169
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1
(* Title: thys/UTM.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2
Author: Jian Xu, Xingyuan Zhang, and Christian Urban
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3
*)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5
header {* Construction of a Universal Turing Machine *}
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 6
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 7
theory UTM
163
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 8
imports Recursive Abacus UF GCD Turing_Hoare
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 9
begin
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 10
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 11
section {* Wang coding of input arguments *}
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 12
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 13
text {*
166
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 14
The direct compilation of the universal function @{text "rec_F"} can
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 15
not give us UTM, because @{text "rec_F"} is of arity 2, where the
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 16
first argument represents the Godel coding of the TM being simulated
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 17
and the second argument represents the right number (in Wang's
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 18
coding) of the TM tape. (Notice, left number is always @{text "0"}
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 19
at the very beginning). However, UTM needs to simulate the execution
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 20
of any TM which may very well take many input arguments. Therefore,
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 21
a initialization TM needs to run before the TM compiled from @{text
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 22
"rec_F"}, and the sequential composition of these two TMs will give
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 23
rise to the UTM we are seeking. The purpose of this initialization
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 24
TM is to transform the multiple input arguments of the TM being
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 25
simulated into Wang's coding, so that it can be consumed by the TM
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 26
compiled from @{text "rec_F"} as the second argument.
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 27
Christian Urban <christian dot urban at kcl dot ac dot uk>
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>
diff
changeset
+ − 29
constructed by compiling from any recursive function, because every
166
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 30
recursive function takes a fixed number of input arguments, while
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 31
@{text "t_wcode"} needs to take varying number of arguments and
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 32
tranform them into Wang's coding. Therefore, this section give a
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 33
direct construction of @{text "t_wcode"} with just some parts being
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 34
obtained from recursive functions.
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 35
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 36
\newlength{\basewidth}
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 37
\settowidth{\basewidth}{xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx}
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 38
\newlength{\baseheight}
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 39
\settoheight{\baseheight}{$B:R$}
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 40
\newcommand{\vsep}{5\baseheight}
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 41
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
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 43
executed sequentially, namely $prepare$, $mainwork$ and $adjust$\<exclamdown>\<pounds>According to the
130
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
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 45
fixed to $0$.
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 46
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
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 48
\ref{prepare_input} and \ref{prepare_output}.
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 49
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 50
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 51
\begin{figure}[h!]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 52
\centering
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 53
\scalebox{1.2}{
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 54
\begin{tikzpicture}
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 55
[tbox/.style = {draw, thick, inner sep = 5pt}]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 56
\node (0) {};
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$};
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$};
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$};
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$};
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$};
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 62
\node (6) [right = -0.9pt of 5] {\ldots \ldots};
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$};
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 64
\draw [->, >=latex, thick] (1)+(0, -4\baseheight) -- (1);
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 65
\end{tikzpicture}}
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 66
\caption{The input of TM $prepare$} \label{prepare_input}
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 67
\end{figure}
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 68
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 69
\begin{figure}[h!]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 70
\centering
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 71
\scalebox{1.2}{
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 72
\begin{tikzpicture}
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 73
\node (0) {};
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$};
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$};
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$};
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$};
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$};
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$};
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 80
\node (7) [right = -0.9pt of 6] {\ldots \ldots};
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$};
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$};
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$};
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$};
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 85
\draw [->, >=latex, thick] (10)+(0, -4\baseheight) -- (10);
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 86
\end{tikzpicture}}
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 87
\caption{The output of TM $prepare$} \label{prepare_output}
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 88
\end{figure}
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 89
166
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 90
As shown in Figure \ref{prepare_input}, the input of $prepare$ is the
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 91
same as the the input of UTM, where $m$ is the Godel coding of the TM
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 92
being interpreted and $a_1$ through $a_n$ are the $n$ input arguments
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 93
of the TM under interpretation. The purpose of $purpose$ is to
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 94
transform this initial tape layout to the one shown in Figure
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 95
\ref{prepare_output}, which is convenient for the generation of Wang's
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 96
codding of $a_1, \ldots, a_n$. The coding procedure starts from $a_n$
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 97
and ends after $a_1$ is encoded. The coding result is stored in an
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 98
accumulator at the end of the tape (initially represented by the $1$
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 99
two blanks right to $a_n$ in Figure \ref{prepare_output}). In Figure
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 100
\ref{prepare_output}, arguments $a_1, \ldots, a_n$ are separated by
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 101
two blanks on both ends with the rest so that movement conditions can
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 102
be implemented conveniently in subsequent TMs, because, by convention,
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 103
two consecutive blanks are usually used to signal the end or start of
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 104
a large chunk of data. The diagram of $prepare$ is given in Figure
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 105
\ref{prepare_diag}.
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 106
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 107
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 108
\begin{figure}[h!]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 109
\centering
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 110
\scalebox{0.9}{
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 111
\begin{tikzpicture}
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 112
\node[circle,draw] (1) {$1$};
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$};
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$};
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$};
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$};
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$};
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$};
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$};
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 120
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 121
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)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 123
;
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)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 125
;
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)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 127
;
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 128
\draw [->, >=latex] (2) -- node[above] {$S_0:L$} (3)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 129
;
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)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 131
;
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 132
\draw [->, >=latex] (3) -- node[above] {$S_0:R$} (4)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 133
;
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)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 135
;
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 136
\draw [->, >=latex] (4) -- node[above] {$S_0:R$} (5)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 137
;
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)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 139
;
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 140
\draw [->, >=latex] (5) -- node[above] {$S_0:R$} (6)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 141
;
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)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 143
;
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 144
\draw [->, >=latex] (6) -- node[above] {$S_0:R$} (7)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 145
;
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)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 147
;
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 148
\draw [->, >=latex] (7) -- node[above] {$S_1:L$} (8)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 149
;
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 150
\end{tikzpicture}}
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 151
\caption{The diagram of TM $prepare$} \label{prepare_diag}
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 152
\end{figure}
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 153
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.
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,
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
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 157
every iteration:
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 158
\begin{enumerate}
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},
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
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
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
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
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 164
$(r+1) \times 2$ to reflect the encoded bit.
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
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 166
\ref{mainwork_case_two_input},
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
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
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
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
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
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.
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 173
The configuration at the end of the iteration
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 174
is shown in Figure \ref{mainwork_case_two_output}.
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 175
Notice that the accumulator has been changed to
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.
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.
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
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}
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
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.
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 182
\end{enumerate}
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
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
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.
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 186
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 187
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 188
\begin{figure}[h!]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 189
\centering
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 190
\scalebox{1.2}{
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 191
\begin{tikzpicture}
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 192
\node (0) {};
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$};
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$};
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$};
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$};
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$};
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$};
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 199
\node (7) [right = -0.9pt of 6] {\ldots \ldots};
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$};
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$};
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$};
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$};
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 204
\node (12) [right = -0.9pt of 11] {\ldots \ldots};
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$};
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$};
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 207
\draw [->, >=latex, thick] (13)+(0, -4\baseheight) -- (13);
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 208
\end{tikzpicture}}
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}
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 210
\end{figure}
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 211
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 212
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 213
\begin{figure}[h!]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 214
\centering
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 215
\scalebox{1.2}{
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 216
\begin{tikzpicture}
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 217
\node (0) {};
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$};
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$};
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$};
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$};
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$};
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$};
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 224
\node (7) [right = -0.9pt of 6] {\ldots \ldots};
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$};
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$};
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$};
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$};
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 229
\node (12) [right = -0.9pt of 11] {\ldots \ldots};
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$};
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$};
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 232
\draw [->, >=latex, thick] (13)+(0, -4\baseheight) -- (13);
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 233
\end{tikzpicture}}
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}
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 235
\label{mainwork_case_one_output}
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 236
\end{figure}
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 237
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 238
\begin{figure}[h!]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 239
\centering
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 240
\scalebox{1.2}{
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 241
\begin{tikzpicture}
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 242
\node (0) {};
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$};
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$};
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$};
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$};
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$};
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$};
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 249
\node (7) [right = -0.9pt of 6] {\ldots \ldots};
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$};
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$};
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$};
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$};
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$};
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 255
\node (13) [right = -0.9pt of 12] {\ldots \ldots};
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$};
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$};
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 258
\draw [->, >=latex, thick] (14)+(0, -4\baseheight) -- (14);
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 259
\end{tikzpicture}}
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}
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 261
\end{figure}
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 262
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 263
\begin{figure}[h!]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 264
\centering
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 265
\scalebox{1.2}{
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 266
\begin{tikzpicture}
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 267
\node (0) {};
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$};
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$};
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$};
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$};
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$};
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$};
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 274
\node (7) [right = -0.9pt of 6] {\ldots \ldots};
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$};
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$};
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$};
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$};
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$};
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 280
\node (13) [right = -0.9pt of 12] {\ldots \ldots};
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$};
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$};
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 283
\draw [->, >=latex, thick] (14)+(0, -4\baseheight) -- (14);
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 284
\end{tikzpicture}}
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}
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 286
\label{mainwork_case_two_output}
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 287
\end{figure}
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 288
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 289
\begin{figure}[h!]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 290
\centering
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 291
\scalebox{1.2}{
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 292
\begin{tikzpicture}
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 293
\node (0) {};
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$};
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$};
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$};
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$};
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$};
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 299
\node (6) [right = -0.9pt of 5] {\ldots \ldots};
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$};
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$};
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 302
\draw [->, >=latex, thick] (7)+(0, -4\baseheight) -- (7);
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 303
\end{tikzpicture}}
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}
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 305
\end{figure}
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 306
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 307
\begin{figure}[h!]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 308
\centering
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 309
\scalebox{1.2}{
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 310
\begin{tikzpicture}
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 311
\node (0) {};
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$};
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$};
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$};
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$};
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$};
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 317
\node (6) [right = -0.9pt of 5] {\ldots \ldots};
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$};
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$};
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 320
\draw [->, >=latex, thick] (3)+(0, -4\baseheight) -- (3);
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 321
\end{tikzpicture}}
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}
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 323
\label{mainwork_case_three_output}
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 324
\end{figure}
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 325
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 326
\begin{figure}[h!]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 327
\centering
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 328
\scalebox{0.9}{
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 329
\begin{tikzpicture}
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 330
\node[circle,draw] (1) {$1$};
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$};
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$};
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$};
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$};
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$};
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$};
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$};
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$};
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$};
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$};
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$};
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$};
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$};
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$};
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$};
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$};
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 347
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)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 349
;
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 350
\draw [->, >=latex] (1) -- node[above] {$S_1:L$} (2)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 351
;
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 352
\draw [->, >=latex] (2) -- node[above] {$S_1:R$} (3)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 353
;
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 354
\draw [->, >=latex] (2) -- node[left] {$S_1:L$} (7)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 355
;
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)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 357
;
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 358
\draw [->, >=latex] (3) -- node[above] {$S_0:R$} (4)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 359
;
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)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 361
;
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 362
\draw [->, >=latex] (4) -- node[above] {$S_1:R$} (5)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 363
;
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)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 365
;
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)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 367
;
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)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 369
;
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 370
\draw [->, >=latex] (6) -- node[above] {$S_0:R$} (13)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 371
;
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 372
\draw [->, >=latex] (13) -- (14)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 373
;
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$}
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 375
;
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 376
\draw [->, >=latex] ($(1) + (0, 6\baseheight)$) -- (1)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 377
;
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 378
\draw [->, >=latex] (7) -- node[above] {$S_0:R$} (17)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 379
;
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 380
\draw [->, >=latex] (7) -- node[left] {$S_1:R$} (8)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 381
;
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 382
\draw [->, >=latex] (8) -- node[above] {$S_0:R$} (9)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 383
;
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 384
\draw [->, >=latex] (9) -- node[above] {$S_0:R$} (10)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 385
;
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 386
\draw [->, >=latex] (10) -- node[above] {$S_1:R$} (11)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 387
;
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)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 389
;
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)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 391
;
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)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 393
;
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 394
\draw [->, >=latex] (12) -- node[above] {$S_0:R$} (15)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 395
;
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)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 397
;
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 398
\draw [->, >=latex] (15) -- (16)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 399
;
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$}
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 401
;
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 402
\draw [->, >=latex] ($(1) + (0, -18\baseheight)$) -- (1)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 403
;
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 404
\end{tikzpicture}}
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 405
\caption{The diagram of TM $mainwork$} \label{mainwork_diag}
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 406
\end{figure}
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 407
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
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.
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}.
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 411
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 412
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 413
\begin{figure}[h!]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 414
\centering
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 415
\scalebox{1.2}{
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 416
\begin{tikzpicture}
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 417
\node (0) {};
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$};
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$};
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$};
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$};
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$};
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 423
\node (6) [right = -0.9pt of 5] {\ldots \ldots};
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$};
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$};
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 426
\draw [->, >=latex, thick] (3)+(0, -4\baseheight) -- (3);
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 427
\end{tikzpicture}}
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 428
\caption{Initial configuration of TM $adjust$} \label{adjust_initial}
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 429
\end{figure}
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 430
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 431
\begin{figure}[h!]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 432
\centering
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 433
\scalebox{1.2}{
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 434
\begin{tikzpicture}
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 435
\node (0) {};
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$};
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$};
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$};
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$};
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$};
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 441
\node (6) [right = -0.9pt of 5] {\ldots \ldots};
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 442
\draw [->, >=latex, thick] (1)+(0, -4\baseheight) -- (1);
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 443
\end{tikzpicture}}
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 444
\caption{Final configuration of TM $adjust$} \label{adjust_final}
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 445
\end{figure}
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 446
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 447
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 448
\begin{figure}[h!]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 449
\centering
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 450
\scalebox{0.9}{
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 451
\begin{tikzpicture}
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 452
\node[circle,draw] (1) {$1$};
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$};
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$};
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$};
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$};
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$};
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$};
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$};
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$};
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$};
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$};
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$};
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 464
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 465
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 466
\draw [->, >=latex] (1) -- node[above] {$S_1:R$} (2)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 467
;
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)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 469
;
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 470
\draw [->, >=latex] (2) -- node[above] {$S_1:R$} (3)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 471
;
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)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 473
;
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 474
\draw [->, >=latex] (3) -- node[above] {$S_1:R$} (4)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 475
;
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 476
\draw [->, >=latex] (4) -- node[above] {$S_1:L$} (5)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 477
;
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 478
\draw [->, >=latex] (4) -- node[right] {$S_0:L$} (8)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 479
;
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 480
\draw [->, >=latex] (5) -- node[above] {$S_0:L$} (6)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 481
;
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)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 483
;
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 484
\draw [->, >=latex] (6) -- node[above] {$S_1:R$} (7)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 485
;
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)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 487
;
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$}
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 489
;
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 490
\draw [->, >=latex] ($(2) + (0, 6\baseheight)$) -- (2)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 491
;
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)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 493
;
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 494
\draw [->, >=latex] (8) -- node[above] {$S_0:L$} (9)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 495
;
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)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 497
;
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 498
\draw [->, >=latex] (9) -- node[above] {$S_1:L$} (10)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 499
;
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)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 501
;
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 502
\draw [->, >=latex] (10) -- node[above] {$S_0:L$} (11)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 503
;
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)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 505
;
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 506
\draw [->, >=latex] (11) -- node[above] {$S_0:R$} (12)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 507
;
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 508
\end{tikzpicture}}
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 509
\caption{Diagram of TM $adjust$} \label{adjust_diag}
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 510
\end{figure}
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 511
*}
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 512
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 513
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 514
definition rec_twice :: "recf"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 515
where
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]"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 517
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 518
definition rec_fourtimes :: "recf"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 519
where
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]"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 521
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 522
definition abc_twice :: "abc_prog"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 523
where
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
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 525
aprog [+] dummy_abc ((Suc 0)))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 526
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 527
definition abc_fourtimes :: "abc_prog"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 528
where
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
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 530
aprog [+] dummy_abc ((Suc 0)))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 531
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 532
definition twice_ly :: "nat list"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 533
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 534
"twice_ly = layout_of abc_twice"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 535
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 536
definition fourtimes_ly :: "nat list"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 537
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 538
"fourtimes_ly = layout_of abc_fourtimes"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 539
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 540
definition t_twice_compile :: "instr list"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 541
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 542
"t_twice_compile= (tm_of abc_twice @ (shift (mopup 1) (length (tm_of abc_twice) div 2)))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 543
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 544
definition t_twice :: "instr list"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 545
where
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 546
"t_twice = adjust t_twice_compile"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 547
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 548
definition t_fourtimes_compile :: "instr list"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 549
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 550
"t_fourtimes_compile= (tm_of abc_fourtimes @ (shift (mopup 1) (length (tm_of abc_fourtimes) div 2)))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 551
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 552
definition t_fourtimes :: "instr list"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 553
where
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 554
"t_fourtimes = adjust t_fourtimes_compile"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 555
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 556
definition t_twice_len :: "nat"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 557
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 558
"t_twice_len = length t_twice div 2"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 559
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 560
definition t_wcode_main_first_part:: "instr list"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 561
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 562
"t_wcode_main_first_part \<equiv>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 563
[(L, 1), (L, 2), (L, 7), (R, 3),
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 564
(R, 4), (W0, 3), (R, 4), (R, 5),
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 565
(W1, 6), (R, 5), (R, 13), (L, 6),
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 566
(R, 0), (R, 8), (R, 9), (Nop, 8),
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 567
(R, 10), (W0, 9), (R, 10), (R, 11),
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)]"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 569
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 570
definition t_wcode_main :: "instr list"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 571
where
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 572
"t_wcode_main = (t_wcode_main_first_part @ shift t_twice 12 @ [(L, 1), (L, 1)]
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 573
@ shift t_fourtimes (t_twice_len + 13) @ [(L, 1), (L, 1)])"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 574
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 575
fun bl_bin :: "cell list \<Rightarrow> nat"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 576
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 577
"bl_bin [] = 0"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 578
| "bl_bin (Bk # xs) = 2 * bl_bin xs"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 579
| "bl_bin (Oc # xs) = Suc (2 * bl_bin xs)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 580
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 581
declare bl_bin.simps[simp del]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 582
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 583
type_synonym bin_inv_t = "cell list \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 584
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 585
fun wcode_before_double :: "bin_inv_t"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 586
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 587
"wcode_before_double ires rs (l, r) =
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 588
(\<exists> ln rn. l = Bk # Bk # Bk\<up>(ln) @ Oc # ires \<and>
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 589
r = Oc\<up>((Suc (Suc rs))) @ Bk\<up>(rn ))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 590
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 591
declare wcode_before_double.simps[simp del]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 592
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 593
fun wcode_after_double :: "bin_inv_t"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 594
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 595
"wcode_after_double ires rs (l, r) =
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 596
(\<exists> ln rn. l = Bk # Bk # Bk\<up>(ln) @ Oc # ires \<and>
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 597
r = Oc\<up>(Suc (Suc (Suc 2*rs))) @ Bk\<up>(rn))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 598
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 599
declare wcode_after_double.simps[simp del]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 600
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"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 602
where
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
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 604
(\<exists> ml mr rn. l = Bk\<up>(ml) @ Oc # Oc # ires \<and>
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 605
r = Bk\<up>(mr) @ Oc\<up>(Suc rs) @ Bk\<up>(rn) \<and>
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 606
ml + mr > Suc 0 \<and> mr > 0)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 607
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]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 609
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"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 611
where
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) =
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 613
(\<exists> ln rn.
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 614
l = Oc # ires \<and>
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 615
r = Oc # Bk\<up>(ln) @ Bk # Bk # Oc\<up>(Suc rs) @ Bk\<up>(rn))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 616
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]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 618
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 619
fun wcode_on_left_moving_1 :: "bin_inv_t"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 620
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 621
"wcode_on_left_moving_1 ires rs (l, r) =
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))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 623
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 624
declare wcode_on_left_moving_1.simps[simp del]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 625
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 626
fun wcode_on_checking_1 :: "bin_inv_t"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 627
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 628
"wcode_on_checking_1 ires rs (l, r) =
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 629
(\<exists> ln rn. l = ires \<and>
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 630
r = Oc # Oc # Bk\<up>(ln) @ Bk # Bk # Oc\<up>(Suc rs) @ Bk\<up>(rn))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 631
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 632
fun wcode_erase1 :: "bin_inv_t"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 633
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 634
"wcode_erase1 ires rs (l, r) =
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 635
(\<exists> ln rn. l = Oc # ires \<and>
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 636
tl r = Bk\<up>(ln) @ Bk # Bk # Oc\<up>(Suc rs) @ Bk\<up>(rn))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 637
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 638
declare wcode_erase1.simps [simp del]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 639
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 640
fun wcode_on_right_moving_1 :: "bin_inv_t"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 641
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 642
"wcode_on_right_moving_1 ires rs (l, r) =
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 643
(\<exists> ml mr rn.
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 644
l = Bk\<up>(ml) @ Oc # ires \<and>
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 645
r = Bk\<up>(mr) @ Oc\<up>(Suc rs) @ Bk\<up>(rn) \<and>
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 646
ml + mr > Suc 0)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 647
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 648
declare wcode_on_right_moving_1.simps [simp del]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 649
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 650
declare wcode_on_right_moving_1.simps[simp del]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 651
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 652
fun wcode_goon_right_moving_1 :: "bin_inv_t"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 653
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 654
"wcode_goon_right_moving_1 ires rs (l, r) =
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 655
(\<exists> ml mr ln rn.
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 656
l = Oc\<up>(ml) @ Bk # Bk # Bk\<up>(ln) @ Oc # ires \<and>
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 657
r = Oc\<up>(mr) @ Bk\<up>(rn) \<and>
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 658
ml + mr = Suc rs)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 659
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 660
declare wcode_goon_right_moving_1.simps[simp del]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 661
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 662
fun wcode_backto_standard_pos_B :: "bin_inv_t"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 663
where
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
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 665
(\<exists> ln rn. l = Bk # Bk\<up>(ln) @ Oc # ires \<and>
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 666
r = Bk # Oc\<up>((Suc (Suc rs))) @ Bk\<up>(rn ))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 667
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 668
declare wcode_backto_standard_pos_B.simps[simp del]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 669
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 670
fun wcode_backto_standard_pos_O :: "bin_inv_t"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 671
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 672
"wcode_backto_standard_pos_O ires rs (l, r) =
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 673
(\<exists> ml mr ln rn.
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 674
l = Oc\<up>(ml) @ Bk # Bk # Bk\<up>(ln) @ Oc # ires \<and>
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 675
r = Oc\<up>(mr) @ Bk\<up>(rn) \<and>
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 676
ml + mr = Suc (Suc rs) \<and> mr > 0)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 677
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 678
declare wcode_backto_standard_pos_O.simps[simp del]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 679
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 680
fun wcode_backto_standard_pos :: "bin_inv_t"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 681
where
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>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 683
wcode_backto_standard_pos_O ires rs (l, r))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 684
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 685
declare wcode_backto_standard_pos.simps[simp del]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 686
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 687
lemma [simp]: "<0::nat> = [Oc]"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 688
apply(simp add: tape_of_nat_abv tape_of_nat_list.simps)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 689
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 690
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
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 692
apply(simp only: tape_of_nat_abv exp_ind, simp)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 693
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 694
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 695
lemma [simp]: "length (<a::nat>) = Suc a"
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)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 697
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 698
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 699
lemma [simp]: "<[a::nat]> = <a>"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 700
apply(simp add: tape_of_nat_abv tape_of_nl_abv
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 701
tape_of_nat_list.simps)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 702
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 703
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 704
lemma bin_wc_eq: "bl_bin xs = bl2wc xs"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 705
proof(induct xs)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 706
show " bl_bin [] = bl2wc []"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 707
apply(simp add: bl_bin.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 708
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 709
next
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 710
fix a xs
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 711
assume "bl_bin xs = bl2wc xs"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 712
thus " bl_bin (a # xs) = bl2wc (a # xs)"
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)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 714
apply(simp_all add: bl2nat.simps bl2nat_double)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 715
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 716
qed
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 717
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 718
lemma bl_bin_nat_Suc:
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
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 720
apply(simp add: tape_of_nat_abv bl_bin.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 721
apply(induct a, auto simp: bl_bin.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 722
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 723
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 724
lemma [simp]: " rev (a\<up>(aa)) = a\<up>(aa)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 725
apply(simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 726
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 727
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 728
lemma tape_of_nl_append_one: "lm \<noteq> [] \<Longrightarrow> <lm @ [a]> = <lm> @ Bk # Oc\<up>Suc a"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 729
apply(induct lm, auto simp: tape_of_nl_cons split:if_splits)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 730
done
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 731
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
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 733
apply(induct lm, simp, auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 734
apply(auto simp: tape_of_nl_cons tape_of_nl_append_one split: if_splits)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 735
apply(simp add: exp_ind[THEN sym])
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 736
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 737
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 738
lemma [simp]: "a\<up>(Suc 0) = [a]"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 739
by(simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 740
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 741
lemma tape_of_nl_cons_app1: "(<a # xs @ [b]>) = (Oc\<up>(Suc a) @ Bk # (<xs@ [b]>))"
133
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 742
apply(case_tac xs, simp add: tape_of_nl_abv tape_of_nat_list.simps tape_of_nat_abv)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 743
apply(simp add: tape_of_nl_abv tape_of_nat_list.simps tape_of_nat_abv)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 744
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 745
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 746
lemma bl_bin_bk_oc[simp]:
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 747
"bl_bin (xs @ [Bk, Oc]) =
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 748
bl_bin xs + 2*2^(length xs)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 749
apply(simp add: bin_wc_eq)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 750
using bl2nat_cons_oc[of "xs @ [Bk]"]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 751
apply(simp add: bl2nat_cons_bk bl2wc.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 752
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 753
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 754
lemma tape_of_nat[simp]: "(<a::nat>) = Oc\<up>(Suc a)"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 755
apply(simp add: tape_of_nat_abv)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 756
done
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 757
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 758
lemma tape_of_nl_cons_app2: "(<c # xs @ [b]>) = (<c # xs> @ Bk # Oc\<up>(Suc b))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 759
proof(induct "length xs" arbitrary: xs c,
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)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 761
fix x xs c
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
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 763
<c # xs> @ Bk # Oc\<up>(Suc b)"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 764
and h: "Suc x = length (xs::nat list)"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 765
show "<c # xs @ [b]> = <c # xs> @ Bk # Oc\<up>(Suc b)"
130
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)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 767
fix a list
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 768
assume g: "xs = a # list"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 769
hence k: "<a # list @ [b]> = <a # list> @ Bk # Oc\<up>(Suc b)"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 770
apply(rule_tac ind)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 771
using h
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 772
apply(simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 773
done
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 774
from g and k show "<c # xs @ [b]> = <c # xs> @ Bk # Oc\<up>(Suc b)"
130
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)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 776
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 777
qed
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 778
qed
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 779
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>)"
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)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 782
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 783
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 784
lemma [simp]: "bl_bin (Oc\<up>(Suc aa) @ Bk # tape_of_nat_list (a # lista) @ [Bk, Oc]) =
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 785
bl_bin (Oc\<up>(Suc aa) @ Bk # tape_of_nat_list (a # lista)) +
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 786
2* 2^(length (Oc\<up>(Suc aa) @ Bk # tape_of_nat_list (a # lista)))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 787
using bl_bin_bk_oc[of "Oc\<up>(Suc aa) @ Bk # tape_of_nat_list (a # lista)"]
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 788
apply(simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 789
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 790
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 791
declare replicate_Suc[simp del]
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 792
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 793
lemma [simp]:
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
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 795
= bl_bin (Oc\<up>(Suc aa) @ Bk # <list @ [0]>) + rs * (2 * 2 ^ (aa + length (<list @ [0]>)))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 796
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 797
apply(case_tac "list", simp add: add_mult_distrib)
130
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)
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)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 800
done
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 801
130
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]"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 803
apply(induct list)
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)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 805
apply(case_tac list)
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)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 807
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 808
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 809
lemma [simp]: "bl_bin (Oc # Oc\<up>(aa) @ Bk # <list @ [ab]> @ [Oc])
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 810
= bl_bin (Oc # Oc\<up>(aa) @ Bk # <list @ [ab]>) +
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 811
2^(length (Oc # Oc\<up>(aa) @ Bk # <list @ [ab]>))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 812
apply(simp add: bin_wc_eq)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 813
apply(simp add: bl2nat_cons_oc bl2wc.simps)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 814
using bl2nat_cons_oc[of "Oc # Oc\<up>(aa) @ Bk # <list @ [ab]>"]
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 815
apply(simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 816
done
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 817
lemma [simp]: "bl_bin (Oc # Oc\<up>(aa) @ Bk # <list @ [ab]>) + (4 * 2 ^ (aa + length (<list @ [ab]>)) +
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 818
4 * (rs * 2 ^ (aa + length (<list @ [ab]>)))) =
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 819
bl_bin (Oc # Oc\<up>(aa) @ Bk # <list @ [Suc ab]>) +
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 820
rs * (2 * 2 ^ (aa + length (<list @ [Suc ab]>)))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 821
apply(simp add: tape_of_nl_app_Suc)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 822
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 823
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 824
declare tape_of_nat[simp del]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 825
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"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 827
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 828
"wcode_double_case_inv st ires rs (l, r) =
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)
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)
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)
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)
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)
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)
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)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 836
else False)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 837
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 838
declare wcode_double_case_inv.simps[simp del]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 839
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 840
fun wcode_double_case_state :: "config \<Rightarrow> nat"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 841
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 842
"wcode_double_case_state (st, l, r) =
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 843
13 - st"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 844
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 845
fun wcode_double_case_step :: "config \<Rightarrow> nat"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 846
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 847
"wcode_double_case_step (st, l, r) =
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 848
(if st = Suc 0 then (length l)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 849
else if st = Suc (Suc 0) then (length r)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 850
else if st = 3 then
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 851
if hd r = Oc then 1 else 0
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 852
else if st = 4 then (length r)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 853
else if st = 5 then (length r)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 854
else if st = 6 then (length l)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 855
else 0)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 856
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 857
fun wcode_double_case_measure :: "config \<Rightarrow> nat \<times> nat"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 858
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 859
"wcode_double_case_measure (st, l, r) =
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 860
(wcode_double_case_state (st, l, r),
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 861
wcode_double_case_step (st, l, r))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 862
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 863
definition wcode_double_case_le :: "(config \<times> config) set"
130
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)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 865
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 866
lemma [intro]: "wf lex_pair"
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)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 868
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"
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 )
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 871
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)"
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
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 874
fetch.simps nth_of.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 875
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 876
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))"
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
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 879
fetch.simps nth_of.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 880
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 881
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)"
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
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 884
fetch.simps nth_of.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 885
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 886
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)"
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
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 889
fetch.simps nth_of.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 890
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 891
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)"
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
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 894
fetch.simps nth_of.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 895
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 896
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
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 898
apply(subgoal_tac "4 = Suc 3")
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 899
apply(simp only: t_wcode_main_def t_wcode_main_first_part_def
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 900
fetch.simps nth_of.simps, auto)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 901
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 902
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
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 904
apply(subgoal_tac "4 = Suc 3")
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 905
apply(simp only: t_wcode_main_def t_wcode_main_first_part_def
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 906
fetch.simps nth_of.simps, auto)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 907
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 908
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
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 910
apply(subgoal_tac "5 = Suc 4")
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 911
apply(simp only: t_wcode_main_def t_wcode_main_first_part_def
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 912
fetch.simps nth_of.simps, auto)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 913
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 914
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
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 916
apply(subgoal_tac "5 = Suc 4")
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 917
apply(simp only: t_wcode_main_def t_wcode_main_first_part_def
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 918
fetch.simps nth_of.simps, auto)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 919
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 920
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
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 922
apply(subgoal_tac "6 = Suc 5")
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 923
apply(simp only: t_wcode_main_def t_wcode_main_first_part_def
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 924
fetch.simps nth_of.simps, auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 925
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 926
130
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
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 928
apply(subgoal_tac "6 = Suc 5")
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 929
apply(simp only: t_wcode_main_def t_wcode_main_first_part_def
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 930
fetch.simps nth_of.simps, auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 931
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 932
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 933
lemma [elim]: "Bk\<up>(mr) = [] \<Longrightarrow> mr = 0"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 934
apply(case_tac mr, auto)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 935
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 936
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"
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
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 939
wcode_on_left_moving_1_O.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 940
done
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 941
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 942
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 943
declare wcode_on_checking_1.simps[simp del]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 944
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 945
lemmas wcode_double_case_inv_simps =
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
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
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 948
wcode_erase1.simps wcode_on_right_moving_1.simps
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
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 950
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 951
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> []"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 953
apply(simp add: wcode_double_case_inv_simps, auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 954
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 955
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 956
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);
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>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 959
wcode_on_left_moving_1 ires rs (aa, ba)"
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
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 961
wcode_on_left_moving_1_B.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 962
apply(erule_tac disjE)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 963
apply(erule_tac exE)+
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 964
apply(case_tac ml, simp)
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)
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)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 967
apply(rule_tac disjI1)
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
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 969
simp, simp add: replicate_Suc)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 970
apply(erule_tac exE)+
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 971
apply(simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 972
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 973
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 974
declare replicate_Suc[simp]
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 975
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 976
lemma [elim]:
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>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 978
\<Longrightarrow> wcode_on_checking_1 ires rs (aa, ba)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 979
apply(simp only: wcode_double_case_inv_simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 980
apply(erule_tac disjE)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 981
apply(erule_tac [!] exE)+
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 982
apply(case_tac mr, simp, auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 983
done
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 984
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"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 986
apply(auto simp: wcode_double_case_inv_simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 987
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 988
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"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 990
apply(auto simp: wcode_double_case_inv_simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 991
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 992
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>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 994
\<Longrightarrow> wcode_erase1 ires rs (aa, ba)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 995
apply(simp only: wcode_double_case_inv_simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 996
apply(erule_tac exE)+
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)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 998
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 999
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1000
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"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1002
apply(simp add: wcode_double_case_inv_simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1003
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1004
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"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1006
apply(simp add: wcode_double_case_inv_simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1007
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1008
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1009
lemma [simp]: "wcode_erase1 ires rs (b, []) = False"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1010
apply(simp add: wcode_double_case_inv_simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1011
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1012
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
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1014
apply(simp add: wcode_double_case_inv_simps)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1015
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1016
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
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1018
apply(simp add: wcode_double_case_inv_simps)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1019
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1020
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>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1022
wcode_on_right_moving_1 ires rs (aa, ba)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1023
apply(simp only: wcode_double_case_inv_simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1024
apply(erule_tac exE)+
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,
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1026
rule_tac x = rn in exI)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1027
apply(simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1028
apply(case_tac mr, simp, simp)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1029
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1030
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1031
lemma [elim]:
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>
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)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1034
apply(simp only: wcode_double_case_inv_simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1035
apply(erule_tac exE)+
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,
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
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1038
apply(case_tac mr, simp_all)
130
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)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1040
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1041
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1042
lemma [simp]:
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
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1044
apply(simp add: wcode_double_case_inv_simps)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1045
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1046
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>
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)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1049
apply(simp only: wcode_double_case_inv_simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1050
apply(erule_tac exE)+
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
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1052
rule_tac x = rn in exI, simp add: exp_ind del: replicate_Suc)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1053
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1054
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>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1056
wcode_erase1 ires rs (aa, ba)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1057
apply(simp only: wcode_double_case_inv_simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1058
apply(erule_tac exE)+
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)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1060
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1061
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>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1063
\<Longrightarrow> wcode_backto_standard_pos ires rs (aa, ba)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1064
apply(simp only: wcode_double_case_inv_simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1065
apply(erule_tac exE)+
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1066
apply(rule_tac disjI2)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1067
apply(simp only:wcode_backto_standard_pos_O.simps)
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,
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1069
rule_tac x = rn in exI, simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1070
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1071
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1072
lemma [elim]:
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>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1074
\<Longrightarrow> wcode_backto_standard_pos ires rs (aa, ba)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1075
apply(simp only: wcode_double_case_inv_simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1076
apply(erule_tac exE)+
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1077
apply(rule_tac disjI2)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1078
apply(simp only:wcode_backto_standard_pos_O.simps)
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,
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
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1081
apply(case_tac mr, simp, case_tac rn, simp, simp_all)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1082
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1083
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>
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)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1086
apply(simp only: wcode_double_case_inv_simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1087
apply(erule_tac exE)+
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,
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
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1090
apply(simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1091
apply(case_tac mr, simp, case_tac rn, simp_all)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1092
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1093
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"
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
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1096
wcode_backto_standard_pos_B.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1097
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1098
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>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1100
\<Longrightarrow> wcode_before_double ires rs (aa, ba)"
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
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)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1103
apply(erule_tac disjE)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1104
apply(erule_tac exE)+
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)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1106
apply(auto)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1107
apply(case_tac [!] mr, simp_all)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1108
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1109
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"
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
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1112
wcode_backto_standard_pos_O.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1113
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1114
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"
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
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1117
wcode_backto_standard_pos_O.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1118
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1119
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>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1121
\<Longrightarrow> wcode_backto_standard_pos ires rs (aa, ba)"
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
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1123
wcode_backto_standard_pos_O.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1124
apply(erule_tac disjE)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1125
apply(simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1126
apply(erule_tac exE)+
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1127
apply(case_tac ml, simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1128
apply(rule_tac disjI1, rule_tac conjI)
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)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1130
apply(rule_tac disjI2)
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,
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1132
rule_tac x = rn in exI, simp)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1133
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1134
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1135
declare nth_of.simps[simp del] fetch.simps[simp del]
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1136
lemma wcode_double_case_first_correctness:
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1137
"let P = (\<lambda> (st, l, r). st = 13) in
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
Christian Urban <christian dot urban at kcl dot ac dot uk>
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
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))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1141
proof -
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1142
let ?P = "(\<lambda> (st, l, r). st = 13)"
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
Christian Urban <christian dot urban at kcl dot ac dot uk>
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
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))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1146
proof(rule_tac halt_lemma2)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1147
show "wf wcode_double_case_le"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1148
by auto
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1149
next
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>
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
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1152
proof(rule_tac allI, case_tac "?f na", simp add: step_red)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1153
fix na a b c
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
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1155
(case step0 (a, b, c) t_wcode_main of (st, x) \<Rightarrow>
130
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
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1157
(step0 (a, b, c) t_wcode_main, a, b, c) \<in> wcode_double_case_le"
130
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
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1159
apply(auto split: if_splits simp: step.simps,
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1160
case_tac [!] c, simp_all, case_tac [!] "(c::cell list)!0")
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1161
apply(simp_all add: wcode_double_case_inv.simps wcode_double_case_le_def
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1162
lex_pair_def)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1163
apply(auto split: if_splits)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1164
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1165
qed
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1166
next
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1167
show "?Q (?f 0)"
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
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1169
wcode_on_left_moving_1.simps
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1170
wcode_on_left_moving_1_B.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1171
apply(rule_tac disjI1)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1172
apply(rule_tac x = "Suc m" in exI, simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1173
apply(rule_tac x = "Suc 0" in exI, simp)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1174
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1175
next
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1176
show "\<not> ?P (?f 0)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1177
apply(simp add: steps.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1178
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1179
qed
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1180
thus "let P = \<lambda>(st, l, r). st = 13;
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
Christian Urban <christian dot urban at kcl dot ac dot uk>
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
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)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1184
apply(simp add: Let_def)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1185
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1186
qed
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1187
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1188
lemma tm_append_shift_append_steps:
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1189
"\<lbrakk>steps0 (st, l, r) tp stp = (st', l', r');
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1190
0 < st';
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1191
length tp1 mod 2 = 0
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1192
\<rbrakk>
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1193
\<Longrightarrow> steps0 (st + length tp1 div 2, l, r) (tp1 @ shift tp (length tp1 div 2) @ tp2) stp
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1194
= (st' + length tp1 div 2, l', r')"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1195
proof -
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1196
assume h:
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1197
"steps0 (st, l, r) tp stp = (st', l', r')"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1198
"0 < st'"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1199
"length tp1 mod 2 = 0 "
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1200
from h have
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1201
"steps (st + length tp1 div 2, l, r) (tp1 @ shift tp (length tp1 div 2), 0) stp =
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1202
(st' + length tp1 div 2, l', r')"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1203
by(rule_tac tm_append_second_steps_eq, simp_all)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1204
then have "steps (st + length tp1 div 2, l, r) ((tp1 @ shift tp (length tp1 div 2)) @ tp2, 0) stp =
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1205
(st' + length tp1 div 2, l', r')"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1206
using h
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1207
apply(rule_tac tm_append_first_steps_eq, simp_all)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1208
done
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1209
thus "?thesis"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1210
by simp
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1211
qed
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1212
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
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1214
apply(simp add: t_twice_def mopup.simps t_twice_compile_def)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1215
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1216
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1217
lemma [intro]: "rec_calc_rel (recf.id (Suc 0) 0) [rs] rs"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1218
apply(rule_tac calc_id, simp_all)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1219
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1220
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1221
lemma [intro]: "rec_calc_rel (constn 2) [rs] 2"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1222
using prime_rel_exec_eq[of "constn 2" "[rs]" 2]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1223
apply(subgoal_tac "primerec (constn 2) 1", auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1224
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1225
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1226
lemma [intro]: "rec_calc_rel rec_mult [rs, 2] (2 * rs)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1227
using prime_rel_exec_eq[of "rec_mult" "[rs, 2]" "2*rs"]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1228
apply(subgoal_tac "primerec rec_mult (Suc (Suc 0))", auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1229
done
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1230
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1231
declare start_of.simps[simp del]
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1232
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1233
lemma t_twice_correct:
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1234
"\<exists>stp ln rn. steps0 (Suc 0, Bk # Bk # ires, Oc\<up>(Suc rs) @ Bk\<up>(n))
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1235
(tm_of abc_twice @ shift (mopup (Suc 0)) ((length (tm_of abc_twice) div 2))) stp =
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1236
(0, Bk\<up>(ln) @ Bk # Bk # ires, Oc\<up>(Suc (2 * rs)) @ Bk\<up>(rn))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1237
proof(case_tac "rec_ci rec_twice")
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1238
fix a b c
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1239
assume h: "rec_ci rec_twice = (a, b, c)"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1240
have "\<exists>stp m l. steps0 (Suc 0, Bk # Bk # ires, <[rs]> @ Bk\<up>(n)) (tm_of abc_twice @ shift (mopup 1)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1241
(length (tm_of abc_twice) div 2)) stp = (0, Bk\<up>(m) @ Bk # Bk # ires, Oc\<up>(Suc (2*rs)) @ Bk\<up>(l))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1242
proof(rule_tac recursive_compile_to_tm_correct)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1243
show "rec_ci rec_twice = (a, b, c)" by (simp add: h)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1244
next
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1245
show "rec_calc_rel rec_twice [rs] (2 * rs)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1246
apply(simp add: rec_twice_def)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1247
apply(rule_tac rs = "[rs, 2]" in calc_cn, simp_all)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1248
apply(rule_tac allI, case_tac k, auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1249
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1250
next
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1251
show "length [rs] = 1" by simp
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1252
next
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1253
show "layout_of (a [+] dummy_abc 1) = layout_of (a [+] dummy_abc 1)" by simp
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1254
next
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1255
show "tm_of abc_twice = tm_of (a [+] dummy_abc 1)"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1256
using h
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1257
apply(simp add: abc_twice_def)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1258
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1259
qed
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1260
thus "?thesis"
133
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1261
apply(simp add: tape_of_nl_abv tape_of_nat_list.simps tape_of_nat_abv)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1262
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1263
qed
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1264
139
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1265
declare adjust.simps[simp]
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1266
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1267
lemma adjust_fetch0:
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1268
"\<lbrakk>0 < a; a \<le> length ap div 2; fetch ap a b = (aa, 0)\<rbrakk>
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1269
\<Longrightarrow> fetch (adjust ap) a b = (aa, Suc (length ap div 2))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1270
apply(case_tac b, auto simp: fetch.simps nth_of.simps nth_map
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1271
split: if_splits)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1272
apply(case_tac [!] a, auto simp: fetch.simps nth_of.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1273
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1274
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1275
lemma adjust_fetch_norm:
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1276
"\<lbrakk>st > 0; st \<le> length tp div 2; fetch ap st b = (aa, ns); ns \<noteq> 0\<rbrakk>
163
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1277
\<Longrightarrow> fetch (Turing.adjust ap) st b = (aa, ns)"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1278
apply(case_tac b, auto simp: fetch.simps nth_of.simps nth_map
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1279
split: if_splits)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1280
apply(case_tac [!] st, auto simp: fetch.simps nth_of.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1281
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1282
139
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1283
declare adjust.simps[simp del]
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1284
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1285
lemma adjust_step_eq:
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1286
assumes exec: "step0 (st,l,r) ap = (st', l', r')"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1287
and wf_tm: "tm_wf (ap, 0)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1288
and notfinal: "st' > 0"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1289
shows "step0 (st, l, r) (adjust ap) = (st', l', r')"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1290
using assms
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1291
proof -
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1292
have "st > 0"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1293
using assms
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1294
by(case_tac st, simp_all add: step.simps fetch.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1295
moreover hence "st \<le> (length ap) div 2"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1296
using assms
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1297
apply(case_tac "st \<le> (length ap) div 2", simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1298
apply(case_tac st, auto simp: step.simps fetch.simps)
139
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1299
apply(case_tac "read r", simp_all add: fetch.simps
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1300
nth_of.simps adjust.simps tm_wf.simps split: if_splits)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1301
apply(auto simp: mod_ex2)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1302
done
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1303
ultimately have "fetch (adjust ap) st (read r) = fetch ap st (read r)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1304
using assms
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1305
apply(case_tac "fetch ap st (read r)")
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1306
apply(drule_tac adjust_fetch_norm, simp_all)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1307
apply(simp add: step.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1308
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1309
thus "?thesis"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1310
using exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1311
by(simp add: step.simps)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1312
qed
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1313
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1314
declare adjust.simps[simp del]
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1315
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1316
lemma adjust_steps_eq:
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1317
assumes exec: "steps0 (st,l,r) ap stp = (st', l', r')"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1318
and wf_tm: "tm_wf (ap, 0)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1319
and notfinal: "st' > 0"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1320
shows "steps0 (st, l, r) (adjust ap) stp = (st', l', r')"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1321
using exec notfinal
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1322
proof(induct stp arbitrary: st' l' r')
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1323
case 0
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1324
thus "?case"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1325
by(simp add: steps.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1326
next
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1327
case (Suc stp st' l' r')
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1328
have ind: "\<And>st' l' r'. \<lbrakk>steps0 (st, l, r) ap stp = (st', l', r'); 0 < st'\<rbrakk>
163
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1329
\<Longrightarrow> steps0 (st, l, r) (Turing.adjust ap) stp = (st', l', r')" by fact
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1330
have h: "steps0 (st, l, r) ap (Suc stp) = (st', l', r')" by fact
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1331
have g: "0 < st'" by fact
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1332
obtain st'' l'' r'' where a: "steps0 (st, l, r) ap stp = (st'', l'', r'')"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1333
by (metis prod_cases3)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1334
hence c:"0 < st''"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1335
using h g
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1336
apply(simp add: step_red)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1337
apply(case_tac st'', auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1338
done
163
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1339
hence b: "steps0 (st, l, r) (Turing.adjust ap) stp = (st'', l'', r'')"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1340
using a
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1341
by(rule_tac ind, simp_all)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1342
thus "?case"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1343
using assms a b h g
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1344
apply(simp add: step_red)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1345
apply(rule_tac adjust_step_eq, simp_all)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1346
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1347
qed
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1348
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1349
lemma adjust_halt_eq:
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1350
assumes exec: "steps0 (1, l, r) ap stp = (0, l', r')"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1351
and tm_wf: "tm_wf (ap, 0)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1352
shows "\<exists> stp. steps0 (Suc 0, l, r) (adjust ap) stp =
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1353
(Suc (length ap div 2), l', r')"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1354
proof -
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1355
have "\<exists> stp. \<not> is_final (steps0 (1, l, r) ap stp) \<and> (steps0 (1, l, r) ap (Suc stp) = (0, l', r'))"
166
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1356
using exec
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1357
by(erule_tac before_final)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1358
then obtain stpa where a:
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1359
"\<not> is_final (steps0 (1, l, r) ap stpa) \<and> (steps0 (1, l, r) ap (Suc stpa) = (0, l', r'))" ..
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1360
obtain sa la ra where b:"steps0 (1, l, r) ap stpa = (sa, la, ra)" by (metis prod_cases3)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1361
hence c: "steps0 (Suc 0, l, r) (adjust ap) stpa = (sa, la, ra)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1362
using assms a
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1363
apply(rule_tac adjust_steps_eq, simp_all)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1364
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1365
have d: "sa \<le> length ap div 2"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1366
using steps_in_range[of "(l, r)" ap stpa] a tm_wf b
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1367
by(simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1368
obtain ac ns where e: "fetch ap sa (read ra) = (ac, ns)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1369
by (metis prod.exhaust)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1370
hence f: "ns = 0"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1371
using b a
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1372
apply(simp add: step_red step.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1373
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1374
have k: "fetch (adjust ap) sa (read ra) = (ac, Suc (length ap div 2))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1375
using a b c d e f
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1376
apply(rule_tac adjust_fetch0, simp_all)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1377
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1378
from a b e f k and c show "?thesis"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1379
apply(rule_tac x = "Suc stpa" in exI)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1380
apply(simp add: step_red, auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1381
apply(simp add: step.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1382
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1383
qed
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1384
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1385
declare tm_wf.simps[simp del]
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1386
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1387
lemma [simp]: " tm_wf (t_twice_compile, 0)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1388
apply(simp only: t_twice_compile_def)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1389
apply(rule_tac t_compiled_correct)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1390
apply(simp_all add: abc_twice_def)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1391
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1392
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1393
lemma t_twice_change_term_state:
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1394
"\<exists> stp ln rn. steps0 (Suc 0, Bk # Bk # ires, Oc\<up>(Suc rs) @ Bk\<up>(n)) t_twice stp
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1395
= (Suc t_twice_len, Bk\<up>(ln) @ Bk # Bk # ires, Oc\<up>(Suc (2 * rs)) @ Bk\<up>(rn))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1396
proof -
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1397
have "\<exists>stp ln rn. steps0 (Suc 0, Bk # Bk # ires, Oc\<up>(Suc rs) @ Bk\<up>(n))
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1398
(tm_of abc_twice @ shift (mopup (Suc 0)) ((length (tm_of abc_twice) div 2))) stp =
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1399
(0, Bk\<up>(ln) @ Bk # Bk # ires, Oc\<up>(Suc (2 * rs)) @ Bk\<up>(rn))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1400
by(rule_tac t_twice_correct)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1401
then obtain stp ln rn where " steps0 (Suc 0, Bk # Bk # ires, Oc\<up>(Suc rs) @ Bk\<up>(n))
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1402
(tm_of abc_twice @ shift (mopup (Suc 0)) ((length (tm_of abc_twice) div 2))) stp =
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1403
(0, Bk\<up>(ln) @ Bk # Bk # ires, Oc\<up>(Suc (2 * rs)) @ Bk\<up>(rn))" by blast
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1404
hence "\<exists> stp. steps0 (Suc 0, Bk # Bk # ires, Oc\<up>(Suc rs) @ Bk\<up>(n))
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1405
(adjust t_twice_compile) stp
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1406
= (Suc (length t_twice_compile div 2), Bk\<up>(ln) @ Bk # Bk # ires, Oc\<up>(Suc (2 * rs)) @ Bk\<up>(rn))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1407
apply(rule_tac stp = stp in adjust_halt_eq)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1408
apply(simp add: t_twice_compile_def, auto)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1409
done
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1410
then obtain stpb where
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1411
"steps0 (Suc 0, Bk # Bk # ires, Oc\<up>(Suc rs) @ Bk\<up>(n))
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1412
(adjust t_twice_compile) stpb
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1413
= (Suc (length t_twice_compile div 2), Bk\<up>(ln) @ Bk # Bk # ires, Oc\<up>(Suc (2 * rs)) @ Bk\<up>(rn))" ..
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1414
thus "?thesis"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1415
apply(simp add: t_twice_def t_twice_len_def)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1416
by metis
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1417
qed
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1418
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1419
lemma [intro]: "length t_wcode_main_first_part mod 2 = 0"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1420
apply(auto simp: t_wcode_main_first_part_def)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1421
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1422
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1423
lemma t_twice_append_pre:
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1424
"steps0 (Suc 0, Bk # Bk # ires, Oc\<up>(Suc rs) @ Bk\<up>(n)) t_twice stp
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1425
= (Suc t_twice_len, Bk\<up>(ln) @ Bk # Bk # ires, Oc\<up>(Suc (2 * rs)) @ Bk\<up>(rn))
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1426
\<Longrightarrow> steps0 (Suc 0 + length t_wcode_main_first_part div 2, Bk # Bk # ires, Oc\<up>(Suc rs) @ Bk\<up>(n))
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1427
(t_wcode_main_first_part @ shift t_twice (length t_wcode_main_first_part div 2) @
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1428
([(L, 1), (L, 1)] @ shift t_fourtimes (t_twice_len + 13) @ [(L, 1), (L, 1)])) stp
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1429
= (Suc (t_twice_len) + length t_wcode_main_first_part div 2,
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1430
Bk\<up>(ln) @ Bk # Bk # ires, Oc\<up>(Suc (2 * rs)) @ Bk\<up>(rn))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1431
by(rule_tac tm_append_shift_append_steps, auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1432
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1433
lemma t_twice_append:
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1434
"\<exists> stp ln rn. steps0 (Suc 0 + length t_wcode_main_first_part div 2, Bk # Bk # ires, Oc\<up>(Suc rs) @ Bk\<up>(n))
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1435
(t_wcode_main_first_part @ shift t_twice (length t_wcode_main_first_part div 2) @
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1436
([(L, 1), (L, 1)] @ shift t_fourtimes (t_twice_len + 13) @ [(L, 1), (L, 1)])) stp
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1437
= (Suc (t_twice_len) + length t_wcode_main_first_part div 2, Bk\<up>(ln) @ Bk # Bk # ires, Oc\<up>(Suc (2 * rs)) @ Bk\<up>(rn))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1438
using t_twice_change_term_state[of ires rs n]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1439
apply(erule_tac exE)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1440
apply(erule_tac exE)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1441
apply(erule_tac exE)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1442
apply(drule_tac t_twice_append_pre)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1443
apply(rule_tac x = stp in exI, rule_tac x = ln in exI, rule_tac x = rn in exI)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1444
apply(simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1445
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1446
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1447
lemma mopup_mod2: "length (mopup k) mod 2 = 0"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1448
apply(auto simp: mopup.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1449
by arith
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1450
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1451
lemma [simp]: "fetch t_wcode_main (Suc (t_twice_len + length t_wcode_main_first_part div 2)) Oc
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1452
= (L, Suc 0)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1453
apply(subgoal_tac "length (t_twice) mod 2 = 0")
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1454
apply(simp add: t_wcode_main_def nth_append fetch.simps t_wcode_main_first_part_def
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1455
nth_of.simps t_twice_len_def, auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1456
apply(simp add: t_twice_def t_twice_compile_def)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1457
using mopup_mod2[of 1]
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1458
apply(simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1459
by arith
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1460
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1461
lemma wcode_jump1:
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1462
"\<exists> stp ln rn. steps0 (Suc (t_twice_len) + length t_wcode_main_first_part div 2,
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1463
Bk\<up>(m) @ Bk # Bk # ires, Oc\<up>(Suc (2 * rs)) @ Bk\<up>(n))
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1464
t_wcode_main stp
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1465
= (Suc 0, Bk\<up>(ln) @ Bk # ires, Bk # Oc\<up>(Suc (2 * rs)) @ Bk\<up>(rn))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1466
apply(rule_tac x = "Suc 0" in exI, rule_tac x = "m" in exI, rule_tac x = n in exI)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1467
apply(simp add: steps.simps step.simps exp_ind)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1468
apply(case_tac m, simp_all)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1469
apply(simp add: exp_ind[THEN sym])
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1470
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1471
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1472
lemma wcode_main_first_part_len:
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1473
"length t_wcode_main_first_part = 24"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1474
apply(simp add: t_wcode_main_first_part_def)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1475
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1476
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1477
lemma wcode_double_case:
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1478
shows "\<exists>stp ln rn. steps0 (Suc 0, Bk # Bk\<up>(m) @ Oc # Oc # ires, Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stp =
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1479
(Suc 0, Bk # Bk\<up>(ln) @ Oc # ires, Bk # Oc\<up>(Suc (2 * rs + 2)) @ Bk\<up>(rn))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1480
proof -
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1481
have "\<exists>stp ln rn. steps0 (Suc 0, Bk # Bk\<up>(m) @ Oc # Oc # ires, Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stp =
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1482
(13, Bk # Bk # Bk\<up>(ln) @ Oc # ires, Oc\<up>(Suc (Suc rs)) @ Bk\<up>(rn))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1483
using wcode_double_case_first_correctness[of ires rs m n]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1484
apply(simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1485
apply(erule_tac exE)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1486
apply(case_tac "steps0 (Suc 0, Bk # Bk\<up>(m) @ Oc # Oc # ires,
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1487
Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main na",
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1488
auto simp: wcode_double_case_inv.simps
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1489
wcode_before_double.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1490
apply(rule_tac x = na in exI, rule_tac x = ln in exI, rule_tac x = rn in exI)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1491
apply(simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1492
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1493
from this obtain stpa lna rna where stp1:
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1494
"steps0 (Suc 0, Bk # Bk\<up>(m) @ Oc # Oc # ires, Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stpa =
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1495
(13, Bk # Bk # Bk\<up>(lna) @ Oc # ires, Oc\<up>(Suc (Suc rs)) @ Bk\<up>(rna))" by blast
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1496
have "\<exists> stp ln rn. steps0 (13, Bk # Bk # Bk\<up>(lna) @ Oc # ires, Oc\<up>(Suc (Suc rs)) @ Bk\<up>(rna)) t_wcode_main stp =
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1497
(13 + t_twice_len, Bk # Bk # Bk\<up>(ln) @ Oc # ires, Oc\<up>(Suc (Suc (Suc (2 *rs)))) @ Bk\<up>(rn))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1498
using t_twice_append[of "Bk\<up>(lna) @ Oc # ires" "Suc rs" rna]
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1499
apply(erule_tac exE)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1500
apply(erule_tac exE)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1501
apply(erule_tac exE)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1502
apply(simp add: wcode_main_first_part_len)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1503
apply(rule_tac x = stp in exI, rule_tac x = "ln + lna" in exI,
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1504
rule_tac x = rn in exI)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1505
apply(simp add: t_wcode_main_def)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1506
apply(simp add: replicate_Suc[THEN sym] exp_add[THEN sym] del: replicate_Suc)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1507
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1508
from this obtain stpb lnb rnb where stp2:
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1509
"steps0 (13, Bk # Bk # Bk\<up>(lna) @ Oc # ires, Oc\<up>(Suc (Suc rs)) @ Bk\<up>(rna)) t_wcode_main stpb =
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1510
(13 + t_twice_len, Bk # Bk # Bk\<up>(lnb) @ Oc # ires, Oc\<up>(Suc (Suc (Suc (2 *rs)))) @ Bk\<up>(rnb))" by blast
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1511
have "\<exists>stp ln rn. steps0 (13 + t_twice_len, Bk # Bk # Bk\<up>(lnb) @ Oc # ires,
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1512
Oc\<up>(Suc (Suc (Suc (2 *rs)))) @ Bk\<up>(rnb)) t_wcode_main stp =
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1513
(Suc 0, Bk # Bk\<up>(ln) @ Oc # ires, Bk # Oc\<up>(Suc (Suc (Suc (2 *rs)))) @ Bk\<up>(rn))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1514
using wcode_jump1[of lnb "Oc # ires" "Suc rs" rnb]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1515
apply(erule_tac exE)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1516
apply(erule_tac exE)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1517
apply(erule_tac exE)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1518
apply(rule_tac x = stp in exI,
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1519
rule_tac x = ln in exI,
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1520
rule_tac x = rn in exI, simp add:wcode_main_first_part_len t_wcode_main_def)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1521
apply(subgoal_tac "Bk\<up>(lnb) @ Bk # Bk # Oc # ires = Bk # Bk # Bk\<up>(lnb) @ Oc # ires", simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1522
apply(simp add: replicate_Suc[THEN sym] exp_ind[THEN sym] del: replicate_Suc)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1523
apply(simp)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1524
apply(simp add: replicate_Suc[THEN sym] exp_ind del: replicate_Suc)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1525
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1526
from this obtain stpc lnc rnc where stp3:
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1527
"steps0 (13 + t_twice_len, Bk # Bk # Bk\<up>(lnb) @ Oc # ires,
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1528
Oc\<up>(Suc (Suc (Suc (2 *rs)))) @ Bk\<up>(rnb)) t_wcode_main stpc =
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1529
(Suc 0, Bk # Bk\<up>(lnc) @ Oc # ires, Bk # Oc\<up>(Suc (Suc (Suc (2 *rs)))) @ Bk\<up>(rnc))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1530
by blast
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1531
from stp1 stp2 stp3 show "?thesis"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1532
apply(rule_tac x = "stpa + stpb + stpc" in exI, rule_tac x = lnc in exI,
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1533
rule_tac x = rnc in exI)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1534
apply(simp add: steps_add)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1535
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1536
qed
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1537
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1538
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1539
(* Begin: fourtime_case*)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1540
fun wcode_on_left_moving_2_B :: "bin_inv_t"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1541
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1542
"wcode_on_left_moving_2_B ires rs (l, r) =
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1543
(\<exists> ml mr rn. l = Bk\<up>(ml) @ Oc # Bk # Oc # ires \<and>
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1544
r = Bk\<up>(mr) @ Oc\<up>(Suc rs) @ Bk\<up>(rn) \<and>
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1545
ml + mr > Suc 0 \<and> mr > 0)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1546
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1547
fun wcode_on_left_moving_2_O :: "bin_inv_t"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1548
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1549
"wcode_on_left_moving_2_O ires rs (l, r) =
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1550
(\<exists> ln rn. l = Bk # Oc # ires \<and>
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1551
r = Oc # Bk\<up>(ln) @ Bk # Bk # Oc\<up>(Suc rs) @ Bk\<up>(rn))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1552
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1553
fun wcode_on_left_moving_2 :: "bin_inv_t"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1554
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1555
"wcode_on_left_moving_2 ires rs (l, r) =
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1556
(wcode_on_left_moving_2_B ires rs (l, r) \<or>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1557
wcode_on_left_moving_2_O ires rs (l, r))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1558
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1559
fun wcode_on_checking_2 :: "bin_inv_t"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1560
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1561
"wcode_on_checking_2 ires rs (l, r) =
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1562
(\<exists> ln rn. l = Oc#ires \<and>
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1563
r = Bk # Oc # Bk\<up>(ln) @ Bk # Bk # Oc\<up>(Suc rs) @ Bk\<up>(rn))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1564
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1565
fun wcode_goon_checking :: "bin_inv_t"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1566
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1567
"wcode_goon_checking ires rs (l, r) =
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1568
(\<exists> ln rn. l = ires \<and>
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1569
r = Oc # Bk # Oc # Bk\<up>(ln) @ Bk # Bk # Oc\<up>(Suc rs) @ Bk\<up>(rn))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1570
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1571
fun wcode_right_move :: "bin_inv_t"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1572
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1573
"wcode_right_move ires rs (l, r) =
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1574
(\<exists> ln rn. l = Oc # ires \<and>
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1575
r = Bk # Oc # Bk\<up>(ln) @ Bk # Bk # Oc\<up>(Suc rs) @ Bk\<up>(rn))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1576
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1577
fun wcode_erase2 :: "bin_inv_t"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1578
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1579
"wcode_erase2 ires rs (l, r) =
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1580
(\<exists> ln rn. l = Bk # Oc # ires \<and>
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1581
tl r = Bk\<up>(ln) @ Bk # Bk # Oc\<up>(Suc rs) @ Bk\<up>(rn))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1582
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1583
fun wcode_on_right_moving_2 :: "bin_inv_t"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1584
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1585
"wcode_on_right_moving_2 ires rs (l, r) =
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1586
(\<exists> ml mr rn. l = Bk\<up>(ml) @ Oc # ires \<and>
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1587
r = Bk\<up>(mr) @ Oc\<up>(Suc rs) @ Bk\<up>(rn) \<and> ml + mr > Suc 0)"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1588
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1589
fun wcode_goon_right_moving_2 :: "bin_inv_t"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1590
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1591
"wcode_goon_right_moving_2 ires rs (l, r) =
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1592
(\<exists> ml mr ln rn. l = Oc\<up>(ml) @ Bk # Bk # Bk\<up>(ln) @ Oc # ires \<and>
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1593
r = Oc\<up>(mr) @ Bk\<up>(rn) \<and> ml + mr = Suc rs)"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1594
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1595
fun wcode_backto_standard_pos_2_B :: "bin_inv_t"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1596
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1597
"wcode_backto_standard_pos_2_B ires rs (l, r) =
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1598
(\<exists> ln rn. l = Bk # Bk\<up>(ln) @ Oc # ires \<and>
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1599
r = Bk # Oc\<up>(Suc (Suc rs)) @ Bk\<up>(rn))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1600
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1601
fun wcode_backto_standard_pos_2_O :: "bin_inv_t"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1602
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1603
"wcode_backto_standard_pos_2_O ires rs (l, r) =
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1604
(\<exists> ml mr ln rn. l = Oc\<up>(ml )@ Bk # Bk # Bk\<up>(ln) @ Oc # ires \<and>
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1605
r = Oc\<up>(mr) @ Bk\<up>(rn) \<and>
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1606
ml + mr = (Suc (Suc rs)) \<and> mr > 0)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1607
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1608
fun wcode_backto_standard_pos_2 :: "bin_inv_t"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1609
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1610
"wcode_backto_standard_pos_2 ires rs (l, r) =
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1611
(wcode_backto_standard_pos_2_O ires rs (l, r) \<or>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1612
wcode_backto_standard_pos_2_B ires rs (l, r))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1613
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1614
fun wcode_before_fourtimes :: "bin_inv_t"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1615
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1616
"wcode_before_fourtimes ires rs (l, r) =
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1617
(\<exists> ln rn. l = Bk # Bk # Bk\<up>(ln) @ Oc # ires \<and>
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1618
r = Oc\<up>(Suc (Suc rs)) @ Bk\<up>(rn))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1619
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1620
declare wcode_on_left_moving_2_B.simps[simp del] wcode_on_left_moving_2.simps[simp del]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1621
wcode_on_left_moving_2_O.simps[simp del] wcode_on_checking_2.simps[simp del]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1622
wcode_goon_checking.simps[simp del] wcode_right_move.simps[simp del]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1623
wcode_erase2.simps[simp del]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1624
wcode_on_right_moving_2.simps[simp del] wcode_goon_right_moving_2.simps[simp del]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1625
wcode_backto_standard_pos_2_B.simps[simp del] wcode_backto_standard_pos_2_O.simps[simp del]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1626
wcode_backto_standard_pos_2.simps[simp del]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1627
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1628
lemmas wcode_fourtimes_invs =
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1629
wcode_on_left_moving_2_B.simps wcode_on_left_moving_2.simps
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1630
wcode_on_left_moving_2_O.simps wcode_on_checking_2.simps
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1631
wcode_goon_checking.simps wcode_right_move.simps
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1632
wcode_erase2.simps
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1633
wcode_on_right_moving_2.simps wcode_goon_right_moving_2.simps
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1634
wcode_backto_standard_pos_2_B.simps wcode_backto_standard_pos_2_O.simps
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1635
wcode_backto_standard_pos_2.simps
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1636
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1637
fun wcode_fourtimes_case_inv :: "nat \<Rightarrow> bin_inv_t"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1638
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1639
"wcode_fourtimes_case_inv st ires rs (l, r) =
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1640
(if st = Suc 0 then wcode_on_left_moving_2 ires rs (l, r)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1641
else if st = Suc (Suc 0) then wcode_on_checking_2 ires rs (l, r)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1642
else if st = 7 then wcode_goon_checking ires rs (l, r)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1643
else if st = 8 then wcode_right_move ires rs (l, r)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1644
else if st = 9 then wcode_erase2 ires rs (l, r)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1645
else if st = 10 then wcode_on_right_moving_2 ires rs (l, r)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1646
else if st = 11 then wcode_goon_right_moving_2 ires rs (l, r)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1647
else if st = 12 then wcode_backto_standard_pos_2 ires rs (l, r)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1648
else if st = t_twice_len + 14 then wcode_before_fourtimes ires rs (l, r)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1649
else False)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1650
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1651
declare wcode_fourtimes_case_inv.simps[simp del]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1652
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1653
fun wcode_fourtimes_case_state :: "config \<Rightarrow> nat"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1654
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1655
"wcode_fourtimes_case_state (st, l, r) = 13 - st"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1656
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1657
fun wcode_fourtimes_case_step :: "config \<Rightarrow> nat"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1658
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1659
"wcode_fourtimes_case_step (st, l, r) =
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1660
(if st = Suc 0 then length l
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1661
else if st = 9 then
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1662
(if hd r = Oc then 1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1663
else 0)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1664
else if st = 10 then length r
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1665
else if st = 11 then length r
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1666
else if st = 12 then length l
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1667
else 0)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1668
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1669
fun wcode_fourtimes_case_measure :: "config \<Rightarrow> nat \<times> nat"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1670
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1671
"wcode_fourtimes_case_measure (st, l, r) =
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1672
(wcode_fourtimes_case_state (st, l, r),
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1673
wcode_fourtimes_case_step (st, l, r))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1674
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1675
definition wcode_fourtimes_case_le :: "(config \<times> config) set"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1676
where "wcode_fourtimes_case_le \<equiv> (inv_image lex_pair wcode_fourtimes_case_measure)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1677
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1678
lemma wf_wcode_fourtimes_case_le[intro]: "wf wcode_fourtimes_case_le"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1679
by(auto intro:wf_inv_image simp: wcode_fourtimes_case_le_def)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1680
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1681
lemma [simp]: "fetch t_wcode_main (Suc (Suc 0)) Bk = (L, 7)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1682
apply(simp add: t_wcode_main_def fetch.simps
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1683
t_wcode_main_first_part_def nth_of.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1684
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1685
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1686
lemma [simp]: "fetch t_wcode_main 7 Oc = (R, 8)"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1687
apply(subgoal_tac "7 = Suc 6")
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1688
apply(simp only: t_wcode_main_def fetch.simps
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1689
t_wcode_main_first_part_def nth_of.simps)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1690
apply(auto)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1691
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1692
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1693
lemma [simp]: "fetch t_wcode_main 8 Bk = (R, 9)"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1694
apply(subgoal_tac "8 = Suc 7")
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1695
apply(simp only: t_wcode_main_def fetch.simps
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1696
t_wcode_main_first_part_def nth_of.simps)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1697
apply(auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1698
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1699
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1700
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1701
lemma [simp]: "fetch t_wcode_main 9 Bk = (R, 10)"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1702
apply(subgoal_tac "9 = Suc 8")
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1703
apply(simp only: t_wcode_main_def fetch.simps
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1704
t_wcode_main_first_part_def nth_of.simps)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1705
apply(auto)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1706
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1707
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1708
lemma [simp]: "fetch t_wcode_main 9 Oc = (W0, 9)"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1709
apply(subgoal_tac "9 = Suc 8")
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1710
apply(simp only: t_wcode_main_def fetch.simps
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1711
t_wcode_main_first_part_def nth_of.simps)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1712
apply(auto)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1713
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1714
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1715
lemma [simp]: "fetch t_wcode_main 10 Bk = (R, 10)"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1716
apply(subgoal_tac "10 = Suc 9")
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1717
apply(simp only: t_wcode_main_def fetch.simps
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1718
t_wcode_main_first_part_def nth_of.simps)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1719
apply(auto)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1720
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1721
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1722
lemma [simp]: "fetch t_wcode_main 10 Oc = (R, 11)"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1723
apply(subgoal_tac "10 = Suc 9")
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1724
apply(simp only: t_wcode_main_def fetch.simps
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1725
t_wcode_main_first_part_def nth_of.simps)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1726
apply(auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1727
done
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1728
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1729
lemma [simp]: "fetch t_wcode_main 11 Bk = (W1, 12)"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1730
apply(subgoal_tac "11 = Suc 10")
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1731
apply(simp only: t_wcode_main_def fetch.simps
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1732
t_wcode_main_first_part_def nth_of.simps)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1733
apply(auto)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1734
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1735
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1736
lemma [simp]: "fetch t_wcode_main 11 Oc = (R, 11)"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1737
apply(subgoal_tac "11 = Suc 10")
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1738
apply(simp only: t_wcode_main_def fetch.simps
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1739
t_wcode_main_first_part_def nth_of.simps)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1740
apply(auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1741
done
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1742
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1743
lemma [simp]: "fetch t_wcode_main 12 Oc = (L, 12)"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1744
apply(subgoal_tac "12 = Suc 11")
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1745
apply(simp only: t_wcode_main_def fetch.simps
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1746
t_wcode_main_first_part_def nth_of.simps)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1747
apply(auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1748
done
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1749
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1750
lemma [simp]: "fetch t_wcode_main 12 Bk = (R, t_twice_len + 14)"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1751
apply(subgoal_tac "12 = Suc 11")
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1752
apply(simp only: t_wcode_main_def fetch.simps
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1753
t_wcode_main_first_part_def nth_of.simps)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1754
apply(auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1755
done
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1756
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1757
lemma [simp]: "wcode_on_left_moving_2 ires rs (b, []) = False"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1758
apply(auto simp: wcode_fourtimes_invs)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1759
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1760
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1761
lemma [simp]: "wcode_on_checking_2 ires rs (b, []) = False"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1762
apply(auto simp: wcode_fourtimes_invs)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1763
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1764
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1765
lemma [simp]: "wcode_goon_checking ires rs (b, []) = False"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1766
apply(auto simp: wcode_fourtimes_invs)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1767
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1768
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1769
lemma [simp]: "wcode_right_move ires rs (b, []) = False"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1770
apply(auto simp: wcode_fourtimes_invs)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1771
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1772
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1773
lemma [simp]: "wcode_erase2 ires rs (b, []) = False"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1774
apply(auto simp: wcode_fourtimes_invs)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1775
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1776
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1777
lemma [simp]: "wcode_on_right_moving_2 ires rs (b, []) = False"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1778
apply(auto simp: wcode_fourtimes_invs)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1779
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1780
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1781
lemma [simp]: "wcode_backto_standard_pos_2 ires rs (b, []) = False"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1782
apply(auto simp: wcode_fourtimes_invs)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1783
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1784
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1785
lemma [simp]: "wcode_on_left_moving_2 ires rs (b, Bk # list) \<Longrightarrow> b \<noteq> []"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1786
apply(simp add: wcode_fourtimes_invs, auto)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1787
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1788
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1789
lemma [simp]: "wcode_on_left_moving_2 ires rs (b, Bk # list) \<Longrightarrow> wcode_on_left_moving_2 ires rs (tl b, hd b # Bk # list)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1790
apply(simp only: wcode_fourtimes_invs)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1791
apply(erule_tac disjE)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1792
apply(erule_tac exE)+
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1793
apply(case_tac ml, simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1794
apply(rule_tac x = "mr - (Suc (Suc 0))" in exI, rule_tac x = rn in exI, simp)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1795
apply(case_tac mr, simp, case_tac nat, simp, simp add: exp_ind del: replicate_Suc)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1796
apply(rule_tac disjI1)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1797
apply(rule_tac x = nat in exI, rule_tac x = "Suc mr" in exI, rule_tac x = rn in exI,
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1798
simp add: replicate_Suc)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1799
apply(simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1800
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1801
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1802
lemma [simp]: "wcode_on_checking_2 ires rs (b, Bk # list) \<Longrightarrow> b \<noteq> []"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1803
apply(auto simp: wcode_fourtimes_invs)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1804
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1805
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1806
lemma [simp]: "wcode_on_checking_2 ires rs (b, Bk # list)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1807
\<Longrightarrow> wcode_goon_checking ires rs (tl b, hd b # Bk # list)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1808
apply(simp only: wcode_fourtimes_invs)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1809
apply(auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1810
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1811
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1812
lemma [simp]: "wcode_goon_checking ires rs (b, Bk # list) = False"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1813
apply(simp add: wcode_fourtimes_invs)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1814
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1815
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1816
lemma [simp]: " wcode_right_move ires rs (b, Bk # list) \<Longrightarrow> b\<noteq> []"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1817
apply(simp add: wcode_fourtimes_invs)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1818
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1819
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1820
lemma [simp]: "wcode_right_move ires rs (b, Bk # list) \<Longrightarrow> wcode_erase2 ires rs (Bk # b, list)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1821
apply(auto simp:wcode_fourtimes_invs )
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1822
apply(rule_tac x = ln in exI, rule_tac x = rn in exI, simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1823
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1824
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1825
lemma [simp]: "wcode_erase2 ires rs (b, Bk # list) \<Longrightarrow> b \<noteq> []"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1826
apply(auto simp: wcode_fourtimes_invs)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1827
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1828
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1829
lemma [simp]: "wcode_erase2 ires rs (b, Bk # list) \<Longrightarrow> wcode_on_right_moving_2 ires rs (Bk # b, list)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1830
apply(auto simp:wcode_fourtimes_invs )
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1831
apply(rule_tac x = "Suc (Suc 0)" in exI, simp add: exp_ind)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1832
apply(rule_tac x = "Suc (Suc ln)" in exI, simp add: exp_ind del: replicate_Suc)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1833
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1834
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1835
lemma [simp]: "wcode_on_right_moving_2 ires rs (b, Bk # list) \<Longrightarrow> b \<noteq> []"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1836
apply(auto simp:wcode_fourtimes_invs )
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1837
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1838
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1839
lemma [simp]: "wcode_on_right_moving_2 ires rs (b, Bk # list)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1840
\<Longrightarrow> wcode_on_right_moving_2 ires rs (Bk # b, list)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1841
apply(auto simp: wcode_fourtimes_invs)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1842
apply(rule_tac x = "Suc ml" in exI, simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1843
apply(rule_tac x = "mr - 1" in exI, case_tac mr,auto)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1844
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1845
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1846
lemma [simp]: "wcode_goon_right_moving_2 ires rs (b, Bk # list) \<Longrightarrow> b \<noteq> []"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1847
apply(auto simp: wcode_fourtimes_invs)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1848
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1849
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1850
lemma [simp]: "wcode_goon_right_moving_2 ires rs (b, Bk # list) \<Longrightarrow>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1851
wcode_backto_standard_pos_2 ires rs (b, Oc # list)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1852
apply(simp add: wcode_fourtimes_invs, auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1853
apply(rule_tac x = ml in exI, auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1854
apply(rule_tac x = "Suc 0" in exI, simp)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1855
apply(case_tac mr, simp_all)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1856
apply(rule_tac x = "rn - 1" in exI, simp)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1857
apply(case_tac rn, simp, simp)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1858
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1859
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1860
lemma [simp]: "wcode_backto_standard_pos_2 ires rs (b, Bk # list) \<Longrightarrow> b \<noteq> []"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1861
apply(simp add: wcode_fourtimes_invs, auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1862
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1863
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1864
lemma [simp]: "wcode_on_left_moving_2 ires rs (b, Oc # list) \<Longrightarrow> b \<noteq> []"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1865
apply(simp add: wcode_fourtimes_invs, auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1866
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1867
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1868
lemma [simp]: "wcode_on_left_moving_2 ires rs (b, Oc # list) \<Longrightarrow>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1869
wcode_on_checking_2 ires rs (tl b, hd b # Oc # list)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1870
apply(auto simp: wcode_fourtimes_invs)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1871
apply(case_tac [!] mr, simp_all)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1872
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1873
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1874
lemma [simp]: "wcode_goon_right_moving_2 ires rs (b, []) \<Longrightarrow> b \<noteq> []"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1875
apply(auto simp: wcode_fourtimes_invs)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1876
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1877
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1878
lemma [simp]: "wcode_goon_right_moving_2 ires rs (b, []) \<Longrightarrow>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1879
wcode_backto_standard_pos_2 ires rs (b, [Oc])"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1880
apply(simp only: wcode_fourtimes_invs)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1881
apply(erule_tac exE)+
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1882
apply(rule_tac disjI1)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1883
apply(rule_tac x = ml in exI, rule_tac x = "Suc 0" in exI,
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1884
rule_tac x = ln in exI, rule_tac x = rn in exI, simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1885
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1886
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1887
lemma "wcode_backto_standard_pos_2 ires rs (b, Bk # list)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1888
\<Longrightarrow> (\<exists>ln. b = Bk # Bk\<up>(ln) @ Oc # ires) \<and> (\<exists>rn. list = Oc\<up>(Suc (Suc rs)) @ Bk\<up>(rn))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1889
apply(auto simp: wcode_fourtimes_invs)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1890
apply(case_tac [!] mr, auto)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1891
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1892
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1893
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1894
lemma [simp]: "wcode_on_checking_2 ires rs (b, Oc # list) \<Longrightarrow> False"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1895
apply(simp add: wcode_fourtimes_invs)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1896
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1897
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1898
lemma [simp]: "wcode_goon_checking ires rs (b, Oc # list) \<Longrightarrow>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1899
(b = [] \<longrightarrow> wcode_right_move ires rs ([Oc], list)) \<and>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1900
(b \<noteq> [] \<longrightarrow> wcode_right_move ires rs (Oc # b, list))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1901
apply(simp only: wcode_fourtimes_invs)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1902
apply(erule_tac exE)+
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1903
apply(auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1904
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1905
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1906
lemma [simp]: "wcode_right_move ires rs (b, Oc # list) = False"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1907
apply(auto simp: wcode_fourtimes_invs)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1908
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1909
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1910
lemma [simp]: " wcode_erase2 ires rs (b, Oc # list) \<Longrightarrow> b \<noteq> []"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1911
apply(simp add: wcode_fourtimes_invs)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1912
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1913
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1914
lemma [simp]: "wcode_erase2 ires rs (b, Oc # list)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1915
\<Longrightarrow> wcode_erase2 ires rs (b, Bk # list)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1916
apply(auto simp: wcode_fourtimes_invs)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1917
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1918
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1919
lemma [simp]: "wcode_on_right_moving_2 ires rs (b, Oc # list) \<Longrightarrow> b \<noteq> []"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1920
apply(simp only: wcode_fourtimes_invs)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1921
apply(auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1922
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1923
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1924
lemma [simp]: "wcode_on_right_moving_2 ires rs (b, Oc # list)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1925
\<Longrightarrow> wcode_goon_right_moving_2 ires rs (Oc # b, list)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1926
apply(auto simp: wcode_fourtimes_invs)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1927
apply(case_tac mr, simp_all)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1928
apply(rule_tac x = "Suc 0" in exI, auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1929
apply(rule_tac x = "ml - 2" in exI)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1930
apply(case_tac ml, simp, case_tac nat, simp_all)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1931
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1932
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1933
lemma [simp]: "wcode_goon_right_moving_2 ires rs (b, Oc # list) \<Longrightarrow> b \<noteq> []"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1934
apply(simp only:wcode_fourtimes_invs, auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1935
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1936
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1937
lemma [simp]: "wcode_backto_standard_pos_2 ires rs (b, Bk # list)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1938
\<Longrightarrow> (\<exists>ln. b = Bk # Bk\<up>(ln) @ Oc # ires) \<and> (\<exists>rn. list = Oc\<up>(Suc (Suc rs)) @ Bk\<up>(rn))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1939
apply(simp add: wcode_fourtimes_invs, auto)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1940
apply(case_tac [!] mr, simp_all)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1941
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1942
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1943
lemma [simp]: "wcode_on_checking_2 ires rs (b, Oc # list) = False"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1944
apply(simp add: wcode_fourtimes_invs)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1945
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1946
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1947
lemma [simp]: "wcode_goon_right_moving_2 ires rs (b, Oc # list) \<Longrightarrow>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1948
wcode_goon_right_moving_2 ires rs (Oc # b, list)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1949
apply(simp only:wcode_fourtimes_invs, auto)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1950
apply(rule_tac x = "Suc ml" in exI, simp)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1951
apply(rule_tac x = "mr - 1" in exI)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1952
apply(case_tac mr, case_tac rn, auto)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1953
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1954
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1955
lemma [simp]: "wcode_backto_standard_pos_2 ires rs (b, Oc # list) \<Longrightarrow> b \<noteq> []"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1956
apply(simp only: wcode_fourtimes_invs, auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1957
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1958
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1959
lemma [simp]: "wcode_backto_standard_pos_2 ires rs (b, Oc # list)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1960
\<Longrightarrow> wcode_backto_standard_pos_2 ires rs (tl b, hd b # Oc # list)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1961
apply(simp only: wcode_fourtimes_invs)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1962
apply(erule_tac disjE)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1963
apply(erule_tac exE)+
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1964
apply(case_tac ml, auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1965
apply(rule_tac x = nat in exI, auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1966
apply(rule_tac x = "Suc mr" in exI, simp)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1967
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1968
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1969
lemma wcode_fourtimes_case_first_correctness:
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1970
shows "let P = (\<lambda> (st, l, r). st = t_twice_len + 14) in
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1971
let Q = (\<lambda> (st, l, r). wcode_fourtimes_case_inv st ires rs (l, r)) in
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1972
let f = (\<lambda> stp. steps0 (Suc 0, Bk # Bk\<up>(m) @ Oc # Bk # Oc # ires, Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stp) in
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1973
\<exists> n .P (f n) \<and> Q (f (n::nat))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1974
proof -
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1975
let ?P = "(\<lambda> (st, l, r). st = t_twice_len + 14)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1976
let ?Q = "(\<lambda> (st, l, r). wcode_fourtimes_case_inv st ires rs (l, r))"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1977
let ?f = "(\<lambda> stp. steps0 (Suc 0, Bk # Bk\<up>(m) @ Oc # Bk # Oc # ires, Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stp)"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1978
have "\<exists> n . ?P (?f n) \<and> ?Q (?f (n::nat))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1979
proof(rule_tac halt_lemma2)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1980
show "wf wcode_fourtimes_case_le"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1981
by auto
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1982
next
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1983
show "\<forall> na. \<not> ?P (?f na) \<and> ?Q (?f na) \<longrightarrow>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1984
?Q (?f (Suc na)) \<and> (?f (Suc na), ?f na) \<in> wcode_fourtimes_case_le"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1985
apply(rule_tac allI,
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1986
case_tac "steps0 (Suc 0, Bk # Bk\<up>(m) @ Oc # Bk # Oc # ires, Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main na", simp,
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1987
rule_tac impI)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1988
apply(simp add: step_red step.simps, case_tac c, simp, case_tac [2] aa, simp_all)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1989
apply(simp_all add: wcode_fourtimes_case_inv.simps
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1990
wcode_fourtimes_case_le_def lex_pair_def split: if_splits)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1991
apply(auto simp: wcode_backto_standard_pos_2.simps wcode_backto_standard_pos_2_O.simps
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1992
wcode_backto_standard_pos_2_B.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 1993
apply(case_tac mr, simp_all)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1994
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1995
next
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1996
show "?Q (?f 0)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1997
apply(simp add: steps.simps wcode_fourtimes_case_inv.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1998
apply(simp add: wcode_on_left_moving_2.simps wcode_on_left_moving_2_B.simps
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 1999
wcode_on_left_moving_2_O.simps)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2000
apply(rule_tac x = "Suc m" in exI, simp )
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2001
apply(rule_tac x ="Suc 0" in exI, auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2002
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2003
next
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2004
show "\<not> ?P (?f 0)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2005
apply(simp add: steps.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2006
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2007
qed
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2008
thus "?thesis"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2009
apply(erule_tac exE, simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2010
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2011
qed
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2012
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2013
definition t_fourtimes_len :: "nat"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2014
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2015
"t_fourtimes_len = (length t_fourtimes div 2)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2016
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2017
lemma t_fourtimes_len_gr: "t_fourtimes_len > 0"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2018
apply(simp add: t_fourtimes_len_def t_fourtimes_def mopup.simps t_fourtimes_compile_def)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2019
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2020
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2021
lemma [intro]: "rec_calc_rel (constn 4) [rs] 4"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2022
using prime_rel_exec_eq[of "constn 4" "[rs]" 4]
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2023
apply(subgoal_tac "primerec (constn 4) 1", auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2024
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2025
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2026
lemma [intro]: "rec_calc_rel rec_mult [rs, 4] (4 * rs)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2027
using prime_rel_exec_eq[of "rec_mult" "[rs, 4]" "4*rs"]
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2028
apply(subgoal_tac "primerec rec_mult 2", auto simp: numeral_2_eq_2)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2029
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2030
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2031
lemma t_fourtimes_correct:
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2032
"\<exists>stp ln rn. steps0 (Suc 0, Bk # Bk # ires, Oc\<up>(Suc rs) @ Bk\<up>(n))
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2033
(tm_of abc_fourtimes @ shift (mopup 1) (length (tm_of abc_fourtimes) div 2)) stp =
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2034
(0, Bk\<up>(ln) @ Bk # Bk # ires, Oc\<up>(Suc (4 * rs)) @ Bk\<up>(rn))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2035
proof(case_tac "rec_ci rec_fourtimes")
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2036
fix a b c
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2037
assume h: "rec_ci rec_fourtimes = (a, b, c)"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2038
have "\<exists>stp m l. steps0 (Suc 0, Bk # Bk # ires, <[rs]> @ Bk\<up>(n)) (tm_of abc_fourtimes @ shift (mopup 1)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2039
(length (tm_of abc_fourtimes) div 2)) stp = (0, Bk\<up>(m) @ Bk # Bk # ires, Oc\<up>(Suc (4*rs)) @ Bk\<up>(l))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2040
proof(rule_tac recursive_compile_to_tm_correct)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2041
show "rec_ci rec_fourtimes = (a, b, c)" by (simp add: h)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2042
next
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2043
show "rec_calc_rel rec_fourtimes [rs] (4 * rs)"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2044
apply(simp add: rec_fourtimes_def)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2045
apply(rule_tac rs = "[rs, 4]" in calc_cn, simp_all)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2046
apply(rule_tac allI, case_tac k, auto simp: mult_lemma)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2047
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2048
next
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2049
show "length [rs] = 1" by simp
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2050
next
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2051
show "layout_of (a [+] dummy_abc 1) = layout_of (a [+] dummy_abc 1)" by simp
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2052
next
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2053
show "tm_of abc_fourtimes = tm_of (a [+] dummy_abc 1)"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2054
using h
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2055
apply(simp add: abc_fourtimes_def)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2056
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2057
qed
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2058
thus "?thesis"
139
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2059
apply(simp add: tape_of_nl_abv tape_of_nat_list.simps tape_of_nat_abv)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2060
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2061
qed
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2062
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2063
lemma wf_fourtimes[intro]: "tm_wf (t_fourtimes_compile, 0)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2064
apply(simp only: t_fourtimes_compile_def)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2065
apply(rule_tac t_compiled_correct)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2066
apply(simp_all add: abc_twice_def)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2067
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2068
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2069
lemma t_fourtimes_change_term_state:
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2070
"\<exists> stp ln rn. steps0 (Suc 0, Bk # Bk # ires, Oc\<up>(Suc rs) @ Bk\<up>(n)) t_fourtimes stp
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2071
= (Suc t_fourtimes_len, Bk\<up>(ln) @ Bk # Bk # ires, Oc\<up>(Suc (4 * rs)) @ Bk\<up>(rn))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2072
proof -
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2073
have "\<exists>stp ln rn. steps0 (Suc 0, Bk # Bk # ires, Oc\<up>(Suc rs) @ Bk\<up>(n))
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2074
(tm_of abc_fourtimes @ shift (mopup 1) ((length (tm_of abc_fourtimes) div 2))) stp =
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2075
(0, Bk\<up>(ln) @ Bk # Bk # ires, Oc\<up>(Suc (4 * rs)) @ Bk\<up>(rn))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2076
by(rule_tac t_fourtimes_correct)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2077
then obtain stp ln rn where
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2078
"steps0 (Suc 0, Bk # Bk # ires, Oc\<up>(Suc rs) @ Bk\<up>(n))
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2079
(tm_of abc_fourtimes @ shift (mopup 1) ((length (tm_of abc_fourtimes) div 2))) stp =
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2080
(0, Bk\<up>(ln) @ Bk # Bk # ires, Oc\<up>(Suc (4 * rs)) @ Bk\<up>(rn))" by blast
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2081
hence "\<exists> stp. steps0 (Suc 0, Bk # Bk # ires, Oc\<up>(Suc rs) @ Bk\<up>(n))
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2082
(adjust t_fourtimes_compile) stp
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2083
= (Suc (length t_fourtimes_compile div 2), Bk\<up>(ln) @ Bk # Bk # ires, Oc\<up>(Suc (4 * rs)) @ Bk\<up>(rn))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2084
apply(rule_tac stp = stp in adjust_halt_eq)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2085
apply(simp add: t_fourtimes_compile_def, auto)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2086
done
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2087
then obtain stpb where
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2088
"steps0 (Suc 0, Bk # Bk # ires, Oc\<up>(Suc rs) @ Bk\<up>(n))
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2089
(adjust t_fourtimes_compile) stpb
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2090
= (Suc (length t_fourtimes_compile div 2), Bk\<up>(ln) @ Bk # Bk # ires, Oc\<up>(Suc (4 * rs)) @ Bk\<up>(rn))" ..
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2091
thus "?thesis"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2092
apply(simp add: t_fourtimes_def t_fourtimes_len_def)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2093
by metis
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2094
qed
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2095
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2096
lemma [intro]: "length t_twice mod 2 = 0"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2097
apply(auto simp: t_twice_def t_twice_compile_def)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2098
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2099
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2100
lemma t_fourtimes_append_pre:
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2101
"steps0 (Suc 0, Bk # Bk # ires, Oc\<up>(Suc rs) @ Bk\<up>(n)) t_fourtimes stp
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2102
= (Suc t_fourtimes_len, Bk\<up>(ln) @ Bk # Bk # ires, Oc\<up>(Suc (4 * rs)) @ Bk\<up>(rn))
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2103
\<Longrightarrow> steps0 (Suc 0 + length (t_wcode_main_first_part @
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2104
shift t_twice (length t_wcode_main_first_part div 2) @ [(L, 1), (L, 1)]) div 2,
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2105
Bk # Bk # ires, Oc\<up>(Suc rs) @ Bk\<up>(n))
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2106
((t_wcode_main_first_part @
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2107
shift t_twice (length t_wcode_main_first_part div 2) @ [(L, 1), (L, 1)]) @
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2108
shift t_fourtimes (length (t_wcode_main_first_part @
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2109
shift t_twice (length t_wcode_main_first_part div 2) @ [(L, 1), (L, 1)]) div 2) @ ([(L, 1), (L, 1)])) stp
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2110
= ((Suc t_fourtimes_len) + length (t_wcode_main_first_part @
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2111
shift t_twice (length t_wcode_main_first_part div 2) @ [(L, 1), (L, 1)]) div 2,
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2112
Bk\<up>(ln) @ Bk # Bk # ires, Oc\<up>(Suc (4 * rs)) @ Bk\<up>(rn))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2113
apply(rule_tac tm_append_shift_append_steps, simp_all)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2114
apply(auto simp: t_wcode_main_first_part_def)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2115
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2116
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2117
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2118
lemma [simp]: "length t_wcode_main_first_part = 24"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2119
apply(simp add: t_wcode_main_first_part_def)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2120
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2121
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2122
lemma [simp]: "(26 + length t_twice) div 2 = (length t_twice) div 2 + 13"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2123
apply(simp add: t_twice_def t_twice_def)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2124
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2125
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2126
lemma [simp]: "((26 + length (shift t_twice 12)) div 2)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2127
= (length (shift t_twice 12) div 2 + 13)"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2128
apply(simp add: t_twice_def)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2129
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2130
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2131
lemma [simp]: "t_twice_len + 14 = 14 + length (shift t_twice 12) div 2"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2132
apply(simp add: t_twice_def t_twice_len_def)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2133
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2134
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2135
lemma t_fourtimes_append:
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2136
"\<exists> stp ln rn.
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2137
steps0 (Suc 0 + length (t_wcode_main_first_part @ shift t_twice
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2138
(length t_wcode_main_first_part div 2) @ [(L, 1), (L, 1)]) div 2,
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2139
Bk # Bk # ires, Oc\<up>(Suc rs) @ Bk\<up>(n))
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2140
((t_wcode_main_first_part @ shift t_twice (length t_wcode_main_first_part div 2) @
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2141
[(L, 1), (L, 1)]) @ shift t_fourtimes (t_twice_len + 13) @ [(L, 1), (L, 1)]) stp
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2142
= (Suc t_fourtimes_len + length (t_wcode_main_first_part @ shift t_twice
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2143
(length t_wcode_main_first_part div 2) @ [(L, 1), (L, 1)]) div 2, Bk\<up>(ln) @ Bk # Bk # ires,
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2144
Oc\<up>(Suc (4 * rs)) @ Bk\<up>(rn))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2145
using t_fourtimes_change_term_state[of ires rs n]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2146
apply(erule_tac exE)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2147
apply(erule_tac exE)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2148
apply(erule_tac exE)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2149
apply(drule_tac t_fourtimes_append_pre)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2150
apply(rule_tac x = stp in exI, rule_tac x = ln in exI, rule_tac x = rn in exI)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2151
apply(simp add: t_twice_len_def)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2152
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2153
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2154
lemma t_wcode_main_len: "length t_wcode_main = length t_twice + length t_fourtimes + 28"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2155
apply(simp add: t_wcode_main_def)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2156
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2157
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2158
lemma even_twice_len: "length t_twice mod 2 = 0"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2159
apply(auto simp: t_twice_def t_twice_compile_def)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2160
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2161
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2162
lemma even_fourtimes_len: "length t_fourtimes mod 2 = 0"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2163
apply(auto simp: t_fourtimes_def t_fourtimes_compile_def)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2164
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2165
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2166
lemma [simp]: "2 * (length t_twice div 2) = length t_twice"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2167
using even_twice_len
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2168
by arith
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2169
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2170
lemma [simp]: "2 * (length t_fourtimes div 2) = length t_fourtimes"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2171
using even_fourtimes_len
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2172
by arith
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2173
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2174
lemma [simp]: "fetch t_wcode_main (14 + length t_twice div 2 + t_fourtimes_len) Oc
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2175
= (L, Suc 0)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2176
apply(subgoal_tac "14 = Suc 13")
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2177
apply(simp only: fetch.simps add_Suc nth_of.simps t_wcode_main_def)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2178
apply(simp add:length_append length_shift Parity.two_times_even_div_two even_twice_len t_fourtimes_len_def)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2179
by arith
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2180
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2181
lemma [simp]: "fetch t_wcode_main (14 + length t_twice div 2 + t_fourtimes_len) Bk
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2182
= (L, Suc 0)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2183
apply(subgoal_tac "14 = Suc 13")
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2184
apply(simp only: fetch.simps add_Suc nth_of.simps t_wcode_main_def)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2185
apply(simp add:length_append length_shift Parity.two_times_even_div_two even_twice_len t_fourtimes_len_def nth_append)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2186
by arith
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2187
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2188
lemma [simp]: "fetch t_wcode_main (14 + length t_twice div 2 + t_fourtimes_len) b
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2189
= (L, Suc 0)"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2190
apply(case_tac b, simp_all)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2191
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2192
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2193
lemma wcode_jump2:
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2194
"\<exists> stp ln rn. steps0 (t_twice_len + 14 + t_fourtimes_len
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2195
, Bk # Bk # Bk\<up>(lnb) @ Oc # ires, Oc\<up>(Suc (4 * rs + 4)) @ Bk\<up>(rnb)) t_wcode_main stp =
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2196
(Suc 0, Bk # Bk\<up>(ln) @ Oc # ires, Bk # Oc\<up>(Suc (4 * rs + 4)) @ Bk\<up>(rn))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2197
apply(rule_tac x = "Suc 0" in exI)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2198
apply(simp add: steps.simps)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2199
apply(rule_tac x = lnb in exI, rule_tac x = rnb in exI)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2200
apply(simp add: step.simps)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2201
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2202
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2203
lemma wcode_fourtimes_case:
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2204
shows "\<exists>stp ln rn.
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2205
steps0 (Suc 0, Bk # Bk\<up>(m) @ Oc # Bk # Oc # ires, Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stp =
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2206
(Suc 0, Bk # Bk\<up>(ln) @ Oc # ires, Bk # Oc\<up>(Suc (4*rs + 4)) @ Bk\<up>(rn))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2207
proof -
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2208
have "\<exists>stp ln rn.
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2209
steps0 (Suc 0, Bk # Bk\<up>(m) @ Oc # Bk # Oc # ires, Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stp =
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2210
(t_twice_len + 14, Bk # Bk # Bk\<up>(ln) @ Oc # ires, Oc\<up>(Suc (rs + 1)) @ Bk\<up>(rn))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2211
using wcode_fourtimes_case_first_correctness[of ires rs m n]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2212
apply(simp add: wcode_fourtimes_case_inv.simps, auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2213
apply(rule_tac x = na in exI, rule_tac x = ln in exI,
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2214
rule_tac x = rn in exI)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2215
apply(simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2216
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2217
from this obtain stpa lna rna where stp1:
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2218
"steps0 (Suc 0, Bk # Bk\<up>(m) @ Oc # Bk # Oc # ires, Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stpa =
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2219
(t_twice_len + 14, Bk # Bk # Bk\<up>(lna) @ Oc # ires, Oc\<up>(Suc (rs + 1)) @ Bk\<up>(rna))" by blast
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2220
have "\<exists>stp ln rn. steps0 (t_twice_len + 14, Bk # Bk # Bk\<up>(lna) @ Oc # ires, Oc\<up>(Suc (rs + 1)) @ Bk\<up>(rna))
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2221
t_wcode_main stp =
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2222
(t_twice_len + 14 + t_fourtimes_len, Bk # Bk # Bk\<up>(ln) @ Oc # ires, Oc\<up>(Suc (4*rs + 4)) @ Bk\<up>(rn))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2223
using t_fourtimes_append[of " Bk\<up>(lna) @ Oc # ires" "rs + 1" rna]
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2224
apply(erule_tac exE)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2225
apply(erule_tac exE)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2226
apply(erule_tac exE)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2227
apply(simp add: t_wcode_main_def)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2228
apply(rule_tac x = stp in exI,
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2229
rule_tac x = "ln + lna" in exI,
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2230
rule_tac x = rn in exI, simp)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2231
apply(simp add: replicate_Suc[THEN sym] exp_add[THEN sym] del: replicate_Suc)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2232
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2233
from this obtain stpb lnb rnb where stp2:
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2234
"steps0 (t_twice_len + 14, Bk # Bk # Bk\<up>(lna) @ Oc # ires, Oc\<up>(Suc (rs + 1)) @ Bk\<up>(rna))
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2235
t_wcode_main stpb =
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2236
(t_twice_len + 14 + t_fourtimes_len, Bk # Bk # Bk\<up>(lnb) @ Oc # ires, Oc\<up>(Suc (4*rs + 4)) @ Bk\<up>(rnb))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2237
by blast
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2238
have "\<exists>stp ln rn. steps0 (t_twice_len + 14 + t_fourtimes_len,
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2239
Bk # Bk # Bk\<up>(lnb) @ Oc # ires, Oc\<up>(Suc (4*rs + 4)) @ Bk\<up>(rnb))
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2240
t_wcode_main stp =
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2241
(Suc 0, Bk # Bk\<up>(ln) @ Oc # ires, Bk # Oc\<up>(Suc (4*rs + 4)) @ Bk\<up>(rn))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2242
apply(rule wcode_jump2)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2243
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2244
from this obtain stpc lnc rnc where stp3:
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2245
"steps0 (t_twice_len + 14 + t_fourtimes_len,
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2246
Bk # Bk # Bk\<up>(lnb) @ Oc # ires, Oc\<up>(Suc (4*rs + 4)) @ Bk\<up>(rnb))
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2247
t_wcode_main stpc =
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2248
(Suc 0, Bk # Bk\<up>(lnc) @ Oc # ires, Bk # Oc\<up>(Suc (4*rs + 4)) @ Bk\<up>(rnc))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2249
by blast
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2250
from stp1 stp2 stp3 show "?thesis"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2251
apply(rule_tac x = "stpa + stpb + stpc" in exI,
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2252
rule_tac x = lnc in exI, rule_tac x = rnc in exI)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2253
apply(simp add: steps_add)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2254
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2255
qed
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2256
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2257
(**********************************************************)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2258
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2259
fun wcode_on_left_moving_3_B :: "bin_inv_t"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2260
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2261
"wcode_on_left_moving_3_B ires rs (l, r) =
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2262
(\<exists> ml mr rn. l = Bk\<up>(ml) @ Oc # Bk # Bk # ires \<and>
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2263
r = Bk\<up>(mr) @ Oc\<up>(Suc rs) @ Bk\<up>(rn) \<and>
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2264
ml + mr > Suc 0 \<and> mr > 0 )"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2265
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2266
fun wcode_on_left_moving_3_O :: "bin_inv_t"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2267
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2268
"wcode_on_left_moving_3_O ires rs (l, r) =
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2269
(\<exists> ln rn. l = Bk # Bk # ires \<and>
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2270
r = Oc # Bk\<up>(ln) @ Bk # Bk # Oc\<up>(Suc rs) @ Bk\<up>(rn))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2271
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2272
fun wcode_on_left_moving_3 :: "bin_inv_t"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2273
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2274
"wcode_on_left_moving_3 ires rs (l, r) =
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2275
(wcode_on_left_moving_3_B ires rs (l, r) \<or>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2276
wcode_on_left_moving_3_O ires rs (l, r))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2277
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2278
fun wcode_on_checking_3 :: "bin_inv_t"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2279
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2280
"wcode_on_checking_3 ires rs (l, r) =
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2281
(\<exists> ln rn. l = Bk # ires \<and>
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2282
r = Bk # Oc # Bk\<up>(ln) @ Bk # Bk # Oc\<up>(Suc rs) @ Bk\<up>(rn))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2283
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2284
fun wcode_goon_checking_3 :: "bin_inv_t"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2285
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2286
"wcode_goon_checking_3 ires rs (l, r) =
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2287
(\<exists> ln rn. l = ires \<and>
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2288
r = Bk # Bk # Oc # Bk\<up>(ln) @ Bk # Bk # Oc\<up>(Suc rs) @ Bk\<up>(rn))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2289
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2290
fun wcode_stop :: "bin_inv_t"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2291
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2292
"wcode_stop ires rs (l, r) =
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2293
(\<exists> ln rn. l = Bk # ires \<and>
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2294
r = Bk # Oc # Bk\<up>(ln) @ Bk # Bk # Oc\<up>(Suc rs) @ Bk\<up>(rn))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2295
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2296
fun wcode_halt_case_inv :: "nat \<Rightarrow> bin_inv_t"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2297
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2298
"wcode_halt_case_inv st ires rs (l, r) =
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2299
(if st = 0 then wcode_stop ires rs (l, r)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2300
else if st = Suc 0 then wcode_on_left_moving_3 ires rs (l, r)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2301
else if st = Suc (Suc 0) then wcode_on_checking_3 ires rs (l, r)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2302
else if st = 7 then wcode_goon_checking_3 ires rs (l, r)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2303
else False)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2304
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2305
fun wcode_halt_case_state :: "config \<Rightarrow> nat"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2306
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2307
"wcode_halt_case_state (st, l, r) =
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2308
(if st = 1 then 5
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2309
else if st = Suc (Suc 0) then 4
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2310
else if st = 7 then 3
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2311
else 0)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2312
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2313
fun wcode_halt_case_step :: "config \<Rightarrow> nat"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2314
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2315
"wcode_halt_case_step (st, l, r) =
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2316
(if st = 1 then length l
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2317
else 0)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2318
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2319
fun wcode_halt_case_measure :: "config \<Rightarrow> nat \<times> nat"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2320
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2321
"wcode_halt_case_measure (st, l, r) =
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2322
(wcode_halt_case_state (st, l, r),
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2323
wcode_halt_case_step (st, l, r))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2324
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2325
definition wcode_halt_case_le :: "(config \<times> config) set"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2326
where "wcode_halt_case_le \<equiv> (inv_image lex_pair wcode_halt_case_measure)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2327
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2328
lemma wf_wcode_halt_case_le[intro]: "wf wcode_halt_case_le"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2329
by(auto intro:wf_inv_image simp: wcode_halt_case_le_def)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2330
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2331
declare wcode_on_left_moving_3_B.simps[simp del] wcode_on_left_moving_3_O.simps[simp del]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2332
wcode_on_checking_3.simps[simp del] wcode_goon_checking_3.simps[simp del]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2333
wcode_on_left_moving_3.simps[simp del] wcode_stop.simps[simp del]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2334
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2335
lemmas wcode_halt_invs =
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2336
wcode_on_left_moving_3_B.simps wcode_on_left_moving_3_O.simps
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2337
wcode_on_checking_3.simps wcode_goon_checking_3.simps
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2338
wcode_on_left_moving_3.simps wcode_stop.simps
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2339
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2340
lemma [simp]: "fetch t_wcode_main 7 Bk = (R, 0)"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2341
apply(subgoal_tac "7 = Suc 6")
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2342
apply(simp only: fetch.simps t_wcode_main_def nth_append nth_of.simps
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2343
t_wcode_main_first_part_def)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2344
apply(auto)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2345
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2346
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2347
lemma [simp]: "wcode_on_left_moving_3 ires rs (b, []) = False"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2348
apply(simp only: wcode_halt_invs)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2349
apply(simp)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2350
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2351
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2352
lemma [simp]: "wcode_on_checking_3 ires rs (b, []) = False"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2353
apply(simp add: wcode_halt_invs)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2354
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2355
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2356
lemma [simp]: "wcode_goon_checking_3 ires rs (b, []) = False"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2357
apply(simp add: wcode_halt_invs)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2358
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2359
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2360
lemma [simp]: "wcode_on_left_moving_3 ires rs (b, Bk # list)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2361
\<Longrightarrow> wcode_on_left_moving_3 ires rs (tl b, hd b # Bk # list)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2362
apply(simp only: wcode_halt_invs)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2363
apply(erule_tac disjE)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2364
apply(erule_tac exE)+
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2365
apply(case_tac ml, simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2366
apply(rule_tac x = "mr - 2" in exI, rule_tac x = rn in exI)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2367
apply(case_tac mr, simp, simp add: exp_ind del: replicate_Suc)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2368
apply(case_tac nat, simp, simp add: exp_ind del: replicate_Suc)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2369
apply(rule_tac disjI1)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2370
apply(rule_tac x = nat in exI, rule_tac x = "Suc mr" in exI,
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2371
rule_tac x = rn in exI, simp)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2372
apply(simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2373
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2374
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2375
lemma [simp]: "wcode_goon_checking_3 ires rs (b, Bk # list) \<Longrightarrow>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2376
(b = [] \<longrightarrow> wcode_stop ires rs ([Bk], list)) \<and>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2377
(b \<noteq> [] \<longrightarrow> wcode_stop ires rs (Bk # b, list))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2378
apply(auto simp: wcode_halt_invs)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2379
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2380
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2381
lemma [simp]: "wcode_on_left_moving_3 ires rs (b, Oc # list) \<Longrightarrow> b \<noteq> []"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2382
apply(auto simp: wcode_halt_invs)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2383
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2384
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2385
lemma [simp]: "wcode_on_left_moving_3 ires rs (b, Oc # list) \<Longrightarrow>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2386
wcode_on_checking_3 ires rs (tl b, hd b # Oc # list)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2387
apply(simp add:wcode_halt_invs, auto)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2388
apply(case_tac [!] mr, simp_all)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2389
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2390
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2391
lemma [simp]: "wcode_on_checking_3 ires rs (b, Oc # list) = False"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2392
apply(auto simp: wcode_halt_invs)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2393
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2394
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2395
lemma [simp]: "wcode_on_left_moving_3 ires rs (b, Bk # list) \<Longrightarrow> b \<noteq> []"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2396
apply(simp add: wcode_halt_invs, auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2397
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2398
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2399
lemma [simp]: "wcode_on_checking_3 ires rs (b, Bk # list) \<Longrightarrow> b \<noteq> []"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2400
apply(auto simp: wcode_halt_invs)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2401
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2402
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2403
lemma [simp]: "wcode_on_checking_3 ires rs (b, Bk # list) \<Longrightarrow>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2404
wcode_goon_checking_3 ires rs (tl b, hd b # Bk # list)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2405
apply(auto simp: wcode_halt_invs)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2406
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2407
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2408
lemma [simp]: "wcode_goon_checking_3 ires rs (b, Oc # list) = False"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2409
apply(simp add: wcode_goon_checking_3.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2410
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2411
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2412
lemma t_halt_case_correctness:
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2413
shows "let P = (\<lambda> (st, l, r). st = 0) in
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2414
let Q = (\<lambda> (st, l, r). wcode_halt_case_inv st ires rs (l, r)) in
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2415
let f = (\<lambda> stp. steps0 (Suc 0, Bk # Bk\<up>(m) @ Oc # Bk # Bk # ires, Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stp) in
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2416
\<exists> n .P (f n) \<and> Q (f (n::nat))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2417
proof -
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2418
let ?P = "(\<lambda> (st, l, r). st = 0)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2419
let ?Q = "(\<lambda> (st, l, r). wcode_halt_case_inv st ires rs (l, r))"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2420
let ?f = "(\<lambda> stp. steps0 (Suc 0, Bk # Bk\<up>(m) @ Oc # Bk # Bk # ires, Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stp)"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2421
have "\<exists> n. ?P (?f n) \<and> ?Q (?f (n::nat))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2422
proof(rule_tac halt_lemma2)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2423
show "wf wcode_halt_case_le" by auto
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2424
next
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2425
show "\<forall> na. \<not> ?P (?f na) \<and> ?Q (?f na) \<longrightarrow>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2426
?Q (?f (Suc na)) \<and> (?f (Suc na), ?f na) \<in> wcode_halt_case_le"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2427
apply(rule_tac allI, rule_tac impI, case_tac "?f na")
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2428
apply(simp add: step_red step.simps)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2429
apply(case_tac c, simp, case_tac [2] aa)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2430
apply(simp_all split: if_splits add: wcode_halt_case_le_def lex_pair_def)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2431
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2432
next
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2433
show "?Q (?f 0)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2434
apply(simp add: steps.simps wcode_halt_invs)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2435
apply(rule_tac x = "Suc m" in exI, simp)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2436
apply(rule_tac x = "Suc 0" in exI, auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2437
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2438
next
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2439
show "\<not> ?P (?f 0)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2440
apply(simp add: steps.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2441
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2442
qed
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2443
thus "?thesis"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2444
apply(auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2445
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2446
qed
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2447
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2448
declare wcode_halt_case_inv.simps[simp del]
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2449
lemma [intro]: "\<exists> xs. (<rev list @ [aa::nat]> :: cell list) = Oc # xs"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2450
apply(case_tac "rev list", simp)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2451
apply(simp add: tape_of_nl_cons)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2452
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2453
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2454
lemma wcode_halt_case:
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2455
"\<exists>stp ln rn. steps0 (Suc 0, Bk # Bk\<up>(m) @ Oc # Bk # Bk # ires, Bk # Oc\<up>(Suc rs) @ Bk\<up>(n))
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2456
t_wcode_main stp = (0, Bk # ires, Bk # Oc # Bk\<up>(ln) @ Bk # Bk # Oc\<up>(Suc rs) @ Bk\<up>(rn))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2457
using t_halt_case_correctness[of ires rs m n]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2458
apply(simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2459
apply(erule_tac exE)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2460
apply(case_tac "steps0 (Suc 0, Bk # Bk\<up>(m) @ Oc # Bk # Bk # ires,
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2461
Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main na")
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2462
apply(auto simp: wcode_halt_case_inv.simps wcode_stop.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2463
apply(rule_tac x = na in exI, rule_tac x = ln in exI,
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2464
rule_tac x = rn in exI, simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2465
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2466
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2467
lemma bl_bin_one: "bl_bin [Oc] = Suc 0"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2468
apply(simp add: bl_bin.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2469
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2470
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2471
lemma [simp]: "bl_bin [Oc] = 1"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2472
apply(simp add: bl_bin.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2473
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2474
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2475
lemma [intro]: "2 * 2 ^ a = Suc (Suc (2 * bl_bin (Oc \<up> a)))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2476
apply(induct a, auto simp: bl_bin.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2477
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2478
declare replicate_Suc[simp del]
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2479
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2480
lemma t_wcode_main_lemma_pre:
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2481
"\<lbrakk>args \<noteq> []; lm = <args::nat list>\<rbrakk> \<Longrightarrow>
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2482
\<exists> stp ln rn. steps0 (Suc 0, Bk # Bk\<up>(m) @ rev lm @ Bk # Bk # ires, Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2483
stp
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2484
= (0, Bk # ires, Bk # Oc # Bk\<up>(ln) @ Bk # Bk # Oc\<up>(bl_bin lm + rs * 2^(length lm - 1) ) @ Bk\<up>(rn))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2485
proof(induct "length args" arbitrary: args lm rs m n, simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2486
fix x args lm rs m n
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2487
assume ind:
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2488
"\<And>args lm rs m n.
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2489
\<lbrakk>x = length args; (args::nat list) \<noteq> []; lm = <args>\<rbrakk>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2490
\<Longrightarrow> \<exists>stp ln rn.
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2491
steps0 (Suc 0, Bk # Bk\<up>(m) @ rev lm @ Bk # Bk # ires, Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stp =
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2492
(0, Bk # ires, Bk # Oc # Bk\<up>(ln) @ Bk # Bk # Oc\<up>(bl_bin lm + rs * 2 ^ (length lm - 1)) @ Bk\<up>(rn))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2493
and h: "Suc x = length args" "(args::nat list) \<noteq> []" "lm = <args>"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2494
from h have "\<exists> (a::nat) xs. args = xs @ [a]"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2495
apply(rule_tac x = "last args" in exI)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2496
apply(rule_tac x = "butlast args" in exI, auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2497
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2498
from this obtain a xs where "args = xs @ [a]" by blast
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2499
from h and this show
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2500
"\<exists>stp ln rn.
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2501
steps0 (Suc 0, Bk # Bk\<up>(m) @ rev lm @ Bk # Bk # ires, Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stp =
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2502
(0, Bk # ires, Bk # Oc # Bk\<up>(ln) @ Bk # Bk # Oc\<up>(bl_bin lm + rs * 2 ^ (length lm - 1)) @ Bk\<up>(rn))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2503
proof(case_tac "xs::nat list", simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2504
show "\<exists>stp ln rn.
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2505
steps0 (Suc 0, Bk # Bk \<up> m @ Oc \<up> Suc a @ Bk # Bk # ires, Bk # Oc \<up> Suc rs @ Bk \<up> n) t_wcode_main stp =
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2506
(0, Bk # ires, Bk # Oc # Bk \<up> ln @ Bk # Bk # Oc \<up> (bl_bin (Oc \<up> Suc a) + rs * 2 ^ a) @ Bk \<up> rn)"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2507
proof(induct "a" arbitrary: m n rs ires, simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2508
fix m n rs ires
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2509
show "\<exists>stp ln rn.
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2510
steps0 (Suc 0, Bk # Bk \<up> m @ Oc # Bk # Bk # ires, Bk # Oc \<up> Suc rs @ Bk \<up> n) t_wcode_main stp =
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2511
(0, Bk # ires, Bk # Oc # Bk \<up> ln @ Bk # Bk # Oc \<up> Suc rs @ Bk \<up> rn)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2512
apply(rule_tac wcode_halt_case)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2513
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2514
next
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2515
fix a m n rs ires
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2516
assume ind2:
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2517
"\<And>m n rs ires.
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2518
\<exists>stp ln rn.
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2519
steps0 (Suc 0, Bk # Bk \<up> m @ Oc \<up> Suc a @ Bk # Bk # ires, Bk # Oc \<up> Suc rs @ Bk \<up> n) t_wcode_main stp =
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2520
(0, Bk # ires, Bk # Oc # Bk \<up> ln @ Bk # Bk # Oc \<up> (bl_bin (Oc \<up> Suc a) + rs * 2 ^ a) @ Bk \<up> rn)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2521
show " \<exists>stp ln rn.
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2522
steps0 (Suc 0, Bk # Bk \<up> m @ Oc \<up> Suc (Suc a) @ Bk # Bk # ires, Bk # Oc \<up> Suc rs @ Bk \<up> n) t_wcode_main stp =
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2523
(0, Bk # ires, Bk # Oc # Bk \<up> ln @ Bk # Bk # Oc \<up> (bl_bin (Oc \<up> Suc (Suc a)) + rs * 2 ^ Suc a) @ Bk \<up> rn)"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2524
proof -
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2525
have "\<exists>stp ln rn.
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2526
steps0 (Suc 0, Bk # Bk\<up>(m) @ rev (<Suc a>) @ Bk # Bk # ires, Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stp =
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2527
(Suc 0, Bk # Bk\<up>(ln) @ rev (<a>) @ Bk # Bk # ires, Bk # Oc\<up>(Suc (2 * rs + 2)) @ Bk\<up>(rn))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2528
apply(simp add: tape_of_nat)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2529
using wcode_double_case[of m "Oc\<up>(a) @ Bk # Bk # ires" rs n]
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2530
apply(simp add: replicate_Suc)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2531
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2532
from this obtain stpa lna rna where stp1:
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2533
"steps0 (Suc 0, Bk # Bk\<up>(m) @ rev (<Suc a>) @ Bk # Bk # ires, Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stpa =
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2534
(Suc 0, Bk # Bk\<up>(lna) @ rev (<a>) @ Bk # Bk # ires, Bk # Oc\<up>(Suc (2 * rs + 2)) @ Bk\<up>(rna))" by blast
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2535
moreover have
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2536
"\<exists>stp ln rn.
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2537
steps0 (Suc 0, Bk # Bk\<up>(lna) @ rev (<a::nat>) @ Bk # Bk # ires, Bk # Oc\<up>(Suc (2 * rs + 2)) @ Bk\<up>(rna)) t_wcode_main stp =
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2538
(0, Bk # ires, Bk # Oc # Bk\<up>(ln) @ Bk # Bk # Oc\<up>(bl_bin (<a>) + (2*rs + 2) * 2 ^ a) @ Bk\<up>(rn))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2539
using ind2[of lna ires "2*rs + 2" rna] by(simp add: tape_of_nl_abv tape_of_nat_abv)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2540
from this obtain stpb lnb rnb where stp2:
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2541
"steps0 (Suc 0, Bk # Bk\<up>(lna) @ rev (<a>) @ Bk # Bk # ires, Bk # Oc\<up>(Suc (2 * rs + 2)) @ Bk\<up>(rna)) t_wcode_main stpb =
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2542
(0, Bk # ires, Bk # Oc # Bk\<up>(lnb) @ Bk # Bk # Oc\<up>(bl_bin (<a>) + (2*rs + 2) * 2 ^ a) @ Bk\<up>(rnb))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2543
by blast
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2544
from stp1 and stp2 show "?thesis"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2545
apply(rule_tac x = "stpa + stpb" in exI,
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2546
rule_tac x = lnb in exI, rule_tac x = rnb in exI, simp add: tape_of_nat_abv)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2547
apply(simp add: bl_bin.simps replicate_Suc)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2548
apply(auto)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2549
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2550
qed
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2551
qed
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2552
next
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2553
fix aa list
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2554
assume g: "Suc x = length args" "args \<noteq> []" "lm = <args>" "args = xs @ [a::nat]" "xs = (aa::nat) # list"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2555
thus "\<exists>stp ln rn. steps0 (Suc 0, Bk # Bk\<up>(m) @ rev lm @ Bk # Bk # ires, Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stp =
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2556
(0, Bk # ires, Bk # Oc # Bk\<up>(ln) @ Bk # Bk # Oc\<up>(bl_bin lm + rs * 2 ^ (length lm - 1)) @ Bk\<up>(rn))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2557
proof(induct a arbitrary: m n rs args lm, simp_all add: tape_of_nl_rev,
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2558
simp only: tape_of_nl_cons_app1, simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2559
fix m n rs args lm
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2560
have "\<exists>stp ln rn.
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2561
steps0 (Suc 0, Bk # Bk\<up>(m) @ Oc # Bk # rev (<(aa::nat) # list>) @ Bk # Bk # ires,
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2562
Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stp =
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2563
(Suc 0, Bk # Bk\<up>(ln) @ rev (<aa # list>) @ Bk # Bk # ires,
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2564
Bk # Oc\<up>(Suc (4*rs + 4)) @ Bk\<up>(rn))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2565
proof(simp add: tape_of_nl_rev)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2566
have "\<exists> xs. (<rev list @ [aa]>) = Oc # xs" by auto
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2567
from this obtain xs where "(<rev list @ [aa]>) = Oc # xs" ..
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2568
thus "\<exists>stp ln rn.
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2569
steps0 (Suc 0, Bk # Bk\<up>(m) @ Oc # Bk # <rev list @ [aa]> @ Bk # Bk # ires,
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2570
Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stp =
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2571
(Suc 0, Bk # Bk\<up>(ln) @ <rev list @ [aa]> @ Bk # Bk # ires, Bk # Oc\<up>(5 + 4 * rs) @ Bk\<up>(rn))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2572
apply(simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2573
using wcode_fourtimes_case[of m "xs @ Bk # Bk # ires" rs n]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2574
apply(simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2575
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2576
qed
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2577
from this obtain stpa lna rna where stp1:
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2578
"steps0 (Suc 0, Bk # Bk\<up>(m) @ Oc # Bk # rev (<aa # list>) @ Bk # Bk # ires,
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2579
Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stpa =
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2580
(Suc 0, Bk # Bk\<up>(lna) @ rev (<aa # list>) @ Bk # Bk # ires,
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2581
Bk # Oc\<up>(Suc (4*rs + 4)) @ Bk\<up>(rna))" by blast
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2582
from g have
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2583
"\<exists> stp ln rn. steps0 (Suc 0, Bk # Bk\<up>(lna) @ rev (<(aa::nat) # list>) @ Bk # Bk # ires,
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2584
Bk # Oc\<up>(Suc (4*rs + 4)) @ Bk\<up>(rna)) t_wcode_main stp = (0, Bk # ires,
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2585
Bk # Oc # Bk\<up>(ln) @ Bk # Bk # Oc\<up>(bl_bin (<aa#list>)+ (4*rs + 4) * 2^(length (<aa#list>) - 1) ) @ Bk\<up>(rn))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2586
apply(rule_tac args = "(aa::nat)#list" in ind, simp_all)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2587
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2588
from this obtain stpb lnb rnb where stp2:
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2589
"steps0 (Suc 0, Bk # Bk\<up>(lna) @ rev (<(aa::nat) # list>) @ Bk # Bk # ires,
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2590
Bk # Oc\<up>(Suc (4*rs + 4)) @ Bk\<up>(rna)) t_wcode_main stpb = (0, Bk # ires,
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2591
Bk # Oc # Bk\<up>(lnb) @ Bk # Bk # Oc\<up>(bl_bin (<aa#list>)+ (4*rs + 4) * 2^(length (<aa#list>) - 1) ) @ Bk\<up>(rnb))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2592
by blast
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2593
from stp1 and stp2 and h
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2594
show "\<exists>stp ln rn.
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2595
steps0 (Suc 0, Bk # Bk\<up>(m) @ Oc # Bk # <rev list @ [aa]> @ Bk # Bk # ires,
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2596
Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stp =
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2597
(0, Bk # ires, Bk # Oc # Bk\<up>(ln) @ Bk #
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2598
Bk # Oc\<up>(bl_bin (Oc\<up>(Suc aa) @ Bk # <list @ [0]>) + rs * (2 * 2 ^ (aa + length (<list @ [0]>)))) @ Bk\<up>(rn))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2599
apply(rule_tac x = "stpa + stpb" in exI, rule_tac x = lnb in exI,
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2600
rule_tac x = rnb in exI, simp add: steps_add tape_of_nl_rev)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2601
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2602
next
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2603
fix ab m n rs args lm
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2604
assume ind2:
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2605
"\<And> m n rs args lm.
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2606
\<lbrakk>lm = <aa # list @ [ab]>; args = aa # list @ [ab]\<rbrakk>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2607
\<Longrightarrow> \<exists>stp ln rn.
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2608
steps0 (Suc 0, Bk # Bk\<up>(m) @ <ab # rev list @ [aa]> @ Bk # Bk # ires,
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2609
Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stp =
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2610
(0, Bk # ires, Bk # Oc # Bk\<up>(ln) @ Bk #
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2611
Bk # Oc\<up>(bl_bin (<aa # list @ [ab]>) + rs * 2 ^ (length (<aa # list @ [ab]>) - Suc 0)) @ Bk\<up>(rn))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2612
and k: "args = aa # list @ [Suc ab]" "lm = <aa # list @ [Suc ab]>"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2613
show "\<exists>stp ln rn.
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2614
steps0 (Suc 0, Bk # Bk\<up>(m) @ <Suc ab # rev list @ [aa]> @ Bk # Bk # ires,
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2615
Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stp =
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2616
(0, Bk # ires,Bk # Oc # Bk\<up>(ln) @ Bk #
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2617
Bk # Oc\<up>(bl_bin (<aa # list @ [Suc ab]>) + rs * 2 ^ (length (<aa # list @ [Suc ab]>) - Suc 0)) @ Bk\<up>(rn))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2618
proof(simp add: tape_of_nl_cons_app1)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2619
have "\<exists>stp ln rn.
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2620
steps0 (Suc 0, Bk # Bk\<up>(m) @ Oc\<up>(Suc (Suc ab)) @ Bk # <rev list @ [aa]> @ Bk # Bk # ires,
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2621
Bk # Oc # Oc\<up>(rs) @ Bk\<up>(n)) t_wcode_main stp
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2622
= (Suc 0, Bk # Bk\<up>(ln) @ Oc\<up>(Suc ab) @ Bk # <rev list @ [aa]> @ Bk # Bk # ires,
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2623
Bk # Oc\<up>(Suc (2*rs + 2)) @ Bk\<up>(rn))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2624
using wcode_double_case[of m "Oc\<up>(ab) @ Bk # <rev list @ [aa]> @ Bk # Bk # ires"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2625
rs n]
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2626
apply(simp add: replicate_Suc)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2627
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2628
from this obtain stpa lna rna where stp1:
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2629
"steps0 (Suc 0, Bk # Bk\<up>(m) @ Oc\<up>(Suc (Suc ab)) @ Bk # <rev list @ [aa]> @ Bk # Bk # ires,
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2630
Bk # Oc # Oc\<up>(rs) @ Bk\<up>(n)) t_wcode_main stpa
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2631
= (Suc 0, Bk # Bk\<up>(lna) @ Oc\<up>(Suc ab) @ Bk # <rev list @ [aa]> @ Bk # Bk # ires,
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2632
Bk # Oc\<up>(Suc (2*rs + 2)) @ Bk\<up>(rna))" by blast
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2633
from k have
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2634
"\<exists> stp ln rn. steps0 (Suc 0, Bk # Bk\<up>(lna) @ <ab # rev list @ [aa]> @ Bk # Bk # ires,
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2635
Bk # Oc\<up>(Suc (2*rs + 2)) @ Bk\<up>(rna)) t_wcode_main stp
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2636
= (0, Bk # ires, Bk # Oc # Bk\<up>(ln) @ Bk #
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2637
Bk # Oc\<up>(bl_bin (<aa # list @ [ab]> ) + (2*rs + 2)* 2^(length (<aa # list @ [ab]>) - Suc 0)) @ Bk\<up>(rn))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2638
apply(rule_tac ind2, simp_all)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2639
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2640
from this obtain stpb lnb rnb where stp2:
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2641
"steps0 (Suc 0, Bk # Bk\<up>(lna) @ <ab # rev list @ [aa]> @ Bk # Bk # ires,
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2642
Bk # Oc\<up>(Suc (2*rs + 2)) @ Bk\<up>(rna)) t_wcode_main stpb
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2643
= (0, Bk # ires, Bk # Oc # Bk\<up>(lnb) @ Bk #
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2644
Bk # Oc\<up>(bl_bin (<aa # list @ [ab]> ) + (2*rs + 2)* 2^(length (<aa # list @ [ab]>) - Suc 0)) @ Bk\<up>(rnb))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2645
by blast
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2646
from stp1 and stp2 show
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2647
"\<exists>stp ln rn.
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2648
steps0 (Suc 0, Bk # Bk\<up>(m) @ Oc\<up>(Suc (Suc ab)) @ Bk # <rev list @ [aa]> @ Bk # Bk # ires,
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2649
Bk # Oc\<up>(Suc rs) @ Bk\<up>(n)) t_wcode_main stp =
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2650
(0, Bk # ires, Bk # Oc # Bk\<up>(ln) @ Bk # Bk #
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2651
Oc\<up>(bl_bin (Oc\<up>(Suc aa) @ Bk # <list @ [Suc ab]>) + rs * (2 * 2 ^ (aa + length (<list @ [Suc ab]>))))
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2652
@ Bk\<up>(rn))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2653
apply(rule_tac x = "stpa + stpb" in exI, rule_tac x = lnb in exI,
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2654
rule_tac x = rnb in exI, simp add: steps_add tape_of_nl_cons_app1 replicate_Suc)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2655
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2656
qed
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2657
qed
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2658
qed
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2659
qed
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2660
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2661
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2662
definition t_wcode_prepare :: "instr list"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2663
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2664
"t_wcode_prepare \<equiv>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2665
[(W1, 2), (L, 1), (L, 3), (R, 2), (R, 4), (W0, 3),
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2666
(R, 4), (R, 5), (R, 6), (R, 5), (R, 7), (R, 5),
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2667
(W1, 7), (L, 0)]"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2668
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2669
fun wprepare_add_one :: "nat \<Rightarrow> nat list \<Rightarrow> tape \<Rightarrow> bool"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2670
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2671
"wprepare_add_one m lm (l, r) =
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2672
(\<exists> rn. l = [] \<and>
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2673
(r = <m # lm> @ Bk\<up>(rn) \<or>
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2674
r = Bk # <m # lm> @ Bk\<up>(rn)))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2675
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2676
fun wprepare_goto_first_end :: "nat \<Rightarrow> nat list \<Rightarrow> tape \<Rightarrow> bool"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2677
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2678
"wprepare_goto_first_end m lm (l, r) =
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2679
(\<exists> ml mr rn. l = Oc\<up>(ml) \<and>
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2680
r = Oc\<up>(mr) @ Bk # <lm> @ Bk\<up>(rn) \<and>
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2681
ml + mr = Suc (Suc m))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2682
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2683
fun wprepare_erase :: "nat \<Rightarrow> nat list \<Rightarrow> tape \<Rightarrow> bool"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2684
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2685
"wprepare_erase m lm (l, r) =
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2686
(\<exists> rn. l = Oc\<up>(Suc m) \<and>
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2687
tl r = Bk # <lm> @ Bk\<up>(rn))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2688
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2689
fun wprepare_goto_start_pos_B :: "nat \<Rightarrow> nat list \<Rightarrow> tape \<Rightarrow> bool"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2690
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2691
"wprepare_goto_start_pos_B m lm (l, r) =
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2692
(\<exists> rn. l = Bk # Oc\<up>(Suc m) \<and>
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2693
r = Bk # <lm> @ Bk\<up>(rn))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2694
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2695
fun wprepare_goto_start_pos_O :: "nat \<Rightarrow> nat list \<Rightarrow> tape \<Rightarrow> bool"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2696
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2697
"wprepare_goto_start_pos_O m lm (l, r) =
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2698
(\<exists> rn. l = Bk # Bk # Oc\<up>(Suc m) \<and>
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2699
r = <lm> @ Bk\<up>(rn))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2700
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2701
fun wprepare_goto_start_pos :: "nat \<Rightarrow> nat list \<Rightarrow> tape \<Rightarrow> bool"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2702
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2703
"wprepare_goto_start_pos m lm (l, r) =
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2704
(wprepare_goto_start_pos_B m lm (l, r) \<or>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2705
wprepare_goto_start_pos_O m lm (l, r))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2706
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2707
fun wprepare_loop_start_on_rightmost :: "nat \<Rightarrow> nat list \<Rightarrow> tape \<Rightarrow> bool"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2708
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2709
"wprepare_loop_start_on_rightmost m lm (l, r) =
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2710
(\<exists> rn mr. rev l @ r = Oc\<up>(Suc m) @ Bk # Bk # <lm> @ Bk\<up>(rn) \<and> l \<noteq> [] \<and>
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2711
r = Oc\<up>(mr) @ Bk\<up>(rn))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2712
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2713
fun wprepare_loop_start_in_middle :: "nat \<Rightarrow> nat list \<Rightarrow> tape \<Rightarrow> bool"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2714
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2715
"wprepare_loop_start_in_middle m lm (l, r) =
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2716
(\<exists> rn (mr:: nat) (lm1::nat list).
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2717
rev l @ r = Oc\<up>(Suc m) @ Bk # Bk # <lm> @ Bk\<up>(rn) \<and> l \<noteq> [] \<and>
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2718
r = Oc\<up>(mr) @ Bk # <lm1> @ Bk\<up>(rn) \<and> lm1 \<noteq> [])"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2719
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2720
fun wprepare_loop_start :: "nat \<Rightarrow> nat list \<Rightarrow> tape \<Rightarrow> bool"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2721
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2722
"wprepare_loop_start m lm (l, r) = (wprepare_loop_start_on_rightmost m lm (l, r) \<or>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2723
wprepare_loop_start_in_middle m lm (l, r))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2724
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2725
fun wprepare_loop_goon_on_rightmost :: "nat \<Rightarrow> nat list \<Rightarrow> tape \<Rightarrow> bool"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2726
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2727
"wprepare_loop_goon_on_rightmost m lm (l, r) =
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2728
(\<exists> rn. l = Bk # <rev lm> @ Bk # Bk # Oc\<up>(Suc m) \<and>
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2729
r = Bk\<up>(rn))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2730
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2731
fun wprepare_loop_goon_in_middle :: "nat \<Rightarrow> nat list \<Rightarrow> tape \<Rightarrow> bool"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2732
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2733
"wprepare_loop_goon_in_middle m lm (l, r) =
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2734
(\<exists> rn (mr:: nat) (lm1::nat list).
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2735
rev l @ r = Oc\<up>(Suc m) @ Bk # Bk # <lm> @ Bk\<up>(rn) \<and> l \<noteq> [] \<and>
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2736
(if lm1 = [] then r = Oc\<up>(mr) @ Bk\<up>(rn)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2737
else r = Oc\<up>(mr) @ Bk # <lm1> @ Bk\<up>(rn)) \<and> mr > 0)"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2738
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2739
fun wprepare_loop_goon :: "nat \<Rightarrow> nat list \<Rightarrow> tape \<Rightarrow> bool"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2740
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2741
"wprepare_loop_goon m lm (l, r) =
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2742
(wprepare_loop_goon_in_middle m lm (l, r) \<or>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2743
wprepare_loop_goon_on_rightmost m lm (l, r))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2744
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2745
fun wprepare_add_one2 :: "nat \<Rightarrow> nat list \<Rightarrow> tape \<Rightarrow> bool"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2746
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2747
"wprepare_add_one2 m lm (l, r) =
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2748
(\<exists> rn. l = Bk # Bk # <rev lm> @ Bk # Bk # Oc\<up>(Suc m) \<and>
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2749
(r = [] \<or> tl r = Bk\<up>(rn)))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2750
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2751
fun wprepare_stop :: "nat \<Rightarrow> nat list \<Rightarrow> tape \<Rightarrow> bool"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2752
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2753
"wprepare_stop m lm (l, r) =
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2754
(\<exists> rn. l = Bk # <rev lm> @ Bk # Bk # Oc\<up>(Suc m) \<and>
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2755
r = Bk # Oc # Bk\<up>(rn))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2756
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2757
fun wprepare_inv :: "nat \<Rightarrow> nat \<Rightarrow> nat list \<Rightarrow> tape \<Rightarrow> bool"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2758
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2759
"wprepare_inv st m lm (l, r) =
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2760
(if st = 0 then wprepare_stop m lm (l, r)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2761
else if st = Suc 0 then wprepare_add_one m lm (l, r)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2762
else if st = Suc (Suc 0) then wprepare_goto_first_end m lm (l, r)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2763
else if st = Suc (Suc (Suc 0)) then wprepare_erase m lm (l, r)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2764
else if st = 4 then wprepare_goto_start_pos m lm (l, r)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2765
else if st = 5 then wprepare_loop_start m lm (l, r)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2766
else if st = 6 then wprepare_loop_goon m lm (l, r)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2767
else if st = 7 then wprepare_add_one2 m lm (l, r)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2768
else False)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2769
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2770
fun wprepare_stage :: "config \<Rightarrow> nat"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2771
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2772
"wprepare_stage (st, l, r) =
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2773
(if st \<ge> 1 \<and> st \<le> 4 then 3
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2774
else if st = 5 \<or> st = 6 then 2
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2775
else 1)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2776
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2777
fun wprepare_state :: "config \<Rightarrow> nat"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2778
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2779
"wprepare_state (st, l, r) =
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2780
(if st = 1 then 4
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2781
else if st = Suc (Suc 0) then 3
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2782
else if st = Suc (Suc (Suc 0)) then 2
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2783
else if st = 4 then 1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2784
else if st = 7 then 2
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2785
else 0)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2786
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2787
fun wprepare_step :: "config \<Rightarrow> nat"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2788
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2789
"wprepare_step (st, l, r) =
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2790
(if st = 1 then (if hd r = Oc then Suc (length l)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2791
else 0)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2792
else if st = Suc (Suc 0) then length r
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2793
else if st = Suc (Suc (Suc 0)) then (if hd r = Oc then 1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2794
else 0)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2795
else if st = 4 then length r
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2796
else if st = 5 then Suc (length r)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2797
else if st = 6 then (if r = [] then 0 else Suc (length r))
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2798
else if st = 7 then (if (r \<noteq> [] \<and> hd r = Oc) then 0
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2799
else 1)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2800
else 0)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2801
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2802
fun wcode_prepare_measure :: "config \<Rightarrow> nat \<times> nat \<times> nat"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2803
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2804
"wcode_prepare_measure (st, l, r) =
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2805
(wprepare_stage (st, l, r),
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2806
wprepare_state (st, l, r),
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2807
wprepare_step (st, l, r))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2808
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2809
definition wcode_prepare_le :: "(config \<times> config) set"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2810
where "wcode_prepare_le \<equiv> (inv_image lex_triple wcode_prepare_measure)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2811
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2812
lemma [intro]: "wf lex_pair"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2813
by(auto intro:wf_lex_prod simp:lex_pair_def)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2814
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2815
lemma wf_wcode_prepare_le[intro]: "wf wcode_prepare_le"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2816
by(auto intro:wf_inv_image simp: wcode_prepare_le_def
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2817
lex_triple_def)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2818
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2819
declare wprepare_add_one.simps[simp del] wprepare_goto_first_end.simps[simp del]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2820
wprepare_erase.simps[simp del] wprepare_goto_start_pos.simps[simp del]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2821
wprepare_loop_start.simps[simp del] wprepare_loop_goon.simps[simp del]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2822
wprepare_add_one2.simps[simp del]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2823
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2824
lemmas wprepare_invs = wprepare_add_one.simps wprepare_goto_first_end.simps
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2825
wprepare_erase.simps wprepare_goto_start_pos.simps
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2826
wprepare_loop_start.simps wprepare_loop_goon.simps
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2827
wprepare_add_one2.simps
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2828
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2829
declare wprepare_inv.simps[simp del]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2830
lemma [simp]: "fetch t_wcode_prepare (Suc 0) Bk = (W1, 2)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2831
apply(simp add: fetch.simps t_wcode_prepare_def nth_of.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2832
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2833
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2834
lemma [simp]: "fetch t_wcode_prepare (Suc 0) Oc = (L, 1)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2835
apply(simp add: fetch.simps t_wcode_prepare_def nth_of.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2836
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2837
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2838
lemma [simp]: "fetch t_wcode_prepare (Suc (Suc 0)) Bk = (L, 3)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2839
apply(simp add: fetch.simps t_wcode_prepare_def nth_of.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2840
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2841
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2842
lemma [simp]: "fetch t_wcode_prepare (Suc (Suc 0)) Oc = (R, 2)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2843
apply(simp add: fetch.simps t_wcode_prepare_def nth_of.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2844
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2845
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2846
lemma [simp]: "fetch t_wcode_prepare (Suc (Suc (Suc 0))) Bk = (R, 4)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2847
apply(simp add: fetch.simps t_wcode_prepare_def nth_of.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2848
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2849
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2850
lemma [simp]: "fetch t_wcode_prepare (Suc (Suc (Suc 0))) Oc = (W0, 3)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2851
apply(simp add: fetch.simps t_wcode_prepare_def nth_of.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2852
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2853
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2854
lemma [simp]: "fetch t_wcode_prepare 4 Bk = (R, 4)"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2855
apply(subgoal_tac "4 = Suc 3")
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2856
apply(simp_all only: fetch.simps t_wcode_prepare_def nth_of.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2857
apply(auto)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2858
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2859
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2860
lemma [simp]: "fetch t_wcode_prepare 4 Oc = (R, 5)"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2861
apply(subgoal_tac "4 = Suc 3")
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2862
apply(simp_all only: fetch.simps t_wcode_prepare_def nth_of.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2863
apply(auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2864
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2865
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2866
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2867
lemma [simp]: "fetch t_wcode_prepare 5 Oc = (R, 5)"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2868
apply(subgoal_tac "5 = Suc 4")
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2869
apply(simp_all only: fetch.simps t_wcode_prepare_def nth_of.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2870
apply(auto)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2871
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2872
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2873
lemma [simp]: "fetch t_wcode_prepare 5 Bk = (R, 6)"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2874
apply(subgoal_tac "5 = Suc 4")
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2875
apply(simp_all only: fetch.simps t_wcode_prepare_def nth_of.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2876
apply(auto)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2877
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2878
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2879
lemma [simp]: "fetch t_wcode_prepare 6 Oc = (R, 5)"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2880
apply(subgoal_tac "6 = Suc 5")
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2881
apply(simp_all only: fetch.simps t_wcode_prepare_def nth_of.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2882
apply(auto)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2883
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2884
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2885
lemma [simp]: "fetch t_wcode_prepare 6 Bk = (R, 7)"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2886
apply(subgoal_tac "6 = Suc 5")
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2887
apply(simp_all only: fetch.simps t_wcode_prepare_def nth_of.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2888
apply(auto)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2889
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2890
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2891
lemma [simp]: "fetch t_wcode_prepare 7 Oc = (L, 0)"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2892
apply(subgoal_tac "7 = Suc 6")
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2893
apply(simp_all only: fetch.simps t_wcode_prepare_def nth_of.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2894
apply(auto)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2895
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2896
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2897
lemma [simp]: "fetch t_wcode_prepare 7 Bk = (W1, 7)"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2898
apply(subgoal_tac "7 = Suc 6")
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2899
apply(simp_all only: fetch.simps t_wcode_prepare_def nth_of.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2900
apply(auto)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2901
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2902
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2903
lemma [simp]: "lm \<noteq> [] \<Longrightarrow> wprepare_add_one m lm (b, []) = False"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2904
apply(simp add: wprepare_invs)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2905
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2906
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2907
lemma [simp]: "lm \<noteq> [] \<Longrightarrow> wprepare_goto_first_end m lm (b, []) = False"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2908
apply(simp add: wprepare_invs)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2909
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2910
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2911
lemma [simp]: "lm \<noteq> [] \<Longrightarrow> wprepare_erase m lm (b, []) = False"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2912
apply(simp add: wprepare_invs)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2913
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2914
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2915
lemma [simp]: "lm \<noteq> [] \<Longrightarrow> wprepare_goto_start_pos m lm (b, []) = False"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2916
apply(simp add: wprepare_invs)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2917
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2918
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2919
lemma [simp]: "\<lbrakk>lm \<noteq> []; wprepare_loop_start m lm (b, [])\<rbrakk> \<Longrightarrow> b \<noteq> []"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2920
apply(simp add: wprepare_invs)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2921
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2922
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2923
lemma rev_eq: "rev xs = rev ys \<Longrightarrow> xs = ys"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2924
by auto
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2925
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2926
lemma [simp]: "\<lbrakk>lm \<noteq> []; wprepare_loop_start m lm (b, [])\<rbrakk> \<Longrightarrow>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2927
wprepare_loop_goon m lm (Bk # b, [])"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2928
apply(simp only: wprepare_invs)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2929
apply(erule_tac disjE)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2930
apply(rule_tac disjI2)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2931
apply(simp add: wprepare_loop_start_on_rightmost.simps
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2932
wprepare_loop_goon_on_rightmost.simps, auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2933
apply(rule_tac rev_eq, simp add: tape_of_nl_rev)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2934
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2935
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2936
lemma [simp]: "\<lbrakk>lm \<noteq> []; wprepare_loop_goon m lm (b, [])\<rbrakk> \<Longrightarrow> b \<noteq> []"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2937
apply(simp only: wprepare_invs, auto)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2938
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2939
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2940
lemma [simp]:"\<lbrakk>lm \<noteq> []; wprepare_loop_goon m lm (b, [])\<rbrakk> \<Longrightarrow>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2941
wprepare_add_one2 m lm (Bk # b, [])"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2942
apply(simp only: wprepare_invs, auto split: if_splits)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2943
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2944
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2945
lemma [simp]: "wprepare_add_one2 m lm (b, []) \<Longrightarrow> b \<noteq> []"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2946
apply(simp only: wprepare_invs, auto)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2947
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2948
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2949
lemma [simp]: "wprepare_add_one2 m lm (b, []) \<Longrightarrow> wprepare_add_one2 m lm (b, [Oc])"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2950
apply(simp only: wprepare_invs, auto)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2951
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2952
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2953
lemma [simp]: "Bk # list = <(m::nat) # lm> @ ys = False"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2954
apply(case_tac lm, auto simp: tape_of_nl_cons replicate_Suc)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2955
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2956
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2957
lemma [simp]: "\<lbrakk>lm \<noteq> []; wprepare_add_one m lm (b, Bk # list)\<rbrakk>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2958
\<Longrightarrow> (b = [] \<longrightarrow> wprepare_goto_first_end m lm ([], Oc # list)) \<and>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2959
(b \<noteq> [] \<longrightarrow> wprepare_goto_first_end m lm (b, Oc # list))"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2960
apply(simp only: wprepare_invs)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2961
apply(auto simp: tape_of_nl_cons split: if_splits)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2962
apply(rule_tac x = 0 in exI, simp add: replicate_Suc)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2963
apply(case_tac lm, simp, simp add: tape_of_nl_abv tape_of_nat_list.simps replicate_Suc)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2964
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2965
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2966
lemma [simp]: "wprepare_goto_first_end m lm (b, Bk # list) \<Longrightarrow> b \<noteq> []"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2967
apply(simp only: wprepare_invs , auto simp: replicate_Suc)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2968
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2969
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2970
declare replicate_Suc[simp]
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2971
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2972
lemma [simp]: "wprepare_goto_first_end m lm (b, Bk # list) \<Longrightarrow>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2973
wprepare_erase m lm (tl b, hd b # Bk # list)"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2974
apply(simp only: wprepare_invs, auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2975
apply(case_tac mr, simp_all)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2976
apply(case_tac mr, auto)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2977
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2978
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2979
lemma [simp]: "wprepare_erase m lm (b, Bk # list) \<Longrightarrow> b \<noteq> []"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2980
apply(simp only: wprepare_invs, auto)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2981
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2982
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2983
lemma [simp]: "wprepare_erase m lm (b, Bk # list) \<Longrightarrow>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2984
wprepare_goto_start_pos m lm (Bk # b, list)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2985
apply(simp only: wprepare_invs, auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2986
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2987
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2988
lemma [simp]: "\<lbrakk>wprepare_add_one m lm (b, Bk # list)\<rbrakk> \<Longrightarrow> list \<noteq> []"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2989
apply(simp only: wprepare_invs)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2990
apply(case_tac lm, simp_all add: tape_of_nl_abv
139
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2991
tape_of_nat_list.simps tape_of_nat_abv, auto)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2992
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2993
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2994
lemma [simp]: "\<lbrakk>lm \<noteq> []; wprepare_goto_first_end m lm (b, Bk # list)\<rbrakk> \<Longrightarrow> list \<noteq> []"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2995
apply(simp only: wprepare_invs, auto)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 2996
apply(case_tac mr, simp_all)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2997
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2998
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 2999
lemma [simp]: "\<lbrakk>lm \<noteq> []; wprepare_goto_first_end m lm (b, Bk # list)\<rbrakk> \<Longrightarrow> b \<noteq> []"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3000
apply(simp only: wprepare_invs, auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3001
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3002
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3003
lemma [simp]: "\<lbrakk>lm \<noteq> []; wprepare_erase m lm (b, Bk # list)\<rbrakk> \<Longrightarrow> list \<noteq> []"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3004
apply(simp only: wprepare_invs, auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3005
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3006
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3007
lemma [simp]: "\<lbrakk>lm \<noteq> []; wprepare_erase m lm (b, Bk # list)\<rbrakk> \<Longrightarrow> b \<noteq> []"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3008
apply(simp only: wprepare_invs, auto)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3009
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3010
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3011
lemma [simp]: "\<lbrakk>lm \<noteq> []; wprepare_goto_start_pos m lm (b, Bk # list)\<rbrakk> \<Longrightarrow> list \<noteq> []"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3012
apply(simp only: wprepare_invs, auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3013
apply(case_tac lm, simp, case_tac list)
139
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3014
apply(simp_all add: tape_of_nl_abv tape_of_nat_list.simps tape_of_nat_abv)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3015
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3016
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3017
lemma [simp]: "\<lbrakk>lm \<noteq> []; wprepare_goto_start_pos m lm (b, Bk # list)\<rbrakk> \<Longrightarrow> b \<noteq> []"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3018
apply(simp only: wprepare_invs)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3019
apply(auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3020
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3021
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3022
lemma [simp]: "\<lbrakk>lm \<noteq> []; wprepare_loop_goon m lm (b, Bk # list)\<rbrakk> \<Longrightarrow> b \<noteq> []"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3023
apply(simp only: wprepare_invs, auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3024
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3025
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3026
lemma [simp]: "\<lbrakk>lm \<noteq> []; wprepare_loop_goon m lm (b, Bk # list)\<rbrakk> \<Longrightarrow>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3027
(list = [] \<longrightarrow> wprepare_add_one2 m lm (Bk # b, [])) \<and>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3028
(list \<noteq> [] \<longrightarrow> wprepare_add_one2 m lm (Bk # b, list))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3029
apply(simp only: wprepare_invs, simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3030
apply(case_tac list, simp_all split: if_splits, auto)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3031
apply(case_tac [1-3] mr, simp_all add: )
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3032
apply(case_tac mr, simp_all)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3033
apply(case_tac [1-2] mr, simp_all add: )
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3034
apply(case_tac rn, simp, case_tac nat, auto simp: )
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3035
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3036
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3037
lemma [simp]: "wprepare_add_one2 m lm (b, Bk # list) \<Longrightarrow> b \<noteq> []"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3038
apply(simp only: wprepare_invs, simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3039
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3040
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3041
lemma [simp]: "wprepare_add_one2 m lm (b, Bk # list) \<Longrightarrow>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3042
(list = [] \<longrightarrow> wprepare_add_one2 m lm (b, [Oc])) \<and>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3043
(list \<noteq> [] \<longrightarrow> wprepare_add_one2 m lm (b, Oc # list))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3044
apply(simp only: wprepare_invs, auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3045
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3046
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3047
lemma [simp]: "wprepare_goto_first_end m lm (b, Oc # list)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3048
\<Longrightarrow> (b = [] \<longrightarrow> wprepare_goto_first_end m lm ([Oc], list)) \<and>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3049
(b \<noteq> [] \<longrightarrow> wprepare_goto_first_end m lm (Oc # b, list))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3050
apply(simp only: wprepare_invs, auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3051
apply(rule_tac x = 1 in exI, auto)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3052
apply(case_tac mr, simp_all add: )
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3053
apply(case_tac ml, simp_all add: )
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3054
apply(rule_tac x = "Suc ml" in exI, simp_all add: )
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3055
apply(rule_tac x = "mr - 1" in exI, simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3056
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3057
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3058
lemma [simp]: "wprepare_erase m lm (b, Oc # list) \<Longrightarrow> b \<noteq> []"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3059
apply(simp only: wprepare_invs, auto simp: )
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3060
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3061
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3062
lemma [simp]: "wprepare_erase m lm (b, Oc # list)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3063
\<Longrightarrow> wprepare_erase m lm (b, Bk # list)"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3064
apply(simp only:wprepare_invs, auto simp: )
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3065
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3066
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3067
lemma [simp]: "\<lbrakk>lm \<noteq> []; wprepare_goto_start_pos m lm (b, Bk # list)\<rbrakk>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3068
\<Longrightarrow> wprepare_goto_start_pos m lm (Bk # b, list)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3069
apply(simp only:wprepare_invs, auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3070
apply(case_tac [!] lm, simp, simp_all)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3071
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3072
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3073
lemma [simp]: "wprepare_loop_start m lm (b, aa) \<Longrightarrow> b \<noteq> []"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3074
apply(simp only:wprepare_invs, auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3075
done
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3076
lemma [elim]: "Bk # list = Oc\<up>(mr) @ Bk\<up>(rn) \<Longrightarrow> \<exists>rn. list = Bk\<up>(rn)"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3077
apply(case_tac mr, simp_all)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3078
apply(case_tac rn, simp_all)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3079
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3080
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3081
lemma rev_equal_iff: "x = y \<Longrightarrow> rev x = rev y"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3082
by simp
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3083
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3084
lemma tape_of_nl_false1:
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3085
"lm \<noteq> [] \<Longrightarrow> rev b @ [Bk] \<noteq> Bk\<up>(ln) @ Oc # Oc\<up>(m) @ Bk # Bk # <lm::nat list>"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3086
apply(auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3087
apply(drule_tac rev_equal_iff, simp add: tape_of_nl_rev)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3088
apply(case_tac "rev lm")
139
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3089
apply(case_tac [2] list, auto simp: tape_of_nl_abv tape_of_nat_list.simps tape_of_nat_abv)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3090
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3091
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3092
lemma [simp]: "wprepare_loop_start_in_middle m lm (b, [Bk]) = False"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3093
apply(simp add: wprepare_loop_start_in_middle.simps, auto)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3094
apply(case_tac mr, simp_all add: )
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3095
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3096
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3097
declare wprepare_loop_start_in_middle.simps[simp del]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3098
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3099
declare wprepare_loop_start_on_rightmost.simps[simp del]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3100
wprepare_loop_goon_in_middle.simps[simp del]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3101
wprepare_loop_goon_on_rightmost.simps[simp del]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3102
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3103
lemma [simp]: "wprepare_loop_goon_in_middle m lm (Bk # b, []) = False"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3104
apply(simp add: wprepare_loop_goon_in_middle.simps, auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3105
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3106
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3107
lemma [simp]: "\<lbrakk>lm \<noteq> []; wprepare_loop_start m lm (b, [Bk])\<rbrakk> \<Longrightarrow>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3108
wprepare_loop_goon m lm (Bk # b, [])"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3109
apply(simp only: wprepare_invs, simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3110
apply(simp add: wprepare_loop_goon_on_rightmost.simps
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3111
wprepare_loop_start_on_rightmost.simps, auto)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3112
apply(case_tac mr, simp_all add: )
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3113
apply(rule_tac rev_eq)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3114
apply(simp add: tape_of_nl_rev)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3115
apply(simp add: exp_ind replicate_Suc[THEN sym] del: replicate_Suc)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3116
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3117
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3118
lemma [simp]: "wprepare_loop_start_on_rightmost m lm (b, Bk # a # lista)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3119
\<Longrightarrow> wprepare_loop_goon_in_middle m lm (Bk # b, a # lista) = False"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3120
apply(auto simp: wprepare_loop_start_on_rightmost.simps
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3121
wprepare_loop_goon_in_middle.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3122
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3123
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3124
lemma [simp]: "\<lbrakk>lm \<noteq> []; wprepare_loop_start_on_rightmost m lm (b, Bk # a # lista)\<rbrakk>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3125
\<Longrightarrow> wprepare_loop_goon_on_rightmost m lm (Bk # b, a # lista)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3126
apply(simp only: wprepare_loop_start_on_rightmost.simps
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3127
wprepare_loop_goon_on_rightmost.simps, auto)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3128
apply(case_tac mr, simp_all add: )
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3129
apply(simp add: tape_of_nl_rev)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3130
apply(simp add: replicate_Suc[THEN sym] exp_ind del: replicate_Suc)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3131
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3132
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3133
lemma [simp]: "\<lbrakk>lm \<noteq> []; wprepare_loop_start_in_middle m lm (b, Bk # a # lista)\<rbrakk>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3134
\<Longrightarrow> wprepare_loop_goon_on_rightmost m lm (Bk # b, a # lista) = False"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3135
apply(simp add: wprepare_loop_start_in_middle.simps
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3136
wprepare_loop_goon_on_rightmost.simps, auto)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3137
apply(case_tac mr, simp_all add: )
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3138
apply(case_tac "lm1::nat list", simp_all, case_tac list, simp)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3139
apply(simp add: tape_of_nl_abv tape_of_nat_list.simps tape_of_nat_abv )
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3140
apply(case_tac [!] rna, simp_all add: )
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3141
apply(case_tac mr, simp_all add: )
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3142
apply(case_tac lm1, simp, case_tac list, simp)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3143
apply(simp_all add: tape_of_nl_abv tape_of_nat_list.simps tape_of_nat_abv)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3144
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3145
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3146
lemma [simp]:
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3147
"\<lbrakk>lm \<noteq> []; wprepare_loop_start_in_middle m lm (b, Bk # a # lista)\<rbrakk>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3148
\<Longrightarrow> wprepare_loop_goon_in_middle m lm (Bk # b, a # lista)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3149
apply(simp add: wprepare_loop_start_in_middle.simps
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3150
wprepare_loop_goon_in_middle.simps, auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3151
apply(rule_tac x = rn in exI, simp)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3152
apply(case_tac mr, simp_all add: )
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3153
apply(case_tac lm1, simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3154
apply(rule_tac x = "Suc aa" in exI, simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3155
apply(rule_tac x = list in exI)
139
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3156
apply(case_tac list, simp_all add: tape_of_nl_abv tape_of_nat_list.simps tape_of_nat_abv)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3157
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3158
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3159
lemma [simp]: "\<lbrakk>lm \<noteq> []; wprepare_loop_start m lm (b, Bk # a # lista)\<rbrakk> \<Longrightarrow>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3160
wprepare_loop_goon m lm (Bk # b, a # lista)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3161
apply(simp add: wprepare_loop_start.simps
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3162
wprepare_loop_goon.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3163
apply(erule_tac disjE, simp, auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3164
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3165
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3166
lemma start_2_goon:
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3167
"\<lbrakk>lm \<noteq> []; wprepare_loop_start m lm (b, Bk # list)\<rbrakk> \<Longrightarrow>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3168
(list = [] \<longrightarrow> wprepare_loop_goon m lm (Bk # b, [])) \<and>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3169
(list \<noteq> [] \<longrightarrow> wprepare_loop_goon m lm (Bk # b, list))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3170
apply(case_tac list, auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3171
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3172
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3173
lemma add_one_2_add_one: "wprepare_add_one m lm (b, Oc # list)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3174
\<Longrightarrow> (hd b = Oc \<longrightarrow> (b = [] \<longrightarrow> wprepare_add_one m lm ([], Bk # Oc # list)) \<and>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3175
(b \<noteq> [] \<longrightarrow> wprepare_add_one m lm (tl b, Oc # Oc # list))) \<and>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3176
(hd b \<noteq> Oc \<longrightarrow> (b = [] \<longrightarrow> wprepare_add_one m lm ([], Bk # Oc # list)) \<and>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3177
(b \<noteq> [] \<longrightarrow> wprepare_add_one m lm (tl b, hd b # Oc # list)))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3178
apply(simp only: wprepare_add_one.simps, auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3179
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3180
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3181
lemma [simp]: "wprepare_loop_start m lm (b, Oc # list) \<Longrightarrow> b \<noteq> []"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3182
apply(simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3183
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3184
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3185
lemma [simp]: "wprepare_loop_start_on_rightmost m lm (b, Oc # list) \<Longrightarrow>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3186
wprepare_loop_start_on_rightmost m lm (Oc # b, list)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3187
apply(simp add: wprepare_loop_start_on_rightmost.simps, auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3188
apply(rule_tac x = rn in exI, auto)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3189
apply(case_tac mr, simp_all add: )
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3190
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3191
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3192
lemma [simp]: "wprepare_loop_start_in_middle m lm (b, Oc # list) \<Longrightarrow>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3193
wprepare_loop_start_in_middle m lm (Oc # b, list)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3194
apply(simp add: wprepare_loop_start_in_middle.simps, auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3195
apply(rule_tac x = rn in exI, auto)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3196
apply(case_tac mr, simp, simp add: )
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3197
apply(rule_tac x = nat in exI, simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3198
apply(rule_tac x = lm1 in exI, simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3199
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3200
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3201
lemma start_2_start: "wprepare_loop_start m lm (b, Oc # list) \<Longrightarrow>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3202
wprepare_loop_start m lm (Oc # b, list)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3203
apply(simp add: wprepare_loop_start.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3204
apply(erule_tac disjE, simp_all )
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3205
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3206
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3207
lemma [simp]: "wprepare_loop_goon m lm (b, Oc # list) \<Longrightarrow> b \<noteq> []"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3208
apply(simp add: wprepare_loop_goon.simps
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3209
wprepare_loop_goon_in_middle.simps
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3210
wprepare_loop_goon_on_rightmost.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3211
apply(auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3212
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3213
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3214
lemma [simp]: "wprepare_goto_start_pos m lm (b, Oc # list) \<Longrightarrow> b \<noteq> []"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3215
apply(simp add: wprepare_goto_start_pos.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3216
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3217
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3218
lemma [simp]: "wprepare_loop_goon_on_rightmost m lm (b, Oc # list) = False"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3219
apply(simp add: wprepare_loop_goon_on_rightmost.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3220
done
139
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3221
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3222
lemma wprepare_loop1: "\<lbrakk>rev b @ Oc\<up>(mr) = Oc\<up>(Suc m) @ Bk # Bk # <lm>;
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3223
b \<noteq> []; 0 < mr; Oc # list = Oc\<up>(mr) @ Bk\<up>(rn)\<rbrakk>
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3224
\<Longrightarrow> wprepare_loop_start_on_rightmost m lm (Oc # b, list)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3225
apply(simp add: wprepare_loop_start_on_rightmost.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3226
apply(rule_tac x = rn in exI, simp)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3227
apply(case_tac mr, simp, simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3228
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3229
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3230
lemma wprepare_loop2: "\<lbrakk>rev b @ Oc\<up>(mr) @ Bk # <a # lista> = Oc\<up>(Suc m) @ Bk # Bk # <lm>;
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3231
b \<noteq> []; Oc # list = Oc\<up>(mr) @ Bk # <(a::nat) # lista> @ Bk\<up>(rn)\<rbrakk>
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3232
\<Longrightarrow> wprepare_loop_start_in_middle m lm (Oc # b, list)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3233
apply(simp add: wprepare_loop_start_in_middle.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3234
apply(rule_tac x = rn in exI, simp)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3235
apply(case_tac mr, simp_all add: )
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3236
apply(rule_tac x = nat in exI, simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3237
apply(rule_tac x = "a#lista" in exI, simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3238
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3239
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3240
lemma [simp]: "wprepare_loop_goon_in_middle m lm (b, Oc # list) \<Longrightarrow>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3241
wprepare_loop_start_on_rightmost m lm (Oc # b, list) \<or>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3242
wprepare_loop_start_in_middle m lm (Oc # b, list)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3243
apply(simp add: wprepare_loop_goon_in_middle.simps split: if_splits)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3244
apply(case_tac lm1, simp_all add: wprepare_loop1 wprepare_loop2)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3245
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3246
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3247
lemma [simp]: "wprepare_loop_goon m lm (b, Oc # list)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3248
\<Longrightarrow> wprepare_loop_start m lm (Oc # b, list)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3249
apply(simp add: wprepare_loop_goon.simps
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3250
wprepare_loop_start.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3251
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3252
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3253
lemma [simp]: "wprepare_add_one m lm (b, Oc # list)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3254
\<Longrightarrow> b = [] \<longrightarrow> wprepare_add_one m lm ([], Bk # Oc # list)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3255
apply(auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3256
apply(simp add: wprepare_add_one.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3257
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3258
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3259
lemma [simp]: "wprepare_goto_start_pos m [a] (b, Oc # list)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3260
\<Longrightarrow> wprepare_loop_start_on_rightmost m [a] (Oc # b, list) "
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3261
apply(auto simp: wprepare_goto_start_pos.simps
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3262
wprepare_loop_start_on_rightmost.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3263
apply(rule_tac x = rn in exI, simp)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3264
apply(simp add: replicate_Suc[THEN sym] exp_ind del: replicate_Suc)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3265
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3266
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3267
lemma [simp]: "wprepare_goto_start_pos m (a # aa # listaa) (b, Oc # list)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3268
\<Longrightarrow>wprepare_loop_start_in_middle m (a # aa # listaa) (Oc # b, list)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3269
apply(auto simp: wprepare_goto_start_pos.simps
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3270
wprepare_loop_start_in_middle.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3271
apply(rule_tac x = rn in exI, simp)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3272
apply(simp add: exp_ind[THEN sym])
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3273
apply(rule_tac x = a in exI, rule_tac x = "aa#listaa" in exI, simp)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3274
apply(simp add: tape_of_nl_cons)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3275
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3276
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3277
lemma [simp]: "\<lbrakk>lm \<noteq> []; wprepare_goto_start_pos m lm (b, Oc # list)\<rbrakk>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3278
\<Longrightarrow> wprepare_loop_start m lm (Oc # b, list)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3279
apply(case_tac lm, simp_all)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3280
apply(case_tac lista, simp_all add: wprepare_loop_start.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3281
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3282
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3283
lemma [simp]: "wprepare_add_one2 m lm (b, Oc # list) \<Longrightarrow> b \<noteq> []"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3284
apply(auto simp: wprepare_add_one2.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3285
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3286
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3287
lemma add_one_2_stop:
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3288
"wprepare_add_one2 m lm (b, Oc # list)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3289
\<Longrightarrow> wprepare_stop m lm (tl b, hd b # Oc # list)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3290
apply(simp add: wprepare_stop.simps wprepare_add_one2.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3291
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3292
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3293
declare wprepare_stop.simps[simp del]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3294
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3295
lemma wprepare_correctness:
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3296
assumes h: "lm \<noteq> []"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3297
shows "let P = (\<lambda> (st, l, r). st = 0) in
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3298
let Q = (\<lambda> (st, l, r). wprepare_inv st m lm (l, r)) in
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3299
let f = (\<lambda> stp. steps0 (Suc 0, [], (<m # lm>)) t_wcode_prepare stp) in
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3300
\<exists> n .P (f n) \<and> Q (f n)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3301
proof -
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3302
let ?P = "(\<lambda> (st, l, r). st = 0)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3303
let ?Q = "(\<lambda> (st, l, r). wprepare_inv st m lm (l, r))"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3304
let ?f = "(\<lambda> stp. steps0 (Suc 0, [], (<m # lm>)) t_wcode_prepare stp)"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3305
have "\<exists> n. ?P (?f n) \<and> ?Q (?f n)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3306
proof(rule_tac halt_lemma2)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3307
show "wf wcode_prepare_le" by auto
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3308
next
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3309
show "\<forall> n. \<not> ?P (?f n) \<and> ?Q (?f n) \<longrightarrow>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3310
?Q (?f (Suc n)) \<and> (?f (Suc n), ?f n) \<in> wcode_prepare_le"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3311
using h
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3312
apply(rule_tac allI, rule_tac impI, case_tac "?f n",
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3313
simp add: step_red step.simps)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3314
apply(case_tac c, simp, case_tac [2] aa)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3315
apply(simp_all add: wprepare_inv.simps wcode_prepare_le_def lex_triple_def lex_pair_def
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3316
split: if_splits)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3317
apply(simp_all add: start_2_goon start_2_start
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3318
add_one_2_add_one add_one_2_stop)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3319
apply(auto simp: wprepare_add_one2.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3320
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3321
next
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3322
show "?Q (?f 0)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3323
apply(simp add: steps.simps wprepare_inv.simps wprepare_invs)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3324
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3325
next
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3326
show "\<not> ?P (?f 0)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3327
apply(simp add: steps.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3328
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3329
qed
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3330
thus "?thesis"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3331
apply(auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3332
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3333
qed
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3334
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3335
lemma [intro]: "tm_wf (t_wcode_prepare, 0)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3336
apply(simp add:tm_wf.simps t_wcode_prepare_def)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3337
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3338
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3339
lemma t_correct_shift:
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3340
"list_all (\<lambda>(acn, st). (st \<le> y)) tp \<Longrightarrow>
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3341
list_all (\<lambda>(acn, st). (st \<le> y + off)) (shift tp off) "
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3342
apply(auto simp: List.list_all_length)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3343
apply(erule_tac x = n in allE, simp add: length_shift)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3344
apply(case_tac "tp!n", auto simp: shift.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3345
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3346
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3347
lemma [intro]: "(28 + (length t_twice_compile + length t_fourtimes_compile)) mod 2 = 0"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3348
apply(auto simp: t_twice_compile_def t_fourtimes_compile_def)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3349
by arith
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3350
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3351
lemma [elim]: "(a, b) \<in> set t_wcode_main_first_part \<Longrightarrow>
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3352
b \<le> (28 + (length t_twice_compile + length t_fourtimes_compile)) div 2"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3353
apply(auto simp: t_wcode_main_first_part_def t_twice_def)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3354
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3355
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3356
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3357
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3358
lemma tm_wf_change_termi: "tm_wf (tp, 0) \<Longrightarrow>
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3359
list_all (\<lambda>(acn, st). (st \<le> Suc (length tp div 2))) (adjust tp)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3360
apply(auto simp: tm_wf.simps List.list_all_length)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3361
apply(case_tac "tp!n", auto simp: adjust.simps split: if_splits)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3362
apply(erule_tac x = "(a, b)" in ballE, auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3363
by (metis in_set_conv_nth)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3364
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3365
lemma tm_wf_shift:
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3366
"list_all (\<lambda>(acn, st). (st \<le> y)) tp \<Longrightarrow>
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3367
list_all (\<lambda>(acn, st). (st \<le> y + off)) (shift tp off) "
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3368
apply(auto simp: tm_wf.simps List.list_all_length)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3369
apply(erule_tac x = n in allE, simp add: length_shift)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3370
apply(case_tac "tp!n", auto simp: shift.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3371
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3372
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3373
declare length_tp'[simp del]
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3374
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3375
lemma [simp]: "length (mopup (Suc 0)) = 16"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3376
apply(auto simp: mopup.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3377
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3378
163
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3379
lemma [elim]: "(a, b) \<in> set (shift (Turing.adjust t_twice_compile) 12) \<Longrightarrow>
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3380
b \<le> (28 + (length t_twice_compile + length t_fourtimes_compile)) div 2"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3381
apply(simp add: t_twice_compile_def t_fourtimes_compile_def)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3382
proof -
163
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3383
assume g: "(a, b) \<in> set (shift (Turing.adjust (tm_of abc_twice @ shift (mopup (Suc 0)) (length (tm_of abc_twice) div 2))) 12)"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3384
moreover have "length (tm_of abc_twice) mod 2 = 0" by auto
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3385
moreover have "length (tm_of abc_fourtimes) mod 2 = 0" by auto
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3386
ultimately have "list_all (\<lambda>(acn, st). (st \<le> (60 + (length (tm_of abc_twice) + length (tm_of abc_fourtimes))) div 2))
163
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3387
(shift (Turing.adjust t_twice_compile) 12)"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3388
proof(auto simp: mod_ex1)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3389
fix q qa
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3390
assume h: "length (tm_of abc_twice) = 2 * q" "length (tm_of abc_fourtimes) = 2 * qa"
163
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3391
hence "list_all (\<lambda>(acn, st). st \<le> (18 + (q + qa)) + 12) (shift (Turing.adjust t_twice_compile) 12)"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3392
proof(rule_tac tm_wf_shift t_twice_compile_def)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3393
have "list_all (\<lambda>(acn, st). st \<le> Suc (length t_twice_compile div 2)) (adjust t_twice_compile)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3394
by(rule_tac tm_wf_change_termi, auto)
163
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3395
thus "list_all (\<lambda>(acn, st). st \<le> 18 + (q + qa)) (Turing.adjust t_twice_compile)"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3396
using h
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3397
apply(simp add: t_twice_compile_def, auto simp: List.list_all_length)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3398
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3399
qed
163
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3400
thus "list_all (\<lambda>(acn, st). st \<le> 30 + (q + qa)) (shift (Turing.adjust t_twice_compile) 12)"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3401
by simp
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3402
qed
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3403
thus "b \<le> (60 + (length (tm_of abc_twice) + length (tm_of abc_fourtimes))) div 2"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3404
using g
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3405
apply(auto simp:t_twice_compile_def)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3406
apply(simp add: Ball_set[THEN sym])
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3407
apply(erule_tac x = "(a, b)" in ballE, simp, simp)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3408
done
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3409
qed
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3410
163
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3411
lemma [elim]: "(a, b) \<in> set (shift (Turing.adjust t_fourtimes_compile) (t_twice_len + 13))
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3412
\<Longrightarrow> b \<le> (28 + (length t_twice_compile + length t_fourtimes_compile)) div 2"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3413
apply(simp add: t_twice_compile_def t_fourtimes_compile_def t_twice_len_def)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3414
proof -
163
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3415
assume g: "(a, b) \<in> set (shift (Turing.adjust (tm_of abc_fourtimes @ shift (mopup (Suc 0))
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3416
(length (tm_of abc_fourtimes) div 2))) (length t_twice div 2 + 13))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3417
moreover have "length (tm_of abc_twice) mod 2 = 0" by auto
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3418
moreover have "length (tm_of abc_fourtimes) mod 2 = 0" by auto
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3419
ultimately have "list_all (\<lambda>(acn, st). (st \<le> (60 + (length (tm_of abc_twice) + length (tm_of abc_fourtimes))) div 2))
163
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3420
(shift (Turing.adjust (tm_of abc_fourtimes @ shift (mopup (Suc 0))
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3421
(length (tm_of abc_fourtimes) div 2))) (length t_twice div 2 + 13))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3422
proof(auto simp: mod_ex1 t_twice_def t_twice_compile_def)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3423
fix q qa
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3424
assume h: "length (tm_of abc_twice) = 2 * q" "length (tm_of abc_fourtimes) = 2 * qa"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3425
hence "list_all (\<lambda>(acn, st). st \<le> (9 + qa + (21 + q)))
163
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3426
(shift (Turing.adjust (tm_of abc_fourtimes @ shift (mopup (Suc 0)) qa)) (21 + q))"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3427
proof(rule_tac tm_wf_shift t_twice_compile_def)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3428
have "list_all (\<lambda>(acn, st). st \<le> Suc (length (tm_of abc_fourtimes @ shift
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3429
(mopup (Suc 0)) qa) div 2)) (adjust (tm_of abc_fourtimes @ shift (mopup (Suc 0)) qa))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3430
apply(rule_tac tm_wf_change_termi)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3431
using wf_fourtimes h
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3432
apply(simp add: t_fourtimes_compile_def)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3433
done
163
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3434
thus "list_all (\<lambda>(acn, st). st \<le> 9 + qa) ((Turing.adjust (tm_of abc_fourtimes @ shift (mopup (Suc 0)) qa)))"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3435
using h
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3436
apply(simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3437
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3438
qed
163
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3439
thus "list_all (\<lambda>(acn, st). st \<le> 30 + (q + qa)) (shift (Turing.adjust (tm_of abc_fourtimes @ shift (mopup (Suc 0)) qa)) (21 + q))"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3440
apply(subgoal_tac "qa + q = q + qa")
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3441
apply(simp, simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3442
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3443
qed
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3444
thus "b \<le> (60 + (length (tm_of abc_twice) + length (tm_of abc_fourtimes))) div 2"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3445
using g
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3446
apply(simp add: Ball_set[THEN sym])
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3447
apply(erule_tac x = "(a, b)" in ballE, simp, simp)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3448
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3449
qed
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3450
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3451
lemma [intro]: "tm_wf (t_wcode_main, 0)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3452
apply(auto simp: t_wcode_main_def tm_wf.simps
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3453
t_twice_def t_fourtimes_def del: List.list_all_iff)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3454
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3455
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3456
declare tm_comp.simps[simp del]
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3457
lemma tm_wf_comp: "\<lbrakk>tm_wf (A, 0); tm_wf (B, 0)\<rbrakk> \<Longrightarrow> tm_wf (A |+| B, 0)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3458
apply(auto simp: tm_wf.simps shift.simps adjust.simps tm_comp_length
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3459
tm_comp.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3460
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3461
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3462
lemma [intro]: "tm_wf (t_wcode_prepare |+| t_wcode_main, 0)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3463
apply(rule_tac tm_wf_comp, auto)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3464
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3465
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3466
lemma prepare_mainpart_lemma:
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3467
"args \<noteq> [] \<Longrightarrow>
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3468
\<exists> stp ln rn. steps0 (Suc 0, [], <m # args>) (t_wcode_prepare |+| t_wcode_main) stp
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3469
= (0, Bk # Oc\<up>(Suc m), Bk # Oc # Bk\<up>(ln) @ Bk # Bk # Oc\<up>(bl_bin (<args>)) @ Bk\<up>(rn))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3470
proof -
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3471
let ?P1 = "(\<lambda> (l, r). (l::cell list) = [] \<and> r = <m # args>)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3472
let ?Q1 = "(\<lambda> (l, r). wprepare_stop m args (l, r))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3473
let ?P2 = ?Q1
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3474
let ?Q2 = "(\<lambda> (l, r). (\<exists> ln rn. l = Bk # Oc\<up>(Suc m) \<and>
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3475
r = Bk # Oc # Bk\<up>(ln) @ Bk # Bk # Oc\<up>(bl_bin (<args>)) @ Bk\<up>(rn)))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3476
let ?P3 = "\<lambda> tp. False"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3477
assume h: "args \<noteq> []"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3478
have "{?P1} t_wcode_prepare |+| t_wcode_main {?Q2}"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3479
proof(rule_tac Hoare_plus_halt)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3480
show "{?P1} t_wcode_prepare {?Q1}"
139
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3481
proof(rule_tac Hoare_haltI, auto)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3482
show "\<exists>n. is_final (steps0 (Suc 0, [], <m # args>) t_wcode_prepare n) \<and>
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3483
wprepare_stop m args holds_for steps0 (Suc 0, [], <m # args>) t_wcode_prepare n"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3484
using wprepare_correctness[of args m] h
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3485
apply(auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3486
apply(rule_tac x = n in exI, simp add: wprepare_inv.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3487
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3488
qed
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3489
next
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3490
show "{?P2} t_wcode_main {?Q2}"
139
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3491
proof(rule_tac Hoare_haltI, auto)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3492
fix l r
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3493
assume "wprepare_stop m args (l, r)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3494
thus "\<exists>n. is_final (steps0 (Suc 0, l, r) t_wcode_main n) \<and>
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3495
(\<lambda>(l, r). l = Bk # Oc # Oc \<up> m \<and> (\<exists>ln rn. r = Bk # Oc # Bk \<up> ln @
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3496
Bk # Bk # Oc \<up> bl_bin (<args>) @ Bk \<up> rn)) holds_for steps0 (Suc 0, l, r) t_wcode_main n"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3497
proof(auto simp: wprepare_stop.simps)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3498
fix rn
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3499
show " \<exists>n. is_final (steps0 (Suc 0, Bk # <rev args> @ Bk # Bk # Oc # Oc \<up> m, Bk # Oc # Bk \<up> rn) t_wcode_main n) \<and>
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3500
(\<lambda>(l, r). l = Bk # Oc # Oc \<up> m \<and>
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3501
(\<exists>ln rn. r = Bk # Oc # Bk \<up> ln @
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3502
Bk # Bk # Oc \<up> bl_bin (<args>) @
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3503
Bk \<up> rn)) holds_for steps0 (Suc 0, Bk # <rev args> @ Bk # Bk # Oc # Oc \<up> m, Bk # Oc # Bk \<up> rn) t_wcode_main n"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3504
using t_wcode_main_lemma_pre[of "args" "<args>" 0 "Oc\<up>(Suc m)" 0 rn] h
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3505
apply(auto simp: tape_of_nl_rev)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3506
apply(rule_tac x = stp in exI, auto)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3507
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3508
qed
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3509
qed
139
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3510
next
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3511
show "tm_wf0 t_wcode_prepare"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3512
by auto
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3513
qed
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3514
thus "?thesis"
139
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3515
apply(auto simp: Hoare_halt_def)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3516
apply(rule_tac x = n in exI)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3517
apply(case_tac "(steps0 (Suc 0, [], <m # args>)
163
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3518
(Turing.adjust t_wcode_prepare @ shift t_wcode_main (length t_wcode_prepare div 2)) n)")
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3519
apply(auto simp: tm_comp.simps)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3520
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3521
qed
139
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3522
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3523
definition tinres :: "cell list \<Rightarrow> cell list \<Rightarrow> bool"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3524
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3525
"tinres xs ys = (\<exists>n. xs = ys @ Bk \<up> n \<or> ys = xs @ Bk \<up> n)"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3526
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3527
lemma [simp]: "tinres r r' \<Longrightarrow>
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3528
fetch t ss (read r) =
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3529
fetch t ss (read r')"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3530
apply(simp add: fetch.simps, auto split: if_splits simp: tinres_def)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3531
apply(case_tac [!] n, simp_all)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3532
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3533
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3534
lemma [intro]: "\<exists> n. (a::cell)\<up>(n) = []"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3535
by auto
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3536
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3537
lemma [simp]: "\<lbrakk>tinres r r'; r \<noteq> []; r' \<noteq> []\<rbrakk> \<Longrightarrow> hd r = hd r'"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3538
apply(auto simp: tinres_def)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3539
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3540
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3541
lemma [intro]: "hd (Bk\<up>(Suc n)) = Bk"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3542
apply(simp add: )
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3543
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3544
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3545
lemma [simp]: "\<lbrakk>tinres r []; r \<noteq> []\<rbrakk> \<Longrightarrow> hd r = Bk"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3546
apply(auto simp: tinres_def)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3547
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3548
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3549
lemma [simp]: "\<lbrakk>tinres [] r'; r' \<noteq> []\<rbrakk> \<Longrightarrow> hd r' = Bk"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3550
apply(auto simp: tinres_def)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3551
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3552
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3553
lemma [intro]: "\<exists>na. tl r = tl (r @ Bk\<up>(n)) @ Bk\<up>(na) \<or> tl (r @ Bk\<up>(n)) = tl r @ Bk\<up>(na)"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3554
apply(case_tac r, simp)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3555
apply(case_tac n, simp, simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3556
apply(rule_tac x = nat in exI, simp)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3557
apply(rule_tac x = n in exI, simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3558
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3559
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3560
lemma [simp]: "tinres r r' \<Longrightarrow> tinres (tl r) (tl r')"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3561
apply(auto simp: tinres_def)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3562
apply(case_tac r', simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3563
apply(case_tac n, simp_all)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3564
apply(rule_tac x = nat in exI, simp)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3565
apply(rule_tac x = n in exI, simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3566
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3567
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3568
lemma [simp]: "\<lbrakk>tinres r []; r \<noteq> []\<rbrakk> \<Longrightarrow> tinres (tl r) []"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3569
apply(case_tac r, auto simp: tinres_def)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3570
apply(case_tac n, simp_all add: )
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3571
apply(rule_tac x = nat in exI, simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3572
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3573
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3574
lemma [simp]: "\<lbrakk>tinres [] r'\<rbrakk> \<Longrightarrow> tinres [] (tl r')"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3575
apply(case_tac r', auto simp: tinres_def)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3576
apply(case_tac n, simp_all add: )
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3577
apply(rule_tac x = nat in exI, simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3578
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3579
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3580
lemma [simp]: "tinres r r' \<Longrightarrow> tinres (b # r) (b # r')"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3581
apply(auto simp: tinres_def)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3582
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3583
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3584
lemma [simp]: "tinres r [] \<Longrightarrow> tinres (Bk # tl r) [Bk]"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3585
apply(auto simp: tinres_def)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3586
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3587
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3588
lemma [simp]: "tinres r [] \<Longrightarrow> tinres (Oc # tl r) [Oc]"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3589
apply(auto simp: tinres_def)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3590
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3591
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3592
lemma tinres_step2:
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3593
"\<lbrakk>tinres r r'; step0 (ss, l, r) t = (sa, la, ra); step0 (ss, l, r') t = (sb, lb, rb)\<rbrakk>
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3594
\<Longrightarrow> la = lb \<and> tinres ra rb \<and> sa = sb"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3595
apply(case_tac "ss = 0", simp add: step_0)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3596
apply(simp add: step.simps [simp del], auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3597
apply(case_tac [!] "fetch t ss (read r')", simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3598
apply(auto simp: update.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3599
apply(case_tac [!] a, auto split: if_splits)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3600
done
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3601
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3602
lemma tinres_steps2:
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3603
"\<lbrakk>tinres r r'; steps0 (ss, l, r) t stp = (sa, la, ra); steps0 (ss, l, r') t stp = (sb, lb, rb)\<rbrakk>
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3604
\<Longrightarrow> la = lb \<and> tinres ra rb \<and> sa = sb"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3605
apply(induct stp arbitrary: sa la ra sb lb rb, simp add: steps.simps)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3606
apply(simp add: step_red)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3607
apply(case_tac "(steps0 (ss, l, r) t stp)")
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3608
apply(case_tac "(steps0 (ss, l, r') t stp)")
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3609
proof -
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3610
fix stp sa la ra sb lb rb a b c aa ba ca
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3611
assume ind: "\<And>sa la ra sb lb rb. \<lbrakk>steps0 (ss, l, r) t stp = (sa, la, ra);
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3612
steps0 (ss, l, r') t stp = (sb, lb, rb)\<rbrakk> \<Longrightarrow> la = lb \<and> tinres ra rb \<and> sa = sb"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3613
and h: " tinres r r'" "step0 (steps0 (ss, l, r) t stp) t = (sa, la, ra)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3614
"step0 (steps0 (ss, l, r') t stp) t = (sb, lb, rb)" "steps0 (ss, l, r) t stp = (a, b, c)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3615
"steps0 (ss, l, r') t stp = (aa, ba, ca)"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3616
have "b = ba \<and> tinres c ca \<and> a = aa"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3617
apply(rule_tac ind, simp_all add: h)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3618
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3619
thus "la = lb \<and> tinres ra rb \<and> sa = sb"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3620
apply(rule_tac l = b and r = c and ss = a and r' = ca
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3621
and t = t in tinres_step2)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3622
using h
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3623
apply(simp, simp, simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3624
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3625
qed
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3626
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3627
definition t_wcode_adjust :: "instr list"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3628
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3629
"t_wcode_adjust = [(W1, 1), (R, 2), (Nop, 2), (R, 3), (R, 3), (R, 4),
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3630
(L, 8), (L, 5), (L, 6), (W0, 5), (L, 6), (R, 7),
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3631
(W1, 2), (Nop, 7), (L, 9), (W0, 8), (L, 9), (L, 10),
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3632
(L, 11), (L, 10), (R, 0), (L, 11)]"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3633
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3634
lemma [simp]: "fetch t_wcode_adjust (Suc 0) Bk = (W1, 1)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3635
apply(simp add: fetch.simps t_wcode_adjust_def nth_of.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3636
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3637
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3638
lemma [simp]: "fetch t_wcode_adjust (Suc 0) Oc = (R, 2)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3639
apply(simp add: fetch.simps t_wcode_adjust_def nth_of.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3640
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3641
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3642
lemma [simp]: "fetch t_wcode_adjust (Suc (Suc 0)) Oc = (R, 3)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3643
apply(simp add: fetch.simps t_wcode_adjust_def nth_of.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3644
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3645
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3646
lemma [simp]: "fetch t_wcode_adjust (Suc (Suc (Suc 0))) Oc = (R, 4)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3647
apply(simp add: fetch.simps t_wcode_adjust_def nth_of.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3648
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3649
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3650
lemma [simp]: "fetch t_wcode_adjust (Suc (Suc (Suc 0))) Bk = (R, 3)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3651
apply(simp add: fetch.simps t_wcode_adjust_def nth_of.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3652
done
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3653
145
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3654
lemma [simp]: "fetch t_wcode_adjust 4 Bk = (L, 8)"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3655
apply(simp add: fetch.simps t_wcode_adjust_def nth_of.simps numeral_4_eq_4)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3656
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3657
145
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3658
lemma [simp]: "fetch t_wcode_adjust 4 Oc = (L, 5)"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3659
apply(simp add: fetch.simps t_wcode_adjust_def nth_of.simps numeral_4_eq_4)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3660
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3661
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3662
lemma [simp]: "fetch t_wcode_adjust 5 Oc = (W0, 5)"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3663
apply(simp only: fetch.simps t_wcode_adjust_def nth_of.simps numeral_5_eq_5, simp)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3664
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3665
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3666
lemma [simp]: "fetch t_wcode_adjust 5 Bk = (L, 6)"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3667
apply(simp only: fetch.simps t_wcode_adjust_def nth_of.simps numeral_5_eq_5, auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3668
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3669
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3670
lemma [simp]: "fetch t_wcode_adjust 6 Oc = (R, 7)"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3671
apply(simp add: fetch.simps t_wcode_adjust_def nth_of.simps numeral_6_eq_6)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3672
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3673
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3674
lemma [simp]: "fetch t_wcode_adjust 6 Bk = (L, 6)"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3675
apply(simp add: fetch.simps t_wcode_adjust_def nth_of.simps numeral_6_eq_6)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3676
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3677
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3678
lemma [simp]: "fetch t_wcode_adjust 7 Bk = (W1, 2)"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3679
apply(simp add: fetch.simps t_wcode_adjust_def nth_of.simps numeral_7_eq_7)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3680
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3681
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3682
lemma [simp]: "fetch t_wcode_adjust 8 Bk = (L, 9)"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3683
apply(simp add: fetch.simps t_wcode_adjust_def nth_of.simps numeral_8_eq_8)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3684
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3685
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3686
lemma [simp]: "fetch t_wcode_adjust 8 Oc = (W0, 8)"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3687
apply(simp add: fetch.simps t_wcode_adjust_def nth_of.simps numeral_8_eq_8)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3688
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3689
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3690
lemma [simp]: "fetch t_wcode_adjust 9 Oc = (L, 10)"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3691
apply(simp add: fetch.simps t_wcode_adjust_def nth_of.simps numeral_9_eq_9)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3692
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3693
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3694
lemma [simp]: "fetch t_wcode_adjust 9 Bk = (L, 9)"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3695
apply(simp add: fetch.simps t_wcode_adjust_def nth_of.simps numeral_9_eq_9)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3696
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3697
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3698
lemma [simp]: "fetch t_wcode_adjust 10 Bk = (L, 11)"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3699
apply(simp add: fetch.simps t_wcode_adjust_def nth_of.simps numeral_10_eq_10)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3700
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3701
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3702
lemma [simp]: "fetch t_wcode_adjust 10 Oc = (L, 10)"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3703
apply(simp add: fetch.simps t_wcode_adjust_def nth_of.simps eval_nat_numeral)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3704
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3705
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3706
lemma [simp]: "fetch t_wcode_adjust 11 Oc = (L, 11)"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3707
apply(simp add: fetch.simps t_wcode_adjust_def nth_of.simps eval_nat_numeral)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3708
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3709
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3710
lemma [simp]: "fetch t_wcode_adjust 11 Bk = (R, 0)"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3711
apply(simp add: fetch.simps t_wcode_adjust_def nth_of.simps eval_nat_numeral)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3712
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3713
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3714
fun wadjust_start :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3715
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3716
"wadjust_start m rs (l, r) =
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3717
(\<exists> ln rn. l = Bk # Oc\<up>(Suc m) \<and>
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3718
tl r = Oc # Bk\<up>(ln) @ Bk # Oc\<up>(Suc rs) @ Bk\<up>(rn))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3719
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3720
fun wadjust_loop_start :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3721
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3722
"wadjust_loop_start m rs (l, r) =
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3723
(\<exists> ln rn ml mr. l = Oc\<up>(ml) @ Bk # Oc\<up>(Suc m) \<and>
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3724
r = Oc # Bk\<up>(ln) @ Bk # Oc\<up>(mr) @ Bk\<up>(rn) \<and>
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3725
ml + mr = Suc (Suc rs) \<and> mr > 0)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3726
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3727
fun wadjust_loop_right_move :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3728
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3729
"wadjust_loop_right_move m rs (l, r) =
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3730
(\<exists> ml mr nl nr rn. l = Bk\<up>(nl) @ Oc # Oc\<up>(ml) @ Bk # Oc\<up>(Suc m) \<and>
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3731
r = Bk\<up>(nr) @ Oc\<up>(mr) @ Bk\<up>(rn) \<and>
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3732
ml + mr = Suc (Suc rs) \<and> mr > 0 \<and>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3733
nl + nr > 0)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3734
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3735
fun wadjust_loop_check :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3736
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3737
"wadjust_loop_check m rs (l, r) =
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3738
(\<exists> ml mr ln rn. l = Oc # Bk\<up>(ln) @ Bk # Oc # Oc\<up>(ml) @ Bk # Oc\<up>(Suc m) \<and>
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3739
r = Oc\<up>(mr) @ Bk\<up>(rn) \<and> ml + mr = (Suc rs))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3740
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3741
fun wadjust_loop_erase :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3742
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3743
"wadjust_loop_erase m rs (l, r) =
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3744
(\<exists> ml mr ln rn. l = Bk\<up>(ln) @ Bk # Oc # Oc\<up>(ml) @ Bk # Oc\<up>(Suc m) \<and>
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3745
tl r = Oc\<up>(mr) @ Bk\<up>(rn) \<and> ml + mr = (Suc rs) \<and> mr > 0)"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3746
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3747
fun wadjust_loop_on_left_moving_O :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3748
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3749
"wadjust_loop_on_left_moving_O m rs (l, r) =
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3750
(\<exists> ml mr ln rn. l = Oc\<up>(ml) @ Bk # Oc\<up>(Suc m )\<and>
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3751
r = Oc # Bk\<up>(ln) @ Bk # Bk # Oc\<up>(mr) @ Bk\<up>(rn) \<and>
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3752
ml + mr = Suc rs \<and> mr > 0)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3753
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3754
fun wadjust_loop_on_left_moving_B :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3755
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3756
"wadjust_loop_on_left_moving_B m rs (l, r) =
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3757
(\<exists> ml mr nl nr rn. l = Bk\<up>(nl) @ Oc # Oc\<up>(ml) @ Bk # Oc\<up>(Suc m) \<and>
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3758
r = Bk\<up>(nr) @ Bk # Bk # Oc\<up>(mr) @ Bk\<up>(rn) \<and>
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3759
ml + mr = Suc rs \<and> mr > 0)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3760
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3761
fun wadjust_loop_on_left_moving :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3762
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3763
"wadjust_loop_on_left_moving m rs (l, r) =
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3764
(wadjust_loop_on_left_moving_O m rs (l, r) \<or>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3765
wadjust_loop_on_left_moving_B m rs (l, r))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3766
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3767
fun wadjust_loop_right_move2 :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3768
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3769
"wadjust_loop_right_move2 m rs (l, r) =
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3770
(\<exists> ml mr ln rn. l = Oc # Oc\<up>(ml) @ Bk # Oc\<up>(Suc m) \<and>
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3771
r = Bk\<up>(ln) @ Bk # Bk # Oc\<up>(mr) @ Bk\<up>(rn) \<and>
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3772
ml + mr = Suc rs \<and> mr > 0)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3773
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3774
fun wadjust_erase2 :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3775
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3776
"wadjust_erase2 m rs (l, r) =
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3777
(\<exists> ln rn. l = Bk\<up>(ln) @ Bk # Oc # Oc\<up>(Suc rs) @ Bk # Oc\<up>(Suc m) \<and>
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3778
tl r = Bk\<up>(rn))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3779
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3780
fun wadjust_on_left_moving_O :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3781
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3782
"wadjust_on_left_moving_O m rs (l, r) =
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3783
(\<exists> rn. l = Oc\<up>(Suc rs) @ Bk # Oc\<up>(Suc m) \<and>
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3784
r = Oc # Bk\<up>(rn))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3785
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3786
fun wadjust_on_left_moving_B :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3787
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3788
"wadjust_on_left_moving_B m rs (l, r) =
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3789
(\<exists> ln rn. l = Bk\<up>(ln) @ Oc # Oc\<up>(Suc rs) @ Bk # Oc\<up>(Suc m) \<and>
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3790
r = Bk\<up>(rn))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3791
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3792
fun wadjust_on_left_moving :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3793
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3794
"wadjust_on_left_moving m rs (l, r) =
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3795
(wadjust_on_left_moving_O m rs (l, r) \<or>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3796
wadjust_on_left_moving_B m rs (l, r))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3797
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3798
fun wadjust_goon_left_moving_B :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3799
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3800
"wadjust_goon_left_moving_B m rs (l, r) =
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3801
(\<exists> rn. l = Oc\<up>(Suc m) \<and>
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3802
r = Bk # Oc\<up>(Suc (Suc rs)) @ Bk\<up>(rn))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3803
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3804
fun wadjust_goon_left_moving_O :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3805
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3806
"wadjust_goon_left_moving_O m rs (l, r) =
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3807
(\<exists> ml mr rn. l = Oc\<up>(ml) @ Bk # Oc\<up>(Suc m) \<and>
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3808
r = Oc\<up>(mr) @ Bk\<up>(rn) \<and>
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3809
ml + mr = Suc (Suc rs) \<and> mr > 0)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3810
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3811
fun wadjust_goon_left_moving :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3812
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3813
"wadjust_goon_left_moving m rs (l, r) =
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3814
(wadjust_goon_left_moving_B m rs (l, r) \<or>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3815
wadjust_goon_left_moving_O m rs (l, r))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3816
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3817
fun wadjust_backto_standard_pos_B :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3818
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3819
"wadjust_backto_standard_pos_B m rs (l, r) =
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3820
(\<exists> rn. l = [] \<and>
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3821
r = Bk # Oc\<up>(Suc m )@ Bk # Oc\<up>(Suc (Suc rs)) @ Bk\<up>(rn))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3822
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3823
fun wadjust_backto_standard_pos_O :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3824
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3825
"wadjust_backto_standard_pos_O m rs (l, r) =
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3826
(\<exists> ml mr rn. l = Oc\<up>(ml) \<and>
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3827
r = Oc\<up>(mr) @ Bk # Oc\<up>(Suc (Suc rs)) @ Bk\<up>(rn) \<and>
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3828
ml + mr = Suc m \<and> mr > 0)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3829
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3830
fun wadjust_backto_standard_pos :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3831
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3832
"wadjust_backto_standard_pos m rs (l, r) =
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3833
(wadjust_backto_standard_pos_B m rs (l, r) \<or>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3834
wadjust_backto_standard_pos_O m rs (l, r))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3835
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3836
fun wadjust_stop :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3837
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3838
"wadjust_stop m rs (l, r) =
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3839
(\<exists> rn. l = [Bk] \<and>
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3840
r = Oc\<up>(Suc m )@ Bk # Oc\<up>(Suc (Suc rs)) @ Bk\<up>(rn))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3841
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3842
declare wadjust_start.simps[simp del] wadjust_loop_start.simps[simp del]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3843
wadjust_loop_right_move.simps[simp del] wadjust_loop_check.simps[simp del]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3844
wadjust_loop_erase.simps[simp del] wadjust_loop_on_left_moving.simps[simp del]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3845
wadjust_loop_right_move2.simps[simp del] wadjust_erase2.simps[simp del]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3846
wadjust_on_left_moving_O.simps[simp del] wadjust_on_left_moving_B.simps[simp del]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3847
wadjust_on_left_moving.simps[simp del] wadjust_goon_left_moving_B.simps[simp del]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3848
wadjust_goon_left_moving_O.simps[simp del] wadjust_goon_left_moving.simps[simp del]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3849
wadjust_backto_standard_pos.simps[simp del] wadjust_backto_standard_pos_B.simps[simp del]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3850
wadjust_backto_standard_pos_O.simps[simp del] wadjust_stop.simps[simp del]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3851
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3852
fun wadjust_inv :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3853
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3854
"wadjust_inv st m rs (l, r) =
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3855
(if st = Suc 0 then wadjust_start m rs (l, r)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3856
else if st = Suc (Suc 0) then wadjust_loop_start m rs (l, r)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3857
else if st = Suc (Suc (Suc 0)) then wadjust_loop_right_move m rs (l, r)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3858
else if st = 4 then wadjust_loop_check m rs (l, r)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3859
else if st = 5 then wadjust_loop_erase m rs (l, r)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3860
else if st = 6 then wadjust_loop_on_left_moving m rs (l, r)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3861
else if st = 7 then wadjust_loop_right_move2 m rs (l, r)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3862
else if st = 8 then wadjust_erase2 m rs (l, r)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3863
else if st = 9 then wadjust_on_left_moving m rs (l, r)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3864
else if st = 10 then wadjust_goon_left_moving m rs (l, r)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3865
else if st = 11 then wadjust_backto_standard_pos m rs (l, r)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3866
else if st = 0 then wadjust_stop m rs (l, r)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3867
else False
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3868
)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3869
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3870
declare wadjust_inv.simps[simp del]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3871
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3872
fun wadjust_phase :: "nat \<Rightarrow> config \<Rightarrow> nat"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3873
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3874
"wadjust_phase rs (st, l, r) =
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3875
(if st = 1 then 3
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3876
else if st \<ge> 2 \<and> st \<le> 7 then 2
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3877
else if st \<ge> 8 \<and> st \<le> 11 then 1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3878
else 0)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3879
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3880
fun wadjust_stage :: "nat \<Rightarrow> config \<Rightarrow> nat"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3881
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3882
"wadjust_stage rs (st, l, r) =
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3883
(if st \<ge> 2 \<and> st \<le> 7 then
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3884
rs - length (takeWhile (\<lambda> a. a = Oc)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3885
(tl (dropWhile (\<lambda> a. a = Oc) (rev l @ r))))
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3886
else 0)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3887
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3888
fun wadjust_state :: "nat \<Rightarrow> config \<Rightarrow> nat"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3889
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3890
"wadjust_state rs (st, l, r) =
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3891
(if st \<ge> 2 \<and> st \<le> 7 then 8 - st
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3892
else if st \<ge> 8 \<and> st \<le> 11 then 12 - st
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3893
else 0)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3894
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3895
fun wadjust_step :: "nat \<Rightarrow> config \<Rightarrow> nat"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3896
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3897
"wadjust_step rs (st, l, r) =
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3898
(if st = 1 then (if hd r = Bk then 1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3899
else 0)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3900
else if st = 3 then length r
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3901
else if st = 5 then (if hd r = Oc then 1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3902
else 0)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3903
else if st = 6 then length l
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3904
else if st = 8 then (if hd r = Oc then 1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3905
else 0)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3906
else if st = 9 then length l
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3907
else if st = 10 then length l
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3908
else if st = 11 then (if hd r = Bk then 0
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3909
else Suc (length l))
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3910
else 0)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3911
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3912
fun wadjust_measure :: "(nat \<times> config) \<Rightarrow> nat \<times> nat \<times> nat \<times> nat"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3913
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3914
"wadjust_measure (rs, (st, l, r)) =
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3915
(wadjust_phase rs (st, l, r),
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3916
wadjust_stage rs (st, l, r),
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3917
wadjust_state rs (st, l, r),
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3918
wadjust_step rs (st, l, r))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3919
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3920
definition wadjust_le :: "((nat \<times> config) \<times> nat \<times> config) set"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3921
where "wadjust_le \<equiv> (inv_image lex_square wadjust_measure)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3922
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3923
lemma [intro]: "wf lex_square"
163
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3924
by(auto intro:wf_lex_prod simp: Abacus.lex_pair_def lex_square_def
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3925
Abacus.lex_triple_def)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3926
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3927
lemma wf_wadjust_le[intro]: "wf wadjust_le"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3928
by(auto intro:wf_inv_image simp: wadjust_le_def
163
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3929
Abacus.lex_triple_def Abacus.lex_pair_def)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3930
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3931
lemma [simp]: "wadjust_start m rs (c, []) = False"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3932
apply(auto simp: wadjust_start.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3933
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3934
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3935
lemma [simp]: "wadjust_loop_right_move m rs (c, []) \<Longrightarrow> c \<noteq> []"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3936
apply(auto simp: wadjust_loop_right_move.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3937
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3938
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3939
lemma [simp]: "wadjust_loop_right_move m rs (c, [])
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3940
\<Longrightarrow> wadjust_loop_check m rs (Bk # c, [])"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3941
apply(simp only: wadjust_loop_right_move.simps wadjust_loop_check.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3942
apply(auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3943
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3944
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3945
lemma [simp]: "wadjust_loop_check m rs (c, []) \<Longrightarrow> c \<noteq> []"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3946
apply(simp only: wadjust_loop_check.simps, auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3947
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3948
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3949
lemma [simp]: "wadjust_loop_start m rs (c, []) = False"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3950
apply(simp add: wadjust_loop_start.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3951
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3952
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3953
lemma [simp]: "wadjust_loop_right_move m rs (c, []) \<Longrightarrow>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3954
wadjust_loop_right_move m rs (Bk # c, [])"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3955
apply(simp only: wadjust_loop_right_move.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3956
apply(erule_tac exE)+
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3957
apply(auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3958
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3959
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3960
lemma [simp]: "wadjust_loop_check m rs (c, []) \<Longrightarrow> wadjust_erase2 m rs (tl c, [hd c])"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3961
apply(simp only: wadjust_loop_check.simps wadjust_erase2.simps, auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3962
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3963
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3964
lemma [simp]: " wadjust_loop_erase m rs (c, [])
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3965
\<Longrightarrow> (c = [] \<longrightarrow> wadjust_loop_on_left_moving m rs ([], [Bk])) \<and>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3966
(c \<noteq> [] \<longrightarrow> wadjust_loop_on_left_moving m rs (tl c, [hd c]))"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3967
apply(simp add: wadjust_loop_erase.simps)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3968
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3969
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3970
lemma [simp]: "wadjust_loop_on_left_moving m rs (c, []) = False"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3971
apply(auto simp: wadjust_loop_on_left_moving.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3972
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3973
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3974
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3975
lemma [simp]: "wadjust_loop_right_move2 m rs (c, []) = False"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3976
apply(auto simp: wadjust_loop_right_move2.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3977
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3978
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3979
lemma [simp]: "wadjust_erase2 m rs ([], []) = False"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3980
apply(auto simp: wadjust_erase2.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3981
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3982
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3983
lemma [simp]: "wadjust_on_left_moving_B m rs
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3984
(Oc # Oc # Oc\<up>(rs) @ Bk # Oc # Oc\<up>(m), [Bk])"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3985
apply(simp add: wadjust_on_left_moving_B.simps, auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3986
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3987
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3988
lemma [simp]: "wadjust_on_left_moving_B m rs
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3989
(Bk\<up>(n) @ Bk # Oc # Oc # Oc\<up>(rs) @ Bk # Oc # Oc\<up>(m), [Bk])"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3990
apply(simp add: wadjust_on_left_moving_B.simps , auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3991
apply(rule_tac x = "Suc n" in exI, simp add: exp_ind del: replicate_Suc)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3992
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3993
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3994
lemma [simp]: "\<lbrakk>wadjust_erase2 m rs (c, []); c \<noteq> []\<rbrakk> \<Longrightarrow>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3995
wadjust_on_left_moving m rs (tl c, [hd c])"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3996
apply(simp only: wadjust_erase2.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3997
apply(erule_tac exE)+
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 3998
apply(case_tac ln, simp_all add: wadjust_on_left_moving.simps)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 3999
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4000
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4001
lemma [simp]: "wadjust_erase2 m rs (c, [])
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4002
\<Longrightarrow> (c = [] \<longrightarrow> wadjust_on_left_moving m rs ([], [Bk])) \<and>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4003
(c \<noteq> [] \<longrightarrow> wadjust_on_left_moving m rs (tl c, [hd c]))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4004
apply(auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4005
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4006
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4007
lemma [simp]: "wadjust_on_left_moving m rs ([], []) = False"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4008
apply(simp add: wadjust_on_left_moving.simps
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4009
wadjust_on_left_moving_O.simps wadjust_on_left_moving_B.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4010
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4011
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4012
lemma [simp]: "wadjust_on_left_moving_O m rs (c, []) = False"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4013
apply(simp add: wadjust_on_left_moving_O.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4014
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4015
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4016
lemma [simp]: " \<lbrakk>wadjust_on_left_moving_B m rs (c, []); c \<noteq> []; hd c = Bk\<rbrakk> \<Longrightarrow>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4017
wadjust_on_left_moving_B m rs (tl c, [Bk])"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4018
apply(simp add: wadjust_on_left_moving_B.simps, auto)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4019
apply(case_tac [!] ln, simp_all)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4020
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4021
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4022
lemma [simp]: "\<lbrakk>wadjust_on_left_moving_B m rs (c, []); c \<noteq> []; hd c = Oc\<rbrakk> \<Longrightarrow>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4023
wadjust_on_left_moving_O m rs (tl c, [Oc])"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4024
apply(simp add: wadjust_on_left_moving_B.simps wadjust_on_left_moving_O.simps, auto)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4025
apply(case_tac [!] ln, simp_all add: )
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4026
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4027
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4028
lemma [simp]: "\<lbrakk>wadjust_on_left_moving m rs (c, []); c \<noteq> []\<rbrakk> \<Longrightarrow>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4029
wadjust_on_left_moving m rs (tl c, [hd c])"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4030
apply(simp add: wadjust_on_left_moving.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4031
apply(case_tac "hd c", simp_all)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4032
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4033
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4034
lemma [simp]: "wadjust_on_left_moving m rs (c, [])
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4035
\<Longrightarrow> (c = [] \<longrightarrow> wadjust_on_left_moving m rs ([], [Bk])) \<and>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4036
(c \<noteq> [] \<longrightarrow> wadjust_on_left_moving m rs (tl c, [hd c]))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4037
apply(auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4038
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4039
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4040
lemma [simp]: "wadjust_goon_left_moving m rs (c, []) = False"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4041
apply(auto simp: wadjust_goon_left_moving.simps wadjust_goon_left_moving_B.simps
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4042
wadjust_goon_left_moving_O.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4043
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4044
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4045
lemma [simp]: "wadjust_backto_standard_pos m rs (c, []) = False"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4046
apply(auto simp: wadjust_backto_standard_pos.simps
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4047
wadjust_backto_standard_pos_B.simps wadjust_backto_standard_pos_O.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4048
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4049
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4050
lemma [simp]:
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4051
"wadjust_start m rs (c, Bk # list) \<Longrightarrow>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4052
(c = [] \<longrightarrow> wadjust_start m rs ([], Oc # list)) \<and>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4053
(c \<noteq> [] \<longrightarrow> wadjust_start m rs (c, Oc # list))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4054
apply(auto simp: wadjust_start.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4055
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4056
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4057
lemma [simp]: "wadjust_loop_start m rs (c, Bk # list) = False"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4058
apply(auto simp: wadjust_loop_start.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4059
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4060
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4061
lemma [simp]: "wadjust_loop_right_move m rs (c, b) \<Longrightarrow> c \<noteq> []"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4062
apply(simp only: wadjust_loop_right_move.simps, auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4063
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4064
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4065
lemma [simp]: "wadjust_loop_right_move m rs (c, Bk # list)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4066
\<Longrightarrow> wadjust_loop_right_move m rs (Bk # c, list)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4067
apply(simp only: wadjust_loop_right_move.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4068
apply(erule_tac exE)+
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4069
apply(rule_tac x = ml in exI, simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4070
apply(rule_tac x = mr in exI, simp)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4071
apply(rule_tac x = "Suc nl" in exI, simp add: )
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4072
apply(case_tac nr, simp, case_tac mr, simp_all add: )
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4073
apply(rule_tac x = nat in exI, auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4074
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4075
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4076
lemma [simp]: "wadjust_loop_check m rs (c, b) \<Longrightarrow> c \<noteq> []"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4077
apply(simp only: wadjust_loop_check.simps, auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4078
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4079
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4080
lemma [simp]: "wadjust_loop_check m rs (c, Bk # list)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4081
\<Longrightarrow> wadjust_erase2 m rs (tl c, hd c # Bk # list)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4082
apply(auto simp: wadjust_loop_check.simps wadjust_erase2.simps)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4083
apply(case_tac [!] mr, simp_all)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4084
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4085
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4086
lemma [simp]: "wadjust_loop_erase m rs (c, b) \<Longrightarrow> c \<noteq> []"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4087
apply(simp only: wadjust_loop_erase.simps, auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4088
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4089
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4090
declare wadjust_loop_on_left_moving_O.simps[simp del]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4091
wadjust_loop_on_left_moving_B.simps[simp del]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4092
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4093
lemma [simp]: "\<lbrakk>wadjust_loop_erase m rs (c, Bk # list); hd c = Bk\<rbrakk>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4094
\<Longrightarrow> wadjust_loop_on_left_moving_B m rs (tl c, Bk # Bk # list)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4095
apply(simp only: wadjust_loop_erase.simps
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4096
wadjust_loop_on_left_moving_B.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4097
apply(erule_tac exE)+
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4098
apply(rule_tac x = ml in exI, rule_tac x = mr in exI,
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4099
rule_tac x = ln in exI, rule_tac x = 0 in exI, simp)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4100
apply(case_tac ln, simp_all add: , auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4101
apply(simp add: exp_ind [THEN sym])
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4102
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4103
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4104
lemma [simp]: "\<lbrakk>wadjust_loop_erase m rs (c, Bk # list); c \<noteq> []; hd c = Oc\<rbrakk> \<Longrightarrow>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4105
wadjust_loop_on_left_moving_O m rs (tl c, Oc # Bk # list)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4106
apply(simp only: wadjust_loop_erase.simps wadjust_loop_on_left_moving_O.simps,
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4107
auto)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4108
apply(case_tac [!] ln, simp_all add: )
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4109
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4110
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4111
lemma [simp]: "\<lbrakk>wadjust_loop_erase m rs (c, Bk # list); c \<noteq> []\<rbrakk> \<Longrightarrow>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4112
wadjust_loop_on_left_moving m rs (tl c, hd c # Bk # list)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4113
apply(case_tac "hd c", simp_all add:wadjust_loop_on_left_moving.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4114
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4115
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4116
lemma [simp]: "wadjust_loop_on_left_moving m rs (c, b) \<Longrightarrow> c \<noteq> []"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4117
apply(simp add: wadjust_loop_on_left_moving.simps
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4118
wadjust_loop_on_left_moving_O.simps wadjust_loop_on_left_moving_B.simps, auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4119
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4120
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4121
lemma [simp]: "wadjust_loop_on_left_moving_O m rs (c, Bk # list) = False"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4122
apply(simp add: wadjust_loop_on_left_moving_O.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4123
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4124
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4125
lemma [simp]: "\<lbrakk>wadjust_loop_on_left_moving_B m rs (c, Bk # list); hd c = Bk\<rbrakk>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4126
\<Longrightarrow> wadjust_loop_on_left_moving_B m rs (tl c, Bk # Bk # list)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4127
apply(simp only: wadjust_loop_on_left_moving_B.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4128
apply(erule_tac exE)+
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4129
apply(rule_tac x = ml in exI, rule_tac x = mr in exI)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4130
apply(case_tac nl, simp_all add: , auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4131
apply(rule_tac x = "Suc nr" in exI, auto simp: )
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4132
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4133
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4134
lemma [simp]: "\<lbrakk>wadjust_loop_on_left_moving_B m rs (c, Bk # list); hd c = Oc\<rbrakk>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4135
\<Longrightarrow> wadjust_loop_on_left_moving_O m rs (tl c, Oc # Bk # list)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4136
apply(simp only: wadjust_loop_on_left_moving_O.simps
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4137
wadjust_loop_on_left_moving_B.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4138
apply(erule_tac exE)+
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4139
apply(rule_tac x = ml in exI, rule_tac x = mr in exI)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4140
apply(case_tac nl, simp_all add: , auto)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4141
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4142
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4143
lemma [simp]: "wadjust_loop_on_left_moving m rs (c, Bk # list)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4144
\<Longrightarrow> wadjust_loop_on_left_moving m rs (tl c, hd c # Bk # list)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4145
apply(simp add: wadjust_loop_on_left_moving.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4146
apply(case_tac "hd c", simp_all)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4147
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4148
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4149
lemma [simp]: "wadjust_loop_right_move2 m rs (c, b) \<Longrightarrow> c \<noteq> []"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4150
apply(simp only: wadjust_loop_right_move2.simps, auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4151
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4152
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4153
lemma [simp]: "wadjust_loop_right_move2 m rs (c, Bk # list) \<Longrightarrow> wadjust_loop_start m rs (c, Oc # list)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4154
apply(auto simp: wadjust_loop_right_move2.simps wadjust_loop_start.simps)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4155
apply(case_tac ln, simp_all add: )
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4156
apply(rule_tac x = 0 in exI, simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4157
apply(rule_tac x = rn in exI, simp)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4158
apply(rule_tac x = "Suc ml" in exI, simp add: , auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4159
apply(rule_tac x = "Suc nat" in exI, simp add: exp_ind del: replicate_Suc)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4160
apply(rule_tac x = rn in exI, auto)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4161
apply(rule_tac x = "Suc ml" in exI, auto )
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4162
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4163
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4164
lemma [simp]: "wadjust_erase2 m rs (c, Bk # list) \<Longrightarrow> c \<noteq> []"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4165
apply(auto simp:wadjust_erase2.simps )
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4166
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4167
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4168
lemma [simp]: "wadjust_erase2 m rs (c, Bk # list) \<Longrightarrow>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4169
wadjust_on_left_moving m rs (tl c, hd c # Bk # list)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4170
apply(auto simp: wadjust_erase2.simps)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4171
apply(case_tac ln, simp_all add: wadjust_on_left_moving.simps
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4172
wadjust_on_left_moving_O.simps wadjust_on_left_moving_B.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4173
apply(auto)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4174
apply(rule_tac x = "(Suc (Suc rn))" in exI, simp add: )
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4175
apply(rule_tac x = "Suc nat" in exI, simp add: exp_ind del: replicate_Suc)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4176
apply(rule_tac x = "(Suc (Suc rn))" in exI, simp add: )
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4177
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4178
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4179
lemma [simp]: "wadjust_on_left_moving m rs (c,b) \<Longrightarrow> c \<noteq> []"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4180
apply(simp only:wadjust_on_left_moving.simps
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4181
wadjust_on_left_moving_O.simps
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4182
wadjust_on_left_moving_B.simps
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4183
, auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4184
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4185
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4186
lemma [simp]: "wadjust_on_left_moving_O m rs (c, Bk # list) = False"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4187
apply(simp add: wadjust_on_left_moving_O.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4188
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4189
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4190
lemma [simp]: "\<lbrakk>wadjust_on_left_moving_B m rs (c, Bk # list); hd c = Bk\<rbrakk>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4191
\<Longrightarrow> wadjust_on_left_moving_B m rs (tl c, Bk # Bk # list)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4192
apply(auto simp: wadjust_on_left_moving_B.simps)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4193
apply(case_tac ln, simp_all)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4194
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4195
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4196
lemma [simp]: "\<lbrakk>wadjust_on_left_moving_B m rs (c, Bk # list); hd c = Oc\<rbrakk>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4197
\<Longrightarrow> wadjust_on_left_moving_O m rs (tl c, Oc # Bk # list)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4198
apply(auto simp: wadjust_on_left_moving_O.simps
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4199
wadjust_on_left_moving_B.simps)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4200
apply(case_tac ln, simp_all add: )
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4201
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4202
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4203
lemma [simp]: "wadjust_on_left_moving m rs (c, Bk # list) \<Longrightarrow>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4204
wadjust_on_left_moving m rs (tl c, hd c # Bk # list)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4205
apply(simp add: wadjust_on_left_moving.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4206
apply(case_tac "hd c", simp_all)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4207
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4208
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4209
lemma [simp]: "wadjust_goon_left_moving m rs (c, b) \<Longrightarrow> c \<noteq> []"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4210
apply(simp add: wadjust_goon_left_moving.simps
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4211
wadjust_goon_left_moving_B.simps
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4212
wadjust_goon_left_moving_O.simps , auto)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4213
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4214
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4215
lemma [simp]: "wadjust_goon_left_moving_O m rs (c, Bk # list) = False"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4216
apply(simp add: wadjust_goon_left_moving_O.simps, auto)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4217
apply(case_tac mr, simp_all add: )
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4218
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4219
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4220
lemma [simp]: "\<lbrakk>wadjust_goon_left_moving_B m rs (c, Bk # list); hd c = Bk\<rbrakk>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4221
\<Longrightarrow> wadjust_backto_standard_pos_B m rs (tl c, Bk # Bk # list)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4222
apply(auto simp: wadjust_goon_left_moving_B.simps
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4223
wadjust_backto_standard_pos_B.simps )
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4224
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4225
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4226
lemma [simp]: "\<lbrakk>wadjust_goon_left_moving_B m rs (c, Bk # list); hd c = Oc\<rbrakk>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4227
\<Longrightarrow> wadjust_backto_standard_pos_O m rs (tl c, Oc # Bk # list)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4228
apply(auto simp: wadjust_goon_left_moving_B.simps
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4229
wadjust_backto_standard_pos_O.simps)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4230
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4231
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4232
lemma [simp]: "wadjust_goon_left_moving m rs (c, Bk # list) \<Longrightarrow>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4233
wadjust_backto_standard_pos m rs (tl c, hd c # Bk # list)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4234
apply(case_tac "hd c", simp_all add: wadjust_backto_standard_pos.simps
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4235
wadjust_goon_left_moving.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4236
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4237
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4238
lemma [simp]: "wadjust_backto_standard_pos m rs (c, Bk # list) \<Longrightarrow>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4239
(c = [] \<longrightarrow> wadjust_stop m rs ([Bk], list)) \<and> (c \<noteq> [] \<longrightarrow> wadjust_stop m rs (Bk # c, list))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4240
apply(auto simp: wadjust_backto_standard_pos.simps
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4241
wadjust_backto_standard_pos_B.simps
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4242
wadjust_backto_standard_pos_O.simps wadjust_stop.simps)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4243
apply(case_tac [!] mr, simp_all add: )
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4244
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4245
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4246
lemma [simp]: "wadjust_start m rs (c, Oc # list)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4247
\<Longrightarrow> (c = [] \<longrightarrow> wadjust_loop_start m rs ([Oc], list)) \<and>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4248
(c \<noteq> [] \<longrightarrow> wadjust_loop_start m rs (Oc # c, list))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4249
apply(auto simp:wadjust_loop_start.simps wadjust_start.simps )
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4250
apply(rule_tac x = ln in exI, rule_tac x = rn in exI,
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4251
rule_tac x = "Suc 0" in exI, simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4252
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4253
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4254
lemma [simp]: "wadjust_loop_start m rs (c, b) \<Longrightarrow> c \<noteq> []"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4255
apply(simp add: wadjust_loop_start.simps, auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4256
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4257
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4258
lemma [simp]: "wadjust_loop_start m rs (c, Oc # list)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4259
\<Longrightarrow> wadjust_loop_right_move m rs (Oc # c, list)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4260
apply(simp add: wadjust_loop_start.simps wadjust_loop_right_move.simps, auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4261
apply(rule_tac x = ml in exI, rule_tac x = mr in exI,
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4262
rule_tac x = 0 in exI, simp)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4263
apply(rule_tac x = "Suc ln" in exI, simp add: exp_ind del: replicate_Suc)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4264
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4265
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4266
lemma [simp]: "wadjust_loop_right_move m rs (c, Oc # list) \<Longrightarrow>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4267
wadjust_loop_check m rs (Oc # c, list)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4268
apply(simp add: wadjust_loop_right_move.simps
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4269
wadjust_loop_check.simps, auto)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4270
apply(rule_tac [!] x = ml in exI, simp_all add: exp_ind del: replicate_Suc, auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4271
apply(case_tac nl, simp_all add: exp_ind del: replicate_Suc)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4272
apply(rule_tac x = "mr - 1" in exI, case_tac mr, simp_all add: )
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4273
apply(case_tac [!] nr, simp_all)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4274
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4275
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4276
lemma [simp]: "wadjust_loop_check m rs (c, Oc # list) \<Longrightarrow>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4277
wadjust_loop_erase m rs (tl c, hd c # Oc # list)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4278
apply(simp only: wadjust_loop_check.simps wadjust_loop_erase.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4279
apply(erule_tac exE)+
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4280
apply(rule_tac x = ml in exI, rule_tac x = mr in exI, auto)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4281
apply(case_tac mr, simp_all add: )
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4282
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4283
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4284
lemma [simp]: "wadjust_loop_erase m rs (c, Oc # list) \<Longrightarrow>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4285
wadjust_loop_erase m rs (c, Bk # list)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4286
apply(auto simp: wadjust_loop_erase.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4287
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4288
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4289
lemma [simp]: "wadjust_loop_on_left_moving_B m rs (c, Oc # list) = False"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4290
apply(auto simp: wadjust_loop_on_left_moving_B.simps)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4291
apply(case_tac nr, simp_all add: )
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4292
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4293
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4294
lemma [simp]: "wadjust_loop_on_left_moving m rs (c, Oc # list)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4295
\<Longrightarrow> wadjust_loop_right_move2 m rs (Oc # c, list)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4296
apply(simp add:wadjust_loop_on_left_moving.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4297
apply(auto simp: wadjust_loop_on_left_moving_O.simps
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4298
wadjust_loop_right_move2.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4299
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4300
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4301
lemma [simp]: "wadjust_loop_right_move2 m rs (c, Oc # list) = False"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4302
apply(auto simp: wadjust_loop_right_move2.simps )
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4303
apply(case_tac ln, simp_all add: )
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4304
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4305
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4306
lemma [simp]: "wadjust_erase2 m rs (c, Oc # list)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4307
\<Longrightarrow> (c = [] \<longrightarrow> wadjust_erase2 m rs ([], Bk # list))
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4308
\<and> (c \<noteq> [] \<longrightarrow> wadjust_erase2 m rs (c, Bk # list))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4309
apply(auto simp: wadjust_erase2.simps )
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4310
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4311
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4312
lemma [simp]: "wadjust_on_left_moving_B m rs (c, Oc # list) = False"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4313
apply(auto simp: wadjust_on_left_moving_B.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4314
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4315
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4316
lemma [simp]: "\<lbrakk>wadjust_on_left_moving_O m rs (c, Oc # list); hd c = Bk\<rbrakk> \<Longrightarrow>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4317
wadjust_goon_left_moving_B m rs (tl c, Bk # Oc # list)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4318
apply(auto simp: wadjust_on_left_moving_O.simps
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4319
wadjust_goon_left_moving_B.simps )
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4320
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4321
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4322
lemma [simp]: "\<lbrakk>wadjust_on_left_moving_O m rs (c, Oc # list); hd c = Oc\<rbrakk>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4323
\<Longrightarrow> wadjust_goon_left_moving_O m rs (tl c, Oc # Oc # list)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4324
apply(auto simp: wadjust_on_left_moving_O.simps
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4325
wadjust_goon_left_moving_O.simps )
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4326
apply(auto simp: numeral_2_eq_2)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4327
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4328
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4329
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>
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)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4332
apply(simp add: wadjust_on_left_moving.simps
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4333
wadjust_goon_left_moving.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4334
apply(case_tac "hd c", simp_all)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4335
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4336
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4337
lemma [simp]: "wadjust_on_left_moving m rs (c, Oc # list) \<Longrightarrow>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4338
wadjust_goon_left_moving m rs (tl c, hd c # Oc # list)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4339
apply(simp add: wadjust_on_left_moving.simps
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4340
wadjust_goon_left_moving.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4341
apply(case_tac "hd c", simp_all)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4342
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4343
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4344
lemma [simp]: "wadjust_goon_left_moving_B m rs (c, Oc # list) = False"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4345
apply(auto simp: wadjust_goon_left_moving_B.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4346
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4347
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4348
lemma [simp]: "\<lbrakk>wadjust_goon_left_moving_O m rs (c, Oc # list); hd c = Bk\<rbrakk>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4349
\<Longrightarrow> wadjust_goon_left_moving_B m rs (tl c, Bk # Oc # list)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4350
apply(auto simp: wadjust_goon_left_moving_O.simps wadjust_goon_left_moving_B.simps)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4351
apply(case_tac [!] ml, auto simp: )
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4352
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4353
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4354
lemma [simp]: "\<lbrakk>wadjust_goon_left_moving_O m rs (c, Oc # list); hd c = Oc\<rbrakk> \<Longrightarrow>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4355
wadjust_goon_left_moving_O m rs (tl c, Oc # Oc # list)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4356
apply(auto simp: wadjust_goon_left_moving_O.simps wadjust_goon_left_moving_B.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4357
apply(rule_tac x = "ml - 1" in exI, simp)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4358
apply(case_tac ml, simp_all add: )
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4359
apply(rule_tac x = "Suc mr" in exI, auto simp: )
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4360
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4361
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4362
lemma [simp]: "wadjust_goon_left_moving m rs (c, Oc # list) \<Longrightarrow>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4363
wadjust_goon_left_moving m rs (tl c, hd c # Oc # list)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4364
apply(simp add: wadjust_goon_left_moving.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4365
apply(case_tac "hd c", simp_all)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4366
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4367
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4368
lemma [simp]: "wadjust_backto_standard_pos_B m rs (c, Oc # list) = False"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4369
apply(simp add: wadjust_backto_standard_pos_B.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4370
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4371
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4372
lemma [simp]: "wadjust_backto_standard_pos_O m rs (c, Bk # xs) = False"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4373
apply(simp add: wadjust_backto_standard_pos_O.simps, auto)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4374
apply(case_tac mr, simp_all add: )
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4375
done
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4376
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4377
lemma [simp]: "wadjust_backto_standard_pos_O m rs ([], Oc # list) \<Longrightarrow>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4378
wadjust_backto_standard_pos_B m rs ([], Bk # Oc # list)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4379
apply(auto simp: wadjust_backto_standard_pos_O.simps
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4380
wadjust_backto_standard_pos_B.simps)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4381
done
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4382
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4383
lemma [simp]:
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4384
"\<lbrakk>wadjust_backto_standard_pos_O m rs (c, Oc # list); c \<noteq> []; hd c = Bk\<rbrakk>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4385
\<Longrightarrow> wadjust_backto_standard_pos_B m rs (tl c, Bk # Oc # list)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4386
apply(simp add:wadjust_backto_standard_pos_O.simps
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4387
wadjust_backto_standard_pos_B.simps, auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4388
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4389
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4390
lemma [simp]: "\<lbrakk>wadjust_backto_standard_pos_O m rs (c, Oc # list); c \<noteq> []; hd c = Oc\<rbrakk>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4391
\<Longrightarrow> wadjust_backto_standard_pos_O m rs (tl c, Oc # Oc # list)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4392
apply(simp add: wadjust_backto_standard_pos_O.simps, auto)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4393
apply(case_tac ml, simp_all add: , auto)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4394
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4395
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4396
lemma [simp]: "wadjust_backto_standard_pos m rs (c, Oc # list)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4397
\<Longrightarrow> (c = [] \<longrightarrow> wadjust_backto_standard_pos m rs ([], Bk # Oc # list)) \<and>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4398
(c \<noteq> [] \<longrightarrow> wadjust_backto_standard_pos m rs (tl c, hd c # Oc # list))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4399
apply(auto simp: wadjust_backto_standard_pos.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4400
apply(case_tac "hd c", simp_all)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4401
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4402
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4403
lemma [simp]: "wadjust_loop_right_move m rs (c, []) = False"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4404
apply(simp only: wadjust_loop_right_move.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4405
apply(rule_tac iffI)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4406
apply(erule_tac exE)+
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4407
apply(case_tac nr, simp_all add: )
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4408
apply(case_tac mr, simp_all add: )
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4409
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4410
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4411
lemma [simp]: "wadjust_loop_erase m rs (c, []) = False"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4412
apply(simp only: wadjust_loop_erase.simps, auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4413
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4414
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4415
lemma [simp]: "\<lbrakk>Suc (Suc rs) = a; wadjust_loop_erase m rs (c, Bk # list)\<rbrakk>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4416
\<Longrightarrow> a - length (takeWhile (\<lambda>a. a = Oc) (tl (dropWhile (\<lambda>a. a = Oc) (rev (tl c) @ hd c # Bk # list))))
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4417
< a - length (takeWhile (\<lambda>a. a = Oc) (tl (dropWhile (\<lambda>a. a = Oc) (rev c @ Bk # list)))) \<or>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4418
a - length (takeWhile (\<lambda>a. a = Oc) (tl (dropWhile (\<lambda>a. a = Oc) (rev (tl c) @ hd c # Bk # list)))) =
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4419
a - length (takeWhile (\<lambda>a. a = Oc) (tl (dropWhile (\<lambda>a. a = Oc) (rev c @ Bk # list))))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4420
apply(simp only: wadjust_loop_erase.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4421
apply(rule_tac disjI2)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4422
apply(case_tac c, simp, simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4423
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4424
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4425
lemma [simp]:
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4426
"\<lbrakk>Suc (Suc rs) = a; wadjust_loop_on_left_moving m rs (c, Bk # list)\<rbrakk>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4427
\<Longrightarrow> a - length (takeWhile (\<lambda>a. a = Oc) (tl (dropWhile (\<lambda>a. a = Oc) (rev (tl c) @ hd c # Bk # list))))
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4428
< a - length (takeWhile (\<lambda>a. a = Oc) (tl (dropWhile (\<lambda>a. a = Oc) (rev c @ Bk # list)))) \<or>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4429
a - length (takeWhile (\<lambda>a. a = Oc) (tl (dropWhile (\<lambda>a. a = Oc) (rev (tl c) @ hd c # Bk # list)))) =
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4430
a - length (takeWhile (\<lambda>a. a = Oc) (tl (dropWhile (\<lambda>a. a = Oc) (rev c @ Bk # list))))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4431
apply(subgoal_tac "c \<noteq> []")
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4432
apply(case_tac c, simp_all)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4433
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4434
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4435
lemma dropWhile_exp1: "dropWhile (\<lambda>a. a = Oc) (Oc\<up>(n) @ xs) = dropWhile (\<lambda>a. a = Oc) xs"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4436
apply(induct n, simp_all add: )
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4437
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4438
lemma takeWhile_exp1: "takeWhile (\<lambda>a. a = Oc) (Oc\<up>(n) @ xs) = Oc\<up>(n) @ takeWhile (\<lambda>a. a = Oc) xs"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4439
apply(induct n, simp_all add: )
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4440
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4441
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4442
lemma [simp]: "\<lbrakk>Suc (Suc rs) = a; wadjust_loop_right_move2 m rs (c, Bk # list)\<rbrakk>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4443
\<Longrightarrow> a - length (takeWhile (\<lambda>a. a = Oc) (tl (dropWhile (\<lambda>a. a = Oc) (rev c @ Oc # list))))
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4444
< a - length (takeWhile (\<lambda>a. a = Oc) (tl (dropWhile (\<lambda>a. a = Oc) (rev c @ Bk # list))))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4445
apply(simp add: wadjust_loop_right_move2.simps, auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4446
apply(simp add: dropWhile_exp1 takeWhile_exp1)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4447
apply(case_tac ln, simp, simp add: )
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4448
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4449
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4450
lemma [simp]: "wadjust_loop_check m rs ([], b) = False"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4451
apply(simp add: wadjust_loop_check.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4452
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4453
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4454
lemma [simp]: "\<lbrakk>Suc (Suc rs) = a; wadjust_loop_check m rs (c, Oc # list)\<rbrakk>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4455
\<Longrightarrow> a - length (takeWhile (\<lambda>a. a = Oc) (tl (dropWhile (\<lambda>a. a = Oc) (rev (tl c) @ hd c # Oc # list))))
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4456
< a - length (takeWhile (\<lambda>a. a = Oc) (tl (dropWhile (\<lambda>a. a = Oc) (rev c @ Oc # list)))) \<or>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4457
a - length (takeWhile (\<lambda>a. a = Oc) (tl (dropWhile (\<lambda>a. a = Oc) (rev (tl c) @ hd c # Oc # list)))) =
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))))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4459
apply(case_tac "c", simp_all)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4460
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4461
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4462
lemma [simp]:
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4463
"\<lbrakk>Suc (Suc rs) = a; wadjust_loop_erase m rs (c, Oc # list)\<rbrakk>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4464
\<Longrightarrow> a - length (takeWhile (\<lambda>a. a = Oc) (tl (dropWhile (\<lambda>a. a = Oc) (rev c @ Bk # list))))
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4465
< a - length (takeWhile (\<lambda>a. a = Oc) (tl (dropWhile (\<lambda>a. a = Oc) (rev c @ Oc # list)))) \<or>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4466
a - length (takeWhile (\<lambda>a. a = Oc) (tl (dropWhile (\<lambda>a. a = Oc) (rev c @ Bk # list)))) =
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4467
a - length (takeWhile (\<lambda>a. a = Oc) (tl (dropWhile (\<lambda>a. a = Oc) (rev c @ Oc # list))))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4468
apply(simp add: wadjust_loop_erase.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4469
apply(rule_tac disjI2)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4470
apply(auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4471
apply(simp add: dropWhile_exp1 takeWhile_exp1)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4472
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4473
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4474
declare numeral_2_eq_2[simp del]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4475
145
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4476
lemma [simp]: "wadjust_start m rs (c, Bk # list)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4477
\<Longrightarrow> wadjust_start m rs (c, Oc # list)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4478
apply(auto simp: wadjust_start.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4479
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4480
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4481
lemma [simp]: "wadjust_backto_standard_pos m rs (c, Bk # list)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4482
\<Longrightarrow> wadjust_stop m rs (Bk # c, list)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4483
apply(auto simp: wadjust_backto_standard_pos.simps
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4484
wadjust_stop.simps wadjust_backto_standard_pos_B.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4485
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4486
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4487
lemma [simp]: "wadjust_start m rs (c, Oc # list)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4488
\<Longrightarrow> wadjust_loop_start m rs (Oc # c, list)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4489
apply(auto simp: wadjust_start.simps wadjust_loop_start.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4490
apply(rule_tac x = ln in exI, simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4491
apply(rule_tac x = "rn" in exI, simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4492
apply(rule_tac x = 1 in exI, simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4493
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4494
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4495
lemma [simp]:" wadjust_erase2 m rs (c, Oc # list)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4496
\<Longrightarrow> wadjust_erase2 m rs (c, Bk # list)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4497
apply(auto simp: wadjust_erase2.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4498
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4499
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4500
lemma wadjust_correctness:
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4501
shows "let P = (\<lambda> (len, st, l, r). st = 0) in
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4502
let Q = (\<lambda> (len, st, l, r). wadjust_inv st m rs (l, r)) in
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4503
let f = (\<lambda> stp. (Suc (Suc rs), steps0 (Suc 0, Bk # Oc\<up>(Suc m),
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4504
Bk # Oc # Bk\<up>(ln) @ Bk # Oc\<up>(Suc rs) @ Bk\<up>(rn)) t_wcode_adjust stp)) in
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4505
\<exists> n .P (f n) \<and> Q (f n)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4506
proof -
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4507
let ?P = "(\<lambda> (len, st, l, r). st = 0)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4508
let ?Q = "\<lambda> (len, st, l, r). wadjust_inv st m rs (l, r)"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4509
let ?f = "\<lambda> stp. (Suc (Suc rs), steps0 (Suc 0, Bk # Oc\<up>(Suc m),
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4510
Bk # Oc # Bk\<up>(ln) @ Bk # Oc\<up>(Suc rs) @ Bk\<up>(rn)) t_wcode_adjust stp)"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4511
have "\<exists> n. ?P (?f n) \<and> ?Q (?f n)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4512
proof(rule_tac halt_lemma2)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4513
show "wf wadjust_le" by auto
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4514
next
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4515
show "\<forall> n. \<not> ?P (?f n) \<and> ?Q (?f n) \<longrightarrow>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4516
?Q (?f (Suc n)) \<and> (?f (Suc n), ?f n) \<in> wadjust_le"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4517
apply(rule_tac allI, rule_tac impI, case_tac "?f n", simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4518
apply(simp add: step.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4519
apply(case_tac d, case_tac [2] aa, simp_all)
145
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4520
apply(simp_all only: wadjust_inv.simps split: if_splits)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4521
apply(simp_all)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4522
apply(simp_all add: wadjust_inv.simps wadjust_le_def
163
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4523
Abacus.lex_triple_def Abacus.lex_pair_def lex_square_def split: if_splits)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4524
done
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4525
next
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4526
show "?Q (?f 0)"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4527
apply(simp add: steps.simps wadjust_inv.simps wadjust_start.simps, auto)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4528
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4529
next
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4530
show "\<not> ?P (?f 0)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4531
apply(simp add: steps.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4532
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4533
qed
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4534
thus"?thesis"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4535
apply(simp)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4536
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4537
qed
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4538
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4539
lemma [intro]: "tm_wf (t_wcode_adjust, 0)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4540
apply(auto simp: t_wcode_adjust_def tm_wf.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4541
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4542
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4543
declare tm_comp.simps[simp del]
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4544
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4545
lemma [simp]: "args \<noteq> [] \<Longrightarrow> bl_bin (<args::nat list>) > 0"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4546
apply(case_tac args)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4547
apply(auto simp: tape_of_nl_cons bl_bin.simps split: if_splits)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4548
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4549
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4550
lemma wcode_lemma_pre':
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4551
"args \<noteq> [] \<Longrightarrow>
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4552
\<exists> stp rn. steps0 (Suc 0, [], <m # args>)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4553
((t_wcode_prepare |+| t_wcode_main) |+| t_wcode_adjust) stp
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4554
= (0, [Bk], Oc\<up>(Suc m) @ Bk # Oc\<up>(Suc (bl_bin (<args>))) @ Bk\<up>(rn))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4555
proof -
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4556
let ?P1 = "\<lambda> (l, r). l = [] \<and> r = <m # args>"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4557
let ?Q1 = "\<lambda>(l, r). l = Bk # Oc\<up>(Suc m) \<and>
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4558
(\<exists>ln rn. r = Bk # Oc # Bk\<up>(ln) @ Bk # Bk # Oc\<up>(bl_bin (<args>)) @ Bk\<up>(rn))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4559
let ?P2 = ?Q1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4560
let ?Q2 = "\<lambda> (l, r). (wadjust_stop m (bl_bin (<args>) - 1) (l, r))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4561
let ?P3 = "\<lambda> tp. False"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4562
assume h: "args \<noteq> []"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4563
hence a: "bl_bin (<args>) > 0"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4564
using h by simp
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4565
hence "{?P1} (t_wcode_prepare |+| t_wcode_main) |+| t_wcode_adjust {?Q2}"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4566
proof(rule_tac Hoare_plus_halt)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4567
next
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4568
show "tm_wf (t_wcode_prepare |+| t_wcode_main, 0)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4569
apply(rule_tac tm_wf_comp, auto)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4570
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4571
next
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4572
show "{?P1} t_wcode_prepare |+| t_wcode_main {?Q1}"
139
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4573
proof(rule_tac Hoare_haltI, auto)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4574
show
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4575
"\<exists>n. is_final (steps0 (Suc 0, [], <m # args>) (t_wcode_prepare |+| t_wcode_main) n) \<and>
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4576
(\<lambda>(l, r). l = Bk # Oc # Oc \<up> m \<and>
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4577
(\<exists>ln rn. r = Bk # Oc # Bk \<up> ln @ Bk # Bk # Oc \<up> bl_bin (<args>) @ Bk \<up> rn))
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4578
holds_for steps0 (Suc 0, [], <m # args>) (t_wcode_prepare |+| t_wcode_main) n"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4579
using h prepare_mainpart_lemma[of args m]
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4580
apply(auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4581
apply(rule_tac x = stp in exI, simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4582
apply(rule_tac x = ln in exI, auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4583
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4584
qed
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4585
next
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4586
show "{?P2} t_wcode_adjust {?Q2}"
139
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4587
proof(rule_tac Hoare_haltI, auto del: replicate_Suc)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4588
fix ln rn
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4589
show "\<exists>n. is_final (steps0 (Suc 0, Bk # Oc # Oc \<up> m,
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4590
Bk # Oc # Bk \<up> ln @ Bk # Bk # Oc \<up> bl_bin (<args>) @ Bk \<up> rn) t_wcode_adjust n) \<and>
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4591
wadjust_stop m (bl_bin (<args>) - Suc 0) holds_for steps0
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4592
(Suc 0, Bk # Oc # Oc \<up> m, Bk # Oc # Bk \<up> ln @ Bk # Bk # Oc \<up> bl_bin (<args>) @ Bk \<up> rn) t_wcode_adjust n"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4593
using wadjust_correctness[of m "bl_bin (<args>) - 1" "Suc ln" rn]
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4594
apply(simp del: replicate_Suc add: replicate_Suc[THEN sym] exp_ind, auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4595
apply(rule_tac x = n in exI)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4596
using a
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4597
apply(case_tac "bl_bin (<args>)", simp, simp del: replicate_Suc add: exp_ind wadjust_inv.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4598
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4599
qed
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4600
qed
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4601
thus "?thesis"
139
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4602
apply(simp add: Hoare_halt_def, auto)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4603
apply(case_tac "(steps0 (Suc 0, [], <(m::nat) # args>)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4604
((t_wcode_prepare |+| t_wcode_main) |+| t_wcode_adjust) n)")
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4605
apply(rule_tac x = n in exI, auto simp: wadjust_stop.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4606
using a
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4607
apply(case_tac "bl_bin (<args>)", simp_all)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4608
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4609
qed
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4610
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4611
text {*
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4612
The initialization TM @{text "t_wcode"}.
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4613
*}
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4614
definition t_wcode :: "instr list"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4615
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4616
"t_wcode = (t_wcode_prepare |+| t_wcode_main) |+| t_wcode_adjust"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4617
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4618
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4619
text {*
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4620
The correctness of @{text "t_wcode"}.
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4621
*}
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4622
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4623
lemma wcode_lemma_1:
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4624
"args \<noteq> [] \<Longrightarrow>
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4625
\<exists> stp ln rn. steps0 (Suc 0, [], <m # args>) (t_wcode) stp =
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4626
(0, [Bk], Oc\<up>(Suc m) @ Bk # Oc\<up>(Suc (bl_bin (<args>))) @ Bk\<up>(rn))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4627
apply(simp add: wcode_lemma_pre' t_wcode_def del: replicate_Suc)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4628
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4629
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4630
lemma wcode_lemma:
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4631
"args \<noteq> [] \<Longrightarrow>
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4632
\<exists> stp ln rn. steps0 (Suc 0, [], <m # args>) (t_wcode) stp =
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4633
(0, [Bk], <[m ,bl_bin (<args>)]> @ Bk\<up>(rn))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4634
using wcode_lemma_1[of args m]
139
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4635
apply(simp add: t_wcode_def tape_of_nl_abv tape_of_nat_list.simps tape_of_nat_abv)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4636
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4637
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4638
section {* The universal TM *}
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4639
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4640
text {*
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4641
This section gives the explicit construction of {\em Universal Turing Machine}, defined as @{text "UTM"} and proves its
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4642
correctness. It is pretty easy by composing the partial results we have got so far.
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4643
*}
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4644
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4645
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4646
definition UTM :: "instr list"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4647
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4648
"UTM = (let (aprog, rs_pos, a_md) = rec_ci rec_F in
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4649
let abc_F = aprog [+] dummy_abc (Suc (Suc 0)) in
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4650
(t_wcode |+| (tm_of abc_F @ shift (mopup (Suc (Suc 0))) (length (tm_of abc_F) div 2))))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4651
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4652
definition F_aprog :: "abc_prog"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4653
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4654
"F_aprog \<equiv> (let (aprog, rs_pos, a_md) = rec_ci rec_F in
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4655
aprog [+] dummy_abc (Suc (Suc 0)))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4656
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4657
definition F_tprog :: "instr list"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4658
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4659
"F_tprog = tm_of (F_aprog)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4660
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4661
definition t_utm :: "instr list"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4662
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4663
"t_utm \<equiv>
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4664
F_tprog @ shift (mopup (Suc (Suc 0))) (length F_tprog div 2)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4665
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4666
definition UTM_pre :: "instr list"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4667
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4668
"UTM_pre = t_wcode |+| t_utm"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4669
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4670
lemma tinres_step1:
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4671
"\<lbrakk>tinres l l'; step (ss, l, r) (t, 0) = (sa, la, ra);
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4672
step (ss, l', r) (t, 0) = (sb, lb, rb)\<rbrakk>
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4673
\<Longrightarrow> tinres la lb \<and> ra = rb \<and> sa = sb"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4674
apply(case_tac ss, case_tac [!]r, case_tac [!] "a::cell")
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4675
apply(auto simp: step.simps fetch.simps nth_of.simps
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4676
split: if_splits )
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4677
apply(case_tac [!] "t ! (2 * nat)",
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4678
auto simp: tinres_def split: if_splits)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4679
apply(case_tac [1-8] a, auto split: if_splits)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4680
apply(case_tac [!] "t ! (2 * nat)",
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4681
auto simp: tinres_def split: if_splits)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4682
apply(case_tac [1-4] a, auto split: if_splits)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4683
apply(case_tac [!] "t ! Suc (2 * nat)",
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4684
auto simp: if_splits)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4685
apply(case_tac [!] aa, auto split: if_splits)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4686
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4687
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4688
lemma tinres_steps1:
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4689
"\<lbrakk>tinres l l'; steps (ss, l, r) (t, 0) stp = (sa, la, ra);
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4690
steps (ss, l', r) (t, 0) stp = (sb, lb, rb)\<rbrakk>
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4691
\<Longrightarrow> tinres la lb \<and> ra = rb \<and> sa = sb"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4692
apply(induct stp arbitrary: sa la ra sb lb rb, simp add: steps.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4693
apply(simp add: step_red)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4694
apply(case_tac "(steps (ss, l, r) (t, 0) stp)")
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4695
apply(case_tac "(steps (ss, l', r) (t, 0) stp)")
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4696
proof -
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4697
fix stp sa la ra sb lb rb a b c aa ba ca
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4698
assume ind: "\<And>sa la ra sb lb rb. \<lbrakk>steps (ss, l, r) (t, 0) stp = (sa, (la::cell list), ra);
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4699
steps (ss, l', r) (t, 0) stp = (sb, lb, rb)\<rbrakk> \<Longrightarrow> tinres la lb \<and> ra = rb \<and> sa = sb"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4700
and h: " tinres l l'" "step (steps (ss, l, r) (t, 0) stp) (t, 0) = (sa, la, ra)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4701
"step (steps (ss, l', r) (t, 0) stp) (t, 0) = (sb, lb, rb)" "steps (ss, l, r) (t, 0) stp = (a, b, c)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4702
"steps (ss, l', r) (t, 0) stp = (aa, ba, ca)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4703
have "tinres b ba \<and> c = ca \<and> a = aa"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4704
apply(rule_tac ind, simp_all add: h)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4705
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4706
thus "tinres la lb \<and> ra = rb \<and> sa = sb"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4707
apply(rule_tac l = b and l' = ba and r = c and ss = a
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4708
and t = t in tinres_step1)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4709
using h
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4710
apply(simp, simp, simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4711
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4712
qed
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4713
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4714
lemma [simp]:
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4715
"tinres (Bk \<up> m @ [Bk, Bk]) la \<Longrightarrow> \<exists>m. la = Bk \<up> m"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4716
apply(auto simp: tinres_def)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4717
apply(case_tac n, simp add: exp_ind)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4718
apply(rule_tac x ="Suc (Suc m)" in exI, simp only: exp_ind, simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4719
apply(simp add: exp_ind del: replicate_Suc)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4720
apply(case_tac nat, simp add: exp_ind)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4721
apply(rule_tac x = "Suc m" in exI, simp only: exp_ind)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4722
apply(simp only: exp_ind, simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4723
apply(subgoal_tac "m = length la + nata")
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4724
apply(rule_tac x = "m - nata" in exI, simp add: exp_add)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4725
apply(drule_tac length_equal, simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4726
apply(simp only: exp_ind[THEN sym] replicate_Suc[THEN sym] replicate_add[THEN sym])
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4727
apply(rule_tac x = "m + Suc (Suc n)" in exI, simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4728
done
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4729
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4730
lemma t_utm_halt_eq:
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4731
assumes tm_wf: "tm_wf (tp, 0)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4732
and exec: "steps0 (Suc 0, Bk\<up>(l), <lm::nat list>) tp stp = (0, Bk\<up>(m), Oc\<up>(rs)@Bk\<up>(n))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4733
and resutl: "0 < rs"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4734
shows "\<exists>stp m n. steps0 (Suc 0, [Bk], <[code tp, bl2wc (<lm>)]> @ Bk\<up>(i)) t_utm stp =
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4735
(0, Bk\<up>(m), Oc\<up>(rs) @ Bk\<up>(n))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4736
proof -
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4737
obtain ap arity fp where a: "rec_ci rec_F = (ap, arity, fp)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4738
by (metis prod_cases3)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4739
moreover have b: "rec_calc_rel rec_F [code tp, (bl2wc (<lm>))] (rs - Suc 0)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4740
using assms
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4741
apply(rule_tac F_correct, simp_all)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4742
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4743
have "\<exists> stp m l. steps0 (Suc 0, Bk # Bk # [], <[code tp, bl2wc (<lm>)]> @ Bk\<up>i)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4744
(F_tprog @ shift (mopup 2) (length F_tprog div 2)) stp
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4745
= (0, Bk\<up>m @ Bk # Bk # [], Oc\<up>Suc (rs - 1) @ Bk\<up>l)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4746
proof(rule_tac recursive_compile_to_tm_correct)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4747
show "rec_ci rec_F = (ap, arity, fp)" using a by simp
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4748
next
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4749
show "rec_calc_rel rec_F [code tp, bl2wc (<lm>)] (rs - 1)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4750
using b by simp
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4751
next
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4752
show "length [code tp, bl2wc (<lm>)] = 2" by simp
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4753
next
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4754
show "layout_of (ap [+] dummy_abc 2) = layout_of (ap [+] dummy_abc 2)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4755
by simp
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4756
next
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4757
show "F_tprog = tm_of (ap [+] dummy_abc 2)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4758
using a
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4759
apply(simp add: F_tprog_def F_aprog_def numeral_2_eq_2)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4760
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4761
qed
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4762
then obtain stp m l where
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4763
"steps0 (Suc 0, Bk # Bk # [], <[code tp, bl2wc (<lm>)]> @ Bk\<up>i)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4764
(F_tprog @ shift (mopup 2) (length F_tprog div 2)) stp
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4765
= (0, Bk\<up>m @ Bk # Bk # [], Oc\<up>Suc (rs - 1) @ Bk\<up>l)" by blast
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4766
hence "\<exists> m. steps0 (Suc 0, [Bk], <[code tp, bl2wc (<lm>)]> @ Bk\<up>i)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4767
(F_tprog @ shift (mopup 2) (length F_tprog div 2)) stp
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4768
= (0, Bk\<up>m, Oc\<up>Suc (rs - 1) @ Bk\<up>l)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4769
proof -
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4770
assume g: "steps0 (Suc 0, [Bk, Bk], <[code tp, bl2wc (<lm>)]> @ Bk \<up> i)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4771
(F_tprog @ shift (mopup 2) (length F_tprog div 2)) stp =
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4772
(0, Bk \<up> m @ [Bk, Bk], Oc \<up> Suc (rs - 1) @ Bk \<up> l)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4773
moreover have "tinres [Bk, Bk] [Bk]"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4774
apply(auto simp: tinres_def)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4775
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4776
moreover obtain sa la ra where "steps0 (Suc 0, [Bk], <[code tp, bl2wc (<lm>)]> @ Bk\<up>i)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4777
(F_tprog @ shift (mopup 2) (length F_tprog div 2)) stp = (sa, la, ra)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4778
apply(case_tac "steps0 (Suc 0, [Bk], <[code tp, bl2wc (<lm>)]> @ Bk\<up>i)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4779
(F_tprog @ shift (mopup 2) (length F_tprog div 2)) stp", auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4780
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4781
ultimately show "?thesis"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4782
apply(drule_tac tinres_steps1, auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4783
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4784
qed
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4785
thus "?thesis"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4786
apply(auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4787
apply(rule_tac x = stp in exI, simp add: t_utm_def)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4788
using assms
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4789
apply(case_tac rs, simp_all add: numeral_2_eq_2)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4790
done
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4791
qed
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4792
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4793
lemma [intro]: "tm_wf (t_wcode, 0)"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4794
apply(simp add: t_wcode_def)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4795
apply(rule_tac tm_wf_comp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4796
apply(rule_tac tm_wf_comp, auto)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4797
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4798
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4799
lemma [intro]: "tm_wf (t_utm, 0)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4800
apply(simp only: t_utm_def F_tprog_def)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4801
apply(rule_tac t_compiled_correct, auto)
139
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4802
done
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4803
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4804
lemma UTM_halt_lemma_pre:
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4805
assumes wf_tm: "tm_wf (tp, 0)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4806
and result: "0 < rs"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4807
and args: "args \<noteq> []"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4808
and exec: "steps0 (Suc 0, Bk\<up>(i), <args::nat list>) tp stp = (0, Bk\<up>(m), Oc\<up>(rs)@Bk\<up>(k))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4809
shows "\<exists>stp m n. steps0 (Suc 0, [], <code tp # args>) UTM_pre stp =
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4810
(0, Bk\<up>(m), Oc\<up>(rs) @ Bk\<up>(n))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4811
proof -
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4812
let ?Q2 = "\<lambda> (l, r). (\<exists> ln rn. l = Bk\<up>(ln) \<and> r = Oc\<up>(rs) @ Bk\<up>(rn))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4813
let ?P1 = "\<lambda> (l, r). l = [] \<and> r = <code tp # args>"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4814
let ?Q1 = "\<lambda> (l, r). (l = [Bk] \<and>
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4815
(\<exists> rn. r = Oc\<up>(Suc (code tp)) @ Bk # Oc\<up>(Suc (bl_bin (<args>))) @ Bk\<up>(rn)))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4816
let ?P2 = ?Q1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4817
let ?P3 = "\<lambda> (l, r). False"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4818
have "{?P1} (t_wcode |+| t_utm) {?Q2}"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4819
proof(rule_tac Hoare_plus_halt)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4820
show "tm_wf (t_wcode, 0)" by auto
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4821
next
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4822
show "{?P1} t_wcode {?Q1}"
139
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4823
apply(rule_tac Hoare_haltI, auto)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4824
using wcode_lemma_1[of args "code tp"] args
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4825
apply(auto)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4826
apply(rule_tac x = stp in exI, simp)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4827
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4828
next
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4829
show "{?P2} t_utm {?Q2}"
139
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4830
proof(rule_tac Hoare_haltI, auto)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4831
fix rn
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4832
show "\<exists>n. is_final (steps0 (Suc 0, [Bk], Oc # Oc \<up> code tp @ Bk # Oc # Oc \<up> bl_bin (<args>) @ Bk \<up> rn) t_utm n) \<and>
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4833
(\<lambda>(l, r). (\<exists>ln. l = Bk \<up> ln) \<and>
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4834
(\<exists>rn. r = Oc \<up> rs @ Bk \<up> rn)) holds_for steps0 (Suc 0, [Bk],
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4835
Oc # Oc \<up> code tp @ Bk # Oc # Oc \<up> bl_bin (<args>) @ Bk \<up> rn) t_utm n"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4836
using t_utm_halt_eq[of tp i "args" stp m rs k rn] assms
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4837
apply(auto simp: bin_wc_eq)
139
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4838
apply(rule_tac x = stpa in exI, simp add: tape_of_nl_abv tape_of_nat_abv)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4839
done
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4840
qed
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4841
qed
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4842
thus "?thesis"
139
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4843
apply(auto simp: Hoare_halt_def UTM_pre_def)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4844
apply(case_tac "steps0 (Suc 0, [], <code tp # args>) (t_wcode |+| t_utm) n")
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4845
apply(rule_tac x = n in exI, simp)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4846
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4847
qed
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4848
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4849
text {*
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4850
The correctness of @{text "UTM"}, the halt case.
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4851
*}
145
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4852
lemma UTM_halt_lemma':
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4853
assumes tm_wf: "tm_wf (tp, 0)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4854
and result: "0 < rs"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4855
and args: "args \<noteq> []"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4856
and exec: "steps0 (Suc 0, Bk\<up>(i), <args::nat list>) tp stp = (0, Bk\<up>(m), Oc\<up>(rs)@Bk\<up>(k))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4857
shows "\<exists>stp m n. steps0 (Suc 0, [], <code tp # args>) UTM stp =
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4858
(0, Bk\<up>(m), Oc\<up>(rs) @ Bk\<up>(n))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4859
using UTM_halt_lemma_pre[of tp rs args i stp m k] assms
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4860
apply(simp add: UTM_pre_def t_utm_def UTM_def F_aprog_def F_tprog_def)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4861
apply(case_tac "rec_ci rec_F", simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4862
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4863
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4864
definition TSTD:: "config \<Rightarrow> bool"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4865
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4866
"TSTD c = (let (st, l, r) = c in
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4867
st = 0 \<and> (\<exists> m. l = Bk\<up>(m)) \<and> (\<exists> rs n. r = Oc\<up>(Suc rs) @ Bk\<up>(n)))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4868
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4869
lemma nstd_case1: "0 < a \<Longrightarrow> NSTD (trpl_code (a, b, c))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4870
apply(simp add: NSTD.simps trpl_code.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4871
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4872
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4873
lemma [simp]: "\<forall>m. b \<noteq> Bk\<up>(m) \<Longrightarrow> 0 < bl2wc b"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4874
apply(rule classical, simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4875
apply(induct b, erule_tac x = 0 in allE, simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4876
apply(simp add: bl2wc.simps, case_tac a, simp_all
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4877
add: bl2nat.simps bl2nat_double)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4878
apply(case_tac "\<exists> m. b = Bk\<up>(m)", erule exE)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4879
apply(erule_tac x = "Suc m" in allE, simp add: , simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4880
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4881
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4882
lemma nstd_case2: "\<forall>m. b \<noteq> Bk\<up>(m) \<Longrightarrow> NSTD (trpl_code (a, b, c))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4883
apply(simp add: NSTD.simps trpl_code.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4884
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4885
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4886
lemma [elim]: "Suc (2 * x) = 2 * y \<Longrightarrow> RR"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4887
apply(induct x arbitrary: y, simp, simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4888
apply(case_tac y, simp, simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4889
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4890
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4891
declare replicate_Suc[simp del]
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4892
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4893
lemma bl2nat_zero_eq[simp]: "(bl2nat c 0 = 0) = (\<exists>n. c = Bk\<up>(n))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4894
apply(auto)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4895
apply(induct c, simp_all add: bl2nat.simps)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4896
apply(case_tac a, auto simp: bl2nat.simps bl2nat_double)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4897
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4898
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4899
lemma bl2wc_exp_ex:
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4900
"\<lbrakk>Suc (bl2wc c) = 2 ^ m\<rbrakk> \<Longrightarrow> \<exists> rs n. c = Oc\<up>(rs) @ Bk\<up>(n)"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4901
apply(induct c arbitrary: m, simp add: bl2wc.simps bl2nat.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4902
apply(case_tac a, auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4903
apply(case_tac m, simp_all add: bl2wc.simps, auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4904
apply(rule_tac x = 0 in exI, rule_tac x = "Suc n" in exI,
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4905
simp add: replicate_Suc)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4906
apply(simp add: bl2wc.simps bl2nat.simps bl2nat_double)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4907
apply(case_tac m, simp, simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4908
proof -
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4909
fix c m nat
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4910
assume ind:
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4911
"\<And>m. Suc (bl2nat c 0) = 2 ^ m \<Longrightarrow> \<exists>rs n. c = Oc\<up>(rs) @ Bk\<up>(n)"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4912
and h:
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4913
"Suc (Suc (2 * bl2nat c 0)) = 2 * 2 ^ nat"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4914
have "\<exists>rs n. c = Oc\<up>(rs) @ Bk\<up>(n)"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4915
apply(rule_tac m = nat in ind)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4916
using h
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4917
apply(simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4918
done
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4919
from this obtain rs n where " c = Oc\<up>(rs) @ Bk\<up>(n)" by blast
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4920
thus "\<exists>rs n. Oc # c = Oc\<up>(rs) @ Bk\<up>(n)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4921
apply(rule_tac x = "Suc rs" in exI, simp add: )
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4922
apply(rule_tac x = n in exI, simp add: replicate_Suc)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4923
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4924
qed
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4925
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4926
lemma lg_bin:
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4927
"\<lbrakk>\<forall>rs n. c \<noteq> Oc\<up>(Suc rs) @ Bk\<up>(n);
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4928
bl2wc c = 2 ^ lg (Suc (bl2wc c)) 2 - Suc 0\<rbrakk> \<Longrightarrow> bl2wc c = 0"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4929
apply(subgoal_tac "\<exists> m. Suc (bl2wc c) = 2^m", erule_tac exE)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4930
apply(drule_tac bl2wc_exp_ex, simp, erule_tac exE, erule_tac exE)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4931
apply(case_tac rs, simp, simp, erule_tac x = nat in allE,
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4932
erule_tac x = n in allE, simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4933
using bl2wc_exp_ex[of c "lg (Suc (bl2wc c)) 2"]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4934
apply(case_tac "(2::nat) ^ lg (Suc (bl2wc c)) 2",
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4935
simp, simp, erule_tac exE, erule_tac exE, simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4936
apply(simp add: bl2wc.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4937
apply(rule_tac x = rs in exI)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4938
apply(case_tac "(2::nat)^rs", simp, simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4939
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4940
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4941
lemma nstd_case3:
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4942
"\<forall>rs n. c \<noteq> Oc\<up>(Suc rs) @ Bk\<up>(n) \<Longrightarrow> NSTD (trpl_code (a, b, c))"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4943
apply(simp add: NSTD.simps trpl_code.simps)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4944
apply(auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4945
apply(drule_tac lg_bin, simp_all)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4946
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4947
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4948
lemma NSTD_1: "\<not> TSTD (a, b, c)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4949
\<Longrightarrow> rec_exec rec_NSTD [trpl_code (a, b, c)] = Suc 0"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4950
using NSTD_lemma1[of "trpl_code (a, b, c)"]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4951
NSTD_lemma2[of "trpl_code (a, b, c)"]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4952
apply(simp add: TSTD_def)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4953
apply(erule_tac disjE, erule_tac nstd_case1)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4954
apply(erule_tac disjE, erule_tac nstd_case2)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4955
apply(erule_tac nstd_case3)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4956
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4957
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4958
lemma nonstop_t_uhalt_eq:
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4959
"\<lbrakk>tm_wf (tp, 0);
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4960
steps0 (Suc 0, Bk\<up>(l), <lm>) tp stp = (a, b, c);
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4961
\<not> TSTD (a, b, c)\<rbrakk>
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4962
\<Longrightarrow> rec_exec rec_nonstop [code tp, bl2wc (<lm>), stp] = Suc 0"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4963
apply(simp add: rec_nonstop_def rec_exec.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4964
apply(subgoal_tac
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4965
"rec_exec rec_conf [code tp, bl2wc (<lm>), stp] =
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4966
trpl_code (a, b, c)", simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4967
apply(erule_tac NSTD_1)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4968
using rec_t_eq_steps[of tp l lm stp]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4969
apply(simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4970
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4971
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4972
lemma nonstop_true:
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4973
"\<lbrakk>tm_wf (tp, 0);
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4974
\<forall> stp. (\<not> TSTD (steps0 (Suc 0, Bk\<up>(l), <lm>) tp stp))\<rbrakk>
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4975
\<Longrightarrow> \<forall>y. rec_calc_rel rec_nonstop
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4976
([code tp, bl2wc (<lm>), y]) (Suc 0)"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4977
apply(rule_tac allI, erule_tac x = y in allE)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4978
apply(case_tac "steps0 (Suc 0, Bk\<up>(l), <lm>) tp y", simp)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4979
apply(rule_tac nonstop_t_uhalt_eq, simp_all)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4980
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4981
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4982
declare ci_cn_para_eq[simp]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4983
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4984
lemma F_aprog_uhalt:
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4985
"\<lbrakk>tm_wf (tp,0);
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4986
\<forall> stp. (\<not> TSTD (steps0 (Suc 0, Bk\<up>(l), <lm>) tp stp));
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4987
rec_ci rec_F = (F_ap, rs_pos, a_md)\<rbrakk>
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 4988
\<Longrightarrow> \<forall> stp. case abc_steps_l (0, [code tp, bl2wc (<lm>)] @ 0\<up>(a_md - rs_pos )
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4989
@ suflm) (F_ap) stp of (ss, e) \<Rightarrow> ss < length (F_ap)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4990
apply(case_tac "rec_ci (Cn (Suc (Suc 0)) rec_right [Cn (Suc (Suc 0)) rec_conf
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4991
([id (Suc (Suc 0)) 0, id (Suc (Suc 0)) (Suc 0), rec_halt])])")
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4992
apply(simp only: rec_F_def, rule_tac i = 0 and ga = a and gb = b and
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4993
gc = c in cn_gi_uhalt, simp, simp, simp, simp, simp, simp, simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4994
apply(simp add: ci_cn_para_eq)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4995
apply(case_tac "rec_ci (Cn (Suc (Suc 0)) rec_conf
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4996
([id (Suc (Suc 0)) 0, id (Suc (Suc 0)) (Suc 0), rec_halt]))")
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4997
apply(rule_tac rf = "(Cn (Suc (Suc 0)) rec_right [Cn (Suc (Suc 0)) rec_conf
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4998
([id (Suc (Suc 0)) 0, id (Suc (Suc 0)) (Suc 0), rec_halt])])"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 4999
and n = "Suc (Suc 0)" and f = rec_right and
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5000
gs = "[Cn (Suc (Suc 0)) rec_conf
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5001
([id (Suc (Suc 0)) 0, id (Suc (Suc 0)) (Suc 0), rec_halt])]"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5002
and i = 0 and ga = aa and gb = ba and gc = ca in
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5003
cn_gi_uhalt)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5004
apply(simp, simp, simp, simp, simp, simp, simp,
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5005
simp add: ci_cn_para_eq)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5006
apply(case_tac "rec_ci rec_halt")
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5007
apply(rule_tac rf = "(Cn (Suc (Suc 0)) rec_conf
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5008
([id (Suc (Suc 0)) 0, id (Suc (Suc 0)) (Suc 0), rec_halt]))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5009
and n = "Suc (Suc 0)" and f = "rec_conf" and
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5010
gs = "([id (Suc (Suc 0)) 0, id (Suc (Suc 0)) (Suc 0), rec_halt])" and
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5011
i = "Suc (Suc 0)" and gi = "rec_halt" and ga = ab and gb = bb and
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5012
gc = cb in cn_gi_uhalt)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5013
apply(simp, simp, simp, simp, simp add: nth_append, simp,
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5014
simp add: nth_append, simp add: rec_halt_def)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5015
apply(simp only: rec_halt_def)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5016
apply(case_tac [!] "rec_ci ((rec_nonstop))")
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5017
apply(rule_tac allI, rule_tac impI, simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5018
apply(case_tac j, simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5019
apply(rule_tac x = "code tp" in exI, rule_tac calc_id, simp, simp, simp, simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5020
apply(rule_tac x = "bl2wc (<lm>)" in exI, rule_tac calc_id, simp, simp, simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5021
apply(rule_tac rf = "Mn (Suc (Suc 0)) (rec_nonstop)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5022
and f = "(rec_nonstop)" and n = "Suc (Suc 0)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5023
and aprog' = ac and rs_pos' = bc and a_md' = cc in Mn_unhalt)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5024
apply(simp, simp add: rec_halt_def , simp, simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5025
apply(drule_tac nonstop_true, simp_all)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5026
apply(rule_tac allI)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5027
apply(erule_tac x = y in allE)+
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5028
apply(simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5029
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5030
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5031
lemma uabc_uhalt':
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5032
"\<lbrakk>tm_wf (tp, 0);
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5033
\<forall> stp. (\<not> TSTD (steps0 (Suc 0, Bk\<up>(l), <lm>) tp stp));
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5034
rec_ci rec_F = (ap, pos, md)\<rbrakk>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5035
\<Longrightarrow> \<forall> stp. case abc_steps_l (0, [code tp, bl2wc (<lm>)]) ap stp of (ss, e)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5036
\<Rightarrow> ss < length ap"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5037
proof(frule_tac F_ap = ap and rs_pos = pos and a_md = md
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5038
and suflm = "[]" in F_aprog_uhalt, auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5039
fix stp a b
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5040
assume h:
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5041
"\<forall>stp. case abc_steps_l (0, code tp # bl2wc (<lm>) # 0\<up>(md - pos)) ap stp of
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5042
(ss, e) \<Rightarrow> ss < length ap"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5043
"abc_steps_l (0, [code tp, bl2wc (<lm>)]) ap stp = (a, b)"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5044
"tm_wf (tp, 0)"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5045
"rec_ci rec_F = (ap, pos, md)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5046
moreover have "ap \<noteq> []"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5047
using h apply(rule_tac rec_ci_not_null, simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5048
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5049
ultimately show "a < length ap"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5050
proof(erule_tac x = stp in allE,
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5051
case_tac "abc_steps_l (0, code tp # bl2wc (<lm>) # 0\<up>(md - pos)) ap stp", simp)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5052
fix aa ba
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5053
assume g: "aa < length ap"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5054
"abc_steps_l (0, code tp # bl2wc (<lm>) # 0\<up>(md - pos)) ap stp = (aa, ba)"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5055
"ap \<noteq> []"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5056
thus "?thesis"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5057
using abc_list_crsp_steps[of "[code tp, bl2wc (<lm>)]"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5058
"md - pos" ap stp aa ba] h
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5059
apply(simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5060
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5061
qed
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5062
qed
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5063
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5064
lemma uabc_uhalt:
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5065
"\<lbrakk>tm_wf (tp, 0);
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5066
\<forall> stp. (\<not> TSTD (steps0 (Suc 0, Bk\<up>(l), <lm>) tp stp))\<rbrakk>
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5067
\<Longrightarrow> \<forall> stp. case abc_steps_l (0, [code tp, bl2wc (<lm>)]) F_aprog
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5068
stp of (ss, e) \<Rightarrow> ss < length F_aprog"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5069
apply(case_tac "rec_ci rec_F", simp add: F_aprog_def)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5070
apply(drule_tac ap = a and pos = b and md = c in uabc_uhalt', simp_all)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5071
proof -
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5072
fix a b c
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5073
assume
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5074
"\<forall>stp. case abc_steps_l (0, [code tp, bl2wc (<lm>)]) a stp of (ss, e)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5075
\<Rightarrow> ss < length a"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5076
"rec_ci rec_F = (a, b, c)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5077
thus
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5078
"\<forall>stp. case abc_steps_l (0, [code tp, bl2wc (<lm>)])
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5079
(a [+] dummy_abc (Suc (Suc 0))) stp of (ss, e) \<Rightarrow>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5080
ss < Suc (Suc (Suc (length a)))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5081
using abc_append_uhalt1[of a "[code tp, bl2wc (<lm>)]"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5082
"a [+] dummy_abc (Suc (Suc 0))" "[]" "dummy_abc (Suc (Suc 0))"]
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5083
apply(simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5084
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5085
qed
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5086
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5087
lemma tutm_uhalt':
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5088
assumes tm_wf: "tm_wf (tp,0)"
170
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5089
and unhalt: "\<forall> stp. (\<not> TSTD (steps0 (1, Bk\<up>(l), <lm>) tp stp))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5090
shows "\<forall> stp. \<not> is_final (steps0 (1, [Bk, Bk], <[code tp, bl2wc (<lm>)]>) t_utm stp)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5091
unfolding t_utm_def
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5092
proof(rule_tac compile_correct_unhalt)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5093
show "layout_of F_aprog = layout_of F_aprog" by simp
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5094
next
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5095
show "F_tprog = tm_of F_aprog"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5096
by(simp add: F_tprog_def)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5097
next
170
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5098
show "crsp (layout_of F_aprog) (0, [code tp, bl2wc (<lm>)]) (1, [Bk, Bk], <[code tp, bl2wc (<lm>)]>) []"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5099
by(auto simp: crsp.simps start_of.simps)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5100
next
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5101
show "length F_tprog div 2 = length F_tprog div 2" by simp
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5102
next
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5103
show "\<forall>stp. case abc_steps_l (0, [code tp, bl2wc (<lm>)]) F_aprog stp of (as, am) \<Rightarrow> as < length F_aprog"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5104
using assms
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5105
apply(erule_tac uabc_uhalt, simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5106
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5107
qed
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5108
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5109
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5110
lemma tinres_commute: "tinres r r' \<Longrightarrow> tinres r' r"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5111
apply(auto simp: tinres_def)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5112
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5113
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5114
lemma inres_tape:
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5115
"\<lbrakk>steps0 (st, l, r) tp stp = (a, b, c); steps0 (st, l', r') tp stp = (a', b', c');
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5116
tinres l l'; tinres r r'\<rbrakk>
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5117
\<Longrightarrow> a = a' \<and> tinres b b' \<and> tinres c c'"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5118
proof(case_tac "steps0 (st, l', r) tp stp")
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5119
fix aa ba ca
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5120
assume h: "steps0 (st, l, r) tp stp = (a, b, c)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5121
"steps0 (st, l', r') tp stp = (a', b', c')"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5122
"tinres l l'" "tinres r r'"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5123
"steps0 (st, l', r) tp stp = (aa, ba, ca)"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5124
have "tinres b ba \<and> c = ca \<and> a = aa"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5125
using h
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5126
apply(rule_tac tinres_steps1, auto)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5127
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5128
moreover have "b' = ba \<and> tinres c' ca \<and> a' = aa"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5129
using h
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5130
apply(rule_tac tinres_steps2, auto intro: tinres_commute)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5131
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5132
ultimately show "?thesis"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5133
apply(auto intro: tinres_commute)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5134
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5135
qed
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5136
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5137
lemma tape_normalize: "\<forall> stp. \<not> is_final(steps0 (Suc 0, [Bk, Bk], <[code tp, bl2wc (<lm>)]>) t_utm stp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5138
\<Longrightarrow> \<forall> stp. \<not> is_final (steps0 (Suc 0, Bk\<up>(m), <[code tp, bl2wc (<lm>)]> @ Bk\<up>(n)) t_utm stp)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5139
apply(rule_tac allI, case_tac "(steps0 (Suc 0, Bk\<up>(m),
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5140
<[code tp, bl2wc (<lm>)]> @ Bk\<up>(n)) t_utm stp)", simp)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5141
apply(erule_tac x = stp in allE)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5142
apply(case_tac "steps0 (Suc 0, [Bk, Bk], <[code tp, bl2wc (<lm>)]>) t_utm stp", simp)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5143
apply(drule_tac inres_tape, auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5144
apply(auto simp: tinres_def)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5145
apply(case_tac "m > Suc (Suc 0)")
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5146
apply(rule_tac x = "m - Suc (Suc 0)" in exI)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5147
apply(case_tac m, simp_all add: , case_tac nat, simp_all add: replicate_Suc)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5148
apply(rule_tac x = "2 - m" in exI, simp add: exp_add[THEN sym])
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5149
apply(simp only: numeral_2_eq_2, simp add: replicate_Suc)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5150
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5151
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5152
lemma tutm_uhalt:
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5153
"\<lbrakk>tm_wf (tp,0);
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5154
\<forall> stp. (\<not> TSTD (steps0 (Suc 0, Bk\<up>(l), <args>) tp stp))\<rbrakk>
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5155
\<Longrightarrow> \<forall> stp. \<not> is_final (steps0 (Suc 0, Bk\<up>(m), <[code tp, bl2wc (<args>)]> @ Bk\<up>(n)) t_utm stp)"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5156
apply(rule_tac tape_normalize)
170
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5157
apply(rule_tac tutm_uhalt'[simplified], simp_all)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5158
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5159
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5160
lemma UTM_uhalt_lemma_pre:
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5161
assumes tm_wf: "tm_wf (tp, 0)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5162
and exec: "\<forall> stp. (\<not> TSTD (steps0 (Suc 0, Bk\<up>(l), <args>) tp stp))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5163
and args: "args \<noteq> []"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5164
shows "\<forall> stp. \<not> is_final (steps0 (Suc 0, [], <code tp # args>) UTM_pre stp)"
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5165
proof -
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5166
let ?P1 = "\<lambda> (l, r). l = [] \<and> r = <code tp # args>"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5167
let ?Q1 = "\<lambda> (l, r). (l = [Bk] \<and>
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5168
(\<exists> rn. r = Oc\<up>(Suc (code tp)) @ Bk # Oc\<up>(Suc (bl_bin (<args>))) @ Bk\<up>(rn)))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5169
let ?P2 = ?Q1
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5170
have "{?P1} (t_wcode |+| t_utm) \<up>"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5171
proof(rule_tac Hoare_plus_unhalt)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5172
show "tm_wf (t_wcode, 0)" by auto
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5173
next
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5174
show "{?P1} t_wcode {?Q1}"
139
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5175
apply(rule_tac Hoare_haltI, auto)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5176
using wcode_lemma_1[of args "code tp"] args
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5177
apply(auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5178
apply(rule_tac x = stp in exI, simp)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5179
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5180
next
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5181
show "{?P2} t_utm \<up>"
139
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5182
proof(rule_tac Hoare_unhaltI, auto)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5183
fix n rn
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5184
assume h: "is_final (steps0 (Suc 0, [Bk], Oc \<up> Suc (code tp) @ Bk # Oc \<up> Suc (bl_bin (<args>)) @ Bk \<up> rn) t_utm n)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5185
have "\<forall> stp. \<not> is_final (steps0 (Suc 0, Bk\<up>(Suc 0), <[code tp, bl2wc (<args>)]> @ Bk\<up>(rn)) t_utm stp)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5186
using assms
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5187
apply(rule_tac tutm_uhalt, simp_all)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5188
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5189
thus "False"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5190
using h
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5191
apply(erule_tac x = n in allE)
139
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5192
apply(simp add: tape_of_nl_abv bin_wc_eq tape_of_nat_abv)
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5193
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5194
qed
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5195
qed
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5196
thus "?thesis"
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5197
apply(simp add: Hoare_unhalt_def UTM_pre_def)
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5198
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5199
qed
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5200
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5201
text {*
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5202
The correctness of @{text "UTM"}, the unhalt case.
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5203
*}
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5204
145
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5205
lemma UTM_uhalt_lemma':
131
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5206
assumes tm_wf: "tm_wf (tp, 0)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5207
and unhalt: "\<forall> stp. (\<not> TSTD (steps0 (Suc 0, Bk\<up>(l), <args>) tp stp))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5208
and args: "args \<noteq> []"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5209
shows " \<forall> stp. \<not> is_final (steps0 (Suc 0, [], <code tp # args>) UTM stp)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5210
using UTM_uhalt_lemma_pre[of tp l args] assms
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5211
apply(simp add: UTM_pre_def t_utm_def UTM_def F_aprog_def F_tprog_def)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5212
apply(case_tac "rec_ci rec_F", simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5213
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5214
145
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5215
lemma UTM_halt_lemma:
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5216
assumes tm_wf: "tm_wf (p, 0)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5217
and resut: "rs > 0"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5218
and args: "(args::nat list) \<noteq> []"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5219
and exec: "{(\<lambda>tp. tp = (Bk\<up>i, <args>))} p {(\<lambda>tp. tp = (Bk\<up>m, Oc\<up>rs @ Bk\<up>k))}"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5220
shows "{(\<lambda>tp. tp = ([], <code p # args>))} UTM {(\<lambda>tp. (\<exists> m n. tp = (Bk\<up>m, Oc\<up>rs @ Bk\<up>n)))}"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5221
proof -
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5222
have "{(\<lambda> (l, r). l = [] \<and> r = <code p # args>)} (t_wcode |+| t_utm)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5223
{(\<lambda> (l, r). (\<exists> m. l = Bk\<up>m) \<and> (\<exists> n. r = Oc\<up>rs @ Bk\<up>n))}"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5224
proof(rule_tac Hoare_plus_halt)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5225
show "{\<lambda>(l, r). l = [] \<and> r = <code p # args>} t_wcode {\<lambda> (l, r). (l = [Bk] \<and>
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5226
(\<exists> rn. r = Oc\<up>(Suc (code p)) @ Bk # Oc\<up>(Suc (bl_bin (<args>))) @ Bk\<up>(rn)))}"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5227
apply(rule_tac Hoare_haltI, auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5228
using wcode_lemma_1[of args "code p"] args
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5229
apply(auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5230
apply(rule_tac x = stp in exI, simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5231
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5232
next
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5233
have "\<exists> stp. steps0 (Suc 0, Bk\<up>i, <args>) p stp = (0, Bk\<up>m, Oc\<up>rs @ Bk\<up>k)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5234
using exec
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5235
apply(simp add: Hoare_halt_def, auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5236
apply(case_tac "steps0 (Suc 0, Bk \<up> i, <args>) p n", simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5237
apply(rule_tac x = n in exI, simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5238
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5239
then obtain stp where k: "steps0 (Suc 0, Bk\<up>i, <args>) p stp = (0, Bk\<up>m, Oc\<up>rs @ Bk\<up>k)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5240
..
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5241
thus "{\<lambda>(l, r). l = [Bk] \<and> (\<exists>rn. r = Oc \<up> Suc (code p) @ Bk # Oc \<up> Suc (bl_bin (<args>)) @ Bk \<up> rn)}
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5242
t_utm {\<lambda>(l, r). (\<exists>m. l = Bk \<up> m) \<and> (\<exists>n. r = Oc \<up> rs @ Bk \<up> n)}"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5243
proof(rule_tac Hoare_haltI, auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5244
fix rn
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5245
show "\<exists>n. is_final (steps0 (Suc 0, [Bk], Oc \<up> Suc (code p) @ Bk # Oc \<up> Suc (bl_bin (<args>)) @ Bk \<up> rn) t_utm n) \<and>
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5246
(\<lambda>(l, r). (\<exists>m. l = Bk \<up> m) \<and> (\<exists>n. r = Oc \<up> rs @ Bk \<up> n)) holds_for steps0
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5247
(Suc 0, [Bk], Oc \<up> Suc (code p) @ Bk # Oc \<up> Suc (bl_bin (<args>)) @ Bk \<up> rn) t_utm n"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5248
using t_utm_halt_eq[of p i "args" stp m rs k rn] assms k
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5249
apply(auto simp: bin_wc_eq, auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5250
apply(rule_tac x = stpa in exI, simp add: tape_of_nl_abv tape_of_nat_abv)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5251
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5252
qed
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5253
next
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5254
show "tm_wf0 t_wcode" by auto
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5255
qed
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5256
thus "?thesis"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5257
apply(case_tac "rec_ci rec_F")
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5258
apply(simp add: UTM_def t_utm_def F_aprog_def F_tprog_def)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5259
apply(auto simp add: Hoare_halt_def)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5260
apply(rule_tac x="n" in exI)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5261
apply(auto)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5262
apply(case_tac "(steps0 (Suc 0, [], <code p # args>)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5263
(t_wcode |+| ((tm_of (a [+] dummy_abc (Suc (Suc 0)))) @
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5264
shift (mopup (Suc (Suc 0)))
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5265
(length (tm_of (a [+] dummy_abc (Suc (Suc 0)))) div
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5266
2))) n)")
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5267
apply(simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5268
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5269
qed
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5270
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5271
lemma UTM_halt_lemma2:
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5272
assumes tm_wf: "tm_wf (p, 0)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5273
and args: "(args::nat list) \<noteq> []"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5274
and exec: "{(\<lambda>tp. tp = ([], <args>))} p {(\<lambda>tp. tp = (Bk\<up>m, <(n::nat)> @ Bk\<up>k))}"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5275
shows "{(\<lambda>tp. tp = ([], <code p # args>))} UTM {(\<lambda>tp. (\<exists> m k. tp = (Bk\<up>m, <n> @ Bk\<up>k)))}"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5276
using UTM_halt_lemma[OF assms(1) _ assms(2), where i="0"]
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5277
using assms(3)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5278
apply(simp add: tape_of_nat_abv)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5279
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5280
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5281
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5282
lemma UTM_unhalt_lemma:
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5283
assumes tm_wf: "tm_wf (p, 0)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5284
and unhalt: "{(\<lambda>tp. tp = (Bk\<up>i, <args>))} p \<up>"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5285
and args: "args \<noteq> []"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5286
shows "{(\<lambda>tp. tp = ([], <code p # args>))} UTM \<up>"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5287
proof -
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5288
have "\<forall> stp. (\<not> TSTD (steps0 (Suc 0, Bk\<up>(i), <args>) p stp))"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5289
using unhalt
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5290
apply(auto simp: Hoare_unhalt_def)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5291
apply(case_tac "steps0 (Suc 0, Bk \<up> i, <args>) p stp", simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5292
apply(erule_tac x = stp in allE, simp add: TSTD_def)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5293
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5294
then have "\<forall> stp. \<not> is_final (steps0 (Suc 0, [], <code p # args>) UTM stp)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5295
using assms
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5296
apply(rule_tac UTM_uhalt_lemma', simp_all)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5297
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5298
thus "?thesis"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5299
apply(simp add: Hoare_unhalt_def)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5300
done
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5301
qed
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5302
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5303
lemma UTM_unhalt_lemma2:
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5304
assumes tm_wf: "tm_wf (p, 0)"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5305
and unhalt: "{(\<lambda>tp. tp = ([], <args>))} p \<up>"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5306
and args: "args \<noteq> []"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5307
shows "{(\<lambda>tp. tp = ([], <code p # args>))} UTM \<up>"
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5308
using UTM_unhalt_lemma[OF assms(1), where i="0"]
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5309
using assms(2-3)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5310
apply(simp add: tape_of_nat_abv)
Christian Urban <christian dot urban at kcl dot ac dot uk>
diff
changeset
+ − 5311
done
130
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff
changeset
+ − 5312
end