--- a/Journal/Paper.thy Mon Mar 04 21:01:55 2013 +0000
+++ b/Journal/Paper.thy Fri Jul 05 12:07:48 2013 +0100
@@ -2452,62 +2452,82 @@
algorithm is still executable. Given the infrastructure for
executable sets introduced by \citeN{Haftmann09} in Isabelle/HOL, it should.
- We started out by claiming that in a theorem prover it is eaiser to reason
- about regular expressions than about automta. Here are some numbers:
- Our formalisation of the Myhill-Nerode Theorem consists of 780 lines of
- Isabelle/Isar code for the first direction and 460 for the second (the one
- based on tagging-functions), plus around 300 lines of standard material
- about regular languages. The formalisation of derivatives and partial
- derivatives shown in Section~\ref{derivatives} consists of 390 lines of
- code. The closure properties in Section~\ref{closure} (except Theorem~\ref{subseqreg})
- can be established in
- 100 lines of code. The Continuation Lemma and the non-regularity of @{text "a\<^sup>n b\<^sup>n"}
- require 70 lines of code.
- The algorithm for solving equational systems, which we
- used in the first direction, is conceptually relatively simple. Still the
- use of sets over which the algorithm operates means it is not as easy to
- formalise as one might wish. However, it seems sets cannot be avoided since
- the `input' of the algorithm consists of equivalence classes and we cannot
- see how to reformulate the theory so that we can use lists or matrices. Lists would be
- much easier to reason about, since we can define functions over them by
- recursion. For sets we have to use set-comprehensions, which is slightly
- unwieldy. Matrices would allow us to use the slick formalisation by
- \citeN{Nipkow11} of the Gauss-Jordan algorithm.
+ We started out by claiming that in a theorem prover it is eaiser to
+ reason about regular expressions than about automta. Here are some
+ numbers: Our formalisation of the Myhill-Nerode Theorem consists of
+ 780 lines of Isabelle/Isar code for the first direction and 460 for
+ the second (the one based on tagging-functions), plus around 300
+ lines of standard material about regular languages. The
+ formalisation of derivatives and partial derivatives shown in
+ Section~\ref{derivatives} consists of 390 lines of code. The
+ closure properties in Section~\ref{closure} (except
+ Theorem~\ref{subseqreg}) can be established in 100 lines of
+ code. The Continuation Lemma and the non-regularity of @{text "a\<^sup>n
+ b\<^sup>n"} require 70 lines of code. The algorithm for solving equational
+ systems, which we used in the first direction, is conceptually
+ relatively simple. Still the use of sets over which the algorithm
+ operates means it is not as easy to formalise as one might
+ wish. However, it seems sets cannot be avoided since the `input' of
+ the algorithm consists of equivalence classes and we cannot see how
+ to reformulate the theory so that we can use lists or
+ matrices. Lists would be much easier to reason about, since we can
+ define functions over them by recursion. For sets we have to use
+ set-comprehensions, which is slightly unwieldy. Matrices would allow
+ us to use the slick formalisation by \citeN{Nipkow11} of the
+ Gauss-Jordan algorithm.
- While our formalisation might appear large, it should be seen
- in the context of the work done by \citeN{Constable00} who
- formalised the Myhill-Nerode Theorem in Nuprl using automata. They write
- that their four-member team would need something on the magnitude of 18 months
- for their formalisation of the first eleven chapters of the textbook by \citeN{HopcroftUllman69},
- which includes the Myhill-Nerode theorem. It is hard to gauge the size of a
- formalisation in Nurpl, but from what is shown in the Nuprl Math Library
- about their development it seems \emph{substantially} larger than ours. We attribute
- this to our use of regular expressions, which meant we did not need to `fight'
- the theorem prover. Recently, \citeN{LammichTuerk12} formalised Hopcroft's
- algorithm in Isabelle/HOL (in 7000 lines of code) using an automata
- library of 27000 lines of code.
- Also, \citeN{Filliatre97} reports that his formalisation in
- Coq of automata theory and Kleene's theorem is ``rather big''.
- \citeN{Almeidaetal10} reported about another
- formalisation of regular languages in Coq. Their
- main result is the
+ % OLD
+ %While our formalisation might appear large, it should be seen in the
+ %context of the work done by \citeN{Constable00} who formalised the
+ %Myhill-Nerode Theorem in Nuprl using automata. They write that their
+ %four-member team would need something on the magnitude of 18 months
+ %for their formalisation of the first eleven chapters of the textbook
+ %by \citeN{HopcroftUllman69}, which includes the Myhill-Nerode
+ %theorem. It is hard to gauge the size of a formalisation in Nurpl,
+ %but from what is shown in the Nuprl Math Library about their
+ %development it seems \emph{substantially} larger than ours. We
+ %attribute this to our use of regular expressions, which meant we did
+ %not need to `fight' the theorem prover.
+
+ %%% NEW
+ While our formalisation might appear large, it should be seen in the
+ context of the work done by \citeN{Constable00} who formalised the
+ Myhill-Nerode Theorem in Nuprl using automata. They choose to formalise the
+ this theorem, because it gives them state minimization of automata
+ as a corollary. It is hard to gauge the size of a formalisation in Nurpl,
+ but from what is shown in the Nuprl Math Library about this
+ development it seems \emph{substantially} larger than ours. We
+ attribute this to our use of regular expressions, which meant we did
+ not need to `fight' the theorem prover.
+ %
+ Recently,
+ \citeN{LammichTuerk12} formalised Hopcroft's algorithm in
+ Isabelle/HOL (in 7000 lines of code) using an automata library of
+ 27000 lines of code. Also, \citeN{Filliatre97} reports that his
+ formalisation in Coq of automata theory and Kleene's theorem is
+ ``rather big''. \citeN{Almeidaetal10} reported about another
+ formalisation of regular languages in Coq. Their main result is the
correctness of Mirkin's construction of an automaton from a regular
- expression using partial derivatives. This took approximately 10600 lines
- of code. \citeN{Braibant12} formalised a large part of regular language
- theory and Kleene algebras in Coq. While he is mainly interested
- in implementing decision procedures for Kleene algebras, his library
- includes a proof of the Myhill-Nerode theorem. He reckons that our
- ``development is more concise'' than his one based on matrices \cite[Page 67]{Braibant12}.
- He writes that there is no conceptual problems with formally reasoning
- about matrices for automata, but notes ``intrinsic difficult[ies]'' when working
- with matrices in Coq, which is the sort of `fighting' one would encounter also
- in other theorem provers.
-
+ expression using partial derivatives. This took approximately 10600
+ lines of code. \citeN{Braibant12} formalised a large part of
+ regular language theory and Kleene algebras in Coq. While he is
+ mainly interested in implementing decision procedures for Kleene
+ algebras, his library includes a proof of the Myhill-Nerode
+ theorem. He reckons that our ``development is more concise'' than
+ his one based on matrices \cite[Page 67]{Braibant12}. He writes
+ that there is no conceptual problems with formally reasoning about
+ matrices for automata, but notes ``intrinsic difficult[ies]'' when
+ working with matrices in Coq, which is the sort of `fighting' one
+ would encounter also in other theorem provers.
In terms of time, the estimate for our formalisation is that we
needed approximately 3 months and this included the time to find our proof
arguments. Unlike \citeN{Constable00}, who were able to follow the Myhill-Nerode
- proof by \citeN{HopcroftUllman69}, we had to find our own arguments. So for us the
- formalisation was not the bottleneck. The code of
+ proof by \citeN{HopcroftUllman69}, we had to find our own arguments.
+ So for us the formalisation was not the bottleneck. The conclusion we draw
+ from all these comparisons is that if one is interested in formalising
+ results from regular language theory, not results from automata theory,
+ then regular expressions are easier to work with formally.
+ The code of
our formalisation \cite{myhillnerodeafp11} can be found in the Archive of Formal Proofs at
\mbox{\url{http://afp.sourceforge.net/entries/Myhill-Nerode.shtml}}.\smallskip
--- a/utm/IsaMakefile Mon Mar 04 21:01:55 2013 +0000
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,31 +0,0 @@
-
-## targets
-
-default: utm
-images: utm
-test:
-
-all: images test
-
-
-## global settings
-
-SRC = $(ISABELLE_HOME)/src
-OUT = $(ISABELLE_OUTPUT)
-LOG = $(OUT)/log
-
-USEDIR = $(ISABELLE_TOOL) usedir -v true -i true -d pdf ## -D generated
-
-
-## utm
-
-utm: $(OUT)/utm
-
-$(OUT)/utm: ## ROOT.ML document/root.tex *.thy
- @$(USEDIR) -b HOL utm
-
-
-## clean
-
-clean:
- @rm -f $(OUT)/utm
--- a/utm/ROOT.ML Mon Mar 04 21:01:55 2013 +0000
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,13 +0,0 @@
-(*
- turing_basic.thy : The basic definitions of Turing Machine.
- uncomputable.thy : The existence of Turing uncomputable functions.
- abacus.thy : The basic definitions of Abacus machine (An intermediate langauge underneath recursive functions) and
- the compilation of Abacus machines into Turing Machines.
- rec_def.thy: The basic definitions of Recursive Functions.
- recursive.thy : The compilation of Recursive Functions into
- Abacus machines.
- UF.thy : The construction of Universal Function, named "rec_F" and the proof of its correctness.
- UTM.thy: Obtaining Uinversal Turing Machine by scarfolding the Turing Machine compiled from "rec_F" with some
- initialization and termination processing Turing Machines.
-*)
- use_thys ["turing_basic", "uncomputable", "abacus", "rec_def", "recursive", "UF", "UTM"]
--- a/utm/UF.thy Mon Mar 04 21:01:55 2013 +0000
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,4873 +0,0 @@
-theory UF
-imports Main rec_def turing_basic GCD abacus
-begin
-
-text {*
- This theory file constructs the Universal Function @{text "rec_F"}, which is the UTM defined
- in terms of recursive functions. This @{text "rec_F"} is essentially an
- interpreter of Turing Machines. Once the correctness of @{text "rec_F"} is established,
- UTM can easil be obtained by compling @{text "rec_F"} into the corresponding Turing Machine.
-*}
-
-section {* Univeral Function *}
-
-subsection {* The construction of component functions *}
-
-text {*
- This section constructs a set of component functions used to construct @{text "rec_F"}.
- *}
-
-text {*
- The recursive function used to do arithmatic addition.
-*}
-definition rec_add :: "recf"
- where
- "rec_add \<equiv> Pr 1 (id 1 0) (Cn 3 s [id 3 2])"
-
-text {*
- The recursive function used to do arithmatic multiplication.
-*}
-definition rec_mult :: "recf"
- where
- "rec_mult = Pr 1 z (Cn 3 rec_add [id 3 0, id 3 2])"
-
-text {*
- The recursive function used to do arithmatic precede.
-*}
-definition rec_pred :: "recf"
- where
- "rec_pred = Cn 1 (Pr 1 z (id 3 1)) [id 1 0, id 1 0]"
-
-text {*
- The recursive function used to do arithmatic subtraction.
-*}
-definition rec_minus :: "recf"
- where
- "rec_minus = Pr 1 (id 1 0) (Cn 3 rec_pred [id 3 2])"
-
-text {*
- @{text "constn n"} is the recursive function which computes
- nature number @{text "n"}.
-*}
-fun constn :: "nat \<Rightarrow> recf"
- where
- "constn 0 = z" |
- "constn (Suc n) = Cn 1 s [constn n]"
-
-
-text {*
- Signal function, which returns 1 when the input argument is greater than @{text "0"}.
-*}
-definition rec_sg :: "recf"
- where
- "rec_sg = Cn 1 rec_minus [constn 1,
- Cn 1 rec_minus [constn 1, id 1 0]]"
-
-text {*
- @{text "rec_less"} compares its two arguments, returns @{text "1"} if
- the first is less than the second; otherwise returns @{text "0"}.
- *}
-definition rec_less :: "recf"
- where
- "rec_less = Cn 2 rec_sg [Cn 2 rec_minus [id 2 1, id 2 0]]"
-
-text {*
- @{text "rec_not"} inverse its argument: returns @{text "1"} when the
- argument is @{text "0"}; returns @{text "0"} otherwise.
- *}
-definition rec_not :: "recf"
- where
- "rec_not = Cn 1 rec_minus [constn 1, id 1 0]"
-
-text {*
- @{text "rec_eq"} compares its two arguments: returns @{text "1"}
- if they are equal; return @{text "0"} otherwise.
- *}
-definition rec_eq :: "recf"
- where
- "rec_eq = Cn 2 rec_minus [Cn 2 (constn 1) [id 2 0],
- Cn 2 rec_add [Cn 2 rec_minus [id 2 0, id 2 1],
- Cn 2 rec_minus [id 2 1, id 2 0]]]"
-
-text {*
- @{text "rec_conj"} computes the conjunction of its two arguments,
- returns @{text "1"} if both of them are non-zero; returns @{text "0"}
- otherwise.
- *}
-definition rec_conj :: "recf"
- where
- "rec_conj = Cn 2 rec_sg [Cn 2 rec_mult [id 2 0, id 2 1]] "
-
-text {*
- @{text "rec_disj"} computes the disjunction of its two arguments,
- returns @{text "0"} if both of them are zero; returns @{text "0"}
- otherwise.
- *}
-definition rec_disj :: "recf"
- where
- "rec_disj = Cn 2 rec_sg [Cn 2 rec_add [id 2 0, id 2 1]]"
-
-
-text {*
- Computes the arity of recursive function.
- *}
-
-fun arity :: "recf \<Rightarrow> nat"
- where
- "arity z = 1"
-| "arity s = 1"
-| "arity (id m n) = m"
-| "arity (Cn n f gs) = n"
-| "arity (Pr n f g) = Suc n"
-| "arity (Mn n f) = n"
-
-text {*
- @{text "get_fstn_args n (Suc k)"} returns
- @{text "[id n 0, id n 1, id n 2, \<dots>, id n k]"},
- the effect of which is to take out the first @{text "Suc k"}
- arguments out of the @{text "n"} input arguments.
- *}
-
-fun get_fstn_args :: "nat \<Rightarrow> nat \<Rightarrow> recf list"
- where
- "get_fstn_args n 0 = []"
-| "get_fstn_args n (Suc y) = get_fstn_args n y @ [id n y]"
-
-text {*
- @{text "rec_sigma f"} returns the recursive functions which
- sums up the results of @{text "f"}:
- \[
- (rec\_sigma f)(x, y) = f(x, 0) + f(x, 1) + \cdots + f(x, y)
- \]
-*}
-fun rec_sigma :: "recf \<Rightarrow> recf"
- where
- "rec_sigma rf =
- (let vl = arity rf in
- Pr (vl - 1) (Cn (vl - 1) rf (get_fstn_args (vl - 1) (vl - 1) @
- [Cn (vl - 1) (constn 0) [id (vl - 1) 0]]))
- (Cn (Suc vl) rec_add [id (Suc vl) vl,
- Cn (Suc vl) rf (get_fstn_args (Suc vl) (vl - 1)
- @ [Cn (Suc vl) s [id (Suc vl) (vl - 1)]])]))"
-
-text {*
- @{text "rec_exec"} is the interpreter function for
- reursive functions. The function is defined such that
- it always returns meaningful results for primitive recursive
- functions.
- *}
-function rec_exec :: "recf \<Rightarrow> nat list \<Rightarrow> nat"
- where
- "rec_exec z xs = 0" |
- "rec_exec s xs = (Suc (xs ! 0))" |
- "rec_exec (id m n) xs = (xs ! n)" |
- "rec_exec (Cn n f gs) xs =
- (let ys = (map (\<lambda> a. rec_exec a xs) gs) in
- rec_exec f ys)" |
- "rec_exec (Pr n f g) xs =
- (if last xs = 0 then
- rec_exec f (butlast xs)
- else rec_exec g (butlast xs @ [last xs - 1] @
- [rec_exec (Pr n f g) (butlast xs @ [last xs - 1])]))" |
- "rec_exec (Mn n f) xs = (LEAST x. rec_exec f (xs @ [x]) = 0)"
-by pat_completeness auto
-termination
-proof
- show "wf (measures [\<lambda> (r, xs). size r, (\<lambda> (r, xs). last xs)])"
- by auto
-next
- fix n f gs xs x
- assume "(x::recf) \<in> set gs"
- thus "((x, xs), Cn n f gs, xs) \<in>
- measures [\<lambda>(r, xs). size r, \<lambda>(r, xs). last xs]"
- by(induct gs, auto)
-next
- fix n f gs xs x
- assume "x = map (\<lambda>a. rec_exec a xs) gs"
- "\<And>x. x \<in> set gs \<Longrightarrow> rec_exec_dom (x, xs)"
- thus "((f, x), Cn n f gs, xs) \<in>
- measures [\<lambda>(r, xs). size r, \<lambda>(r, xs). last xs]"
- by(auto)
-next
- fix n f g xs
- show "((f, butlast xs), Pr n f g, xs) \<in>
- measures [\<lambda>(r, xs). size r, \<lambda>(r, xs). last xs]"
- by auto
-next
- fix n f g xs
- assume "last xs \<noteq> (0::nat)" thus
- "((Pr n f g, butlast xs @ [last xs - 1]), Pr n f g, xs)
- \<in> measures [\<lambda>(r, xs). size r, \<lambda>(r, xs). last xs]"
- by auto
-next
- fix n f g xs
- show "((g, butlast xs @ [last xs - 1] @ [rec_exec (Pr n f g) (butlast xs @ [last xs - 1])]),
- Pr n f g, xs) \<in> measures [\<lambda>(r, xs). size r, \<lambda>(r, xs). last xs]"
- by auto
-next
- fix n f xs x
- show "((f, xs @ [x]), Mn n f, xs) \<in>
- measures [\<lambda>(r, xs). size r, \<lambda>(r, xs). last xs]"
- by auto
-qed
-
-declare rec_exec.simps[simp del] constn.simps[simp del]
-
-text {*
- Correctness of @{text "rec_add"}.
- *}
-lemma add_lemma: "\<And> x y. rec_exec rec_add [x, y] = x + y"
-by(induct_tac y, auto simp: rec_add_def rec_exec.simps)
-
-text {*
- Correctness of @{text "rec_mult"}.
- *}
-lemma mult_lemma: "\<And> x y. rec_exec rec_mult [x, y] = x * y"
-by(induct_tac y, auto simp: rec_mult_def rec_exec.simps add_lemma)
-
-text {*
- Correctness of @{text "rec_pred"}.
- *}
-lemma pred_lemma: "\<And> x. rec_exec rec_pred [x] = x - 1"
-by(induct_tac x, auto simp: rec_pred_def rec_exec.simps)
-
-text {*
- Correctness of @{text "rec_minus"}.
- *}
-lemma minus_lemma: "\<And> x y. rec_exec rec_minus [x, y] = x - y"
-by(induct_tac y, auto simp: rec_exec.simps rec_minus_def pred_lemma)
-
-text {*
- Correctness of @{text "rec_sg"}.
- *}
-lemma sg_lemma: "\<And> x. rec_exec rec_sg [x] = (if x = 0 then 0 else 1)"
-by(auto simp: rec_sg_def minus_lemma rec_exec.simps constn.simps)
-
-text {*
- Correctness of @{text "constn"}.
- *}
-lemma constn_lemma: "rec_exec (constn n) [x] = n"
-by(induct n, auto simp: rec_exec.simps constn.simps)
-
-text {*
- Correctness of @{text "rec_less"}.
- *}
-lemma less_lemma: "\<And> x y. rec_exec rec_less [x, y] =
- (if x < y then 1 else 0)"
-by(induct_tac y, auto simp: rec_exec.simps
- rec_less_def minus_lemma sg_lemma)
-
-text {*
- Correctness of @{text "rec_not"}.
- *}
-lemma not_lemma:
- "\<And> x. rec_exec rec_not [x] = (if x = 0 then 1 else 0)"
-by(induct_tac x, auto simp: rec_exec.simps rec_not_def
- constn_lemma minus_lemma)
-
-text {*
- Correctness of @{text "rec_eq"}.
- *}
-lemma eq_lemma: "\<And> x y. rec_exec rec_eq [x, y] = (if x = y then 1 else 0)"
-by(induct_tac y, auto simp: rec_exec.simps rec_eq_def constn_lemma add_lemma minus_lemma)
-
-text {*
- Correctness of @{text "rec_conj"}.
- *}
-lemma conj_lemma: "\<And> x y. rec_exec rec_conj [x, y] = (if x = 0 \<or> y = 0 then 0
- else 1)"
-by(induct_tac y, auto simp: rec_exec.simps sg_lemma rec_conj_def mult_lemma)
-
-
-text {*
- Correctness of @{text "rec_disj"}.
- *}
-lemma disj_lemma: "\<And> x y. rec_exec rec_disj [x, y] = (if x = 0 \<and> y = 0 then 0
- else 1)"
-by(induct_tac y, auto simp: rec_disj_def sg_lemma add_lemma rec_exec.simps)
-
-
-text {*
- @{text "primrec recf n"} is true iff
- @{text "recf"} is a primitive recursive function
- with arity @{text "n"}.
- *}
-inductive primerec :: "recf \<Rightarrow> nat \<Rightarrow> bool"
- where
-prime_z[intro]: "primerec z (Suc 0)" |
-prime_s[intro]: "primerec s (Suc 0)" |
-prime_id[intro!]: "\<lbrakk>n < m\<rbrakk> \<Longrightarrow> primerec (id m n) m" |
-prime_cn[intro!]: "\<lbrakk>primerec f k; length gs = k;
- \<forall> i < length gs. primerec (gs ! i) m; m = n\<rbrakk>
- \<Longrightarrow> primerec (Cn n f gs) m" |
-prime_pr[intro!]: "\<lbrakk>primerec f n;
- primerec g (Suc (Suc n)); m = Suc n\<rbrakk>
- \<Longrightarrow> primerec (Pr n f g) m"
-
-inductive_cases prime_cn_reverse'[elim]: "primerec (Cn n f gs) n"
-inductive_cases prime_mn_reverse: "primerec (Mn n f) m"
-inductive_cases prime_z_reverse[elim]: "primerec z n"
-inductive_cases prime_s_reverse[elim]: "primerec s n"
-inductive_cases prime_id_reverse[elim]: "primerec (id m n) k"
-inductive_cases prime_cn_reverse[elim]: "primerec (Cn n f gs) m"
-inductive_cases prime_pr_reverse[elim]: "primerec (Pr n f g) m"
-
-declare mult_lemma[simp] add_lemma[simp] pred_lemma[simp]
- minus_lemma[simp] sg_lemma[simp] constn_lemma[simp]
- less_lemma[simp] not_lemma[simp] eq_lemma[simp]
- conj_lemma[simp] disj_lemma[simp]
-
-text {*
- @{text "Sigma"} is the logical specification of
- the recursive function @{text "rec_sigma"}.
- *}
-function Sigma :: "(nat list \<Rightarrow> nat) \<Rightarrow> nat list \<Rightarrow> nat"
- where
- "Sigma g xs = (if last xs = 0 then g xs
- else (Sigma g (butlast xs @ [last xs - 1]) +
- g xs)) "
-by pat_completeness auto
-termination
-proof
- show "wf (measure (\<lambda> (f, xs). last xs))" by auto
-next
- fix g xs
- assume "last (xs::nat list) \<noteq> 0"
- thus "((g, butlast xs @ [last xs - 1]), g, xs)
- \<in> measure (\<lambda>(f, xs). last xs)"
- by auto
-qed
-
-declare rec_exec.simps[simp del] get_fstn_args.simps[simp del]
- arity.simps[simp del] Sigma.simps[simp del]
- rec_sigma.simps[simp del]
-
-lemma [simp]: "arity z = 1"
- by(simp add: arity.simps)
-
-lemma rec_pr_0_simp_rewrite: "
- rec_exec (Pr n f g) (xs @ [0]) = rec_exec f xs"
-by(simp add: rec_exec.simps)
-
-lemma rec_pr_0_simp_rewrite_single_param: "
- rec_exec (Pr n f g) [0] = rec_exec f []"
-by(simp add: rec_exec.simps)
-
-lemma rec_pr_Suc_simp_rewrite:
- "rec_exec (Pr n f g) (xs @ [Suc x]) =
- rec_exec g (xs @ [x] @
- [rec_exec (Pr n f g) (xs @ [x])])"
-by(simp add: rec_exec.simps)
-
-lemma rec_pr_Suc_simp_rewrite_single_param:
- "rec_exec (Pr n f g) ([Suc x]) =
- rec_exec g ([x] @ [rec_exec (Pr n f g) ([x])])"
-by(simp add: rec_exec.simps)
-
-lemma Sigma_0_simp_rewrite_single_param:
- "Sigma f [0] = f [0]"
-by(simp add: Sigma.simps)
-
-lemma Sigma_0_simp_rewrite:
- "Sigma f (xs @ [0]) = f (xs @ [0])"
-by(simp add: Sigma.simps)
-
-lemma Sigma_Suc_simp_rewrite:
- "Sigma f (xs @ [Suc x]) = Sigma f (xs @ [x]) + f (xs @ [Suc x])"
-by(simp add: Sigma.simps)
-
-lemma Sigma_Suc_simp_rewrite_single:
- "Sigma f ([Suc x]) = Sigma f ([x]) + f ([Suc x])"
-by(simp add: Sigma.simps)
-
-lemma [simp]: "(xs @ ys) ! (Suc (length xs)) = ys ! 1"
-by(simp add: nth_append)
-
-lemma get_fstn_args_take: "\<lbrakk>length xs = m; n \<le> m\<rbrakk> \<Longrightarrow>
- map (\<lambda> f. rec_exec f xs) (get_fstn_args m n)= take n xs"
-proof(induct n)
- case 0 thus "?case"
- by(simp add: get_fstn_args.simps)
-next
- case (Suc n) thus "?case"
- by(simp add: get_fstn_args.simps rec_exec.simps
- take_Suc_conv_app_nth)
-qed
-
-lemma [simp]: "primerec f n \<Longrightarrow> arity f = n"
- apply(case_tac f)
- apply(auto simp: arity.simps )
- apply(erule_tac prime_mn_reverse)
- done
-
-lemma rec_sigma_Suc_simp_rewrite:
- "primerec f (Suc (length xs))
- \<Longrightarrow> rec_exec (rec_sigma f) (xs @ [Suc x]) =
- rec_exec (rec_sigma f) (xs @ [x]) + rec_exec f (xs @ [Suc x])"
- apply(induct x)
- apply(auto simp: rec_sigma.simps Let_def rec_pr_Suc_simp_rewrite
- rec_exec.simps get_fstn_args_take)
- done
-
-text {*
- The correctness of @{text "rec_sigma"} with respect to its specification.
- *}
-lemma sigma_lemma:
- "primerec rg (Suc (length xs))
- \<Longrightarrow> rec_exec (rec_sigma rg) (xs @ [x]) = Sigma (rec_exec rg) (xs @ [x])"
-apply(induct x)
-apply(auto simp: rec_exec.simps rec_sigma.simps Let_def
- get_fstn_args_take Sigma_0_simp_rewrite
- Sigma_Suc_simp_rewrite)
-done
-
-text {*
- @{text "rec_accum f (x1, x2, \<dots>, xn, k) =
- f(x1, x2, \<dots>, xn, 0) *
- f(x1, x2, \<dots>, xn, 1) *
- \<dots>
- f(x1, x2, \<dots>, xn, k)"}
-*}
-fun rec_accum :: "recf \<Rightarrow> recf"
- where
- "rec_accum rf =
- (let vl = arity rf in
- Pr (vl - 1) (Cn (vl - 1) rf (get_fstn_args (vl - 1) (vl - 1) @
- [Cn (vl - 1) (constn 0) [id (vl - 1) 0]]))
- (Cn (Suc vl) rec_mult [id (Suc vl) (vl),
- Cn (Suc vl) rf (get_fstn_args (Suc vl) (vl - 1)
- @ [Cn (Suc vl) s [id (Suc vl) (vl - 1)]])]))"
-
-text {*
- @{text "Accum"} is the formal specification of @{text "rec_accum"}.
- *}
-function Accum :: "(nat list \<Rightarrow> nat) \<Rightarrow> nat list \<Rightarrow> nat"
- where
- "Accum f xs = (if last xs = 0 then f xs
- else (Accum f (butlast xs @ [last xs - 1]) *
- f xs))"
-by pat_completeness auto
-termination
-proof
- show "wf (measure (\<lambda> (f, xs). last xs))"
- by auto
-next
- fix f xs
- assume "last xs \<noteq> (0::nat)"
- thus "((f, butlast xs @ [last xs - 1]), f, xs) \<in>
- measure (\<lambda>(f, xs). last xs)"
- by auto
-qed
-
-lemma rec_accum_Suc_simp_rewrite:
- "primerec f (Suc (length xs))
- \<Longrightarrow> rec_exec (rec_accum f) (xs @ [Suc x]) =
- rec_exec (rec_accum f) (xs @ [x]) * rec_exec f (xs @ [Suc x])"
- apply(induct x)
- apply(auto simp: rec_sigma.simps Let_def rec_pr_Suc_simp_rewrite
- rec_exec.simps get_fstn_args_take)
- done
-
-text {*
- The correctness of @{text "rec_accum"} with respect to its specification.
-*}
-lemma accum_lemma :
- "primerec rg (Suc (length xs))
- \<Longrightarrow> rec_exec (rec_accum rg) (xs @ [x]) = Accum (rec_exec rg) (xs @ [x])"
-apply(induct x)
-apply(auto simp: rec_exec.simps rec_sigma.simps Let_def
- get_fstn_args_take)
-done
-
-declare rec_accum.simps [simp del]
-
-text {*
- @{text "rec_all t f (x1, x2, \<dots>, xn)"}
- computes the charactrization function of the following FOL formula:
- @{text "(\<forall> x \<le> t(x1, x2, \<dots>, xn). (f(x1, x2, \<dots>, xn, x) > 0))"}
-*}
-fun rec_all :: "recf \<Rightarrow> recf \<Rightarrow> recf"
- where
- "rec_all rt rf =
- (let vl = arity rf in
- Cn (vl - 1) rec_sg [Cn (vl - 1) (rec_accum rf)
- (get_fstn_args (vl - 1) (vl - 1) @ [rt])])"
-
-lemma rec_accum_ex: "primerec rf (Suc (length xs)) \<Longrightarrow>
- (rec_exec (rec_accum rf) (xs @ [x]) = 0) =
- (\<exists> t \<le> x. rec_exec rf (xs @ [t]) = 0)"
-apply(induct x, simp_all add: rec_accum_Suc_simp_rewrite)
-apply(simp add: rec_exec.simps rec_accum.simps get_fstn_args_take,
- auto)
-apply(rule_tac x = ta in exI, simp)
-apply(case_tac "t = Suc x", simp_all)
-apply(rule_tac x = t in exI, simp)
-done
-
-text {*
- The correctness of @{text "rec_all"}.
- *}
-lemma all_lemma:
- "\<lbrakk>primerec rf (Suc (length xs));
- primerec rt (length xs)\<rbrakk>
- \<Longrightarrow> rec_exec (rec_all rt rf) xs = (if (\<forall> x \<le> (rec_exec rt xs). 0 < rec_exec rf (xs @ [x])) then 1
- else 0)"
-apply(auto simp: rec_all.simps)
-apply(simp add: rec_exec.simps map_append get_fstn_args_take split: if_splits)
-apply(drule_tac x = "rec_exec rt xs" in rec_accum_ex)
-apply(case_tac "rec_exec (rec_accum rf) (xs @ [rec_exec rt xs]) = 0", simp_all)
-apply(erule_tac exE, erule_tac x = t in allE, simp)
-apply(simp add: rec_exec.simps map_append get_fstn_args_take)
-apply(drule_tac x = "rec_exec rt xs" in rec_accum_ex)
-apply(case_tac "rec_exec (rec_accum rf) (xs @ [rec_exec rt xs]) = 0", simp, simp)
-apply(erule_tac x = x in allE, simp)
-done
-
-text {*
- @{text "rec_ex t f (x1, x2, \<dots>, xn)"}
- computes the charactrization function of the following FOL formula:
- @{text "(\<exists> x \<le> t(x1, x2, \<dots>, xn). (f(x1, x2, \<dots>, xn, x) > 0))"}
-*}
-fun rec_ex :: "recf \<Rightarrow> recf \<Rightarrow> recf"
- where
- "rec_ex rt rf =
- (let vl = arity rf in
- Cn (vl - 1) rec_sg [Cn (vl - 1) (rec_sigma rf)
- (get_fstn_args (vl - 1) (vl - 1) @ [rt])])"
-
-lemma rec_sigma_ex: "primerec rf (Suc (length xs))
- \<Longrightarrow> (rec_exec (rec_sigma rf) (xs @ [x]) = 0) =
- (\<forall> t \<le> x. rec_exec rf (xs @ [t]) = 0)"
-apply(induct x, simp_all add: rec_sigma_Suc_simp_rewrite)
-apply(simp add: rec_exec.simps rec_sigma.simps
- get_fstn_args_take, auto)
-apply(case_tac "t = Suc x", simp_all)
-done
-
-text {*
- The correctness of @{text "ex_lemma"}.
- *}
-lemma ex_lemma:"
- \<lbrakk>primerec rf (Suc (length xs));
- primerec rt (length xs)\<rbrakk>
-\<Longrightarrow> (rec_exec (rec_ex rt rf) xs =
- (if (\<exists> x \<le> (rec_exec rt xs). 0 <rec_exec rf (xs @ [x])) then 1
- else 0))"
-apply(auto simp: rec_ex.simps rec_exec.simps map_append get_fstn_args_take
- split: if_splits)
-apply(drule_tac x = "rec_exec rt xs" in rec_sigma_ex, simp)
-apply(drule_tac x = "rec_exec rt xs" in rec_sigma_ex, simp)
-done
-
-text {*
- Defintiion of @{text "Min[R]"} on page 77 of Boolos's book.
-*}
-
-fun Minr :: "(nat list \<Rightarrow> bool) \<Rightarrow> nat list \<Rightarrow> nat \<Rightarrow> nat"
- where "Minr Rr xs w = (let setx = {y | y. (y \<le> w) \<and> Rr (xs @ [y])} in
- if (setx = {}) then (Suc w)
- else (Min setx))"
-
-declare Minr.simps[simp del] rec_all.simps[simp del]
-
-text {*
- The following is a set of auxilliary lemmas about @{text "Minr"}.
-*}
-lemma Minr_range: "Minr Rr xs w \<le> w \<or> Minr Rr xs w = Suc w"
-apply(auto simp: Minr.simps)
-apply(subgoal_tac "Min {x. x \<le> w \<and> Rr (xs @ [x])} \<le> x")
-apply(erule_tac order_trans, simp)
-apply(rule_tac Min_le, auto)
-done
-
-lemma [simp]: "{x. x \<le> Suc w \<and> Rr (xs @ [x])}
- = (if Rr (xs @ [Suc w]) then insert (Suc w)
- {x. x \<le> w \<and> Rr (xs @ [x])}
- else {x. x \<le> w \<and> Rr (xs @ [x])})"
-by(auto, case_tac "x = Suc w", auto)
-
-lemma [simp]: "Minr Rr xs w \<le> w \<Longrightarrow> Minr Rr xs (Suc w) = Minr Rr xs w"
-apply(simp add: Minr.simps, auto)
-apply(case_tac "\<forall>x\<le>w. \<not> Rr (xs @ [x])", auto)
-done
-
-lemma [simp]: "\<forall>x\<le>w. \<not> Rr (xs @ [x]) \<Longrightarrow>
- {x. x \<le> w \<and> Rr (xs @ [x])} = {} "
-by auto
-
-lemma [simp]: "\<lbrakk>Minr Rr xs w = Suc w; Rr (xs @ [Suc w])\<rbrakk> \<Longrightarrow>
- Minr Rr xs (Suc w) = Suc w"
-apply(simp add: Minr.simps)
-apply(case_tac "\<forall>x\<le>w. \<not> Rr (xs @ [x])", auto)
-done
-
-lemma [simp]: "\<lbrakk>Minr Rr xs w = Suc w; \<not> Rr (xs @ [Suc w])\<rbrakk> \<Longrightarrow>
- Minr Rr xs (Suc w) = Suc (Suc w)"
-apply(simp add: Minr.simps)
-apply(case_tac "\<forall>x\<le>w. \<not> Rr (xs @ [x])", auto)
-apply(subgoal_tac "Min {x. x \<le> w \<and> Rr (xs @ [x])} \<in>
- {x. x \<le> w \<and> Rr (xs @ [x])}", simp)
-apply(rule_tac Min_in, auto)
-done
-
-lemma Minr_Suc_simp:
- "Minr Rr xs (Suc w) =
- (if Minr Rr xs w \<le> w then Minr Rr xs w
- else if (Rr (xs @ [Suc w])) then (Suc w)
- else Suc (Suc w))"
-by(insert Minr_range[of Rr xs w], auto)
-
-text {*
- @{text "rec_Minr"} is the recursive function
- used to implement @{text "Minr"}:
- if @{text "Rr"} is implemented by a recursive function @{text "recf"},
- then @{text "rec_Minr recf"} is the recursive function used to
- implement @{text "Minr Rr"}
- *}
-fun rec_Minr :: "recf \<Rightarrow> recf"
- where
- "rec_Minr rf =
- (let vl = arity rf
- in let rq = rec_all (id vl (vl - 1)) (Cn (Suc vl)
- rec_not [Cn (Suc vl) rf
- (get_fstn_args (Suc vl) (vl - 1) @
- [id (Suc vl) (vl)])])
- in rec_sigma rq)"
-
-lemma length_getpren_params[simp]: "length (get_fstn_args m n) = n"
-by(induct n, auto simp: get_fstn_args.simps)
-
-lemma length_app:
- "(length (get_fstn_args (arity rf - Suc 0)
- (arity rf - Suc 0)
- @ [Cn (arity rf - Suc 0) (constn 0)
- [recf.id (arity rf - Suc 0) 0]]))
- = (Suc (arity rf - Suc 0))"
- apply(simp)
-done
-
-lemma primerec_accum: "primerec (rec_accum rf) n \<Longrightarrow> primerec rf n"
-apply(auto simp: rec_accum.simps Let_def)
-apply(erule_tac prime_pr_reverse, simp)
-apply(erule_tac prime_cn_reverse, simp only: length_app)
-done
-
-lemma primerec_all: "primerec (rec_all rt rf) n \<Longrightarrow>
- primerec rt n \<and> primerec rf (Suc n)"
-apply(simp add: rec_all.simps Let_def)
-apply(erule_tac prime_cn_reverse, simp)
-apply(erule_tac prime_cn_reverse, simp)
-apply(erule_tac x = n in allE, simp add: nth_append primerec_accum)
-done
-
-lemma min_Suc_Suc[simp]: "min (Suc (Suc x)) x = x"
- by auto
-
-declare numeral_3_eq_3[simp]
-
-lemma [intro]: "primerec rec_pred (Suc 0)"
-apply(simp add: rec_pred_def)
-apply(rule_tac prime_cn, auto)
-apply(case_tac i, auto intro: prime_id)
-done
-
-lemma [intro]: "primerec rec_minus (Suc (Suc 0))"
- apply(auto simp: rec_minus_def)
- done
-
-lemma [intro]: "primerec (constn n) (Suc 0)"
- apply(induct n)
- apply(auto simp: constn.simps intro: prime_z prime_cn prime_s)
- done
-
-lemma [intro]: "primerec rec_sg (Suc 0)"
- apply(simp add: rec_sg_def)
- apply(rule_tac k = "Suc (Suc 0)" in prime_cn, auto)
- apply(case_tac i, auto)
- apply(case_tac ia, auto intro: prime_id)
- done
-
-lemma [simp]: "length (get_fstn_args m n) = n"
- apply(induct n)
- apply(auto simp: get_fstn_args.simps)
- done
-
-lemma primerec_getpren[elim]: "\<lbrakk>i < n; n \<le> m\<rbrakk> \<Longrightarrow> primerec (get_fstn_args m n ! i) m"
-apply(induct n, auto simp: get_fstn_args.simps)
-apply(case_tac "i = n", auto simp: nth_append intro: prime_id)
-done
-
-lemma [intro]: "primerec rec_add (Suc (Suc 0))"
-apply(simp add: rec_add_def)
-apply(rule_tac prime_pr, auto)
-done
-
-lemma [intro]:"primerec rec_mult (Suc (Suc 0))"
-apply(simp add: rec_mult_def )
-apply(rule_tac prime_pr, auto intro: prime_z)
-apply(case_tac i, auto intro: prime_id)
-done
-
-lemma [elim]: "\<lbrakk>primerec rf n; n \<ge> Suc (Suc 0)\<rbrakk> \<Longrightarrow>
- primerec (rec_accum rf) n"
-apply(auto simp: rec_accum.simps)
-apply(simp add: nth_append, auto)
-apply(case_tac i, auto intro: prime_id)
-apply(auto simp: nth_append)
-done
-
-lemma primerec_all_iff:
- "\<lbrakk>primerec rt n; primerec rf (Suc n); n > 0\<rbrakk> \<Longrightarrow>
- primerec (rec_all rt rf) n"
- apply(simp add: rec_all.simps, auto)
- apply(auto, simp add: nth_append, auto)
- done
-
-lemma [simp]: "Rr (xs @ [0]) \<Longrightarrow>
- Min {x. x = (0::nat) \<and> Rr (xs @ [x])} = 0"
-by(rule_tac Min_eqI, simp, simp, simp)
-
-lemma [intro]: "primerec rec_not (Suc 0)"
-apply(simp add: rec_not_def)
-apply(rule prime_cn, auto)
-apply(case_tac i, auto intro: prime_id)
-done
-
-lemma Min_false1[simp]: "\<lbrakk>\<not> Min {uu. uu \<le> w \<and> 0 < rec_exec rf (xs @ [uu])} \<le> w;
- x \<le> w; 0 < rec_exec rf (xs @ [x])\<rbrakk>
- \<Longrightarrow> False"
-apply(subgoal_tac "finite {uu. uu \<le> w \<and> 0 < rec_exec rf (xs @ [uu])}")
-apply(subgoal_tac "{uu. uu \<le> w \<and> 0 < rec_exec rf (xs @ [uu])} \<noteq> {}")
-apply(simp add: Min_le_iff, simp)
-apply(rule_tac x = x in exI, simp)
-apply(simp)
-done
-
-lemma sigma_minr_lemma:
- assumes prrf: "primerec rf (Suc (length xs))"
- shows "UF.Sigma (rec_exec (rec_all (recf.id (Suc (length xs)) (length xs))
- (Cn (Suc (Suc (length xs))) rec_not
- [Cn (Suc (Suc (length xs))) rf (get_fstn_args (Suc (Suc (length xs)))
- (length xs) @ [recf.id (Suc (Suc (length xs))) (Suc (length xs))])])))
- (xs @ [w]) =
- Minr (\<lambda>args. 0 < rec_exec rf args) xs w"
-proof(induct w)
- let ?rt = "(recf.id (Suc (length xs)) ((length xs)))"
- let ?rf = "(Cn (Suc (Suc (length xs)))
- rec_not [Cn (Suc (Suc (length xs))) rf
- (get_fstn_args (Suc (Suc (length xs))) (length xs) @
- [recf.id (Suc (Suc (length xs)))
- (Suc ((length xs)))])])"
- let ?rq = "(rec_all ?rt ?rf)"
- have prrf: "primerec ?rf (Suc (length (xs @ [0]))) \<and>
- primerec ?rt (length (xs @ [0]))"
- apply(auto simp: prrf nth_append)+
- done
- show "Sigma (rec_exec (rec_all ?rt ?rf)) (xs @ [0])
- = Minr (\<lambda>args. 0 < rec_exec rf args) xs 0"
- apply(simp add: Sigma.simps)
- apply(simp only: prrf all_lemma,
- auto simp: rec_exec.simps get_fstn_args_take Minr.simps)
- apply(rule_tac Min_eqI, auto)
- done
-next
- fix w
- let ?rt = "(recf.id (Suc (length xs)) ((length xs)))"
- let ?rf = "(Cn (Suc (Suc (length xs)))
- rec_not [Cn (Suc (Suc (length xs))) rf
- (get_fstn_args (Suc (Suc (length xs))) (length xs) @
- [recf.id (Suc (Suc (length xs)))
- (Suc ((length xs)))])])"
- let ?rq = "(rec_all ?rt ?rf)"
- assume ind:
- "Sigma (rec_exec (rec_all ?rt ?rf)) (xs @ [w]) = Minr (\<lambda>args. 0 < rec_exec rf args) xs w"
- have prrf: "primerec ?rf (Suc (length (xs @ [Suc w]))) \<and>
- primerec ?rt (length (xs @ [Suc w]))"
- apply(auto simp: prrf nth_append)+
- done
- show "UF.Sigma (rec_exec (rec_all ?rt ?rf))
- (xs @ [Suc w]) =
- Minr (\<lambda>args. 0 < rec_exec rf args) xs (Suc w)"
- apply(auto simp: Sigma_Suc_simp_rewrite ind Minr_Suc_simp)
- apply(simp_all only: prrf all_lemma)
- apply(auto simp: rec_exec.simps get_fstn_args_take Let_def Minr.simps split: if_splits)
- apply(drule_tac Min_false1, simp, simp, simp)
- apply(case_tac "x = Suc w", simp, simp)
- apply(drule_tac Min_false1, simp, simp, simp)
- apply(drule_tac Min_false1, simp, simp, simp)
- done
-qed
-
-text {*
- The correctness of @{text "rec_Minr"}.
- *}
-lemma Minr_lemma: "
- \<lbrakk>primerec rf (Suc (length xs))\<rbrakk>
- \<Longrightarrow> rec_exec (rec_Minr rf) (xs @ [w]) =
- Minr (\<lambda> args. (0 < rec_exec rf args)) xs w"
-proof -
- let ?rt = "(recf.id (Suc (length xs)) ((length xs)))"
- let ?rf = "(Cn (Suc (Suc (length xs)))
- rec_not [Cn (Suc (Suc (length xs))) rf
- (get_fstn_args (Suc (Suc (length xs))) (length xs) @
- [recf.id (Suc (Suc (length xs)))
- (Suc ((length xs)))])])"
- let ?rq = "(rec_all ?rt ?rf)"
- assume h: "primerec rf (Suc (length xs))"
- have h1: "primerec ?rq (Suc (length xs))"
- apply(rule_tac primerec_all_iff)
- apply(auto simp: h nth_append)+
- done
- moreover have "arity rf = Suc (length xs)"
- using h by auto
- ultimately show "rec_exec (rec_Minr rf) (xs @ [w]) =
- Minr (\<lambda> args. (0 < rec_exec rf args)) xs w"
- apply(simp add: rec_exec.simps rec_Minr.simps arity.simps Let_def
- sigma_lemma all_lemma)
- apply(rule_tac sigma_minr_lemma)
- apply(simp add: h)
- done
-qed
-
-text {*
- @{text "rec_le"} is the comparasion function
- which compares its two arguments, testing whether the
- first is less or equal to the second.
- *}
-definition rec_le :: "recf"
- where
- "rec_le = Cn (Suc (Suc 0)) rec_disj [rec_less, rec_eq]"
-
-text {*
- The correctness of @{text "rec_le"}.
- *}
-lemma le_lemma:
- "\<And>x y. rec_exec rec_le [x, y] = (if (x \<le> y) then 1 else 0)"
-by(auto simp: rec_le_def rec_exec.simps)
-
-text {*
- Defintiion of @{text "Max[Rr]"} on page 77 of Boolos's book.
-*}
-
-fun Maxr :: "(nat list \<Rightarrow> bool) \<Rightarrow> nat list \<Rightarrow> nat \<Rightarrow> nat"
- where
- "Maxr Rr xs w = (let setx = {y. y \<le> w \<and> Rr (xs @[y])} in
- if setx = {} then 0
- else Max setx)"
-
-text {*
- @{text "rec_maxr"} is the recursive function
- used to implementation @{text "Maxr"}.
- *}
-fun rec_maxr :: "recf \<Rightarrow> recf"
- where
- "rec_maxr rr = (let vl = arity rr in
- let rt = id (Suc vl) (vl - 1) in
- let rf1 = Cn (Suc (Suc vl)) rec_le
- [id (Suc (Suc vl))
- ((Suc vl)), id (Suc (Suc vl)) (vl)] in
- let rf2 = Cn (Suc (Suc vl)) rec_not
- [Cn (Suc (Suc vl))
- rr (get_fstn_args (Suc (Suc vl))
- (vl - 1) @
- [id (Suc (Suc vl)) ((Suc vl))])] in
- let rf = Cn (Suc (Suc vl)) rec_disj [rf1, rf2] in
- let rq = rec_all rt rf in
- let Qf = Cn (Suc vl) rec_not [rec_all rt rf]
- in Cn vl (rec_sigma Qf) (get_fstn_args vl vl @
- [id vl (vl - 1)]))"
-
-declare rec_maxr.simps[simp del] Maxr.simps[simp del]
-declare le_lemma[simp]
-lemma [simp]: "(min (Suc (Suc (Suc (x)))) (x)) = x"
-by simp
-
-declare numeral_2_eq_2[simp]
-
-lemma [intro]: "primerec rec_disj (Suc (Suc 0))"
- apply(simp add: rec_disj_def, auto)
- apply(auto)
- apply(case_tac ia, auto intro: prime_id)
- done
-
-lemma [intro]: "primerec rec_less (Suc (Suc 0))"
- apply(simp add: rec_less_def, auto)
- apply(auto)
- apply(case_tac ia , auto intro: prime_id)
- done
-
-lemma [intro]: "primerec rec_eq (Suc (Suc 0))"
- apply(simp add: rec_eq_def)
- apply(rule_tac prime_cn, auto)
- apply(case_tac i, auto)
- apply(case_tac ia, auto)
- apply(case_tac [!] i, auto intro: prime_id)
- done
-
-lemma [intro]: "primerec rec_le (Suc (Suc 0))"
- apply(simp add: rec_le_def)
- apply(rule_tac prime_cn, auto)
- apply(case_tac i, auto)
- done
-
-lemma [simp]:
- "length ys = Suc n \<Longrightarrow> (take n ys @ [ys ! n, ys ! n]) =
- ys @ [ys ! n]"
-apply(simp)
-apply(subgoal_tac "\<exists> xs y. ys = xs @ [y]", auto)
-apply(rule_tac x = "butlast ys" in exI, rule_tac x = "last ys" in exI)
-apply(case_tac "ys = []", simp_all)
-done
-
-lemma Maxr_Suc_simp:
- "Maxr Rr xs (Suc w) =(if Rr (xs @ [Suc w]) then Suc w
- else Maxr Rr xs w)"
-apply(auto simp: Maxr.simps)
-apply(rule_tac max_absorb1)
-apply(subgoal_tac "(Max {y. y \<le> w \<and> Rr (xs @ [y])} \<le> (Suc w)) =
- (\<forall>a\<in>{y. y \<le> w \<and> Rr (xs @ [y])}. a \<le> (Suc w))", simp)
-apply(rule_tac Max_le_iff, auto)
-done
-
-
-lemma [simp]: "min (Suc n) n = n" by simp
-
-lemma Sigma_0: "\<forall> i \<le> n. (f (xs @ [i]) = 0) \<Longrightarrow>
- Sigma f (xs @ [n]) = 0"
-apply(induct n, simp add: Sigma.simps)
-apply(simp add: Sigma_Suc_simp_rewrite)
-done
-
-lemma [elim]: "\<forall>k<Suc w. f (xs @ [k]) = Suc 0
- \<Longrightarrow> Sigma f (xs @ [w]) = Suc w"
-apply(induct w)
-apply(simp add: Sigma.simps, simp)
-apply(simp add: Sigma.simps)
-done
-
-lemma Sigma_max_point: "\<lbrakk>\<forall> k < ma. f (xs @ [k]) = 1;
- \<forall> k \<ge> ma. f (xs @ [k]) = 0; ma \<le> w\<rbrakk>
- \<Longrightarrow> Sigma f (xs @ [w]) = ma"
-apply(induct w, auto)
-apply(rule_tac Sigma_0, simp)
-apply(simp add: Sigma_Suc_simp_rewrite)
-apply(case_tac "ma = Suc w", auto)
-done
-
-lemma Sigma_Max_lemma:
- assumes prrf: "primerec rf (Suc (length xs))"
- shows "UF.Sigma (rec_exec (Cn (Suc (Suc (length xs))) rec_not
- [rec_all (recf.id (Suc (Suc (length xs))) (length xs))
- (Cn (Suc (Suc (Suc (length xs)))) rec_disj
- [Cn (Suc (Suc (Suc (length xs)))) rec_le
- [recf.id (Suc (Suc (Suc (length xs)))) (Suc (Suc (length xs))),
- recf.id (Suc (Suc (Suc (length xs)))) (Suc (length xs))],
- Cn (Suc (Suc (Suc (length xs)))) rec_not
- [Cn (Suc (Suc (Suc (length xs)))) rf
- (get_fstn_args (Suc (Suc (Suc (length xs)))) (length xs) @
- [recf.id (Suc (Suc (Suc (length xs)))) (Suc (Suc (length xs)))])]])]))
- ((xs @ [w]) @ [w]) =
- Maxr (\<lambda>args. 0 < rec_exec rf args) xs w"
-proof -
- let ?rt = "(recf.id (Suc (Suc (length xs))) ((length xs)))"
- let ?rf1 = "Cn (Suc (Suc (Suc (length xs))))
- rec_le [recf.id (Suc (Suc (Suc (length xs))))
- ((Suc (Suc (length xs)))), recf.id
- (Suc (Suc (Suc (length xs)))) ((Suc (length xs)))]"
- let ?rf2 = "Cn (Suc (Suc (Suc (length xs)))) rf
- (get_fstn_args (Suc (Suc (Suc (length xs))))
- (length xs) @
- [recf.id (Suc (Suc (Suc (length xs))))
- ((Suc (Suc (length xs))))])"
- let ?rf3 = "Cn (Suc (Suc (Suc (length xs)))) rec_not [?rf2]"
- let ?rf = "Cn (Suc (Suc (Suc (length xs)))) rec_disj [?rf1, ?rf3]"
- let ?rq = "rec_all ?rt ?rf"
- let ?notrq = "Cn (Suc (Suc (length xs))) rec_not [?rq]"
- show "?thesis"
- proof(auto simp: Maxr.simps)
- assume h: "\<forall>x\<le>w. rec_exec rf (xs @ [x]) = 0"
- have "primerec ?rf (Suc (length (xs @ [w, i]))) \<and>
- primerec ?rt (length (xs @ [w, i]))"
- using prrf
- apply(auto)
- apply(case_tac i, auto)
- apply(case_tac ia, auto simp: h nth_append)
- done
- hence "Sigma (rec_exec ?notrq) ((xs@[w])@[w]) = 0"
- apply(rule_tac Sigma_0)
- apply(auto simp: rec_exec.simps all_lemma
- get_fstn_args_take nth_append h)
- done
- thus "UF.Sigma (rec_exec ?notrq)
- (xs @ [w, w]) = 0"
- by simp
- next
- fix x
- assume h: "x \<le> w" "0 < rec_exec rf (xs @ [x])"
- hence "\<exists> ma. Max {y. y \<le> w \<and> 0 < rec_exec rf (xs @ [y])} = ma"
- by auto
- from this obtain ma where k1:
- "Max {y. y \<le> w \<and> 0 < rec_exec rf (xs @ [y])} = ma" ..
- hence k2: "ma \<le> w \<and> 0 < rec_exec rf (xs @ [ma])"
- using h
- apply(subgoal_tac
- "Max {y. y \<le> w \<and> 0 < rec_exec rf (xs @ [y])} \<in> {y. y \<le> w \<and> 0 < rec_exec rf (xs @ [y])}")
- apply(erule_tac CollectE, simp)
- apply(rule_tac Max_in, auto)
- done
- hence k3: "\<forall> k < ma. (rec_exec ?notrq (xs @ [w, k]) = 1)"
- apply(auto simp: nth_append)
- apply(subgoal_tac "primerec ?rf (Suc (length (xs @ [w, k]))) \<and>
- primerec ?rt (length (xs @ [w, k]))")
- apply(auto simp: rec_exec.simps all_lemma get_fstn_args_take nth_append)
- using prrf
- apply(case_tac i, auto)
- apply(case_tac ia, auto simp: h nth_append)
- done
- have k4: "\<forall> k \<ge> ma. (rec_exec ?notrq (xs @ [w, k]) = 0)"
- apply(auto)
- apply(subgoal_tac "primerec ?rf (Suc (length (xs @ [w, k]))) \<and>
- primerec ?rt (length (xs @ [w, k]))")
- apply(auto simp: rec_exec.simps all_lemma get_fstn_args_take nth_append)
- apply(subgoal_tac "x \<le> Max {y. y \<le> w \<and> 0 < rec_exec rf (xs @ [y])}",
- simp add: k1)
- apply(rule_tac Max_ge, auto)
- using prrf
- apply(case_tac i, auto)
- apply(case_tac ia, auto simp: h nth_append)
- done
- from k3 k4 k1 have "Sigma (rec_exec ?notrq) ((xs @ [w]) @ [w]) = ma"
- apply(rule_tac Sigma_max_point, simp, simp, simp add: k2)
- done
- from k1 and this show "Sigma (rec_exec ?notrq) (xs @ [w, w]) =
- Max {y. y \<le> w \<and> 0 < rec_exec rf (xs @ [y])}"
- by simp
- qed
-qed
-
-text {*
- The correctness of @{text "rec_maxr"}.
- *}
-lemma Maxr_lemma:
- assumes h: "primerec rf (Suc (length xs))"
- shows "rec_exec (rec_maxr rf) (xs @ [w]) =
- Maxr (\<lambda> args. 0 < rec_exec rf args) xs w"
-proof -
- from h have "arity rf = Suc (length xs)"
- by auto
- thus "?thesis"
- proof(simp add: rec_exec.simps rec_maxr.simps nth_append get_fstn_args_take)
- let ?rt = "(recf.id (Suc (Suc (length xs))) ((length xs)))"
- let ?rf1 = "Cn (Suc (Suc (Suc (length xs))))
- rec_le [recf.id (Suc (Suc (Suc (length xs))))
- ((Suc (Suc (length xs)))), recf.id
- (Suc (Suc (Suc (length xs)))) ((Suc (length xs)))]"
- let ?rf2 = "Cn (Suc (Suc (Suc (length xs)))) rf
- (get_fstn_args (Suc (Suc (Suc (length xs))))
- (length xs) @
- [recf.id (Suc (Suc (Suc (length xs))))
- ((Suc (Suc (length xs))))])"
- let ?rf3 = "Cn (Suc (Suc (Suc (length xs)))) rec_not [?rf2]"
- let ?rf = "Cn (Suc (Suc (Suc (length xs)))) rec_disj [?rf1, ?rf3]"
- let ?rq = "rec_all ?rt ?rf"
- let ?notrq = "Cn (Suc (Suc (length xs))) rec_not [?rq]"
- have prt: "primerec ?rt (Suc (Suc (length xs)))"
- by(auto intro: prime_id)
- have prrf: "primerec ?rf (Suc (Suc (Suc (length xs))))"
- apply(auto)
- apply(case_tac i, auto)
- apply(case_tac ia, auto intro: prime_id)
- apply(simp add: h)
- apply(simp add: nth_append, auto intro: prime_id)
- done
- from prt and prrf have prrq: "primerec ?rq
- (Suc (Suc (length xs)))"
- by(erule_tac primerec_all_iff, auto)
- hence prnotrp: "primerec ?notrq (Suc (length ((xs @ [w]))))"
- by(rule_tac prime_cn, auto)
- have g1: "rec_exec (rec_sigma ?notrq) ((xs @ [w]) @ [w])
- = Maxr (\<lambda>args. 0 < rec_exec rf args) xs w"
- using prnotrp
- using sigma_lemma
- apply(simp only: sigma_lemma)
- apply(rule_tac Sigma_Max_lemma)
- apply(simp add: h)
- done
- thus "rec_exec (rec_sigma ?notrq)
- (xs @ [w, w]) =
- Maxr (\<lambda>args. 0 < rec_exec rf args) xs w"
- apply(simp)
- done
- qed
-qed
-
-text {*
- @{text "quo"} is the formal specification of division.
- *}
-fun quo :: "nat list \<Rightarrow> nat"
- where
- "quo [x, y] = (let Rr =
- (\<lambda> zs. ((zs ! (Suc 0) * zs ! (Suc (Suc 0))
- \<le> zs ! 0) \<and> zs ! Suc 0 \<noteq> (0::nat)))
- in Maxr Rr [x, y] x)"
-
-declare quo.simps[simp del]
-
-text {*
- The following lemmas shows more directly the menaing of @{text "quo"}:
- *}
-lemma [elim!]: "y > 0 \<Longrightarrow> quo [x, y] = x div y"
-proof(simp add: quo.simps Maxr.simps, auto,
- rule_tac Max_eqI, simp, auto)
- fix xa ya
- assume h: "y * ya \<le> x" "y > 0"
- hence "(y * ya) div y \<le> x div y"
- by(insert div_le_mono[of "y * ya" x y], simp)
- from this and h show "ya \<le> x div y" by simp
-next
- fix xa
- show "y * (x div y) \<le> x"
- apply(subgoal_tac "y * (x div y) + x mod y = x")
- apply(rule_tac k = "x mod y" in add_leD1, simp)
- apply(simp)
- done
-qed
-
-lemma [intro]: "quo [x, 0] = 0"
-by(simp add: quo.simps Maxr.simps)
-
-lemma quo_div: "quo [x, y] = x div y"
-by(case_tac "y=0", auto)
-
-text {*
- @{text "rec_noteq"} is the recursive function testing whether its
- two arguments are not equal.
- *}
-definition rec_noteq:: "recf"
- where
- "rec_noteq = Cn (Suc (Suc 0)) rec_not [Cn (Suc (Suc 0))
- rec_eq [id (Suc (Suc 0)) (0), id (Suc (Suc 0))
- ((Suc 0))]]"
-
-text {*
- The correctness of @{text "rec_noteq"}.
- *}
-lemma noteq_lemma:
- "\<And> x y. rec_exec rec_noteq [x, y] =
- (if x \<noteq> y then 1 else 0)"
-by(simp add: rec_exec.simps rec_noteq_def)
-
-declare noteq_lemma[simp]
-
-text {*
- @{text "rec_quo"} is the recursive function used to implement @{text "quo"}
- *}
-definition rec_quo :: "recf"
- where
- "rec_quo = (let rR = Cn (Suc (Suc (Suc 0))) rec_conj
- [Cn (Suc (Suc (Suc 0))) rec_le
- [Cn (Suc (Suc (Suc 0))) rec_mult
- [id (Suc (Suc (Suc 0))) (Suc 0),
- id (Suc (Suc (Suc 0))) ((Suc (Suc 0)))],
- id (Suc (Suc (Suc 0))) (0)],
- Cn (Suc (Suc (Suc 0))) rec_noteq
- [id (Suc (Suc (Suc 0))) (Suc (0)),
- Cn (Suc (Suc (Suc 0))) (constn 0)
- [id (Suc (Suc (Suc 0))) (0)]]]
- in Cn (Suc (Suc 0)) (rec_maxr rR)) [id (Suc (Suc 0))
- (0),id (Suc (Suc 0)) (Suc (0)),
- id (Suc (Suc 0)) (0)]"
-
-lemma [intro]: "primerec rec_conj (Suc (Suc 0))"
- apply(simp add: rec_conj_def)
- apply(rule_tac prime_cn, auto)+
- apply(case_tac i, auto intro: prime_id)
- done
-
-lemma [intro]: "primerec rec_noteq (Suc (Suc 0))"
-apply(simp add: rec_noteq_def)
-apply(rule_tac prime_cn, auto)+
-apply(case_tac i, auto intro: prime_id)
-done
-
-
-lemma quo_lemma1: "rec_exec rec_quo [x, y] = quo [x, y]"
-proof(simp add: rec_exec.simps rec_quo_def)
- let ?rR = "(Cn (Suc (Suc (Suc 0))) rec_conj
- [Cn (Suc (Suc (Suc 0))) rec_le
- [Cn (Suc (Suc (Suc 0))) rec_mult
- [recf.id (Suc (Suc (Suc 0))) (Suc (0)),
- recf.id (Suc (Suc (Suc 0))) (Suc (Suc (0)))],
- recf.id (Suc (Suc (Suc 0))) (0)],
- Cn (Suc (Suc (Suc 0))) rec_noteq
- [recf.id (Suc (Suc (Suc 0)))
- (Suc (0)), Cn (Suc (Suc (Suc 0))) (constn 0)
- [recf.id (Suc (Suc (Suc 0))) (0)]]])"
- have "rec_exec (rec_maxr ?rR) ([x, y]@ [ x]) = Maxr (\<lambda> args. 0 < rec_exec ?rR args) [x, y] x"
- proof(rule_tac Maxr_lemma, simp)
- show "primerec ?rR (Suc (Suc (Suc 0)))"
- apply(auto)
- apply(case_tac i, auto)
- apply(case_tac [!] ia, auto)
- apply(case_tac i, auto)
- done
- qed
- hence g1: "rec_exec (rec_maxr ?rR) ([x, y, x]) =
- Maxr (\<lambda> args. if rec_exec ?rR args = 0 then False
- else True) [x, y] x"
- by simp
- have g2: "Maxr (\<lambda> args. if rec_exec ?rR args = 0 then False
- else True) [x, y] x = quo [x, y]"
- apply(simp add: rec_exec.simps)
- apply(simp add: Maxr.simps quo.simps, auto)
- done
- from g1 and g2 show
- "rec_exec (rec_maxr ?rR) ([x, y, x]) = quo [x, y]"
- by simp
-qed
-
-text {*
- The correctness of @{text "quo"}.
- *}
-lemma quo_lemma2: "rec_exec rec_quo [x, y] = x div y"
- using quo_lemma1[of x y] quo_div[of x y]
- by simp
-
-text {*
- @{text "rec_mod"} is the recursive function used to implement
- the reminder function.
- *}
-definition rec_mod :: "recf"
- where
- "rec_mod = Cn (Suc (Suc 0)) rec_minus [id (Suc (Suc 0)) (0),
- Cn (Suc (Suc 0)) rec_mult [rec_quo, id (Suc (Suc 0))
- (Suc (0))]]"
-
-text {*
- The correctness of @{text "rec_mod"}:
- *}
-lemma mod_lemma: "\<And> x y. rec_exec rec_mod [x, y] = (x mod y)"
-proof(simp add: rec_exec.simps rec_mod_def quo_lemma2)
- fix x y
- show "x - x div y * y = x mod (y::nat)"
- using mod_div_equality2[of y x]
- apply(subgoal_tac "y * (x div y) = (x div y ) * y", arith, simp)
- done
-qed
-
-text{* lemmas for embranch function*}
-type_synonym ftype = "nat list \<Rightarrow> nat"
-type_synonym rtype = "nat list \<Rightarrow> bool"
-
-text {*
- The specifation of the mutli-way branching statement on
- page 79 of Boolos's book.
- *}
-fun Embranch :: "(ftype * rtype) list \<Rightarrow> nat list \<Rightarrow> nat"
- where
- "Embranch [] xs = 0" |
- "Embranch (gc # gcs) xs = (
- let (g, c) = gc in
- if c xs then g xs else Embranch gcs xs)"
-
-fun rec_embranch' :: "(recf * recf) list \<Rightarrow> nat \<Rightarrow> recf"
- where
- "rec_embranch' [] vl = Cn vl z [id vl (vl - 1)]" |
- "rec_embranch' ((rg, rc) # rgcs) vl = Cn vl rec_add
- [Cn vl rec_mult [rg, rc], rec_embranch' rgcs vl]"
-
-text {*
- @{text "rec_embrach"} is the recursive function used to implement
- @{text "Embranch"}.
- *}
-fun rec_embranch :: "(recf * recf) list \<Rightarrow> recf"
- where
- "rec_embranch ((rg, rc) # rgcs) =
- (let vl = arity rg in
- rec_embranch' ((rg, rc) # rgcs) vl)"
-
-declare Embranch.simps[simp del] rec_embranch.simps[simp del]
-
-lemma embranch_all0:
- "\<lbrakk>\<forall> j < length rcs. rec_exec (rcs ! j) xs = 0;
- length rgs = length rcs;
- rcs \<noteq> [];
- list_all (\<lambda> rf. primerec rf (length xs)) (rgs @ rcs)\<rbrakk> \<Longrightarrow>
- rec_exec (rec_embranch (zip rgs rcs)) xs = 0"
-proof(induct rcs arbitrary: rgs, simp, case_tac rgs, simp)
- fix a rcs rgs aa list
- assume ind:
- "\<And>rgs. \<lbrakk>\<forall>j<length rcs. rec_exec (rcs ! j) xs = 0;
- length rgs = length rcs; rcs \<noteq> [];
- list_all (\<lambda>rf. primerec rf (length xs)) (rgs @ rcs)\<rbrakk> \<Longrightarrow>
- rec_exec (rec_embranch (zip rgs rcs)) xs = 0"
- and h: "\<forall>j<length (a # rcs). rec_exec ((a # rcs) ! j) xs = 0"
- "length rgs = length (a # rcs)"
- "a # rcs \<noteq> []"
- "list_all (\<lambda>rf. primerec rf (length xs)) (rgs @ a # rcs)"
- "rgs = aa # list"
- have g: "rcs \<noteq> [] \<Longrightarrow> rec_exec (rec_embranch (zip list rcs)) xs = 0"
- using h
- by(rule_tac ind, auto)
- show "rec_exec (rec_embranch (zip rgs (a # rcs))) xs = 0"
- proof(case_tac "rcs = []", simp)
- show "rec_exec (rec_embranch (zip rgs [a])) xs = 0"
- using h
- apply(simp add: rec_embranch.simps rec_exec.simps)
- apply(erule_tac x = 0 in allE, simp)
- done
- next
- assume "rcs \<noteq> []"
- hence "rec_exec (rec_embranch (zip list rcs)) xs = 0"
- using g by simp
- thus "rec_exec (rec_embranch (zip rgs (a # rcs))) xs = 0"
- using h
- apply(simp add: rec_embranch.simps rec_exec.simps)
- apply(case_tac rcs,
- auto simp: rec_exec.simps rec_embranch.simps)
- apply(case_tac list,
- auto simp: rec_exec.simps rec_embranch.simps)
- done
- qed
-qed
-
-
-lemma embranch_exec_0: "\<lbrakk>rec_exec aa xs = 0; zip rgs list \<noteq> [];
- list_all (\<lambda> rf. primerec rf (length xs)) ([a, aa] @ rgs @ list)\<rbrakk>
- \<Longrightarrow> rec_exec (rec_embranch ((a, aa) # zip rgs list)) xs
- = rec_exec (rec_embranch (zip rgs list)) xs"
-apply(simp add: rec_exec.simps rec_embranch.simps)
-apply(case_tac "zip rgs list", simp, case_tac ab,
- simp add: rec_embranch.simps rec_exec.simps)
-apply(subgoal_tac "arity a = length xs", auto)
-apply(subgoal_tac "arity aaa = length xs", auto)
-apply(case_tac rgs, simp, case_tac list, simp, simp)
-done
-
-lemma zip_null_iff: "\<lbrakk>length xs = k; length ys = k; zip xs ys = []\<rbrakk> \<Longrightarrow> xs = [] \<and> ys = []"
-apply(case_tac xs, simp, simp)
-apply(case_tac ys, simp, simp)
-done
-
-lemma zip_null_gr: "\<lbrakk>length xs = k; length ys = k; zip xs ys \<noteq> []\<rbrakk> \<Longrightarrow> 0 < k"
-apply(case_tac xs, simp, simp)
-done
-
-lemma Embranch_0:
- "\<lbrakk>length rgs = k; length rcs = k; k > 0;
- \<forall> j < k. rec_exec (rcs ! j) xs = 0\<rbrakk> \<Longrightarrow>
- Embranch (zip (map rec_exec rgs) (map (\<lambda>r args. 0 < rec_exec r args) rcs)) xs = 0"
-proof(induct rgs arbitrary: rcs k, simp, simp)
- fix a rgs rcs k
- assume ind:
- "\<And>rcs k. \<lbrakk>length rgs = k; length rcs = k; 0 < k; \<forall>j<k. rec_exec (rcs ! j) xs = 0\<rbrakk>
- \<Longrightarrow> Embranch (zip (map rec_exec rgs) (map (\<lambda>r args. 0 < rec_exec r args) rcs)) xs = 0"
- and h: "Suc (length rgs) = k" "length rcs = k"
- "\<forall>j<k. rec_exec (rcs ! j) xs = 0"
- from h show
- "Embranch (zip (rec_exec a # map rec_exec rgs)
- (map (\<lambda>r args. 0 < rec_exec r args) rcs)) xs = 0"
- apply(case_tac rcs, simp, case_tac "rgs = []", simp)
- apply(simp add: Embranch.simps)
- apply(erule_tac x = 0 in allE, simp)
- apply(simp add: Embranch.simps)
- apply(erule_tac x = 0 in all_dupE, simp)
- apply(rule_tac ind, simp, simp, simp, auto)
- apply(erule_tac x = "Suc j" in allE, simp)
- done
-qed
-
-text {*
- The correctness of @{text "rec_embranch"}.
- *}
-lemma embranch_lemma:
- assumes branch_num:
- "length rgs = n" "length rcs = n" "n > 0"
- and partition:
- "(\<exists> i < n. (rec_exec (rcs ! i) xs = 1 \<and> (\<forall> j < n. j \<noteq> i \<longrightarrow>
- rec_exec (rcs ! j) xs = 0)))"
- and prime_all: "list_all (\<lambda> rf. primerec rf (length xs)) (rgs @ rcs)"
- shows "rec_exec (rec_embranch (zip rgs rcs)) xs =
- Embranch (zip (map rec_exec rgs)
- (map (\<lambda> r args. 0 < rec_exec r args) rcs)) xs"
- using branch_num partition prime_all
-proof(induct rgs arbitrary: rcs n, simp)
- fix a rgs rcs n
- assume ind:
- "\<And>rcs n. \<lbrakk>length rgs = n; length rcs = n; 0 < n;
- \<exists>i<n. rec_exec (rcs ! i) xs = 1 \<and> (\<forall>j<n. j \<noteq> i \<longrightarrow> rec_exec (rcs ! j) xs = 0);
- list_all (\<lambda>rf. primerec rf (length xs)) (rgs @ rcs)\<rbrakk>
- \<Longrightarrow> rec_exec (rec_embranch (zip rgs rcs)) xs =
- Embranch (zip (map rec_exec rgs) (map (\<lambda>r args. 0 < rec_exec r args) rcs)) xs"
- and h: "length (a # rgs) = n" "length (rcs::recf list) = n" "0 < n"
- " \<exists>i<n. rec_exec (rcs ! i) xs = 1 \<and>
- (\<forall>j<n. j \<noteq> i \<longrightarrow> rec_exec (rcs ! j) xs = 0)"
- "list_all (\<lambda>rf. primerec rf (length xs)) ((a # rgs) @ rcs)"
- from h show "rec_exec (rec_embranch (zip (a # rgs) rcs)) xs =
- Embranch (zip (map rec_exec (a # rgs)) (map (\<lambda>r args.
- 0 < rec_exec r args) rcs)) xs"
- apply(case_tac rcs, simp, simp)
- apply(case_tac "rec_exec aa xs = 0")
- apply(case_tac [!] "zip rgs list = []", simp)
- apply(subgoal_tac "rgs = [] \<and> list = []", simp add: Embranch.simps rec_exec.simps rec_embranch.simps)
- apply(rule_tac zip_null_iff, simp, simp, simp)
- proof -
- fix aa list
- assume g:
- "Suc (length rgs) = n" "Suc (length list) = n"
- "\<exists>i<n. rec_exec ((aa # list) ! i) xs = Suc 0 \<and>
- (\<forall>j<n. j \<noteq> i \<longrightarrow> rec_exec ((aa # list) ! j) xs = 0)"
- "primerec a (length xs) \<and>
- list_all (\<lambda>rf. primerec rf (length xs)) rgs \<and>
- primerec aa (length xs) \<and>
- list_all (\<lambda>rf. primerec rf (length xs)) list"
- "rec_exec aa xs = 0" "rcs = aa # list" "zip rgs list \<noteq> []"
- have "rec_exec (rec_embranch ((a, aa) # zip rgs list)) xs
- = rec_exec (rec_embranch (zip rgs list)) xs"
- apply(rule embranch_exec_0, simp_all add: g)
- done
- from g and this show "rec_exec (rec_embranch ((a, aa) # zip rgs list)) xs =
- Embranch ((rec_exec a, \<lambda>args. 0 < rec_exec aa args) #
- zip (map rec_exec rgs) (map (\<lambda>r args. 0 < rec_exec r args) list)) xs"
- apply(simp add: Embranch.simps)
- apply(rule_tac n = "n - Suc 0" in ind)
- apply(case_tac n, simp, simp)
- apply(case_tac n, simp, simp)
- apply(case_tac n, simp, simp add: zip_null_gr )
- apply(auto)
- apply(case_tac i, simp, simp)
- apply(rule_tac x = nat in exI, simp)
- apply(rule_tac allI, erule_tac x = "Suc j" in allE, simp)
- done
- next
- fix aa list
- assume g: "Suc (length rgs) = n" "Suc (length list) = n"
- "\<exists>i<n. rec_exec ((aa # list) ! i) xs = Suc 0 \<and>
- (\<forall>j<n. j \<noteq> i \<longrightarrow> rec_exec ((aa # list) ! j) xs = 0)"
- "primerec a (length xs) \<and> list_all (\<lambda>rf. primerec rf (length xs)) rgs \<and>
- primerec aa (length xs) \<and> list_all (\<lambda>rf. primerec rf (length xs)) list"
- "rcs = aa # list" "rec_exec aa xs \<noteq> 0" "zip rgs list = []"
- thus "rec_exec (rec_embranch ((a, aa) # zip rgs list)) xs =
- Embranch ((rec_exec a, \<lambda>args. 0 < rec_exec aa args) #
- zip (map rec_exec rgs) (map (\<lambda>r args. 0 < rec_exec r args) list)) xs"
- apply(subgoal_tac "rgs = [] \<and> list = []", simp)
- prefer 2
- apply(rule_tac zip_null_iff, simp, simp, simp)
- apply(simp add: rec_exec.simps rec_embranch.simps Embranch.simps, auto)
- done
- next
- fix aa list
- assume g: "Suc (length rgs) = n" "Suc (length list) = n"
- "\<exists>i<n. rec_exec ((aa # list) ! i) xs = Suc 0 \<and>
- (\<forall>j<n. j \<noteq> i \<longrightarrow> rec_exec ((aa # list) ! j) xs = 0)"
- "primerec a (length xs) \<and> list_all (\<lambda>rf. primerec rf (length xs)) rgs
- \<and> primerec aa (length xs) \<and> list_all (\<lambda>rf. primerec rf (length xs)) list"
- "rcs = aa # list" "rec_exec aa xs \<noteq> 0" "zip rgs list \<noteq> []"
- have "rec_exec aa xs = Suc 0"
- using g
- apply(case_tac "rec_exec aa xs", simp, auto)
- done
- moreover have "rec_exec (rec_embranch' (zip rgs list) (length xs)) xs = 0"
- proof -
- have "rec_embranch' (zip rgs list) (length xs) = rec_embranch (zip rgs list)"
- using g
- apply(case_tac "zip rgs list", simp, case_tac ab)
- apply(simp add: rec_embranch.simps)
- apply(subgoal_tac "arity aaa = length xs", simp, auto)
- apply(case_tac rgs, simp, simp, case_tac list, simp, simp)
- done
- moreover have "rec_exec (rec_embranch (zip rgs list)) xs = 0"
- proof(rule embranch_all0)
- show " \<forall>j<length list. rec_exec (list ! j) xs = 0"
- using g
- apply(auto)
- apply(case_tac i, simp)
- apply(erule_tac x = "Suc j" in allE, simp)
- apply(simp)
- apply(erule_tac x = 0 in allE, simp)
- done
- next
- show "length rgs = length list"
- using g
- apply(case_tac n, simp, simp)
- done
- next
- show "list \<noteq> []"
- using g
- apply(case_tac list, simp, simp)
- done
- next
- show "list_all (\<lambda>rf. primerec rf (length xs)) (rgs @ list)"
- using g
- apply auto
- done
- qed
- ultimately show "rec_exec (rec_embranch' (zip rgs list) (length xs)) xs = 0"
- by simp
- qed
- moreover have
- "Embranch (zip (map rec_exec rgs)
- (map (\<lambda>r args. 0 < rec_exec r args) list)) xs = 0"
- using g
- apply(rule_tac k = "length rgs" in Embranch_0)
- apply(simp, case_tac n, simp, simp)
- apply(case_tac rgs, simp, simp)
- apply(auto)
- apply(case_tac i, simp)
- apply(erule_tac x = "Suc j" in allE, simp)
- apply(simp)
- apply(rule_tac x = 0 in allE, auto)
- done
- moreover have "arity a = length xs"
- using g
- apply(auto)
- done
- ultimately show "rec_exec (rec_embranch ((a, aa) # zip rgs list)) xs =
- Embranch ((rec_exec a, \<lambda>args. 0 < rec_exec aa args) #
- zip (map rec_exec rgs) (map (\<lambda>r args. 0 < rec_exec r args) list)) xs"
- apply(simp add: rec_exec.simps rec_embranch.simps Embranch.simps)
- done
- qed
-qed
-
-text{*
- @{text "prime n"} means @{text "n"} is a prime number.
-*}
-fun Prime :: "nat \<Rightarrow> bool"
- where
- "Prime x = (1 < x \<and> (\<forall> u < x. (\<forall> v < x. u * v \<noteq> x)))"
-
-declare Prime.simps [simp del]
-
-lemma primerec_all1:
- "primerec (rec_all rt rf) n \<Longrightarrow> primerec rt n"
- by (simp add: primerec_all)
-
-lemma primerec_all2: "primerec (rec_all rt rf) n \<Longrightarrow>
- primerec rf (Suc n)"
-by(insert primerec_all[of rt rf n], simp)
-
-text {*
- @{text "rec_prime"} is the recursive function used to implement
- @{text "Prime"}.
- *}
-definition rec_prime :: "recf"
- where
- "rec_prime = Cn (Suc 0) rec_conj
- [Cn (Suc 0) rec_less [constn 1, id (Suc 0) (0)],
- rec_all (Cn 1 rec_minus [id 1 0, constn 1])
- (rec_all (Cn 2 rec_minus [id 2 0, Cn 2 (constn 1)
- [id 2 0]]) (Cn 3 rec_noteq
- [Cn 3 rec_mult [id 3 1, id 3 2], id 3 0]))]"
-
-declare numeral_2_eq_2[simp del] numeral_3_eq_3[simp del]
-
-lemma exec_tmp:
- "rec_exec (rec_all (Cn 2 rec_minus [recf.id 2 0, Cn 2 (constn (Suc 0)) [recf.id 2 0]])
- (Cn 3 rec_noteq [Cn 3 rec_mult [recf.id 3 (Suc 0), recf.id 3 2], recf.id 3 0])) [x, k] =
- ((if (\<forall>w\<le>rec_exec (Cn 2 rec_minus [recf.id 2 0, Cn 2 (constn (Suc 0)) [recf.id 2 0]]) ([x, k]).
- 0 < rec_exec (Cn 3 rec_noteq [Cn 3 rec_mult [recf.id 3 (Suc 0), recf.id 3 2], recf.id 3 0])
- ([x, k] @ [w])) then 1 else 0))"
-apply(rule_tac all_lemma)
-apply(auto)
-apply(case_tac [!] i, auto)
-apply(case_tac ia, auto simp: numeral_3_eq_3 numeral_2_eq_2)
-done
-
-text {*
- The correctness of @{text "Prime"}.
- *}
-lemma prime_lemma: "rec_exec rec_prime [x] = (if Prime x then 1 else 0)"
-proof(simp add: rec_exec.simps rec_prime_def)
- let ?rt1 = "(Cn 2 rec_minus [recf.id 2 0,
- Cn 2 (constn (Suc 0)) [recf.id 2 0]])"
- let ?rf1 = "(Cn 3 rec_noteq [Cn 3 rec_mult
- [recf.id 3 (Suc 0), recf.id 3 2], recf.id 3 (0)])"
- let ?rt2 = "(Cn (Suc 0) rec_minus
- [recf.id (Suc 0) 0, constn (Suc 0)])"
- let ?rf2 = "rec_all ?rt1 ?rf1"
- have h1: "rec_exec (rec_all ?rt2 ?rf2) ([x]) =
- (if (\<forall>k\<le>rec_exec ?rt2 ([x]). 0 < rec_exec ?rf2 ([x] @ [k])) then 1 else 0)"
- proof(rule_tac all_lemma, simp_all)
- show "primerec ?rf2 (Suc (Suc 0))"
- apply(rule_tac primerec_all_iff)
- apply(auto)
- apply(case_tac [!] i, auto simp: numeral_2_eq_2)
- apply(case_tac ia, auto simp: numeral_3_eq_3)
- done
- next
- show "primerec (Cn (Suc 0) rec_minus
- [recf.id (Suc 0) 0, constn (Suc 0)]) (Suc 0)"
- apply(auto)
- apply(case_tac i, auto)
- done
- qed
- from h1 show
- "(Suc 0 < x \<longrightarrow> (rec_exec (rec_all ?rt2 ?rf2) [x] = 0 \<longrightarrow>
- \<not> Prime x) \<and>
- (0 < rec_exec (rec_all ?rt2 ?rf2) [x] \<longrightarrow> Prime x)) \<and>
- (\<not> Suc 0 < x \<longrightarrow> \<not> Prime x \<and> (rec_exec (rec_all ?rt2 ?rf2) [x] = 0
- \<longrightarrow> \<not> Prime x))"
- apply(auto simp:rec_exec.simps)
- apply(simp add: exec_tmp rec_exec.simps)
- proof -
- assume "\<forall>k\<le>x - Suc 0. (0::nat) < (if \<forall>w\<le>x - Suc 0.
- 0 < (if k * w \<noteq> x then 1 else (0 :: nat)) then 1 else 0)" "Suc 0 < x"
- thus "Prime x"
- apply(simp add: rec_exec.simps split: if_splits)
- apply(simp add: Prime.simps, auto)
- apply(erule_tac x = u in allE, auto)
- apply(case_tac u, simp, case_tac nat, simp, simp)
- apply(case_tac v, simp, case_tac nat, simp, simp)
- done
- next
- assume "\<not> Suc 0 < x" "Prime x"
- thus "False"
- apply(simp add: Prime.simps)
- done
- next
- fix k
- assume "rec_exec (rec_all ?rt1 ?rf1)
- [x, k] = 0" "k \<le> x - Suc 0" "Prime x"
- thus "False"
- apply(simp add: exec_tmp rec_exec.simps Prime.simps split: if_splits)
- done
- next
- fix k
- assume "rec_exec (rec_all ?rt1 ?rf1)
- [x, k] = 0" "k \<le> x - Suc 0" "Prime x"
- thus "False"
- apply(simp add: exec_tmp rec_exec.simps Prime.simps split: if_splits)
- done
- qed
-qed
-
-definition rec_dummyfac :: "recf"
- where
- "rec_dummyfac = Pr 1 (constn 1)
- (Cn 3 rec_mult [id 3 2, Cn 3 s [id 3 1]])"
-
-text {*
- The recursive function used to implment factorization.
- *}
-definition rec_fac :: "recf"
- where
- "rec_fac = Cn 1 rec_dummyfac [id 1 0, id 1 0]"
-
-text {*
- Formal specification of factorization.
- *}
-fun fac :: "nat \<Rightarrow> nat" ("_!" [100] 99)
- where
- "fac 0 = 1" |
- "fac (Suc x) = (Suc x) * fac x"
-
-lemma [simp]: "rec_exec rec_dummyfac [0, 0] = Suc 0"
-by(simp add: rec_dummyfac_def rec_exec.simps)
-
-lemma rec_cn_simp: "rec_exec (Cn n f gs) xs =
- (let rgs = map (\<lambda> g. rec_exec g xs) gs in
- rec_exec f rgs)"
-by(simp add: rec_exec.simps)
-
-lemma rec_id_simp: "rec_exec (id m n) xs = xs ! n"
- by(simp add: rec_exec.simps)
-
-lemma fac_dummy: "rec_exec rec_dummyfac [x, y] = y !"
-apply(induct y)
-apply(auto simp: rec_dummyfac_def rec_exec.simps)
-done
-
-text {*
- The correctness of @{text "rec_fac"}.
- *}
-lemma fac_lemma: "rec_exec rec_fac [x] = x!"
-apply(simp add: rec_fac_def rec_exec.simps fac_dummy)
-done
-
-declare fac.simps[simp del]
-
-text {*
- @{text "Np x"} returns the first prime number after @{text "x"}.
- *}
-fun Np ::"nat \<Rightarrow> nat"
- where
- "Np x = Min {y. y \<le> Suc (x!) \<and> x < y \<and> Prime y}"
-
-declare Np.simps[simp del] rec_Minr.simps[simp del]
-
-text {*
- @{text "rec_np"} is the recursive function used to implement
- @{text "Np"}.
- *}
-definition rec_np :: "recf"
- where
- "rec_np = (let Rr = Cn 2 rec_conj [Cn 2 rec_less [id 2 0, id 2 1],
- Cn 2 rec_prime [id 2 1]]
- in Cn 1 (rec_Minr Rr) [id 1 0, Cn 1 s [rec_fac]])"
-
-lemma [simp]: "n < Suc (n!)"
-apply(induct n, simp)
-apply(simp add: fac.simps)
-apply(case_tac n, auto simp: fac.simps)
-done
-
-lemma divsor_ex:
-"\<lbrakk>\<not> Prime x; x > Suc 0\<rbrakk> \<Longrightarrow> (\<exists> u > Suc 0. (\<exists> v > Suc 0. u * v = x))"
- by(auto simp: Prime.simps)
-
-lemma divsor_prime_ex: "\<lbrakk>\<not> Prime x; x > Suc 0\<rbrakk> \<Longrightarrow>
- \<exists> p. Prime p \<and> p dvd x"
-apply(induct x rule: wf_induct[where r = "measure (\<lambda> y. y)"], simp)
-apply(drule_tac divsor_ex, simp, auto)
-apply(erule_tac x = u in allE, simp)
-apply(case_tac "Prime u", simp)
-apply(rule_tac x = u in exI, simp, auto)
-done
-
-lemma [intro]: "0 < n!"
-apply(induct n)
-apply(auto simp: fac.simps)
-done
-
-lemma fac_Suc: "Suc n! = (Suc n) * (n!)" by(simp add: fac.simps)
-
-lemma fac_dvd: "\<lbrakk>0 < q; q \<le> n\<rbrakk> \<Longrightarrow> q dvd n!"
-apply(induct n, simp)
-apply(case_tac "q \<le> n", simp add: fac_Suc)
-apply(subgoal_tac "q = Suc n", simp only: fac_Suc)
-apply(rule_tac dvd_mult2, simp, simp)
-done
-
-lemma fac_dvd2: "\<lbrakk>Suc 0 < q; q dvd n!; q \<le> n\<rbrakk> \<Longrightarrow> \<not> q dvd Suc (n!)"
-proof(auto simp: dvd_def)
- fix k ka
- assume h1: "Suc 0 < q" "q \<le> n"
- and h2: "Suc (q * k) = q * ka"
- have "k < ka"
- proof -
- have "q * k < q * ka"
- using h2 by arith
- thus "k < ka"
- using h1
- by(auto)
- qed
- hence "\<exists>d. d > 0 \<and> ka = d + k"
- by(rule_tac x = "ka - k" in exI, simp)
- from this obtain d where "d > 0 \<and> ka = d + k" ..
- from h2 and this and h1 show "False"
- by(simp add: add_mult_distrib2)
-qed
-
-lemma prime_ex: "\<exists> p. n < p \<and> p \<le> Suc (n!) \<and> Prime p"
-proof(cases "Prime (n! + 1)")
- case True thus "?thesis"
- by(rule_tac x = "Suc (n!)" in exI, simp)
-next
- assume h: "\<not> Prime (n! + 1)"
- hence "\<exists> p. Prime p \<and> p dvd (n! + 1)"
- by(erule_tac divsor_prime_ex, auto)
- from this obtain q where k: "Prime q \<and> q dvd (n! + 1)" ..
- thus "?thesis"
- proof(cases "q > n")
- case True thus "?thesis"
- using k
- apply(rule_tac x = q in exI, auto)
- apply(rule_tac dvd_imp_le, auto)
- done
- next
- case False thus "?thesis"
- proof -
- assume g: "\<not> n < q"
- have j: "q > Suc 0"
- using k by(case_tac q, auto simp: Prime.simps)
- hence "q dvd n!"
- using g
- apply(rule_tac fac_dvd, auto)
- done
- hence "\<not> q dvd Suc (n!)"
- using g j
- by(rule_tac fac_dvd2, auto)
- thus "?thesis"
- using k by simp
- qed
- qed
-qed
-
-lemma Suc_Suc_induct[elim!]: "\<lbrakk>i < Suc (Suc 0);
- primerec (ys ! 0) n; primerec (ys ! 1) n\<rbrakk> \<Longrightarrow> primerec (ys ! i) n"
-by(case_tac i, auto)
-
-lemma [intro]: "primerec rec_prime (Suc 0)"
-apply(auto simp: rec_prime_def, auto)
-apply(rule_tac primerec_all_iff, auto, auto)
-apply(rule_tac primerec_all_iff, auto, auto simp:
- numeral_2_eq_2 numeral_3_eq_3)
-done
-
-text {*
- The correctness of @{text "rec_np"}.
- *}
-lemma np_lemma: "rec_exec rec_np [x] = Np x"
-proof(auto simp: rec_np_def rec_exec.simps Let_def fac_lemma)
- let ?rr = "(Cn 2 rec_conj [Cn 2 rec_less [recf.id 2 0,
- recf.id 2 (Suc 0)], Cn 2 rec_prime [recf.id 2 (Suc 0)]])"
- let ?R = "\<lambda> zs. zs ! 0 < zs ! 1 \<and> Prime (zs ! 1)"
- have g1: "rec_exec (rec_Minr ?rr) ([x] @ [Suc (x!)]) =
- Minr (\<lambda> args. 0 < rec_exec ?rr args) [x] (Suc (x!))"
- by(rule_tac Minr_lemma, auto simp: rec_exec.simps
- prime_lemma, auto simp: numeral_2_eq_2 numeral_3_eq_3)
- have g2: "Minr (\<lambda> args. 0 < rec_exec ?rr args) [x] (Suc (x!)) = Np x"
- using prime_ex[of x]
- apply(auto simp: Minr.simps Np.simps rec_exec.simps)
- apply(erule_tac x = p in allE, simp add: prime_lemma)
- apply(simp add: prime_lemma split: if_splits)
- apply(subgoal_tac
- "{uu. (Prime uu \<longrightarrow> (x < uu \<longrightarrow> uu \<le> Suc (x!)) \<and> x < uu) \<and> Prime uu}
- = {y. y \<le> Suc (x!) \<and> x < y \<and> Prime y}", auto)
- done
- from g1 and g2 show "rec_exec (rec_Minr ?rr) ([x, Suc (x!)]) = Np x"
- by simp
-qed
-
-text {*
- @{text "rec_power"} is the recursive function used to implement
- power function.
- *}
-definition rec_power :: "recf"
- where
- "rec_power = Pr 1 (constn 1) (Cn 3 rec_mult [id 3 0, id 3 2])"
-
-text {*
- The correctness of @{text "rec_power"}.
- *}
-lemma power_lemma: "rec_exec rec_power [x, y] = x^y"
- by(induct y, auto simp: rec_exec.simps rec_power_def)
-
-text{*
- @{text "Pi k"} returns the @{text "k"}-th prime number.
- *}
-fun Pi :: "nat \<Rightarrow> nat"
- where
- "Pi 0 = 2" |
- "Pi (Suc x) = Np (Pi x)"
-
-definition rec_dummy_pi :: "recf"
- where
- "rec_dummy_pi = Pr 1 (constn 2) (Cn 3 rec_np [id 3 2])"
-
-text {*
- @{text "rec_pi"} is the recursive function used to implement
- @{text "Pi"}.
- *}
-definition rec_pi :: "recf"
- where
- "rec_pi = Cn 1 rec_dummy_pi [id 1 0, id 1 0]"
-
-lemma pi_dummy_lemma: "rec_exec rec_dummy_pi [x, y] = Pi y"
-apply(induct y)
-by(auto simp: rec_exec.simps rec_dummy_pi_def Pi.simps np_lemma)
-
-text {*
- The correctness of @{text "rec_pi"}.
- *}
-lemma pi_lemma: "rec_exec rec_pi [x] = Pi x"
-apply(simp add: rec_pi_def rec_exec.simps pi_dummy_lemma)
-done
-
-fun loR :: "nat list \<Rightarrow> bool"
- where
- "loR [x, y, u] = (x mod (y^u) = 0)"
-
-declare loR.simps[simp del]
-
-text {*
- @{text "Lo"} specifies the @{text "lo"} function given on page 79 of
- Boolos's book. It is one of the two notions of integeral logarithmatic
- operation on that page. The other is @{text "lg"}.
- *}
-fun lo :: " nat \<Rightarrow> nat \<Rightarrow> nat"
- where
- "lo x y = (if x > 1 \<and> y > 1 \<and> {u. loR [x, y, u]} \<noteq> {} then Max {u. loR [x, y, u]}
- else 0)"
-
-declare lo.simps[simp del]
-
-lemma [elim]: "primerec rf n \<Longrightarrow> n > 0"
-apply(induct rule: primerec.induct, auto)
-done
-
-lemma primerec_sigma[intro!]:
- "\<lbrakk>n > Suc 0; primerec rf n\<rbrakk> \<Longrightarrow>
- primerec (rec_sigma rf) n"
-apply(simp add: rec_sigma.simps)
-apply(auto, auto simp: nth_append)
-done
-
-lemma [intro!]: "\<lbrakk>primerec rf n; n > 0\<rbrakk> \<Longrightarrow> primerec (rec_maxr rf) n"
-apply(simp add: rec_maxr.simps)
-apply(rule_tac prime_cn, auto)
-apply(rule_tac primerec_all_iff, auto, auto simp: nth_append)
-done
-
-lemma Suc_Suc_Suc_induct[elim!]:
- "\<lbrakk>i < Suc (Suc (Suc (0::nat))); primerec (ys ! 0) n;
- primerec (ys ! 1) n;
- primerec (ys ! 2) n\<rbrakk> \<Longrightarrow> primerec (ys ! i) n"
-apply(case_tac i, auto, case_tac nat, simp, simp add: numeral_2_eq_2)
-done
-
-lemma [intro]: "primerec rec_quo (Suc (Suc 0))"
-apply(simp add: rec_quo_def)
-apply(tactic {* resolve_tac [@{thm prime_cn},
- @{thm prime_id}] 1*}, auto+)+
-done
-
-lemma [intro]: "primerec rec_mod (Suc (Suc 0))"
-apply(simp add: rec_mod_def)
-apply(tactic {* resolve_tac [@{thm prime_cn},
- @{thm prime_id}] 1*}, auto+)+
-done
-
-lemma [intro]: "primerec rec_power (Suc (Suc 0))"
-apply(simp add: rec_power_def numeral_2_eq_2 numeral_3_eq_3)
-apply(tactic {* resolve_tac [@{thm prime_cn},
- @{thm prime_id}, @{thm prime_pr}] 1*}, auto+)+
-done
-
-text {*
- @{text "rec_lo"} is the recursive function used to implement @{text "Lo"}.
-*}
-definition rec_lo :: "recf"
- where
- "rec_lo = (let rR = Cn 3 rec_eq [Cn 3 rec_mod [id 3 0,
- Cn 3 rec_power [id 3 1, id 3 2]],
- Cn 3 (constn 0) [id 3 1]] in
- let rb = Cn 2 (rec_maxr rR) [id 2 0, id 2 1, id 2 0] in
- let rcond = Cn 2 rec_conj [Cn 2 rec_less [Cn 2 (constn 1)
- [id 2 0], id 2 0],
- Cn 2 rec_less [Cn 2 (constn 1)
- [id 2 0], id 2 1]] in
- let rcond2 = Cn 2 rec_minus
- [Cn 2 (constn 1) [id 2 0], rcond]
- in Cn 2 rec_add [Cn 2 rec_mult [rb, rcond],
- Cn 2 rec_mult [Cn 2 (constn 0) [id 2 0], rcond2]])"
-
-lemma rec_lo_Maxr_lor:
- "\<lbrakk>Suc 0 < x; Suc 0 < y\<rbrakk> \<Longrightarrow>
- rec_exec rec_lo [x, y] = Maxr loR [x, y] x"
-proof(auto simp: rec_exec.simps rec_lo_def Let_def
- numeral_2_eq_2 numeral_3_eq_3)
- let ?rR = "(Cn (Suc (Suc (Suc 0))) rec_eq
- [Cn (Suc (Suc (Suc 0))) rec_mod [recf.id (Suc (Suc (Suc 0))) 0,
- Cn (Suc (Suc (Suc 0))) rec_power [recf.id (Suc (Suc (Suc 0)))
- (Suc 0), recf.id (Suc (Suc (Suc 0))) (Suc (Suc 0))]],
- Cn (Suc (Suc (Suc 0))) (constn 0) [recf.id (Suc (Suc (Suc 0))) (Suc 0)]])"
- have h: "rec_exec (rec_maxr ?rR) ([x, y] @ [x]) =
- Maxr (\<lambda> args. 0 < rec_exec ?rR args) [x, y] x"
- by(rule_tac Maxr_lemma, auto simp: rec_exec.simps
- mod_lemma power_lemma, auto simp: numeral_2_eq_2 numeral_3_eq_3)
- have "Maxr loR [x, y] x = Maxr (\<lambda> args. 0 < rec_exec ?rR args) [x, y] x"
- apply(simp add: rec_exec.simps mod_lemma power_lemma)
- apply(simp add: Maxr.simps loR.simps)
- done
- from h and this show "rec_exec (rec_maxr ?rR) [x, y, x] =
- Maxr loR [x, y] x"
- apply(simp)
- done
-qed
-
-lemma [simp]: "Max {ya. ya = 0 \<and> loR [0, y, ya]} = 0"
-apply(rule_tac Max_eqI, auto simp: loR.simps)
-done
-
-lemma [simp]: "Suc 0 < y \<Longrightarrow> Suc (Suc 0) < y * y"
-apply(induct y, simp)
-apply(case_tac y, simp, simp)
-done
-
-lemma less_mult: "\<lbrakk>x > 0; y > Suc 0\<rbrakk> \<Longrightarrow> x < y * x"
-apply(case_tac y, simp, simp)
-done
-
-lemma x_less_exp: "\<lbrakk>y > Suc 0\<rbrakk> \<Longrightarrow> x < y^x"
-apply(induct x, simp, simp)
-apply(case_tac x, simp, auto)
-apply(rule_tac y = "y* y^nat" in le_less_trans, simp)
-apply(rule_tac less_mult, auto)
-done
-
-lemma le_mult: "y \<noteq> (0::nat) \<Longrightarrow> x \<le> x * y"
- by(induct y, simp, simp)
-
-lemma uplimit_loR: "\<lbrakk>Suc 0 < x; Suc 0 < y; loR [x, y, xa]\<rbrakk> \<Longrightarrow>
- xa \<le> x"
-apply(simp add: loR.simps)
-apply(rule_tac classical, auto)
-apply(subgoal_tac "xa < y^xa")
-apply(subgoal_tac "y^xa \<le> y^xa * q", simp)
-apply(rule_tac le_mult, case_tac q, simp, simp)
-apply(rule_tac x_less_exp, simp)
-done
-
-lemma [simp]: "\<lbrakk>xa \<le> x; loR [x, y, xa]; Suc 0 < x; Suc 0 < y\<rbrakk> \<Longrightarrow>
- {u. loR [x, y, u]} = {ya. ya \<le> x \<and> loR [x, y, ya]}"
-apply(rule_tac Collect_cong, auto)
-apply(erule_tac uplimit_loR, simp, simp)
-done
-
-lemma Maxr_lo: "\<lbrakk>Suc 0 < x; Suc 0 < y\<rbrakk> \<Longrightarrow>
- Maxr loR [x, y] x = lo x y"
-apply(simp add: Maxr.simps lo.simps, auto)
-apply(erule_tac x = xa in allE, simp, simp add: uplimit_loR)
-done
-
-lemma lo_lemma': "\<lbrakk>Suc 0 < x; Suc 0 < y\<rbrakk> \<Longrightarrow>
- rec_exec rec_lo [x, y] = lo x y"
-by(simp add: Maxr_lo rec_lo_Maxr_lor)
-
-lemma lo_lemma'': "\<lbrakk>\<not> Suc 0 < x\<rbrakk> \<Longrightarrow> rec_exec rec_lo [x, y] = lo x y"
-apply(case_tac x, auto simp: rec_exec.simps rec_lo_def
- Let_def lo.simps)
-done
-
-lemma lo_lemma''': "\<lbrakk>\<not> Suc 0 < y\<rbrakk> \<Longrightarrow> rec_exec rec_lo [x, y] = lo x y"
-apply(case_tac y, auto simp: rec_exec.simps rec_lo_def
- Let_def lo.simps)
-done
-
-text {*
- The correctness of @{text "rec_lo"}:
-*}
-lemma lo_lemma: "rec_exec rec_lo [x, y] = lo x y"
-apply(case_tac "Suc 0 < x \<and> Suc 0 < y")
-apply(auto simp: lo_lemma' lo_lemma'' lo_lemma''')
-done
-
-fun lgR :: "nat list \<Rightarrow> bool"
- where
- "lgR [x, y, u] = (y^u \<le> x)"
-
-text {*
- @{text "lg"} specifies the @{text "lg"} function given on page 79 of
- Boolos's book. It is one of the two notions of integeral logarithmatic
- operation on that page. The other is @{text "lo"}.
- *}
-fun lg :: "nat \<Rightarrow> nat \<Rightarrow> nat"
- where
- "lg x y = (if x > 1 \<and> y > 1 \<and> {u. lgR [x, y, u]} \<noteq> {} then
- Max {u. lgR [x, y, u]}
- else 0)"
-
-declare lg.simps[simp del] lgR.simps[simp del]
-
-text {*
- @{text "rec_lg"} is the recursive function used to implement @{text "lg"}.
- *}
-definition rec_lg :: "recf"
- where
- "rec_lg = (let rec_lgR = Cn 3 rec_le
- [Cn 3 rec_power [id 3 1, id 3 2], id 3 0] in
- let conR1 = Cn 2 rec_conj [Cn 2 rec_less
- [Cn 2 (constn 1) [id 2 0], id 2 0],
- Cn 2 rec_less [Cn 2 (constn 1)
- [id 2 0], id 2 1]] in
- let conR2 = Cn 2 rec_not [conR1] in
- Cn 2 rec_add [Cn 2 rec_mult
- [conR1, Cn 2 (rec_maxr rec_lgR)
- [id 2 0, id 2 1, id 2 0]],
- Cn 2 rec_mult [conR2, Cn 2 (constn 0)
- [id 2 0]]])"
-
-lemma lg_maxr: "\<lbrakk>Suc 0 < x; Suc 0 < y\<rbrakk> \<Longrightarrow>
- rec_exec rec_lg [x, y] = Maxr lgR [x, y] x"
-proof(simp add: rec_exec.simps rec_lg_def Let_def)
- assume h: "Suc 0 < x" "Suc 0 < y"
- let ?rR = "(Cn 3 rec_le [Cn 3 rec_power
- [recf.id 3 (Suc 0), recf.id 3 2], recf.id 3 0])"
- have "rec_exec (rec_maxr ?rR) ([x, y] @ [x])
- = Maxr ((\<lambda> args. 0 < rec_exec ?rR args)) [x, y] x"
- proof(rule Maxr_lemma)
- show "primerec (Cn 3 rec_le [Cn 3 rec_power
- [recf.id 3 (Suc 0), recf.id 3 2], recf.id 3 0]) (Suc (length [x, y]))"
- apply(auto simp: numeral_3_eq_3)+
- done
- qed
- moreover have "Maxr lgR [x, y] x = Maxr ((\<lambda> args. 0 < rec_exec ?rR args)) [x, y] x"
- apply(simp add: rec_exec.simps power_lemma)
- apply(simp add: Maxr.simps lgR.simps)
- done
- ultimately show "rec_exec (rec_maxr ?rR) [x, y, x] = Maxr lgR [x, y] x"
- by simp
-qed
-
-lemma [simp]: "\<lbrakk>Suc 0 < y; lgR [x, y, xa]\<rbrakk> \<Longrightarrow> xa \<le> x"
-apply(simp add: lgR.simps)
-apply(subgoal_tac "y^xa > xa", simp)
-apply(erule x_less_exp)
-done
-
-lemma [simp]: "\<lbrakk>Suc 0 < x; Suc 0 < y; lgR [x, y, xa]\<rbrakk> \<Longrightarrow>
- {u. lgR [x, y, u]} = {ya. ya \<le> x \<and> lgR [x, y, ya]}"
-apply(rule_tac Collect_cong, auto)
-done
-
-lemma maxr_lg: "\<lbrakk>Suc 0 < x; Suc 0 < y\<rbrakk> \<Longrightarrow> Maxr lgR [x, y] x = lg x y"
-apply(simp add: lg.simps Maxr.simps, auto)
-apply(erule_tac x = xa in allE, simp)
-done
-
-lemma lg_lemma': "\<lbrakk>Suc 0 < x; Suc 0 < y\<rbrakk> \<Longrightarrow> rec_exec rec_lg [x, y] = lg x y"
-apply(simp add: maxr_lg lg_maxr)
-done
-
-lemma lg_lemma'': "\<not> Suc 0 < x \<Longrightarrow> rec_exec rec_lg [x, y] = lg x y"
-apply(simp add: rec_exec.simps rec_lg_def Let_def lg.simps)
-done
-
-lemma lg_lemma''': "\<not> Suc 0 < y \<Longrightarrow> rec_exec rec_lg [x, y] = lg x y"
-apply(simp add: rec_exec.simps rec_lg_def Let_def lg.simps)
-done
-
-text {*
- The correctness of @{text "rec_lg"}.
- *}
-lemma lg_lemma: "rec_exec rec_lg [x, y] = lg x y"
-apply(case_tac "Suc 0 < x \<and> Suc 0 < y", auto simp:
- lg_lemma' lg_lemma'' lg_lemma''')
-done
-
-text {*
- @{text "Entry sr i"} returns the @{text "i"}-th entry of a list of natural
- numbers encoded by number @{text "sr"} using Godel's coding.
- *}
-fun Entry :: "nat \<Rightarrow> nat \<Rightarrow> nat"
- where
- "Entry sr i = lo sr (Pi (Suc i))"
-
-text {*
- @{text "rec_entry"} is the recursive function used to implement
- @{text "Entry"}.
- *}
-definition rec_entry:: "recf"
- where
- "rec_entry = Cn 2 rec_lo [id 2 0, Cn 2 rec_pi [Cn 2 s [id 2 1]]]"
-
-declare Pi.simps[simp del]
-
-text {*
- The correctness of @{text "rec_entry"}.
- *}
-lemma entry_lemma: "rec_exec rec_entry [str, i] = Entry str i"
- by(simp add: rec_entry_def rec_exec.simps lo_lemma pi_lemma)
-
-
-subsection {* The construction of F *}
-
-text {*
- Using the auxilliary functions obtained in last section,
- we are going to contruct the function @{text "F"},
- which is an interpreter of Turing Machines.
- *}
-
-fun listsum2 :: "nat list \<Rightarrow> nat \<Rightarrow> nat"
- where
- "listsum2 xs 0 = 0"
-| "listsum2 xs (Suc n) = listsum2 xs n + xs ! n"
-
-fun rec_listsum2 :: "nat \<Rightarrow> nat \<Rightarrow> recf"
- where
- "rec_listsum2 vl 0 = Cn vl z [id vl 0]"
-| "rec_listsum2 vl (Suc n) = Cn vl rec_add
- [rec_listsum2 vl n, id vl (n)]"
-
-declare listsum2.simps[simp del] rec_listsum2.simps[simp del]
-
-lemma listsum2_lemma: "\<lbrakk>length xs = vl; n \<le> vl\<rbrakk> \<Longrightarrow>
- rec_exec (rec_listsum2 vl n) xs = listsum2 xs n"
-apply(induct n, simp_all)
-apply(simp_all add: rec_exec.simps rec_listsum2.simps listsum2.simps)
-done
-
-fun strt' :: "nat list \<Rightarrow> nat \<Rightarrow> nat"
- where
- "strt' xs 0 = 0"
-| "strt' xs (Suc n) = (let dbound = listsum2 xs n + n in
- strt' xs n + (2^(xs ! n + dbound) - 2^dbound))"
-
-fun rec_strt' :: "nat \<Rightarrow> nat \<Rightarrow> recf"
- where
- "rec_strt' vl 0 = Cn vl z [id vl 0]"
-| "rec_strt' vl (Suc n) = (let rec_dbound =
- Cn vl rec_add [rec_listsum2 vl n, Cn vl (constn n) [id vl 0]]
- in Cn vl rec_add [rec_strt' vl n, Cn vl rec_minus
- [Cn vl rec_power [Cn vl (constn 2) [id vl 0], Cn vl rec_add
- [id vl (n), rec_dbound]],
- Cn vl rec_power [Cn vl (constn 2) [id vl 0], rec_dbound]]])"
-
-declare strt'.simps[simp del] rec_strt'.simps[simp del]
-
-lemma strt'_lemma: "\<lbrakk>length xs = vl; n \<le> vl\<rbrakk> \<Longrightarrow>
- rec_exec (rec_strt' vl n) xs = strt' xs n"
-apply(induct n)
-apply(simp_all add: rec_exec.simps rec_strt'.simps strt'.simps
- Let_def power_lemma listsum2_lemma)
-done
-
-text {*
- @{text "strt"} corresponds to the @{text "strt"} function on page 90 of B book, but
- this definition generalises the original one to deal with multiple input arguments.
- *}
-fun strt :: "nat list \<Rightarrow> nat"
- where
- "strt xs = (let ys = map Suc xs in
- strt' ys (length ys))"
-
-fun rec_map :: "recf \<Rightarrow> nat \<Rightarrow> recf list"
- where
- "rec_map rf vl = map (\<lambda> i. Cn vl rf [id vl (i)]) [0..<vl]"
-
-text {*
- @{text "rec_strt"} is the recursive function used to implement @{text "strt"}.
- *}
-fun rec_strt :: "nat \<Rightarrow> recf"
- where
- "rec_strt vl = Cn vl (rec_strt' vl vl) (rec_map s vl)"
-
-lemma map_s_lemma: "length xs = vl \<Longrightarrow>
- map ((\<lambda>a. rec_exec a xs) \<circ> (\<lambda>i. Cn vl s [recf.id vl i]))
- [0..<vl]
- = map Suc xs"
-apply(induct vl arbitrary: xs, simp, auto simp: rec_exec.simps)
-apply(subgoal_tac "\<exists> ys y. xs = ys @ [y]", auto)
-proof -
- fix ys y
- assume ind: "\<And>xs. length xs = length (ys::nat list) \<Longrightarrow>
- map ((\<lambda>a. rec_exec a xs) \<circ> (\<lambda>i. Cn (length ys) s
- [recf.id (length ys) (i)])) [0..<length ys] = map Suc xs"
- show
- "map ((\<lambda>a. rec_exec a (ys @ [y])) \<circ> (\<lambda>i. Cn (Suc (length ys)) s
- [recf.id (Suc (length ys)) (i)])) [0..<length ys] = map Suc ys"
- proof -
- have "map ((\<lambda>a. rec_exec a ys) \<circ> (\<lambda>i. Cn (length ys) s
- [recf.id (length ys) (i)])) [0..<length ys] = map Suc ys"
- apply(rule_tac ind, simp)
- done
- moreover have
- "map ((\<lambda>a. rec_exec a (ys @ [y])) \<circ> (\<lambda>i. Cn (Suc (length ys)) s
- [recf.id (Suc (length ys)) (i)])) [0..<length ys]
- = map ((\<lambda>a. rec_exec a ys) \<circ> (\<lambda>i. Cn (length ys) s
- [recf.id (length ys) (i)])) [0..<length ys]"
- apply(rule_tac map_ext, auto simp: rec_exec.simps nth_append)
- done
- ultimately show "?thesis"
- by simp
- qed
-next
- fix vl xs
- assume "length xs = Suc vl"
- thus "\<exists>ys y. xs = ys @ [y]"
- apply(rule_tac x = "butlast xs" in exI, rule_tac x = "last xs" in exI)
- apply(subgoal_tac "xs \<noteq> []", auto)
- done
-qed
-
-text {*
- The correctness of @{text "rec_strt"}.
- *}
-lemma strt_lemma: "length xs = vl \<Longrightarrow>
- rec_exec (rec_strt vl) xs = strt xs"
-apply(simp add: strt.simps rec_exec.simps strt'_lemma)
-apply(subgoal_tac "(map ((\<lambda>a. rec_exec a xs) \<circ> (\<lambda>i. Cn vl s [recf.id vl (i)])) [0..<vl])
- = map Suc xs", auto)
-apply(rule map_s_lemma, simp)
-done
-
-text {*
- The @{text "scan"} function on page 90 of B book.
- *}
-fun scan :: "nat \<Rightarrow> nat"
- where
- "scan r = r mod 2"
-
-text {*
- @{text "rec_scan"} is the implemention of @{text "scan"}.
- *}
-definition rec_scan :: "recf"
- where "rec_scan = Cn 1 rec_mod [id 1 0, constn 2]"
-
-text {*
- The correctness of @{text "scan"}.
- *}
-lemma scan_lemma: "rec_exec rec_scan [r] = r mod 2"
- by(simp add: rec_exec.simps rec_scan_def mod_lemma)
-
-fun newleft0 :: "nat list \<Rightarrow> nat"
- where
- "newleft0 [p, r] = p"
-
-definition rec_newleft0 :: "recf"
- where
- "rec_newleft0 = id 2 0"
-
-fun newrgt0 :: "nat list \<Rightarrow> nat"
- where
- "newrgt0 [p, r] = r - scan r"
-
-definition rec_newrgt0 :: "recf"
- where
- "rec_newrgt0 = Cn 2 rec_minus [id 2 1, Cn 2 rec_scan [id 2 1]]"
-
-(*newleft1, newrgt1: left rgt number after execute on step*)
-fun newleft1 :: "nat list \<Rightarrow> nat"
- where
- "newleft1 [p, r] = p"
-
-definition rec_newleft1 :: "recf"
- where
- "rec_newleft1 = id 2 0"
-
-fun newrgt1 :: "nat list \<Rightarrow> nat"
- where
- "newrgt1 [p, r] = r + 1 - scan r"
-
-definition rec_newrgt1 :: "recf"
- where
- "rec_newrgt1 =
- Cn 2 rec_minus [Cn 2 rec_add [id 2 1, Cn 2 (constn 1) [id 2 0]],
- Cn 2 rec_scan [id 2 1]]"
-
-fun newleft2 :: "nat list \<Rightarrow> nat"
- where
- "newleft2 [p, r] = p div 2"
-
-definition rec_newleft2 :: "recf"
- where
- "rec_newleft2 = Cn 2 rec_quo [id 2 0, Cn 2 (constn 2) [id 2 0]]"
-
-fun newrgt2 :: "nat list \<Rightarrow> nat"
- where
- "newrgt2 [p, r] = 2 * r + p mod 2"
-
-definition rec_newrgt2 :: "recf"
- where
- "rec_newrgt2 =
- Cn 2 rec_add [Cn 2 rec_mult [Cn 2 (constn 2) [id 2 0], id 2 1],
- Cn 2 rec_mod [id 2 0, Cn 2 (constn 2) [id 2 0]]]"
-
-fun newleft3 :: "nat list \<Rightarrow> nat"
- where
- "newleft3 [p, r] = 2 * p + r mod 2"
-
-definition rec_newleft3 :: "recf"
- where
- "rec_newleft3 =
- Cn 2 rec_add [Cn 2 rec_mult [Cn 2 (constn 2) [id 2 0], id 2 0],
- Cn 2 rec_mod [id 2 1, Cn 2 (constn 2) [id 2 0]]]"
-
-fun newrgt3 :: "nat list \<Rightarrow> nat"
- where
- "newrgt3 [p, r] = r div 2"
-
-definition rec_newrgt3 :: "recf"
- where
- "rec_newrgt3 = Cn 2 rec_quo [id 2 1, Cn 2 (constn 2) [id 2 0]]"
-
-text {*
- The @{text "new_left"} function on page 91 of B book.
- *}
-fun newleft :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat"
- where
- "newleft p r a = (if a = 0 \<or> a = 1 then newleft0 [p, r]
- else if a = 2 then newleft2 [p, r]
- else if a = 3 then newleft3 [p, r]
- else p)"
-
-text {*
- @{text "rec_newleft"} is the recursive function used to
- implement @{text "newleft"}.
- *}
-definition rec_newleft :: "recf"
- where
- "rec_newleft =
- (let g0 =
- Cn 3 rec_newleft0 [id 3 0, id 3 1] in
- let g1 = Cn 3 rec_newleft2 [id 3 0, id 3 1] in
- let g2 = Cn 3 rec_newleft3 [id 3 0, id 3 1] in
- let g3 = id 3 0 in
- let r0 = Cn 3 rec_disj
- [Cn 3 rec_eq [id 3 2, Cn 3 (constn 0) [id 3 0]],
- Cn 3 rec_eq [id 3 2, Cn 3 (constn 1) [id 3 0]]] in
- let r1 = Cn 3 rec_eq [id 3 2, Cn 3 (constn 2) [id 3 0]] in
- let r2 = Cn 3 rec_eq [id 3 2, Cn 3 (constn 3) [id 3 0]] in
- let r3 = Cn 3 rec_less [Cn 3 (constn 3) [id 3 0], id 3 2] in
- let gs = [g0, g1, g2, g3] in
- let rs = [r0, r1, r2, r3] in
- rec_embranch (zip gs rs))"
-
-declare newleft.simps[simp del]
-
-
-lemma Suc_Suc_Suc_Suc_induct:
- "\<lbrakk>i < Suc (Suc (Suc (Suc 0))); i = 0 \<Longrightarrow> P i;
- i = 1 \<Longrightarrow> P i; i =2 \<Longrightarrow> P i;
- i =3 \<Longrightarrow> P i\<rbrakk> \<Longrightarrow> P i"
-apply(case_tac i, simp, case_tac nat, simp,
- case_tac nata, simp, case_tac natb, simp, simp)
-done
-
-declare quo_lemma2[simp] mod_lemma[simp]
-
-text {*
- The correctness of @{text "rec_newleft"}.
- *}
-lemma newleft_lemma:
- "rec_exec rec_newleft [p, r, a] = newleft p r a"
-proof(simp only: rec_newleft_def Let_def)
- let ?rgs = "[Cn 3 rec_newleft0 [recf.id 3 0, recf.id 3 1], Cn 3 rec_newleft2
- [recf.id 3 0, recf.id 3 1], Cn 3 rec_newleft3 [recf.id 3 0, recf.id 3 1], recf.id 3 0]"
- let ?rrs =
- "[Cn 3 rec_disj [Cn 3 rec_eq [recf.id 3 2, Cn 3 (constn 0)
- [recf.id 3 0]], Cn 3 rec_eq [recf.id 3 2, Cn 3 (constn 1) [recf.id 3 0]]],
- Cn 3 rec_eq [recf.id 3 2, Cn 3 (constn 2) [recf.id 3 0]],
- Cn 3 rec_eq [recf.id 3 2, Cn 3 (constn 3) [recf.id 3 0]],
- Cn 3 rec_less [Cn 3 (constn 3) [recf.id 3 0], recf.id 3 2]]"
- thm embranch_lemma
- have k1: "rec_exec (rec_embranch (zip ?rgs ?rrs)) [p, r, a]
- = Embranch (zip (map rec_exec ?rgs) (map (\<lambda>r args. 0 < rec_exec r args) ?rrs)) [p, r, a]"
- apply(rule_tac embranch_lemma )
- apply(auto simp: numeral_3_eq_3 numeral_2_eq_2 rec_newleft0_def
- rec_newleft1_def rec_newleft2_def rec_newleft3_def)+
- apply(case_tac "a = 0 \<or> a = 1", rule_tac x = 0 in exI)
- prefer 2
- apply(case_tac "a = 2", rule_tac x = "Suc 0" in exI)
- prefer 2
- apply(case_tac "a = 3", rule_tac x = "2" in exI)
- prefer 2
- apply(case_tac "a > 3", rule_tac x = "3" in exI, auto)
- apply(auto simp: rec_exec.simps)
- apply(erule_tac [!] Suc_Suc_Suc_Suc_induct, auto simp: rec_exec.simps)
- done
- have k2: "Embranch (zip (map rec_exec ?rgs) (map (\<lambda>r args. 0 < rec_exec r args) ?rrs)) [p, r, a] = newleft p r a"
- apply(simp add: Embranch.simps)
- apply(simp add: rec_exec.simps)
- apply(auto simp: newleft.simps rec_newleft0_def rec_exec.simps
- rec_newleft1_def rec_newleft2_def rec_newleft3_def)
- done
- from k1 and k2 show
- "rec_exec (rec_embranch (zip ?rgs ?rrs)) [p, r, a] = newleft p r a"
- by simp
-qed
-
-text {*
- The @{text "newrght"} function is one similar to @{text "newleft"}, but used to
- compute the right number.
- *}
-fun newrght :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat"
- where
- "newrght p r a = (if a = 0 then newrgt0 [p, r]
- else if a = 1 then newrgt1 [p, r]
- else if a = 2 then newrgt2 [p, r]
- else if a = 3 then newrgt3 [p, r]
- else r)"
-
-text {*
- @{text "rec_newrght"} is the recursive function used to implement
- @{text "newrgth"}.
- *}
-definition rec_newrght :: "recf"
- where
- "rec_newrght =
- (let g0 = Cn 3 rec_newrgt0 [id 3 0, id 3 1] in
- let g1 = Cn 3 rec_newrgt1 [id 3 0, id 3 1] in
- let g2 = Cn 3 rec_newrgt2 [id 3 0, id 3 1] in
- let g3 = Cn 3 rec_newrgt3 [id 3 0, id 3 1] in
- let g4 = id 3 1 in
- let r0 = Cn 3 rec_eq [id 3 2, Cn 3 (constn 0) [id 3 0]] in
- let r1 = Cn 3 rec_eq [id 3 2, Cn 3 (constn 1) [id 3 0]] in
- let r2 = Cn 3 rec_eq [id 3 2, Cn 3 (constn 2) [id 3 0]] in
- let r3 = Cn 3 rec_eq [id 3 2, Cn 3 (constn 3) [id 3 0]] in
- let r4 = Cn 3 rec_less [Cn 3 (constn 3) [id 3 0], id 3 2] in
- let gs = [g0, g1, g2, g3, g4] in
- let rs = [r0, r1, r2, r3, r4] in
- rec_embranch (zip gs rs))"
-declare newrght.simps[simp del]
-
-lemma numeral_4_eq_4: "4 = Suc 3"
-by auto
-
-lemma Suc_5_induct:
- "\<lbrakk>i < Suc (Suc (Suc (Suc (Suc 0)))); i = 0 \<Longrightarrow> P 0;
- i = 1 \<Longrightarrow> P 1; i = 2 \<Longrightarrow> P 2; i = 3 \<Longrightarrow> P 3; i = 4 \<Longrightarrow> P 4\<rbrakk> \<Longrightarrow> P i"
-apply(case_tac i, auto)
-apply(case_tac nat, auto)
-apply(case_tac nata, auto simp: numeral_2_eq_2)
-apply(case_tac nat, auto simp: numeral_3_eq_3 numeral_4_eq_4)
-done
-
-lemma [intro]: "primerec rec_scan (Suc 0)"
-apply(auto simp: rec_scan_def, auto)
-done
-
-text {*
- The correctness of @{text "rec_newrght"}.
- *}
-lemma newrght_lemma: "rec_exec rec_newrght [p, r, a] = newrght p r a"
-proof(simp only: rec_newrght_def Let_def)
- let ?gs' = "[newrgt0, newrgt1, newrgt2, newrgt3, \<lambda> zs. zs ! 1]"
- let ?r0 = "\<lambda> zs. zs ! 2 = 0"
- let ?r1 = "\<lambda> zs. zs ! 2 = 1"
- let ?r2 = "\<lambda> zs. zs ! 2 = 2"
- let ?r3 = "\<lambda> zs. zs ! 2 = 3"
- let ?r4 = "\<lambda> zs. zs ! 2 > 3"
- let ?gs = "map (\<lambda> g. (\<lambda> zs. g [zs ! 0, zs ! 1])) ?gs'"
- let ?rs = "[?r0, ?r1, ?r2, ?r3, ?r4]"
- let ?rgs =
- "[Cn 3 rec_newrgt0 [recf.id 3 0, recf.id 3 1],
- Cn 3 rec_newrgt1 [recf.id 3 0, recf.id 3 1],
- Cn 3 rec_newrgt2 [recf.id 3 0, recf.id 3 1],
- Cn 3 rec_newrgt3 [recf.id 3 0, recf.id 3 1], recf.id 3 1]"
- let ?rrs =
- "[Cn 3 rec_eq [recf.id 3 2, Cn 3 (constn 0) [recf.id 3 0]], Cn 3 rec_eq [recf.id 3 2,
- Cn 3 (constn 1) [recf.id 3 0]], Cn 3 rec_eq [recf.id 3 2, Cn 3 (constn 2) [recf.id 3 0]],
- Cn 3 rec_eq [recf.id 3 2, Cn 3 (constn 3) [recf.id 3 0]],
- Cn 3 rec_less [Cn 3 (constn 3) [recf.id 3 0], recf.id 3 2]]"
-
- have k1: "rec_exec (rec_embranch (zip ?rgs ?rrs)) [p, r, a]
- = Embranch (zip (map rec_exec ?rgs) (map (\<lambda>r args. 0 < rec_exec r args) ?rrs)) [p, r, a]"
- apply(rule_tac embranch_lemma)
- apply(auto simp: numeral_3_eq_3 numeral_2_eq_2 rec_newrgt0_def
- rec_newrgt1_def rec_newrgt2_def rec_newrgt3_def)+
- apply(case_tac "a = 0", rule_tac x = 0 in exI)
- prefer 2
- apply(case_tac "a = 1", rule_tac x = "Suc 0" in exI)
- prefer 2
- apply(case_tac "a = 2", rule_tac x = "2" in exI)
- prefer 2
- apply(case_tac "a = 3", rule_tac x = "3" in exI)
- prefer 2
- apply(case_tac "a > 3", rule_tac x = "4" in exI, auto simp: rec_exec.simps)
- apply(erule_tac [!] Suc_5_induct, auto simp: rec_exec.simps)
- done
- have k2: "Embranch (zip (map rec_exec ?rgs)
- (map (\<lambda>r args. 0 < rec_exec r args) ?rrs)) [p, r, a] = newrght p r a"
- apply(auto simp:Embranch.simps rec_exec.simps)
- apply(auto simp: newrght.simps rec_newrgt3_def rec_newrgt2_def
- rec_newrgt1_def rec_newrgt0_def rec_exec.simps
- scan_lemma)
- done
- from k1 and k2 show
- "rec_exec (rec_embranch (zip ?rgs ?rrs)) [p, r, a] =
- newrght p r a" by simp
-qed
-
-declare Entry.simps[simp del]
-
-text {*
- The @{text "actn"} function given on page 92 of B book, which is used to
- fetch Turing Machine intructions.
- In @{text "actn m q r"}, @{text "m"} is the Godel coding of a Turing Machine,
- @{text "q"} is the current state of Turing Machine, @{text "r"} is the
- right number of Turing Machine tape.
- *}
-fun actn :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat"
- where
- "actn m q r = (if q \<noteq> 0 then Entry m (4*(q - 1) + 2 * scan r)
- else 4)"
-
-text {*
- @{text "rec_actn"} is the recursive function used to implement @{text "actn"}
- *}
-definition rec_actn :: "recf"
- where
- "rec_actn =
- Cn 3 rec_add [Cn 3 rec_mult
- [Cn 3 rec_entry [id 3 0, Cn 3 rec_add [Cn 3 rec_mult
- [Cn 3 (constn 4) [id 3 0],
- Cn 3 rec_minus [id 3 1, Cn 3 (constn 1) [id 3 0]]],
- Cn 3 rec_mult [Cn 3 (constn 2) [id 3 0],
- Cn 3 rec_scan [id 3 2]]]],
- Cn 3 rec_noteq [id 3 1, Cn 3 (constn 0) [id 3 0]]],
- Cn 3 rec_mult [Cn 3 (constn 4) [id 3 0],
- Cn 3 rec_eq [id 3 1, Cn 3 (constn 0) [id 3 0]]]] "
-
-text {*
- The correctness of @{text "actn"}.
- *}
-lemma actn_lemma: "rec_exec rec_actn [m, q, r] = actn m q r"
- by(auto simp: rec_actn_def rec_exec.simps entry_lemma scan_lemma)
-
-fun newstat :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat"
- where
- "newstat m q r = (if q \<noteq> 0 then Entry m (4*(q - 1) + 2*scan r + 1)
- else 0)"
-
-definition rec_newstat :: "recf"
- where
- "rec_newstat = Cn 3 rec_add
- [Cn 3 rec_mult [Cn 3 rec_entry [id 3 0,
- Cn 3 rec_add [Cn 3 rec_mult [Cn 3 (constn 4) [id 3 0],
- Cn 3 rec_minus [id 3 1, Cn 3 (constn 1) [id 3 0]]],
- Cn 3 rec_add [Cn 3 rec_mult [Cn 3 (constn 2) [id 3 0],
- Cn 3 rec_scan [id 3 2]], Cn 3 (constn 1) [id 3 0]]]],
- Cn 3 rec_noteq [id 3 1, Cn 3 (constn 0) [id 3 0]]],
- Cn 3 rec_mult [Cn 3 (constn 0) [id 3 0],
- Cn 3 rec_eq [id 3 1, Cn 3 (constn 0) [id 3 0]]]] "
-
-lemma newstat_lemma: "rec_exec rec_newstat [m, q, r] = newstat m q r"
-by(auto simp: rec_exec.simps entry_lemma scan_lemma rec_newstat_def)
-
-declare newstat.simps[simp del] actn.simps[simp del]
-
-text{*code the configuration*}
-
-fun trpl :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat"
- where
- "trpl p q r = (Pi 0)^p * (Pi 1)^q * (Pi 2)^r"
-
-definition rec_trpl :: "recf"
- where
- "rec_trpl = Cn 3 rec_mult [Cn 3 rec_mult
- [Cn 3 rec_power [Cn 3 (constn (Pi 0)) [id 3 0], id 3 0],
- Cn 3 rec_power [Cn 3 (constn (Pi 1)) [id 3 0], id 3 1]],
- Cn 3 rec_power [Cn 3 (constn (Pi 2)) [id 3 0], id 3 2]]"
-declare trpl.simps[simp del]
-lemma trpl_lemma: "rec_exec rec_trpl [p, q, r] = trpl p q r"
-by(auto simp: rec_trpl_def rec_exec.simps power_lemma trpl.simps)
-
-text{*left, stat, rght: decode func*}
-fun left :: "nat \<Rightarrow> nat"
- where
- "left c = lo c (Pi 0)"
-
-fun stat :: "nat \<Rightarrow> nat"
- where
- "stat c = lo c (Pi 1)"
-
-fun rght :: "nat \<Rightarrow> nat"
- where
- "rght c = lo c (Pi 2)"
-
-thm Prime.simps
-
-fun inpt :: "nat \<Rightarrow> nat list \<Rightarrow> nat"
- where
- "inpt m xs = trpl 0 1 (strt xs)"
-
-fun newconf :: "nat \<Rightarrow> nat \<Rightarrow> nat"
- where
- "newconf m c = trpl (newleft (left c) (rght c)
- (actn m (stat c) (rght c)))
- (newstat m (stat c) (rght c))
- (newrght (left c) (rght c)
- (actn m (stat c) (rght c)))"
-
-declare left.simps[simp del] stat.simps[simp del] rght.simps[simp del]
- inpt.simps[simp del] newconf.simps[simp del]
-
-definition rec_left :: "recf"
- where
- "rec_left = Cn 1 rec_lo [id 1 0, constn (Pi 0)]"
-
-definition rec_right :: "recf"
- where
- "rec_right = Cn 1 rec_lo [id 1 0, constn (Pi 2)]"
-
-definition rec_stat :: "recf"
- where
- "rec_stat = Cn 1 rec_lo [id 1 0, constn (Pi 1)]"
-
-definition rec_inpt :: "nat \<Rightarrow> recf"
- where
- "rec_inpt vl = Cn vl rec_trpl
- [Cn vl (constn 0) [id vl 0],
- Cn vl (constn 1) [id vl 0],
- Cn vl (rec_strt (vl - 1))
- (map (\<lambda> i. id vl (i)) [1..<vl])]"
-
-lemma left_lemma: "rec_exec rec_left [c] = left c"
-by(simp add: rec_exec.simps rec_left_def left.simps lo_lemma)
-
-lemma right_lemma: "rec_exec rec_right [c] = rght c"
-by(simp add: rec_exec.simps rec_right_def rght.simps lo_lemma)
-
-lemma stat_lemma: "rec_exec rec_stat [c] = stat c"
-by(simp add: rec_exec.simps rec_stat_def stat.simps lo_lemma)
-
-declare rec_strt.simps[simp del] strt.simps[simp del]
-
-lemma map_cons_eq:
- "(map ((\<lambda>a. rec_exec a (m # xs)) \<circ>
- (\<lambda>i. recf.id (Suc (length xs)) (i)))
- [Suc 0..<Suc (length xs)])
- = map (\<lambda> i. xs ! (i - 1)) [Suc 0..<Suc (length xs)]"
-apply(rule map_ext, auto)
-apply(auto simp: rec_exec.simps nth_append nth_Cons split: nat.split)
-done
-
-lemma list_map_eq:
- "vl = length (xs::nat list) \<Longrightarrow> map (\<lambda> i. xs ! (i - 1))
- [Suc 0..<Suc vl] = xs"
-apply(induct vl arbitrary: xs, simp)
-apply(subgoal_tac "\<exists> ys y. xs = ys @ [y]", auto)
-proof -
- fix ys y
- assume ind:
- "\<And>xs. length (ys::nat list) = length (xs::nat list) \<Longrightarrow>
- map (\<lambda>i. xs ! (i - Suc 0)) [Suc 0..<length xs] @
- [xs ! (length xs - Suc 0)] = xs"
- and h: "Suc 0 \<le> length (ys::nat list)"
- have "map (\<lambda>i. ys ! (i - Suc 0)) [Suc 0..<length ys] @
- [ys ! (length ys - Suc 0)] = ys"
- apply(rule_tac ind, simp)
- done
- moreover have
- "map (\<lambda>i. (ys @ [y]) ! (i - Suc 0)) [Suc 0..<length ys]
- = map (\<lambda>i. ys ! (i - Suc 0)) [Suc 0..<length ys]"
- apply(rule map_ext)
- using h
- apply(auto simp: nth_append)
- done
- ultimately show "map (\<lambda>i. (ys @ [y]) ! (i - Suc 0))
- [Suc 0..<length ys] @ [(ys @ [y]) ! (length ys - Suc 0)] = ys"
- apply(simp del: map_eq_conv add: nth_append, auto)
- using h
- apply(simp)
- done
-next
- fix vl xs
- assume "Suc vl = length (xs::nat list)"
- thus "\<exists>ys y. xs = ys @ [y]"
- apply(rule_tac x = "butlast xs" in exI,
- rule_tac x = "last xs" in exI)
- apply(case_tac "xs \<noteq> []", auto)
- done
-qed
-
-lemma [elim]:
- "Suc 0 \<le> length xs \<Longrightarrow>
- (map ((\<lambda>a. rec_exec a (m # xs)) \<circ>
- (\<lambda>i. recf.id (Suc (length xs)) (i)))
- [Suc 0..<length xs] @ [(m # xs) ! length xs]) = xs"
-using map_cons_eq[of m xs]
-apply(simp del: map_eq_conv add: rec_exec.simps)
-using list_map_eq[of "length xs" xs]
-apply(simp)
-done
-
-
-lemma inpt_lemma:
- "\<lbrakk>Suc (length xs) = vl\<rbrakk> \<Longrightarrow>
- rec_exec (rec_inpt vl) (m # xs) = inpt m xs"
-apply(auto simp: rec_exec.simps rec_inpt_def
- trpl_lemma inpt.simps strt_lemma)
-apply(subgoal_tac
- "(map ((\<lambda>a. rec_exec a (m # xs)) \<circ>
- (\<lambda>i. recf.id (Suc (length xs)) (i)))
- [Suc 0..<length xs] @ [(m # xs) ! length xs]) = xs", simp)
-apply(auto, case_tac xs, auto)
-done
-
-definition rec_newconf:: "recf"
- where
- "rec_newconf =
- Cn 2 rec_trpl
- [Cn 2 rec_newleft [Cn 2 rec_left [id 2 1],
- Cn 2 rec_right [id 2 1],
- Cn 2 rec_actn [id 2 0,
- Cn 2 rec_stat [id 2 1],
- Cn 2 rec_right [id 2 1]]],
- Cn 2 rec_newstat [id 2 0,
- Cn 2 rec_stat [id 2 1],
- Cn 2 rec_right [id 2 1]],
- Cn 2 rec_newrght [Cn 2 rec_left [id 2 1],
- Cn 2 rec_right [id 2 1],
- Cn 2 rec_actn [id 2 0,
- Cn 2 rec_stat [id 2 1],
- Cn 2 rec_right [id 2 1]]]]"
-
-lemma newconf_lemma: "rec_exec rec_newconf [m ,c] = newconf m c"
-by(auto simp: rec_newconf_def rec_exec.simps
- trpl_lemma newleft_lemma left_lemma
- right_lemma stat_lemma newrght_lemma actn_lemma
- newstat_lemma stat_lemma newconf.simps)
-
-declare newconf_lemma[simp]
-
-text {*
- @{text "conf m r k"} computes the TM configuration after @{text "k"} steps of execution
- of TM coded as @{text "m"} starting from the initial configuration where the left number equals @{text "0"},
- right number equals @{text "r"}.
- *}
-fun conf :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat"
- where
- "conf m r 0 = trpl 0 (Suc 0) r"
-| "conf m r (Suc t) = newconf m (conf m r t)"
-
-declare conf.simps[simp del]
-
-text {*
- @{text "conf"} is implemented by the following recursive function @{text "rec_conf"}.
- *}
-definition rec_conf :: "recf"
- where
- "rec_conf = Pr 2 (Cn 2 rec_trpl [Cn 2 (constn 0) [id 2 0], Cn 2 (constn (Suc 0)) [id 2 0], id 2 1])
- (Cn 4 rec_newconf [id 4 0, id 4 3])"
-
-lemma conf_step:
- "rec_exec rec_conf [m, r, Suc t] =
- rec_exec rec_newconf [m, rec_exec rec_conf [m, r, t]]"
-proof -
- have "rec_exec rec_conf ([m, r] @ [Suc t]) =
- rec_exec rec_newconf [m, rec_exec rec_conf [m, r, t]]"
- by(simp only: rec_conf_def rec_pr_Suc_simp_rewrite,
- simp add: rec_exec.simps)
- thus "rec_exec rec_conf [m, r, Suc t] =
- rec_exec rec_newconf [m, rec_exec rec_conf [m, r, t]]"
- by simp
-qed
-
-text {*
- The correctness of @{text "rec_conf"}.
- *}
-lemma conf_lemma:
- "rec_exec rec_conf [m, r, t] = conf m r t"
-apply(induct t)
-apply(simp add: rec_conf_def rec_exec.simps conf.simps inpt_lemma trpl_lemma)
-apply(simp add: conf_step conf.simps)
-done
-
-text {*
- @{text "NSTD c"} returns true if the configureation coded by @{text "c"} is no a stardard
- final configuration.
- *}
-fun NSTD :: "nat \<Rightarrow> bool"
- where
- "NSTD c = (stat c \<noteq> 0 \<or> left c \<noteq> 0 \<or>
- rght c \<noteq> 2^(lg (rght c + 1) 2) - 1 \<or> rght c = 0)"
-
-text {*
- @{text "rec_NSTD"} is the recursive function implementing @{text "NSTD"}.
- *}
-definition rec_NSTD :: "recf"
- where
- "rec_NSTD =
- Cn 1 rec_disj [
- Cn 1 rec_disj [
- Cn 1 rec_disj
- [Cn 1 rec_noteq [rec_stat, constn 0],
- Cn 1 rec_noteq [rec_left, constn 0]] ,
- Cn 1 rec_noteq [rec_right,
- Cn 1 rec_minus [Cn 1 rec_power
- [constn 2, Cn 1 rec_lg
- [Cn 1 rec_add
- [rec_right, constn 1],
- constn 2]], constn 1]]],
- Cn 1 rec_eq [rec_right, constn 0]]"
-
-lemma NSTD_lemma1: "rec_exec rec_NSTD [c] = Suc 0 \<or>
- rec_exec rec_NSTD [c] = 0"
-by(simp add: rec_exec.simps rec_NSTD_def)
-
-declare NSTD.simps[simp del]
-lemma NSTD_lemma2': "(rec_exec rec_NSTD [c] = Suc 0) \<Longrightarrow> NSTD c"
-apply(simp add: rec_exec.simps rec_NSTD_def stat_lemma left_lemma
- lg_lemma right_lemma power_lemma NSTD.simps eq_lemma)
-apply(auto)
-apply(case_tac "0 < left c", simp, simp)
-done
-
-lemma NSTD_lemma2'':
- "NSTD c \<Longrightarrow> (rec_exec rec_NSTD [c] = Suc 0)"
-apply(simp add: rec_exec.simps rec_NSTD_def stat_lemma
- left_lemma lg_lemma right_lemma power_lemma NSTD.simps)
-apply(auto split: if_splits)
-done
-
-text {*
- The correctness of @{text "NSTD"}.
- *}
-lemma NSTD_lemma2: "(rec_exec rec_NSTD [c] = Suc 0) = NSTD c"
-using NSTD_lemma1
-apply(auto intro: NSTD_lemma2' NSTD_lemma2'')
-done
-
-fun nstd :: "nat \<Rightarrow> nat"
- where
- "nstd c = (if NSTD c then 1 else 0)"
-
-lemma nstd_lemma: "rec_exec rec_NSTD [c] = nstd c"
-using NSTD_lemma1
-apply(simp add: NSTD_lemma2, auto)
-done
-
-text{*
- @{text "nonstep m r t"} means afer @{text "t"} steps of execution, the TM coded by @{text "m"}
- is not at a stardard final configuration.
- *}
-fun nonstop :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat"
- where
- "nonstop m r t = nstd (conf m r t)"
-
-text {*
- @{text "rec_nonstop"} is the recursive function implementing @{text "nonstop"}.
- *}
-definition rec_nonstop :: "recf"
- where
- "rec_nonstop = Cn 3 rec_NSTD [rec_conf]"
-
-text {*
- The correctness of @{text "rec_nonstop"}.
- *}
-lemma nonstop_lemma:
- "rec_exec rec_nonstop [m, r, t] = nonstop m r t"
-apply(simp add: rec_exec.simps rec_nonstop_def nstd_lemma conf_lemma)
-done
-
-text{*
- @{text "rec_halt"} is the recursive function calculating the steps a TM needs to execute before
- to reach a stardard final configuration. This recursive function is the only one
- using @{text "Mn"} combinator. So it is the only non-primitive recursive function
- needs to be used in the construction of the universal function @{text "F"}.
- *}
-
-definition rec_halt :: "recf"
- where
- "rec_halt = Mn (Suc (Suc 0)) (rec_nonstop)"
-
-declare nonstop.simps[simp del]
-
-lemma primerec_not0: "primerec f n \<Longrightarrow> n > 0"
-by(induct f n rule: primerec.induct, auto)
-
-lemma [elim]: "primerec f 0 \<Longrightarrow> RR"
-apply(drule_tac primerec_not0, simp)
-done
-
-lemma [simp]: "length xs = Suc n \<Longrightarrow> length (butlast xs) = n"
-apply(subgoal_tac "\<exists> y ys. xs = ys @ [y]", auto)
-apply(rule_tac x = "last xs" in exI)
-apply(rule_tac x = "butlast xs" in exI)
-apply(case_tac "xs = []", auto)
-done
-
-text {*
- The lemma relates the interpreter of primitive fucntions with
- the calculation relation of general recursive functions.
- *}
-lemma prime_rel_exec_eq: "primerec r (length xs)
- \<Longrightarrow> rec_calc_rel r xs rs = (rec_exec r xs = rs)"
-proof(induct r xs arbitrary: rs rule: rec_exec.induct, simp_all)
- fix xs rs
- assume "primerec z (length (xs::nat list))"
- hence "length xs = Suc 0" by(erule_tac prime_z_reverse, simp)
- thus "rec_calc_rel z xs rs = (rec_exec z xs = rs)"
- apply(case_tac xs, simp, auto)
- apply(erule_tac calc_z_reverse, simp add: rec_exec.simps)
- apply(simp add: rec_exec.simps, rule_tac calc_z)
- done
-next
- fix xs rs
- assume "primerec s (length (xs::nat list))"
- hence "length xs = Suc 0" ..
- thus "rec_calc_rel s xs rs = (rec_exec s xs = rs)"
- by(case_tac xs, auto simp: rec_exec.simps intro: calc_s
- elim: calc_s_reverse)
-next
- fix m n xs rs
- assume "primerec (recf.id m n) (length (xs::nat list))"
- thus
- "rec_calc_rel (recf.id m n) xs rs =
- (rec_exec (recf.id m n) xs = rs)"
- apply(erule_tac prime_id_reverse)
- apply(simp add: rec_exec.simps, auto)
- apply(erule_tac calc_id_reverse, simp)
- apply(rule_tac calc_id, auto)
- done
-next
- fix n f gs xs rs
- assume ind1:
- "\<And>x rs. \<lbrakk>x \<in> set gs; primerec x (length xs)\<rbrakk> \<Longrightarrow>
- rec_calc_rel x xs rs = (rec_exec x xs = rs)"
- and ind2:
- "\<And>x rs. \<lbrakk>x = map (\<lambda>a. rec_exec a xs) gs;
- primerec f (length gs)\<rbrakk> \<Longrightarrow>
- rec_calc_rel f (map (\<lambda>a. rec_exec a xs) gs) rs =
- (rec_exec f (map (\<lambda>a. rec_exec a xs) gs) = rs)"
- and h: "primerec (Cn n f gs) (length xs)"
- show "rec_calc_rel (Cn n f gs) xs rs =
- (rec_exec (Cn n f gs) xs = rs)"
- proof(auto simp: rec_exec.simps, erule_tac calc_cn_reverse, auto)
- fix ys
- assume g1:"\<forall>k<length gs. rec_calc_rel (gs ! k) xs (ys ! k)"
- and g2: "length ys = length gs"
- and g3: "rec_calc_rel f ys rs"
- have "rec_calc_rel f (map (\<lambda>a. rec_exec a xs) gs) rs =
- (rec_exec f (map (\<lambda>a. rec_exec a xs) gs) = rs)"
- apply(rule_tac ind2, auto)
- using h
- apply(erule_tac prime_cn_reverse, simp)
- done
- moreover have "ys = (map (\<lambda>a. rec_exec a xs) gs)"
- proof(rule_tac nth_equalityI, auto simp: g2)
- fix i
- assume "i < length gs" thus "ys ! i = rec_exec (gs!i) xs"
- using ind1[of "gs ! i" "ys ! i"] g1 h
- apply(erule_tac prime_cn_reverse, simp)
- done
- qed
- ultimately show "rec_exec f (map (\<lambda>a. rec_exec a xs) gs) = rs"
- using g3
- by(simp)
- next
- from h show
- "rec_calc_rel (Cn n f gs) xs
- (rec_exec f (map (\<lambda>a. rec_exec a xs) gs))"
- apply(rule_tac rs = "(map (\<lambda>a. rec_exec a xs) gs)" in calc_cn,
- auto)
- apply(erule_tac [!] prime_cn_reverse, auto)
- proof -
- fix k
- assume "k < length gs" "primerec f (length gs)"
- "\<forall>i<length gs. primerec (gs ! i) (length xs)"
- thus "rec_calc_rel (gs ! k) xs (rec_exec (gs ! k) xs)"
- using ind1[of "gs!k" "(rec_exec (gs ! k) xs)"]
- by(simp)
- next
- assume "primerec f (length gs)"
- "\<forall>i<length gs. primerec (gs ! i) (length xs)"
- thus "rec_calc_rel f (map (\<lambda>a. rec_exec a xs) gs)
- (rec_exec f (map (\<lambda>a. rec_exec a xs) gs))"
- using ind2[of "(map (\<lambda>a. rec_exec a xs) gs)"
- "(rec_exec f (map (\<lambda>a. rec_exec a xs) gs))"]
- by simp
- qed
- qed
-next
- fix n f g xs rs
- assume ind1:
- "\<And>rs. \<lbrakk>last xs = 0; primerec f (length xs - Suc 0)\<rbrakk>
- \<Longrightarrow> rec_calc_rel f (butlast xs) rs =
- (rec_exec f (butlast xs) = rs)"
- and ind2 :
- "\<And>rs. \<lbrakk>0 < last xs;
- primerec (Pr n f g) (Suc (length xs - Suc 0))\<rbrakk> \<Longrightarrow>
- rec_calc_rel (Pr n f g) (butlast xs @ [last xs - Suc 0]) rs
- = (rec_exec (Pr n f g) (butlast xs @ [last xs - Suc 0]) = rs)"
- and ind3:
- "\<And>rs. \<lbrakk>0 < last xs; primerec g (Suc (Suc (length xs - Suc 0)))\<rbrakk>
- \<Longrightarrow> rec_calc_rel g (butlast xs @
- [last xs - Suc 0, rec_exec (Pr n f g)
- (butlast xs @ [last xs - Suc 0])]) rs =
- (rec_exec g (butlast xs @ [last xs - Suc 0,
- rec_exec (Pr n f g)
- (butlast xs @ [last xs - Suc 0])]) = rs)"
- and h: "primerec (Pr n f g) (length (xs::nat list))"
- show "rec_calc_rel (Pr n f g) xs rs = (rec_exec (Pr n f g) xs = rs)"
- proof(auto)
- assume "rec_calc_rel (Pr n f g) xs rs"
- thus "rec_exec (Pr n f g) xs = rs"
- proof(erule_tac calc_pr_reverse)
- fix l
- assume g: "xs = l @ [0]"
- "rec_calc_rel f l rs"
- "n = length l"
- thus "rec_exec (Pr n f g) xs = rs"
- using ind1[of rs] h
- apply(simp add: rec_exec.simps,
- erule_tac prime_pr_reverse, simp)
- done
- next
- fix l y ry
- assume d:"xs = l @ [Suc y]"
- "rec_calc_rel (Pr (length l) f g) (l @ [y]) ry"
- "n = length l"
- "rec_calc_rel g (l @ [y, ry]) rs"
- moreover hence "primerec g (Suc (Suc n))" using h
- proof(erule_tac prime_pr_reverse)
- assume "primerec g (Suc (Suc n))" "length xs = Suc n"
- thus "?thesis" by simp
- qed
- ultimately show "rec_exec (Pr n f g) xs = rs"
- apply(simp)
- using ind3[of rs]
- apply(simp add: rec_pr_Suc_simp_rewrite)
- using ind2[of ry] h
- apply(simp)
- done
- qed
- next
- show "rec_calc_rel (Pr n f g) xs (rec_exec (Pr n f g) xs)"
- proof -
- have "rec_calc_rel (Pr n f g) (butlast xs @ [last xs])
- (rec_exec (Pr n f g) (butlast xs @ [last xs]))"
- using h
- apply(erule_tac prime_pr_reverse, simp)
- apply(case_tac "last xs", simp)
- apply(rule_tac calc_pr_zero, simp)
- using ind1[of "rec_exec (Pr n f g) (butlast xs @ [0])"]
- apply(simp add: rec_exec.simps, simp, simp, simp)
- thm calc_pr_ind
- apply(rule_tac rk = "rec_exec (Pr n f g)
- (butlast xs@[last xs - Suc 0])" in calc_pr_ind)
- using ind2[of "rec_exec (Pr n f g)
- (butlast xs @ [last xs - Suc 0])"] h
- apply(simp, simp, simp)
- proof -
- fix nat
- assume "length xs = Suc n"
- "primerec g (Suc (Suc n))"
- "last xs = Suc nat"
- thus
- "rec_calc_rel g (butlast xs @ [nat, rec_exec (Pr n f g)
- (butlast xs @ [nat])]) (rec_exec (Pr n f g) (butlast xs @ [Suc nat]))"
- using ind3[of "rec_exec (Pr n f g)
- (butlast xs @ [Suc nat])"]
- apply(simp add: rec_exec.simps)
- done
- qed
- thus "rec_calc_rel (Pr n f g) xs (rec_exec (Pr n f g) xs)"
- using h
- apply(erule_tac prime_pr_reverse, simp)
- apply(subgoal_tac "butlast xs @ [last xs] = xs", simp)
- apply(case_tac xs, simp, simp)
- done
- qed
- qed
-next
- fix n f xs rs
- assume "primerec (Mn n f) (length (xs::nat list))"
- thus "rec_calc_rel (Mn n f) xs rs = (rec_exec (Mn n f) xs = rs)"
- by(erule_tac prime_mn_reverse)
-qed
-
-declare numeral_2_eq_2[simp] numeral_3_eq_3[simp]
-
-lemma [intro]: "primerec rec_right (Suc 0)"
-apply(simp add: rec_right_def rec_lo_def Let_def)
-apply(tactic {* resolve_tac [@{thm prime_cn},
- @{thm prime_id}, @{thm prime_pr}] 1*}, auto+)+
-done
-
-lemma [simp]:
-"rec_calc_rel rec_right [r] rs = (rec_exec rec_right [r] = rs)"
-apply(rule_tac prime_rel_exec_eq, auto)
-done
-
-lemma [intro]: "primerec rec_pi (Suc 0)"
-apply(simp add: rec_pi_def rec_dummy_pi_def
- rec_np_def rec_fac_def rec_prime_def
- rec_Minr.simps Let_def get_fstn_args.simps
- arity.simps
- rec_all.simps rec_sigma.simps rec_accum.simps)
-apply(tactic {* resolve_tac [@{thm prime_cn},
- @{thm prime_id}, @{thm prime_pr}] 1*}, auto+)+
-apply(simp add: rec_dummyfac_def)
-apply(tactic {* resolve_tac [@{thm prime_cn},
- @{thm prime_id}, @{thm prime_pr}] 1*}, auto+)+
-done
-
-lemma [intro]: "primerec rec_trpl (Suc (Suc (Suc 0)))"
-apply(simp add: rec_trpl_def)
-apply(tactic {* resolve_tac [@{thm prime_cn},
- @{thm prime_id}, @{thm prime_pr}] 1*}, auto+)+
-done
-
-lemma [intro!]: "\<lbrakk>0 < vl; n \<le> vl\<rbrakk> \<Longrightarrow> primerec (rec_listsum2 vl n) vl"
-apply(induct n)
-apply(simp_all add: rec_strt'.simps Let_def rec_listsum2.simps)
-apply(tactic {* resolve_tac [@{thm prime_cn},
- @{thm prime_id}, @{thm prime_pr}] 1*}, auto+)+
-done
-
-lemma [elim]: "\<lbrakk>0 < vl; n \<le> vl\<rbrakk> \<Longrightarrow> primerec (rec_strt' vl n) vl"
-apply(induct n)
-apply(simp_all add: rec_strt'.simps Let_def)
-apply(tactic {* resolve_tac [@{thm prime_cn},
- @{thm prime_id}, @{thm prime_pr}] 1*}, auto+)
-done
-
-lemma [elim]: "vl > 0 \<Longrightarrow> primerec (rec_strt vl) vl"
-apply(simp add: rec_strt.simps rec_strt'.simps)
-apply(tactic {* resolve_tac [@{thm prime_cn},
- @{thm prime_id}, @{thm prime_pr}] 1*}, auto+)+
-done
-
-lemma [elim]:
- "i < vl \<Longrightarrow> primerec ((map (\<lambda>i. recf.id (Suc vl) (i))
- [Suc 0..<vl] @ [recf.id (Suc vl) (vl)]) ! i) (Suc vl)"
-apply(induct i, auto simp: nth_append)
-done
-
-lemma [intro]: "primerec rec_newleft0 ((Suc (Suc 0)))"
-apply(simp add: rec_newleft_def rec_embranch.simps
- Let_def arity.simps rec_newleft0_def
- rec_newleft1_def rec_newleft2_def rec_newleft3_def)
-apply(tactic {* resolve_tac [@{thm prime_cn},
- @{thm prime_id}, @{thm prime_pr}] 1*}, auto+)+
-done
-
-lemma [intro]: "primerec rec_newleft1 ((Suc (Suc 0)))"
-apply(simp add: rec_newleft_def rec_embranch.simps
- Let_def arity.simps rec_newleft0_def
- rec_newleft1_def rec_newleft2_def rec_newleft3_def)
-apply(tactic {* resolve_tac [@{thm prime_cn},
- @{thm prime_id}, @{thm prime_pr}] 1*}, auto+)+
-done
-
-lemma [intro]: "primerec rec_newleft2 ((Suc (Suc 0)))"
-apply(simp add: rec_newleft_def rec_embranch.simps
- Let_def arity.simps rec_newleft0_def
- rec_newleft1_def rec_newleft2_def rec_newleft3_def)
-apply(tactic {* resolve_tac [@{thm prime_cn},
- @{thm prime_id}, @{thm prime_pr}] 1*}, auto+)+
-done
-
-lemma [intro]: "primerec rec_newleft3 ((Suc (Suc 0)))"
-apply(simp add: rec_newleft_def rec_embranch.simps
- Let_def arity.simps rec_newleft0_def
- rec_newleft1_def rec_newleft2_def rec_newleft3_def)
-apply(tactic {* resolve_tac [@{thm prime_cn},
- @{thm prime_id}, @{thm prime_pr}] 1*}, auto+)+
-done
-
-lemma [intro]: "primerec rec_newleft (Suc (Suc (Suc 0)))"
-apply(simp add: rec_newleft_def rec_embranch.simps
- Let_def arity.simps)
-apply(rule_tac prime_cn, auto+)
-done
-
-lemma [intro]: "primerec rec_left (Suc 0)"
-apply(simp add: rec_left_def rec_lo_def rec_entry_def Let_def)
-apply(tactic {* resolve_tac [@{thm prime_cn},
- @{thm prime_id}, @{thm prime_pr}] 1*}, auto+)+
-done
-
-lemma [intro]: "primerec rec_actn (Suc (Suc (Suc 0)))"
-apply(simp add: rec_left_def rec_lo_def rec_entry_def
- Let_def rec_actn_def)
-apply(tactic {* resolve_tac [@{thm prime_cn},
- @{thm prime_id}, @{thm prime_pr}] 1*}, auto+)+
-done
-
-lemma [intro]: "primerec rec_stat (Suc 0)"
-apply(simp add: rec_left_def rec_lo_def rec_entry_def Let_def
- rec_actn_def rec_stat_def)
-apply(tactic {* resolve_tac [@{thm prime_cn},
- @{thm prime_id}, @{thm prime_pr}] 1*}, auto+)+
-done
-
-lemma [intro]: "primerec rec_newstat (Suc (Suc (Suc 0)))"
-apply(simp add: rec_left_def rec_lo_def rec_entry_def
- Let_def rec_actn_def rec_stat_def rec_newstat_def)
-apply(tactic {* resolve_tac [@{thm prime_cn},
- @{thm prime_id}, @{thm prime_pr}] 1*}, auto+)+
-done
-
-lemma [intro]: "primerec rec_newrght (Suc (Suc (Suc 0)))"
-apply(simp add: rec_newrght_def rec_embranch.simps
- Let_def arity.simps rec_newrgt0_def
- rec_newrgt1_def rec_newrgt2_def rec_newrgt3_def)
-apply(tactic {* resolve_tac [@{thm prime_cn},
- @{thm prime_id}, @{thm prime_pr}] 1*}, auto+)+
-done
-
-lemma [intro]: "primerec rec_newconf (Suc (Suc 0))"
-apply(simp add: rec_newconf_def)
-apply(tactic {* resolve_tac [@{thm prime_cn},
- @{thm prime_id}, @{thm prime_pr}] 1*}, auto+)+
-done
-
-lemma [intro]: "0 < vl \<Longrightarrow> primerec (rec_inpt (Suc vl)) (Suc vl)"
-apply(simp add: rec_inpt_def)
-apply(tactic {* resolve_tac [@{thm prime_cn},
- @{thm prime_id}, @{thm prime_pr}] 1*}, auto+)+
-done
-
-lemma [intro]: "primerec rec_conf (Suc (Suc (Suc 0)))"
-apply(simp add: rec_conf_def)
-apply(tactic {* resolve_tac [@{thm prime_cn},
- @{thm prime_id}, @{thm prime_pr}] 1*}, auto+)+
-apply(auto simp: numeral_4_eq_4)
-done
-
-lemma [simp]:
- "rec_calc_rel rec_conf [m, r, t] rs =
- (rec_exec rec_conf [m, r, t] = rs)"
-apply(rule_tac prime_rel_exec_eq, auto)
-done
-
-lemma [intro]: "primerec rec_lg (Suc (Suc 0))"
-apply(simp add: rec_lg_def Let_def)
-apply(tactic {* resolve_tac [@{thm prime_cn},
- @{thm prime_id}, @{thm prime_pr}] 1*}, auto+)+
-done
-
-lemma [intro]: "primerec rec_nonstop (Suc (Suc (Suc 0)))"
-apply(simp add: rec_nonstop_def rec_NSTD_def rec_stat_def
- rec_lo_def Let_def rec_left_def rec_right_def rec_newconf_def
- rec_newstat_def)
-apply(tactic {* resolve_tac [@{thm prime_cn},
- @{thm prime_id}, @{thm prime_pr}] 1*}, auto+)+
-done
-
-lemma nonstop_eq[simp]:
- "rec_calc_rel rec_nonstop [m, r, t] rs =
- (rec_exec rec_nonstop [m, r, t] = rs)"
-apply(rule prime_rel_exec_eq, auto)
-done
-
-lemma halt_lemma':
- "rec_calc_rel rec_halt [m, r] t =
- (rec_calc_rel rec_nonstop [m, r, t] 0 \<and>
- (\<forall> t'< t.
- (\<exists> y. rec_calc_rel rec_nonstop [m, r, t'] y \<and>
- y \<noteq> 0)))"
-apply(auto simp: rec_halt_def)
-apply(erule calc_mn_reverse, simp)
-apply(erule_tac calc_mn_reverse)
-apply(erule_tac x = t' in allE, simp)
-apply(rule_tac calc_mn, simp_all)
-done
-
-text {*
- The following lemma gives the correctness of @{text "rec_halt"}.
- It says: if @{text "rec_halt"} calculates that the TM coded by @{text "m"}
- will reach a standard final configuration after @{text "t"} steps of execution, then it is indeed so.
- *}
-lemma halt_lemma:
- "rec_calc_rel (rec_halt) [m, r] t =
- (rec_exec rec_nonstop [m, r, t] = 0 \<and>
- (\<forall> t'< t. (\<exists> y. rec_exec rec_nonstop [m, r, t'] = y
- \<and> y \<noteq> 0)))"
-using halt_lemma'[of m r t]
-by simp
-
-text {*F: universal machine*}
-
-text {*
- @{text "valu r"} extracts computing result out of the right number @{text "r"}.
- *}
-fun valu :: "nat \<Rightarrow> nat"
- where
- "valu r = (lg (r + 1) 2) - 1"
-
-text {*
- @{text "rec_valu"} is the recursive function implementing @{text "valu"}.
-*}
-definition rec_valu :: "recf"
- where
- "rec_valu = Cn 1 rec_minus [Cn 1 rec_lg [s, constn 2], constn 1]"
-
-text {*
- The correctness of @{text "rec_valu"}.
-*}
-lemma value_lemma: "rec_exec rec_valu [r] = valu r"
-apply(simp add: rec_exec.simps rec_valu_def lg_lemma)
-done
-
-lemma [intro]: "primerec rec_valu (Suc 0)"
-apply(simp add: rec_valu_def)
-apply(rule_tac k = "Suc (Suc 0)" in prime_cn)
-apply(auto simp: prime_s)
-proof -
- show "primerec rec_lg (Suc (Suc 0))" by auto
-next
- show "Suc (Suc 0) = Suc (Suc 0)" by simp
-next
- show "primerec (constn (Suc (Suc 0))) (Suc 0)" by auto
-qed
-
-lemma [simp]: "rec_calc_rel rec_valu [r] rs =
- (rec_exec rec_valu [r] = rs)"
-apply(rule_tac prime_rel_exec_eq, auto)
-done
-
-declare valu.simps[simp del]
-
-text {*
- The definition of the universal function @{text "rec_F"}.
- *}
-definition rec_F :: "recf"
- where
- "rec_F = Cn (Suc (Suc 0)) rec_valu [Cn (Suc (Suc 0)) rec_right [Cn (Suc (Suc 0))
- rec_conf ([id (Suc (Suc 0)) 0, id (Suc (Suc 0)) (Suc 0), rec_halt])]]"
-
-lemma get_fstn_args_nth:
- "k < n \<Longrightarrow> (get_fstn_args m n ! k) = id m (k)"
-apply(induct n, simp)
-apply(case_tac "k = n", simp_all add: get_fstn_args.simps
- nth_append)
-done
-
-lemma [simp]:
- "\<lbrakk>ys \<noteq> []; k < length ys\<rbrakk> \<Longrightarrow>
- (get_fstn_args (length ys) (length ys) ! k) =
- id (length ys) (k)"
-by(erule_tac get_fstn_args_nth)
-
-lemma calc_rel_get_pren:
- "\<lbrakk>ys \<noteq> []; k < length ys\<rbrakk> \<Longrightarrow>
- rec_calc_rel (get_fstn_args (length ys) (length ys) ! k) ys
- (ys ! k)"
-apply(simp)
-apply(rule_tac calc_id, auto)
-done
-
-lemma [elim]:
- "\<lbrakk>xs \<noteq> []; k < Suc (length xs)\<rbrakk> \<Longrightarrow>
- rec_calc_rel (get_fstn_args (Suc (length xs))
- (Suc (length xs)) ! k) (m # xs) ((m # xs) ! k)"
-using calc_rel_get_pren[of "m#xs" k]
-apply(simp)
-done
-
-text {*
- The correctness of @{text "rec_F"}, halt case.
- *}
-lemma F_lemma:
- "rec_calc_rel rec_halt [m, r] t \<Longrightarrow>
- rec_calc_rel rec_F [m, r] (valu (rght (conf m r t)))"
-apply(simp add: rec_F_def)
-apply(rule_tac rs = "[rght (conf m r t)]" in calc_cn,
- auto simp: value_lemma)
-apply(rule_tac rs = "[conf m r t]" in calc_cn,
- auto simp: right_lemma)
-apply(rule_tac rs = "[m, r, t]" in calc_cn, auto)
-apply(subgoal_tac " k = 0 \<or> k = Suc 0 \<or> k = Suc (Suc 0)",
- auto simp:nth_append)
-apply(rule_tac [1-2] calc_id, simp_all add: conf_lemma)
-done
-
-
-text {*
- The correctness of @{text "rec_F"}, nonhalt case.
- *}
-lemma F_lemma2:
- "\<forall> t. \<not> rec_calc_rel rec_halt [m, r] t \<Longrightarrow>
- \<forall> rs. \<not> rec_calc_rel rec_F [m, r] rs"
-apply(auto simp: rec_F_def)
-apply(erule_tac calc_cn_reverse, simp (no_asm_use))+
-proof -
- fix rs rsa rsb rsc
- assume h:
- "\<forall>t. \<not> rec_calc_rel rec_halt [m, r] t"
- "length rsa = Suc 0"
- "rec_calc_rel rec_valu rsa rs"
- "length rsb = Suc 0"
- "rec_calc_rel rec_right rsb (rsa ! 0)"
- "length rsc = (Suc (Suc (Suc 0)))"
- "rec_calc_rel rec_conf rsc (rsb ! 0)"
- and g: "\<forall>k<Suc (Suc (Suc 0)). rec_calc_rel ([recf.id (Suc (Suc 0)) 0,
- recf.id (Suc (Suc 0)) (Suc 0), rec_halt] ! k) [m, r] (rsc ! k)"
- have "rec_calc_rel (rec_halt ) [m, r]
- (rsc ! (Suc (Suc 0)))"
- using g
- apply(erule_tac x = "(Suc (Suc 0))" in allE)
- apply(simp add:nth_append)
- done
- thus "False"
- using h
- apply(erule_tac x = "ysb ! (Suc (Suc 0))" in allE, simp)
- done
-qed
-
-
-subsection {* Coding function of TMs *}
-
-text {*
- The purpose of this section is to get the coding function of Turing Machine, which is
- going to be named @{text "code"}.
- *}
-
-fun bl2nat :: "block list \<Rightarrow> nat \<Rightarrow> nat"
- where
- "bl2nat [] n = 0"
-| "bl2nat (Bk#bl) n = bl2nat bl (Suc n)"
-| "bl2nat (Oc#bl) n = 2^n + bl2nat bl (Suc n)"
-
-fun bl2wc :: "block list \<Rightarrow> nat"
- where
- "bl2wc xs = bl2nat xs 0"
-
-fun trpl_code :: "t_conf \<Rightarrow> nat"
- where
- "trpl_code (st, l, r) = trpl (bl2wc l) st (bl2wc r)"
-
-declare bl2nat.simps[simp del] bl2wc.simps[simp del]
- trpl_code.simps[simp del]
-
-fun action_map :: "taction \<Rightarrow> nat"
- where
- "action_map W0 = 0"
-| "action_map W1 = 1"
-| "action_map L = 2"
-| "action_map R = 3"
-| "action_map Nop = 4"
-
-fun action_map_iff :: "nat \<Rightarrow> taction"
- where
- "action_map_iff (0::nat) = W0"
-| "action_map_iff (Suc 0) = W1"
-| "action_map_iff (Suc (Suc 0)) = L"
-| "action_map_iff (Suc (Suc (Suc 0))) = R"
-| "action_map_iff n = Nop"
-
-fun block_map :: "block \<Rightarrow> nat"
- where
- "block_map Bk = 0"
-| "block_map Oc = 1"
-
-fun godel_code' :: "nat list \<Rightarrow> nat \<Rightarrow> nat"
- where
- "godel_code' [] n = 1"
-| "godel_code' (x#xs) n = (Pi n)^x * godel_code' xs (Suc n) "
-
-fun godel_code :: "nat list \<Rightarrow> nat"
- where
- "godel_code xs = (let lh = length xs in
- 2^lh * (godel_code' xs (Suc 0)))"
-
-fun modify_tprog :: "tprog \<Rightarrow> nat list"
- where
- "modify_tprog [] = []"
-| "modify_tprog ((ac, ns)#nl) = action_map ac # ns # modify_tprog nl"
-
-text {*
- @{text "code tp"} gives the Godel coding of TM program @{text "tp"}.
- *}
-fun code :: "tprog \<Rightarrow> nat"
- where
- "code tp = (let nl = modify_tprog tp in
- godel_code nl)"
-
-subsection {* Relating interperter functions to the execution of TMs *}
-
-lemma [simp]: "bl2wc [] = 0" by(simp add: bl2wc.simps bl2nat.simps)
-term trpl
-
-lemma [simp]: "\<lbrakk>fetch tp 0 b = (nact, ns)\<rbrakk> \<Longrightarrow> action_map nact = 4"
-apply(simp add: fetch.simps)
-done
-
-lemma Pi_gr_1[simp]: "Pi n > Suc 0"
-proof(induct n, auto simp: Pi.simps Np.simps)
- fix n
- let ?setx = "{y. y \<le> Suc (Pi n!) \<and> Pi n < y \<and> Prime y}"
- have "finite ?setx" by auto
- moreover have "?setx \<noteq> {}"
- using prime_ex[of "Pi n"]
- apply(auto)
- done
- ultimately show "Suc 0 < Min ?setx"
- apply(simp add: Min_gr_iff)
- apply(auto simp: Prime.simps)
- done
-qed
-
-lemma Pi_not_0[simp]: "Pi n > 0"
-using Pi_gr_1[of n]
-by arith
-
-declare godel_code.simps[simp del]
-
-lemma [simp]: "0 < godel_code' nl n"
-apply(induct nl arbitrary: n)
-apply(auto simp: godel_code'.simps)
-done
-
-lemma godel_code_great: "godel_code nl > 0"
-apply(simp add: godel_code.simps)
-done
-
-lemma godel_code_eq_1: "(godel_code nl = 1) = (nl = [])"
-apply(auto simp: godel_code.simps)
-done
-
-lemma [elim]:
- "\<lbrakk>i < length nl; \<not> Suc 0 < godel_code nl\<rbrakk> \<Longrightarrow> nl ! i = 0"
-using godel_code_great[of nl] godel_code_eq_1[of nl]
-apply(simp)
-done
-
-term set_of
-lemma prime_coprime: "\<lbrakk>Prime x; Prime y; x\<noteq>y\<rbrakk> \<Longrightarrow> coprime x y"
-proof(simp only: Prime.simps coprime_nat, auto simp: dvd_def,
- rule_tac classical, simp)
- fix d k ka
- assume case_ka: "\<forall>u<d * ka. \<forall>v<d * ka. u * v \<noteq> d * ka"
- and case_k: "\<forall>u<d * k. \<forall>v<d * k. u * v \<noteq> d * k"
- and h: "(0::nat) < d" "d \<noteq> Suc 0" "Suc 0 < d * ka"
- "ka \<noteq> k" "Suc 0 < d * k"
- from h have "k > Suc 0 \<or> ka >Suc 0"
- apply(auto)
- apply(case_tac ka, simp, simp)
- apply(case_tac k, simp, simp)
- done
- from this show "False"
- proof(erule_tac disjE)
- assume "(Suc 0::nat) < k"
- hence "k < d*k \<and> d < d*k"
- using h
- by(auto)
- thus "?thesis"
- using case_k
- apply(erule_tac x = d in allE)
- apply(simp)
- apply(erule_tac x = k in allE)
- apply(simp)
- done
- next
- assume "(Suc 0::nat) < ka"
- hence "ka < d * ka \<and> d < d*ka"
- using h by auto
- thus "?thesis"
- using case_ka
- apply(erule_tac x = d in allE)
- apply(simp)
- apply(erule_tac x = ka in allE)
- apply(simp)
- done
- qed
-qed
-
-lemma Pi_inc: "Pi (Suc i) > Pi i"
-proof(simp add: Pi.simps Np.simps)
- let ?setx = "{y. y \<le> Suc (Pi i!) \<and> Pi i < y \<and> Prime y}"
- have "finite ?setx" by simp
- moreover have "?setx \<noteq> {}"
- using prime_ex[of "Pi i"]
- apply(auto)
- done
- ultimately show "Pi i < Min ?setx"
- apply(simp add: Min_gr_iff)
- done
-qed
-
-lemma Pi_inc_gr: "i < j \<Longrightarrow> Pi i < Pi j"
-proof(induct j, simp)
- fix j
- assume ind: "i < j \<Longrightarrow> Pi i < Pi j"
- and h: "i < Suc j"
- from h show "Pi i < Pi (Suc j)"
- proof(cases "i < j")
- case True thus "?thesis"
- proof -
- assume "i < j"
- hence "Pi i < Pi j" by(erule_tac ind)
- moreover have "Pi j < Pi (Suc j)"
- apply(simp add: Pi_inc)
- done
- ultimately show "?thesis"
- by simp
- qed
- next
- assume "i < Suc j" "\<not> i < j"
- hence "i = j"
- by arith
- thus "Pi i < Pi (Suc j)"
- apply(simp add: Pi_inc)
- done
- qed
-qed
-
-lemma Pi_notEq: "i \<noteq> j \<Longrightarrow> Pi i \<noteq> Pi j"
-apply(case_tac "i < j")
-using Pi_inc_gr[of i j]
-apply(simp)
-using Pi_inc_gr[of j i]
-apply(simp)
-done
-
-lemma [intro]: "Prime (Suc (Suc 0))"
-apply(auto simp: Prime.simps)
-apply(case_tac u, simp, case_tac nat, simp, simp)
-done
-
-lemma Prime_Pi[intro]: "Prime (Pi n)"
-proof(induct n, auto simp: Pi.simps Np.simps)
- fix n
- let ?setx = "{y. y \<le> Suc (Pi n!) \<and> Pi n < y \<and> Prime y}"
- show "Prime (Min ?setx)"
- proof -
- have "finite ?setx" by simp
- moreover have "?setx \<noteq> {}"
- using prime_ex[of "Pi n"]
- apply(simp)
- done
- ultimately show "?thesis"
- apply(drule_tac Min_in, simp, simp)
- done
- qed
-qed
-
-lemma Pi_coprime: "i \<noteq> j \<Longrightarrow> coprime (Pi i) (Pi j)"
-using Prime_Pi[of i]
-using Prime_Pi[of j]
-apply(rule_tac prime_coprime, simp_all add: Pi_notEq)
-done
-
-lemma Pi_power_coprime: "i \<noteq> j \<Longrightarrow> coprime ((Pi i)^m) ((Pi j)^n)"
-by(rule_tac coprime_exp2_nat, erule_tac Pi_coprime)
-
-lemma coprime_dvd_mult_nat2: "\<lbrakk>coprime (k::nat) n; k dvd n * m\<rbrakk> \<Longrightarrow> k dvd m"
-apply(erule_tac coprime_dvd_mult_nat)
-apply(simp add: dvd_def, auto)
-apply(rule_tac x = ka in exI)
-apply(subgoal_tac "n * m = m * n", simp)
-apply(simp add: nat_mult_commute)
-done
-
-declare godel_code'.simps[simp del]
-
-lemma godel_code'_butlast_last_id' :
- "godel_code' (ys @ [y]) (Suc j) = godel_code' ys (Suc j) *
- Pi (Suc (length ys + j)) ^ y"
-proof(induct ys arbitrary: j, simp_all add: godel_code'.simps)
-qed
-
-lemma godel_code'_butlast_last_id:
-"xs \<noteq> [] \<Longrightarrow> godel_code' xs (Suc j) =
- godel_code' (butlast xs) (Suc j) * Pi (length xs + j)^(last xs)"
-apply(subgoal_tac "\<exists> ys y. xs = ys @ [y]")
-apply(erule_tac exE, erule_tac exE, simp add:
- godel_code'_butlast_last_id')
-apply(rule_tac x = "butlast xs" in exI)
-apply(rule_tac x = "last xs" in exI, auto)
-done
-
-lemma godel_code'_not0: "godel_code' xs n \<noteq> 0"
-apply(induct xs, auto simp: godel_code'.simps)
-done
-
-lemma godel_code_append_cons:
- "length xs = i \<Longrightarrow> godel_code' (xs@y#ys) (Suc 0)
- = godel_code' xs (Suc 0) * Pi (Suc i)^y * godel_code' ys (i + 2)"
-proof(induct "length xs" arbitrary: i y ys xs, simp add: godel_code'.simps,simp)
- fix x xs i y ys
- assume ind:
- "\<And>xs i y ys. \<lbrakk>x = i; length xs = i\<rbrakk> \<Longrightarrow>
- godel_code' (xs @ y # ys) (Suc 0)
- = godel_code' xs (Suc 0) * Pi (Suc i) ^ y *
- godel_code' ys (Suc (Suc i))"
- and h: "Suc x = i"
- "length (xs::nat list) = i"
- have
- "godel_code' (butlast xs @ last xs # ((y::nat)#ys)) (Suc 0) =
- godel_code' (butlast xs) (Suc 0) * Pi (Suc (i - 1))^(last xs)
- * godel_code' (y#ys) (Suc (Suc (i - 1)))"
- apply(rule_tac ind)
- using h
- by(auto)
- moreover have
- "godel_code' xs (Suc 0)= godel_code' (butlast xs) (Suc 0) *
- Pi (i)^(last xs)"
- using godel_code'_butlast_last_id[of xs] h
- apply(case_tac "xs = []", simp, simp)
- done
- moreover have "butlast xs @ last xs # y # ys = xs @ y # ys"
- using h
- apply(case_tac xs, auto)
- done
- ultimately show
- "godel_code' (xs @ y # ys) (Suc 0) =
- godel_code' xs (Suc 0) * Pi (Suc i) ^ y *
- godel_code' ys (Suc (Suc i))"
- using h
- apply(simp add: godel_code'_not0 Pi_not_0)
- apply(simp add: godel_code'.simps)
- done
-qed
-
-lemma Pi_coprime_pre:
- "length ps \<le> i \<Longrightarrow> coprime (Pi (Suc i)) (godel_code' ps (Suc 0))"
-proof(induct "length ps" arbitrary: ps, simp add: godel_code'.simps)
- fix x ps
- assume ind:
- "\<And>ps. \<lbrakk>x = length ps; length ps \<le> i\<rbrakk> \<Longrightarrow>
- coprime (Pi (Suc i)) (godel_code' ps (Suc 0))"
- and h: "Suc x = length ps"
- "length (ps::nat list) \<le> i"
- have g: "coprime (Pi (Suc i)) (godel_code' (butlast ps) (Suc 0))"
- apply(rule_tac ind)
- using h by auto
- have k: "godel_code' ps (Suc 0) =
- godel_code' (butlast ps) (Suc 0) * Pi (length ps)^(last ps)"
- using godel_code'_butlast_last_id[of ps 0] h
- by(case_tac ps, simp, simp)
- from g have
- "coprime (Pi (Suc i)) (godel_code' (butlast ps) (Suc 0) *
- Pi (length ps)^(last ps)) "
- proof(rule_tac coprime_mult_nat, simp)
- show "coprime (Pi (Suc i)) (Pi (length ps) ^ last ps)"
- apply(rule_tac coprime_exp_nat, rule prime_coprime, auto)
- using Pi_notEq[of "Suc i" "length ps"] h by simp
- qed
- from this and k show "coprime (Pi (Suc i)) (godel_code' ps (Suc 0))"
- by simp
-qed
-
-lemma Pi_coprime_suf: "i < j \<Longrightarrow> coprime (Pi i) (godel_code' ps j)"
-proof(induct "length ps" arbitrary: ps, simp add: godel_code'.simps)
- fix x ps
- assume ind:
- "\<And>ps. \<lbrakk>x = length ps; i < j\<rbrakk> \<Longrightarrow>
- coprime (Pi i) (godel_code' ps j)"
- and h: "Suc x = length (ps::nat list)" "i < j"
- have g: "coprime (Pi i) (godel_code' (butlast ps) j)"
- apply(rule ind) using h by auto
- have k: "(godel_code' ps j) = godel_code' (butlast ps) j *
- Pi (length ps + j - 1)^last ps"
- using h godel_code'_butlast_last_id[of ps "j - 1"]
- apply(case_tac "ps = []", simp, simp)
- done
- from g have
- "coprime (Pi i) (godel_code' (butlast ps) j *
- Pi (length ps + j - 1)^last ps)"
- apply(rule_tac coprime_mult_nat, simp)
- using Pi_power_coprime[of i "length ps + j - 1" 1 "last ps"] h
- apply(auto)
- done
- from k and this show "coprime (Pi i) (godel_code' ps j)"
- by auto
-qed
-
-lemma godel_finite:
- "finite {u. Pi (Suc i) ^ u dvd godel_code' nl (Suc 0)}"
-proof(rule_tac n = "godel_code' nl (Suc 0)" in
- bounded_nat_set_is_finite, auto,
- case_tac "ia < godel_code' nl (Suc 0)", auto)
- fix ia
- assume g1: "Pi (Suc i) ^ ia dvd godel_code' nl (Suc 0)"
- and g2: "\<not> ia < godel_code' nl (Suc 0)"
- from g1 have "Pi (Suc i)^ia \<le> godel_code' nl (Suc 0)"
- apply(erule_tac dvd_imp_le)
- using godel_code'_not0[of nl "Suc 0"] by simp
- moreover have "ia < Pi (Suc i)^ia"
- apply(rule x_less_exp)
- using Pi_gr_1 by auto
- ultimately show "False"
- using g2
- by(auto)
-qed
-
-
-lemma godel_code_in:
- "i < length nl \<Longrightarrow> nl ! i \<in> {u. Pi (Suc i) ^ u dvd
- godel_code' nl (Suc 0)}"
-proof -
- assume h: "i<length nl"
- hence "godel_code' (take i nl@(nl!i)#drop (Suc i) nl) (Suc 0)
- = godel_code' (take i nl) (Suc 0) * Pi (Suc i)^(nl!i) *
- godel_code' (drop (Suc i) nl) (i + 2)"
- by(rule_tac godel_code_append_cons, simp)
- moreover from h have "take i nl @ (nl ! i) # drop (Suc i) nl = nl"
- using upd_conv_take_nth_drop[of i nl "nl ! i"]
- apply(simp)
- done
- ultimately show
- "nl ! i \<in> {u. Pi (Suc i) ^ u dvd godel_code' nl (Suc 0)}"
- by(simp)
-qed
-
-lemma godel_code'_get_nth:
- "i < length nl \<Longrightarrow> Max {u. Pi (Suc i) ^ u dvd
- godel_code' nl (Suc 0)} = nl ! i"
-proof(rule_tac Max_eqI)
- let ?gc = "godel_code' nl (Suc 0)"
- assume h: "i < length nl" thus "finite {u. Pi (Suc i) ^ u dvd ?gc}"
- by (simp add: godel_finite)
-next
- fix y
- let ?suf ="godel_code' (drop (Suc i) nl) (i + 2)"
- let ?pref = "godel_code' (take i nl) (Suc 0)"
- assume h: "i < length nl"
- "y \<in> {u. Pi (Suc i) ^ u dvd godel_code' nl (Suc 0)}"
- moreover hence
- "godel_code' (take i nl@(nl!i)#drop (Suc i) nl) (Suc 0)
- = ?pref * Pi (Suc i)^(nl!i) * ?suf"
- by(rule_tac godel_code_append_cons, simp)
- moreover from h have "take i nl @ (nl!i) # drop (Suc i) nl = nl"
- using upd_conv_take_nth_drop[of i nl "nl!i"]
- by simp
- ultimately show "y\<le>nl!i"
- proof(simp)
- let ?suf' = "godel_code' (drop (Suc i) nl) (Suc (Suc i))"
- assume mult_dvd:
- "Pi (Suc i) ^ y dvd ?pref * Pi (Suc i) ^ nl ! i * ?suf'"
- hence "Pi (Suc i) ^ y dvd ?pref * Pi (Suc i) ^ nl ! i"
- proof(rule_tac coprime_dvd_mult_nat)
- show "coprime (Pi (Suc i)^y) ?suf'"
- proof -
- have "coprime (Pi (Suc i) ^ y) (?suf'^(Suc 0))"
- apply(rule_tac coprime_exp2_nat)
- apply(rule_tac Pi_coprime_suf, simp)
- done
- thus "?thesis" by simp
- qed
- qed
- hence "Pi (Suc i) ^ y dvd Pi (Suc i) ^ nl ! i"
- proof(rule_tac coprime_dvd_mult_nat2)
- show "coprime (Pi (Suc i) ^ y) ?pref"
- proof -
- have "coprime (Pi (Suc i)^y) (?pref^Suc 0)"
- apply(rule_tac coprime_exp2_nat)
- apply(rule_tac Pi_coprime_pre, simp)
- done
- thus "?thesis" by simp
- qed
- qed
- hence "Pi (Suc i) ^ y \<le> Pi (Suc i) ^ nl ! i "
- apply(rule_tac dvd_imp_le, auto)
- done
- thus "y \<le> nl ! i"
- apply(rule_tac power_le_imp_le_exp, auto)
- done
- qed
-next
- assume h: "i<length nl"
- thus "nl ! i \<in> {u. Pi (Suc i) ^ u dvd godel_code' nl (Suc 0)}"
- by(rule_tac godel_code_in, simp)
-qed
-
-lemma [simp]:
- "{u. Pi (Suc i) ^ u dvd (Suc (Suc 0)) ^ length nl *
- godel_code' nl (Suc 0)} =
- {u. Pi (Suc i) ^ u dvd godel_code' nl (Suc 0)}"
-apply(rule_tac Collect_cong, auto)
-apply(rule_tac n = " (Suc (Suc 0)) ^ length nl" in
- coprime_dvd_mult_nat2)
-proof -
- fix u
- show "coprime (Pi (Suc i) ^ u) ((Suc (Suc 0)) ^ length nl)"
- proof(rule_tac coprime_exp2_nat)
- have "Pi 0 = (2::nat)"
- apply(simp add: Pi.simps)
- done
- moreover have "coprime (Pi (Suc i)) (Pi 0)"
- apply(rule_tac Pi_coprime, simp)
- done
- ultimately show "coprime (Pi (Suc i)) (Suc (Suc 0))" by simp
- qed
-qed
-
-lemma godel_code_get_nth:
- "i < length nl \<Longrightarrow>
- Max {u. Pi (Suc i) ^ u dvd godel_code nl} = nl ! i"
-by(simp add: godel_code.simps godel_code'_get_nth)
-
-lemma "trpl l st r = godel_code' [l, st, r] 0"
-apply(simp add: trpl.simps godel_code'.simps)
-done
-
-lemma mod_dvd_simp: "(x mod y = (0::nat)) = (y dvd x)"
-by(simp add: dvd_def, auto)
-
-lemma dvd_power_le: "\<lbrakk>a > Suc 0; a ^ y dvd a ^ l\<rbrakk> \<Longrightarrow> y \<le> l"
-apply(case_tac "y \<le> l", simp, simp)
-apply(subgoal_tac "\<exists> d. y = l + d", auto simp: power_add)
-apply(rule_tac x = "y - l" in exI, simp)
-done
-
-
-lemma [elim]: "Pi n = 0 \<Longrightarrow> RR"
- using Pi_not_0[of n] by simp
-
-lemma [elim]: "Pi n = Suc 0 \<Longrightarrow> RR"
- using Pi_gr_1[of n] by simp
-
-lemma finite_power_dvd:
- "\<lbrakk>(a::nat) > Suc 0; y \<noteq> 0\<rbrakk> \<Longrightarrow> finite {u. a^u dvd y}"
-apply(auto simp: dvd_def)
-apply(rule_tac n = y in bounded_nat_set_is_finite, auto)
-apply(case_tac k, simp,simp)
-apply(rule_tac trans_less_add1)
-apply(erule_tac x_less_exp)
-done
-
-lemma conf_decode1: "\<lbrakk>m \<noteq> n; m \<noteq> k; k \<noteq> n\<rbrakk> \<Longrightarrow>
- Max {u. Pi m ^ u dvd Pi m ^ l * Pi n ^ st * Pi k ^ r} = l"
-proof -
- let ?setx = "{u. Pi m ^ u dvd Pi m ^ l * Pi n ^ st * Pi k ^ r}"
- assume g: "m \<noteq> n" "m \<noteq> k" "k \<noteq> n"
- show "Max ?setx = l"
- proof(rule_tac Max_eqI)
- show "finite ?setx"
- apply(rule_tac finite_power_dvd, auto simp: Pi_gr_1)
- done
- next
- fix y
- assume h: "y \<in> ?setx"
- have "Pi m ^ y dvd Pi m ^ l"
- proof -
- have "Pi m ^ y dvd Pi m ^ l * Pi n ^ st"
- using h g
- apply(rule_tac n = "Pi k^r" in coprime_dvd_mult_nat)
- apply(rule Pi_power_coprime, simp, simp)
- done
- thus "Pi m^y dvd Pi m^l"
- apply(rule_tac n = " Pi n ^ st" in coprime_dvd_mult_nat)
- using g
- apply(rule_tac Pi_power_coprime, simp, simp)
- done
- qed
- thus "y \<le> (l::nat)"
- apply(rule_tac a = "Pi m" in power_le_imp_le_exp)
- apply(simp_all add: Pi_gr_1)
- apply(rule_tac dvd_power_le, auto)
- done
- next
- show "l \<in> ?setx" by simp
- qed
-qed
-
-lemma conf_decode2:
- "\<lbrakk>m \<noteq> n; m \<noteq> k; n \<noteq> k;
- \<not> Suc 0 < Pi m ^ l * Pi n ^ st * Pi k ^ r\<rbrakk> \<Longrightarrow> l = 0"
-apply(case_tac "Pi m ^ l * Pi n ^ st * Pi k ^ r", auto)
-done
-
-lemma [simp]: "left (trpl l st r) = l"
-apply(simp add: left.simps trpl.simps lo.simps
- loR.simps mod_dvd_simp, auto simp: conf_decode1)
-apply(case_tac "Pi 0 ^ l * Pi (Suc 0) ^ st * Pi (Suc (Suc 0)) ^ r",
- auto)
-apply(erule_tac x = l in allE, auto)
-done
-
-lemma [simp]: "stat (trpl l st r) = st"
-apply(simp add: stat.simps trpl.simps lo.simps
- loR.simps mod_dvd_simp, auto)
-apply(subgoal_tac "Pi 0 ^ l * Pi (Suc 0) ^ st * Pi (Suc (Suc 0)) ^ r
- = Pi (Suc 0)^st * Pi 0 ^ l * Pi (Suc (Suc 0)) ^ r")
-apply(simp (no_asm_simp) add: conf_decode1, simp)
-apply(case_tac "Pi 0 ^ l * Pi (Suc 0) ^ st *
- Pi (Suc (Suc 0)) ^ r", auto)
-apply(erule_tac x = st in allE, auto)
-done
-
-lemma [simp]: "rght (trpl l st r) = r"
-apply(simp add: rght.simps trpl.simps lo.simps
- loR.simps mod_dvd_simp, auto)
-apply(subgoal_tac "Pi 0 ^ l * Pi (Suc 0) ^ st * Pi (Suc (Suc 0)) ^ r
- = Pi (Suc (Suc 0))^r * Pi 0 ^ l * Pi (Suc 0) ^ st")
-apply(simp (no_asm_simp) add: conf_decode1, simp)
-apply(case_tac "Pi 0 ^ l * Pi (Suc 0) ^ st * Pi (Suc (Suc 0)) ^ r",
- auto)
-apply(erule_tac x = r in allE, auto)
-done
-
-lemma max_lor:
- "i < length nl \<Longrightarrow> Max {u. loR [godel_code nl, Pi (Suc i), u]}
- = nl ! i"
-apply(simp add: loR.simps godel_code_get_nth mod_dvd_simp)
-done
-
-lemma godel_decode:
- "i < length nl \<Longrightarrow> Entry (godel_code nl) i = nl ! i"
-apply(auto simp: Entry.simps lo.simps max_lor)
-apply(erule_tac x = "nl!i" in allE)
-using max_lor[of i nl] godel_finite[of i nl]
-apply(simp)
-apply(drule_tac Max_in, auto simp: loR.simps
- godel_code.simps mod_dvd_simp)
-using godel_code_in[of i nl]
-apply(simp)
-done
-
-lemma Four_Suc: "4 = Suc (Suc (Suc (Suc 0)))"
-by auto
-
-declare numeral_2_eq_2[simp del]
-
-lemma modify_tprog_fetch_even:
- "\<lbrakk>st \<le> length tp div 2; st > 0\<rbrakk> \<Longrightarrow>
- modify_tprog tp ! (4 * (st - Suc 0) ) =
- action_map (fst (tp ! (2 * (st - Suc 0))))"
-proof(induct st arbitrary: tp, simp)
- fix tp st
- assume ind:
- "\<And>tp. \<lbrakk>st \<le> length tp div 2; 0 < st\<rbrakk> \<Longrightarrow>
- modify_tprog tp ! (4 * (st - Suc 0)) =
- action_map (fst ((tp::tprog) ! (2 * (st - Suc 0))))"
- and h: "Suc st \<le> length (tp::tprog) div 2" "0 < Suc st"
- thus "modify_tprog tp ! (4 * (Suc st - Suc 0)) =
- action_map (fst (tp ! (2 * (Suc st - Suc 0))))"
- proof(cases "st = 0")
- case True thus "?thesis"
- using h
- apply(auto)
- apply(cases tp, simp, case_tac a, simp add: modify_tprog.simps)
- done
- next
- case False
- assume g: "st \<noteq> 0"
- hence "\<exists> aa ab ba bb tp'. tp = (aa, ab) # (ba, bb) # tp'"
- using h
- apply(case_tac tp, simp, case_tac list, simp, simp)
- done
- from this obtain aa ab ba bb tp' where g1:
- "tp = (aa, ab) # (ba, bb) # tp'" by blast
- hence g2:
- "modify_tprog tp' ! (4 * (st - Suc 0)) =
- action_map (fst ((tp'::tprog) ! (2 * (st - Suc 0))))"
- apply(rule_tac ind)
- using h g by auto
- thus "?thesis"
- using g1 g
- apply(case_tac st, simp, simp add: Four_Suc)
- done
- qed
-qed
-
-lemma modify_tprog_fetch_odd:
- "\<lbrakk>st \<le> length tp div 2; st > 0\<rbrakk> \<Longrightarrow>
- modify_tprog tp ! (Suc (Suc (4 * (st - Suc 0)))) =
- action_map (fst (tp ! (Suc (2 * (st - Suc 0)))))"
-proof(induct st arbitrary: tp, simp)
- fix tp st
- assume ind:
- "\<And>tp. \<lbrakk>st \<le> length tp div 2; 0 < st\<rbrakk> \<Longrightarrow>
- modify_tprog tp ! Suc (Suc (4 * (st - Suc 0))) =
- action_map (fst (tp ! Suc (2 * (st - Suc 0))))"
- and h: "Suc st \<le> length (tp::tprog) div 2" "0 < Suc st"
- thus "modify_tprog tp ! Suc (Suc (4 * (Suc st - Suc 0)))
- = action_map (fst (tp ! Suc (2 * (Suc st - Suc 0))))"
- proof(cases "st = 0")
- case True thus "?thesis"
- using h
- apply(auto)
- apply(cases tp, simp, case_tac a, simp add: modify_tprog.simps)
- apply(case_tac list, simp, case_tac ab,
- simp add: modify_tprog.simps)
- done
- next
- case False
- assume g: "st \<noteq> 0"
- hence "\<exists> aa ab ba bb tp'. tp = (aa, ab) # (ba, bb) # tp'"
- using h
- apply(case_tac tp, simp, case_tac list, simp, simp)
- done
- from this obtain aa ab ba bb tp' where g1:
- "tp = (aa, ab) # (ba, bb) # tp'" by blast
- hence g2: "modify_tprog tp' ! Suc (Suc (4 * (st - Suc 0))) =
- action_map (fst (tp' ! Suc (2 * (st - Suc 0))))"
- apply(rule_tac ind)
- using h g by auto
- thus "?thesis"
- using g1 g
- apply(case_tac st, simp, simp add: Four_Suc)
- done
- qed
-qed
-
-lemma modify_tprog_fetch_action:
- "\<lbrakk>st \<le> length tp div 2; st > 0; b = 1 \<or> b = 0\<rbrakk> \<Longrightarrow>
- modify_tprog tp ! (4 * (st - Suc 0) + 2* b) =
- action_map (fst (tp ! ((2 * (st - Suc 0)) + b)))"
-apply(erule_tac disjE, auto elim: modify_tprog_fetch_odd
- modify_tprog_fetch_even)
-done
-
-lemma length_modify: "length (modify_tprog tp) = 2 * length tp"
-apply(induct tp, auto)
-done
-
-declare fetch.simps[simp del]
-
-lemma fetch_action_eq:
- "\<lbrakk>block_map b = scan r; fetch tp st b = (nact, ns);
- st \<le> length tp div 2\<rbrakk> \<Longrightarrow> actn (code tp) st r = action_map nact"
-proof(simp add: actn.simps, auto)
- let ?i = "4 * (st - Suc 0) + 2 * (r mod 2)"
- assume h: "block_map b = r mod 2" "fetch tp st b = (nact, ns)"
- "st \<le> length tp div 2" "0 < st"
- have "?i < length (modify_tprog tp)"
- proof -
- have "length (modify_tprog tp) = 2 * length tp"
- by(simp add: length_modify)
- thus "?thesis"
- using h
- by(auto)
- qed
- hence
- "Entry (godel_code (modify_tprog tp))?i =
- (modify_tprog tp) ! ?i"
- by(erule_tac godel_decode)
- moreover have
- "modify_tprog tp ! ?i =
- action_map (fst (tp ! (2 * (st - Suc 0) + r mod 2)))"
- apply(rule_tac modify_tprog_fetch_action)
- using h
- by(auto)
- moreover have "(fst (tp ! (2 * (st - Suc 0) + r mod 2))) = nact"
- using h
- apply(simp add: fetch.simps nth_of.simps)
- apply(case_tac b, auto simp: block_map.simps nth_of.simps split: if_splits)
- done
- ultimately show
- "Entry (godel_code (modify_tprog tp))
- (4 * (st - Suc 0) + 2 * (r mod 2))
- = action_map nact"
- by simp
-qed
-
-lemma [simp]: "fetch tp 0 b = (nact, ns) \<Longrightarrow> ns = 0"
-by(simp add: fetch.simps)
-
-lemma Five_Suc: "5 = Suc 4" by simp
-
-lemma modify_tprog_fetch_state:
- "\<lbrakk>st \<le> length tp div 2; st > 0; b = 1 \<or> b = 0\<rbrakk> \<Longrightarrow>
- modify_tprog tp ! Suc (4 * (st - Suc 0) + 2 * b) =
- (snd (tp ! (2 * (st - Suc 0) + b)))"
-proof(induct st arbitrary: tp, simp)
- fix st tp
- assume ind:
- "\<And>tp. \<lbrakk>st \<le> length tp div 2; 0 < st; b = 1 \<or> b = 0\<rbrakk> \<Longrightarrow>
- modify_tprog tp ! Suc (4 * (st - Suc 0) + 2 * b) =
- snd (tp ! (2 * (st - Suc 0) + b))"
- and h:
- "Suc st \<le> length (tp::tprog) div 2"
- "0 < Suc st"
- "b = 1 \<or> b = 0"
- show "modify_tprog tp ! Suc (4 * (Suc st - Suc 0) + 2 * b) =
- snd (tp ! (2 * (Suc st - Suc 0) + b))"
- proof(cases "st = 0")
- case True
- thus "?thesis"
- using h
- apply(cases tp, simp, case_tac a, simp add: modify_tprog.simps)
- apply(case_tac list, simp, case_tac ab,
- simp add: modify_tprog.simps, auto)
- done
- next
- case False
- assume g: "st \<noteq> 0"
- hence "\<exists> aa ab ba bb tp'. tp = (aa, ab) # (ba, bb) # tp'"
- using h
- apply(case_tac tp, simp, case_tac list, simp, simp)
- done
- from this obtain aa ab ba bb tp' where g1:
- "tp = (aa, ab) # (ba, bb) # tp'" by blast
- hence g2:
- "modify_tprog tp' ! Suc (4 * (st - Suc 0) + 2 * b) =
- snd (tp' ! (2 * (st - Suc 0) + b))"
- apply(rule_tac ind)
- using h g by auto
- thus "?thesis"
- using g1 g
- apply(case_tac st, simp, simp)
- done
- qed
-qed
-
-lemma fetch_state_eq:
- "\<lbrakk>block_map b = scan r;
- fetch tp st b = (nact, ns);
- st \<le> length tp div 2\<rbrakk> \<Longrightarrow> newstat (code tp) st r = ns"
-proof(simp add: newstat.simps, auto)
- let ?i = "Suc (4 * (st - Suc 0) + 2 * (r mod 2))"
- assume h: "block_map b = r mod 2" "fetch tp st b =
- (nact, ns)" "st \<le> length tp div 2" "0 < st"
- have "?i < length (modify_tprog tp)"
- proof -
- have "length (modify_tprog tp) = 2 * length tp"
- apply(simp add: length_modify)
- done
- thus "?thesis"
- using h
- by(auto)
- qed
- hence "Entry (godel_code (modify_tprog tp)) (?i) =
- (modify_tprog tp) ! ?i"
- by(erule_tac godel_decode)
- moreover have
- "modify_tprog tp ! ?i =
- (snd (tp ! (2 * (st - Suc 0) + r mod 2)))"
- apply(rule_tac modify_tprog_fetch_state)
- using h
- by(auto)
- moreover have "(snd (tp ! (2 * (st - Suc 0) + r mod 2))) = ns"
- using h
- apply(simp add: fetch.simps nth_of.simps)
- apply(case_tac b, auto simp: block_map.simps nth_of.simps
- split: if_splits)
- done
- ultimately show "Entry (godel_code (modify_tprog tp)) (?i)
- = ns"
- by simp
-qed
-
-
-lemma [intro!]:
- "\<lbrakk>a = a'; b = b'; c = c'\<rbrakk> \<Longrightarrow> trpl a b c = trpl a' b' c'"
-by simp
-
-lemma [simp]: "bl2wc [Bk] = 0"
-by(simp add: bl2wc.simps bl2nat.simps)
-
-lemma bl2nat_double: "bl2nat xs (Suc n) = 2 * bl2nat xs n"
-proof(induct xs arbitrary: n)
- case Nil thus "?case"
- by(simp add: bl2nat.simps)
-next
- case (Cons x xs) thus "?case"
- proof -
- assume ind: "\<And>n. bl2nat xs (Suc n) = 2 * bl2nat xs n "
- show "bl2nat (x # xs) (Suc n) = 2 * bl2nat (x # xs) n"
- proof(cases x)
- case Bk thus "?thesis"
- apply(simp add: bl2nat.simps)
- using ind[of "Suc n"] by simp
- next
- case Oc thus "?thesis"
- apply(simp add: bl2nat.simps)
- using ind[of "Suc n"] by simp
- qed
- qed
-qed
-
-
-lemma [simp]: "c \<noteq> [] \<Longrightarrow> 2 * bl2wc (tl c) = bl2wc c - bl2wc c mod 2 "
-apply(case_tac c, simp, case_tac a)
-apply(auto simp: bl2wc.simps bl2nat.simps bl2nat_double)
-done
-
-lemma [simp]:
- "c \<noteq> [] \<Longrightarrow> bl2wc (Oc # tl c) = Suc (bl2wc c) - bl2wc c mod 2 "
-apply(case_tac c, simp, case_tac a)
-apply(auto simp: bl2wc.simps bl2nat.simps bl2nat_double)
-done
-
-lemma [simp]: "bl2wc (Bk # c) = 2*bl2wc (c)"
-apply(simp add: bl2wc.simps bl2nat.simps bl2nat_double)
-done
-
-lemma [simp]: "bl2wc [Oc] = Suc 0"
- by(simp add: bl2wc.simps bl2nat.simps)
-
-lemma [simp]: "b \<noteq> [] \<Longrightarrow> bl2wc (tl b) = bl2wc b div 2"
-apply(case_tac b, simp, case_tac a)
-apply(auto simp: bl2wc.simps bl2nat.simps bl2nat_double)
-done
-
-lemma [simp]: "b \<noteq> [] \<Longrightarrow> bl2wc ([hd b]) = bl2wc b mod 2"
-apply(case_tac b, simp, case_tac a)
-apply(auto simp: bl2wc.simps bl2nat.simps bl2nat_double)
-done
-
-lemma [simp]: "\<lbrakk>b \<noteq> []; c \<noteq> []\<rbrakk> \<Longrightarrow> bl2wc (hd b # c) = 2 * bl2wc c + bl2wc b mod 2"
-apply(case_tac b, simp, case_tac a)
-apply(auto simp: bl2wc.simps bl2nat.simps bl2nat_double)
-done
-
-lemma [simp]: " 2 * (bl2wc c div 2) = bl2wc c - bl2wc c mod 2"
- by(simp add: mult_div_cancel)
-
-lemma [simp]: "bl2wc (Oc # list) mod 2 = Suc 0"
- by(simp add: bl2wc.simps bl2nat.simps bl2nat_double)
-
-
-declare code.simps[simp del]
-declare nth_of.simps[simp del]
-declare new_tape.simps[simp del]
-
-text {*
- The lemma relates the one step execution of TMs with the interpreter function @{text "rec_newconf"}.
- *}
-lemma rec_t_eq_step:
- "(\<lambda> (s, l, r). s \<le> length tp div 2) c \<Longrightarrow>
- trpl_code (tstep c tp) =
- rec_exec rec_newconf [code tp, trpl_code c]"
-apply(cases c, auto simp: tstep.simps)
-proof(case_tac "fetch tp a (case c of [] \<Rightarrow> Bk | x # xs \<Rightarrow> x)",
- simp add: newconf.simps trpl_code.simps)
- fix a b c aa ba
- assume h: "(a::nat) \<le> length tp div 2"
- "fetch tp a (case c of [] \<Rightarrow> Bk | x # xs \<Rightarrow> x) = (aa, ba)"
- moreover hence "actn (code tp) a (bl2wc c) = action_map aa"
- apply(rule_tac b = "(case c of [] \<Rightarrow> Bk | x # xs \<Rightarrow> x)"
- in fetch_action_eq, auto)
- apply(auto split: list.splits)
- apply(case_tac ab, auto)
- done
- moreover from h have "(newstat (code tp) a (bl2wc c)) = ba"
- apply(rule_tac b = "(case c of [] \<Rightarrow> Bk | x # xs \<Rightarrow> x)"
- in fetch_state_eq, auto split: list.splits)
- apply(case_tac ab, auto)
- done
- ultimately show
- "trpl_code (ba, new_tape aa (b, c)) =
- trpl (newleft (bl2wc b) (bl2wc c) (actn (code tp) a (bl2wc c)))
- (newstat (code tp) a (bl2wc c)) (newrght (bl2wc b) (bl2wc c)
- (actn (code tp) a (bl2wc c)))"
- by(auto simp: new_tape.simps trpl_code.simps
- newleft.simps newrght.simps split: taction.splits)
-qed
-
-lemma [simp]: "a\<^bsup>0\<^esup> = []"
-apply(simp add: exp_zero)
-done
-lemma [simp]: "bl2nat (Oc # Oc\<^bsup>x\<^esup>) 0 = (2 * 2 ^ x - Suc 0)"
-apply(induct x)
-apply(simp add: bl2nat.simps)
-apply(simp add: bl2nat.simps bl2nat_double exp_ind_def)
-done
-
-lemma [simp]: "bl2nat (Oc\<^bsup>y\<^esup>) 0 = 2^y - Suc 0"
-apply(induct y, auto simp: bl2nat.simps exp_ind_def bl2nat_double)
-apply(case_tac "(2::nat)^y", auto)
-done
-
-lemma [simp]: "bl2nat (Bk\<^bsup>l\<^esup>) n = 0"
-apply(induct l, auto simp: bl2nat.simps bl2nat_double exp_ind_def)
-done
-
-lemma bl2nat_cons_bk: "bl2nat (ks @ [Bk]) 0 = bl2nat ks 0"
-apply(induct ks, auto simp: bl2nat.simps split: block.splits)
-apply(case_tac a, auto simp: bl2nat.simps bl2nat_double)
-done
-
-lemma bl2nat_cons_oc:
- "bl2nat (ks @ [Oc]) 0 = bl2nat ks 0 + 2 ^ length ks"
-apply(induct ks, auto simp: bl2nat.simps split: block.splits)
-apply(case_tac a, auto simp: bl2nat.simps bl2nat_double)
-done
-
-lemma bl2nat_append:
- "bl2nat (xs @ ys) 0 = bl2nat xs 0 + bl2nat ys (length xs) "
-proof(induct "length xs" arbitrary: xs ys, simp add: bl2nat.simps)
- fix x xs ys
- assume ind:
- "\<And>xs ys. x = length xs \<Longrightarrow>
- bl2nat (xs @ ys) 0 = bl2nat xs 0 + bl2nat ys (length xs)"
- and h: "Suc x = length (xs::block list)"
- have "\<exists> ks k. xs = ks @ [k]"
- apply(rule_tac x = "butlast xs" in exI,
- rule_tac x = "last xs" in exI)
- using h
- apply(case_tac xs, auto)
- done
- from this obtain ks k where "xs = ks @ [k]" by blast
- moreover hence
- "bl2nat (ks @ (k # ys)) 0 = bl2nat ks 0 +
- bl2nat (k # ys) (length ks)"
- apply(rule_tac ind) using h by simp
- ultimately show "bl2nat (xs @ ys) 0 =
- bl2nat xs 0 + bl2nat ys (length xs)"
- apply(case_tac k, simp_all add: bl2nat.simps)
- apply(simp_all only: bl2nat_cons_bk bl2nat_cons_oc)
- done
-qed
-
-lemma bl2nat_exp: "n \<noteq> 0 \<Longrightarrow> bl2nat bl n = 2^n * bl2nat bl 0"
-apply(induct bl)
-apply(auto simp: bl2nat.simps)
-apply(case_tac a, auto simp: bl2nat.simps bl2nat_double)
-done
-
-lemma nat_minus_eq: "\<lbrakk>a = b; c = d\<rbrakk> \<Longrightarrow> a - c = b - d"
-by auto
-
-lemma tape_of_nat_list_butlast_last:
- "ys \<noteq> [] \<Longrightarrow> <ys @ [y]> = <ys> @ Bk # Oc\<^bsup>Suc y\<^esup>"
-apply(induct ys, simp, simp)
-apply(case_tac "ys = []", simp add: tape_of_nl_abv
- tape_of_nat_list.simps)
-apply(simp)
-done
-
-lemma listsum2_append:
- "\<lbrakk>n \<le> length xs\<rbrakk> \<Longrightarrow> listsum2 (xs @ ys) n = listsum2 xs n"
-apply(induct n)
-apply(auto simp: listsum2.simps nth_append)
-done
-
-lemma strt'_append:
- "\<lbrakk>n \<le> length xs\<rbrakk> \<Longrightarrow> strt' xs n = strt' (xs @ ys) n"
-proof(induct n arbitrary: xs ys)
- fix xs ys
- show "strt' xs 0 = strt' (xs @ ys) 0" by(simp add: strt'.simps)
-next
- fix n xs ys
- assume ind:
- "\<And> xs ys. n \<le> length xs \<Longrightarrow> strt' xs n = strt' (xs @ ys) n"
- and h: "Suc n \<le> length (xs::nat list)"
- show "strt' xs (Suc n) = strt' (xs @ ys) (Suc n)"
- using ind[of xs ys] h
- apply(simp add: strt'.simps nth_append listsum2_append)
- done
-qed
-
-lemma length_listsum2_eq:
- "\<lbrakk>length (ys::nat list) = k\<rbrakk>
- \<Longrightarrow> length (<ys>) = listsum2 (map Suc ys) k + k - 1"
-apply(induct k arbitrary: ys, simp_all add: listsum2.simps)
-apply(subgoal_tac "\<exists> xs x. ys = xs @ [x]", auto)
-proof -
- fix xs x
- assume ind: "\<And>ys. length ys = length xs \<Longrightarrow> length (<ys>)
- = listsum2 (map Suc ys) (length xs) +
- length (xs::nat list) - Suc 0"
- have "length (<xs>)
- = listsum2 (map Suc xs) (length xs) + length xs - Suc 0"
- apply(rule_tac ind, simp)
- done
- thus "length (<xs @ [x]>) =
- Suc (listsum2 (map Suc xs @ [Suc x]) (length xs) + x + length xs)"
- apply(case_tac "xs = []")
- apply(simp add: tape_of_nl_abv listsum2.simps
- tape_of_nat_list.simps)
- apply(simp add: tape_of_nat_list_butlast_last)
- using listsum2_append[of "length xs" "map Suc xs" "[Suc x]"]
- apply(simp)
- done
-next
- fix k ys
- assume "length ys = Suc k"
- thus "\<exists>xs x. ys = xs @ [x]"
- apply(rule_tac x = "butlast ys" in exI,
- rule_tac x = "last ys" in exI)
- apply(case_tac ys, auto)
- done
-qed
-
-lemma tape_of_nat_list_length:
- "length (<(ys::nat list)>) =
- listsum2 (map Suc ys) (length ys) + length ys - 1"
- using length_listsum2_eq[of ys "length ys"]
- apply(simp)
- done
-
-
-
-lemma [simp]:
- "trpl_code (steps (Suc 0, Bk\<^bsup>l\<^esup>, <lm>) tp 0) =
- rec_exec rec_conf [code tp, bl2wc (<lm>), 0]"
-apply(simp add: steps.simps rec_exec.simps conf_lemma conf.simps
- inpt.simps trpl_code.simps bl2wc.simps)
-done
-
-text {*
- The following lemma relates the multi-step interpreter function @{text "rec_conf"}
- with the multi-step execution of TMs.
- *}
-lemma rec_t_eq_steps:
- "turing_basic.t_correct tp \<Longrightarrow>
- trpl_code (steps (Suc 0, Bk\<^bsup>l\<^esup>, <lm>) tp stp) =
- rec_exec rec_conf [code tp, bl2wc (<lm>), stp]"
-proof(induct stp)
- case 0 thus "?case" by(simp)
-next
- case (Suc n) thus "?case"
- proof -
- assume ind:
- "t_correct tp \<Longrightarrow> trpl_code (steps (Suc 0, Bk\<^bsup>l\<^esup>, <lm>) tp n)
- = rec_exec rec_conf [code tp, bl2wc (<lm>), n]"
- and h: "t_correct tp"
- show
- "trpl_code (steps (Suc 0, Bk\<^bsup>l\<^esup>, <lm>) tp (Suc n)) =
- rec_exec rec_conf [code tp, bl2wc (<lm>), Suc n]"
- proof(case_tac "steps (Suc 0, Bk\<^bsup>l\<^esup>, <lm>) tp n",
- simp only: tstep_red conf_lemma conf.simps)
- fix a b c
- assume g: "steps (Suc 0, Bk\<^bsup>l\<^esup>, <lm>) tp n = (a, b, c) "
- hence "conf (code tp) (bl2wc (<lm>)) n= trpl_code (a, b, c)"
- using ind h
- apply(simp add: conf_lemma)
- done
- moreover hence
- "trpl_code (tstep (a, b, c) tp) =
- rec_exec rec_newconf [code tp, trpl_code (a, b, c)]"
- apply(rule_tac rec_t_eq_step)
- using h g
- apply(simp add: s_keep)
- done
- ultimately show
- "trpl_code (tstep (a, b, c) tp) =
- newconf (code tp) (conf (code tp) (bl2wc (<lm>)) n)"
- by(simp add: newconf_lemma)
- qed
- qed
-qed
-
-lemma [simp]: "bl2wc (Bk\<^bsup>m\<^esup>) = 0"
-apply(induct m)
-apply(simp, simp)
-done
-
-lemma [simp]: "bl2wc (Oc\<^bsup>rs\<^esup>@Bk\<^bsup>n\<^esup>) = bl2wc (Oc\<^bsup>rs\<^esup>)"
-apply(induct rs, simp,
- simp add: bl2wc.simps bl2nat.simps bl2nat_double)
-done
-
-lemma lg_power: "x > Suc 0 \<Longrightarrow> lg (x ^ rs) x = rs"
-proof(simp add: lg.simps, auto)
- fix xa
- assume h: "Suc 0 < x"
- show "Max {ya. ya \<le> x ^ rs \<and> lgR [x ^ rs, x, ya]} = rs"
- apply(rule_tac Max_eqI, simp_all add: lgR.simps)
- apply(simp add: h)
- using x_less_exp[of x rs] h
- apply(simp)
- done
-next
- assume "\<not> Suc 0 < x ^ rs" "Suc 0 < x"
- thus "rs = 0"
- apply(case_tac "x ^ rs", simp, simp)
- done
-next
- assume "Suc 0 < x" "\<forall>xa. \<not> lgR [x ^ rs, x, xa]"
- thus "rs = 0"
- apply(simp only:lgR.simps)
- apply(erule_tac x = rs in allE, simp)
- done
-qed
-
-text {*
- The following lemma relates execution of TMs with
- the multi-step interpreter function @{text "rec_nonstop"}. Note,
- @{text "rec_nonstop"} is constructed using @{text "rec_conf"}.
- *}
-lemma nonstop_t_eq:
- "\<lbrakk>steps (Suc 0, Bk\<^bsup>l\<^esup>, <lm>) tp stp = (0, Bk\<^bsup>m\<^esup>, Oc\<^bsup>rs\<^esup> @ Bk\<^bsup>n\<^esup>);
- turing_basic.t_correct tp;
- rs > 0\<rbrakk>
- \<Longrightarrow> rec_exec rec_nonstop [code tp, bl2wc (<lm>), stp] = 0"
-proof(simp add: nonstop_lemma nonstop.simps nstd.simps)
- assume h: "steps (Suc 0, Bk\<^bsup>l\<^esup>, <lm>) tp stp = (0, Bk\<^bsup>m\<^esup>, Oc\<^bsup>rs\<^esup> @ Bk\<^bsup>n\<^esup>)"
- and tc_t: "turing_basic.t_correct tp" "rs > 0"
- have g: "rec_exec rec_conf [code tp, bl2wc (<lm>), stp] =
- trpl_code (0, Bk\<^bsup>m\<^esup>, Oc\<^bsup>rs\<^esup>@Bk\<^bsup>n\<^esup>)"
- using rec_t_eq_steps[of tp l lm stp] tc_t h
- by(simp)
- thus "\<not> NSTD (conf (code tp) (bl2wc (<lm>)) stp)"
- proof(auto simp: NSTD.simps)
- show "stat (conf (code tp) (bl2wc (<lm>)) stp) = 0"
- using g
- by(auto simp: conf_lemma trpl_code.simps)
- next
- show "left (conf (code tp) (bl2wc (<lm>)) stp) = 0"
- using g
- by(simp add: conf_lemma trpl_code.simps)
- next
- show "rght (conf (code tp) (bl2wc (<lm>)) stp) =
- 2 ^ lg (Suc (rght (conf (code tp) (bl2wc (<lm>)) stp))) 2 - Suc 0"
- using g h
- proof(simp add: conf_lemma trpl_code.simps)
- have "2 ^ lg (Suc (bl2wc (Oc\<^bsup>rs\<^esup>))) 2 = Suc (bl2wc (Oc\<^bsup>rs\<^esup>))"
- apply(simp add: bl2wc.simps lg_power)
- done
- thus "bl2wc (Oc\<^bsup>rs\<^esup>) = 2 ^ lg (Suc (bl2wc (Oc\<^bsup>rs\<^esup>))) 2 - Suc 0"
- apply(simp)
- done
- qed
- next
- show "0 < rght (conf (code tp) (bl2wc (<lm>)) stp)"
- using g h tc_t
- apply(simp add: conf_lemma trpl_code.simps bl2wc.simps
- bl2nat.simps)
- apply(case_tac rs, simp, simp add: bl2nat.simps)
- done
- qed
-qed
-
-lemma [simp]: "actn m 0 r = 4"
-by(simp add: actn.simps)
-
-lemma [simp]: "newstat m 0 r = 0"
-by(simp add: newstat.simps)
-
-declare exp_def[simp del]
-
-lemma halt_least_step:
- "\<lbrakk>steps (Suc 0, Bk\<^bsup>l\<^esup>, <lm>) tp stp = (0, Bk\<^bsup>m\<^esup>, Oc\<^bsup>rs \<^esup> @ Bk\<^bsup>n\<^esup>);
- turing_basic.t_correct tp;
- 0<rs\<rbrakk> \<Longrightarrow>
- \<exists> stp. (nonstop (code tp) (bl2wc (<lm>)) stp = 0 \<and>
- (\<forall> stp'. nonstop (code tp) (bl2wc (<lm>)) stp' = 0 \<longrightarrow> stp \<le> stp'))"
-proof(induct stp, simp add: steps.simps, simp)
- fix stp
- assume ind:
- "steps (Suc 0, Bk\<^bsup>l\<^esup>, <lm>) tp stp = (0, Bk\<^bsup>m\<^esup>, Oc\<^bsup>rs\<^esup> @ Bk\<^bsup>n\<^esup>) \<Longrightarrow>
- \<exists>stp. nonstop (code tp) (bl2wc (<lm>)) stp = 0 \<and>
- (\<forall>stp'. nonstop (code tp) (bl2wc (<lm>)) stp' = 0 \<longrightarrow> stp \<le> stp')"
- and h:
- "steps (Suc 0, Bk\<^bsup>l\<^esup>, <lm>) tp (Suc stp) = (0, Bk\<^bsup>m\<^esup>, Oc\<^bsup>rs\<^esup> @ Bk\<^bsup>n\<^esup>)"
- "turing_basic.t_correct tp"
- "0 < rs"
- from h show
- "\<exists>stp. nonstop (code tp) (bl2wc (<lm>)) stp = 0
- \<and> (\<forall>stp'. nonstop (code tp) (bl2wc (<lm>)) stp' = 0 \<longrightarrow> stp \<le> stp')"
- proof(simp add: tstep_red,
- case_tac "steps (Suc 0, Bk\<^bsup>l\<^esup>, <lm>) tp stp", simp,
- case_tac a, simp add: tstep_0)
- assume "steps (Suc 0, Bk\<^bsup>l\<^esup>, <lm>) tp stp = (0, Bk\<^bsup>m\<^esup>, Oc\<^bsup>rs\<^esup> @ Bk\<^bsup>n\<^esup>)"
- thus "\<exists>stp. nonstop (code tp) (bl2wc (<lm>)) stp = 0 \<and>
- (\<forall>stp'. nonstop (code tp) (bl2wc (<lm>)) stp' = 0 \<longrightarrow> stp \<le> stp')"
- apply(erule_tac ind)
- done
- next
- fix a b c nat
- assume "steps (Suc 0, Bk\<^bsup>l\<^esup>, <lm>) tp stp = (a, b, c)"
- "a = Suc nat"
- thus "\<exists>stp. nonstop (code tp) (bl2wc (<lm>)) stp = 0 \<and>
- (\<forall>stp'. nonstop (code tp) (bl2wc (<lm>)) stp' = 0 \<longrightarrow> stp \<le> stp')"
- using h
- apply(rule_tac x = "Suc stp" in exI, auto)
- apply(drule_tac nonstop_t_eq, simp_all add: nonstop_lemma)
- proof -
- fix stp'
- assume g:"steps (Suc 0, Bk\<^bsup>l\<^esup>, <lm>) tp stp = (Suc nat, b, c)"
- "nonstop (code tp) (bl2wc (<lm>)) stp' = 0"
- thus "Suc stp \<le> stp'"
- proof(case_tac "Suc stp \<le> stp'", simp, simp)
- assume "\<not> Suc stp \<le> stp'"
- hence "stp' \<le> stp" by simp
- hence "\<not> isS0 (steps (Suc 0, Bk\<^bsup>l\<^esup>, <lm>) tp stp')"
- using g
- apply(case_tac "steps (Suc 0, Bk\<^bsup>l\<^esup>, <lm>) tp stp'",auto,
- simp add: isS0_def)
- apply(subgoal_tac "\<exists> n. stp = stp' + n",
- auto simp: steps_add steps_0)
- apply(rule_tac x = "stp - stp'" in exI, simp)
- done
- hence "nonstop (code tp) (bl2wc (<lm>)) stp' = 1"
- proof(case_tac "steps (Suc 0, Bk\<^bsup>l\<^esup>, <lm>) tp stp'",
- simp add: isS0_def nonstop.simps)
- fix a b c
- assume k:
- "0 < a" "steps (Suc 0, Bk\<^bsup>l\<^esup>, <lm>) tp stp' = (a, b, c)"
- thus " NSTD (conf (code tp) (bl2wc (<lm>)) stp')"
- using rec_t_eq_steps[of tp l lm stp'] h
- proof(simp add: conf_lemma)
- assume "trpl_code (a, b, c) = conf (code tp) (bl2wc (<lm>)) stp'"
- moreover have "NSTD (trpl_code (a, b, c))"
- using k
- apply(auto simp: trpl_code.simps NSTD.simps)
- done
- ultimately show "NSTD (conf (code tp) (bl2wc (<lm>)) stp')" by simp
- qed
- qed
- thus "False" using g by simp
- qed
- qed
- qed
-qed
-
-lemma conf_trpl_ex: "\<exists> p q r. conf m (bl2wc (<lm>)) stp = trpl p q r"
-apply(induct stp, auto simp: conf.simps inpt.simps trpl.simps
- newconf.simps)
-apply(rule_tac x = 0 in exI, rule_tac x = 1 in exI,
- rule_tac x = "bl2wc (<lm>)" in exI)
-apply(simp)
-done
-
-lemma nonstop_rgt_ex:
- "nonstop m (bl2wc (<lm>)) stpa = 0 \<Longrightarrow> \<exists> r. conf m (bl2wc (<lm>)) stpa = trpl 0 0 r"
-apply(auto simp: nonstop.simps NSTD.simps split: if_splits)
-using conf_trpl_ex[of m lm stpa]
-apply(auto)
-done
-
-lemma [elim]: "x > Suc 0 \<Longrightarrow> Max {u. x ^ u dvd x ^ r} = r"
-proof(rule_tac Max_eqI)
- assume "x > Suc 0"
- thus "finite {u. x ^ u dvd x ^ r}"
- apply(rule_tac finite_power_dvd, auto)
- done
-next
- fix y
- assume "Suc 0 < x" "y \<in> {u. x ^ u dvd x ^ r}"
- thus "y \<le> r"
- apply(case_tac "y\<le> r", simp)
- apply(subgoal_tac "\<exists> d. y = r + d")
- apply(auto simp: power_add)
- apply(rule_tac x = "y - r" in exI, simp)
- done
-next
- show "r \<in> {u. x ^ u dvd x ^ r}" by simp
-qed
-
-lemma lo_power: "x > Suc 0 \<Longrightarrow> lo (x ^ r) x = r"
-apply(auto simp: lo.simps loR.simps mod_dvd_simp)
-apply(case_tac "x^r", simp_all)
-done
-
-lemma lo_rgt: "lo (trpl 0 0 r) (Pi 2) = r"
-apply(simp add: trpl.simps lo_power)
-done
-
-lemma conf_keep:
- "conf m lm stp = trpl 0 0 r \<Longrightarrow>
- conf m lm (stp + n) = trpl 0 0 r"
-apply(induct n)
-apply(auto simp: conf.simps newconf.simps newleft.simps
- newrght.simps rght.simps lo_rgt)
-done
-
-lemma halt_state_keep_steps_add:
- "\<lbrakk>nonstop m (bl2wc (<lm>)) stpa = 0\<rbrakk> \<Longrightarrow>
- conf m (bl2wc (<lm>)) stpa = conf m (bl2wc (<lm>)) (stpa + n)"
-apply(drule_tac nonstop_rgt_ex, auto simp: conf_keep)
-done
-
-lemma halt_state_keep:
- "\<lbrakk>nonstop m (bl2wc (<lm>)) stpa = 0; nonstop m (bl2wc (<lm>)) stpb = 0\<rbrakk> \<Longrightarrow>
- conf m (bl2wc (<lm>)) stpa = conf m (bl2wc (<lm>)) stpb"
-apply(case_tac "stpa > stpb")
-using halt_state_keep_steps_add[of m lm stpb "stpa - stpb"]
-apply simp
-using halt_state_keep_steps_add[of m lm stpa "stpb - stpa"]
-apply(simp)
-done
-
-text {*
- The correntess of @{text "rec_F"} which relates the interpreter function @{text "rec_F"} with the
- execution of of TMs.
- *}
-lemma F_t_halt_eq:
- "\<lbrakk>steps (Suc 0, Bk\<^bsup>l\<^esup>, <lm>) tp stp = (0, Bk\<^bsup>m\<^esup>, Oc\<^bsup>rs\<^esup>@Bk\<^bsup>n\<^esup>);
- turing_basic.t_correct tp;
- 0<rs\<rbrakk>
- \<Longrightarrow> rec_calc_rel rec_F [code tp, (bl2wc (<lm>))] (rs - Suc 0)"
-apply(frule_tac halt_least_step, auto)
-apply(frule_tac nonstop_t_eq, auto simp: nonstop_lemma)
-using rec_t_eq_steps[of tp l lm stp]
-apply(simp add: conf_lemma)
-proof -
- fix stpa
- assume h:
- "nonstop (code tp) (bl2wc (<lm>)) stpa = 0"
- "\<forall>stp'. nonstop (code tp) (bl2wc (<lm>)) stp' = 0 \<longrightarrow> stpa \<le> stp'"
- "nonstop (code tp) (bl2wc (<lm>)) stp = 0"
- "trpl_code (0, Bk\<^bsup>m\<^esup>, Oc\<^bsup>rs\<^esup> @ Bk\<^bsup>n\<^esup>) = conf (code tp) (bl2wc (<lm>)) stp"
- "steps (Suc 0, Bk\<^bsup>l\<^esup>, <lm>) tp stp = (0, Bk\<^bsup>m\<^esup>, Oc\<^bsup>rs\<^esup> @ Bk\<^bsup>n\<^esup>)"
- hence g1: "conf (code tp) (bl2wc (<lm>)) stpa = trpl_code (0, Bk\<^bsup>m\<^esup>, Oc\<^bsup>rs\<^esup> @ Bk\<^bsup>n\<^esup>)"
- using halt_state_keep[of "code tp" lm stpa stp]
- by(simp)
- moreover have g2:
- "rec_calc_rel rec_halt [code tp, (bl2wc (<lm>))] stpa"
- using h
- apply(simp add: halt_lemma nonstop_lemma, auto)
- done
- show
- "rec_calc_rel rec_F [code tp, (bl2wc (<lm>))] (rs - Suc 0)"
- proof -
- have
- "rec_calc_rel rec_F [code tp, (bl2wc (<lm>))]
- (valu (rght (conf (code tp) (bl2wc (<lm>)) stpa)))"
- apply(rule F_lemma) using g2 h by auto
- moreover have
- "valu (rght (conf (code tp) (bl2wc (<lm>)) stpa)) = rs - Suc 0"
- using g1
- apply(simp add: valu.simps trpl_code.simps
- bl2wc.simps bl2nat_append lg_power)
- done
- ultimately show "?thesis" by simp
- qed
-qed
-
-
-end
\ No newline at end of file
--- a/utm/UTM.thy Mon Mar 04 21:01:55 2013 +0000
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,5165 +0,0 @@
-theory UTM
-imports Main uncomputable recursive abacus UF GCD
-begin
-
-section {* Wang coding of input arguments *}
-
-text {*
- The direct compilation of the universal function @{text "rec_F"} can not give us UTM, because @{text "rec_F"} is of arity 2,
- where the first argument represents the Godel coding of the TM being simulated and the second argument represents the right number (in Wang's coding) of the TM tape.
- (Notice, left number is always @{text "0"} at the very beginning). However, UTM needs to simulate the execution of any TM which may
- very well take many input arguments. Therefore, a initialization TM needs to run before the TM compiled from @{text "rec_F"}, and the sequential
- composition of these two TMs will give rise to the UTM we are seeking. The purpose of this initialization TM is to transform the multiple
- input arguments of the TM being simulated into Wang's coding, so that it can be consumed by the TM compiled from @{text "rec_F"} as the second
- argument.
-
- However, this initialization TM (named @{text "t_wcode"}) can not be constructed by compiling from any resurve function, because every recursive
- function takes a fixed number of input arguments, while @{text "t_wcode"} needs to take varying number of arguments and tranform them into
- Wang's coding. Therefore, this section give a direct construction of @{text "t_wcode"} with just some parts being obtained from recursive functions.
-
-\newlength{\basewidth}
-\settowidth{\basewidth}{xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx}
-\newlength{\baseheight}
-\settoheight{\baseheight}{$B:R$}
-\newcommand{\vsep}{5\baseheight}
-
-The TM used to generate the Wang's code of input arguments is divided into three TMs
- executed sequentially, namely $prepare$, $mainwork$ and $adjust$¡£According to the
- convention, start state of ever TM is fixed to state $1$ while the final state is
- fixed to $0$.
-
-The input and output of $prepare$ are illustrated respectively by Figure
-\ref{prepare_input} and \ref{prepare_output}.
-
-
-\begin{figure}[h!]
-\centering
-\scalebox{1.2}{
-\begin{tikzpicture}
- [tbox/.style = {draw, thick, inner sep = 5pt}]
- \node (0) {};
- \node (1) [tbox, text height = 3.5pt, right = -0.9pt of 0] {\wuhao $m$};
- \node (2) [tbox, right = -0.9pt of 1] {\wuhao $0$};
- \node (3) [tbox, right = -0.9pt of 2] {\wuhao $a_1$};
- \node (4) [tbox, right = -0.9pt of 3] {\wuhao $0$};
- \node (5) [tbox, right = -0.9pt of 4] {\wuhao $a_2$};
- \node (6) [right = -0.9pt of 5] {\ldots \ldots};
- \node (7) [tbox, right = -0.9pt of 6] {\wuhao $a_n$};
- \draw [->, >=latex, thick] (1)+(0, -4\baseheight) -- (1);
-\end{tikzpicture}}
-\caption{The input of TM $prepare$} \label{prepare_input}
-\end{figure}
-
-\begin{figure}[h!]
-\centering
-\scalebox{1.2}{
-\begin{tikzpicture}
- \node (0) {};
- \node (1) [draw, text height = 3.5pt, right = -0.9pt of 0, thick, inner sep = 5pt] {\wuhao $m$};
- \node (2) [draw, right = -0.9pt of 1, thick, inner sep = 5pt] {\wuhao $0$};
- \node (3) [draw, right = -0.9pt of 2, thick, inner sep = 5pt] {\wuhao $0$};
- \node (4) [draw, right = -0.9pt of 3, thick, inner sep = 5pt] {\wuhao $a_1$};
- \node (5) [draw, right = -0.9pt of 4, thick, inner sep = 5pt] {\wuhao $0$};
- \node (6) [draw, right = -0.9pt of 5, thick, inner sep = 5pt] {\wuhao $a_2$};
- \node (7) [right = -0.9pt of 6] {\ldots \ldots};
- \node (8) [draw, right = -0.9pt of 7, thick, inner sep = 5pt] {\wuhao $a_n$};
- \node (9) [draw, right = -0.9pt of 8, thick, inner sep = 5pt] {\wuhao $0$};
- \node (10) [draw, right = -0.9pt of 9, thick, inner sep = 5pt] {\wuhao $0$};
- \node (11) [draw, right = -0.9pt of 10, thick, inner sep = 5pt] {\wuhao $1$};
- \draw [->, >=latex, thick] (10)+(0, -4\baseheight) -- (10);
-\end{tikzpicture}}
-\caption{The output of TM $prepare$} \label{prepare_output}
-\end{figure}
-
-As shown in Figure \ref{prepare_input}, the input of $prepare$ is the same as the the input
-of UTM, where $m$ is the Godel coding of the TM being interpreted and $a_1$ through $a_n$ are the $n$ input arguments of the TM under interpretation. The purpose of $purpose$ is to transform this initial tape layout to the one shown in Figure \ref{prepare_output},
-which is convenient for the generation of Wang's codding of $a_1, \ldots, a_n$. The coding procedure starts from $a_n$ and ends after $a_1$ is encoded. The coding result is stored in an accumulator at the end of the tape (initially represented by the $1$ two blanks right to $a_n$ in Figure \ref{prepare_output}). In Figure \ref{prepare_output}, arguments $a_1, \ldots, a_n$ are separated by two blanks on both ends with the rest so that movement conditions can be implemented conveniently in subsequent TMs, because, by convention,
-two consecutive blanks are usually used to signal the end or start of a large chunk of data. The diagram of $prepare$ is given in Figure \ref{prepare_diag}.
-
-
-\begin{figure}[h!]
-\centering
-\scalebox{0.9}{
-\begin{tikzpicture}
- \node[circle,draw] (1) {$1$};
- \node[circle,draw] (2) at ($(1)+(0.3\basewidth, 0)$) {$2$};
- \node[circle,draw] (3) at ($(2)+(0.3\basewidth, 0)$) {$3$};
- \node[circle,draw] (4) at ($(3)+(0.3\basewidth, 0)$) {$4$};
- \node[circle,draw] (5) at ($(4)+(0.3\basewidth, 0)$) {$5$};
- \node[circle,draw] (6) at ($(5)+(0.3\basewidth, 0)$) {$6$};
- \node[circle,draw] (7) at ($(6)+(0.3\basewidth, 0)$) {$7$};
- \node[circle,draw] (8) at ($(7)+(0.3\basewidth, 0)$) {$0$};
-
-
- \draw [->, >=latex] (1) edge [loop above] node[above] {$S_1:L$} (1)
- ;
- \draw [->, >=latex] (1) -- node[above] {$S_0:S_1$} (2)
- ;
- \draw [->, >=latex] (2) edge [loop above] node[above] {$S_1:R$} (2)
- ;
- \draw [->, >=latex] (2) -- node[above] {$S_0:L$} (3)
- ;
- \draw [->, >=latex] (3) edge[loop above] node[above] {$S_1:S_0$} (3)
- ;
- \draw [->, >=latex] (3) -- node[above] {$S_0:R$} (4)
- ;
- \draw [->, >=latex] (4) edge[loop above] node[above] {$S_0:R$} (4)
- ;
- \draw [->, >=latex] (4) -- node[above] {$S_0:R$} (5)
- ;
- \draw [->, >=latex] (5) edge[loop above] node[above] {$S_1:R$} (5)
- ;
- \draw [->, >=latex] (5) -- node[above] {$S_0:R$} (6)
- ;
- \draw [->, >=latex] (6) edge[bend left = 50] node[below] {$S_1:R$} (5)
- ;
- \draw [->, >=latex] (6) -- node[above] {$S_0:R$} (7)
- ;
- \draw [->, >=latex] (7) edge[loop above] node[above] {$S_0:S_1$} (7)
- ;
- \draw [->, >=latex] (7) -- node[above] {$S_1:L$} (8)
- ;
- \end{tikzpicture}}
-\caption{The diagram of TM $prepare$} \label{prepare_diag}
-\end{figure}
-
-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.
-In order to detect the termination condition when the left most bit of $a_1$ is reached,
-TM $mainwork$ needs to look ahead and consider three different situations at the start of
-every iteration:
-\begin{enumerate}
- \item The TM configuration for the first situation is shown in Figure \ref{mainwork_case_one_input},
- where the accumulator is stored in $r$, both of the next two bits
- to be encoded are $1$. The configuration at the end of the iteration
- is shown in Figure \ref{mainwork_case_one_output}, where the first 1-bit has been
- encoded and cleared. Notice that the accumulator has been changed to
- $(r+1) \times 2$ to reflect the encoded bit.
- \item The TM configuration for the second situation is shown in Figure
- \ref{mainwork_case_two_input},
- where the accumulator is stored in $r$, the next two bits
- to be encoded are $1$ and $0$. After the first
- $1$-bit was encoded and cleared, the second $0$-bit is difficult to detect
- and process. To solve this problem, these two consecutive bits are
- encoded in one iteration. In this situation, only the first $1$-bit needs
- to be cleared since the second one is cleared by definition.
- The configuration at the end of the iteration
- is shown in Figure \ref{mainwork_case_two_output}.
- Notice that the accumulator has been changed to
- $(r+1) \times 4$ to reflect the two encoded bits.
- \item The third situation corresponds to the case when the last bit of $a_1$ is reached.
- The TM configurations at the start and end of the iteration are shown in
- Figure \ref{mainwork_case_three_input} and \ref{mainwork_case_three_output}
- respectively. For this situation, only the read write head needs to be moved to
- the left to prepare a initial configuration for TM $adjust$ to start with.
-\end{enumerate}
-The diagram of $mainwork$ is given in Figure \ref{mainwork_diag}. The two rectangular nodes
-labeled with $2 \times x$ and $4 \times x$ are two TMs compiling from recursive functions
-so that we do not have to design and verify two quite complicated TMs.
-
-
-\begin{figure}[h!]
-\centering
-\scalebox{1.2}{
-\begin{tikzpicture}
- \node (0) {};
- \node (1) [draw, text height = 3.9pt, right = -0.9pt of 0, thick, inner sep = 5pt] {\wuhao $m$};
- \node (2) [draw, right = -0.9pt of 1, thick, inner sep = 5pt] {\wuhao $0$};
- \node (3) [draw, right = -0.9pt of 2, thick, inner sep = 5pt] {\wuhao $0$};
- \node (4) [draw, right = -0.9pt of 3, thick, inner sep = 5pt] {\wuhao $a_1$};
- \node (5) [draw, right = -0.9pt of 4, thick, inner sep = 5pt] {\wuhao $0$};
- \node (6) [draw, right = -0.9pt of 5, thick, inner sep = 5pt] {\wuhao $a_2$};
- \node (7) [right = -0.9pt of 6] {\ldots \ldots};
- \node (8) [draw, right = -0.9pt of 7, thick, inner sep = 5pt] {\wuhao $a_i$};
- \node (9) [draw, right = -0.9pt of 8, thick, inner sep = 5pt] {\wuhao $1$};
- \node (10) [draw, right = -0.9pt of 9, thick, inner sep = 5pt] {\wuhao $1$};
- \node (11) [draw, right = -0.9pt of 10, thick, inner sep = 5pt] {\wuhao $0$};
- \node (12) [right = -0.9pt of 11] {\ldots \ldots};
- \node (13) [draw, right = -0.9pt of 12, thick, inner sep = 5pt] {\wuhao $0$};
- \node (14) [draw, text height = 3.9pt, right = -0.9pt of 13, thick, inner sep = 5pt] {\wuhao $r$};
- \draw [->, >=latex, thick] (13)+(0, -4\baseheight) -- (13);
-\end{tikzpicture}}
-\caption{The first situation for TM $mainwork$ to consider} \label{mainwork_case_one_input}
-\end{figure}
-
-
-\begin{figure}[h!]
-\centering
-\scalebox{1.2}{
-\begin{tikzpicture}
- \node (0) {};
- \node (1) [draw, text height = 3.9pt, right = -0.9pt of 0, thick, inner sep = 5pt] {\wuhao $m$};
- \node (2) [draw, right = -0.9pt of 1, thick, inner sep = 5pt] {\wuhao $0$};
- \node (3) [draw, right = -0.9pt of 2, thick, inner sep = 5pt] {\wuhao $0$};
- \node (4) [draw, right = -0.9pt of 3, thick, inner sep = 5pt] {\wuhao $a_1$};
- \node (5) [draw, right = -0.9pt of 4, thick, inner sep = 5pt] {\wuhao $0$};
- \node (6) [draw, right = -0.9pt of 5, thick, inner sep = 5pt] {\wuhao $a_2$};
- \node (7) [right = -0.9pt of 6] {\ldots \ldots};
- \node (8) [draw, right = -0.9pt of 7, thick, inner sep = 5pt] {\wuhao $a_i$};
- \node (9) [draw, right = -0.9pt of 8, thick, inner sep = 5pt] {\wuhao $1$};
- \node (10) [draw, right = -0.9pt of 9, thick, inner sep = 5pt] {\wuhao $0$};
- \node (11) [draw, right = -0.9pt of 10, thick, inner sep = 5pt] {\wuhao $0$};
- \node (12) [right = -0.9pt of 11] {\ldots \ldots};
- \node (13) [draw, right = -0.9pt of 12, thick, inner sep = 5pt] {\wuhao $0$};
- \node (14) [draw, text height = 2.7pt, right = -0.9pt of 13, thick, inner sep = 5pt] {\wuhao $(r+1) \times 2$};
- \draw [->, >=latex, thick] (13)+(0, -4\baseheight) -- (13);
-\end{tikzpicture}}
-\caption{The output for the first case of TM $mainwork$'s processing}
-\label{mainwork_case_one_output}
-\end{figure}
-
-\begin{figure}[h!]
-\centering
-\scalebox{1.2}{
-\begin{tikzpicture}
- \node (0) {};
- \node (1) [draw, text height = 3.9pt, right = -0.9pt of 0, thick, inner sep = 5pt] {\wuhao $m$};
- \node (2) [draw, right = -0.9pt of 1, thick, inner sep = 5pt] {\wuhao $0$};
- \node (3) [draw, right = -0.9pt of 2, thick, inner sep = 5pt] {\wuhao $0$};
- \node (4) [draw, right = -0.9pt of 3, thick, inner sep = 5pt] {\wuhao $a_1$};
- \node (5) [draw, right = -0.9pt of 4, thick, inner sep = 5pt] {\wuhao $0$};
- \node (6) [draw, right = -0.9pt of 5, thick, inner sep = 5pt] {\wuhao $a_2$};
- \node (7) [right = -0.9pt of 6] {\ldots \ldots};
- \node (8) [draw, right = -0.9pt of 7, thick, inner sep = 5pt] {\wuhao $a_i$};
- \node (9) [draw, right = -0.9pt of 8, thick, inner sep = 5pt] {\wuhao $1$};
- \node (10) [draw, right = -0.9pt of 9, thick, inner sep = 5pt] {\wuhao $0$};
- \node (11) [draw, right = -0.9pt of 10, thick, inner sep = 5pt] {\wuhao $1$};
- \node (12) [draw, right = -0.9pt of 11, thick, inner sep = 5pt] {\wuhao $0$};
- \node (13) [right = -0.9pt of 12] {\ldots \ldots};
- \node (14) [draw, right = -0.9pt of 13, thick, inner sep = 5pt] {\wuhao $0$};
- \node (15) [draw, text height = 3.9pt, right = -0.9pt of 14, thick, inner sep = 5pt] {\wuhao $r$};
- \draw [->, >=latex, thick] (14)+(0, -4\baseheight) -- (14);
-\end{tikzpicture}}
-\caption{The second situation for TM $mainwork$ to consider} \label{mainwork_case_two_input}
-\end{figure}
-
-\begin{figure}[h!]
-\centering
-\scalebox{1.2}{
-\begin{tikzpicture}
- \node (0) {};
- \node (1) [draw, text height = 3.9pt, right = -0.9pt of 0, thick, inner sep = 5pt] {\wuhao $m$};
- \node (2) [draw, right = -0.9pt of 1, thick, inner sep = 5pt] {\wuhao $0$};
- \node (3) [draw, right = -0.9pt of 2, thick, inner sep = 5pt] {\wuhao $0$};
- \node (4) [draw, right = -0.9pt of 3, thick, inner sep = 5pt] {\wuhao $a_1$};
- \node (5) [draw, right = -0.9pt of 4, thick, inner sep = 5pt] {\wuhao $0$};
- \node (6) [draw, right = -0.9pt of 5, thick, inner sep = 5pt] {\wuhao $a_2$};
- \node (7) [right = -0.9pt of 6] {\ldots \ldots};
- \node (8) [draw, right = -0.9pt of 7, thick, inner sep = 5pt] {\wuhao $a_i$};
- \node (9) [draw, right = -0.9pt of 8, thick, inner sep = 5pt] {\wuhao $1$};
- \node (10) [draw, right = -0.9pt of 9, thick, inner sep = 5pt] {\wuhao $0$};
- \node (11) [draw, right = -0.9pt of 10, thick, inner sep = 5pt] {\wuhao $0$};
- \node (12) [draw, right = -0.9pt of 11, thick, inner sep = 5pt] {\wuhao $0$};
- \node (13) [right = -0.9pt of 12] {\ldots \ldots};
- \node (14) [draw, right = -0.9pt of 13, thick, inner sep = 5pt] {\wuhao $0$};
- \node (15) [draw, text height = 2.7pt, right = -0.9pt of 14, thick, inner sep = 5pt] {\wuhao $(r+1) \times 4$};
- \draw [->, >=latex, thick] (14)+(0, -4\baseheight) -- (14);
-\end{tikzpicture}}
-\caption{The output for the second case of TM $mainwork$'s processing}
-\label{mainwork_case_two_output}
-\end{figure}
-
-\begin{figure}[h!]
-\centering
-\scalebox{1.2}{
-\begin{tikzpicture}
- \node (0) {};
- \node (1) [draw, text height = 3.9pt, right = -0.9pt of 0, thick, inner sep = 5pt] {\wuhao $m$};
- \node (2) [draw, right = -0.9pt of 1, thick, inner sep = 5pt] {\wuhao $0$};
- \node (3) [draw, right = -0.9pt of 2, thick, inner sep = 5pt] {\wuhao $0$};
- \node (4) [draw, right = -0.9pt of 3, thick, inner sep = 5pt] {\wuhao $1$};
- \node (5) [draw, right = -0.9pt of 4, thick, inner sep = 5pt] {\wuhao $0$};
- \node (6) [right = -0.9pt of 5] {\ldots \ldots};
- \node (7) [draw, right = -0.9pt of 6, thick, inner sep = 5pt] {\wuhao $0$};
- \node (8) [draw, text height = 3.9pt, right = -0.9pt of 7, thick, inner sep = 5pt] {\wuhao $r$};
- \draw [->, >=latex, thick] (7)+(0, -4\baseheight) -- (7);
-\end{tikzpicture}}
-\caption{The third situation for TM $mainwork$ to consider} \label{mainwork_case_three_input}
-\end{figure}
-
-\begin{figure}[h!]
-\centering
-\scalebox{1.2}{
-\begin{tikzpicture}
- \node (0) {};
- \node (1) [draw, text height = 3.9pt, right = -0.9pt of 0, thick, inner sep = 5pt] {\wuhao $m$};
- \node (2) [draw, right = -0.9pt of 1, thick, inner sep = 5pt] {\wuhao $0$};
- \node (3) [draw, right = -0.9pt of 2, thick, inner sep = 5pt] {\wuhao $0$};
- \node (4) [draw, right = -0.9pt of 3, thick, inner sep = 5pt] {\wuhao $1$};
- \node (5) [draw, right = -0.9pt of 4, thick, inner sep = 5pt] {\wuhao $0$};
- \node (6) [right = -0.9pt of 5] {\ldots \ldots};
- \node (7) [draw, right = -0.9pt of 6, thick, inner sep = 5pt] {\wuhao $0$};
- \node (8) [draw, text height = 3.9pt, right = -0.9pt of 7, thick, inner sep = 5pt] {\wuhao $r$};
- \draw [->, >=latex, thick] (3)+(0, -4\baseheight) -- (3);
-\end{tikzpicture}}
-\caption{The output for the third case of TM $mainwork$'s processing}
-\label{mainwork_case_three_output}
-\end{figure}
-
-\begin{figure}[h!]
-\centering
-\scalebox{0.9}{
-\begin{tikzpicture}
- \node[circle,draw] (1) {$1$};
- \node[circle,draw] (2) at ($(1)+(0.3\basewidth, 0)$) {$2$};
- \node[circle,draw] (3) at ($(2)+(0.3\basewidth, 0)$) {$3$};
- \node[circle,draw] (4) at ($(3)+(0.3\basewidth, 0)$) {$4$};
- \node[circle,draw] (5) at ($(4)+(0.3\basewidth, 0)$) {$5$};
- \node[circle,draw] (6) at ($(5)+(0.3\basewidth, 0)$) {$6$};
- \node[circle,draw] (7) at ($(2)+(0, -7\baseheight)$) {$7$};
- \node[circle,draw] (8) at ($(7)+(0, -7\baseheight)$) {$8$};
- \node[circle,draw] (9) at ($(8)+(0.3\basewidth, 0)$) {$9$};
- \node[circle,draw] (10) at ($(9)+(0.3\basewidth, 0)$) {$10$};
- \node[circle,draw] (11) at ($(10)+(0.3\basewidth, 0)$) {$11$};
- \node[circle,draw] (12) at ($(11)+(0.3\basewidth, 0)$) {$12$};
- \node[draw] (13) at ($(6)+(0.3\basewidth, 0)$) {$2 \times x$};
- \node[circle,draw] (14) at ($(13)+(0.3\basewidth, 0)$) {$j_1$};
- \node[draw] (15) at ($(12)+(0.3\basewidth, 0)$) {$4 \times x$};
- \node[draw] (16) at ($(15)+(0.3\basewidth, 0)$) {$j_2$};
- \node[draw] (17) at ($(7)+(0.3\basewidth, 0)$) {$0$};
-
- \draw [->, >=latex] (1) edge[loop left] node[above] {$S_0:L$} (1)
- ;
- \draw [->, >=latex] (1) -- node[above] {$S_1:L$} (2)
- ;
- \draw [->, >=latex] (2) -- node[above] {$S_1:R$} (3)
- ;
- \draw [->, >=latex] (2) -- node[left] {$S_1:L$} (7)
- ;
- \draw [->, >=latex] (3) edge[loop above] node[above] {$S_1:S_0$} (3)
- ;
- \draw [->, >=latex] (3) -- node[above] {$S_0:R$} (4)
- ;
- \draw [->, >=latex] (4) edge[loop above] node[above] {$S_0:R$} (4)
- ;
- \draw [->, >=latex] (4) -- node[above] {$S_1:R$} (5)
- ;
- \draw [->, >=latex] (5) edge[loop above] node[above] {$S_1:R$} (5)
- ;
- \draw [->, >=latex] (5) -- node[above] {$S_0:S_1$} (6)
- ;
- \draw [->, >=latex] (6) edge[loop above] node[above] {$S_1:L$} (6)
- ;
- \draw [->, >=latex] (6) -- node[above] {$S_0:R$} (13)
- ;
- \draw [->, >=latex] (13) -- (14)
- ;
- \draw (14) -- ($(14)+(0, 6\baseheight)$) -- ($(1) + (0, 6\baseheight)$) node [above,midway] {$S_1:L$}
- ;
- \draw [->, >=latex] ($(1) + (0, 6\baseheight)$) -- (1)
- ;
- \draw [->, >=latex] (7) -- node[above] {$S_0:R$} (17)
- ;
- \draw [->, >=latex] (7) -- node[left] {$S_1:R$} (8)
- ;
- \draw [->, >=latex] (8) -- node[above] {$S_0:R$} (9)
- ;
- \draw [->, >=latex] (9) -- node[above] {$S_0:R$} (10)
- ;
- \draw [->, >=latex] (10) -- node[above] {$S_1:R$} (11)
- ;
- \draw [->, >=latex] (10) edge[loop above] node[above] {$S_0:R$} (10)
- ;
- \draw [->, >=latex] (11) edge[loop above] node[above] {$S_1:R$} (11)
- ;
- \draw [->, >=latex] (11) -- node[above] {$S_0:S_1$} (12)
- ;
- \draw [->, >=latex] (12) -- node[above] {$S_0:R$} (15)
- ;
- \draw [->, >=latex] (12) edge[loop above] node[above] {$S_1:L$} (12)
- ;
- \draw [->, >=latex] (15) -- (16)
- ;
- \draw (16) -- ($(16)+(0, -4\baseheight)$) -- ($(1) + (0, -18\baseheight)$) node [below,midway] {$S_1:L$}
- ;
- \draw [->, >=latex] ($(1) + (0, -18\baseheight)$) -- (1)
- ;
- \end{tikzpicture}}
-\caption{The diagram of TM $mainwork$} \label{mainwork_diag}
-\end{figure}
-
-The purpose of TM $adjust$ is to encode the last bit of $a_1$. The initial and final configuration
-of this TM are shown in Figure \ref{adjust_initial} and \ref{adjust_final} respectively.
-The diagram of TM $adjust$ is shown in Figure \ref{adjust_diag}.
-
-
-\begin{figure}[h!]
-\centering
-\scalebox{1.2}{
-\begin{tikzpicture}
- \node (0) {};
- \node (1) [draw, text height = 3.9pt, right = -0.9pt of 0, thick, inner sep = 5pt] {\wuhao $m$};
- \node (2) [draw, right = -0.9pt of 1, thick, inner sep = 5pt] {\wuhao $0$};
- \node (3) [draw, right = -0.9pt of 2, thick, inner sep = 5pt] {\wuhao $0$};
- \node (4) [draw, right = -0.9pt of 3, thick, inner sep = 5pt] {\wuhao $1$};
- \node (5) [draw, right = -0.9pt of 4, thick, inner sep = 5pt] {\wuhao $0$};
- \node (6) [right = -0.9pt of 5] {\ldots \ldots};
- \node (7) [draw, right = -0.9pt of 6, thick, inner sep = 5pt] {\wuhao $0$};
- \node (8) [draw, text height = 3.9pt, right = -0.9pt of 7, thick, inner sep = 5pt] {\wuhao $r$};
- \draw [->, >=latex, thick] (3)+(0, -4\baseheight) -- (3);
-\end{tikzpicture}}
-\caption{Initial configuration of TM $adjust$} \label{adjust_initial}
-\end{figure}
-
-\begin{figure}[h!]
-\centering
-\scalebox{1.2}{
-\begin{tikzpicture}
- \node (0) {};
- \node (1) [draw, text height = 3.9pt, right = -0.9pt of 0, thick, inner sep = 5pt] {\wuhao $m$};
- \node (2) [draw, right = -0.9pt of 1, thick, inner sep = 5pt] {\wuhao $0$};
- \node (3) [draw, text height = 2.9pt, right = -0.9pt of 2, thick, inner sep = 5pt] {\wuhao $r+1$};
- \node (4) [draw, right = -0.9pt of 3, thick, inner sep = 5pt] {\wuhao $0$};
- \node (5) [draw, right = -0.9pt of 4, thick, inner sep = 5pt] {\wuhao $0$};
- \node (6) [right = -0.9pt of 5] {\ldots \ldots};
- \draw [->, >=latex, thick] (1)+(0, -4\baseheight) -- (1);
-\end{tikzpicture}}
-\caption{Final configuration of TM $adjust$} \label{adjust_final}
-\end{figure}
-
-
-\begin{figure}[h!]
-\centering
-\scalebox{0.9}{
-\begin{tikzpicture}
- \node[circle,draw] (1) {$1$};
- \node[circle,draw] (2) at ($(1)+(0.3\basewidth, 0)$) {$2$};
- \node[circle,draw] (3) at ($(2)+(0.3\basewidth, 0)$) {$3$};
- \node[circle,draw] (4) at ($(3)+(0.3\basewidth, 0)$) {$4$};
- \node[circle,draw] (5) at ($(4)+(0.3\basewidth, 0)$) {$5$};
- \node[circle,draw] (6) at ($(5)+(0.3\basewidth, 0)$) {$6$};
- \node[circle,draw] (7) at ($(6)+(0.3\basewidth, 0)$) {$7$};
- \node[circle,draw] (8) at ($(4)+(0, -7\baseheight)$) {$8$};
- \node[circle,draw] (9) at ($(8)+(0.3\basewidth, 0)$) {$9$};
- \node[circle,draw] (10) at ($(9)+(0.3\basewidth, 0)$) {$10$};
- \node[circle,draw] (11) at ($(10)+(0.3\basewidth, 0)$) {$11$};
- \node[circle,draw] (12) at ($(11)+(0.3\basewidth, 0)$) {$0$};
-
-
- \draw [->, >=latex] (1) -- node[above] {$S_1:R$} (2)
- ;
- \draw [->, >=latex] (1) edge[loop above] node[above] {$S_0:S_1$} (1)
- ;
- \draw [->, >=latex] (2) -- node[above] {$S_1:R$} (3)
- ;
- \draw [->, >=latex] (3) edge[loop above] node[above] {$S_0:R$} (3)
- ;
- \draw [->, >=latex] (3) -- node[above] {$S_1:R$} (4)
- ;
- \draw [->, >=latex] (4) -- node[above] {$S_1:L$} (5)
- ;
- \draw [->, >=latex] (4) -- node[right] {$S_0:L$} (8)
- ;
- \draw [->, >=latex] (5) -- node[above] {$S_0:L$} (6)
- ;
- \draw [->, >=latex] (5) edge[loop above] node[above] {$S_1:S_0$} (5)
- ;
- \draw [->, >=latex] (6) -- node[above] {$S_1:R$} (7)
- ;
- \draw [->, >=latex] (6) edge[loop above] node[above] {$S_0:L$} (6)
- ;
- \draw (7) -- ($(7)+(0, 6\baseheight)$) -- ($(2) + (0, 6\baseheight)$) node [above,midway] {$S_0:S_1$}
- ;
- \draw [->, >=latex] ($(2) + (0, 6\baseheight)$) -- (2)
- ;
- \draw [->, >=latex] (8) edge[loop left] node[left] {$S_1:S_0$} (8)
- ;
- \draw [->, >=latex] (8) -- node[above] {$S_0:L$} (9)
- ;
- \draw [->, >=latex] (9) edge[loop above] node[above] {$S_0:L$} (9)
- ;
- \draw [->, >=latex] (9) -- node[above] {$S_1:L$} (10)
- ;
- \draw [->, >=latex] (10) edge[loop above] node[above] {$S_0:L$} (10)
- ;
- \draw [->, >=latex] (10) -- node[above] {$S_0:L$} (11)
- ;
- \draw [->, >=latex] (11) edge[loop above] node[above] {$S_1:L$} (11)
- ;
- \draw [->, >=latex] (11) -- node[above] {$S_0:R$} (12)
- ;
- \end{tikzpicture}}
-\caption{Diagram of TM $adjust$} \label{adjust_diag}
-\end{figure}
-*}
-
-
-definition rec_twice :: "recf"
- where
- "rec_twice = Cn 1 rec_mult [id 1 0, constn 2]"
-
-definition rec_fourtimes :: "recf"
- where
- "rec_fourtimes = Cn 1 rec_mult [id 1 0, constn 4]"
-
-definition abc_twice :: "abc_prog"
- where
- "abc_twice = (let (aprog, ary, fp) = rec_ci rec_twice in
- aprog [+] dummy_abc ((Suc 0)))"
-
-definition abc_fourtimes :: "abc_prog"
- where
- "abc_fourtimes = (let (aprog, ary, fp) = rec_ci rec_fourtimes in
- aprog [+] dummy_abc ((Suc 0)))"
-
-definition twice_ly :: "nat list"
- where
- "twice_ly = layout_of abc_twice"
-
-definition fourtimes_ly :: "nat list"
- where
- "fourtimes_ly = layout_of abc_fourtimes"
-
-definition t_twice :: "tprog"
- where
- "t_twice = change_termi_state (tm_of (abc_twice) @ (tMp 1 (start_of twice_ly (length abc_twice) - Suc 0)))"
-
-definition t_fourtimes :: "tprog"
- where
- "t_fourtimes = change_termi_state (tm_of (abc_fourtimes) @
- (tMp 1 (start_of fourtimes_ly (length abc_fourtimes) - Suc 0)))"
-
-
-definition t_twice_len :: "nat"
- where
- "t_twice_len = length t_twice div 2"
-
-definition t_wcode_main_first_part:: "tprog"
- where
- "t_wcode_main_first_part \<equiv>
- [(L, 1), (L, 2), (L, 7), (R, 3),
- (R, 4), (W0, 3), (R, 4), (R, 5),
- (W1, 6), (R, 5), (R, 13), (L, 6),
- (R, 0), (R, 8), (R, 9), (Nop, 8),
- (R, 10), (W0, 9), (R, 10), (R, 11),
- (W1, 12), (R, 11), (R, t_twice_len + 14), (L, 12)]"
-
-definition t_wcode_main :: "tprog"
- where
- "t_wcode_main = (t_wcode_main_first_part @ tshift t_twice 12 @ [(L, 1), (L, 1)]
- @ tshift t_fourtimes (t_twice_len + 13) @ [(L, 1), (L, 1)])"
-
-fun bl_bin :: "block list \<Rightarrow> nat"
- where
- "bl_bin [] = 0"
-| "bl_bin (Bk # xs) = 2 * bl_bin xs"
-| "bl_bin (Oc # xs) = Suc (2 * bl_bin xs)"
-
-declare bl_bin.simps[simp del]
-
-type_synonym bin_inv_t = "block list \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
-
-fun wcode_before_double :: "bin_inv_t"
- where
- "wcode_before_double ires rs (l, r) =
- (\<exists> ln rn. l = Bk # Bk # Bk\<^bsup>ln\<^esup> @ Oc # ires \<and>
- r = Oc\<^bsup>(Suc (Suc rs))\<^esup> @ Bk\<^bsup>rn \<^esup>)"
-
-declare wcode_before_double.simps[simp del]
-
-fun wcode_after_double :: "bin_inv_t"
- where
- "wcode_after_double ires rs (l, r) =
- (\<exists> ln rn. l = Bk # Bk # Bk\<^bsup>ln\<^esup> @ Oc # ires \<and>
- r = Oc\<^bsup>Suc (Suc (Suc 2*rs))\<^esup> @ Bk\<^bsup>rn\<^esup>)"
-
-declare wcode_after_double.simps[simp del]
-
-fun wcode_on_left_moving_1_B :: "bin_inv_t"
- where
- "wcode_on_left_moving_1_B ires rs (l, r) =
- (\<exists> ml mr rn. l = Bk\<^bsup>ml\<^esup> @ Oc # Oc # ires \<and>
- r = Bk\<^bsup>mr\<^esup> @ Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>rn\<^esup> \<and>
- ml + mr > Suc 0 \<and> mr > 0)"
-
-declare wcode_on_left_moving_1_B.simps[simp del]
-
-fun wcode_on_left_moving_1_O :: "bin_inv_t"
- where
- "wcode_on_left_moving_1_O ires rs (l, r) =
- (\<exists> ln rn.
- l = Oc # ires \<and>
- r = Oc # Bk\<^bsup>ln\<^esup> @ Bk # Bk # Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>rn\<^esup>)"
-
-declare wcode_on_left_moving_1_O.simps[simp del]
-
-fun wcode_on_left_moving_1 :: "bin_inv_t"
- where
- "wcode_on_left_moving_1 ires rs (l, r) =
- (wcode_on_left_moving_1_B ires rs (l, r) \<or> wcode_on_left_moving_1_O ires rs (l, r))"
-
-declare wcode_on_left_moving_1.simps[simp del]
-
-fun wcode_on_checking_1 :: "bin_inv_t"
- where
- "wcode_on_checking_1 ires rs (l, r) =
- (\<exists> ln rn. l = ires \<and>
- r = Oc # Oc # Bk\<^bsup>ln\<^esup> @ Bk # Bk # Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>rn\<^esup>)"
-
-fun wcode_erase1 :: "bin_inv_t"
- where
-"wcode_erase1 ires rs (l, r) =
- (\<exists> ln rn. l = Oc # ires \<and>
- tl r = Bk\<^bsup>ln\<^esup> @ Bk # Bk # Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>rn\<^esup>)"
-
-declare wcode_erase1.simps [simp del]
-
-fun wcode_on_right_moving_1 :: "bin_inv_t"
- where
- "wcode_on_right_moving_1 ires rs (l, r) =
- (\<exists> ml mr rn.
- l = Bk\<^bsup>ml\<^esup> @ Oc # ires \<and>
- r = Bk\<^bsup>mr\<^esup> @ Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>rn\<^esup> \<and>
- ml + mr > Suc 0)"
-
-declare wcode_on_right_moving_1.simps [simp del]
-
-declare wcode_on_right_moving_1.simps[simp del]
-
-fun wcode_goon_right_moving_1 :: "bin_inv_t"
- where
- "wcode_goon_right_moving_1 ires rs (l, r) =
- (\<exists> ml mr ln rn.
- l = Oc\<^bsup>ml\<^esup> @ Bk # Bk # Bk\<^bsup>ln\<^esup> @ Oc # ires \<and>
- r = Oc\<^bsup>mr\<^esup> @ Bk\<^bsup>rn\<^esup> \<and>
- ml + mr = Suc rs)"
-
-declare wcode_goon_right_moving_1.simps[simp del]
-
-fun wcode_backto_standard_pos_B :: "bin_inv_t"
- where
- "wcode_backto_standard_pos_B ires rs (l, r) =
- (\<exists> ln rn. l = Bk # Bk\<^bsup>ln\<^esup> @ Oc # ires \<and>
- r = Bk # Oc\<^bsup>(Suc (Suc rs))\<^esup> @ Bk\<^bsup>rn \<^esup>)"
-
-declare wcode_backto_standard_pos_B.simps[simp del]
-
-fun wcode_backto_standard_pos_O :: "bin_inv_t"
- where
- "wcode_backto_standard_pos_O ires rs (l, r) =
- (\<exists> ml mr ln rn.
- l = Oc\<^bsup>ml\<^esup> @ Bk # Bk # Bk\<^bsup>ln\<^esup> @ Oc # ires \<and>
- r = Oc\<^bsup>mr\<^esup> @ Bk\<^bsup>rn\<^esup> \<and>
- ml + mr = Suc (Suc rs) \<and> mr > 0)"
-
-declare wcode_backto_standard_pos_O.simps[simp del]
-
-fun wcode_backto_standard_pos :: "bin_inv_t"
- where
- "wcode_backto_standard_pos ires rs (l, r) = (wcode_backto_standard_pos_B ires rs (l, r) \<or>
- wcode_backto_standard_pos_O ires rs (l, r))"
-
-declare wcode_backto_standard_pos.simps[simp del]
-
-lemma [simp]: "<0::nat> = [Oc]"
-apply(simp add: tape_of_nat_abv exponent_def tape_of_nat_list.simps)
-done
-
-lemma tape_of_Suc_nat: "<Suc (a ::nat)> = replicate a Oc @ [Oc, Oc]"
-apply(simp add: tape_of_nat_abv exp_ind tape_of_nat_list.simps)
-apply(simp only: exp_ind_def[THEN sym])
-apply(simp only: exp_ind, simp, simp add: exponent_def)
-done
-
-lemma [simp]: "length (<a::nat>) = Suc a"
-apply(simp add: tape_of_nat_abv tape_of_nat_list.simps)
-done
-
-lemma [simp]: "<[a::nat]> = <a>"
-apply(simp add: tape_of_nat_abv tape_of_nl_abv exponent_def
- tape_of_nat_list.simps)
-done
-
-lemma bin_wc_eq: "bl_bin xs = bl2wc xs"
-proof(induct xs)
- show " bl_bin [] = bl2wc []"
- apply(simp add: bl_bin.simps)
- done
-next
- fix a xs
- assume "bl_bin xs = bl2wc xs"
- thus " bl_bin (a # xs) = bl2wc (a # xs)"
- apply(case_tac a, simp_all add: bl_bin.simps bl2wc.simps)
- apply(simp_all add: bl2nat.simps bl2nat_double)
- done
-qed
-
-declare exp_def[simp del]
-
-lemma bl_bin_nat_Suc:
- "bl_bin (<Suc a>) = bl_bin (<a>) + 2^(Suc a)"
-apply(simp add: tape_of_nat_abv bin_wc_eq)
-apply(simp add: bl2wc.simps)
-done
-lemma [simp]: " rev (a\<^bsup>aa\<^esup>) = a\<^bsup>aa\<^esup>"
-apply(simp add: exponent_def)
-done
-
-declare tape_of_nl_abv_cons[simp del]
-
-lemma tape_of_nl_rev: "rev (<lm::nat list>) = (<rev lm>)"
-apply(induct lm rule: list_tl_induct, simp)
-apply(case_tac "list = []", simp add: tape_of_nl_abv tape_of_nat_list.simps)
-apply(simp add: tape_of_nat_list_butlast_last tape_of_nl_abv_cons)
-done
-lemma [simp]: "a\<^bsup>Suc 0\<^esup> = [a]"
-by(simp add: exp_def)
-lemma tape_of_nl_cons_app1: "(<a # xs @ [b]>) = (Oc\<^bsup>Suc a\<^esup> @ Bk # (<xs@ [b]>))"
-apply(case_tac xs, simp add: tape_of_nl_abv tape_of_nat_list.simps)
-apply(simp add: tape_of_nl_abv tape_of_nat_list.simps)
-done
-
-lemma bl_bin_bk_oc[simp]:
- "bl_bin (xs @ [Bk, Oc]) =
- bl_bin xs + 2*2^(length xs)"
-apply(simp add: bin_wc_eq)
-using bl2nat_cons_oc[of "xs @ [Bk]"]
-apply(simp add: bl2nat_cons_bk bl2wc.simps)
-done
-
-lemma tape_of_nat[simp]: "(<a::nat>) = Oc\<^bsup>Suc a\<^esup>"
-apply(simp add: tape_of_nat_abv)
-done
-lemma tape_of_nl_cons_app2: "(<c # xs @ [b]>) = (<c # xs> @ Bk # Oc\<^bsup>Suc b\<^esup>)"
-proof(induct "length xs" arbitrary: xs c,
- simp add: tape_of_nl_abv tape_of_nat_list.simps)
- fix x xs c
- assume ind: "\<And>xs c. x = length xs \<Longrightarrow> <c # xs @ [b]> =
- <c # xs> @ Bk # Oc\<^bsup>Suc b\<^esup>"
- and h: "Suc x = length (xs::nat list)"
- show "<c # xs @ [b]> = <c # xs> @ Bk # Oc\<^bsup>Suc b\<^esup>"
- proof(case_tac xs, simp add: tape_of_nl_abv tape_of_nat_list.simps)
- fix a list
- assume g: "xs = a # list"
- hence k: "<a # list @ [b]> = <a # list> @ Bk # Oc\<^bsup>Suc b\<^esup>"
- apply(rule_tac ind)
- using h
- apply(simp)
- done
- from g and k show "<c # xs @ [b]> = <c # xs> @ Bk # Oc\<^bsup>Suc b\<^esup>"
- apply(simp add: tape_of_nl_abv tape_of_nat_list.simps)
- done
- qed
-qed
-
-lemma [simp]: "length (<aa # a # list>) = Suc (Suc aa) + length (<a # list>)"
-apply(simp add: tape_of_nl_abv tape_of_nat_list.simps)
-done
-
-lemma [simp]: "bl_bin (Oc\<^bsup>Suc aa\<^esup> @ Bk # tape_of_nat_list (a # lista) @ [Bk, Oc]) =
- bl_bin (Oc\<^bsup>Suc aa\<^esup> @ Bk # tape_of_nat_list (a # lista)) +
- 2* 2^(length (Oc\<^bsup>Suc aa\<^esup> @ Bk # tape_of_nat_list (a # lista)))"
-using bl_bin_bk_oc[of "Oc\<^bsup>Suc aa\<^esup> @ Bk # tape_of_nat_list (a # lista)"]
-apply(simp)
-done
-
-lemma [simp]:
- "bl_bin (<aa # list>) + (4 * rs + 4) * 2 ^ (length (<aa # list>) - Suc 0)
- = bl_bin (Oc\<^bsup>Suc aa\<^esup> @ Bk # <list @ [0]>) + rs * (2 * 2 ^ (aa + length (<list @ [0]>)))"
-apply(case_tac "list", simp add: add_mult_distrib, simp)
-apply(simp add: tape_of_nl_cons_app2 add_mult_distrib)
-apply(simp add: tape_of_nl_abv tape_of_nat_list.simps)
-done
-
-lemma tape_of_nl_app_Suc: "((<list @ [Suc ab]>)) = (<list @ [ab]>) @ [Oc]"
-apply(induct list)
-apply(simp add: tape_of_nl_abv tape_of_nat_list.simps exp_ind)
-apply(case_tac list)
-apply(simp_all add:tape_of_nl_abv tape_of_nat_list.simps exp_ind)
-done
-
-lemma [simp]: "bl_bin (Oc # Oc\<^bsup>aa\<^esup> @ Bk # <list @ [ab]> @ [Oc])
- = bl_bin (Oc # Oc\<^bsup>aa\<^esup> @ Bk # <list @ [ab]>) +
- 2^(length (Oc # Oc\<^bsup>aa\<^esup> @ Bk # <list @ [ab]>))"
-apply(simp add: bin_wc_eq)
-apply(simp add: bl2nat_cons_oc bl2wc.simps)
-using bl2nat_cons_oc[of "Oc # Oc\<^bsup>aa\<^esup> @ Bk # <list @ [ab]>"]
-apply(simp)
-done
-lemma [simp]: "bl_bin (Oc # Oc\<^bsup>aa\<^esup> @ Bk # <list @ [ab]>) + (4 * 2 ^ (aa + length (<list @ [ab]>)) +
- 4 * (rs * 2 ^ (aa + length (<list @ [ab]>)))) =
- bl_bin (Oc # Oc\<^bsup>aa\<^esup> @ Bk # <list @ [Suc ab]>) +
- rs * (2 * 2 ^ (aa + length (<list @ [Suc ab]>)))"
-apply(simp add: tape_of_nl_app_Suc)
-done
-
-declare tape_of_nat[simp del]
-
-fun wcode_double_case_inv :: "nat \<Rightarrow> bin_inv_t"
- where
- "wcode_double_case_inv st ires rs (l, r) =
- (if st = Suc 0 then wcode_on_left_moving_1 ires rs (l, r)
- else if st = Suc (Suc 0) then wcode_on_checking_1 ires rs (l, r)
- else if st = 3 then wcode_erase1 ires rs (l, r)
- else if st = 4 then wcode_on_right_moving_1 ires rs (l, r)
- else if st = 5 then wcode_goon_right_moving_1 ires rs (l, r)
- else if st = 6 then wcode_backto_standard_pos ires rs (l, r)
- else if st = 13 then wcode_before_double ires rs (l, r)
- else False)"
-
-declare wcode_double_case_inv.simps[simp del]
-
-fun wcode_double_case_state :: "t_conf \<Rightarrow> nat"
- where
- "wcode_double_case_state (st, l, r) =
- 13 - st"
-
-fun wcode_double_case_step :: "t_conf \<Rightarrow> nat"
- where
- "wcode_double_case_step (st, l, r) =
- (if st = Suc 0 then (length l)
- else if st = Suc (Suc 0) then (length r)
- else if st = 3 then
- if hd r = Oc then 1 else 0
- else if st = 4 then (length r)
- else if st = 5 then (length r)
- else if st = 6 then (length l)
- else 0)"
-
-fun wcode_double_case_measure :: "t_conf \<Rightarrow> nat \<times> nat"
- where
- "wcode_double_case_measure (st, l, r) =
- (wcode_double_case_state (st, l, r),
- wcode_double_case_step (st, l, r))"
-
-definition wcode_double_case_le :: "(t_conf \<times> t_conf) set"
- where "wcode_double_case_le \<equiv> (inv_image lex_pair wcode_double_case_measure)"
-
-lemma [intro]: "wf lex_pair"
-by(auto intro:wf_lex_prod simp:lex_pair_def)
-
-lemma wf_wcode_double_case_le[intro]: "wf wcode_double_case_le"
-by(auto intro:wf_inv_image simp: wcode_double_case_le_def )
-term fetch
-
-lemma [simp]: "fetch t_wcode_main (Suc 0) Bk = (L, Suc 0)"
-apply(simp add: t_wcode_main_def t_wcode_main_first_part_def
- fetch.simps nth_of.simps)
-done
-
-lemma [simp]: "fetch t_wcode_main (Suc 0) Oc = (L, Suc (Suc 0))"
-apply(simp add: t_wcode_main_def t_wcode_main_first_part_def
- fetch.simps nth_of.simps)
-done
-
-lemma [simp]: "fetch t_wcode_main (Suc (Suc 0)) Oc = (R, 3)"
-apply(simp add: t_wcode_main_def t_wcode_main_first_part_def
- fetch.simps nth_of.simps)
-done
-
-lemma [simp]: "fetch t_wcode_main (Suc (Suc (Suc 0))) Bk = (R, 4)"
-apply(simp add: t_wcode_main_def t_wcode_main_first_part_def
- fetch.simps nth_of.simps)
-done
-
-lemma [simp]: "fetch t_wcode_main (Suc (Suc (Suc 0))) Oc = (W0, 3)"
-apply(simp add: t_wcode_main_def t_wcode_main_first_part_def
- fetch.simps nth_of.simps)
-done
-
-lemma [simp]: "fetch t_wcode_main 4 Bk = (R, 4)"
-apply(simp add: t_wcode_main_def t_wcode_main_first_part_def
- fetch.simps nth_of.simps)
-done
-
-lemma [simp]: "fetch t_wcode_main 4 Oc = (R, 5)"
-apply(simp add: t_wcode_main_def t_wcode_main_first_part_def
- fetch.simps nth_of.simps)
-done
-
-lemma [simp]: "fetch t_wcode_main 5 Oc = (R, 5)"
-apply(simp add: t_wcode_main_def t_wcode_main_first_part_def
- fetch.simps nth_of.simps)
-done
-
-lemma [simp]: "fetch t_wcode_main 5 Bk = (W1, 6)"
-apply(simp add: t_wcode_main_def t_wcode_main_first_part_def
- fetch.simps nth_of.simps)
-done
-
-lemma [simp]: "fetch t_wcode_main 6 Bk = (R, 13)"
-apply(simp add: t_wcode_main_def t_wcode_main_first_part_def
- fetch.simps nth_of.simps)
-done
-
-lemma [simp]: "fetch t_wcode_main 6 Oc = (L, 6)"
-apply(simp add: t_wcode_main_def t_wcode_main_first_part_def
- fetch.simps nth_of.simps)
-done
-lemma [elim]: "Bk\<^bsup>mr\<^esup> = [] \<Longrightarrow> mr = 0"
-apply(case_tac mr, auto simp: exponent_def)
-done
-
-lemma [simp]: "wcode_on_left_moving_1 ires rs (b, []) = False"
-apply(simp add: wcode_on_left_moving_1.simps wcode_on_left_moving_1_B.simps
- wcode_on_left_moving_1_O.simps, auto)
-done
-
-
-declare wcode_on_checking_1.simps[simp del]
-
-lemmas wcode_double_case_inv_simps =
- wcode_on_left_moving_1.simps wcode_on_left_moving_1_O.simps
- wcode_on_left_moving_1_B.simps wcode_on_checking_1.simps
- wcode_erase1.simps wcode_on_right_moving_1.simps
- wcode_goon_right_moving_1.simps wcode_backto_standard_pos.simps
-
-
-lemma [simp]: "wcode_on_left_moving_1 ires rs (b, r) \<Longrightarrow> b \<noteq> []"
-apply(simp add: wcode_double_case_inv_simps, auto)
-done
-
-
-lemma [elim]: "\<lbrakk>wcode_on_left_moving_1 ires rs (b, Bk # list);
- tl b = aa \<and> hd b # Bk # list = ba\<rbrakk> \<Longrightarrow>
- wcode_on_left_moving_1 ires rs (aa, ba)"
-apply(simp only: wcode_on_left_moving_1.simps wcode_on_left_moving_1_O.simps
- wcode_on_left_moving_1_B.simps)
-apply(erule_tac disjE)
-apply(erule_tac exE)+
-apply(case_tac ml, simp)
-apply(rule_tac x = "mr - Suc (Suc 0)" in exI, rule_tac x = rn in exI)
-apply(case_tac mr, simp, case_tac nat, simp, simp add: exp_ind)
-apply(rule_tac disjI1)
-apply(rule_tac x = nat in exI, rule_tac x = "Suc mr" in exI, rule_tac x = rn in exI,
- simp add: exp_ind_def)
-apply(erule_tac exE)+
-apply(simp)
-done
-
-
-lemma [elim]:
- "\<lbrakk>wcode_on_left_moving_1 ires rs (b, Oc # list); tl b = aa \<and> hd b # Oc # list = ba\<rbrakk>
- \<Longrightarrow> wcode_on_checking_1 ires rs (aa, ba)"
-apply(simp only: wcode_double_case_inv_simps)
-apply(erule_tac disjE)
-apply(erule_tac [!] exE)+
-apply(case_tac mr, simp, simp add: exp_ind_def)
-apply(rule_tac x = ln in exI, rule_tac x = rn in exI, simp)
-done
-
-
-lemma [simp]: "wcode_on_checking_1 ires rs (b, []) = False"
-apply(auto simp: wcode_double_case_inv_simps)
-done
-
-lemma [simp]: "wcode_on_checking_1 ires rs (b, Bk # list) = False"
-apply(auto simp: wcode_double_case_inv_simps)
-done
-
-lemma [elim]: "\<lbrakk>wcode_on_checking_1 ires rs (b, Oc # ba);Oc # b = aa \<and> list = ba\<rbrakk>
- \<Longrightarrow> wcode_erase1 ires rs (aa, ba)"
-apply(simp only: wcode_double_case_inv_simps)
-apply(erule_tac exE)+
-apply(rule_tac x = ln in exI, rule_tac x = rn in exI, simp)
-done
-
-
-lemma [simp]: "wcode_on_checking_1 ires rs (b, []) = False"
-apply(simp add: wcode_double_case_inv_simps)
-done
-
-lemma [simp]: "wcode_on_checking_1 ires rs ([], Bk # list) = False"
-apply(simp add: wcode_double_case_inv_simps)
-done
-
-lemma [simp]: "wcode_erase1 ires rs (b, []) = False"
-apply(simp add: wcode_double_case_inv_simps)
-done
-
-lemma [simp]: "wcode_on_right_moving_1 ires rs (b, []) = False"
-apply(simp add: wcode_double_case_inv_simps exp_ind_def)
-done
-
-lemma [simp]: "wcode_on_right_moving_1 ires rs (b, []) = False"
-apply(simp add: wcode_double_case_inv_simps exp_ind_def)
-done
-
-lemma [elim]: "\<lbrakk>wcode_on_right_moving_1 ires rs (b, Bk # ba); Bk # b = aa \<and> list = b\<rbrakk> \<Longrightarrow>
- wcode_on_right_moving_1 ires rs (aa, ba)"
-apply(simp only: wcode_double_case_inv_simps)
-apply(erule_tac exE)+
-apply(rule_tac x = "Suc ml" in exI, rule_tac x = "mr - Suc 0" in exI,
- rule_tac x = rn in exI)
-apply(simp add: exp_ind_def)
-apply(case_tac mr, simp, simp add: exp_ind_def)
-done
-
-lemma [elim]:
- "\<lbrakk>wcode_on_right_moving_1 ires rs (b, Oc # ba); Oc # b = aa \<and> list = ba\<rbrakk>
- \<Longrightarrow> wcode_goon_right_moving_1 ires rs (aa, ba)"
-apply(simp only: wcode_double_case_inv_simps)
-apply(erule_tac exE)+
-apply(rule_tac x = "Suc 0" in exI, rule_tac x = "rs" in exI,
- rule_tac x = "ml - Suc (Suc 0)" in exI, rule_tac x = rn in exI)
-apply(case_tac mr, simp_all add: exp_ind_def)
-apply(case_tac ml, simp, case_tac nat, simp, simp)
-apply(simp add: exp_ind_def)
-done
-
-lemma [simp]:
- "wcode_on_right_moving_1 ires rs (b, []) \<Longrightarrow> False"
-apply(simp add: wcode_double_case_inv_simps exponent_def)
-done
-
-lemma [elim]: "\<lbrakk>wcode_erase1 ires rs (b, Bk # ba); Bk # b = aa \<and> list = ba; c = Bk # ba\<rbrakk>
- \<Longrightarrow> wcode_on_right_moving_1 ires rs (aa, ba)"
-apply(simp only: wcode_double_case_inv_simps)
-apply(erule_tac exE)+
-apply(rule_tac x = "Suc 0" in exI, rule_tac x = "Suc (Suc ln)" in exI,
- rule_tac x = rn in exI, simp add: exp_ind)
-done
-
-lemma [elim]: "\<lbrakk>wcode_erase1 ires rs (aa, Oc # list); b = aa \<and> Bk # list = ba\<rbrakk> \<Longrightarrow>
- wcode_erase1 ires rs (aa, ba)"
-apply(simp only: wcode_double_case_inv_simps)
-apply(erule_tac exE)+
-apply(rule_tac x = ln in exI, rule_tac x = rn in exI, auto)
-done
-
-lemma [elim]: "\<lbrakk>wcode_goon_right_moving_1 ires rs (aa, []); b = aa \<and> [Oc] = ba\<rbrakk>
- \<Longrightarrow> wcode_backto_standard_pos ires rs (aa, ba)"
-apply(simp only: wcode_double_case_inv_simps)
-apply(erule_tac exE)+
-apply(rule_tac disjI2)
-apply(simp only:wcode_backto_standard_pos_O.simps)
-apply(rule_tac x = ml in exI, rule_tac x = "Suc 0" in exI, rule_tac x = ln in exI,
- rule_tac x = rn in exI, simp)
-apply(case_tac mr, simp_all add: exponent_def)
-done
-
-lemma [elim]:
- "\<lbrakk>wcode_goon_right_moving_1 ires rs (aa, Bk # list); b = aa \<and> Oc # list = ba\<rbrakk>
- \<Longrightarrow> wcode_backto_standard_pos ires rs (aa, ba)"
-apply(simp only: wcode_double_case_inv_simps)
-apply(erule_tac exE)+
-apply(rule_tac disjI2)
-apply(simp only:wcode_backto_standard_pos_O.simps)
-apply(rule_tac x = ml in exI, rule_tac x = "Suc 0" in exI, rule_tac x = ln in exI,
- rule_tac x = "rn - Suc 0" in exI, simp)
-apply(case_tac mr, simp, case_tac rn, simp, simp_all add: exp_ind_def)
-done
-
-lemma [elim]: "\<lbrakk>wcode_goon_right_moving_1 ires rs (b, Oc # ba); Oc # b = aa \<and> list = ba\<rbrakk>
- \<Longrightarrow> wcode_goon_right_moving_1 ires rs (aa, ba)"
-apply(simp only: wcode_double_case_inv_simps)
-apply(erule_tac exE)+
-apply(rule_tac x = "Suc ml" in exI, rule_tac x = "mr - Suc 0" in exI,
- rule_tac x = ln in exI, rule_tac x = rn in exI)
-apply(simp add: exp_ind_def)
-apply(case_tac mr, simp, case_tac rn, simp_all add: exp_ind_def)
-done
-
-lemma [elim]: "\<lbrakk>wcode_backto_standard_pos ires rs (b, []); Bk # b = aa\<rbrakk> \<Longrightarrow> False"
-apply(auto simp: wcode_double_case_inv_simps wcode_backto_standard_pos_O.simps
- wcode_backto_standard_pos_B.simps)
-apply(case_tac mr, simp_all add: exp_ind_def)
-done
-
-lemma [elim]: "\<lbrakk>wcode_backto_standard_pos ires rs (b, Bk # ba); Bk # b = aa \<and> list = ba\<rbrakk>
- \<Longrightarrow> wcode_before_double ires rs (aa, ba)"
-apply(simp only: wcode_double_case_inv_simps wcode_backto_standard_pos_B.simps
- wcode_backto_standard_pos_O.simps wcode_before_double.simps)
-apply(erule_tac disjE)
-apply(erule_tac exE)+
-apply(rule_tac x = ln in exI, rule_tac x = rn in exI, simp)
-apply(auto)
-apply(case_tac [!] mr, simp_all add: exp_ind_def)
-done
-
-lemma [simp]: "wcode_backto_standard_pos ires rs ([], Oc # list) = False"
-apply(auto simp: wcode_backto_standard_pos.simps wcode_backto_standard_pos_B.simps
- wcode_backto_standard_pos_O.simps)
-done
-
-lemma [simp]: "wcode_backto_standard_pos ires rs (b, []) = False"
-apply(auto simp: wcode_backto_standard_pos.simps wcode_backto_standard_pos_B.simps
- wcode_backto_standard_pos_O.simps)
-apply(case_tac mr, simp, simp add: exp_ind_def)
-done
-
-lemma [elim]: "\<lbrakk>wcode_backto_standard_pos ires rs (b, Oc # list); tl b = aa; hd b # Oc # list = ba\<rbrakk>
- \<Longrightarrow> wcode_backto_standard_pos ires rs (aa, ba)"
-apply(simp only: wcode_backto_standard_pos.simps wcode_backto_standard_pos_B.simps
- wcode_backto_standard_pos_O.simps)
-apply(erule_tac disjE)
-apply(simp)
-apply(erule_tac exE)+
-apply(case_tac ml, simp)
-apply(rule_tac disjI1, rule_tac conjI)
-apply(rule_tac x = ln in exI, simp, rule_tac x = rn in exI, simp)
-apply(rule_tac disjI2)
-apply(rule_tac x = nat in exI, rule_tac x = "Suc mr" in exI, rule_tac x = ln in exI,
- rule_tac x = rn in exI, simp)
-apply(simp add: exp_ind_def)
-done
-
-declare new_tape.simps[simp del] nth_of.simps[simp del] fetch.simps[simp del]
-lemma wcode_double_case_first_correctness:
- "let P = (\<lambda> (st, l, r). st = 13) in
- let Q = (\<lambda> (st, l, r). wcode_double_case_inv st ires rs (l, r)) in
- let f = (\<lambda> stp. steps (Suc 0, Bk # Bk\<^bsup>m\<^esup> @ Oc # Oc # ires, Bk # Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>n\<^esup>) t_wcode_main stp) in
- \<exists> n .P (f n) \<and> Q (f (n::nat))"
-proof -
- let ?P = "(\<lambda> (st, l, r). st = 13)"
- let ?Q = "(\<lambda> (st, l, r). wcode_double_case_inv st ires rs (l, r))"
- let ?f = "(\<lambda> stp. steps (Suc 0, Bk # Bk\<^bsup>m\<^esup> @ Oc # Oc # ires, Bk # Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>n\<^esup>) t_wcode_main stp)"
- have "\<exists> n. ?P (?f n) \<and> ?Q (?f (n::nat))"
- proof(rule_tac halt_lemma2)
- show "wf wcode_double_case_le"
- by auto
- next
- show "\<forall> na. \<not> ?P (?f na) \<and> ?Q (?f na) \<longrightarrow>
- ?Q (?f (Suc na)) \<and> (?f (Suc na), ?f na) \<in> wcode_double_case_le"
- proof(rule_tac allI, case_tac "?f na", simp add: tstep_red)
- fix na a b c
- show "a \<noteq> 13 \<and> wcode_double_case_inv a ires rs (b, c) \<longrightarrow>
- (case tstep (a, b, c) t_wcode_main of (st, x) \<Rightarrow>
- wcode_double_case_inv st ires rs x) \<and>
- (tstep (a, b, c) t_wcode_main, a, b, c) \<in> wcode_double_case_le"
- apply(rule_tac impI, simp add: wcode_double_case_inv.simps)
- apply(auto split: if_splits simp: tstep.simps,
- case_tac [!] c, simp_all, case_tac [!] "(c::block list)!0")
- apply(simp_all add: new_tape.simps wcode_double_case_inv.simps wcode_double_case_le_def
- lex_pair_def)
- apply(auto split: if_splits)
- done
- qed
- next
- show "?Q (?f 0)"
- apply(simp add: steps.simps wcode_double_case_inv.simps
- wcode_on_left_moving_1.simps
- wcode_on_left_moving_1_B.simps)
- apply(rule_tac disjI1)
- apply(rule_tac x = "Suc m" in exI, simp add: exp_ind_def)
- apply(rule_tac x = "Suc 0" in exI, simp add: exp_ind_def)
- apply(auto)
- done
- next
- show "\<not> ?P (?f 0)"
- apply(simp add: steps.simps)
- done
- qed
- thus "let P = \<lambda>(st, l, r). st = 13;
- Q = \<lambda>(st, l, r). wcode_double_case_inv st ires rs (l, r);
- f = steps (Suc 0, Bk # Bk\<^bsup>m\<^esup> @ Oc # Oc # ires, Bk # Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>n\<^esup>) t_wcode_main
- in \<exists>n. P (f n) \<and> Q (f n)"
- apply(simp add: Let_def)
- done
-qed
-
-lemma [elim]: "t_ncorrect tp
- \<Longrightarrow> t_ncorrect (abacus.tshift tp a)"
-apply(simp add: t_ncorrect.simps shift_length)
-done
-
-lemma tshift_fetch: "\<lbrakk> fetch tp a b = (aa, st'); 0 < st'\<rbrakk>
- \<Longrightarrow> fetch (abacus.tshift tp (length tp1 div 2)) a b
- = (aa, st' + length tp1 div 2)"
-apply(subgoal_tac "a > 0")
-apply(auto simp: fetch.simps nth_of.simps shift_length nth_map
- tshift.simps split: block.splits if_splits)
-done
-
-lemma t_steps_steps_eq: "\<lbrakk>steps (st, l, r) tp stp = (st', l', r');
- 0 < st';
- 0 < st \<and> st \<le> length tp div 2;
- t_ncorrect tp1;
- t_ncorrect tp\<rbrakk>
- \<Longrightarrow> t_steps (st + length tp1 div 2, l, r) (tshift tp (length tp1 div 2),
- length tp1 div 2) stp
- = (st' + length tp1 div 2, l', r')"
-apply(induct stp arbitrary: st' l' r', simp add: steps.simps t_steps.simps,
- simp add: tstep_red stepn)
-apply(case_tac "(steps (st, l, r) tp stp)", simp)
-proof -
- fix stp st' l' r' a b c
- assume ind: "\<And>st' l' r'.
- \<lbrakk>a = st' \<and> b = l' \<and> c = r'; 0 < st'\<rbrakk>
- \<Longrightarrow> t_steps (st + length tp1 div 2, l, r)
- (abacus.tshift tp (length tp1 div 2), length tp1 div 2) stp =
- (st' + length tp1 div 2, l', r')"
- and h: "tstep (a, b, c) tp = (st', l', r')" "0 < st'" "t_ncorrect tp1" "t_ncorrect tp"
- have k: "t_steps (st + length tp1 div 2, l, r) (abacus.tshift tp (length tp1 div 2),
- length tp1 div 2) stp = (a + length tp1 div 2, b, c)"
- apply(rule_tac ind, simp)
- using h
- apply(case_tac a, simp_all add: tstep.simps fetch.simps)
- done
- from h and this show "t_step (t_steps (st + length tp1 div 2, l, r) (abacus.tshift tp (length tp1 div 2), length tp1 div 2) stp)
- (abacus.tshift tp (length tp1 div 2), length tp1 div 2) =
- (st' + length tp1 div 2, l', r')"
- apply(simp add: k)
- apply(simp add: tstep.simps t_step.simps)
- apply(case_tac "fetch tp a (case c of [] \<Rightarrow> Bk | x # xs \<Rightarrow> x)", simp)
- apply(subgoal_tac "fetch (abacus.tshift tp (length tp1 div 2)) a
- (case c of [] \<Rightarrow> Bk | x # xs \<Rightarrow> x) = (aa, st' + length tp1 div 2)", simp)
- apply(simp add: tshift_fetch)
- done
-qed
-
-lemma t_tshift_lemma: "\<lbrakk> steps (st, l, r) tp stp = (st', l', r');
- st' \<noteq> 0;
- stp > 0;
- 0 < st \<and> st \<le> length tp div 2;
- t_ncorrect tp1;
- t_ncorrect tp;
- t_ncorrect tp2
- \<rbrakk>
- \<Longrightarrow> \<exists> stp>0. steps (st + length tp1 div 2, l, r) (tp1 @ tshift tp (length tp1 div 2) @ tp2) stp
- = (st' + length tp1 div 2, l', r')"
-proof -
- assume h: "steps (st, l, r) tp stp = (st', l', r')"
- "st' \<noteq> 0" "stp > 0"
- "0 < st \<and> st \<le> length tp div 2"
- "t_ncorrect tp1"
- "t_ncorrect tp"
- "t_ncorrect tp2"
- from h have
- "\<exists>stp>0. t_steps (st + length tp1 div 2, l, r) (tp1 @ abacus.tshift tp (length tp1 div 2) @ tp2, 0) stp =
- (st' + length tp1 div 2, l', r')"
- apply(rule_tac stp = stp in turing_shift, simp_all add: shift_length)
- apply(simp add: t_steps_steps_eq)
- apply(simp add: t_ncorrect.simps shift_length)
- done
- thus "\<exists> stp>0. steps (st + length tp1 div 2, l, r) (tp1 @ tshift tp (length tp1 div 2) @ tp2) stp
- = (st' + length tp1 div 2, l', r')"
- apply(erule_tac exE)
- apply(rule_tac x = stp in exI, simp)
- apply(subgoal_tac "length (tp1 @ abacus.tshift tp (length tp1 div 2) @ tp2) mod 2 = 0")
- apply(simp only: steps_eq)
- using h
- apply(auto simp: t_ncorrect.simps shift_length)
- apply arith
- done
-qed
-
-
-lemma t_twice_len_ge: "Suc 0 \<le> length t_twice div 2"
-apply(simp add: t_twice_def tMp.simps shift_length)
-done
-
-lemma [intro]: "rec_calc_rel (recf.id (Suc 0) 0) [rs] rs"
- apply(rule_tac calc_id, simp_all)
- done
-
-lemma [intro]: "rec_calc_rel (constn 2) [rs] 2"
-using prime_rel_exec_eq[of "constn 2" "[rs]" 2]
-apply(subgoal_tac "primerec (constn 2) 1", auto)
-done
-
-lemma [intro]: "rec_calc_rel rec_mult [rs, 2] (2 * rs)"
-using prime_rel_exec_eq[of "rec_mult" "[rs, 2]" "2*rs"]
-apply(subgoal_tac "primerec rec_mult (Suc (Suc 0))", auto)
-done
-lemma t_twice_correct: "\<exists>stp ln rn. steps (Suc 0, Bk # Bk # ires, Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>n\<^esup>)
- (tm_of abc_twice @ tMp (Suc 0) (start_of twice_ly (length abc_twice) - Suc 0)) stp =
- (0, Bk\<^bsup>ln\<^esup> @ Bk # Bk # ires, Oc\<^bsup>Suc (2 * rs)\<^esup> @ Bk\<^bsup>rn\<^esup>)"
-proof(case_tac "rec_ci rec_twice")
- fix a b c
- assume h: "rec_ci rec_twice = (a, b, c)"
- have "\<exists>stp m l. steps (Suc 0, Bk # Bk # ires, <[rs]> @ Bk\<^bsup>n\<^esup>) (tm_of abc_twice @ tMp (Suc 0)
- (start_of twice_ly (length abc_twice) - 1)) stp = (0, Bk\<^bsup>m\<^esup> @ Bk # Bk # ires, Oc\<^bsup>Suc (2*rs)\<^esup> @ Bk\<^bsup>l\<^esup>)"
- proof(rule_tac t_compiled_by_rec)
- show "rec_ci rec_twice = (a, b, c)" by (simp add: h)
- next
- show "rec_calc_rel rec_twice [rs] (2 * rs)"
- apply(simp add: rec_twice_def)
- apply(rule_tac rs = "[rs, 2]" in calc_cn, simp_all)
- apply(rule_tac allI, case_tac k, auto)
- done
- next
- show "length [rs] = Suc 0" by simp
- next
- show "layout_of (a [+] dummy_abc (Suc 0)) = layout_of (a [+] dummy_abc (Suc 0))"
- by simp
- next
- show "start_of twice_ly (length abc_twice) =
- start_of (layout_of (a [+] dummy_abc (Suc 0))) (length (a [+] dummy_abc (Suc 0)))"
- using h
- apply(simp add: twice_ly_def abc_twice_def)
- done
- next
- show "tm_of abc_twice = tm_of (a [+] dummy_abc (Suc 0))"
- using h
- apply(simp add: abc_twice_def)
- done
- qed
- thus "\<exists>stp ln rn. steps (Suc 0, Bk # Bk # ires, Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>n\<^esup>)
- (tm_of abc_twice @ tMp (Suc 0) (start_of twice_ly (length abc_twice) - Suc 0)) stp =
- (0, Bk\<^bsup>ln\<^esup> @ Bk # Bk # ires, Oc\<^bsup>Suc (2 * rs)\<^esup> @ Bk\<^bsup>rn\<^esup>)"
- apply(simp add: tape_of_nl_abv tape_of_nat_list.simps)
- done
-qed
-
-lemma change_termi_state_fetch: "\<lbrakk>fetch ap a b = (aa, st); st > 0\<rbrakk>
- \<Longrightarrow> fetch (change_termi_state ap) a b = (aa, st)"
-apply(case_tac b, auto simp: fetch.simps nth_of.simps change_termi_state.simps nth_map
- split: if_splits block.splits)
-done
-
-lemma change_termi_state_exec_in_range:
- "\<lbrakk>steps (st, l, r) ap stp = (st', l', r'); st' \<noteq> 0\<rbrakk>
- \<Longrightarrow> steps (st, l, r) (change_termi_state ap) stp = (st', l', r')"
-proof(induct stp arbitrary: st l r st' l' r', simp add: steps.simps)
- fix stp st l r st' l' r'
- assume ind: "\<And>st l r st' l' r'.
- \<lbrakk>steps (st, l, r) ap stp = (st', l', r'); st' \<noteq> 0\<rbrakk> \<Longrightarrow>
- steps (st, l, r) (change_termi_state ap) stp = (st', l', r')"
- and h: "steps (st, l, r) ap (Suc stp) = (st', l', r')" "st' \<noteq> 0"
- from h show "steps (st, l, r) (change_termi_state ap) (Suc stp) = (st', l', r')"
- proof(simp add: tstep_red, case_tac "steps (st, l, r) ap stp", simp)
- fix a b c
- assume g: "steps (st, l, r) ap stp = (a, b, c)"
- "tstep (a, b, c) ap = (st', l', r')" "0 < st'"
- hence "steps (st, l, r) (change_termi_state ap) stp = (a, b, c)"
- apply(rule_tac ind, simp)
- apply(case_tac a, simp_all add: tstep_0)
- done
- from g and this show "tstep (steps (st, l, r) (change_termi_state ap) stp)
- (change_termi_state ap) = (st', l', r')"
- apply(simp add: tstep.simps)
- apply(case_tac "fetch ap a (case c of [] \<Rightarrow> Bk | x # xs \<Rightarrow> x)", simp)
- apply(subgoal_tac "fetch (change_termi_state ap) a (case c of [] \<Rightarrow> Bk | x # xs \<Rightarrow> x)
- = (aa, st')", simp)
- apply(simp add: change_termi_state_fetch)
- done
- qed
-qed
-
-lemma change_termi_state_fetch0:
- "\<lbrakk>0 < a; a \<le> length ap div 2; t_correct ap; fetch ap a b = (aa, 0)\<rbrakk>
- \<Longrightarrow> fetch (change_termi_state ap) a b = (aa, Suc (length ap div 2))"
-apply(case_tac b, auto simp: fetch.simps nth_of.simps change_termi_state.simps nth_map
- split: if_splits block.splits)
-done
-
-lemma turing_change_termi_state:
- "\<lbrakk>steps (Suc 0, l, r) ap stp = (0, l', r'); t_correct ap\<rbrakk>
- \<Longrightarrow> \<exists> stp. steps (Suc 0, l, r) (change_termi_state ap) stp =
- (Suc (length ap div 2), l', r')"
-apply(drule first_halt_point)
-apply(erule_tac exE)
-apply(rule_tac x = "Suc stp" in exI, simp add: tstep_red)
-apply(case_tac "steps (Suc 0, l, r) ap stp")
-apply(simp add: isS0_def change_termi_state_exec_in_range)
-apply(subgoal_tac "steps (Suc 0, l, r) (change_termi_state ap) stp = (a, b, c)", simp)
-apply(simp add: tstep.simps)
-apply(case_tac "fetch ap a (case c of [] \<Rightarrow> Bk | x # xs \<Rightarrow> x)", simp)
-apply(subgoal_tac "fetch (change_termi_state ap) a
- (case c of [] \<Rightarrow> Bk | x # xs \<Rightarrow> x) = (aa, Suc (length ap div 2))", simp)
-apply(rule_tac ap = ap in change_termi_state_fetch0, simp_all)
-apply(rule_tac tp = "(l, r)" and l = b and r = c and stp = stp and A = ap in s_keep, simp_all)
-apply(simp add: change_termi_state_exec_in_range)
-done
-
-lemma t_twice_change_term_state:
- "\<exists> stp ln rn. steps (Suc 0, Bk # Bk # ires, Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>n\<^esup>) t_twice stp
- = (Suc t_twice_len, Bk\<^bsup>ln\<^esup> @ Bk # Bk # ires, Oc\<^bsup>Suc (2 * rs)\<^esup> @ Bk\<^bsup>rn\<^esup>)"
-using t_twice_correct[of ires rs n]
-apply(erule_tac exE)
-apply(erule_tac exE)
-apply(erule_tac exE)
-proof(drule_tac turing_change_termi_state)
- fix stp ln rn
- show "t_correct (tm_of abc_twice @ tMp (Suc 0) (start_of twice_ly (length abc_twice) - Suc 0))"
- apply(rule_tac t_compiled_correct, simp_all)
- apply(simp add: twice_ly_def)
- done
-next
- fix stp ln rn
- show "\<exists>stp. steps (Suc 0, Bk # Bk # ires, Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>n\<^esup>)
- (change_termi_state (tm_of abc_twice @ tMp (Suc 0)
- (start_of twice_ly (length abc_twice) - Suc 0))) stp =
- (Suc (length (tm_of abc_twice @ tMp (Suc 0) (start_of twice_ly (length abc_twice) - Suc 0)) div 2),
- Bk\<^bsup>ln\<^esup> @ Bk # Bk # ires, Oc\<^bsup>Suc (2 * rs)\<^esup> @ Bk\<^bsup>rn\<^esup>) \<Longrightarrow>
- \<exists>stp ln rn. steps (Suc 0, Bk # Bk # ires, Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>n\<^esup>) t_twice stp =
- (Suc t_twice_len, Bk\<^bsup>ln\<^esup> @ Bk # Bk # ires, Oc\<^bsup>Suc (2 * rs)\<^esup> @ Bk\<^bsup>rn\<^esup>)"
- apply(erule_tac exE)
- apply(simp add: t_twice_len_def t_twice_def)
- apply(rule_tac x = stp in exI, rule_tac x = ln in exI, rule_tac x = rn in exI, simp)
- done
-qed
-
-lemma t_twice_append_pre:
- "steps (Suc 0, Bk # Bk # ires, Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>n\<^esup>) t_twice stp
- = (Suc t_twice_len, Bk\<^bsup>ln\<^esup> @ Bk # Bk # ires, Oc\<^bsup>Suc (2 * rs)\<^esup> @ Bk\<^bsup>rn\<^esup>)
- \<Longrightarrow> \<exists> stp>0. steps (Suc 0 + length t_wcode_main_first_part div 2, Bk # Bk # ires, Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>n\<^esup>)
- (t_wcode_main_first_part @ tshift t_twice (length t_wcode_main_first_part div 2) @
- ([(L, 1), (L, 1)] @ tshift t_fourtimes (t_twice_len + 13) @ [(L, 1), (L, 1)])) stp
- = (Suc (t_twice_len) + length t_wcode_main_first_part div 2, Bk\<^bsup>ln\<^esup> @ Bk # Bk # ires, Oc\<^bsup>Suc (2 * rs)\<^esup> @ Bk\<^bsup>rn\<^esup>)"
-proof(rule_tac t_tshift_lemma, simp_all add: t_twice_len_ge)
- assume "steps (Suc 0, Bk # Bk # ires, Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>n\<^esup>) t_twice stp =
- (Suc t_twice_len, Bk\<^bsup>ln\<^esup> @ Bk # Bk # ires, Oc\<^bsup>Suc (2 * rs)\<^esup> @ Bk\<^bsup>rn\<^esup>)"
- thus "0 < stp"
- apply(case_tac stp, simp add: steps.simps t_twice_len_ge t_twice_len_def)
- using t_twice_len_ge
- apply(simp, simp)
- done
-next
- show "t_ncorrect t_wcode_main_first_part"
- apply(simp add: t_ncorrect.simps t_wcode_main_first_part_def)
- done
-next
- show "t_ncorrect t_twice"
- using length_tm_even[of abc_twice]
- apply(auto simp: t_ncorrect.simps t_twice_def)
- apply(arith)
- done
-next
- show "t_ncorrect ((L, Suc 0) # (L, Suc 0) #
- abacus.tshift t_fourtimes (t_twice_len + 13) @ [(L, Suc 0), (L, Suc 0)])"
- using length_tm_even[of abc_fourtimes]
- apply(simp add: t_ncorrect.simps shift_length t_fourtimes_def)
- apply arith
- done
-qed
-
-lemma t_twice_append:
- "\<exists> stp ln rn. steps (Suc 0 + length t_wcode_main_first_part div 2, Bk # Bk # ires, Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>n\<^esup>)
- (t_wcode_main_first_part @ tshift t_twice (length t_wcode_main_first_part div 2) @
- ([(L, 1), (L, 1)] @ tshift t_fourtimes (t_twice_len + 13) @ [(L, 1), (L, 1)])) stp
- = (Suc (t_twice_len) + length t_wcode_main_first_part div 2, Bk\<^bsup>ln\<^esup> @ Bk # Bk # ires, Oc\<^bsup>Suc (2 * rs)\<^esup> @ Bk\<^bsup>rn\<^esup>)"
- using t_twice_change_term_state[of ires rs n]
- apply(erule_tac exE)
- apply(erule_tac exE)
- apply(erule_tac exE)
- apply(drule_tac t_twice_append_pre)
- apply(erule_tac exE)
- apply(rule_tac x = stpa in exI, rule_tac x = ln in exI, rule_tac x = rn in exI)
- apply(simp)
- done
-
-lemma [simp]: "fetch t_wcode_main (Suc (t_twice_len + length t_wcode_main_first_part div 2)) Oc
- = (L, Suc 0)"
-apply(subgoal_tac "length (t_twice) mod 2 = 0")
-apply(simp add: t_wcode_main_def nth_append fetch.simps t_wcode_main_first_part_def
- nth_of.simps shift_length t_twice_len_def, auto)
-apply(simp add: t_twice_def)
-apply(subgoal_tac "length (tm_of abc_twice) mod 2 = 0")
-apply arith
-apply(rule_tac tm_even)
-done
-
-lemma wcode_jump1:
- "\<exists> stp ln rn. steps (Suc (t_twice_len) + length t_wcode_main_first_part div 2,
- Bk\<^bsup>m\<^esup> @ Bk # Bk # ires, Oc\<^bsup>Suc (2 * rs)\<^esup> @ Bk\<^bsup>n\<^esup>)
- t_wcode_main stp
- = (Suc 0, Bk\<^bsup>ln\<^esup> @ Bk # ires, Bk # Oc\<^bsup>Suc (2 * rs)\<^esup> @ Bk\<^bsup>rn\<^esup>)"
-apply(rule_tac x = "Suc 0" in exI, rule_tac x = "m" in exI, rule_tac x = n in exI)
-apply(simp add: steps.simps tstep.simps exp_ind_def new_tape.simps)
-apply(case_tac m, simp, simp add: exp_ind_def)
-apply(simp add: exp_ind_def[THEN sym] exp_ind[THEN sym])
-done
-
-lemma wcode_main_first_part_len:
- "length t_wcode_main_first_part = 24"
- apply(simp add: t_wcode_main_first_part_def)
- done
-
-lemma wcode_double_case:
- shows "\<exists>stp ln rn. steps (Suc 0, Bk # Bk\<^bsup>m\<^esup> @ Oc # Oc # ires, Bk # Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>n\<^esup>) t_wcode_main stp =
- (Suc 0, Bk # Bk\<^bsup>ln\<^esup> @ Oc # ires, Bk # Oc\<^bsup>Suc (2 * rs + 2)\<^esup> @ Bk\<^bsup>rn\<^esup>)"
-proof -
- have "\<exists>stp ln rn. steps (Suc 0, Bk # Bk\<^bsup>m\<^esup> @ Oc # Oc # ires, Bk # Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>n\<^esup>) t_wcode_main stp =
- (13, Bk # Bk # Bk\<^bsup>ln\<^esup> @ Oc # ires, Oc\<^bsup>Suc (Suc rs)\<^esup> @ Bk\<^bsup>rn\<^esup>)"
- using wcode_double_case_first_correctness[of ires rs m n]
- apply(simp)
- apply(erule_tac exE)
- apply(case_tac "steps (Suc 0, Bk # Bk\<^bsup>m\<^esup> @ Oc # Oc # ires,
- Bk # Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>n\<^esup>) t_wcode_main na",
- auto simp: wcode_double_case_inv.simps
- wcode_before_double.simps)
- apply(rule_tac x = na in exI, rule_tac x = ln in exI, rule_tac x = rn in exI)
- apply(simp)
- done
- from this obtain stpa lna rna where stp1:
- "steps (Suc 0, Bk # Bk\<^bsup>m\<^esup> @ Oc # Oc # ires, Bk # Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>n\<^esup>) t_wcode_main stpa =
- (13, Bk # Bk # Bk\<^bsup>lna\<^esup> @ Oc # ires, Oc\<^bsup>Suc (Suc rs)\<^esup> @ Bk\<^bsup>rna\<^esup>)" by blast
- have "\<exists> stp ln rn. steps (13, Bk # Bk # Bk\<^bsup>lna\<^esup> @ Oc # ires, Oc\<^bsup>Suc (Suc rs)\<^esup> @ Bk\<^bsup>rna\<^esup>) t_wcode_main stp =
- (13 + t_twice_len, Bk # Bk # Bk\<^bsup>ln\<^esup> @ Oc # ires, Oc\<^bsup>Suc (Suc (Suc (2 *rs)))\<^esup> @ Bk\<^bsup>rn\<^esup>)"
- using t_twice_append[of "Bk\<^bsup>lna\<^esup> @ Oc # ires" "Suc rs" rna]
- apply(erule_tac exE)
- apply(erule_tac exE)
- apply(erule_tac exE)
- apply(simp add: wcode_main_first_part_len)
- apply(rule_tac x = stp in exI, rule_tac x = "ln + lna" in exI,
- rule_tac x = rn in exI)
- apply(simp add: t_wcode_main_def)
- apply(simp add: exp_ind_def[THEN sym] exp_add[THEN sym])
- done
- from this obtain stpb lnb rnb where stp2:
- "steps (13, Bk # Bk # Bk\<^bsup>lna\<^esup> @ Oc # ires, Oc\<^bsup>Suc (Suc rs)\<^esup> @ Bk\<^bsup>rna\<^esup>) t_wcode_main stpb =
- (13 + t_twice_len, Bk # Bk # Bk\<^bsup>lnb\<^esup> @ Oc # ires, Oc\<^bsup>Suc (Suc (Suc (2 *rs)))\<^esup> @ Bk\<^bsup>rnb\<^esup>)" by blast
- have "\<exists>stp ln rn. steps (13 + t_twice_len, Bk # Bk # Bk\<^bsup>lnb\<^esup> @ Oc # ires,
- Oc\<^bsup>Suc (Suc (Suc (2 *rs)))\<^esup> @ Bk\<^bsup>rnb\<^esup>) t_wcode_main stp =
- (Suc 0, Bk # Bk\<^bsup>ln\<^esup> @ Oc # ires, Bk # Oc\<^bsup>Suc (Suc (Suc (2 *rs)))\<^esup> @ Bk\<^bsup>rn\<^esup>)"
- using wcode_jump1[of lnb "Oc # ires" "Suc rs" rnb]
- apply(erule_tac exE)
- apply(erule_tac exE)
- apply(erule_tac exE)
- apply(rule_tac x = stp in exI,
- rule_tac x = ln in exI,
- rule_tac x = rn in exI, simp add:wcode_main_first_part_len t_wcode_main_def)
- apply(subgoal_tac "Bk\<^bsup>lnb\<^esup> @ Bk # Bk # Oc # ires = Bk # Bk # Bk\<^bsup>lnb\<^esup> @ Oc # ires", simp)
- apply(simp add: exp_ind_def[THEN sym] exp_ind[THEN sym])
- apply(simp)
- apply(case_tac lnb, simp, simp add: exp_ind_def[THEN sym] exp_ind)
- done
- from this obtain stpc lnc rnc where stp3:
- "steps (13 + t_twice_len, Bk # Bk # Bk\<^bsup>lnb\<^esup> @ Oc # ires,
- Oc\<^bsup>Suc (Suc (Suc (2 *rs)))\<^esup> @ Bk\<^bsup>rnb\<^esup>) t_wcode_main stpc =
- (Suc 0, Bk # Bk\<^bsup>lnc\<^esup> @ Oc # ires, Bk # Oc\<^bsup>Suc (Suc (Suc (2 *rs)))\<^esup> @ Bk\<^bsup>rnc\<^esup>)"
- by blast
- from stp1 stp2 stp3 show "?thesis"
- apply(rule_tac x = "stpa + stpb + stpc" in exI, rule_tac x = lnc in exI,
- rule_tac x = rnc in exI)
- apply(simp add: steps_add)
- done
-qed
-
-
-(* Begin: fourtime_case*)
-fun wcode_on_left_moving_2_B :: "bin_inv_t"
- where
- "wcode_on_left_moving_2_B ires rs (l, r) =
- (\<exists> ml mr rn. l = Bk\<^bsup>ml\<^esup> @ Oc # Bk # Oc # ires \<and>
- r = Bk\<^bsup>mr\<^esup> @ Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>rn\<^esup> \<and>
- ml + mr > Suc 0 \<and> mr > 0)"
-
-fun wcode_on_left_moving_2_O :: "bin_inv_t"
- where
- "wcode_on_left_moving_2_O ires rs (l, r) =
- (\<exists> ln rn. l = Bk # Oc # ires \<and>
- r = Oc # Bk\<^bsup>ln\<^esup> @ Bk # Bk # Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>rn\<^esup>)"
-
-fun wcode_on_left_moving_2 :: "bin_inv_t"
- where
- "wcode_on_left_moving_2 ires rs (l, r) =
- (wcode_on_left_moving_2_B ires rs (l, r) \<or>
- wcode_on_left_moving_2_O ires rs (l, r))"
-
-fun wcode_on_checking_2 :: "bin_inv_t"
- where
- "wcode_on_checking_2 ires rs (l, r) =
- (\<exists> ln rn. l = Oc#ires \<and>
- r = Bk # Oc # Bk\<^bsup>ln\<^esup> @ Bk # Bk # Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>rn\<^esup>)"
-
-fun wcode_goon_checking :: "bin_inv_t"
- where
- "wcode_goon_checking ires rs (l, r) =
- (\<exists> ln rn. l = ires \<and>
- r = Oc # Bk # Oc # Bk\<^bsup>ln\<^esup> @ Bk # Bk # Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>rn\<^esup>)"
-
-fun wcode_right_move :: "bin_inv_t"
- where
- "wcode_right_move ires rs (l, r) =
- (\<exists> ln rn. l = Oc # ires \<and>
- r = Bk # Oc # Bk\<^bsup>ln\<^esup> @ Bk # Bk # Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>rn\<^esup>)"
-
-fun wcode_erase2 :: "bin_inv_t"
- where
- "wcode_erase2 ires rs (l, r) =
- (\<exists> ln rn. l = Bk # Oc # ires \<and>
- tl r = Bk\<^bsup>ln\<^esup> @ Bk # Bk # Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>rn\<^esup>)"
-
-fun wcode_on_right_moving_2 :: "bin_inv_t"
- where
- "wcode_on_right_moving_2 ires rs (l, r) =
- (\<exists> ml mr rn. l = Bk\<^bsup>ml\<^esup> @ Oc # ires \<and>
- r = Bk\<^bsup>mr\<^esup> @ Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>rn\<^esup> \<and> ml + mr > Suc 0)"
-
-fun wcode_goon_right_moving_2 :: "bin_inv_t"
- where
- "wcode_goon_right_moving_2 ires rs (l, r) =
- (\<exists> ml mr ln rn. l = Oc\<^bsup>ml\<^esup> @ Bk # Bk # Bk\<^bsup>ln\<^esup> @ Oc # ires \<and>
- r = Oc\<^bsup>mr\<^esup> @ Bk\<^bsup>rn\<^esup> \<and> ml + mr = Suc rs)"
-
-fun wcode_backto_standard_pos_2_B :: "bin_inv_t"
- where
- "wcode_backto_standard_pos_2_B ires rs (l, r) =
- (\<exists> ln rn. l = Bk # Bk\<^bsup>ln\<^esup> @ Oc # ires \<and>
- r = Bk # Oc\<^bsup>Suc (Suc rs)\<^esup> @ Bk\<^bsup>rn\<^esup>)"
-
-fun wcode_backto_standard_pos_2_O :: "bin_inv_t"
- where
- "wcode_backto_standard_pos_2_O ires rs (l, r) =
- (\<exists> ml mr ln rn. l = Oc\<^bsup>ml \<^esup>@ Bk # Bk # Bk\<^bsup>ln\<^esup> @ Oc # ires \<and>
- r = Oc\<^bsup>mr\<^esup> @ Bk\<^bsup>rn\<^esup> \<and>
- ml + mr = (Suc (Suc rs)) \<and> mr > 0)"
-
-fun wcode_backto_standard_pos_2 :: "bin_inv_t"
- where
- "wcode_backto_standard_pos_2 ires rs (l, r) =
- (wcode_backto_standard_pos_2_O ires rs (l, r) \<or>
- wcode_backto_standard_pos_2_B ires rs (l, r))"
-
-fun wcode_before_fourtimes :: "bin_inv_t"
- where
- "wcode_before_fourtimes ires rs (l, r) =
- (\<exists> ln rn. l = Bk # Bk # Bk\<^bsup>ln\<^esup> @ Oc # ires \<and>
- r = Oc\<^bsup>Suc (Suc rs)\<^esup> @ Bk\<^bsup>rn\<^esup>)"
-
-declare wcode_on_left_moving_2_B.simps[simp del] wcode_on_left_moving_2.simps[simp del]
- wcode_on_left_moving_2_O.simps[simp del] wcode_on_checking_2.simps[simp del]
- wcode_goon_checking.simps[simp del] wcode_right_move.simps[simp del]
- wcode_erase2.simps[simp del]
- wcode_on_right_moving_2.simps[simp del] wcode_goon_right_moving_2.simps[simp del]
- wcode_backto_standard_pos_2_B.simps[simp del] wcode_backto_standard_pos_2_O.simps[simp del]
- wcode_backto_standard_pos_2.simps[simp del]
-
-lemmas wcode_fourtimes_invs =
- wcode_on_left_moving_2_B.simps wcode_on_left_moving_2.simps
- wcode_on_left_moving_2_O.simps wcode_on_checking_2.simps
- wcode_goon_checking.simps wcode_right_move.simps
- wcode_erase2.simps
- wcode_on_right_moving_2.simps wcode_goon_right_moving_2.simps
- wcode_backto_standard_pos_2_B.simps wcode_backto_standard_pos_2_O.simps
- wcode_backto_standard_pos_2.simps
-
-fun wcode_fourtimes_case_inv :: "nat \<Rightarrow> bin_inv_t"
- where
- "wcode_fourtimes_case_inv st ires rs (l, r) =
- (if st = Suc 0 then wcode_on_left_moving_2 ires rs (l, r)
- else if st = Suc (Suc 0) then wcode_on_checking_2 ires rs (l, r)
- else if st = 7 then wcode_goon_checking ires rs (l, r)
- else if st = 8 then wcode_right_move ires rs (l, r)
- else if st = 9 then wcode_erase2 ires rs (l, r)
- else if st = 10 then wcode_on_right_moving_2 ires rs (l, r)
- else if st = 11 then wcode_goon_right_moving_2 ires rs (l, r)
- else if st = 12 then wcode_backto_standard_pos_2 ires rs (l, r)
- else if st = t_twice_len + 14 then wcode_before_fourtimes ires rs (l, r)
- else False)"
-
-declare wcode_fourtimes_case_inv.simps[simp del]
-
-fun wcode_fourtimes_case_state :: "t_conf \<Rightarrow> nat"
- where
- "wcode_fourtimes_case_state (st, l, r) = 13 - st"
-
-fun wcode_fourtimes_case_step :: "t_conf \<Rightarrow> nat"
- where
- "wcode_fourtimes_case_step (st, l, r) =
- (if st = Suc 0 then length l
- else if st = 9 then
- (if hd r = Oc then 1
- else 0)
- else if st = 10 then length r
- else if st = 11 then length r
- else if st = 12 then length l
- else 0)"
-
-fun wcode_fourtimes_case_measure :: "t_conf \<Rightarrow> nat \<times> nat"
- where
- "wcode_fourtimes_case_measure (st, l, r) =
- (wcode_fourtimes_case_state (st, l, r),
- wcode_fourtimes_case_step (st, l, r))"
-
-definition wcode_fourtimes_case_le :: "(t_conf \<times> t_conf) set"
- where "wcode_fourtimes_case_le \<equiv> (inv_image lex_pair wcode_fourtimes_case_measure)"
-
-lemma wf_wcode_fourtimes_case_le[intro]: "wf wcode_fourtimes_case_le"
-by(auto intro:wf_inv_image simp: wcode_fourtimes_case_le_def)
-
-lemma [simp]: "fetch t_wcode_main (Suc (Suc 0)) Bk = (L, 7)"
-apply(simp add: t_wcode_main_def fetch.simps
- t_wcode_main_first_part_def nth_of.simps)
-done
-
-lemma [simp]: "fetch t_wcode_main 7 Oc = (R, 8)"
-apply(simp add: t_wcode_main_def fetch.simps
- t_wcode_main_first_part_def nth_of.simps)
-done
-
-lemma [simp]: "fetch t_wcode_main 8 Bk = (R, 9)"
-apply(simp add: t_wcode_main_def fetch.simps
- t_wcode_main_first_part_def nth_of.simps)
-done
-
-lemma [simp]: "fetch t_wcode_main 9 Bk = (R, 10)"
-apply(simp add: t_wcode_main_def fetch.simps
- t_wcode_main_first_part_def nth_of.simps)
-done
-
-lemma [simp]: "fetch t_wcode_main 9 Oc = (W0, 9)"
-apply(simp add: t_wcode_main_def fetch.simps
- t_wcode_main_first_part_def nth_of.simps)
-done
-
-lemma [simp]: "fetch t_wcode_main 10 Bk = (R, 10)"
-apply(simp add: t_wcode_main_def fetch.simps
- t_wcode_main_first_part_def nth_of.simps)
-done
-
-lemma [simp]: "fetch t_wcode_main 10 Oc = (R, 11)"
-apply(simp add: t_wcode_main_def fetch.simps
- t_wcode_main_first_part_def nth_of.simps)
-done
-
-lemma [simp]: "fetch t_wcode_main 11 Bk = (W1, 12)"
-apply(simp add: t_wcode_main_def fetch.simps
- t_wcode_main_first_part_def nth_of.simps)
-done
-
-lemma [simp]: "fetch t_wcode_main 11 Oc = (R, 11)"
-apply(simp add: t_wcode_main_def fetch.simps
- t_wcode_main_first_part_def nth_of.simps)
-done
-
-lemma [simp]: "fetch t_wcode_main 12 Oc = (L, 12)"
-apply(simp add: t_wcode_main_def fetch.simps
- t_wcode_main_first_part_def nth_of.simps)
-done
-
-lemma [simp]: "fetch t_wcode_main 12 Bk = (R, t_twice_len + 14)"
-apply(simp add: t_wcode_main_def fetch.simps
- t_wcode_main_first_part_def nth_of.simps)
-done
-
-
-lemma [simp]: "wcode_on_left_moving_2 ires rs (b, []) = False"
-apply(auto simp: wcode_fourtimes_invs)
-done
-
-lemma [simp]: "wcode_on_checking_2 ires rs (b, []) = False"
-apply(auto simp: wcode_fourtimes_invs)
-done
-
-lemma [simp]: "wcode_goon_checking ires rs (b, []) = False"
-apply(auto simp: wcode_fourtimes_invs)
-done
-
-lemma [simp]: "wcode_right_move ires rs (b, []) = False"
-apply(auto simp: wcode_fourtimes_invs)
-done
-
-lemma [simp]: "wcode_erase2 ires rs (b, []) = False"
-apply(auto simp: wcode_fourtimes_invs)
-done
-
-lemma [simp]: "wcode_on_right_moving_2 ires rs (b, []) = False"
-apply(auto simp: wcode_fourtimes_invs exponent_def)
-done
-
-lemma [simp]: "wcode_backto_standard_pos_2 ires rs (b, []) = False"
-apply(auto simp: wcode_fourtimes_invs exponent_def)
-done
-
-lemma [simp]: "wcode_on_left_moving_2 ires rs (b, Bk # list) \<Longrightarrow> b \<noteq> []"
-apply(simp add: wcode_fourtimes_invs, auto)
-done
-
-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)"
-apply(simp only: wcode_fourtimes_invs)
-apply(erule_tac disjE)
-apply(erule_tac exE)+
-apply(case_tac ml, simp)
-apply(rule_tac x = "mr - (Suc (Suc 0))" in exI, rule_tac x = rn in exI, simp)
-apply(case_tac mr, simp, case_tac nat, simp, simp add: exp_ind)
-apply(rule_tac disjI1)
-apply(rule_tac x = nat in exI, rule_tac x = "Suc mr" in exI, rule_tac x = rn in exI,
- simp add: exp_ind_def)
-apply(simp)
-done
-
-lemma [simp]: "wcode_on_checking_2 ires rs (b, Bk # list) \<Longrightarrow> b \<noteq> []"
-apply(auto simp: wcode_fourtimes_invs)
-done
-
-lemma [simp]: "wcode_on_checking_2 ires rs (b, Bk # list)
- \<Longrightarrow> wcode_goon_checking ires rs (tl b, hd b # Bk # list)"
-apply(simp only: wcode_fourtimes_invs)
-apply(auto)
-done
-
-lemma [simp]: "wcode_goon_checking ires rs (b, Bk # list) = False"
-apply(simp add: wcode_fourtimes_invs)
-done
-
-lemma [simp]: " wcode_right_move ires rs (b, Bk # list) \<Longrightarrow> b\<noteq> []"
-apply(simp add: wcode_fourtimes_invs)
-done
-
-lemma [simp]: "wcode_right_move ires rs (b, Bk # list) \<Longrightarrow> wcode_erase2 ires rs (Bk # b, list)"
-apply(auto simp:wcode_fourtimes_invs )
-apply(rule_tac x = ln in exI, rule_tac x = rn in exI, simp)
-done
-
-lemma [simp]: "wcode_erase2 ires rs (b, Bk # list) \<Longrightarrow> b \<noteq> []"
-apply(auto simp: wcode_fourtimes_invs)
-done
-
-lemma [simp]: "wcode_erase2 ires rs (b, Bk # list) \<Longrightarrow> wcode_on_right_moving_2 ires rs (Bk # b, list)"
-apply(auto simp:wcode_fourtimes_invs )
-apply(rule_tac x = "Suc (Suc 0)" in exI, simp add: exp_ind)
-apply(rule_tac x = "Suc (Suc ln)" in exI, simp add: exp_ind, auto)
-done
-
-lemma [simp]: "wcode_on_right_moving_2 ires rs (b, Bk # list) \<Longrightarrow> b \<noteq> []"
-apply(auto simp:wcode_fourtimes_invs )
-done
-
-lemma [simp]: "wcode_on_right_moving_2 ires rs (b, Bk # list)
- \<Longrightarrow> wcode_on_right_moving_2 ires rs (Bk # b, list)"
-apply(auto simp: wcode_fourtimes_invs)
-apply(rule_tac x = "Suc ml" in exI, simp add: exp_ind_def)
-apply(rule_tac x = "mr - 1" in exI, case_tac mr, auto simp: exp_ind_def)
-done
-
-lemma [simp]: "wcode_goon_right_moving_2 ires rs (b, Bk # list) \<Longrightarrow> b \<noteq> []"
-apply(auto simp: wcode_fourtimes_invs)
-done
-
-lemma [simp]: "wcode_goon_right_moving_2 ires rs (b, Bk # list) \<Longrightarrow>
- wcode_backto_standard_pos_2 ires rs (b, Oc # list)"
-apply(simp add: wcode_fourtimes_invs, auto)
-apply(rule_tac x = ml in exI, auto)
-apply(rule_tac x = "Suc 0" in exI, simp)
-apply(case_tac mr, simp_all add: exp_ind_def)
-apply(rule_tac x = "rn - 1" in exI, simp)
-apply(case_tac rn, simp, simp add: exp_ind_def)
-done
-
-lemma [simp]: "wcode_backto_standard_pos_2 ires rs (b, Bk # list) \<Longrightarrow> b \<noteq> []"
-apply(simp add: wcode_fourtimes_invs, auto)
-done
-
-lemma [simp]: "wcode_on_left_moving_2 ires rs (b, Oc # list) \<Longrightarrow> b \<noteq> []"
-apply(simp add: wcode_fourtimes_invs, auto)
-done
-
-lemma [simp]: "wcode_on_left_moving_2 ires rs (b, Oc # list) \<Longrightarrow>
- wcode_on_checking_2 ires rs (tl b, hd b # Oc # list)"
-apply(auto simp: wcode_fourtimes_invs)
-apply(case_tac [!] mr, simp_all add: exp_ind_def)
-done
-
-lemma [simp]: "wcode_goon_right_moving_2 ires rs (b, []) \<Longrightarrow> b \<noteq> []"
-apply(auto simp: wcode_fourtimes_invs)
-done
-
-lemma [simp]: "wcode_goon_right_moving_2 ires rs (b, []) \<Longrightarrow>
- wcode_backto_standard_pos_2 ires rs (b, [Oc])"
-apply(simp only: wcode_fourtimes_invs)
-apply(erule_tac exE)+
-apply(rule_tac disjI1)
-apply(rule_tac x = ml in exI, rule_tac x = "Suc 0" in exI,
- rule_tac x = ln in exI, rule_tac x = rn in exI, simp)
-apply(case_tac mr, simp, simp add: exp_ind_def)
-done
-
-lemma "wcode_backto_standard_pos_2 ires rs (b, Bk # list)
- \<Longrightarrow> (\<exists>ln. b = Bk # Bk\<^bsup>ln\<^esup> @ Oc # ires) \<and> (\<exists>rn. list = Oc\<^bsup>Suc (Suc rs)\<^esup> @ Bk\<^bsup>rn\<^esup>)"
-apply(auto simp: wcode_fourtimes_invs)
-apply(case_tac [!] mr, auto simp: exp_ind_def)
-done
-
-
-lemma [simp]: "wcode_on_checking_2 ires rs (b, Oc # list) \<Longrightarrow> False"
-apply(simp add: wcode_fourtimes_invs)
-done
-
-lemma [simp]: "wcode_goon_checking ires rs (b, Oc # list) \<Longrightarrow>
- (b = [] \<longrightarrow> wcode_right_move ires rs ([Oc], list)) \<and>
- (b \<noteq> [] \<longrightarrow> wcode_right_move ires rs (Oc # b, list))"
-apply(simp only: wcode_fourtimes_invs)
-apply(erule_tac exE)+
-apply(auto)
-done
-
-lemma [simp]: "wcode_right_move ires rs (b, Oc # list) = False"
-apply(auto simp: wcode_fourtimes_invs)
-done
-
-lemma [simp]: " wcode_erase2 ires rs (b, Oc # list) \<Longrightarrow> b \<noteq> []"
-apply(simp add: wcode_fourtimes_invs)
-done
-
-lemma [simp]: "wcode_erase2 ires rs (b, Oc # list)
- \<Longrightarrow> wcode_erase2 ires rs (b, Bk # list)"
-apply(auto simp: wcode_fourtimes_invs)
-done
-
-lemma [simp]: "wcode_on_right_moving_2 ires rs (b, Oc # list) \<Longrightarrow> b \<noteq> []"
-apply(simp only: wcode_fourtimes_invs)
-apply(auto)
-done
-
-lemma [simp]: "wcode_on_right_moving_2 ires rs (b, Oc # list)
- \<Longrightarrow> wcode_goon_right_moving_2 ires rs (Oc # b, list)"
-apply(auto simp: wcode_fourtimes_invs)
-apply(case_tac mr, simp_all add: exp_ind_def)
-apply(rule_tac x = "Suc 0" in exI, auto)
-apply(rule_tac x = "ml - 2" in exI)
-apply(case_tac ml, simp, case_tac nat, simp_all add: exp_ind_def)
-done
-
-lemma [simp]: "wcode_goon_right_moving_2 ires rs (b, Oc # list) \<Longrightarrow> b \<noteq> []"
-apply(simp only:wcode_fourtimes_invs, auto)
-done
-
-lemma [simp]: "wcode_backto_standard_pos_2 ires rs (b, Bk # list)
- \<Longrightarrow> (\<exists>ln. b = Bk # Bk\<^bsup>ln\<^esup> @ Oc # ires) \<and> (\<exists>rn. list = Oc\<^bsup>Suc (Suc rs)\<^esup> @ Bk\<^bsup>rn\<^esup>)"
-apply(simp add: wcode_fourtimes_invs, auto)
-apply(case_tac [!] mr, simp_all add: exp_ind_def)
-done
-
-lemma [simp]: "wcode_on_checking_2 ires rs (b, Oc # list) = False"
-apply(simp add: wcode_fourtimes_invs)
-done
-
-lemma [simp]: "wcode_goon_right_moving_2 ires rs (b, Oc # list) \<Longrightarrow>
- wcode_goon_right_moving_2 ires rs (Oc # b, list)"
-apply(simp only:wcode_fourtimes_invs, auto)
-apply(rule_tac x = "Suc ml" in exI, auto simp: exp_ind_def)
-apply(rule_tac x = "mr - 1" in exI)
-apply(case_tac mr, case_tac rn, auto simp: exp_ind_def)
-done
-
-lemma [simp]: "wcode_backto_standard_pos_2 ires rs (b, Oc # list) \<Longrightarrow> b \<noteq> []"
-apply(simp only: wcode_fourtimes_invs, auto)
-done
-
-lemma [simp]: "wcode_backto_standard_pos_2 ires rs (b, Oc # list)
- \<Longrightarrow> wcode_backto_standard_pos_2 ires rs (tl b, hd b # Oc # list)"
-apply(simp only: wcode_fourtimes_invs)
-apply(erule_tac disjE)
-apply(erule_tac exE)+
-apply(case_tac ml, simp)
-apply(rule_tac disjI2)
-apply(rule_tac conjI, rule_tac x = ln in exI, simp)
-apply(rule_tac x = rn in exI, simp)
-apply(rule_tac disjI1)
-apply(rule_tac x = nat in exI, rule_tac x = "Suc mr" in exI,
- rule_tac x = ln in exI, rule_tac x = rn in exI, simp add: exp_ind_def)
-apply(simp)
-done
-
-lemma wcode_fourtimes_case_first_correctness:
- shows "let P = (\<lambda> (st, l, r). st = t_twice_len + 14) in
- let Q = (\<lambda> (st, l, r). wcode_fourtimes_case_inv st ires rs (l, r)) in
- let f = (\<lambda> stp. steps (Suc 0, Bk # Bk\<^bsup>m\<^esup> @ Oc # Bk # Oc # ires, Bk # Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>n\<^esup>) t_wcode_main stp) in
- \<exists> n .P (f n) \<and> Q (f (n::nat))"
-proof -
- let ?P = "(\<lambda> (st, l, r). st = t_twice_len + 14)"
- let ?Q = "(\<lambda> (st, l, r). wcode_fourtimes_case_inv st ires rs (l, r))"
- let ?f = "(\<lambda> stp. steps (Suc 0, Bk # Bk\<^bsup>m\<^esup> @ Oc # Bk # Oc # ires, Bk # Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>n\<^esup>) t_wcode_main stp)"
- have "\<exists> n . ?P (?f n) \<and> ?Q (?f (n::nat))"
- proof(rule_tac halt_lemma2)
- show "wf wcode_fourtimes_case_le"
- by auto
- next
- show "\<forall> na. \<not> ?P (?f na) \<and> ?Q (?f na) \<longrightarrow>
- ?Q (?f (Suc na)) \<and> (?f (Suc na), ?f na) \<in> wcode_fourtimes_case_le"
- apply(rule_tac allI,
- case_tac "steps (Suc 0, Bk # Bk\<^bsup>m\<^esup> @ Oc # Bk # Oc # ires, Bk # Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>n\<^esup>) t_wcode_main na", simp,
- rule_tac impI)
- apply(simp add: tstep_red tstep.simps, case_tac c, simp, case_tac [2] aa, simp_all)
-
- apply(simp_all add: wcode_fourtimes_case_inv.simps new_tape.simps
- wcode_fourtimes_case_le_def lex_pair_def split: if_splits)
- done
- next
- show "?Q (?f 0)"
- apply(simp add: steps.simps wcode_fourtimes_case_inv.simps)
- apply(simp add: wcode_on_left_moving_2.simps wcode_on_left_moving_2_B.simps
- wcode_on_left_moving_2_O.simps)
- apply(rule_tac x = "Suc m" in exI, simp add: exp_ind_def)
- apply(rule_tac x ="Suc 0" in exI, auto)
- done
- next
- show "\<not> ?P (?f 0)"
- apply(simp add: steps.simps)
- done
- qed
- thus "?thesis"
- apply(erule_tac exE, simp)
- done
-qed
-
-definition t_fourtimes_len :: "nat"
- where
- "t_fourtimes_len = (length t_fourtimes div 2)"
-
-lemma t_fourtimes_len_gr: "t_fourtimes_len > 0"
-apply(simp add: t_fourtimes_len_def t_fourtimes_def)
-done
-
-lemma t_fourtimes_correct:
- "\<exists>stp ln rn. steps (Suc 0, Bk # Bk # ires, Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>n\<^esup>)
- (tm_of abc_fourtimes @ tMp (Suc 0) (start_of fourtimes_ly (length abc_fourtimes) - Suc 0)) stp =
- (0, Bk\<^bsup>ln\<^esup> @ Bk # Bk # ires, Oc\<^bsup>Suc (4 * rs)\<^esup> @ Bk\<^bsup>rn\<^esup>)"
-proof(case_tac "rec_ci rec_fourtimes")
- fix a b c
- assume h: "rec_ci rec_fourtimes = (a, b, c)"
- have "\<exists>stp m l. steps (Suc 0, Bk # Bk # ires, <[rs]> @ Bk\<^bsup>n\<^esup>) (tm_of abc_fourtimes @ tMp (Suc 0)
- (start_of fourtimes_ly (length abc_fourtimes) - 1)) stp = (0, Bk\<^bsup>m\<^esup> @ Bk # Bk # ires, Oc\<^bsup>Suc (4*rs)\<^esup> @ Bk\<^bsup>l\<^esup>)"
- proof(rule_tac t_compiled_by_rec)
- show "rec_ci rec_fourtimes = (a, b, c)" by (simp add: h)
- next
- show "rec_calc_rel rec_fourtimes [rs] (4 * rs)"
- using prime_rel_exec_eq [of rec_fourtimes "[rs]" "4 * rs"]
- apply(subgoal_tac "primerec rec_fourtimes (length [rs])")
- apply(simp_all add: rec_fourtimes_def rec_exec.simps)
- apply(auto)
- apply(simp only: Nat.One_nat_def[THEN sym], auto)
- done
- next
- show "length [rs] = Suc 0" by simp
- next
- show "layout_of (a [+] dummy_abc (Suc 0)) = layout_of (a [+] dummy_abc (Suc 0))"
- by simp
- next
- show "start_of fourtimes_ly (length abc_fourtimes) =
- start_of (layout_of (a [+] dummy_abc (Suc 0))) (length (a [+] dummy_abc (Suc 0)))"
- using h
- apply(simp add: fourtimes_ly_def abc_fourtimes_def)
- done
- next
- show "tm_of abc_fourtimes = tm_of (a [+] dummy_abc (Suc 0))"
- using h
- apply(simp add: abc_fourtimes_def)
- done
- qed
- thus "\<exists>stp ln rn. steps (Suc 0, Bk # Bk # ires, Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>n\<^esup>)
- (tm_of abc_fourtimes @ tMp (Suc 0) (start_of fourtimes_ly (length abc_fourtimes) - Suc 0)) stp =
- (0, Bk\<^bsup>ln\<^esup> @ Bk # Bk # ires, Oc\<^bsup>Suc (4 * rs)\<^esup> @ Bk\<^bsup>rn\<^esup>)"
- apply(simp add: tape_of_nl_abv tape_of_nat_list.simps)
- done
-qed
-
-lemma t_fourtimes_change_term_state:
- "\<exists> stp ln rn. steps (Suc 0, Bk # Bk # ires, Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>n\<^esup>) t_fourtimes stp
- = (Suc t_fourtimes_len, Bk\<^bsup>ln\<^esup> @ Bk # Bk # ires, Oc\<^bsup>Suc (4 * rs)\<^esup> @ Bk\<^bsup>rn\<^esup>)"
-using t_fourtimes_correct[of ires rs n]
-apply(erule_tac exE)
-apply(erule_tac exE)
-apply(erule_tac exE)
-proof(drule_tac turing_change_termi_state)
- fix stp ln rn
- show "t_correct (tm_of abc_fourtimes @ tMp (Suc 0)
- (start_of fourtimes_ly (length abc_fourtimes) - Suc 0))"
- apply(rule_tac t_compiled_correct, auto simp: fourtimes_ly_def)
- done
-next
- fix stp ln rn
- show "\<exists>stp. steps (Suc 0, Bk # Bk # ires, Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>n\<^esup>)
- (change_termi_state (tm_of abc_fourtimes @ tMp (Suc 0)
- (start_of fourtimes_ly (length abc_fourtimes) - Suc 0))) stp =
- (Suc (length (tm_of abc_fourtimes @ tMp (Suc 0) (start_of fourtimes_ly
- (length abc_fourtimes) - Suc 0)) div 2), Bk\<^bsup>ln\<^esup> @ Bk # Bk # ires, Oc\<^bsup>Suc (4 * rs)\<^esup> @ Bk\<^bsup>rn\<^esup>) \<Longrightarrow>
- \<exists>stp ln rn. steps (Suc 0, Bk # Bk # ires, Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>n\<^esup>) t_fourtimes stp =
- (Suc t_fourtimes_len, Bk\<^bsup>ln\<^esup> @ Bk # Bk # ires, Oc\<^bsup>Suc (4 * rs)\<^esup> @ Bk\<^bsup>rn\<^esup>)"
- apply(erule_tac exE)
- apply(simp add: t_fourtimes_len_def t_fourtimes_def)
- apply(rule_tac x = stp in exI, rule_tac x = ln in exI, rule_tac x = rn in exI, simp)
- done
-qed
-
-lemma t_fourtimes_append_pre:
- "steps (Suc 0, Bk # Bk # ires, Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>n\<^esup>) t_fourtimes stp
- = (Suc t_fourtimes_len, Bk\<^bsup>ln\<^esup> @ Bk # Bk # ires, Oc\<^bsup>Suc (4 * rs)\<^esup> @ Bk\<^bsup>rn\<^esup>)
- \<Longrightarrow> \<exists> stp>0. steps (Suc 0 + length (t_wcode_main_first_part @
- tshift t_twice (length t_wcode_main_first_part div 2) @ [(L, 1), (L, 1)]) div 2,
- Bk # Bk # ires, Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>n\<^esup>)
- ((t_wcode_main_first_part @
- tshift t_twice (length t_wcode_main_first_part div 2) @ [(L, 1), (L, 1)]) @
- tshift t_fourtimes (length (t_wcode_main_first_part @
- tshift t_twice (length t_wcode_main_first_part div 2) @ [(L, 1), (L, 1)]) div 2) @ ([(L, 1), (L, 1)])) stp
- = (Suc t_fourtimes_len + length (t_wcode_main_first_part @
- tshift t_twice (length t_wcode_main_first_part div 2) @ [(L, 1), (L, 1)]) div 2,
- Bk\<^bsup>ln\<^esup> @ Bk # Bk # ires, Oc\<^bsup>Suc (4 * rs)\<^esup> @ Bk\<^bsup>rn\<^esup>)"
-proof(rule_tac t_tshift_lemma, auto)
- assume "steps (Suc 0, Bk # Bk # ires, Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>n\<^esup>) t_fourtimes stp =
- (Suc t_fourtimes_len, Bk\<^bsup>ln\<^esup> @ Bk # Bk # ires, Oc\<^bsup>Suc (4 * rs)\<^esup> @ Bk\<^bsup>rn\<^esup>)"
- thus "0 < stp"
- using t_fourtimes_len_gr
- apply(case_tac stp, simp_all add: steps.simps)
- done
-next
- show "Suc 0 \<le> length t_fourtimes div 2"
- apply(simp add: t_fourtimes_def shift_length tMp.simps)
- done
-next
- show "t_ncorrect (t_wcode_main_first_part @
- abacus.tshift t_twice (length t_wcode_main_first_part div 2) @
- [(L, Suc 0), (L, Suc 0)])"
- apply(simp add: t_ncorrect.simps t_wcode_main_first_part_def shift_length
- t_twice_def)
- using tm_even[of abc_twice]
- by arith
-next
- show "t_ncorrect t_fourtimes"
- apply(simp add: t_fourtimes_def steps.simps t_ncorrect.simps)
- using tm_even[of abc_fourtimes]
- by arith
-next
- show "t_ncorrect [(L, Suc 0), (L, Suc 0)]"
- apply(simp add: t_ncorrect.simps)
- done
-qed
-
-lemma [simp]: "length t_wcode_main_first_part = 24"
-apply(simp add: t_wcode_main_first_part_def)
-done
-
-lemma [simp]: "(26 + length t_twice) div 2 = (length t_twice) div 2 + 13"
-using tm_even[of abc_twice]
-apply(simp add: t_twice_def)
-done
-
-lemma [simp]: "((26 + length (abacus.tshift t_twice 12)) div 2)
- = (length (abacus.tshift t_twice 12) div 2 + 13)"
-using tm_even[of abc_twice]
-apply(simp add: t_twice_def)
-done
-
-lemma [simp]: "t_twice_len + 14 = 14 + length (abacus.tshift t_twice 12) div 2"
-using tm_even[of abc_twice]
-apply(simp add: t_twice_def t_twice_len_def shift_length)
-done
-
-lemma t_fourtimes_append:
- "\<exists> stp ln rn.
- steps (Suc 0 + length (t_wcode_main_first_part @ tshift t_twice
- (length t_wcode_main_first_part div 2) @ [(L, 1), (L, 1)]) div 2,
- Bk # Bk # ires, Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>n\<^esup>)
- ((t_wcode_main_first_part @ tshift t_twice (length t_wcode_main_first_part div 2) @
- [(L, 1), (L, 1)]) @ tshift t_fourtimes (t_twice_len + 13) @ [(L, 1), (L, 1)]) stp
- = (Suc t_fourtimes_len + length (t_wcode_main_first_part @ tshift t_twice
- (length t_wcode_main_first_part div 2) @ [(L, 1), (L, 1)]) div 2, Bk\<^bsup>ln\<^esup> @ Bk # Bk # ires,
- Oc\<^bsup>Suc (4 * rs)\<^esup> @ Bk\<^bsup>rn\<^esup>)"
- using t_fourtimes_change_term_state[of ires rs n]
- apply(erule_tac exE)
- apply(erule_tac exE)
- apply(erule_tac exE)
- apply(drule_tac t_fourtimes_append_pre)
- apply(erule_tac exE)
- apply(rule_tac x = stpa in exI, rule_tac x = ln in exI, rule_tac x = rn in exI)
- apply(simp add: t_twice_len_def shift_length)
- done
-
-lemma t_wcode_main_len: "length t_wcode_main = length t_twice + length t_fourtimes + 28"
-apply(simp add: t_wcode_main_def shift_length)
-done
-
-lemma [simp]: "fetch t_wcode_main (14 + length t_twice div 2 + t_fourtimes_len) b
- = (L, Suc 0)"
-using tm_even[of "abc_twice"] tm_even[of "abc_fourtimes"]
-apply(case_tac b)
-apply(simp_all only: fetch.simps)
-apply(auto simp: nth_of.simps t_wcode_main_len t_twice_len_def
- t_fourtimes_def t_twice_def t_fourtimes_def t_fourtimes_len_def)
-apply(auto simp: t_wcode_main_def t_wcode_main_first_part_def shift_length t_twice_def nth_append
- t_fourtimes_def)
-done
-
-lemma wcode_jump2:
- "\<exists> stp ln rn. steps (t_twice_len + 14 + t_fourtimes_len
- , Bk # Bk # Bk\<^bsup>lnb\<^esup> @ Oc # ires, Oc\<^bsup>Suc (4 * rs + 4)\<^esup> @ Bk\<^bsup>rnb\<^esup>) t_wcode_main stp =
- (Suc 0, Bk # Bk\<^bsup>ln\<^esup> @ Oc # ires, Bk # Oc\<^bsup>Suc (4 * rs + 4)\<^esup> @ Bk\<^bsup>rn\<^esup>)"
-apply(rule_tac x = "Suc 0" in exI)
-apply(simp add: steps.simps shift_length)
-apply(rule_tac x = lnb in exI, rule_tac x = rnb in exI)
-apply(simp add: tstep.simps new_tape.simps)
-done
-
-lemma wcode_fourtimes_case:
- shows "\<exists>stp ln rn.
- steps (Suc 0, Bk # Bk\<^bsup>m\<^esup> @ Oc # Bk # Oc # ires, Bk # Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>n\<^esup>) t_wcode_main stp =
- (Suc 0, Bk # Bk\<^bsup>ln\<^esup> @ Oc # ires, Bk # Oc\<^bsup>Suc (4*rs + 4)\<^esup> @ Bk\<^bsup>rn\<^esup>)"
-proof -
- have "\<exists>stp ln rn.
- steps (Suc 0, Bk # Bk\<^bsup>m\<^esup> @ Oc # Bk # Oc # ires, Bk # Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>n\<^esup>) t_wcode_main stp =
- (t_twice_len + 14, Bk # Bk # Bk\<^bsup>ln\<^esup> @ Oc # ires, Oc\<^bsup>Suc (rs + 1)\<^esup> @ Bk\<^bsup>rn\<^esup>)"
- using wcode_fourtimes_case_first_correctness[of ires rs m n]
- apply(simp add: wcode_fourtimes_case_inv.simps, auto)
- apply(rule_tac x = na in exI, rule_tac x = ln in exI,
- rule_tac x = rn in exI)
- apply(simp)
- done
- from this obtain stpa lna rna where stp1:
- "steps (Suc 0, Bk # Bk\<^bsup>m\<^esup> @ Oc # Bk # Oc # ires, Bk # Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>n\<^esup>) t_wcode_main stpa =
- (t_twice_len + 14, Bk # Bk # Bk\<^bsup>lna\<^esup> @ Oc # ires, Oc\<^bsup>Suc (rs + 1)\<^esup> @ Bk\<^bsup>rna\<^esup>)" by blast
- have "\<exists>stp ln rn. steps (t_twice_len + 14, Bk # Bk # Bk\<^bsup>lna\<^esup> @ Oc # ires, Oc\<^bsup>Suc (rs + 1)\<^esup> @ Bk\<^bsup>rna\<^esup>)
- t_wcode_main stp =
- (t_twice_len + 14 + t_fourtimes_len, Bk # Bk # Bk\<^bsup>ln\<^esup> @ Oc # ires, Oc\<^bsup>Suc (4*rs + 4)\<^esup> @ Bk\<^bsup>rn\<^esup>)"
- using t_fourtimes_append[of " Bk\<^bsup>lna\<^esup> @ Oc # ires" "rs + 1" rna]
- apply(erule_tac exE)
- apply(erule_tac exE)
- apply(erule_tac exE)
- apply(simp add: t_wcode_main_def)
- apply(rule_tac x = stp in exI,
- rule_tac x = "ln + lna" in exI,
- rule_tac x = rn in exI, simp)
- apply(simp add: exp_ind_def[THEN sym] exp_add[THEN sym])
- done
- from this obtain stpb lnb rnb where stp2:
- "steps (t_twice_len + 14, Bk # Bk # Bk\<^bsup>lna\<^esup> @ Oc # ires, Oc\<^bsup>Suc (rs + 1)\<^esup> @ Bk\<^bsup>rna\<^esup>)
- t_wcode_main stpb =
- (t_twice_len + 14 + t_fourtimes_len, Bk # Bk # Bk\<^bsup>lnb\<^esup> @ Oc # ires, Oc\<^bsup>Suc (4*rs + 4)\<^esup> @ Bk\<^bsup>rnb\<^esup>)"
- by blast
- have "\<exists>stp ln rn. steps (t_twice_len + 14 + t_fourtimes_len,
- Bk # Bk # Bk\<^bsup>lnb\<^esup> @ Oc # ires, Oc\<^bsup>Suc (4*rs + 4)\<^esup> @ Bk\<^bsup>rnb\<^esup>)
- t_wcode_main stp =
- (Suc 0, Bk # Bk\<^bsup>ln\<^esup> @ Oc # ires, Bk # Oc\<^bsup>Suc (4*rs + 4)\<^esup> @ Bk\<^bsup>rn\<^esup>)"
- apply(rule wcode_jump2)
- done
- from this obtain stpc lnc rnc where stp3:
- "steps (t_twice_len + 14 + t_fourtimes_len,
- Bk # Bk # Bk\<^bsup>lnb\<^esup> @ Oc # ires, Oc\<^bsup>Suc (4*rs + 4)\<^esup> @ Bk\<^bsup>rnb\<^esup>)
- t_wcode_main stpc =
- (Suc 0, Bk # Bk\<^bsup>lnc\<^esup> @ Oc # ires, Bk # Oc\<^bsup>Suc (4*rs + 4)\<^esup> @ Bk\<^bsup>rnc\<^esup>)"
- by blast
- from stp1 stp2 stp3 show "?thesis"
- apply(rule_tac x = "stpa + stpb + stpc" in exI,
- rule_tac x = lnc in exI, rule_tac x = rnc in exI)
- apply(simp add: steps_add)
- done
-qed
-
-(**********************************************************)
-
-fun wcode_on_left_moving_3_B :: "bin_inv_t"
- where
- "wcode_on_left_moving_3_B ires rs (l, r) =
- (\<exists> ml mr rn. l = Bk\<^bsup>ml\<^esup> @ Oc # Bk # Bk # ires \<and>
- r = Bk\<^bsup>mr\<^esup> @ Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>rn\<^esup> \<and>
- ml + mr > Suc 0 \<and> mr > 0 )"
-
-fun wcode_on_left_moving_3_O :: "bin_inv_t"
- where
- "wcode_on_left_moving_3_O ires rs (l, r) =
- (\<exists> ln rn. l = Bk # Bk # ires \<and>
- r = Oc # Bk\<^bsup>ln\<^esup> @ Bk # Bk # Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>rn\<^esup>)"
-
-fun wcode_on_left_moving_3 :: "bin_inv_t"
- where
- "wcode_on_left_moving_3 ires rs (l, r) =
- (wcode_on_left_moving_3_B ires rs (l, r) \<or>
- wcode_on_left_moving_3_O ires rs (l, r))"
-
-fun wcode_on_checking_3 :: "bin_inv_t"
- where
- "wcode_on_checking_3 ires rs (l, r) =
- (\<exists> ln rn. l = Bk # ires \<and>
- r = Bk # Oc # Bk\<^bsup>ln\<^esup> @ Bk # Bk # Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>rn\<^esup>)"
-
-fun wcode_goon_checking_3 :: "bin_inv_t"
- where
- "wcode_goon_checking_3 ires rs (l, r) =
- (\<exists> ln rn. l = ires \<and>
- r = Bk # Bk # Oc # Bk\<^bsup>ln\<^esup> @ Bk # Bk # Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>rn\<^esup>)"
-
-fun wcode_stop :: "bin_inv_t"
- where
- "wcode_stop ires rs (l, r) =
- (\<exists> ln rn. l = Bk # ires \<and>
- r = Bk # Oc # Bk\<^bsup>ln\<^esup> @ Bk # Bk # Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>rn\<^esup>)"
-
-fun wcode_halt_case_inv :: "nat \<Rightarrow> bin_inv_t"
- where
- "wcode_halt_case_inv st ires rs (l, r) =
- (if st = 0 then wcode_stop ires rs (l, r)
- else if st = Suc 0 then wcode_on_left_moving_3 ires rs (l, r)
- else if st = Suc (Suc 0) then wcode_on_checking_3 ires rs (l, r)
- else if st = 7 then wcode_goon_checking_3 ires rs (l, r)
- else False)"
-
-fun wcode_halt_case_state :: "t_conf \<Rightarrow> nat"
- where
- "wcode_halt_case_state (st, l, r) =
- (if st = 1 then 5
- else if st = Suc (Suc 0) then 4
- else if st = 7 then 3
- else 0)"
-
-fun wcode_halt_case_step :: "t_conf \<Rightarrow> nat"
- where
- "wcode_halt_case_step (st, l, r) =
- (if st = 1 then length l
- else 0)"
-
-fun wcode_halt_case_measure :: "t_conf \<Rightarrow> nat \<times> nat"
- where
- "wcode_halt_case_measure (st, l, r) =
- (wcode_halt_case_state (st, l, r),
- wcode_halt_case_step (st, l, r))"
-
-definition wcode_halt_case_le :: "(t_conf \<times> t_conf) set"
- where "wcode_halt_case_le \<equiv> (inv_image lex_pair wcode_halt_case_measure)"
-
-lemma wf_wcode_halt_case_le[intro]: "wf wcode_halt_case_le"
-by(auto intro:wf_inv_image simp: wcode_halt_case_le_def)
-
-declare wcode_on_left_moving_3_B.simps[simp del] wcode_on_left_moving_3_O.simps[simp del]
- wcode_on_checking_3.simps[simp del] wcode_goon_checking_3.simps[simp del]
- wcode_on_left_moving_3.simps[simp del] wcode_stop.simps[simp del]
-
-lemmas wcode_halt_invs =
- wcode_on_left_moving_3_B.simps wcode_on_left_moving_3_O.simps
- wcode_on_checking_3.simps wcode_goon_checking_3.simps
- wcode_on_left_moving_3.simps wcode_stop.simps
-
-lemma [simp]: "fetch t_wcode_main 7 Bk = (R, 0)"
-apply(simp add: fetch.simps t_wcode_main_def nth_append nth_of.simps
- t_wcode_main_first_part_def)
-done
-
-lemma [simp]: "wcode_on_left_moving_3 ires rs (b, []) = False"
-apply(simp only: wcode_halt_invs)
-apply(simp add: exp_ind_def)
-done
-
-lemma [simp]: "wcode_on_checking_3 ires rs (b, []) = False"
-apply(simp add: wcode_halt_invs)
-done
-
-lemma [simp]: "wcode_goon_checking_3 ires rs (b, []) = False"
-apply(simp add: wcode_halt_invs)
-done
-
-lemma [simp]: "wcode_on_left_moving_3 ires rs (b, Bk # list)
- \<Longrightarrow> wcode_on_left_moving_3 ires rs (tl b, hd b # Bk # list)"
-apply(simp only: wcode_halt_invs)
-apply(erule_tac disjE)
-apply(erule_tac exE)+
-apply(case_tac ml, simp)
-apply(rule_tac x = "mr - 2" in exI, rule_tac x = rn in exI)
-apply(case_tac mr, simp, simp add: exp_ind, simp add: exp_ind[THEN sym])
-apply(rule_tac disjI1)
-apply(rule_tac x = nat in exI, rule_tac x = "Suc mr" in exI,
- rule_tac x = rn in exI, simp add: exp_ind_def)
-apply(simp)
-done
-
-lemma [simp]: "wcode_goon_checking_3 ires rs (b, Bk # list) \<Longrightarrow>
- (b = [] \<longrightarrow> wcode_stop ires rs ([Bk], list)) \<and>
- (b \<noteq> [] \<longrightarrow> wcode_stop ires rs (Bk # b, list))"
-apply(auto simp: wcode_halt_invs)
-done
-
-lemma [simp]: "wcode_on_left_moving_3 ires rs (b, Oc # list) \<Longrightarrow> b \<noteq> []"
-apply(auto simp: wcode_halt_invs)
-done
-
-lemma [simp]: "wcode_on_left_moving_3 ires rs (b, Oc # list) \<Longrightarrow>
- wcode_on_checking_3 ires rs (tl b, hd b # Oc # list)"
-apply(simp add:wcode_halt_invs, auto)
-apply(case_tac [!] mr, simp_all add: exp_ind_def)
-done
-
-lemma [simp]: "wcode_on_checking_3 ires rs (b, Oc # list) = False"
-apply(auto simp: wcode_halt_invs)
-done
-
-lemma [simp]: "wcode_on_left_moving_3 ires rs (b, Bk # list) \<Longrightarrow> b \<noteq> []"
-apply(simp add: wcode_halt_invs, auto)
-done
-
-
-lemma [simp]: "wcode_on_checking_3 ires rs (b, Bk # list) \<Longrightarrow> b \<noteq> []"
-apply(auto simp: wcode_halt_invs)
-done
-
-lemma [simp]: "wcode_on_checking_3 ires rs (b, Bk # list) \<Longrightarrow>
- wcode_goon_checking_3 ires rs (tl b, hd b # Bk # list)"
-apply(auto simp: wcode_halt_invs)
-done
-
-lemma [simp]: "wcode_goon_checking_3 ires rs (b, Oc # list) = False"
-apply(simp add: wcode_goon_checking_3.simps)
-done
-
-lemma t_halt_case_correctness:
-shows "let P = (\<lambda> (st, l, r). st = 0) in
- let Q = (\<lambda> (st, l, r). wcode_halt_case_inv st ires rs (l, r)) in
- let f = (\<lambda> stp. steps (Suc 0, Bk # Bk\<^bsup>m\<^esup> @ Oc # Bk # Bk # ires, Bk # Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>n\<^esup>) t_wcode_main stp) in
- \<exists> n .P (f n) \<and> Q (f (n::nat))"
-proof -
- let ?P = "(\<lambda> (st, l, r). st = 0)"
- let ?Q = "(\<lambda> (st, l, r). wcode_halt_case_inv st ires rs (l, r))"
- let ?f = "(\<lambda> stp. steps (Suc 0, Bk # Bk\<^bsup>m\<^esup> @ Oc # Bk # Bk # ires, Bk # Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>n\<^esup>) t_wcode_main stp)"
- have "\<exists> n. ?P (?f n) \<and> ?Q (?f (n::nat))"
- proof(rule_tac halt_lemma2)
- show "wf wcode_halt_case_le" by auto
- next
- show "\<forall> na. \<not> ?P (?f na) \<and> ?Q (?f na) \<longrightarrow>
- ?Q (?f (Suc na)) \<and> (?f (Suc na), ?f na) \<in> wcode_halt_case_le"
- apply(rule_tac allI, rule_tac impI, case_tac "?f na")
- apply(simp add: tstep_red tstep.simps)
- apply(case_tac c, simp, case_tac [2] aa)
- apply(simp_all split: if_splits add: new_tape.simps wcode_halt_case_le_def lex_pair_def)
- done
- next
- show "?Q (?f 0)"
- apply(simp add: steps.simps wcode_halt_invs)
- apply(rule_tac x = "Suc m" in exI, simp add: exp_ind_def)
- apply(rule_tac x = "Suc 0" in exI, auto)
- done
- next
- show "\<not> ?P (?f 0)"
- apply(simp add: steps.simps)
- done
- qed
- thus "?thesis"
- apply(auto)
- done
-qed
-
-declare wcode_halt_case_inv.simps[simp del]
-lemma [intro]: "\<exists> xs. (<rev list @ [aa::nat]> :: block list) = Oc # xs"
-apply(case_tac "rev list", simp)
-apply(simp add: tape_of_nat_abv tape_of_nat_list.simps exp_ind_def)
-apply(case_tac list, simp, simp)
-done
-
-lemma wcode_halt_case:
- "\<exists>stp ln rn. steps (Suc 0, Bk # Bk\<^bsup>m\<^esup> @ Oc # Bk # Bk # ires, Bk # Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>n\<^esup>)
- t_wcode_main stp = (0, Bk # ires, Bk # Oc # Bk\<^bsup>ln\<^esup> @ Bk # Bk # Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>rn\<^esup>)"
- using t_halt_case_correctness[of ires rs m n]
-apply(simp)
-apply(erule_tac exE)
-apply(case_tac "steps (Suc 0, Bk # Bk\<^bsup>m\<^esup> @ Oc # Bk # Bk # ires,
- Bk # Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>n\<^esup>) t_wcode_main na")
-apply(auto simp: wcode_halt_case_inv.simps wcode_stop.simps)
-apply(rule_tac x = na in exI, rule_tac x = ln in exI,
- rule_tac x = rn in exI, simp)
-done
-
-lemma bl_bin_one: "bl_bin [Oc] = Suc 0"
-apply(simp add: bl_bin.simps)
-done
-
-lemma t_wcode_main_lemma_pre:
- "\<lbrakk>args \<noteq> []; lm = <args::nat list>\<rbrakk> \<Longrightarrow>
- \<exists> stp ln rn. steps (Suc 0, Bk # Bk\<^bsup>m\<^esup> @ rev lm @ Bk # Bk # ires, Bk # Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>n\<^esup>) t_wcode_main
- stp
- = (0, Bk # ires, Bk # Oc # Bk\<^bsup>ln\<^esup> @ Bk # Bk # Oc\<^bsup>bl_bin lm + rs * 2^(length lm - 1) \<^esup> @ Bk\<^bsup>rn\<^esup>)"
-proof(induct "length args" arbitrary: args lm rs m n, simp)
- fix x args lm rs m n
- assume ind:
- "\<And>args lm rs m n.
- \<lbrakk>x = length args; (args::nat list) \<noteq> []; lm = <args>\<rbrakk>
- \<Longrightarrow> \<exists>stp ln rn.
- steps (Suc 0, Bk # Bk\<^bsup>m\<^esup> @ rev lm @ Bk # Bk # ires, Bk # Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>n\<^esup>) t_wcode_main stp =
- (0, Bk # ires, Bk # Oc # Bk\<^bsup>ln\<^esup> @ Bk # Bk # Oc\<^bsup>bl_bin lm + rs * 2 ^ (length lm - 1)\<^esup> @ Bk\<^bsup>rn\<^esup>)"
-
- and h: "Suc x = length args" "(args::nat list) \<noteq> []" "lm = <args>"
- from h have "\<exists> (a::nat) xs. args = xs @ [a]"
- apply(rule_tac x = "last args" in exI)
- apply(rule_tac x = "butlast args" in exI, auto)
- done
- from this obtain a xs where "args = xs @ [a]" by blast
- from h and this show
- "\<exists>stp ln rn.
- steps (Suc 0, Bk # Bk\<^bsup>m\<^esup> @ rev lm @ Bk # Bk # ires, Bk # Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>n\<^esup>) t_wcode_main stp =
- (0, Bk # ires, Bk # Oc # Bk\<^bsup>ln\<^esup> @ Bk # Bk # Oc\<^bsup>bl_bin lm + rs * 2 ^ (length lm - 1)\<^esup> @ Bk\<^bsup>rn\<^esup>)"
- proof(case_tac "xs::nat list", simp)
- show "\<exists>stp ln rn.
- steps (Suc 0, Bk # Bk\<^bsup>m\<^esup> @ rev (<a>) @ Bk # Bk # ires, Bk # Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>n\<^esup>) t_wcode_main stp =
- (0, Bk # ires, Bk # Oc # Bk\<^bsup>ln\<^esup> @ Bk # Bk # Oc\<^bsup>bl_bin (<a>) + rs * 2 ^ a\<^esup> @ Bk\<^bsup>rn\<^esup>)"
- proof(induct "a" arbitrary: m n rs ires, simp)
- fix m n rs ires
- show "\<exists>stp ln rn. steps (Suc 0, Bk # Bk\<^bsup>m\<^esup> @ Oc # Bk # Bk # ires, Bk # Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>n\<^esup>)
- t_wcode_main stp = (0, Bk # ires, Bk # Oc # Bk\<^bsup>ln\<^esup> @ Bk # Bk # Oc\<^bsup>bl_bin [Oc] + rs\<^esup> @ Bk\<^bsup>rn\<^esup>)"
- apply(simp add: bl_bin_one)
- apply(rule_tac wcode_halt_case)
- done
- next
- fix a m n rs ires
- assume ind2:
- "\<And>m n rs ires.
- \<exists>stp ln rn.
- steps (Suc 0, Bk # Bk\<^bsup>m\<^esup> @ rev (<a>) @ Bk # Bk # ires, Bk # Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>n\<^esup>) t_wcode_main stp =
- (0, Bk # ires, Bk # Oc # Bk\<^bsup>ln\<^esup> @ Bk # Bk # Oc\<^bsup>bl_bin (<a>) + rs * 2 ^ a\<^esup> @ Bk\<^bsup>rn\<^esup>)"
- show "\<exists>stp ln rn.
- steps (Suc 0, Bk # Bk\<^bsup>m\<^esup> @ rev (<Suc a>) @ Bk # Bk # ires, Bk # Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>n\<^esup>) t_wcode_main stp =
- (0, Bk # ires, Bk # Oc # Bk\<^bsup>ln\<^esup> @ Bk # Bk # Oc\<^bsup>bl_bin (<Suc a>) + rs * 2 ^ Suc a\<^esup> @ Bk\<^bsup>rn\<^esup>)"
- proof -
- have "\<exists>stp ln rn.
- steps (Suc 0, Bk # Bk\<^bsup>m\<^esup> @ rev (<Suc a>) @ Bk # Bk # ires, Bk # Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>n\<^esup>) t_wcode_main stp =
- (Suc 0, Bk # Bk\<^bsup>ln\<^esup> @ rev (<a>) @ Bk # Bk # ires, Bk # Oc\<^bsup>Suc (2 * rs + 2)\<^esup> @ Bk\<^bsup>rn\<^esup>)"
- apply(simp add: tape_of_nat)
- using wcode_double_case[of m "Oc\<^bsup>a\<^esup> @ Bk # Bk # ires" rs n]
- apply(simp add: exp_ind_def)
- done
- from this obtain stpa lna rna where stp1:
- "steps (Suc 0, Bk # Bk\<^bsup>m\<^esup> @ rev (<Suc a>) @ Bk # Bk # ires, Bk # Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>n\<^esup>) t_wcode_main stpa =
- (Suc 0, Bk # Bk\<^bsup>lna\<^esup> @ rev (<a>) @ Bk # Bk # ires, Bk # Oc\<^bsup>Suc (2 * rs + 2)\<^esup> @ Bk\<^bsup>rna\<^esup>)" by blast
- moreover have
- "\<exists>stp ln rn.
- steps (Suc 0, Bk # Bk\<^bsup>lna\<^esup> @ rev (<a>) @ Bk # Bk # ires, Bk # Oc\<^bsup>Suc (2 * rs + 2)\<^esup> @ Bk\<^bsup>rna\<^esup>) t_wcode_main stp =
- (0, Bk # ires, Bk # Oc # Bk\<^bsup>ln\<^esup> @ Bk # Bk # Oc\<^bsup>bl_bin (<a>) + (2*rs + 2) * 2 ^ a\<^esup> @ Bk\<^bsup>rn\<^esup>)"
- using ind2[of lna ires "2*rs + 2" rna] by simp
- from this obtain stpb lnb rnb where stp2:
- "steps (Suc 0, Bk # Bk\<^bsup>lna\<^esup> @ rev (<a>) @ Bk # Bk # ires, Bk # Oc\<^bsup>Suc (2 * rs + 2)\<^esup> @ Bk\<^bsup>rna\<^esup>) t_wcode_main stpb =
- (0, Bk # ires, Bk # Oc # Bk\<^bsup>lnb\<^esup> @ Bk # Bk # Oc\<^bsup>bl_bin (<a>) + (2*rs + 2) * 2 ^ a\<^esup> @ Bk\<^bsup>rnb\<^esup>)"
- by blast
- from stp1 and stp2 show "?thesis"
- apply(rule_tac x = "stpa + stpb" in exI,
- rule_tac x = lnb in exI, rule_tac x = rnb in exI, simp)
- apply(simp add: steps_add bl_bin_nat_Suc exponent_def)
- done
- qed
- qed
- next
- fix aa list
- assume g: "Suc x = length args" "args \<noteq> []" "lm = <args>" "args = xs @ [a::nat]" "xs = (aa::nat) # list"
- thus "\<exists>stp ln rn. steps (Suc 0, Bk # Bk\<^bsup>m\<^esup> @ rev lm @ Bk # Bk # ires, Bk # Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>n\<^esup>) t_wcode_main stp =
- (0, Bk # ires, Bk # Oc # Bk\<^bsup>ln\<^esup> @ Bk # Bk # Oc\<^bsup>bl_bin lm + rs * 2 ^ (length lm - 1)\<^esup> @ Bk\<^bsup>rn\<^esup>)"
- proof(induct a arbitrary: m n rs args lm, simp_all add: tape_of_nl_rev,
- simp only: tape_of_nl_cons_app1, simp)
- fix m n rs args lm
- have "\<exists>stp ln rn.
- steps (Suc 0, Bk # Bk\<^bsup>m\<^esup> @ Oc # Bk # rev (<(aa::nat) # list>) @ Bk # Bk # ires,
- Bk # Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>n\<^esup>) t_wcode_main stp =
- (Suc 0, Bk # Bk\<^bsup>ln\<^esup> @ rev (<aa # list>) @ Bk # Bk # ires,
- Bk # Oc\<^bsup>Suc (4*rs + 4)\<^esup> @ Bk\<^bsup>rn\<^esup>)"
- proof(simp add: tape_of_nl_rev)
- have "\<exists> xs. (<rev list @ [aa]>) = Oc # xs" by auto
- from this obtain xs where "(<rev list @ [aa]>) = Oc # xs" ..
- thus "\<exists>stp ln rn.
- steps (Suc 0, Bk # Bk\<^bsup>m\<^esup> @ Oc # Bk # <rev list @ [aa]> @ Bk # Bk # ires,
- Bk # Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>n\<^esup>) t_wcode_main stp =
- (Suc 0, Bk # Bk\<^bsup>ln\<^esup> @ <rev list @ [aa]> @ Bk # Bk # ires, Bk # Oc\<^bsup>5 + 4 * rs\<^esup> @ Bk\<^bsup>rn\<^esup>)"
- apply(simp)
- using wcode_fourtimes_case[of m "xs @ Bk # Bk # ires" rs n]
- apply(simp)
- done
- qed
- from this obtain stpa lna rna where stp1:
- "steps (Suc 0, Bk # Bk\<^bsup>m\<^esup> @ Oc # Bk # rev (<aa # list>) @ Bk # Bk # ires,
- Bk # Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>n\<^esup>) t_wcode_main stpa =
- (Suc 0, Bk # Bk\<^bsup>lna\<^esup> @ rev (<aa # list>) @ Bk # Bk # ires,
- Bk # Oc\<^bsup>Suc (4*rs + 4)\<^esup> @ Bk\<^bsup>rna\<^esup>)" by blast
- from g have
- "\<exists> stp ln rn. steps (Suc 0, Bk # Bk\<^bsup>lna\<^esup> @ rev (<(aa::nat) # list>) @ Bk # Bk # ires,
- Bk # Oc\<^bsup>Suc (4*rs + 4)\<^esup> @ Bk\<^bsup>rna\<^esup>) t_wcode_main stp = (0, Bk # ires,
- Bk # Oc # Bk\<^bsup>ln\<^esup> @ Bk # Bk # Oc\<^bsup>bl_bin (<aa#list>)+ (4*rs + 4) * 2^(length (<aa#list>) - 1) \<^esup> @ Bk\<^bsup>rn\<^esup>)"
- apply(rule_tac args = "(aa::nat)#list" in ind, simp_all)
- done
- from this obtain stpb lnb rnb where stp2:
- "steps (Suc 0, Bk # Bk\<^bsup>lna\<^esup> @ rev (<(aa::nat) # list>) @ Bk # Bk # ires,
- Bk # Oc\<^bsup>Suc (4*rs + 4)\<^esup> @ Bk\<^bsup>rna\<^esup>) t_wcode_main stpb = (0, Bk # ires,
- Bk # Oc # Bk\<^bsup>lnb\<^esup> @ Bk # Bk # Oc\<^bsup>bl_bin (<aa#list>)+ (4*rs + 4) * 2^(length (<aa#list>) - 1) \<^esup> @ Bk\<^bsup>rnb\<^esup>)"
- by blast
- from stp1 and stp2 and h
- show "\<exists>stp ln rn.
- steps (Suc 0, Bk # Bk\<^bsup>m\<^esup> @ Oc # Bk # <rev list @ [aa]> @ Bk # Bk # ires,
- Bk # Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>n\<^esup>) t_wcode_main stp =
- (0, Bk # ires, Bk # Oc # Bk\<^bsup>ln\<^esup> @ Bk #
- Bk # Oc\<^bsup>bl_bin (Oc\<^bsup>Suc aa\<^esup> @ Bk # <list @ [0]>) + rs * (2 * 2 ^ (aa + length (<list @ [0]>)))\<^esup> @ Bk\<^bsup>rn\<^esup>)"
- apply(rule_tac x = "stpa + stpb" in exI, rule_tac x = lnb in exI,
- rule_tac x = rnb in exI, simp add: steps_add tape_of_nl_rev)
- done
- next
- fix ab m n rs args lm
- assume ind2:
- "\<And> m n rs args lm.
- \<lbrakk>lm = <aa # list @ [ab]>; args = aa # list @ [ab]\<rbrakk>
- \<Longrightarrow> \<exists>stp ln rn.
- steps (Suc 0, Bk # Bk\<^bsup>m\<^esup> @ <ab # rev list @ [aa]> @ Bk # Bk # ires,
- Bk # Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>n\<^esup>) t_wcode_main stp =
- (0, Bk # ires, Bk # Oc # Bk\<^bsup>ln\<^esup> @ Bk #
- Bk # Oc\<^bsup>bl_bin (<aa # list @ [ab]>) + rs * 2 ^ (length (<aa # list @ [ab]>) - Suc 0)\<^esup> @ Bk\<^bsup>rn\<^esup>)"
- and k: "args = aa # list @ [Suc ab]" "lm = <aa # list @ [Suc ab]>"
- show "\<exists>stp ln rn.
- steps (Suc 0, Bk # Bk\<^bsup>m\<^esup> @ <Suc ab # rev list @ [aa]> @ Bk # Bk # ires,
- Bk # Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>n\<^esup>) t_wcode_main stp =
- (0, Bk # ires,Bk # Oc # Bk\<^bsup>ln\<^esup> @ Bk #
- Bk # Oc\<^bsup>bl_bin (<aa # list @ [Suc ab]>) + rs * 2 ^ (length (<aa # list @ [Suc ab]>) - Suc 0)\<^esup> @ Bk\<^bsup>rn\<^esup>)"
- proof(simp add: tape_of_nl_cons_app1)
- have "\<exists>stp ln rn.
- steps (Suc 0, Bk # Bk\<^bsup>m\<^esup> @ Oc\<^bsup>Suc (Suc ab)\<^esup> @ Bk # <rev list @ [aa]> @ Bk # Bk # ires,
- Bk # Oc # Oc\<^bsup>rs\<^esup> @ Bk\<^bsup>n\<^esup>) t_wcode_main stp
- = (Suc 0, Bk # Bk\<^bsup>ln\<^esup> @ Oc\<^bsup>Suc ab\<^esup> @ Bk # <rev list @ [aa]> @ Bk # Bk # ires,
- Bk # Oc\<^bsup>Suc (2*rs + 2)\<^esup> @ Bk\<^bsup>rn\<^esup>)"
- using wcode_double_case[of m "Oc\<^bsup>ab\<^esup> @ Bk # <rev list @ [aa]> @ Bk # Bk # ires"
- rs n]
- apply(simp add: exp_ind_def)
- done
- from this obtain stpa lna rna where stp1:
- "steps (Suc 0, Bk # Bk\<^bsup>m\<^esup> @ Oc\<^bsup>Suc (Suc ab)\<^esup> @ Bk # <rev list @ [aa]> @ Bk # Bk # ires,
- Bk # Oc # Oc\<^bsup>rs\<^esup> @ Bk\<^bsup>n\<^esup>) t_wcode_main stpa
- = (Suc 0, Bk # Bk\<^bsup>lna\<^esup> @ Oc\<^bsup>Suc ab\<^esup> @ Bk # <rev list @ [aa]> @ Bk # Bk # ires,
- Bk # Oc\<^bsup>Suc (2*rs + 2)\<^esup> @ Bk\<^bsup>rna\<^esup>)" by blast
- from k have
- "\<exists> stp ln rn. steps (Suc 0, Bk # Bk\<^bsup>lna\<^esup> @ <ab # rev list @ [aa]> @ Bk # Bk # ires,
- Bk # Oc\<^bsup>Suc (2*rs + 2)\<^esup> @ Bk\<^bsup>rna\<^esup>) t_wcode_main stp
- = (0, Bk # ires, Bk # Oc # Bk\<^bsup>ln\<^esup> @ Bk #
- Bk # Oc\<^bsup>bl_bin (<aa # list @ [ab]> ) + (2*rs + 2)* 2^(length (<aa # list @ [ab]>) - Suc 0)\<^esup> @ Bk\<^bsup>rn\<^esup>)"
- apply(rule_tac ind2, simp_all)
- done
- from this obtain stpb lnb rnb where stp2:
- "steps (Suc 0, Bk # Bk\<^bsup>lna\<^esup> @ <ab # rev list @ [aa]> @ Bk # Bk # ires,
- Bk # Oc\<^bsup>Suc (2*rs + 2)\<^esup> @ Bk\<^bsup>rna\<^esup>) t_wcode_main stpb
- = (0, Bk # ires, Bk # Oc # Bk\<^bsup>lnb\<^esup> @ Bk #
- Bk # Oc\<^bsup>bl_bin (<aa # list @ [ab]> ) + (2*rs + 2)* 2^(length (<aa # list @ [ab]>) - Suc 0)\<^esup> @ Bk\<^bsup>rnb\<^esup>)"
- by blast
- from stp1 and stp2 show
- "\<exists>stp ln rn.
- steps (Suc 0, Bk # Bk\<^bsup>m\<^esup> @ Oc\<^bsup>Suc (Suc ab)\<^esup> @ Bk # <rev list @ [aa]> @ Bk # Bk # ires,
- Bk # Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>n\<^esup>) t_wcode_main stp =
- (0, Bk # ires, Bk # Oc # Bk\<^bsup>ln\<^esup> @ Bk # Bk #
- Oc\<^bsup>bl_bin (Oc\<^bsup>Suc aa\<^esup> @ Bk # <list @ [Suc ab]>) + rs * (2 * 2 ^ (aa + length (<list @ [Suc ab]>)))\<^esup>
- @ Bk\<^bsup>rn\<^esup>)"
- apply(rule_tac x = "stpa + stpb" in exI, rule_tac x = lnb in exI,
- rule_tac x = rnb in exI, simp add: steps_add tape_of_nl_cons_app1 exp_ind_def)
- done
- qed
- qed
- qed
- qed
-
-
-
-(* turing_shift can be used*)
-term t_wcode_main
-definition t_wcode_prepare :: "tprog"
- where
- "t_wcode_prepare \<equiv>
- [(W1, 2), (L, 1), (L, 3), (R, 2), (R, 4), (W0, 3),
- (R, 4), (R, 5), (R, 6), (R, 5), (R, 7), (R, 5),
- (W1, 7), (L, 0)]"
-
-fun wprepare_add_one :: "nat \<Rightarrow> nat list \<Rightarrow> tape \<Rightarrow> bool"
- where
- "wprepare_add_one m lm (l, r) =
- (\<exists> rn. l = [] \<and>
- (r = <m # lm> @ Bk\<^bsup>rn\<^esup> \<or>
- r = Bk # <m # lm> @ Bk\<^bsup>rn\<^esup>))"
-
-fun wprepare_goto_first_end :: "nat \<Rightarrow> nat list \<Rightarrow> tape \<Rightarrow> bool"
- where
- "wprepare_goto_first_end m lm (l, r) =
- (\<exists> ml mr rn. l = Oc\<^bsup>ml\<^esup> \<and>
- r = Oc\<^bsup>mr\<^esup> @ Bk # <lm> @ Bk\<^bsup>rn\<^esup> \<and>
- ml + mr = Suc (Suc m))"
-
-fun wprepare_erase :: "nat \<Rightarrow> nat list \<Rightarrow> tape \<Rightarrow> bool"
- where
- "wprepare_erase m lm (l, r) =
- (\<exists> rn. l = Oc\<^bsup>Suc m\<^esup> \<and>
- tl r = Bk # <lm> @ Bk\<^bsup>rn\<^esup>)"
-
-fun wprepare_goto_start_pos_B :: "nat \<Rightarrow> nat list \<Rightarrow> tape \<Rightarrow> bool"
- where
- "wprepare_goto_start_pos_B m lm (l, r) =
- (\<exists> rn. l = Bk # Oc\<^bsup>Suc m\<^esup> \<and>
- r = Bk # <lm> @ Bk\<^bsup>rn\<^esup>)"
-
-fun wprepare_goto_start_pos_O :: "nat \<Rightarrow> nat list \<Rightarrow> tape \<Rightarrow> bool"
- where
- "wprepare_goto_start_pos_O m lm (l, r) =
- (\<exists> rn. l = Bk # Bk # Oc\<^bsup>Suc m\<^esup> \<and>
- r = <lm> @ Bk\<^bsup>rn\<^esup>)"
-
-fun wprepare_goto_start_pos :: "nat \<Rightarrow> nat list \<Rightarrow> tape \<Rightarrow> bool"
- where
- "wprepare_goto_start_pos m lm (l, r) =
- (wprepare_goto_start_pos_B m lm (l, r) \<or>
- wprepare_goto_start_pos_O m lm (l, r))"
-
-fun wprepare_loop_start_on_rightmost :: "nat \<Rightarrow> nat list \<Rightarrow> tape \<Rightarrow> bool"
- where
- "wprepare_loop_start_on_rightmost m lm (l, r) =
- (\<exists> rn mr. rev l @ r = Oc\<^bsup>Suc m\<^esup> @ Bk # Bk # <lm> @ Bk\<^bsup>rn\<^esup> \<and> l \<noteq> [] \<and>
- r = Oc\<^bsup>mr\<^esup> @ Bk\<^bsup>rn\<^esup>)"
-
-fun wprepare_loop_start_in_middle :: "nat \<Rightarrow> nat list \<Rightarrow> tape \<Rightarrow> bool"
- where
- "wprepare_loop_start_in_middle m lm (l, r) =
- (\<exists> rn (mr:: nat) (lm1::nat list).
- rev l @ r = Oc\<^bsup>Suc m\<^esup> @ Bk # Bk # <lm> @ Bk\<^bsup>rn\<^esup> \<and> l \<noteq> [] \<and>
- r = Oc\<^bsup>mr\<^esup> @ Bk # <lm1> @ Bk\<^bsup>rn\<^esup> \<and> lm1 \<noteq> [])"
-
-fun wprepare_loop_start :: "nat \<Rightarrow> nat list \<Rightarrow> tape \<Rightarrow> bool"
- where
- "wprepare_loop_start m lm (l, r) = (wprepare_loop_start_on_rightmost m lm (l, r) \<or>
- wprepare_loop_start_in_middle m lm (l, r))"
-
-fun wprepare_loop_goon_on_rightmost :: "nat \<Rightarrow> nat list \<Rightarrow> tape \<Rightarrow> bool"
- where
- "wprepare_loop_goon_on_rightmost m lm (l, r) =
- (\<exists> rn. l = Bk # <rev lm> @ Bk # Bk # Oc\<^bsup>Suc m\<^esup> \<and>
- r = Bk\<^bsup>rn\<^esup>)"
-
-fun wprepare_loop_goon_in_middle :: "nat \<Rightarrow> nat list \<Rightarrow> tape \<Rightarrow> bool"
- where
- "wprepare_loop_goon_in_middle m lm (l, r) =
- (\<exists> rn (mr:: nat) (lm1::nat list).
- rev l @ r = Oc\<^bsup>Suc m\<^esup> @ Bk # Bk # <lm> @ Bk\<^bsup>rn\<^esup> \<and> l \<noteq> [] \<and>
- (if lm1 = [] then r = Oc\<^bsup>mr\<^esup> @ Bk\<^bsup>rn\<^esup>
- else r = Oc\<^bsup>mr\<^esup> @ Bk # <lm1> @ Bk\<^bsup>rn\<^esup>) \<and> mr > 0)"
-
-fun wprepare_loop_goon :: "nat \<Rightarrow> nat list \<Rightarrow> tape \<Rightarrow> bool"
- where
- "wprepare_loop_goon m lm (l, r) =
- (wprepare_loop_goon_in_middle m lm (l, r) \<or>
- wprepare_loop_goon_on_rightmost m lm (l, r))"
-
-fun wprepare_add_one2 :: "nat \<Rightarrow> nat list \<Rightarrow> tape \<Rightarrow> bool"
- where
- "wprepare_add_one2 m lm (l, r) =
- (\<exists> rn. l = Bk # Bk # <rev lm> @ Bk # Bk # Oc\<^bsup>Suc m\<^esup> \<and>
- (r = [] \<or> tl r = Bk\<^bsup>rn\<^esup>))"
-
-fun wprepare_stop :: "nat \<Rightarrow> nat list \<Rightarrow> tape \<Rightarrow> bool"
- where
- "wprepare_stop m lm (l, r) =
- (\<exists> rn. l = Bk # <rev lm> @ Bk # Bk # Oc\<^bsup>Suc m\<^esup> \<and>
- r = Bk # Oc # Bk\<^bsup>rn\<^esup>)"
-
-fun wprepare_inv :: "nat \<Rightarrow> nat \<Rightarrow> nat list \<Rightarrow> tape \<Rightarrow> bool"
- where
- "wprepare_inv st m lm (l, r) =
- (if st = 0 then wprepare_stop m lm (l, r)
- else if st = Suc 0 then wprepare_add_one m lm (l, r)
- else if st = Suc (Suc 0) then wprepare_goto_first_end m lm (l, r)
- else if st = Suc (Suc (Suc 0)) then wprepare_erase m lm (l, r)
- else if st = 4 then wprepare_goto_start_pos m lm (l, r)
- else if st = 5 then wprepare_loop_start m lm (l, r)
- else if st = 6 then wprepare_loop_goon m lm (l, r)
- else if st = 7 then wprepare_add_one2 m lm (l, r)
- else False)"
-
-fun wprepare_stage :: "t_conf \<Rightarrow> nat"
- where
- "wprepare_stage (st, l, r) =
- (if st \<ge> 1 \<and> st \<le> 4 then 3
- else if st = 5 \<or> st = 6 then 2
- else 1)"
-
-fun wprepare_state :: "t_conf \<Rightarrow> nat"
- where
- "wprepare_state (st, l, r) =
- (if st = 1 then 4
- else if st = Suc (Suc 0) then 3
- else if st = Suc (Suc (Suc 0)) then 2
- else if st = 4 then 1
- else if st = 7 then 2
- else 0)"
-
-fun wprepare_step :: "t_conf \<Rightarrow> nat"
- where
- "wprepare_step (st, l, r) =
- (if st = 1 then (if hd r = Oc then Suc (length l)
- else 0)
- else if st = Suc (Suc 0) then length r
- else if st = Suc (Suc (Suc 0)) then (if hd r = Oc then 1
- else 0)
- else if st = 4 then length r
- else if st = 5 then Suc (length r)
- else if st = 6 then (if r = [] then 0 else Suc (length r))
- else if st = 7 then (if (r \<noteq> [] \<and> hd r = Oc) then 0
- else 1)
- else 0)"
-
-fun wcode_prepare_measure :: "t_conf \<Rightarrow> nat \<times> nat \<times> nat"
- where
- "wcode_prepare_measure (st, l, r) =
- (wprepare_stage (st, l, r),
- wprepare_state (st, l, r),
- wprepare_step (st, l, r))"
-
-definition wcode_prepare_le :: "(t_conf \<times> t_conf) set"
- where "wcode_prepare_le \<equiv> (inv_image lex_triple wcode_prepare_measure)"
-
-lemma [intro]: "wf lex_pair"
-by(auto intro:wf_lex_prod simp:lex_pair_def)
-
-lemma wf_wcode_prepare_le[intro]: "wf wcode_prepare_le"
-by(auto intro:wf_inv_image simp: wcode_prepare_le_def
- recursive.lex_triple_def)
-
-declare wprepare_add_one.simps[simp del] wprepare_goto_first_end.simps[simp del]
- wprepare_erase.simps[simp del] wprepare_goto_start_pos.simps[simp del]
- wprepare_loop_start.simps[simp del] wprepare_loop_goon.simps[simp del]
- wprepare_add_one2.simps[simp del]
-
-lemmas wprepare_invs = wprepare_add_one.simps wprepare_goto_first_end.simps
- wprepare_erase.simps wprepare_goto_start_pos.simps
- wprepare_loop_start.simps wprepare_loop_goon.simps
- wprepare_add_one2.simps
-
-declare wprepare_inv.simps[simp del]
-lemma [simp]: "fetch t_wcode_prepare (Suc 0) Bk = (W1, 2)"
-apply(simp add: fetch.simps t_wcode_prepare_def nth_of.simps)
-done
-
-lemma [simp]: "fetch t_wcode_prepare (Suc 0) Oc = (L, 1)"
-apply(simp add: fetch.simps t_wcode_prepare_def nth_of.simps)
-done
-
-lemma [simp]: "fetch t_wcode_prepare (Suc (Suc 0)) Bk = (L, 3)"
-apply(simp add: fetch.simps t_wcode_prepare_def nth_of.simps)
-done
-
-lemma [simp]: "fetch t_wcode_prepare (Suc (Suc 0)) Oc = (R, 2)"
-apply(simp add: fetch.simps t_wcode_prepare_def nth_of.simps)
-done
-
-lemma [simp]: "fetch t_wcode_prepare (Suc (Suc (Suc 0))) Bk = (R, 4)"
-apply(simp add: fetch.simps t_wcode_prepare_def nth_of.simps)
-done
-
-lemma [simp]: "fetch t_wcode_prepare (Suc (Suc (Suc 0))) Oc = (W0, 3)"
-apply(simp add: fetch.simps t_wcode_prepare_def nth_of.simps)
-done
-
-lemma [simp]: "fetch t_wcode_prepare 4 Bk = (R, 4)"
-apply(simp add: fetch.simps t_wcode_prepare_def nth_of.simps)
-done
-
-lemma [simp]: "fetch t_wcode_prepare 4 Oc = (R, 5)"
-apply(simp add: fetch.simps t_wcode_prepare_def nth_of.simps)
-done
-
-lemma [simp]: "fetch t_wcode_prepare 5 Oc = (R, 5)"
-apply(simp add: fetch.simps t_wcode_prepare_def nth_of.simps)
-done
-
-lemma [simp]: "fetch t_wcode_prepare 5 Bk = (R, 6)"
-apply(simp add: fetch.simps t_wcode_prepare_def nth_of.simps)
-done
-
-lemma [simp]: "fetch t_wcode_prepare 6 Oc = (R, 5)"
-apply(simp add: fetch.simps t_wcode_prepare_def nth_of.simps)
-done
-
-lemma [simp]: "fetch t_wcode_prepare 6 Bk = (R, 7)"
-apply(simp add: fetch.simps t_wcode_prepare_def nth_of.simps)
-done
-
-lemma [simp]: "fetch t_wcode_prepare 7 Oc = (L, 0)"
-apply(simp add: fetch.simps t_wcode_prepare_def nth_of.simps)
-done
-
-lemma [simp]: "fetch t_wcode_prepare 7 Bk = (W1, 7)"
-apply(simp add: fetch.simps t_wcode_prepare_def nth_of.simps)
-done
-
-lemma tape_of_nl_not_null: "lm \<noteq> [] \<Longrightarrow> <lm::nat list> \<noteq> []"
-apply(case_tac lm, auto)
-apply(case_tac list, auto simp: tape_of_nl_abv tape_of_nat_list.simps exp_ind_def)
-done
-
-lemma [simp]: "lm \<noteq> [] \<Longrightarrow> wprepare_add_one m lm (b, []) = False"
-apply(simp add: wprepare_invs)
-apply(simp add: tape_of_nl_not_null)
-done
-
-lemma [simp]: "lm \<noteq> [] \<Longrightarrow> wprepare_goto_first_end m lm (b, []) = False"
-apply(simp add: wprepare_invs)
-done
-
-lemma [simp]: "lm \<noteq> [] \<Longrightarrow> wprepare_erase m lm (b, []) = False"
-apply(simp add: wprepare_invs)
-done
-
-
-
-lemma [simp]: "lm \<noteq> [] \<Longrightarrow> wprepare_goto_start_pos m lm (b, []) = False"
-apply(simp add: wprepare_invs tape_of_nl_not_null)
-done
-
-lemma [simp]: "\<lbrakk>lm \<noteq> []; wprepare_loop_start m lm (b, [])\<rbrakk> \<Longrightarrow> b \<noteq> []"
-apply(simp add: wprepare_invs tape_of_nl_not_null, auto)
-done
-
-lemma [simp]: "\<lbrakk>lm \<noteq> []; wprepare_loop_start m lm (b, [])\<rbrakk> \<Longrightarrow>
- wprepare_loop_goon m lm (Bk # b, [])"
-apply(simp only: wprepare_invs tape_of_nl_not_null)
-apply(erule_tac disjE)
-apply(rule_tac disjI2)
-apply(simp add: wprepare_loop_start_on_rightmost.simps
- wprepare_loop_goon_on_rightmost.simps, auto)
-apply(rule_tac rev_eq, simp add: tape_of_nl_rev)
-done
-
-lemma [simp]: "\<lbrakk>lm \<noteq> []; wprepare_loop_goon m lm (b, [])\<rbrakk> \<Longrightarrow> b \<noteq> []"
-apply(simp only: wprepare_invs tape_of_nl_not_null, auto)
-done
-
-lemma [simp]:"\<lbrakk>lm \<noteq> []; wprepare_loop_goon m lm (b, [])\<rbrakk> \<Longrightarrow>
- wprepare_add_one2 m lm (Bk # b, [])"
-apply(simp only: wprepare_invs tape_of_nl_not_null, auto split: if_splits)
-apply(case_tac mr, simp, simp add: exp_ind_def)
-done
-
-lemma [simp]: "wprepare_add_one2 m lm (b, []) \<Longrightarrow> b \<noteq> []"
-apply(simp only: wprepare_invs tape_of_nl_not_null, auto)
-done
-
-lemma [simp]: "wprepare_add_one2 m lm (b, []) \<Longrightarrow> wprepare_add_one2 m lm (b, [Oc])"
-apply(simp only: wprepare_invs tape_of_nl_not_null, auto)
-done
-
-lemma [simp]: "Bk # list = <(m::nat) # lm> @ ys = False"
-apply(case_tac lm, auto simp: tape_of_nl_abv tape_of_nat_list.simps exp_ind_def)
-done
-
-lemma [simp]: "\<lbrakk>lm \<noteq> []; wprepare_add_one m lm (b, Bk # list)\<rbrakk>
- \<Longrightarrow> (b = [] \<longrightarrow> wprepare_goto_first_end m lm ([], Oc # list)) \<and>
- (b \<noteq> [] \<longrightarrow> wprepare_goto_first_end m lm (b, Oc # list))"
-apply(simp only: wprepare_invs, auto)
-apply(rule_tac x = 0 in exI, simp add: exp_ind_def)
-apply(case_tac lm, simp, simp add: tape_of_nl_abv tape_of_nat_list.simps exp_ind_def)
-apply(rule_tac x = rn in exI, simp)
-done
-
-lemma [simp]: "wprepare_goto_first_end m lm (b, Bk # list) \<Longrightarrow> b \<noteq> []"
-apply(simp only: wprepare_invs tape_of_nl_not_null, auto)
-apply(case_tac mr, simp_all add: exp_ind_def)
-done
-
-lemma [simp]: "wprepare_goto_first_end m lm (b, Bk # list) \<Longrightarrow>
- wprepare_erase m lm (tl b, hd b # Bk # list)"
-apply(simp only: wprepare_invs tape_of_nl_not_null, auto)
-apply(case_tac mr, simp_all add: exp_ind_def)
-apply(case_tac mr, auto simp: exp_ind_def)
-done
-
-lemma [simp]: "wprepare_erase m lm (b, Bk # list) \<Longrightarrow> b \<noteq> []"
-apply(simp only: wprepare_invs exp_ind_def, auto)
-done
-
-lemma [simp]: "wprepare_erase m lm (b, Bk # list) \<Longrightarrow>
- wprepare_goto_start_pos m lm (Bk # b, list)"
-apply(simp only: wprepare_invs, auto)
-done
-
-lemma [simp]: "\<lbrakk>wprepare_add_one m lm (b, Bk # list)\<rbrakk> \<Longrightarrow> list \<noteq> []"
-apply(simp only: wprepare_invs)
-apply(case_tac lm, simp_all add: tape_of_nl_abv
- tape_of_nat_list.simps exp_ind_def, auto)
-done
-
-lemma [simp]: "\<lbrakk>lm \<noteq> []; wprepare_goto_first_end m lm (b, Bk # list)\<rbrakk> \<Longrightarrow> list \<noteq> []"
-apply(simp only: wprepare_invs, auto)
-apply(case_tac mr, simp_all add: exp_ind_def)
-apply(simp add: tape_of_nl_not_null)
-done
-
-lemma [simp]: "\<lbrakk>lm \<noteq> []; wprepare_goto_first_end m lm (b, Bk # list)\<rbrakk> \<Longrightarrow> b \<noteq> []"
-apply(simp only: wprepare_invs, auto)
-apply(case_tac mr, simp_all add: exp_ind_def tape_of_nl_not_null)
-done
-
-lemma [simp]: "\<lbrakk>lm \<noteq> []; wprepare_erase m lm (b, Bk # list)\<rbrakk> \<Longrightarrow> list \<noteq> []"
-apply(simp only: wprepare_invs, auto)
-done
-
-lemma [simp]: "\<lbrakk>lm \<noteq> []; wprepare_erase m lm (b, Bk # list)\<rbrakk> \<Longrightarrow> b \<noteq> []"
-apply(simp only: wprepare_invs, auto simp: exp_ind_def)
-done
-
-lemma [simp]: "\<lbrakk>lm \<noteq> []; wprepare_goto_start_pos m lm (b, Bk # list)\<rbrakk> \<Longrightarrow> list \<noteq> []"
-apply(simp only: wprepare_invs, auto)
-apply(simp add: tape_of_nl_not_null)
-apply(case_tac lm, simp, case_tac list)
-apply(simp_all add: tape_of_nl_abv tape_of_nat_list.simps exp_ind_def)
-done
-
-lemma [simp]: "\<lbrakk>lm \<noteq> []; wprepare_goto_start_pos m lm (b, Bk # list)\<rbrakk> \<Longrightarrow> b \<noteq> []"
-apply(simp only: wprepare_invs)
-apply(auto)
-done
-
-lemma [simp]: "\<lbrakk>lm \<noteq> []; wprepare_loop_goon m lm (b, Bk # list)\<rbrakk> \<Longrightarrow> b \<noteq> []"
-apply(simp only: wprepare_invs, auto)
-done
-
-lemma [simp]: "\<lbrakk>lm \<noteq> []; wprepare_loop_goon m lm (b, Bk # list)\<rbrakk> \<Longrightarrow>
- (list = [] \<longrightarrow> wprepare_add_one2 m lm (Bk # b, [])) \<and>
- (list \<noteq> [] \<longrightarrow> wprepare_add_one2 m lm (Bk # b, list))"
-apply(simp only: wprepare_invs, simp)
-apply(case_tac list, simp_all split: if_splits, auto)
-apply(case_tac [1-3] mr, simp_all add: exp_ind_def)
-apply(case_tac mr, simp_all add: exp_ind_def tape_of_nl_not_null)
-apply(case_tac [1-2] mr, simp_all add: exp_ind_def)
-apply(case_tac rn, simp, case_tac nat, auto simp: exp_ind_def)
-done
-
-lemma [simp]: "wprepare_add_one2 m lm (b, Bk # list) \<Longrightarrow> b \<noteq> []"
-apply(simp only: wprepare_invs, simp)
-done
-
-lemma [simp]: "wprepare_add_one2 m lm (b, Bk # list) \<Longrightarrow>
- (list = [] \<longrightarrow> wprepare_add_one2 m lm (b, [Oc])) \<and>
- (list \<noteq> [] \<longrightarrow> wprepare_add_one2 m lm (b, Oc # list))"
-apply(simp only: wprepare_invs, auto)
-done
-
-lemma [simp]: "wprepare_goto_first_end m lm (b, Oc # list)
- \<Longrightarrow> (b = [] \<longrightarrow> wprepare_goto_first_end m lm ([Oc], list)) \<and>
- (b \<noteq> [] \<longrightarrow> wprepare_goto_first_end m lm (Oc # b, list))"
-apply(simp only: wprepare_invs, auto)
-apply(rule_tac x = 1 in exI, auto)
-apply(case_tac mr, simp_all add: exp_ind_def)
-apply(case_tac ml, simp_all add: exp_ind_def)
-apply(rule_tac x = rn in exI, simp)
-apply(rule_tac x = "Suc ml" in exI, simp_all add: exp_ind_def)
-apply(rule_tac x = "mr - 1" in exI, simp)
-apply(case_tac mr, simp_all add: exp_ind_def, auto)
-done
-
-lemma [simp]: "wprepare_erase m lm (b, Oc # list) \<Longrightarrow> b \<noteq> []"
-apply(simp only: wprepare_invs, auto simp: exp_ind_def)
-done
-
-lemma [simp]: "wprepare_erase m lm (b, Oc # list)
- \<Longrightarrow> wprepare_erase m lm (b, Bk # list)"
-apply(simp only:wprepare_invs, auto simp: exp_ind_def)
-done
-
-lemma [simp]: "\<lbrakk>lm \<noteq> []; wprepare_goto_start_pos m lm (b, Bk # list)\<rbrakk>
- \<Longrightarrow> wprepare_goto_start_pos m lm (Bk # b, list)"
-apply(simp only:wprepare_invs, auto)
-apply(case_tac [!] lm, simp, simp_all)
-done
-
-lemma [simp]: "wprepare_loop_start m lm (b, aa) \<Longrightarrow> b \<noteq> []"
-apply(simp only:wprepare_invs, auto)
-done
-lemma [elim]: "Bk # list = Oc\<^bsup>mr\<^esup> @ Bk\<^bsup>rn\<^esup> \<Longrightarrow> \<exists>rn. list = Bk\<^bsup>rn\<^esup>"
-apply(case_tac mr, simp_all)
-apply(case_tac rn, simp_all add: exp_ind_def, auto)
-done
-
-lemma rev_equal_iff: "x = y \<Longrightarrow> rev x = rev y"
-by simp
-
-lemma tape_of_nl_false1:
- "lm \<noteq> [] \<Longrightarrow> rev b @ [Bk] \<noteq> Bk\<^bsup>ln\<^esup> @ Oc # Oc\<^bsup>m\<^esup> @ Bk # Bk # <lm::nat list>"
-apply(auto)
-apply(drule_tac rev_equal_iff, simp add: tape_of_nl_rev)
-apply(case_tac "rev lm")
-apply(case_tac [2] list, auto simp: tape_of_nl_abv tape_of_nat_list.simps exp_ind_def)
-done
-
-lemma [simp]: "wprepare_loop_start_in_middle m lm (b, [Bk]) = False"
-apply(simp add: wprepare_loop_start_in_middle.simps, auto)
-apply(case_tac mr, simp_all add: exp_ind_def)
-apply(case_tac lm1, simp, simp add: tape_of_nl_not_null)
-done
-
-declare wprepare_loop_start_in_middle.simps[simp del]
-
-declare wprepare_loop_start_on_rightmost.simps[simp del]
- wprepare_loop_goon_in_middle.simps[simp del]
- wprepare_loop_goon_on_rightmost.simps[simp del]
-
-lemma [simp]: "wprepare_loop_goon_in_middle m lm (Bk # b, []) = False"
-apply(simp add: wprepare_loop_goon_in_middle.simps, auto)
-done
-
-lemma [simp]: "\<lbrakk>lm \<noteq> []; wprepare_loop_start m lm (b, [Bk])\<rbrakk> \<Longrightarrow>
- wprepare_loop_goon m lm (Bk # b, [])"
-apply(simp only: wprepare_invs, simp)
-apply(simp add: wprepare_loop_goon_on_rightmost.simps
- wprepare_loop_start_on_rightmost.simps, auto)
-apply(case_tac mr, simp_all add: exp_ind_def)
-apply(rule_tac rev_eq)
-apply(simp add: tape_of_nl_rev)
-apply(simp add: exp_ind_def[THEN sym] exp_ind)
-done
-
-lemma [simp]: "wprepare_loop_start_on_rightmost m lm (b, Bk # a # lista)
- \<Longrightarrow> wprepare_loop_goon_in_middle m lm (Bk # b, a # lista) = False"
-apply(auto simp: wprepare_loop_start_on_rightmost.simps
- wprepare_loop_goon_in_middle.simps)
-apply(case_tac [!] mr, simp_all add: exp_ind_def)
-done
-
-lemma [simp]: "\<lbrakk>lm \<noteq> []; wprepare_loop_start_on_rightmost m lm (b, Bk # a # lista)\<rbrakk>
- \<Longrightarrow> wprepare_loop_goon_on_rightmost m lm (Bk # b, a # lista)"
-apply(simp only: wprepare_loop_start_on_rightmost.simps
- wprepare_loop_goon_on_rightmost.simps, auto)
-apply(case_tac mr, simp_all add: exp_ind_def)
-apply(simp add: tape_of_nl_rev)
-apply(simp add: exp_ind_def[THEN sym] exp_ind)
-done
-
-lemma [simp]: "\<lbrakk>lm \<noteq> []; wprepare_loop_start_in_middle m lm (b, Bk # a # lista)\<rbrakk>
- \<Longrightarrow> wprepare_loop_goon_on_rightmost m lm (Bk # b, a # lista) = False"
-apply(simp add: wprepare_loop_start_in_middle.simps
- wprepare_loop_goon_on_rightmost.simps, auto)
-apply(case_tac mr, simp_all add: exp_ind_def)
-apply(case_tac "lm1::nat list", simp_all, case_tac list, simp)
-apply(simp add: tape_of_nl_abv tape_of_nat_list.simps tape_of_nat_abv exp_ind_def)
-apply(case_tac [!] rna, simp_all add: exp_ind_def)
-apply(case_tac mr, simp_all add: exp_ind_def)
-apply(case_tac lm1, simp, case_tac list, simp)
-apply(simp_all add: tape_of_nl_abv tape_of_nat_list.simps exp_ind_def tape_of_nat_abv)
-done
-
-lemma [simp]:
- "\<lbrakk>lm \<noteq> []; wprepare_loop_start_in_middle m lm (b, Bk # a # lista)\<rbrakk>
- \<Longrightarrow> wprepare_loop_goon_in_middle m lm (Bk # b, a # lista)"
-apply(simp add: wprepare_loop_start_in_middle.simps
- wprepare_loop_goon_in_middle.simps, auto)
-apply(rule_tac x = rn in exI, simp)
-apply(case_tac mr, simp_all add: exp_ind_def)
-apply(case_tac lm1, simp)
-apply(rule_tac x = "Suc aa" in exI, simp)
-apply(rule_tac x = list in exI)
-apply(case_tac list, simp_all add: tape_of_nl_abv tape_of_nat_list.simps)
-done
-
-lemma [simp]: "\<lbrakk>lm \<noteq> []; wprepare_loop_start m lm (b, Bk # a # lista)\<rbrakk> \<Longrightarrow>
- wprepare_loop_goon m lm (Bk # b, a # lista)"
-apply(simp add: wprepare_loop_start.simps
- wprepare_loop_goon.simps)
-apply(erule_tac disjE, simp, auto)
-done
-
-lemma start_2_goon:
- "\<lbrakk>lm \<noteq> []; wprepare_loop_start m lm (b, Bk # list)\<rbrakk> \<Longrightarrow>
- (list = [] \<longrightarrow> wprepare_loop_goon m lm (Bk # b, [])) \<and>
- (list \<noteq> [] \<longrightarrow> wprepare_loop_goon m lm (Bk # b, list))"
-apply(case_tac list, auto)
-done
-
-lemma add_one_2_add_one: "wprepare_add_one m lm (b, Oc # list)
- \<Longrightarrow> (hd b = Oc \<longrightarrow> (b = [] \<longrightarrow> wprepare_add_one m lm ([], Bk # Oc # list)) \<and>
- (b \<noteq> [] \<longrightarrow> wprepare_add_one m lm (tl b, Oc # Oc # list))) \<and>
- (hd b \<noteq> Oc \<longrightarrow> (b = [] \<longrightarrow> wprepare_add_one m lm ([], Bk # Oc # list)) \<and>
- (b \<noteq> [] \<longrightarrow> wprepare_add_one m lm (tl b, hd b # Oc # list)))"
-apply(simp only: wprepare_add_one.simps, auto)
-done
-
-lemma [simp]: "wprepare_loop_start m lm (b, Oc # list) \<Longrightarrow> b \<noteq> []"
-apply(simp)
-done
-
-lemma [simp]: "wprepare_loop_start_on_rightmost m lm (b, Oc # list) \<Longrightarrow>
- wprepare_loop_start_on_rightmost m lm (Oc # b, list)"
-apply(simp add: wprepare_loop_start_on_rightmost.simps, auto)
-apply(rule_tac x = rn in exI, auto)
-apply(case_tac mr, simp_all add: exp_ind_def)
-apply(case_tac rn, auto simp: exp_ind_def)
-done
-
-lemma [simp]: "wprepare_loop_start_in_middle m lm (b, Oc # list) \<Longrightarrow>
- wprepare_loop_start_in_middle m lm (Oc # b, list)"
-apply(simp add: wprepare_loop_start_in_middle.simps, auto)
-apply(rule_tac x = rn in exI, auto)
-apply(case_tac mr, simp, simp add: exp_ind_def)
-apply(rule_tac x = nat in exI, simp)
-apply(rule_tac x = lm1 in exI, simp)
-done
-
-lemma start_2_start: "wprepare_loop_start m lm (b, Oc # list) \<Longrightarrow>
- wprepare_loop_start m lm (Oc # b, list)"
-apply(simp add: wprepare_loop_start.simps)
-apply(erule_tac disjE, simp_all )
-done
-
-lemma [simp]: "wprepare_loop_goon m lm (b, Oc # list) \<Longrightarrow> b \<noteq> []"
-apply(simp add: wprepare_loop_goon.simps
- wprepare_loop_goon_in_middle.simps
- wprepare_loop_goon_on_rightmost.simps)
-apply(auto)
-done
-
-lemma [simp]: "wprepare_goto_start_pos m lm (b, Oc # list) \<Longrightarrow> b \<noteq> []"
-apply(simp add: wprepare_goto_start_pos.simps)
-done
-
-lemma [simp]: "wprepare_loop_goon_on_rightmost m lm (b, Oc # list) = False"
-apply(simp add: wprepare_loop_goon_on_rightmost.simps)
-done
-lemma wprepare_loop1: "\<lbrakk>rev b @ Oc\<^bsup>mr\<^esup> = Oc\<^bsup>Suc m\<^esup> @ Bk # Bk # <lm>;
- b \<noteq> []; 0 < mr; Oc # list = Oc\<^bsup>mr\<^esup> @ Bk\<^bsup>rn\<^esup>\<rbrakk>
- \<Longrightarrow> wprepare_loop_start_on_rightmost m lm (Oc # b, list)"
-apply(simp add: wprepare_loop_start_on_rightmost.simps)
-apply(rule_tac x = rn in exI, simp)
-apply(case_tac mr, simp, simp add: exp_ind_def, auto)
-done
-
-lemma wprepare_loop2: "\<lbrakk>rev b @ Oc\<^bsup>mr\<^esup> @ Bk # <a # lista> = Oc\<^bsup>Suc m\<^esup> @ Bk # Bk # <lm>;
- b \<noteq> []; Oc # list = Oc\<^bsup>mr\<^esup> @ Bk # <(a::nat) # lista> @ Bk\<^bsup>rn\<^esup>\<rbrakk>
- \<Longrightarrow> wprepare_loop_start_in_middle m lm (Oc # b, list)"
-apply(simp add: wprepare_loop_start_in_middle.simps)
-apply(rule_tac x = rn in exI, simp)
-apply(case_tac mr, simp_all add: exp_ind_def)
-apply(rule_tac x = nat in exI, simp)
-apply(rule_tac x = "a#lista" in exI, simp)
-done
-
-lemma [simp]: "wprepare_loop_goon_in_middle m lm (b, Oc # list) \<Longrightarrow>
- wprepare_loop_start_on_rightmost m lm (Oc # b, list) \<or>
- wprepare_loop_start_in_middle m lm (Oc # b, list)"
-apply(simp add: wprepare_loop_goon_in_middle.simps split: if_splits)
-apply(case_tac lm1, simp_all add: wprepare_loop1 wprepare_loop2)
-done
-
-lemma [simp]: "wprepare_loop_goon m lm (b, Oc # list)
- \<Longrightarrow> wprepare_loop_start m lm (Oc # b, list)"
-apply(simp add: wprepare_loop_goon.simps
- wprepare_loop_start.simps)
-done
-
-lemma [simp]: "wprepare_add_one m lm (b, Oc # list)
- \<Longrightarrow> b = [] \<longrightarrow> wprepare_add_one m lm ([], Bk # Oc # list)"
-apply(auto)
-apply(simp add: wprepare_add_one.simps)
-done
-
-lemma [simp]: "wprepare_goto_start_pos m [a] (b, Oc # list)
- \<Longrightarrow> wprepare_loop_start_on_rightmost m [a] (Oc # b, list) "
-apply(auto simp: wprepare_goto_start_pos.simps
- wprepare_loop_start_on_rightmost.simps)
-apply(rule_tac x = rn in exI, simp)
-apply(simp add: tape_of_nat_abv tape_of_nat_list.simps exp_ind_def, auto)
-done
-
-lemma [simp]: "wprepare_goto_start_pos m (a # aa # listaa) (b, Oc # list)
- \<Longrightarrow>wprepare_loop_start_in_middle m (a # aa # listaa) (Oc # b, list)"
-apply(auto simp: wprepare_goto_start_pos.simps
- wprepare_loop_start_in_middle.simps)
-apply(rule_tac x = rn in exI, simp)
-apply(simp add: tape_of_nl_abv tape_of_nat_list.simps exp_ind_def)
-apply(rule_tac x = a in exI, rule_tac x = "aa#listaa" in exI, simp)
-done
-
-lemma [simp]: "\<lbrakk>lm \<noteq> []; wprepare_goto_start_pos m lm (b, Oc # list)\<rbrakk>
- \<Longrightarrow> wprepare_loop_start m lm (Oc # b, list)"
-apply(case_tac lm, simp_all)
-apply(case_tac lista, simp_all add: wprepare_loop_start.simps)
-done
-
-lemma [simp]: "wprepare_add_one2 m lm (b, Oc # list) \<Longrightarrow> b \<noteq> []"
-apply(auto simp: wprepare_add_one2.simps)
-done
-
-lemma add_one_2_stop:
- "wprepare_add_one2 m lm (b, Oc # list)
- \<Longrightarrow> wprepare_stop m lm (tl b, hd b # Oc # list)"
-apply(simp add: wprepare_stop.simps wprepare_add_one2.simps)
-done
-
-declare wprepare_stop.simps[simp del]
-
-lemma wprepare_correctness:
- assumes h: "lm \<noteq> []"
- shows "let P = (\<lambda> (st, l, r). st = 0) in
- let Q = (\<lambda> (st, l, r). wprepare_inv st m lm (l, r)) in
- let f = (\<lambda> stp. steps (Suc 0, [], (<m # lm>)) t_wcode_prepare stp) in
- \<exists> n .P (f n) \<and> Q (f n)"
-proof -
- let ?P = "(\<lambda> (st, l, r). st = 0)"
- let ?Q = "(\<lambda> (st, l, r). wprepare_inv st m lm (l, r))"
- let ?f = "(\<lambda> stp. steps (Suc 0, [], (<m # lm>)) t_wcode_prepare stp)"
- have "\<exists> n. ?P (?f n) \<and> ?Q (?f n)"
- proof(rule_tac halt_lemma2)
- show "wf wcode_prepare_le" by auto
- next
- show "\<forall> n. \<not> ?P (?f n) \<and> ?Q (?f n) \<longrightarrow>
- ?Q (?f (Suc n)) \<and> (?f (Suc n), ?f n) \<in> wcode_prepare_le"
- using h
- apply(rule_tac allI, rule_tac impI, case_tac "?f n",
- simp add: tstep_red tstep.simps)
- apply(case_tac c, simp, case_tac [2] aa)
- apply(simp_all add: wprepare_inv.simps wcode_prepare_le_def new_tape.simps
- lex_triple_def lex_pair_def
-
- split: if_splits)
- apply(simp_all add: start_2_goon start_2_start
- add_one_2_add_one add_one_2_stop)
- apply(auto simp: wprepare_add_one2.simps)
- done
- next
- show "?Q (?f 0)"
- apply(simp add: steps.simps wprepare_inv.simps wprepare_invs)
- done
- next
- show "\<not> ?P (?f 0)"
- apply(simp add: steps.simps)
- done
- qed
- thus "?thesis"
- apply(auto)
- done
-qed
-
-lemma [intro]: "t_correct t_wcode_prepare"
-apply(simp add: t_correct.simps t_wcode_prepare_def iseven_def)
-apply(rule_tac x = 7 in exI, simp)
-done
-
-lemma twice_len_even: "length (tm_of abc_twice) mod 2 = 0"
-apply(simp add: tm_even)
-done
-
-lemma fourtimes_len_even: "length (tm_of abc_fourtimes) mod 2 = 0"
-apply(simp add: tm_even)
-done
-
-lemma t_correct_termi: "t_correct tp \<Longrightarrow>
- list_all (\<lambda>(acn, st). (st \<le> Suc (length tp div 2))) (change_termi_state tp)"
-apply(auto simp: t_correct.simps List.list_all_length)
-apply(erule_tac x = n in allE, simp)
-apply(case_tac "tp!n", auto simp: change_termi_state.simps split: if_splits)
-done
-
-
-lemma t_correct_shift:
- "list_all (\<lambda>(acn, st). (st \<le> y)) tp \<Longrightarrow>
- list_all (\<lambda>(acn, st). (st \<le> y + off)) (tshift tp off) "
-apply(auto simp: t_correct.simps List.list_all_length)
-apply(erule_tac x = n in allE, simp add: shift_length)
-apply(case_tac "tp!n", auto simp: tshift.simps)
-done
-
-lemma [intro]:
- "t_correct (tm_of abc_twice @ tMp (Suc 0)
- (start_of twice_ly (length abc_twice) - Suc 0))"
-apply(rule_tac t_compiled_correct, simp_all)
-apply(simp add: twice_ly_def)
-done
-
-lemma [intro]: "t_correct (tm_of abc_fourtimes @ tMp (Suc 0)
- (start_of fourtimes_ly (length abc_fourtimes) - Suc 0))"
-apply(rule_tac t_compiled_correct, simp_all)
-apply(simp add: fourtimes_ly_def)
-done
-
-
-lemma [intro]: "t_correct t_wcode_main"
-apply(auto simp: t_wcode_main_def t_correct.simps shift_length
- t_twice_def t_fourtimes_def)
-proof -
- show "iseven (60 + (length (tm_of abc_twice) +
- length (tm_of abc_fourtimes)))"
- using twice_len_even fourtimes_len_even
- apply(auto simp: iseven_def)
- apply(rule_tac x = "30 + q + qa" in exI, simp)
- done
-next
- show " list_all (\<lambda>(acn, s). s \<le> (60 + (length (tm_of abc_twice) +
- length (tm_of abc_fourtimes))) div 2) t_wcode_main_first_part"
- apply(auto simp: t_wcode_main_first_part_def shift_length t_twice_def)
- done
-next
- have "list_all (\<lambda>(acn, s). s \<le> Suc (length (tm_of abc_twice @ tMp (Suc 0)
- (start_of twice_ly (length abc_twice) - Suc 0)) div 2))
- (change_termi_state (tm_of abc_twice @ tMp (Suc 0)
- (start_of twice_ly (length abc_twice) - Suc 0)))"
- apply(rule_tac t_correct_termi, auto)
- done
- hence "list_all (\<lambda>(acn, s). s \<le> Suc (length (tm_of abc_twice @ tMp (Suc 0)
- (start_of twice_ly (length abc_twice) - Suc 0)) div 2) + 12)
- (abacus.tshift (change_termi_state (tm_of abc_twice @ tMp (Suc 0)
- (start_of twice_ly (length abc_twice) - Suc 0))) 12)"
- apply(rule_tac t_correct_shift, simp)
- done
- thus "list_all (\<lambda>(acn, s). s \<le>
- (60 + (length (tm_of abc_twice) + length (tm_of abc_fourtimes))) div 2)
- (abacus.tshift (change_termi_state (tm_of abc_twice @ tMp (Suc 0)
- (start_of twice_ly (length abc_twice) - Suc 0))) 12)"
- apply(simp)
- apply(simp add: list_all_length, auto)
- done
-next
- have "list_all (\<lambda>(acn, s). s \<le> Suc (length (tm_of abc_fourtimes @ tMp (Suc 0)
- (start_of fourtimes_ly (length abc_fourtimes) - Suc 0)) div 2))
- (change_termi_state (tm_of abc_fourtimes @ tMp (Suc 0)
- (start_of fourtimes_ly (length abc_fourtimes) - Suc 0))) "
- apply(rule_tac t_correct_termi, auto)
- done
- hence "list_all (\<lambda>(acn, s). s \<le> Suc (length (tm_of abc_fourtimes @ tMp (Suc 0)
- (start_of fourtimes_ly (length abc_fourtimes) - Suc 0)) div 2) + (t_twice_len + 13))
- (abacus.tshift (change_termi_state (tm_of abc_fourtimes @ tMp (Suc 0)
- (start_of fourtimes_ly (length abc_fourtimes) - Suc 0))) (t_twice_len + 13))"
- apply(rule_tac t_correct_shift, simp)
- done
- thus "list_all (\<lambda>(acn, s). s \<le> (60 + (length (tm_of abc_twice) + length (tm_of abc_fourtimes))) div 2)
- (abacus.tshift (change_termi_state (tm_of abc_fourtimes @ tMp (Suc 0)
- (start_of fourtimes_ly (length abc_fourtimes) - Suc 0))) (t_twice_len + 13))"
- apply(simp add: t_twice_len_def t_twice_def)
- using twice_len_even fourtimes_len_even
- apply(auto simp: list_all_length)
- done
-qed
-
-lemma [intro]: "t_correct (t_wcode_prepare |+| t_wcode_main)"
-apply(auto intro: t_correct_add)
-done
-
-lemma prepare_mainpart_lemma:
- "args \<noteq> [] \<Longrightarrow>
- \<exists> stp ln rn. steps (Suc 0, [], <m # args>) (t_wcode_prepare |+| t_wcode_main) stp
- = (0, Bk # Oc\<^bsup>Suc m\<^esup>, Bk # Oc # Bk\<^bsup>ln\<^esup> @ Bk # Bk # Oc\<^bsup>bl_bin (<args>)\<^esup> @ Bk\<^bsup>rn\<^esup>)"
-proof -
- let ?P1 = "\<lambda> (l, r). l = [] \<and> r = <m # args>"
- let ?Q1 = "\<lambda> (l, r). wprepare_stop m args (l, r)"
- let ?P2 = ?Q1
- let ?Q2 = "\<lambda> (l, r). (\<exists> ln rn. l = Bk # Oc\<^bsup>Suc m\<^esup> \<and>
- r = Bk # Oc # Bk\<^bsup>ln\<^esup> @ Bk # Bk # Oc\<^bsup>bl_bin (<args>)\<^esup> @ Bk\<^bsup>rn\<^esup>)"
- let ?P3 = "\<lambda> tp. False"
- assume h: "args \<noteq> []"
- have "?P1 \<turnstile>-> \<lambda> tp. (\<exists> stp tp'. steps (Suc 0, tp)
- (t_wcode_prepare |+| t_wcode_main) stp = (0, tp') \<and> ?Q2 tp')"
- proof(rule_tac turing_merge.t_merge_halt[of t_wcode_prepare t_wcode_main ?P1 ?P2 ?P3 ?P3 ?Q1 ?Q2],
- auto simp: turing_merge_def)
- show "\<exists>stp. case steps (Suc 0, [], <m # args>) t_wcode_prepare stp of (st, tp')
- \<Rightarrow> st = 0 \<and> wprepare_stop m args tp'"
- using wprepare_correctness[of args m] h
- apply(simp, auto)
- apply(rule_tac x = n in exI, simp add: wprepare_inv.simps)
- done
- next
- fix a b
- assume "wprepare_stop m args (a, b)"
- thus "\<exists>stp. case steps (Suc 0, a, b) t_wcode_main stp of
- (st, tp') \<Rightarrow> (st = 0) \<and> (case tp' of (l, r) \<Rightarrow> l = Bk # Oc\<^bsup>Suc m\<^esup> \<and>
- (\<exists>ln rn. r = Bk # Oc # Bk\<^bsup>ln\<^esup> @ Bk # Bk # Oc\<^bsup>bl_bin (<args>)\<^esup> @ Bk\<^bsup>rn\<^esup>))"
- proof(simp only: wprepare_stop.simps, erule_tac exE)
- fix rn
- assume "a = Bk # <rev args> @ Bk # Bk # Oc\<^bsup>Suc m\<^esup> \<and>
- b = Bk # Oc # Bk\<^bsup>rn\<^esup>"
- thus "?thesis"
- using t_wcode_main_lemma_pre[of "args" "<args>" 0 "Oc\<^bsup>Suc m\<^esup>" 0 rn] h
- apply(simp)
- apply(erule_tac exE)+
- apply(rule_tac x = stp in exI, simp add: tape_of_nl_rev, auto)
- done
- qed
- next
- show "wprepare_stop m args \<turnstile>-> wprepare_stop m args"
- by(simp add: t_imply_def)
- qed
- thus "\<exists> stp ln rn. steps (Suc 0, [], <m # args>) (t_wcode_prepare |+| t_wcode_main) stp
- = (0, Bk # Oc\<^bsup>Suc m\<^esup>, Bk # Oc # Bk\<^bsup>ln\<^esup> @ Bk # Bk # Oc\<^bsup>bl_bin (<args>)\<^esup> @ Bk\<^bsup>rn\<^esup>)"
- apply(simp add: t_imply_def)
- apply(erule_tac exE)+
- apply(auto)
- done
-qed
-
-
-lemma [simp]: "tinres r r' \<Longrightarrow>
- fetch t ss (case r of [] \<Rightarrow> Bk | x # xs \<Rightarrow> x) =
- fetch t ss (case r' of [] \<Rightarrow> Bk | x # xs \<Rightarrow> x)"
-apply(simp add: fetch.simps, auto split: if_splits simp: tinres_def)
-apply(case_tac [!] r', simp_all)
-apply(case_tac [!] n, simp_all add: exp_ind_def)
-apply(case_tac [!] r, simp_all)
-done
-
-lemma [intro]: "\<exists> n. (a::block)\<^bsup>n\<^esup> = []"
-by auto
-
-lemma [simp]: "\<lbrakk>tinres r r'; r \<noteq> []; r' \<noteq> []\<rbrakk> \<Longrightarrow> hd r = hd r'"
-apply(auto simp: tinres_def)
-done
-
-lemma [intro]: "hd (Bk\<^bsup>Suc n\<^esup>) = Bk"
-apply(simp add: exp_ind_def)
-done
-
-lemma [simp]: "\<lbrakk>tinres r []; r \<noteq> []\<rbrakk> \<Longrightarrow> hd r = Bk"
-apply(auto simp: tinres_def)
-apply(case_tac n, auto)
-done
-
-lemma [simp]: "\<lbrakk>tinres [] r'; r' \<noteq> []\<rbrakk> \<Longrightarrow> hd r' = Bk"
-apply(auto simp: tinres_def)
-done
-
-lemma [intro]: "\<exists>na. tl r = tl (r @ Bk\<^bsup>n\<^esup>) @ Bk\<^bsup>na\<^esup> \<or> tl (r @ Bk\<^bsup>n\<^esup>) = tl r @ Bk\<^bsup>na\<^esup>"
-apply(case_tac r, simp)
-apply(case_tac n, simp)
-apply(rule_tac x = 0 in exI, simp)
-apply(rule_tac x = nat in exI, simp add: exp_ind_def)
-apply(simp)
-apply(rule_tac x = n in exI, simp)
-done
-
-lemma [simp]: "tinres r r' \<Longrightarrow> tinres (tl r) (tl r')"
-apply(auto simp: tinres_def)
-apply(case_tac r', simp_all)
-apply(case_tac n, simp_all add: exp_ind_def)
-apply(rule_tac x = 0 in exI, simp)
-apply(rule_tac x = nat in exI, simp_all)
-apply(rule_tac x = n in exI, simp)
-done
-
-lemma [simp]: "\<lbrakk>tinres r []; r \<noteq> []\<rbrakk> \<Longrightarrow> tinres (tl r) []"
-apply(case_tac r, auto simp: tinres_def)
-apply(case_tac n, simp_all add: exp_ind_def)
-apply(rule_tac x = nat in exI, simp)
-done
-
-lemma [simp]: "\<lbrakk>tinres [] r'\<rbrakk> \<Longrightarrow> tinres [] (tl r')"
-apply(case_tac r', auto simp: tinres_def)
-apply(case_tac n, simp_all add: exp_ind_def)
-apply(rule_tac x = nat in exI, simp)
-done
-
-lemma [simp]: "tinres r r' \<Longrightarrow> tinres (b # r) (b # r')"
-apply(auto simp: tinres_def)
-done
-
-lemma tinres_step2:
- "\<lbrakk>tinres r r'; tstep (ss, l, r) t = (sa, la, ra); tstep (ss, l, r') t = (sb, lb, rb)\<rbrakk>
- \<Longrightarrow> la = lb \<and> tinres ra rb \<and> sa = sb"
-apply(case_tac "ss = 0", simp add: tstep_0)
-apply(simp add: tstep.simps [simp del])
-apply(case_tac "fetch t ss (case r of [] \<Rightarrow> Bk | x # xs \<Rightarrow> x)", simp)
-apply(auto simp: new_tape.simps)
-apply(simp_all split: taction.splits if_splits)
-apply(auto)
-done
-
-
-lemma tinres_steps2:
- "\<lbrakk>tinres r r'; steps (ss, l, r) t stp = (sa, la, ra); steps (ss, l, r') t stp = (sb, lb, rb)\<rbrakk>
- \<Longrightarrow> la = lb \<and> tinres ra rb \<and> sa = sb"
-apply(induct stp arbitrary: sa la ra sb lb rb, simp add: steps.simps)
-apply(simp add: tstep_red)
-apply(case_tac "(steps (ss, l, r) t stp)")
-apply(case_tac "(steps (ss, l, r') t stp)")
-proof -
- fix stp sa la ra sb lb rb a b c aa ba ca
- assume ind: "\<And>sa la ra sb lb rb. \<lbrakk>steps (ss, l, r) t stp = (sa, la, ra);
- steps (ss, l, r') t stp = (sb, lb, rb)\<rbrakk> \<Longrightarrow> la = lb \<and> tinres ra rb \<and> sa = sb"
- and h: " tinres r r'" "tstep (steps (ss, l, r) t stp) t = (sa, la, ra)"
- "tstep (steps (ss, l, r') t stp) t = (sb, lb, rb)" "steps (ss, l, r) t stp = (a, b, c)"
- "steps (ss, l, r') t stp = (aa, ba, ca)"
- have "b = ba \<and> tinres c ca \<and> a = aa"
- apply(rule_tac ind, simp_all add: h)
- done
- thus "la = lb \<and> tinres ra rb \<and> sa = sb"
- apply(rule_tac l = b and r = c and ss = a and r' = ca
- and t = t in tinres_step2)
- using h
- apply(simp, simp, simp)
- done
-qed
-
-definition t_wcode_adjust :: "tprog"
- where
- "t_wcode_adjust = [(W1, 1), (R, 2), (Nop, 2), (R, 3), (R, 3), (R, 4),
- (L, 8), (L, 5), (L, 6), (W0, 5), (L, 6), (R, 7),
- (W1, 2), (Nop, 7), (L, 9), (W0, 8), (L, 9), (L, 10),
- (L, 11), (L, 10), (R, 0), (L, 11)]"
-
-lemma [simp]: "fetch t_wcode_adjust (Suc 0) Bk = (W1, 1)"
-apply(simp add: fetch.simps t_wcode_adjust_def nth_of.simps)
-done
-
-lemma [simp]: "fetch t_wcode_adjust (Suc 0) Oc = (R, 2)"
-apply(simp add: fetch.simps t_wcode_adjust_def nth_of.simps)
-done
-
-lemma [simp]: "fetch t_wcode_adjust (Suc (Suc 0)) Oc = (R, 3)"
-apply(simp add: fetch.simps t_wcode_adjust_def nth_of.simps)
-done
-
-lemma [simp]: "fetch t_wcode_adjust (Suc (Suc (Suc 0))) Oc = (R, 4)"
-apply(simp add: fetch.simps t_wcode_adjust_def nth_of.simps)
-done
-
-lemma [simp]: "fetch t_wcode_adjust (Suc (Suc (Suc 0))) Bk = (R, 3)"
-apply(simp add: fetch.simps t_wcode_adjust_def nth_of.simps)
-done
-
-lemma [simp]: "fetch t_wcode_adjust 4 Bk = (L, 8)"
-apply(simp add: fetch.simps t_wcode_adjust_def nth_of.simps)
-done
-
-lemma [simp]: "fetch t_wcode_adjust 4 Oc = (L, 5)"
-apply(simp add: fetch.simps t_wcode_adjust_def nth_of.simps)
-done
-
-lemma [simp]: "fetch t_wcode_adjust 5 Oc = (W0, 5)"
-apply(simp add: fetch.simps t_wcode_adjust_def nth_of.simps)
-done
-
-lemma [simp]: "fetch t_wcode_adjust 5 Bk = (L, 6)"
-apply(simp add: fetch.simps t_wcode_adjust_def nth_of.simps)
-done
-
-lemma [simp]: "fetch t_wcode_adjust 6 Oc = (R, 7)"
-apply(simp add: fetch.simps t_wcode_adjust_def nth_of.simps)
-done
-
-lemma [simp]: "fetch t_wcode_adjust 6 Bk = (L, 6)"
-apply(simp add: fetch.simps t_wcode_adjust_def nth_of.simps)
-done
-
-lemma [simp]: "fetch t_wcode_adjust 7 Bk = (W1, 2)"
-apply(simp add: fetch.simps t_wcode_adjust_def nth_of.simps)
-done
-
-lemma [simp]: "fetch t_wcode_adjust 8 Bk = (L, 9)"
-apply(simp add: fetch.simps t_wcode_adjust_def nth_of.simps)
-done
-
-lemma [simp]: "fetch t_wcode_adjust 8 Oc = (W0, 8)"
-apply(simp add: fetch.simps t_wcode_adjust_def nth_of.simps)
-done
-
-lemma [simp]: "fetch t_wcode_adjust 9 Oc = (L, 10)"
-apply(simp add: fetch.simps t_wcode_adjust_def nth_of.simps)
-done
-
-lemma [simp]: "fetch t_wcode_adjust 9 Bk = (L, 9)"
-apply(simp add: fetch.simps t_wcode_adjust_def nth_of.simps)
-done
-
-lemma [simp]: "fetch t_wcode_adjust 10 Bk = (L, 11)"
-apply(simp add: fetch.simps t_wcode_adjust_def nth_of.simps)
-done
-
-lemma [simp]: "fetch t_wcode_adjust 10 Oc = (L, 10)"
-apply(simp add: fetch.simps t_wcode_adjust_def nth_of.simps)
-done
-
-lemma [simp]: "fetch t_wcode_adjust 11 Oc = (L, 11)"
-apply(simp add: fetch.simps t_wcode_adjust_def nth_of.simps)
-done
-
-lemma [simp]: "fetch t_wcode_adjust 11 Bk = (R, 0)"
-apply(simp add: fetch.simps t_wcode_adjust_def nth_of.simps)
-done
-
-fun wadjust_start :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
- where
- "wadjust_start m rs (l, r) =
- (\<exists> ln rn. l = Bk # Oc\<^bsup>Suc m\<^esup> \<and>
- tl r = Oc # Bk\<^bsup>ln\<^esup> @ Bk # Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>rn\<^esup>)"
-
-fun wadjust_loop_start :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
- where
- "wadjust_loop_start m rs (l, r) =
- (\<exists> ln rn ml mr. l = Oc\<^bsup>ml\<^esup> @ Bk # Oc\<^bsup>Suc m\<^esup> \<and>
- r = Oc # Bk\<^bsup>ln\<^esup> @ Bk # Oc\<^bsup>mr\<^esup> @ Bk\<^bsup>rn\<^esup> \<and>
- ml + mr = Suc (Suc rs) \<and> mr > 0)"
-
-fun wadjust_loop_right_move :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
- where
- "wadjust_loop_right_move m rs (l, r) =
- (\<exists> ml mr nl nr rn. l = Bk\<^bsup>nl\<^esup> @ Oc # Oc\<^bsup>ml\<^esup> @ Bk # Oc\<^bsup>Suc m\<^esup> \<and>
- r = Bk\<^bsup>nr\<^esup> @ Oc\<^bsup>mr\<^esup> @ Bk\<^bsup>rn\<^esup> \<and>
- ml + mr = Suc (Suc rs) \<and> mr > 0 \<and>
- nl + nr > 0)"
-
-fun wadjust_loop_check :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
- where
- "wadjust_loop_check m rs (l, r) =
- (\<exists> ml mr ln rn. l = Oc # Bk\<^bsup>ln\<^esup> @ Bk # Oc # Oc\<^bsup>ml\<^esup> @ Bk # Oc\<^bsup>Suc m\<^esup> \<and>
- r = Oc\<^bsup>mr\<^esup> @ Bk\<^bsup>rn\<^esup> \<and> ml + mr = (Suc rs))"
-
-fun wadjust_loop_erase :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
- where
- "wadjust_loop_erase m rs (l, r) =
- (\<exists> ml mr ln rn. l = Bk\<^bsup>ln\<^esup> @ Bk # Oc # Oc\<^bsup>ml\<^esup> @ Bk # Oc\<^bsup>Suc m\<^esup> \<and>
- tl r = Oc\<^bsup>mr\<^esup> @ Bk\<^bsup>rn\<^esup> \<and> ml + mr = (Suc rs) \<and> mr > 0)"
-
-fun wadjust_loop_on_left_moving_O :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
- where
- "wadjust_loop_on_left_moving_O m rs (l, r) =
- (\<exists> ml mr ln rn. l = Oc\<^bsup>ml\<^esup> @ Bk # Oc\<^bsup>Suc m \<^esup>\<and>
- r = Oc # Bk\<^bsup>ln\<^esup> @ Bk # Bk # Oc\<^bsup>mr\<^esup> @ Bk\<^bsup>rn\<^esup> \<and>
- ml + mr = Suc rs \<and> mr > 0)"
-
-fun wadjust_loop_on_left_moving_B :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
- where
- "wadjust_loop_on_left_moving_B m rs (l, r) =
- (\<exists> ml mr nl nr rn. l = Bk\<^bsup>nl\<^esup> @ Oc # Oc\<^bsup>ml\<^esup> @ Bk # Oc\<^bsup>Suc m\<^esup> \<and>
- r = Bk\<^bsup>nr\<^esup> @ Bk # Bk # Oc\<^bsup>mr\<^esup> @ Bk\<^bsup>rn\<^esup> \<and>
- ml + mr = Suc rs \<and> mr > 0)"
-
-fun wadjust_loop_on_left_moving :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
- where
- "wadjust_loop_on_left_moving m rs (l, r) =
- (wadjust_loop_on_left_moving_O m rs (l, r) \<or>
- wadjust_loop_on_left_moving_B m rs (l, r))"
-
-fun wadjust_loop_right_move2 :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
- where
- "wadjust_loop_right_move2 m rs (l, r) =
- (\<exists> ml mr ln rn. l = Oc # Oc\<^bsup>ml\<^esup> @ Bk # Oc\<^bsup>Suc m\<^esup> \<and>
- r = Bk\<^bsup>ln\<^esup> @ Bk # Bk # Oc\<^bsup>mr\<^esup> @ Bk\<^bsup>rn\<^esup> \<and>
- ml + mr = Suc rs \<and> mr > 0)"
-
-fun wadjust_erase2 :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
- where
- "wadjust_erase2 m rs (l, r) =
- (\<exists> ln rn. l = Bk\<^bsup>ln\<^esup> @ Bk # Oc # Oc\<^bsup>Suc rs\<^esup> @ Bk # Oc\<^bsup>Suc m\<^esup> \<and>
- tl r = Bk\<^bsup>rn\<^esup>)"
-
-fun wadjust_on_left_moving_O :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
- where
- "wadjust_on_left_moving_O m rs (l, r) =
- (\<exists> rn. l = Oc\<^bsup>Suc rs\<^esup> @ Bk # Oc\<^bsup>Suc m\<^esup> \<and>
- r = Oc # Bk\<^bsup>rn\<^esup>)"
-
-fun wadjust_on_left_moving_B :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
- where
- "wadjust_on_left_moving_B m rs (l, r) =
- (\<exists> ln rn. l = Bk\<^bsup>ln\<^esup> @ Oc # Oc\<^bsup>Suc rs\<^esup> @ Bk # Oc\<^bsup>Suc m\<^esup> \<and>
- r = Bk\<^bsup>rn\<^esup>)"
-
-fun wadjust_on_left_moving :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
- where
- "wadjust_on_left_moving m rs (l, r) =
- (wadjust_on_left_moving_O m rs (l, r) \<or>
- wadjust_on_left_moving_B m rs (l, r))"
-
-fun wadjust_goon_left_moving_B :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
- where
- "wadjust_goon_left_moving_B m rs (l, r) =
- (\<exists> rn. l = Oc\<^bsup>Suc m\<^esup> \<and>
- r = Bk # Oc\<^bsup>Suc (Suc rs)\<^esup> @ Bk\<^bsup>rn\<^esup>)"
-
-fun wadjust_goon_left_moving_O :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
- where
- "wadjust_goon_left_moving_O m rs (l, r) =
- (\<exists> ml mr rn. l = Oc\<^bsup>ml\<^esup> @ Bk # Oc\<^bsup>Suc m\<^esup> \<and>
- r = Oc\<^bsup>mr\<^esup> @ Bk\<^bsup>rn\<^esup> \<and>
- ml + mr = Suc (Suc rs) \<and> mr > 0)"
-
-fun wadjust_goon_left_moving :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
- where
- "wadjust_goon_left_moving m rs (l, r) =
- (wadjust_goon_left_moving_B m rs (l, r) \<or>
- wadjust_goon_left_moving_O m rs (l, r))"
-
-fun wadjust_backto_standard_pos_B :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
- where
- "wadjust_backto_standard_pos_B m rs (l, r) =
- (\<exists> rn. l = [] \<and>
- r = Bk # Oc\<^bsup>Suc m \<^esup>@ Bk # Oc\<^bsup>Suc (Suc rs)\<^esup> @ Bk\<^bsup>rn\<^esup>)"
-
-fun wadjust_backto_standard_pos_O :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
- where
- "wadjust_backto_standard_pos_O m rs (l, r) =
- (\<exists> ml mr rn. l = Oc\<^bsup>ml\<^esup> \<and>
- r = Oc\<^bsup>mr\<^esup> @ Bk # Oc\<^bsup>Suc (Suc rs)\<^esup> @ Bk\<^bsup>rn\<^esup> \<and>
- ml + mr = Suc m \<and> mr > 0)"
-
-fun wadjust_backto_standard_pos :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
- where
- "wadjust_backto_standard_pos m rs (l, r) =
- (wadjust_backto_standard_pos_B m rs (l, r) \<or>
- wadjust_backto_standard_pos_O m rs (l, r))"
-
-fun wadjust_stop :: "nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
-where
- "wadjust_stop m rs (l, r) =
- (\<exists> rn. l = [Bk] \<and>
- r = Oc\<^bsup>Suc m \<^esup>@ Bk # Oc\<^bsup>Suc (Suc rs)\<^esup> @ Bk\<^bsup>rn\<^esup>)"
-
-declare wadjust_start.simps[simp del] wadjust_loop_start.simps[simp del]
- wadjust_loop_right_move.simps[simp del] wadjust_loop_check.simps[simp del]
- wadjust_loop_erase.simps[simp del] wadjust_loop_on_left_moving.simps[simp del]
- wadjust_loop_right_move2.simps[simp del] wadjust_erase2.simps[simp del]
- wadjust_on_left_moving_O.simps[simp del] wadjust_on_left_moving_B.simps[simp del]
- wadjust_on_left_moving.simps[simp del] wadjust_goon_left_moving_B.simps[simp del]
- wadjust_goon_left_moving_O.simps[simp del] wadjust_goon_left_moving.simps[simp del]
- wadjust_backto_standard_pos.simps[simp del] wadjust_backto_standard_pos_B.simps[simp del]
- wadjust_backto_standard_pos_O.simps[simp del] wadjust_stop.simps[simp del]
-
-fun wadjust_inv :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> tape \<Rightarrow> bool"
- where
- "wadjust_inv st m rs (l, r) =
- (if st = Suc 0 then wadjust_start m rs (l, r)
- else if st = Suc (Suc 0) then wadjust_loop_start m rs (l, r)
- else if st = Suc (Suc (Suc 0)) then wadjust_loop_right_move m rs (l, r)
- else if st = 4 then wadjust_loop_check m rs (l, r)
- else if st = 5 then wadjust_loop_erase m rs (l, r)
- else if st = 6 then wadjust_loop_on_left_moving m rs (l, r)
- else if st = 7 then wadjust_loop_right_move2 m rs (l, r)
- else if st = 8 then wadjust_erase2 m rs (l, r)
- else if st = 9 then wadjust_on_left_moving m rs (l, r)
- else if st = 10 then wadjust_goon_left_moving m rs (l, r)
- else if st = 11 then wadjust_backto_standard_pos m rs (l, r)
- else if st = 0 then wadjust_stop m rs (l, r)
- else False
-)"
-
-declare wadjust_inv.simps[simp del]
-
-fun wadjust_phase :: "nat \<Rightarrow> t_conf \<Rightarrow> nat"
- where
- "wadjust_phase rs (st, l, r) =
- (if st = 1 then 3
- else if st \<ge> 2 \<and> st \<le> 7 then 2
- else if st \<ge> 8 \<and> st \<le> 11 then 1
- else 0)"
-
-thm dropWhile.simps
-
-fun wadjust_stage :: "nat \<Rightarrow> t_conf \<Rightarrow> nat"
- where
- "wadjust_stage rs (st, l, r) =
- (if st \<ge> 2 \<and> st \<le> 7 then
- rs - length (takeWhile (\<lambda> a. a = Oc)
- (tl (dropWhile (\<lambda> a. a = Oc) (rev l @ r))))
- else 0)"
-
-fun wadjust_state :: "nat \<Rightarrow> t_conf \<Rightarrow> nat"
- where
- "wadjust_state rs (st, l, r) =
- (if st \<ge> 2 \<and> st \<le> 7 then 8 - st
- else if st \<ge> 8 \<and> st \<le> 11 then 12 - st
- else 0)"
-
-fun wadjust_step :: "nat \<Rightarrow> t_conf \<Rightarrow> nat"
- where
- "wadjust_step rs (st, l, r) =
- (if st = 1 then (if hd r = Bk then 1
- else 0)
- else if st = 3 then length r
- else if st = 5 then (if hd r = Oc then 1
- else 0)
- else if st = 6 then length l
- else if st = 8 then (if hd r = Oc then 1
- else 0)
- else if st = 9 then length l
- else if st = 10 then length l
- else if st = 11 then (if hd r = Bk then 0
- else Suc (length l))
- else 0)"
-
-fun wadjust_measure :: "(nat \<times> t_conf) \<Rightarrow> nat \<times> nat \<times> nat \<times> nat"
- where
- "wadjust_measure (rs, (st, l, r)) =
- (wadjust_phase rs (st, l, r),
- wadjust_stage rs (st, l, r),
- wadjust_state rs (st, l, r),
- wadjust_step rs (st, l, r))"
-
-definition wadjust_le :: "((nat \<times> t_conf) \<times> nat \<times> t_conf) set"
- where "wadjust_le \<equiv> (inv_image lex_square wadjust_measure)"
-
-lemma [intro]: "wf lex_square"
-by(auto intro:wf_lex_prod simp: abacus.lex_pair_def lex_square_def
- abacus.lex_triple_def)
-
-lemma wf_wadjust_le[intro]: "wf wadjust_le"
-by(auto intro:wf_inv_image simp: wadjust_le_def
- abacus.lex_triple_def abacus.lex_pair_def)
-
-lemma [simp]: "wadjust_start m rs (c, []) = False"
-apply(auto simp: wadjust_start.simps)
-done
-
-lemma [simp]: "wadjust_loop_right_move m rs (c, []) \<Longrightarrow> c \<noteq> []"
-apply(auto simp: wadjust_loop_right_move.simps)
-done
-
-lemma [simp]: "wadjust_loop_right_move m rs (c, [])
- \<Longrightarrow> wadjust_loop_check m rs (Bk # c, [])"
-apply(simp only: wadjust_loop_right_move.simps wadjust_loop_check.simps)
-apply(auto)
-apply(case_tac [!] mr, simp_all add: exp_ind_def)
-done
-
-lemma [simp]: "wadjust_loop_check m rs (c, []) \<Longrightarrow> c \<noteq> []"
-apply(simp only: wadjust_loop_check.simps, auto)
-done
-
-lemma [simp]: "wadjust_loop_start m rs (c, []) = False"
-apply(simp add: wadjust_loop_start.simps)
-done
-
-lemma [simp]: "wadjust_loop_right_move m rs (c, []) \<Longrightarrow>
- wadjust_loop_right_move m rs (Bk # c, [])"
-apply(simp only: wadjust_loop_right_move.simps)
-apply(erule_tac exE)+
-apply(auto)
-apply(case_tac [!] mr, simp_all add: exp_ind_def)
-done
-
-lemma [simp]: "wadjust_loop_check m rs (c, []) \<Longrightarrow> wadjust_erase2 m rs (tl c, [hd c])"
-apply(simp only: wadjust_loop_check.simps wadjust_erase2.simps, auto)
-apply(case_tac mr, simp_all add: exp_ind_def, auto)
-done
-
-lemma [simp]: " wadjust_loop_erase m rs (c, [])
- \<Longrightarrow> (c = [] \<longrightarrow> wadjust_loop_on_left_moving m rs ([], [Bk])) \<and>
- (c \<noteq> [] \<longrightarrow> wadjust_loop_on_left_moving m rs (tl c, [hd c]))"
-apply(simp add: wadjust_loop_erase.simps, auto)
-apply(case_tac [!] mr, simp_all add: exp_ind_def)
-done
-
-lemma [simp]: "wadjust_loop_on_left_moving m rs (c, []) = False"
-apply(auto simp: wadjust_loop_on_left_moving.simps)
-done
-
-
-lemma [simp]: "wadjust_loop_right_move2 m rs (c, []) = False"
-apply(auto simp: wadjust_loop_right_move2.simps)
-done
-
-lemma [simp]: "wadjust_erase2 m rs ([], []) = False"
-apply(auto simp: wadjust_erase2.simps)
-done
-
-lemma [simp]: "wadjust_on_left_moving_B m rs
- (Oc # Oc # Oc\<^bsup>rs\<^esup> @ Bk # Oc # Oc\<^bsup>m\<^esup>, [Bk])"
-apply(simp add: wadjust_on_left_moving_B.simps, auto)
-apply(rule_tac x = 0 in exI, simp add: exp_ind_def)
-done
-
-lemma [simp]: "wadjust_on_left_moving_B m rs
- (Bk\<^bsup>n\<^esup> @ Bk # Oc # Oc # Oc\<^bsup>rs\<^esup> @ Bk # Oc # Oc\<^bsup>m\<^esup>, [Bk])"
-apply(simp add: wadjust_on_left_moving_B.simps exp_ind_def, auto)
-apply(rule_tac x = "Suc n" in exI, simp add: exp_ind)
-done
-
-lemma [simp]: "\<lbrakk>wadjust_erase2 m rs (c, []); c \<noteq> []\<rbrakk> \<Longrightarrow>
- wadjust_on_left_moving m rs (tl c, [hd c])"
-apply(simp only: wadjust_erase2.simps)
-apply(erule_tac exE)+
-apply(case_tac ln, simp_all add: exp_ind_def wadjust_on_left_moving.simps)
-done
-
-lemma [simp]: "wadjust_erase2 m rs (c, [])
- \<Longrightarrow> (c = [] \<longrightarrow> wadjust_on_left_moving m rs ([], [Bk])) \<and>
- (c \<noteq> [] \<longrightarrow> wadjust_on_left_moving m rs (tl c, [hd c]))"
-apply(auto)
-done
-
-lemma [simp]: "wadjust_on_left_moving m rs ([], []) = False"
-apply(simp add: wadjust_on_left_moving.simps
- wadjust_on_left_moving_O.simps wadjust_on_left_moving_B.simps)
-done
-
-lemma [simp]: "wadjust_on_left_moving_O m rs (c, []) = False"
-apply(simp add: wadjust_on_left_moving_O.simps)
-done
-
-lemma [simp]: " \<lbrakk>wadjust_on_left_moving_B m rs (c, []); c \<noteq> []; hd c = Bk\<rbrakk> \<Longrightarrow>
- wadjust_on_left_moving_B m rs (tl c, [Bk])"
-apply(simp add: wadjust_on_left_moving_B.simps, auto)
-apply(case_tac [!] ln, simp_all add: exp_ind_def, auto)
-done
-
-lemma [simp]: "\<lbrakk>wadjust_on_left_moving_B m rs (c, []); c \<noteq> []; hd c = Oc\<rbrakk> \<Longrightarrow>
- wadjust_on_left_moving_O m rs (tl c, [Oc])"
-apply(simp add: wadjust_on_left_moving_B.simps wadjust_on_left_moving_O.simps, auto)
-apply(case_tac [!] ln, simp_all add: exp_ind_def)
-done
-
-lemma [simp]: "\<lbrakk>wadjust_on_left_moving m rs (c, []); c \<noteq> []\<rbrakk> \<Longrightarrow>
- wadjust_on_left_moving m rs (tl c, [hd c])"
-apply(simp add: wadjust_on_left_moving.simps)
-apply(case_tac "hd c", simp_all)
-done
-
-lemma [simp]: "wadjust_on_left_moving m rs (c, [])
- \<Longrightarrow> (c = [] \<longrightarrow> wadjust_on_left_moving m rs ([], [Bk])) \<and>
- (c \<noteq> [] \<longrightarrow> wadjust_on_left_moving m rs (tl c, [hd c]))"
-apply(auto)
-done
-
-lemma [simp]: "wadjust_goon_left_moving m rs (c, []) = False"
-apply(auto simp: wadjust_goon_left_moving.simps wadjust_goon_left_moving_B.simps
- wadjust_goon_left_moving_O.simps)
-done
-
-lemma [simp]: "wadjust_backto_standard_pos m rs (c, []) = False"
-apply(auto simp: wadjust_backto_standard_pos.simps
- wadjust_backto_standard_pos_B.simps wadjust_backto_standard_pos_O.simps)
-done
-
-lemma [simp]:
- "wadjust_start m rs (c, Bk # list) \<Longrightarrow>
- (c = [] \<longrightarrow> wadjust_start m rs ([], Oc # list)) \<and>
- (c \<noteq> [] \<longrightarrow> wadjust_start m rs (c, Oc # list))"
-apply(auto simp: wadjust_start.simps)
-done
-
-lemma [simp]: "wadjust_loop_start m rs (c, Bk # list) = False"
-apply(auto simp: wadjust_loop_start.simps)
-done
-
-lemma [simp]: "wadjust_loop_right_move m rs (c, b) \<Longrightarrow> c \<noteq> []"
-apply(simp only: wadjust_loop_right_move.simps, auto)
-done
-
-lemma [simp]: "wadjust_loop_right_move m rs (c, Bk # list)
- \<Longrightarrow> wadjust_loop_right_move m rs (Bk # c, list)"
-apply(simp only: wadjust_loop_right_move.simps)
-apply(erule_tac exE)+
-apply(rule_tac x = ml in exI, simp)
-apply(rule_tac x = mr in exI, simp)
-apply(rule_tac x = "Suc nl" in exI, simp add: exp_ind_def)
-apply(case_tac nr, simp, case_tac mr, simp_all add: exp_ind_def)
-apply(rule_tac x = nat in exI, auto)
-done
-
-lemma [simp]: "wadjust_loop_check m rs (c, b) \<Longrightarrow> c \<noteq> []"
-apply(simp only: wadjust_loop_check.simps, auto)
-done
-
-lemma [simp]: "wadjust_loop_check m rs (c, Bk # list)
- \<Longrightarrow> wadjust_erase2 m rs (tl c, hd c # Bk # list)"
-apply(auto simp: wadjust_loop_check.simps wadjust_erase2.simps)
-apply(case_tac [!] mr, simp_all add: exp_ind_def, auto)
-done
-
-lemma [simp]: "wadjust_loop_erase m rs (c, b) \<Longrightarrow> c \<noteq> []"
-apply(simp only: wadjust_loop_erase.simps, auto)
-done
-
-declare wadjust_loop_on_left_moving_O.simps[simp del]
- wadjust_loop_on_left_moving_B.simps[simp del]
-
-lemma [simp]: "\<lbrakk>wadjust_loop_erase m rs (c, Bk # list); hd c = Bk\<rbrakk>
- \<Longrightarrow> wadjust_loop_on_left_moving_B m rs (tl c, Bk # Bk # list)"
-apply(simp only: wadjust_loop_erase.simps
- wadjust_loop_on_left_moving_B.simps)
-apply(erule_tac exE)+
-apply(rule_tac x = ml in exI, rule_tac x = mr in exI,
- rule_tac x = ln in exI, rule_tac x = 0 in exI, simp)
-apply(case_tac ln, simp_all add: exp_ind_def, auto)
-apply(simp add: exp_ind exp_ind_def[THEN sym])
-done
-
-lemma [simp]: "\<lbrakk>wadjust_loop_erase m rs (c, Bk # list); c \<noteq> []; hd c = Oc\<rbrakk> \<Longrightarrow>
- wadjust_loop_on_left_moving_O m rs (tl c, Oc # Bk # list)"
-apply(simp only: wadjust_loop_erase.simps wadjust_loop_on_left_moving_O.simps,
- auto)
-apply(case_tac [!] ln, simp_all add: exp_ind_def)
-done
-
-lemma [simp]: "\<lbrakk>wadjust_loop_erase m rs (c, Bk # list); c \<noteq> []\<rbrakk> \<Longrightarrow>
- wadjust_loop_on_left_moving m rs (tl c, hd c # Bk # list)"
-apply(case_tac "hd c", simp_all add:wadjust_loop_on_left_moving.simps)
-done
-
-lemma [simp]: "wadjust_loop_on_left_moving m rs (c, b) \<Longrightarrow> c \<noteq> []"
-apply(simp add: wadjust_loop_on_left_moving.simps
-wadjust_loop_on_left_moving_O.simps wadjust_loop_on_left_moving_B.simps, auto)
-done
-
-lemma [simp]: "wadjust_loop_on_left_moving_O m rs (c, Bk # list) = False"
-apply(simp add: wadjust_loop_on_left_moving_O.simps)
-done
-
-lemma [simp]: "\<lbrakk>wadjust_loop_on_left_moving_B m rs (c, Bk # list); hd c = Bk\<rbrakk>
- \<Longrightarrow> wadjust_loop_on_left_moving_B m rs (tl c, Bk # Bk # list)"
-apply(simp only: wadjust_loop_on_left_moving_B.simps)
-apply(erule_tac exE)+
-apply(rule_tac x = ml in exI, rule_tac x = mr in exI)
-apply(case_tac nl, simp_all add: exp_ind_def, auto)
-apply(rule_tac x = "Suc nr" in exI, auto simp: exp_ind_def)
-done
-
-lemma [simp]: "\<lbrakk>wadjust_loop_on_left_moving_B m rs (c, Bk # list); hd c = Oc\<rbrakk>
- \<Longrightarrow> wadjust_loop_on_left_moving_O m rs (tl c, Oc # Bk # list)"
-apply(simp only: wadjust_loop_on_left_moving_O.simps
- wadjust_loop_on_left_moving_B.simps)
-apply(erule_tac exE)+
-apply(rule_tac x = ml in exI, rule_tac x = mr in exI)
-apply(case_tac nl, simp_all add: exp_ind_def, auto)
-done
-
-lemma [simp]: "wadjust_loop_on_left_moving m rs (c, Bk # list)
- \<Longrightarrow> wadjust_loop_on_left_moving m rs (tl c, hd c # Bk # list)"
-apply(simp add: wadjust_loop_on_left_moving.simps)
-apply(case_tac "hd c", simp_all)
-done
-
-lemma [simp]: "wadjust_loop_right_move2 m rs (c, b) \<Longrightarrow> c \<noteq> []"
-apply(simp only: wadjust_loop_right_move2.simps, auto)
-done
-
-lemma [simp]: "wadjust_loop_right_move2 m rs (c, Bk # list) \<Longrightarrow> wadjust_loop_start m rs (c, Oc # list)"
-apply(auto simp: wadjust_loop_right_move2.simps wadjust_loop_start.simps)
-apply(case_tac ln, simp_all add: exp_ind_def)
-apply(rule_tac x = 0 in exI, simp)
-apply(rule_tac x = rn in exI, simp)
-apply(rule_tac x = "Suc ml" in exI, simp add: exp_ind_def, auto)
-apply(rule_tac x = "Suc nat" in exI, simp add: exp_ind)
-apply(rule_tac x = rn in exI, auto)
-apply(rule_tac x = "Suc ml" in exI, auto simp: exp_ind_def)
-done
-
-lemma [simp]: "wadjust_erase2 m rs (c, Bk # list) \<Longrightarrow> c \<noteq> []"
-apply(auto simp:wadjust_erase2.simps )
-done
-
-lemma [simp]: "wadjust_erase2 m rs (c, Bk # list) \<Longrightarrow>
- wadjust_on_left_moving m rs (tl c, hd c # Bk # list)"
-apply(auto simp: wadjust_erase2.simps)
-apply(case_tac ln, simp_all add: exp_ind_def wadjust_on_left_moving.simps
- wadjust_on_left_moving_O.simps wadjust_on_left_moving_B.simps)
-apply(auto)
-apply(rule_tac x = "(Suc (Suc rn))" in exI, simp add: exp_ind_def)
-apply(rule_tac x = "Suc nat" in exI, simp add: exp_ind)
-apply(rule_tac x = "(Suc (Suc rn))" in exI, simp add: exp_ind_def)
-done
-
-lemma [simp]: "wadjust_on_left_moving m rs (c,b) \<Longrightarrow> c \<noteq> []"
-apply(simp only:wadjust_on_left_moving.simps
- wadjust_on_left_moving_O.simps
- wadjust_on_left_moving_B.simps
- , auto)
-done
-
-lemma [simp]: "wadjust_on_left_moving_O m rs (c, Bk # list) = False"
-apply(simp add: wadjust_on_left_moving_O.simps)
-done
-
-lemma [simp]: "\<lbrakk>wadjust_on_left_moving_B m rs (c, Bk # list); hd c = Bk\<rbrakk>
- \<Longrightarrow> wadjust_on_left_moving_B m rs (tl c, Bk # Bk # list)"
-apply(auto simp: wadjust_on_left_moving_B.simps)
-apply(case_tac ln, simp_all add: exp_ind_def, auto)
-done
-
-lemma [simp]: "\<lbrakk>wadjust_on_left_moving_B m rs (c, Bk # list); hd c = Oc\<rbrakk>
- \<Longrightarrow> wadjust_on_left_moving_O m rs (tl c, Oc # Bk # list)"
-apply(auto simp: wadjust_on_left_moving_O.simps
- wadjust_on_left_moving_B.simps)
-apply(case_tac ln, simp_all add: exp_ind_def)
-done
-
-lemma [simp]: "wadjust_on_left_moving m rs (c, Bk # list) \<Longrightarrow>
- wadjust_on_left_moving m rs (tl c, hd c # Bk # list)"
-apply(simp add: wadjust_on_left_moving.simps)
-apply(case_tac "hd c", simp_all)
-done
-
-lemma [simp]: "wadjust_goon_left_moving m rs (c, b) \<Longrightarrow> c \<noteq> []"
-apply(simp add: wadjust_goon_left_moving.simps
- wadjust_goon_left_moving_B.simps
- wadjust_goon_left_moving_O.simps exp_ind_def, auto)
-done
-
-lemma [simp]: "wadjust_goon_left_moving_O m rs (c, Bk # list) = False"
-apply(simp add: wadjust_goon_left_moving_O.simps, auto)
-apply(case_tac mr, simp_all add: exp_ind_def)
-done
-
-lemma [simp]: "\<lbrakk>wadjust_goon_left_moving_B m rs (c, Bk # list); hd c = Bk\<rbrakk>
- \<Longrightarrow> wadjust_backto_standard_pos_B m rs (tl c, Bk # Bk # list)"
-apply(auto simp: wadjust_goon_left_moving_B.simps
- wadjust_backto_standard_pos_B.simps exp_ind_def)
-done
-
-lemma [simp]: "\<lbrakk>wadjust_goon_left_moving_B m rs (c, Bk # list); hd c = Oc\<rbrakk>
- \<Longrightarrow> wadjust_backto_standard_pos_O m rs (tl c, Oc # Bk # list)"
-apply(auto simp: wadjust_goon_left_moving_B.simps
- wadjust_backto_standard_pos_O.simps exp_ind_def)
-apply(rule_tac x = m in exI, simp, auto)
-done
-
-lemma [simp]: "wadjust_goon_left_moving m rs (c, Bk # list) \<Longrightarrow>
- wadjust_backto_standard_pos m rs (tl c, hd c # Bk # list)"
-apply(case_tac "hd c", simp_all add: wadjust_backto_standard_pos.simps
- wadjust_goon_left_moving.simps)
-done
-
-lemma [simp]: "wadjust_backto_standard_pos m rs (c, Bk # list) \<Longrightarrow>
- (c = [] \<longrightarrow> wadjust_stop m rs ([Bk], list)) \<and> (c \<noteq> [] \<longrightarrow> wadjust_stop m rs (Bk # c, list))"
-apply(auto simp: wadjust_backto_standard_pos.simps
- wadjust_backto_standard_pos_B.simps
- wadjust_backto_standard_pos_O.simps wadjust_stop.simps)
-apply(case_tac [!] mr, simp_all add: exp_ind_def)
-done
-
-lemma [simp]: "wadjust_start m rs (c, Oc # list)
- \<Longrightarrow> (c = [] \<longrightarrow> wadjust_loop_start m rs ([Oc], list)) \<and>
- (c \<noteq> [] \<longrightarrow> wadjust_loop_start m rs (Oc # c, list))"
-apply(auto simp:wadjust_loop_start.simps wadjust_start.simps )
-apply(rule_tac x = ln in exI, rule_tac x = rn in exI,
- rule_tac x = "Suc 0" in exI, simp)
-done
-
-lemma [simp]: "wadjust_loop_start m rs (c, b) \<Longrightarrow> c \<noteq> []"
-apply(simp add: wadjust_loop_start.simps, auto)
-done
-
-lemma [simp]: "wadjust_loop_start m rs (c, Oc # list)
- \<Longrightarrow> wadjust_loop_right_move m rs (Oc # c, list)"
-apply(simp add: wadjust_loop_start.simps wadjust_loop_right_move.simps, auto)
-apply(rule_tac x = ml in exI, rule_tac x = mr in exI,
- rule_tac x = 0 in exI, simp)
-apply(rule_tac x = "Suc ln" in exI, simp add: exp_ind, auto)
-done
-
-lemma [simp]: "wadjust_loop_right_move m rs (c, Oc # list) \<Longrightarrow>
- wadjust_loop_check m rs (Oc # c, list)"
-apply(simp add: wadjust_loop_right_move.simps
- wadjust_loop_check.simps, auto)
-apply(rule_tac [!] x = ml in exI, simp_all, auto)
-apply(case_tac nl, auto simp: exp_ind_def)
-apply(rule_tac x = "mr - 1" in exI, case_tac mr, simp_all add: exp_ind_def)
-apply(case_tac [!] nr, simp_all add: exp_ind_def, auto)
-done
-
-lemma [simp]: "wadjust_loop_check m rs (c, Oc # list) \<Longrightarrow>
- wadjust_loop_erase m rs (tl c, hd c # Oc # list)"
-apply(simp only: wadjust_loop_check.simps wadjust_loop_erase.simps)
-apply(erule_tac exE)+
-apply(rule_tac x = ml in exI, rule_tac x = mr in exI, auto)
-apply(case_tac mr, simp_all add: exp_ind_def)
-apply(case_tac rn, simp_all add: exp_ind_def)
-done
-
-lemma [simp]: "wadjust_loop_erase m rs (c, Oc # list) \<Longrightarrow>
- wadjust_loop_erase m rs (c, Bk # list)"
-apply(auto simp: wadjust_loop_erase.simps)
-done
-
-lemma [simp]: "wadjust_loop_on_left_moving_B m rs (c, Oc # list) = False"
-apply(auto simp: wadjust_loop_on_left_moving_B.simps)
-apply(case_tac nr, simp_all add: exp_ind_def)
-done
-
-lemma [simp]: "wadjust_loop_on_left_moving m rs (c, Oc # list)
- \<Longrightarrow> wadjust_loop_right_move2 m rs (Oc # c, list)"
-apply(simp add:wadjust_loop_on_left_moving.simps)
-apply(auto simp: wadjust_loop_on_left_moving_O.simps
- wadjust_loop_right_move2.simps)
-done
-
-lemma [simp]: "wadjust_loop_right_move2 m rs (c, Oc # list) = False"
-apply(auto simp: wadjust_loop_right_move2.simps )
-apply(case_tac ln, simp_all add: exp_ind_def)
-done
-
-lemma [simp]: "wadjust_erase2 m rs (c, Oc # list)
- \<Longrightarrow> (c = [] \<longrightarrow> wadjust_erase2 m rs ([], Bk # list))
- \<and> (c \<noteq> [] \<longrightarrow> wadjust_erase2 m rs (c, Bk # list))"
-apply(auto simp: wadjust_erase2.simps )
-done
-
-lemma [simp]: "wadjust_on_left_moving_B m rs (c, Oc # list) = False"
-apply(auto simp: wadjust_on_left_moving_B.simps)
-done
-
-lemma [simp]: "\<lbrakk>wadjust_on_left_moving_O m rs (c, Oc # list); hd c = Bk\<rbrakk> \<Longrightarrow>
- wadjust_goon_left_moving_B m rs (tl c, Bk # Oc # list)"
-apply(auto simp: wadjust_on_left_moving_O.simps
- wadjust_goon_left_moving_B.simps exp_ind_def)
-done
-
-lemma [simp]: "\<lbrakk>wadjust_on_left_moving_O m rs (c, Oc # list); hd c = Oc\<rbrakk>
- \<Longrightarrow> wadjust_goon_left_moving_O m rs (tl c, Oc # Oc # list)"
-apply(auto simp: wadjust_on_left_moving_O.simps
- wadjust_goon_left_moving_O.simps exp_ind_def)
-apply(rule_tac x = rs in exI, simp)
-apply(auto simp: exp_ind_def numeral_2_eq_2)
-done
-
-
-lemma [simp]: "wadjust_on_left_moving m rs (c, Oc # list) \<Longrightarrow>
- wadjust_goon_left_moving m rs (tl c, hd c # Oc # list)"
-apply(simp add: wadjust_on_left_moving.simps
- wadjust_goon_left_moving.simps)
-apply(case_tac "hd c", simp_all)
-done
-
-lemma [simp]: "wadjust_on_left_moving m rs (c, Oc # list) \<Longrightarrow>
- wadjust_goon_left_moving m rs (tl c, hd c # Oc # list)"
-apply(simp add: wadjust_on_left_moving.simps
- wadjust_goon_left_moving.simps)
-apply(case_tac "hd c", simp_all)
-done
-
-lemma [simp]: "wadjust_goon_left_moving_B m rs (c, Oc # list) = False"
-apply(auto simp: wadjust_goon_left_moving_B.simps)
-done
-
-lemma [simp]: "\<lbrakk>wadjust_goon_left_moving_O m rs (c, Oc # list); hd c = Bk\<rbrakk>
- \<Longrightarrow> wadjust_goon_left_moving_B m rs (tl c, Bk # Oc # list)"
-apply(auto simp: wadjust_goon_left_moving_O.simps wadjust_goon_left_moving_B.simps)
-apply(case_tac [!] ml, auto simp: exp_ind_def)
-done
-
-lemma [simp]: "\<lbrakk>wadjust_goon_left_moving_O m rs (c, Oc # list); hd c = Oc\<rbrakk> \<Longrightarrow>
- wadjust_goon_left_moving_O m rs (tl c, Oc # Oc # list)"
-apply(auto simp: wadjust_goon_left_moving_O.simps wadjust_goon_left_moving_B.simps)
-apply(rule_tac x = "ml - 1" in exI, simp)
-apply(case_tac ml, simp_all add: exp_ind_def)
-apply(rule_tac x = "Suc mr" in exI, auto simp: exp_ind_def)
-done
-
-lemma [simp]: "wadjust_goon_left_moving m rs (c, Oc # list) \<Longrightarrow>
- wadjust_goon_left_moving m rs (tl c, hd c # Oc # list)"
-apply(simp add: wadjust_goon_left_moving.simps)
-apply(case_tac "hd c", simp_all)
-done
-
-lemma [simp]: "wadjust_backto_standard_pos_B m rs (c, Oc # list) = False"
-apply(simp add: wadjust_backto_standard_pos_B.simps)
-done
-
-lemma [simp]: "wadjust_backto_standard_pos_O m rs (c, Bk # xs) = False"
-apply(simp add: wadjust_backto_standard_pos_O.simps, auto)
-apply(case_tac mr, simp_all add: exp_ind_def)
-done
-
-
-
-lemma [simp]: "wadjust_backto_standard_pos_O m rs ([], Oc # list) \<Longrightarrow>
- wadjust_backto_standard_pos_B m rs ([], Bk # Oc # list)"
-apply(auto simp: wadjust_backto_standard_pos_O.simps
- wadjust_backto_standard_pos_B.simps)
-apply(rule_tac x = rn in exI, simp)
-apply(case_tac ml, simp_all add: exp_ind_def)
-done
-
-
-lemma [simp]:
- "\<lbrakk>wadjust_backto_standard_pos_O m rs (c, Oc # list); c \<noteq> []; hd c = Bk\<rbrakk>
- \<Longrightarrow> wadjust_backto_standard_pos_B m rs (tl c, Bk # Oc # list)"
-apply(simp add:wadjust_backto_standard_pos_O.simps
- wadjust_backto_standard_pos_B.simps, auto)
-apply(case_tac [!] ml, simp_all add: exp_ind_def)
-done
-
-lemma [simp]: "\<lbrakk>wadjust_backto_standard_pos_O m rs (c, Oc # list); c \<noteq> []; hd c = Oc\<rbrakk>
- \<Longrightarrow> wadjust_backto_standard_pos_O m rs (tl c, Oc # Oc # list)"
-apply(simp add: wadjust_backto_standard_pos_O.simps, auto)
-apply(case_tac ml, simp_all add: exp_ind_def, auto)
-apply(rule_tac x = nat in exI, auto simp: exp_ind_def)
-done
-
-lemma [simp]: "wadjust_backto_standard_pos m rs (c, Oc # list)
- \<Longrightarrow> (c = [] \<longrightarrow> wadjust_backto_standard_pos m rs ([], Bk # Oc # list)) \<and>
- (c \<noteq> [] \<longrightarrow> wadjust_backto_standard_pos m rs (tl c, hd c # Oc # list))"
-apply(auto simp: wadjust_backto_standard_pos.simps)
-apply(case_tac "hd c", simp_all)
-done
-thm wadjust_loop_right_move.simps
-
-lemma [simp]: "wadjust_loop_right_move m rs (c, []) = False"
-apply(simp only: wadjust_loop_right_move.simps)
-apply(rule_tac iffI)
-apply(erule_tac exE)+
-apply(case_tac nr, simp_all add: exp_ind_def)
-apply(case_tac mr, simp_all add: exp_ind_def)
-done
-
-lemma [simp]: "wadjust_loop_erase m rs (c, []) = False"
-apply(simp only: wadjust_loop_erase.simps, auto)
-apply(case_tac mr, simp_all add: exp_ind_def)
-done
-
-lemma [simp]: "\<lbrakk>Suc (Suc rs) = a; wadjust_loop_erase m rs (c, Bk # list)\<rbrakk>
- \<Longrightarrow> a - length (takeWhile (\<lambda>a. a = Oc) (tl (dropWhile (\<lambda>a. a = Oc) (rev (tl c) @ hd c # Bk # list))))
- < a - length (takeWhile (\<lambda>a. a = Oc) (tl (dropWhile (\<lambda>a. a = Oc) (rev c @ Bk # list)))) \<or>
- a - length (takeWhile (\<lambda>a. a = Oc) (tl (dropWhile (\<lambda>a. a = Oc) (rev (tl c) @ hd c # Bk # list)))) =
- a - length (takeWhile (\<lambda>a. a = Oc) (tl (dropWhile (\<lambda>a. a = Oc) (rev c @ Bk # list))))"
-apply(simp only: wadjust_loop_erase.simps)
-apply(rule_tac disjI2)
-apply(case_tac c, simp, simp)
-done
-
-lemma [simp]:
- "\<lbrakk>Suc (Suc rs) = a; wadjust_loop_on_left_moving m rs (c, Bk # list)\<rbrakk>
- \<Longrightarrow> a - length (takeWhile (\<lambda>a. a = Oc) (tl (dropWhile (\<lambda>a. a = Oc) (rev (tl c) @ hd c # Bk # list))))
- < a - length (takeWhile (\<lambda>a. a = Oc) (tl (dropWhile (\<lambda>a. a = Oc) (rev c @ Bk # list)))) \<or>
- a - length (takeWhile (\<lambda>a. a = Oc) (tl (dropWhile (\<lambda>a. a = Oc) (rev (tl c) @ hd c # Bk # list)))) =
- a - length (takeWhile (\<lambda>a. a = Oc) (tl (dropWhile (\<lambda>a. a = Oc) (rev c @ Bk # list))))"
-apply(subgoal_tac "c \<noteq> []")
-apply(case_tac c, simp_all)
-done
-
-lemma dropWhile_exp1: "dropWhile (\<lambda>a. a = Oc) (Oc\<^bsup>n\<^esup> @ xs) = dropWhile (\<lambda>a. a = Oc) xs"
-apply(induct n, simp_all add: exp_ind_def)
-done
-lemma takeWhile_exp1: "takeWhile (\<lambda>a. a = Oc) (Oc\<^bsup>n\<^esup> @ xs) = Oc\<^bsup>n\<^esup> @ takeWhile (\<lambda>a. a = Oc) xs"
-apply(induct n, simp_all add: exp_ind_def)
-done
-
-lemma [simp]: "\<lbrakk>Suc (Suc rs) = a; wadjust_loop_right_move2 m rs (c, Bk # list)\<rbrakk>
- \<Longrightarrow> a - length (takeWhile (\<lambda>a. a = Oc) (tl (dropWhile (\<lambda>a. a = Oc) (rev c @ Oc # list))))
- < a - length (takeWhile (\<lambda>a. a = Oc) (tl (dropWhile (\<lambda>a. a = Oc) (rev c @ Bk # list))))"
-apply(simp add: wadjust_loop_right_move2.simps, auto)
-apply(simp add: dropWhile_exp1 takeWhile_exp1)
-apply(case_tac ln, simp, simp add: exp_ind_def)
-done
-
-lemma [simp]: "wadjust_loop_check m rs ([], b) = False"
-apply(simp add: wadjust_loop_check.simps)
-done
-
-lemma [simp]: "\<lbrakk>Suc (Suc rs) = a; wadjust_loop_check m rs (c, Oc # list)\<rbrakk>
- \<Longrightarrow> a - length (takeWhile (\<lambda>a. a = Oc) (tl (dropWhile (\<lambda>a. a = Oc) (rev (tl c) @ hd c # Oc # list))))
- < a - length (takeWhile (\<lambda>a. a = Oc) (tl (dropWhile (\<lambda>a. a = Oc) (rev c @ Oc # list)))) \<or>
- a - length (takeWhile (\<lambda>a. a = Oc) (tl (dropWhile (\<lambda>a. a = Oc) (rev (tl c) @ hd c # Oc # list)))) =
- a - length (takeWhile (\<lambda>a. a = Oc) (tl (dropWhile (\<lambda>a. a = Oc) (rev c @ Oc # list))))"
-apply(case_tac "c", simp_all)
-done
-
-lemma [simp]:
- "\<lbrakk>Suc (Suc rs) = a; wadjust_loop_erase m rs (c, Oc # list)\<rbrakk>
- \<Longrightarrow> a - length (takeWhile (\<lambda>a. a = Oc) (tl (dropWhile (\<lambda>a. a = Oc) (rev c @ Bk # list))))
- < a - length (takeWhile (\<lambda>a. a = Oc) (tl (dropWhile (\<lambda>a. a = Oc) (rev c @ Oc # list)))) \<or>
- a - length (takeWhile (\<lambda>a. a = Oc) (tl (dropWhile (\<lambda>a. a = Oc) (rev c @ Bk # list)))) =
- a - length (takeWhile (\<lambda>a. a = Oc) (tl (dropWhile (\<lambda>a. a = Oc) (rev c @ Oc # list))))"
-apply(simp add: wadjust_loop_erase.simps)
-apply(rule_tac disjI2)
-apply(auto)
-apply(simp add: dropWhile_exp1 takeWhile_exp1)
-done
-
-declare numeral_2_eq_2[simp del]
-
-lemma wadjust_correctness:
- shows "let P = (\<lambda> (len, st, l, r). st = 0) in
- let Q = (\<lambda> (len, st, l, r). wadjust_inv st m rs (l, r)) in
- let f = (\<lambda> stp. (Suc (Suc rs), steps (Suc 0, Bk # Oc\<^bsup>Suc m\<^esup>,
- Bk # Oc # Bk\<^bsup>ln\<^esup> @ Bk # Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>rn\<^esup>) t_wcode_adjust stp)) in
- \<exists> n .P (f n) \<and> Q (f n)"
-proof -
- let ?P = "(\<lambda> (len, st, l, r). st = 0)"
- let ?Q = "\<lambda> (len, st, l, r). wadjust_inv st m rs (l, r)"
- let ?f = "\<lambda> stp. (Suc (Suc rs), steps (Suc 0, Bk # Oc\<^bsup>Suc m\<^esup>,
- Bk # Oc # Bk\<^bsup>ln\<^esup> @ Bk # Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>rn\<^esup>) t_wcode_adjust stp)"
- have "\<exists> n. ?P (?f n) \<and> ?Q (?f n)"
- proof(rule_tac halt_lemma2)
- show "wf wadjust_le" by auto
- next
- show "\<forall> n. \<not> ?P (?f n) \<and> ?Q (?f n) \<longrightarrow>
- ?Q (?f (Suc n)) \<and> (?f (Suc n), ?f n) \<in> wadjust_le"
- proof(rule_tac allI, rule_tac impI, case_tac "?f n",
- simp add: tstep_red tstep.simps, rule_tac conjI, erule_tac conjE,
- erule_tac conjE)
- fix n a b c d
- assume "0 < b" "wadjust_inv b m rs (c, d)" "Suc (Suc rs) = a"
- thus "case case fetch t_wcode_adjust b (case d of [] \<Rightarrow> Bk | x # xs \<Rightarrow> x)
- of (ac, ns) \<Rightarrow> (ns, new_tape ac (c, d)) of (st, x) \<Rightarrow> wadjust_inv st m rs x"
- apply(case_tac d, simp, case_tac [2] aa)
- apply(simp_all add: wadjust_inv.simps wadjust_le_def new_tape.simps
- abacus.lex_triple_def abacus.lex_pair_def lex_square_def
- split: if_splits)
- done
- next
- fix n a b c d
- assume "0 < b \<and> wadjust_inv b m rs (c, d)"
- "Suc (Suc rs) = a \<and> steps (Suc 0, Bk # Oc\<^bsup>Suc m\<^esup>,
- Bk # Oc # Bk\<^bsup>ln\<^esup> @ Bk # Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>rn\<^esup>) t_wcode_adjust n = (b, c, d)"
- thus "((a, case fetch t_wcode_adjust b (case d of [] \<Rightarrow> Bk | x # xs \<Rightarrow> x)
- of (ac, ns) \<Rightarrow> (ns, new_tape ac (c, d))), a, b, c, d) \<in> wadjust_le"
- proof(erule_tac conjE, erule_tac conjE, erule_tac conjE)
- assume "0 < b" "wadjust_inv b m rs (c, d)" "Suc (Suc rs) = a"
- thus "?thesis"
- apply(case_tac d, case_tac [2] aa)
- apply(simp_all add: wadjust_inv.simps wadjust_le_def new_tape.simps
- abacus.lex_triple_def abacus.lex_pair_def lex_square_def
- split: if_splits)
- done
- qed
- qed
- next
- show "?Q (?f 0)"
- apply(simp add: steps.simps wadjust_inv.simps wadjust_start.simps)
- apply(rule_tac x = ln in exI,auto)
- done
- next
- show "\<not> ?P (?f 0)"
- apply(simp add: steps.simps)
- done
- qed
- thus "?thesis"
- apply(auto)
- done
-qed
-
-lemma [intro]: "t_correct t_wcode_adjust"
-apply(auto simp: t_wcode_adjust_def t_correct.simps iseven_def)
-apply(rule_tac x = 11 in exI, simp)
-done
-
-lemma wcode_lemma_pre':
- "args \<noteq> [] \<Longrightarrow>
- \<exists> stp rn. steps (Suc 0, [], <m # args>)
- ((t_wcode_prepare |+| t_wcode_main) |+| t_wcode_adjust) stp
- = (0, [Bk], Oc\<^bsup>Suc m\<^esup> @ Bk # Oc\<^bsup>Suc (bl_bin (<args>))\<^esup> @ Bk\<^bsup>rn\<^esup>)"
-proof -
- let ?P1 = "\<lambda> (l, r). l = [] \<and> r = <m # args>"
- let ?Q1 = "\<lambda>(l, r). l = Bk # Oc\<^bsup>Suc m\<^esup> \<and>
- (\<exists>ln rn. r = Bk # Oc # Bk\<^bsup>ln\<^esup> @ Bk # Bk # Oc\<^bsup>bl_bin (<args>)\<^esup> @ Bk\<^bsup>rn\<^esup>)"
- let ?P2 = ?Q1
- let ?Q2 = "\<lambda> (l, r). (wadjust_stop m (bl_bin (<args>) - 1) (l, r))"
- let ?P3 = "\<lambda> tp. False"
- assume h: "args \<noteq> []"
- have "?P1 \<turnstile>-> \<lambda> tp. (\<exists> stp tp'. steps (Suc 0, tp)
- ((t_wcode_prepare |+| t_wcode_main) |+| t_wcode_adjust) stp = (0, tp') \<and> ?Q2 tp')"
- proof(rule_tac turing_merge.t_merge_halt[of "t_wcode_prepare |+| t_wcode_main"
- t_wcode_adjust ?P1 ?P2 ?P3 ?P3 ?Q1 ?Q2],
- auto simp: turing_merge_def)
-
- show "\<exists>stp. case steps (Suc 0, [], <m # args>) (t_wcode_prepare |+| t_wcode_main) stp of
- (st, tp') \<Rightarrow> st = 0 \<and> (case tp' of (l, r) \<Rightarrow> l = Bk # Oc\<^bsup>Suc m\<^esup> \<and>
- (\<exists>ln rn. r = Bk # Oc # Bk\<^bsup>ln\<^esup> @ Bk # Bk # Oc\<^bsup>bl_bin (<args>)\<^esup> @ Bk\<^bsup>rn\<^esup>))"
- using h prepare_mainpart_lemma[of args m]
- apply(auto)
- apply(rule_tac x = stp in exI, simp)
- apply(rule_tac x = ln in exI, auto)
- done
- next
- fix ln rn
- show "\<exists>stp. case steps (Suc 0, Bk # Oc\<^bsup>Suc m\<^esup>, Bk # Oc # Bk\<^bsup>ln\<^esup> @ Bk # Bk #
- Oc\<^bsup>bl_bin (<args>)\<^esup> @ Bk\<^bsup>rn\<^esup>) t_wcode_adjust stp of
- (st, tp') \<Rightarrow> st = 0 \<and> wadjust_stop m (bl_bin (<args>) - Suc 0) tp'"
- using wadjust_correctness[of m "bl_bin (<args>) - 1" "Suc ln" rn]
- apply(subgoal_tac "bl_bin (<args>) > 0", auto simp: wadjust_inv.simps)
- apply(rule_tac x = n in exI, simp add: exp_ind)
- using h
- apply(case_tac args, simp_all, case_tac list,
- simp_all add: tape_of_nl_abv tape_of_nat_list.simps exp_ind_def
- bl_bin.simps)
- done
- next
- show "?Q1 \<turnstile>-> ?P2"
- by(simp add: t_imply_def)
- qed
- thus "\<exists>stp rn. steps (Suc 0, [], <m # args>) ((t_wcode_prepare |+| t_wcode_main) |+|
- t_wcode_adjust) stp = (0, [Bk], Oc\<^bsup>Suc m\<^esup> @ Bk # Oc\<^bsup>Suc (bl_bin (<args>))\<^esup> @ Bk\<^bsup>rn\<^esup>)"
- apply(simp add: t_imply_def)
- apply(erule_tac exE)+
- apply(subgoal_tac "bl_bin (<args>) > 0", auto simp: wadjust_stop.simps)
- using h
- apply(case_tac args, simp_all, case_tac list,
- simp_all add: tape_of_nl_abv tape_of_nat_list.simps exp_ind_def
- bl_bin.simps)
- done
-qed
-
-text {*
- The initialization TM @{text "t_wcode"}.
- *}
-definition t_wcode :: "tprog"
- where
- "t_wcode = (t_wcode_prepare |+| t_wcode_main) |+| t_wcode_adjust"
-
-
-text {*
- The correctness of @{text "t_wcode"}.
- *}
-lemma wcode_lemma_1:
- "args \<noteq> [] \<Longrightarrow>
- \<exists> stp ln rn. steps (Suc 0, [], <m # args>) (t_wcode) stp =
- (0, [Bk], Oc\<^bsup>Suc m\<^esup> @ Bk # Oc\<^bsup>Suc (bl_bin (<args>))\<^esup> @ Bk\<^bsup>rn\<^esup>)"
-apply(simp add: wcode_lemma_pre' t_wcode_def)
-done
-
-lemma wcode_lemma:
- "args \<noteq> [] \<Longrightarrow>
- \<exists> stp ln rn. steps (Suc 0, [], <m # args>) (t_wcode) stp =
- (0, [Bk], <[m ,bl_bin (<args>)]> @ Bk\<^bsup>rn\<^esup>)"
-using wcode_lemma_1[of args m]
-apply(simp add: t_wcode_def tape_of_nl_abv tape_of_nat_list.simps)
-done
-
-section {* The universal TM *}
-
-text {*
- This section gives the explicit construction of {\em Universal Turing Machine}, defined as @{text "UTM"} and proves its
- correctness. It is pretty easy by composing the partial results we have got so far.
- *}
-
-
-definition UTM :: "tprog"
- where
- "UTM = (let (aprog, rs_pos, a_md) = rec_ci rec_F in
- let abc_F = aprog [+] dummy_abc (Suc (Suc 0)) in
- (t_wcode |+| (tm_of abc_F @ tMp (Suc (Suc 0)) (start_of (layout_of abc_F)
- (length abc_F) - Suc 0))))"
-
-definition F_aprog :: "abc_prog"
- where
- "F_aprog \<equiv> (let (aprog, rs_pos, a_md) = rec_ci rec_F in
- aprog [+] dummy_abc (Suc (Suc 0)))"
-
-definition F_tprog :: "tprog"
- where
- "F_tprog = tm_of (F_aprog)"
-
-definition t_utm :: "tprog"
- where
- "t_utm \<equiv>
- (F_tprog) @ tMp (Suc (Suc 0)) (start_of (layout_of (F_aprog))
- (length (F_aprog)) - Suc 0)"
-
-definition UTM_pre :: "tprog"
- where
- "UTM_pre = t_wcode |+| t_utm"
-
-lemma F_abc_halt_eq:
- "\<lbrakk>turing_basic.t_correct tp;
- length lm = k;
- steps (Suc 0, Bk\<^bsup>l\<^esup>, <lm>) tp stp = (0, Bk\<^bsup>m\<^esup>, Oc\<^bsup>rs\<^esup>@Bk\<^bsup>n\<^esup>);
- rs > 0\<rbrakk>
- \<Longrightarrow> \<exists> stp m. abc_steps_l (0, [code tp, bl2wc (<lm>)]) (F_aprog) stp =
- (length (F_aprog), code tp # bl2wc (<lm>) # (rs - 1) # 0\<^bsup>m\<^esup>)"
-apply(drule_tac F_t_halt_eq, simp, simp, simp)
-apply(case_tac "rec_ci rec_F")
-apply(frule_tac abc_append_dummy_complie, simp, simp, erule_tac exE,
- erule_tac exE)
-apply(rule_tac x = stp in exI, rule_tac x = m in exI)
-apply(simp add: F_aprog_def dummy_abc_def)
-done
-
-lemma F_abc_utm_halt_eq:
- "\<lbrakk>rs > 0;
- abc_steps_l (0, [code tp, bl2wc (<lm>)]) F_aprog stp =
- (length F_aprog, code tp # bl2wc (<lm>) # (rs - 1) # 0\<^bsup>m\<^esup>)\<rbrakk>
- \<Longrightarrow> \<exists>stp m n.(steps (Suc 0, [Bk, Bk], <[code tp, bl2wc (<lm>)]>) t_utm stp =
- (0, Bk\<^bsup>m\<^esup>, Oc\<^bsup>rs\<^esup> @ Bk\<^bsup>n\<^esup>))"
- thm abacus_turing_eq_halt
- using abacus_turing_eq_halt
- [of "layout_of F_aprog" "F_aprog" "F_tprog" "length (F_aprog)"
- "[code tp, bl2wc (<lm>)]" stp "code tp # bl2wc (<lm>) # (rs - 1) # 0\<^bsup>m\<^esup>" "Suc (Suc 0)"
- "start_of (layout_of (F_aprog)) (length (F_aprog))" "[]" 0]
-apply(simp add: F_tprog_def t_utm_def abc_lm_v.simps nth_append)
-apply(erule_tac exE)+
-apply(rule_tac x = stpa in exI, rule_tac x = "Suc (Suc ma)" in exI,
- rule_tac x = l in exI, simp add: exp_ind)
-done
-
-declare tape_of_nl_abv_cons[simp del]
-
-lemma t_utm_halt_eq':
- "\<lbrakk>turing_basic.t_correct tp;
- 0 < rs;
- steps (Suc 0, Bk\<^bsup>l\<^esup>, <lm::nat list>) tp stp = (0, Bk\<^bsup>m\<^esup>, Oc\<^bsup>rs\<^esup>@Bk\<^bsup>n\<^esup>)\<rbrakk>
- \<Longrightarrow> \<exists>stp m n. steps (Suc 0, [Bk, Bk], <[code tp, bl2wc (<lm>)]>) t_utm stp =
- (0, Bk\<^bsup>m\<^esup>, Oc\<^bsup>rs\<^esup> @ Bk\<^bsup>n\<^esup>)"
-apply(drule_tac l = l in F_abc_halt_eq, simp, simp, simp)
-apply(erule_tac exE, erule_tac exE)
-apply(rule_tac F_abc_utm_halt_eq, simp_all)
-done
-
-lemma [simp]: "tinres xs (xs @ Bk\<^bsup>i\<^esup>)"
-apply(auto simp: tinres_def)
-done
-
-lemma [elim]: "\<lbrakk>rs > 0; Oc\<^bsup>rs\<^esup> @ Bk\<^bsup>na\<^esup> = c @ Bk\<^bsup>n\<^esup>\<rbrakk>
- \<Longrightarrow> \<exists>n. c = Oc\<^bsup>rs\<^esup> @ Bk\<^bsup>n\<^esup>"
-apply(case_tac "na > n")
-apply(subgoal_tac "\<exists> d. na = d + n", auto simp: exp_add)
-apply(rule_tac x = "na - n" in exI, simp)
-apply(subgoal_tac "\<exists> d. n = d + na", auto simp: exp_add)
-apply(case_tac rs, simp_all add: exp_ind, case_tac d,
- simp_all add: exp_ind)
-apply(rule_tac x = "n - na" in exI, simp)
-done
-
-
-lemma t_utm_halt_eq'':
- "\<lbrakk>turing_basic.t_correct tp;
- 0 < rs;
- steps (Suc 0, Bk\<^bsup>l\<^esup>, <lm::nat list>) tp stp = (0, Bk\<^bsup>m\<^esup>, Oc\<^bsup>rs\<^esup>@Bk\<^bsup>n\<^esup>)\<rbrakk>
- \<Longrightarrow> \<exists>stp m n. steps (Suc 0, [Bk, Bk], <[code tp, bl2wc (<lm>)]> @ Bk\<^bsup>i\<^esup>) t_utm stp =
- (0, Bk\<^bsup>m\<^esup>, Oc\<^bsup>rs\<^esup> @ Bk\<^bsup>n\<^esup>)"
-apply(drule_tac t_utm_halt_eq', simp_all)
-apply(erule_tac exE)+
-proof -
- fix stpa ma na
- assume "steps (Suc 0, [Bk, Bk], <[code tp, bl2wc (<lm>)]>) t_utm stpa = (0, Bk\<^bsup>ma\<^esup>, Oc\<^bsup>rs\<^esup> @ Bk\<^bsup>na\<^esup>)"
- and gr: "rs > 0"
- thus "\<exists>stp m n. steps (Suc 0, [Bk, Bk], <[code tp, bl2wc (<lm>)]> @ Bk\<^bsup>i\<^esup>) t_utm stp = (0, Bk\<^bsup>m\<^esup>, Oc\<^bsup>rs\<^esup> @ Bk\<^bsup>n\<^esup>)"
- apply(rule_tac x = stpa in exI, rule_tac x = ma in exI, simp)
- proof(case_tac "steps (Suc 0, [Bk, Bk], <[code tp, bl2wc (<lm>)]> @ Bk\<^bsup>i\<^esup>) t_utm stpa", simp)
- fix a b c
- assume "steps (Suc 0, [Bk, Bk], <[code tp, bl2wc (<lm>)]>) t_utm stpa = (0, Bk\<^bsup>ma\<^esup>, Oc\<^bsup>rs\<^esup> @ Bk\<^bsup>na\<^esup>)"
- "steps (Suc 0, [Bk, Bk], <[code tp, bl2wc (<lm>)]> @ Bk\<^bsup>i\<^esup>) t_utm stpa = (a, b, c)"
- thus " a = 0 \<and> b = Bk\<^bsup>ma\<^esup> \<and> (\<exists>n. c = Oc\<^bsup>rs\<^esup> @ Bk\<^bsup>n\<^esup>)"
- using tinres_steps2[of "<[code tp, bl2wc (<lm>)]>" "<[code tp, bl2wc (<lm>)]> @ Bk\<^bsup>i\<^esup>"
- "Suc 0" " [Bk, Bk]" t_utm stpa 0 "Bk\<^bsup>ma\<^esup>" "Oc\<^bsup>rs\<^esup> @ Bk\<^bsup>na\<^esup>" a b c]
- apply(simp)
- using gr
- apply(simp only: tinres_def, auto)
- apply(rule_tac x = "na + n" in exI, simp add: exp_add)
- done
- qed
-qed
-
-lemma [simp]: "tinres [Bk, Bk] [Bk]"
-apply(auto simp: tinres_def)
-done
-
-lemma [elim]: "Bk\<^bsup>ma\<^esup> = b @ Bk\<^bsup>n\<^esup> \<Longrightarrow> \<exists>m. b = Bk\<^bsup>m\<^esup>"
-apply(subgoal_tac "ma = length b + n")
-apply(rule_tac x = "ma - n" in exI, simp add: exp_add)
-apply(drule_tac length_equal)
-apply(simp)
-done
-
-lemma t_utm_halt_eq:
- "\<lbrakk>turing_basic.t_correct tp;
- 0 < rs;
- steps (Suc 0, Bk\<^bsup>l\<^esup>, <lm::nat list>) tp stp = (0, Bk\<^bsup>m\<^esup>, Oc\<^bsup>rs\<^esup>@Bk\<^bsup>n\<^esup>)\<rbrakk>
- \<Longrightarrow> \<exists>stp m n. steps (Suc 0, [Bk], <[code tp, bl2wc (<lm>)]> @ Bk\<^bsup>i\<^esup>) t_utm stp =
- (0, Bk\<^bsup>m\<^esup>, Oc\<^bsup>rs\<^esup> @ Bk\<^bsup>n\<^esup>)"
-apply(drule_tac i = i in t_utm_halt_eq'', simp_all)
-apply(erule_tac exE)+
-proof -
- fix stpa ma na
- assume "steps (Suc 0, [Bk, Bk], <[code tp, bl2wc (<lm>)]> @ Bk\<^bsup>i\<^esup>) t_utm stpa = (0, Bk\<^bsup>ma\<^esup>, Oc\<^bsup>rs\<^esup> @ Bk\<^bsup>na\<^esup>)"
- and gr: "rs > 0"
- thus "\<exists>stp m n. steps (Suc 0, [Bk], <[code tp, bl2wc (<lm>)]> @ Bk\<^bsup>i\<^esup>) t_utm stp = (0, Bk\<^bsup>m\<^esup>, Oc\<^bsup>rs\<^esup> @ Bk\<^bsup>n\<^esup>)"
- apply(rule_tac x = stpa in exI)
- proof(case_tac "steps (Suc 0, [Bk], <[code tp, bl2wc (<lm>)]> @ Bk\<^bsup>i\<^esup>) t_utm stpa", simp)
- fix a b c
- assume "steps (Suc 0, [Bk, Bk], <[code tp, bl2wc (<lm>)]> @ Bk\<^bsup>i\<^esup>) t_utm stpa = (0, Bk\<^bsup>ma\<^esup>, Oc\<^bsup>rs\<^esup> @ Bk\<^bsup>na\<^esup>)"
- "steps (Suc 0, [Bk], <[code tp, bl2wc (<lm>)]> @ Bk\<^bsup>i\<^esup>) t_utm stpa = (a, b, c)"
- thus "a = 0 \<and> (\<exists>m. b = Bk\<^bsup>m\<^esup>) \<and> (\<exists>n. c = Oc\<^bsup>rs\<^esup> @ Bk\<^bsup>n\<^esup>)"
- using tinres_steps[of "[Bk, Bk]" "[Bk]" "Suc 0" "<[code tp, bl2wc (<lm>)]> @ Bk\<^bsup>i\<^esup>" t_utm stpa 0
- "Bk\<^bsup>ma\<^esup>" "Oc\<^bsup>rs\<^esup> @ Bk\<^bsup>na\<^esup>" a b c]
- apply(simp)
- apply(auto simp: tinres_def)
- apply(rule_tac x = "ma + n" in exI, simp add: exp_add)
- done
- qed
-qed
-
-lemma [intro]: "t_correct t_wcode"
-apply(simp add: t_wcode_def)
-apply(auto)
-done
-
-lemma [intro]: "t_correct t_utm"
-apply(simp add: t_utm_def F_tprog_def)
-apply(rule_tac t_compiled_correct, auto)
-done
-
-lemma UTM_halt_lemma_pre:
- "\<lbrakk>turing_basic.t_correct tp;
- 0 < rs;
- args \<noteq> [];
- steps (Suc 0, Bk\<^bsup>i\<^esup>, <args::nat list>) tp stp = (0, Bk\<^bsup>m\<^esup>, Oc\<^bsup>rs\<^esup>@Bk\<^bsup>k\<^esup>)\<rbrakk>
- \<Longrightarrow> \<exists>stp m n. steps (Suc 0, [], <code tp # args>) UTM_pre stp =
- (0, Bk\<^bsup>m\<^esup>, Oc\<^bsup>rs\<^esup> @ Bk\<^bsup>n\<^esup>)"
-proof -
- let ?Q2 = "\<lambda> (l, r). (\<exists> ln rn. l = Bk\<^bsup>ln\<^esup> \<and> r = Oc\<^bsup>rs\<^esup> @ Bk\<^bsup>rn\<^esup>)"
- term ?Q2
- let ?P1 = "\<lambda> (l, r). l = [] \<and> r = <code tp # args>"
- let ?Q1 = "\<lambda> (l, r). (l = [Bk] \<and>
- (\<exists> rn. r = Oc\<^bsup>Suc (code tp)\<^esup> @ Bk # Oc\<^bsup>Suc (bl_bin (<args>))\<^esup> @ Bk\<^bsup>rn\<^esup>))"
- let ?P2 = ?Q1
- let ?P3 = "\<lambda> (l, r). False"
- assume h: "turing_basic.t_correct tp" "0 < rs"
- "args \<noteq> []" "steps (Suc 0, Bk\<^bsup>i\<^esup>, <args::nat list>) tp stp = (0, Bk\<^bsup>m\<^esup>, Oc\<^bsup>rs\<^esup>@Bk\<^bsup>k\<^esup>)"
- have "?P1 \<turnstile>-> \<lambda> tp. (\<exists> stp tp'. steps (Suc 0, tp)
- (t_wcode |+| t_utm) stp = (0, tp') \<and> ?Q2 tp')"
- proof(rule_tac turing_merge.t_merge_halt [of "t_wcode" "t_utm"
- ?P1 ?P2 ?P3 ?P3 ?Q1 ?Q2], auto simp: turing_merge_def)
- show "\<exists>stp. case steps (Suc 0, [], <code tp # args>) t_wcode stp of (st, tp') \<Rightarrow>
- st = 0 \<and> (case tp' of (l, r) \<Rightarrow> l = [Bk] \<and>
- (\<exists>rn. r = Oc\<^bsup>Suc (code tp)\<^esup> @ Bk # Oc\<^bsup>Suc (bl_bin (<args>))\<^esup> @ Bk\<^bsup>rn\<^esup>))"
- using wcode_lemma_1[of args "code tp"] h
- apply(simp, auto)
- apply(rule_tac x = stpa in exI, auto)
- done
- next
- fix rn
- show "\<exists>stp. case steps (Suc 0, [Bk], Oc\<^bsup>Suc (code tp)\<^esup> @
- Bk # Oc\<^bsup>Suc (bl_bin (<args>))\<^esup> @ Bk\<^bsup>rn\<^esup>) t_utm stp of
- (st, tp') \<Rightarrow> st = 0 \<and> (case tp' of (l, r) \<Rightarrow>
- (\<exists>ln. l = Bk\<^bsup>ln\<^esup>) \<and> (\<exists>rn. r = Oc\<^bsup>rs\<^esup> @ Bk\<^bsup>rn\<^esup>))"
- using t_utm_halt_eq[of tp rs i args stp m k rn] h
- apply(auto)
- apply(rule_tac x = stpa in exI, simp add: bin_wc_eq
- tape_of_nat_list.simps tape_of_nl_abv)
- apply(auto)
- done
- next
- show "?Q1 \<turnstile>-> ?P2"
- apply(simp add: t_imply_def)
- done
- qed
- thus "?thesis"
- apply(simp add: t_imply_def)
- apply(auto simp: UTM_pre_def)
- done
-qed
-
-text {*
- The correctness of @{text "UTM"}, the halt case.
-*}
-lemma UTM_halt_lemma:
- "\<lbrakk>turing_basic.t_correct tp;
- 0 < rs;
- args \<noteq> [];
- steps (Suc 0, Bk\<^bsup>i\<^esup>, <args::nat list>) tp stp = (0, Bk\<^bsup>m\<^esup>, Oc\<^bsup>rs\<^esup>@Bk\<^bsup>k\<^esup>)\<rbrakk>
- \<Longrightarrow> \<exists>stp m n. steps (Suc 0, [], <code tp # args>) UTM stp =
- (0, Bk\<^bsup>m\<^esup>, Oc\<^bsup>rs\<^esup> @ Bk\<^bsup>n\<^esup>)"
-using UTM_halt_lemma_pre[of tp rs args i stp m k]
-apply(simp add: UTM_pre_def t_utm_def UTM_def F_aprog_def F_tprog_def)
-apply(case_tac "rec_ci rec_F", simp)
-done
-
-definition TSTD:: "t_conf \<Rightarrow> bool"
- where
- "TSTD c = (let (st, l, r) = c in
- st = 0 \<and> (\<exists> m. l = Bk\<^bsup>m\<^esup>) \<and> (\<exists> rs n. r = Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>n\<^esup>))"
-
-thm abacus_turing_eq_uhalt
-
-lemma nstd_case1: "0 < a \<Longrightarrow> NSTD (trpl_code (a, b, c))"
-apply(simp add: NSTD.simps trpl_code.simps)
-done
-
-lemma [simp]: "\<forall>m. b \<noteq> Bk\<^bsup>m\<^esup> \<Longrightarrow> 0 < bl2wc b"
-apply(rule classical, simp)
-apply(induct b, erule_tac x = 0 in allE, simp)
-apply(simp add: bl2wc.simps, case_tac a, simp_all
- add: bl2nat.simps bl2nat_double)
-apply(case_tac "\<exists> m. b = Bk\<^bsup>m\<^esup>", erule exE)
-apply(erule_tac x = "Suc m" in allE, simp add: exp_ind_def, simp)
-done
-lemma nstd_case2: "\<forall>m. b \<noteq> Bk\<^bsup>m\<^esup> \<Longrightarrow> NSTD (trpl_code (a, b, c))"
-apply(simp add: NSTD.simps trpl_code.simps)
-done
-
-thm lg.simps
-thm lgR.simps
-
-lemma [elim]: "Suc (2 * x) = 2 * y \<Longrightarrow> RR"
-apply(induct x arbitrary: y, simp, simp)
-apply(case_tac y, simp, simp)
-done
-
-lemma bl2nat_zero_eq[simp]: "(bl2nat c 0 = 0) = (\<exists>n. c = Bk\<^bsup>n\<^esup>)"
-apply(auto)
-apply(induct c, simp add: bl2nat.simps)
-apply(rule_tac x = 0 in exI, simp)
-apply(case_tac a, auto simp: bl2nat.simps bl2nat_double)
-done
-
-lemma bl2wc_exp_ex:
- "\<lbrakk>Suc (bl2wc c) = 2 ^ m\<rbrakk> \<Longrightarrow> \<exists> rs n. c = Oc\<^bsup>rs\<^esup> @ Bk\<^bsup>n\<^esup>"
-apply(induct c arbitrary: m, simp add: bl2wc.simps bl2nat.simps)
-apply(case_tac a, auto)
-apply(case_tac m, simp_all add: bl2wc.simps, auto)
-apply(rule_tac x = 0 in exI, rule_tac x = "Suc n" in exI,
- simp add: exp_ind_def)
-apply(simp add: bl2wc.simps bl2nat.simps bl2nat_double)
-apply(case_tac m, simp, simp)
-proof -
- fix c m nat
- assume ind:
- "\<And>m. Suc (bl2nat c 0) = 2 ^ m \<Longrightarrow> \<exists>rs n. c = Oc\<^bsup>rs\<^esup> @ Bk\<^bsup>n\<^esup>"
- and h:
- "Suc (Suc (2 * bl2nat c 0)) = 2 * 2 ^ nat"
- have "\<exists>rs n. c = Oc\<^bsup>rs\<^esup> @ Bk\<^bsup>n\<^esup>"
- apply(rule_tac m = nat in ind)
- using h
- apply(simp)
- done
- from this obtain rs n where " c = Oc\<^bsup>rs\<^esup> @ Bk\<^bsup>n\<^esup>" by blast
- thus "\<exists>rs n. Oc # c = Oc\<^bsup>rs\<^esup> @ Bk\<^bsup>n\<^esup>"
- apply(rule_tac x = "Suc rs" in exI, simp add: exp_ind_def)
- apply(rule_tac x = n in exI, simp)
- done
-qed
-
-lemma [elim]:
- "\<lbrakk>\<forall>rs n. c \<noteq> Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>n\<^esup>;
- bl2wc c = 2 ^ lg (Suc (bl2wc c)) 2 - Suc 0\<rbrakk> \<Longrightarrow> bl2wc c = 0"
-apply(subgoal_tac "\<exists> m. Suc (bl2wc c) = 2^m", erule_tac exE)
-apply(drule_tac bl2wc_exp_ex, simp, erule_tac exE, erule_tac exE)
-apply(case_tac rs, simp, simp, erule_tac x = nat in allE,
- erule_tac x = n in allE, simp)
-using bl2wc_exp_ex[of c "lg (Suc (bl2wc c)) 2"]
-apply(case_tac "(2::nat) ^ lg (Suc (bl2wc c)) 2",
- simp, simp, erule_tac exE, erule_tac exE, simp)
-apply(simp add: bl2wc.simps)
-apply(rule_tac x = rs in exI)
-apply(case_tac "(2::nat)^rs", simp, simp)
-done
-
-lemma nstd_case3:
- "\<forall>rs n. c \<noteq> Oc\<^bsup>Suc rs\<^esup> @ Bk\<^bsup>n\<^esup> \<Longrightarrow> NSTD (trpl_code (a, b, c))"
-apply(simp add: NSTD.simps trpl_code.simps)
-apply(rule_tac impI)
-apply(rule_tac disjI2, rule_tac disjI2, auto)
-done
-
-lemma NSTD_1: "\<not> TSTD (a, b, c)
- \<Longrightarrow> rec_exec rec_NSTD [trpl_code (a, b, c)] = Suc 0"
- using NSTD_lemma1[of "trpl_code (a, b, c)"]
- NSTD_lemma2[of "trpl_code (a, b, c)"]
- apply(simp add: TSTD_def)
- apply(erule_tac disjE, erule_tac nstd_case1)
- apply(erule_tac disjE, erule_tac nstd_case2)
- apply(erule_tac nstd_case3)
- done
-
-lemma nonstop_t_uhalt_eq:
- "\<lbrakk>turing_basic.t_correct tp;
- steps (Suc 0, Bk\<^bsup>l\<^esup>, <lm>) tp stp = (a, b, c);
- \<not> TSTD (a, b, c)\<rbrakk>
- \<Longrightarrow> rec_exec rec_nonstop [code tp, bl2wc (<lm>), stp] = Suc 0"
-apply(simp add: rec_nonstop_def rec_exec.simps)
-apply(subgoal_tac
- "rec_exec rec_conf [code tp, bl2wc (<lm>), stp] =
- trpl_code (a, b, c)", simp)
-apply(erule_tac NSTD_1)
-using rec_t_eq_steps[of tp l lm stp]
-apply(simp)
-done
-
-lemma nonstop_true:
- "\<lbrakk>turing_basic.t_correct tp;
- \<forall> stp. (\<not> TSTD (steps (Suc 0, Bk\<^bsup>l\<^esup>, <lm>) tp stp))\<rbrakk>
- \<Longrightarrow> \<forall>y. rec_calc_rel rec_nonstop
- ([code tp, bl2wc (<lm>), y]) (Suc 0)"
-apply(rule_tac allI, erule_tac x = y in allE)
-apply(case_tac "steps (Suc 0, Bk\<^bsup>l\<^esup>, <lm>) tp y", simp)
-apply(rule_tac nonstop_t_uhalt_eq, simp_all)
-done
-
-(*
-lemma [simp]:
- "\<forall>j<Suc k. Ex (rec_calc_rel (get_fstn_args (Suc k) (Suc k) ! j)
- (code tp # lm))"
-apply(auto simp: get_fstn_args_nth)
-apply(rule_tac x = "(code tp # lm) ! j" in exI)
-apply(rule_tac calc_id, simp_all)
-done
-*)
-declare ci_cn_para_eq[simp]
-
-lemma F_aprog_uhalt:
- "\<lbrakk>turing_basic.t_correct tp;
- \<forall> stp. (\<not> TSTD (steps (Suc 0, Bk\<^bsup>l\<^esup>, <lm>) tp stp));
- rec_ci rec_F = (F_ap, rs_pos, a_md)\<rbrakk>
- \<Longrightarrow> \<forall> stp. case abc_steps_l (0, [code tp, bl2wc (<lm>)] @ 0\<^bsup>a_md - rs_pos \<^esup>
- @ suflm) (F_ap) stp of (ss, e) \<Rightarrow> ss < length (F_ap)"
-apply(case_tac "rec_ci (Cn (Suc (Suc 0)) rec_right [Cn (Suc (Suc 0)) rec_conf
- ([id (Suc (Suc 0)) 0, id (Suc (Suc 0)) (Suc 0), rec_halt])])")
-apply(simp only: rec_F_def, rule_tac i = 0 and ga = a and gb = b and
- gc = c in cn_gi_uhalt, simp, simp, simp, simp, simp, simp, simp)
-apply(simp add: ci_cn_para_eq)
-apply(case_tac "rec_ci (Cn (Suc (Suc 0)) rec_conf
- ([id (Suc (Suc 0)) 0, id (Suc (Suc 0)) (Suc 0), rec_halt]))")
-apply(rule_tac rf = "(Cn (Suc (Suc 0)) rec_right [Cn (Suc (Suc 0)) rec_conf
- ([id (Suc (Suc 0)) 0, id (Suc (Suc 0)) (Suc 0), rec_halt])])"
- and n = "Suc (Suc 0)" and f = rec_right and
- gs = "[Cn (Suc (Suc 0)) rec_conf
- ([id (Suc (Suc 0)) 0, id (Suc (Suc 0)) (Suc 0), rec_halt])]"
- and i = 0 and ga = aa and gb = ba and gc = ca in
- cn_gi_uhalt)
-apply(simp, simp, simp, simp, simp, simp, simp,
- simp add: ci_cn_para_eq)
-apply(case_tac "rec_ci rec_halt")
-apply(rule_tac rf = "(Cn (Suc (Suc 0)) rec_conf
- ([id (Suc (Suc 0)) 0, id (Suc (Suc 0)) (Suc 0), rec_halt]))"
- and n = "Suc (Suc 0)" and f = "rec_conf" and
- gs = "([id (Suc (Suc 0)) 0, id (Suc (Suc 0)) (Suc 0), rec_halt])" and
- i = "Suc (Suc 0)" and gi = "rec_halt" and ga = ab and gb = bb and
- gc = cb in cn_gi_uhalt)
-apply(simp, simp, simp, simp, simp add: nth_append, simp,
- simp add: nth_append, simp add: rec_halt_def)
-apply(simp only: rec_halt_def)
-apply(case_tac [!] "rec_ci ((rec_nonstop))")
-apply(rule_tac allI, rule_tac impI, simp)
-apply(case_tac j, simp)
-apply(rule_tac x = "code tp" in exI, rule_tac calc_id, simp, simp, simp, simp)
-apply(rule_tac x = "bl2wc (<lm>)" in exI, rule_tac calc_id, simp, simp, simp)
-apply(rule_tac rf = "Mn (Suc (Suc 0)) (rec_nonstop)"
- and f = "(rec_nonstop)" and n = "Suc (Suc 0)"
- and aprog' = ac and rs_pos' = bc and a_md' = cc in Mn_unhalt)
-apply(simp, simp add: rec_halt_def , simp, simp)
-apply(drule_tac nonstop_true, simp_all)
-apply(rule_tac allI)
-apply(erule_tac x = y in allE)+
-apply(simp)
-done
-
-thm abc_list_crsp_steps
-
-lemma uabc_uhalt':
- "\<lbrakk>turing_basic.t_correct tp;
- \<forall> stp. (\<not> TSTD (steps (Suc 0, Bk\<^bsup>l\<^esup>, <lm>) tp stp));
- rec_ci rec_F = (ap, pos, md)\<rbrakk>
- \<Longrightarrow> \<forall> stp. case abc_steps_l (0, [code tp, bl2wc (<lm>)]) ap stp of (ss, e)
- \<Rightarrow> ss < length ap"
-proof(frule_tac F_ap = ap and rs_pos = pos and a_md = md
- and suflm = "[]" in F_aprog_uhalt, auto)
- fix stp a b
- assume h:
- "\<forall>stp. case abc_steps_l (0, code tp # bl2wc (<lm>) # 0\<^bsup>md - pos\<^esup>) ap stp of
- (ss, e) \<Rightarrow> ss < length ap"
- "abc_steps_l (0, [code tp, bl2wc (<lm>)]) ap stp = (a, b)"
- "turing_basic.t_correct tp"
- "rec_ci rec_F = (ap, pos, md)"
- moreover have "ap \<noteq> []"
- using h apply(rule_tac rec_ci_not_null, simp)
- done
- ultimately show "a < length ap"
- proof(erule_tac x = stp in allE,
- case_tac "abc_steps_l (0, code tp # bl2wc (<lm>) # 0\<^bsup>md - pos\<^esup>) ap stp", simp)
- fix aa ba
- assume g: "aa < length ap"
- "abc_steps_l (0, code tp # bl2wc (<lm>) # 0\<^bsup>md - pos\<^esup>) ap stp = (aa, ba)"
- "ap \<noteq> []"
- thus "?thesis"
- using abc_list_crsp_steps[of "[code tp, bl2wc (<lm>)]"
- "md - pos" ap stp aa ba] h
- apply(simp)
- done
- qed
-qed
-
-lemma uabc_uhalt:
- "\<lbrakk>turing_basic.t_correct tp;
- \<forall> stp. (\<not> TSTD (steps (Suc 0, Bk\<^bsup>l\<^esup>, <lm>) tp stp))\<rbrakk>
- \<Longrightarrow> \<forall> stp. case abc_steps_l (0, [code tp, bl2wc (<lm>)]) F_aprog
- stp of (ss, e) \<Rightarrow> ss < length F_aprog"
-apply(case_tac "rec_ci rec_F", simp add: F_aprog_def)
-thm uabc_uhalt'
-apply(drule_tac ap = a and pos = b and md = c in uabc_uhalt', simp_all)
-proof -
- fix a b c
- assume
- "\<forall>stp. case abc_steps_l (0, [code tp, bl2wc (<lm>)]) a stp of (ss, e)
- \<Rightarrow> ss < length a"
- "rec_ci rec_F = (a, b, c)"
- thus
- "\<forall>stp. case abc_steps_l (0, [code tp, bl2wc (<lm>)])
- (a [+] dummy_abc (Suc (Suc 0))) stp of (ss, e) \<Rightarrow>
- ss < Suc (Suc (Suc (length a)))"
- using abc_append_uhalt1[of a "[code tp, bl2wc (<lm>)]"
- "a [+] dummy_abc (Suc (Suc 0))" "[]" "dummy_abc (Suc (Suc 0))"]
- apply(simp)
- done
-qed
-
-lemma tutm_uhalt':
- "\<lbrakk>turing_basic.t_correct tp;
- \<forall> stp. (\<not> TSTD (steps (Suc 0, Bk\<^bsup>l\<^esup>, <lm>) tp stp))\<rbrakk>
- \<Longrightarrow> \<forall> stp. \<not> isS0 (steps (Suc 0, [Bk, Bk], <[code tp, bl2wc (<lm>)]>) t_utm stp)"
- using abacus_turing_eq_uhalt[of "layout_of (F_aprog)"
- "F_aprog" "F_tprog" "[code tp, bl2wc (<lm>)]"
- "start_of (layout_of (F_aprog )) (length (F_aprog))"
- "Suc (Suc 0)"]
-apply(simp add: F_tprog_def)
-apply(subgoal_tac "\<forall>stp. case abc_steps_l (0, [code tp, bl2wc (<lm>)])
- (F_aprog) stp of (as, am) \<Rightarrow> as < length (F_aprog)", simp)
-thm abacus_turing_eq_uhalt
-apply(simp add: t_utm_def F_tprog_def)
-apply(rule_tac uabc_uhalt, simp_all)
-done
-
-lemma tinres_commute: "tinres r r' \<Longrightarrow> tinres r' r"
-apply(auto simp: tinres_def)
-done
-
-lemma inres_tape:
- "\<lbrakk>steps (st, l, r) tp stp = (a, b, c); steps (st, l', r') tp stp = (a', b', c');
- tinres l l'; tinres r r'\<rbrakk>
- \<Longrightarrow> a = a' \<and> tinres b b' \<and> tinres c c'"
-proof(case_tac "steps (st, l', r) tp stp")
- fix aa ba ca
- assume h: "steps (st, l, r) tp stp = (a, b, c)"
- "steps (st, l', r') tp stp = (a', b', c')"
- "tinres l l'" "tinres r r'"
- "steps (st, l', r) tp stp = (aa, ba, ca)"
- have "tinres b ba \<and> c = ca \<and> a = aa"
- using h
- apply(rule_tac tinres_steps, auto)
- done
-
- thm tinres_steps2
- moreover have "b' = ba \<and> tinres c' ca \<and> a' = aa"
- using h
- apply(rule_tac tinres_steps2, auto intro: tinres_commute)
- done
- ultimately show "?thesis"
- apply(auto intro: tinres_commute)
- done
-qed
-
-lemma tape_normalize: "\<forall> stp. \<not> isS0 (steps (Suc 0, [Bk, Bk], <[code tp, bl2wc (<lm>)]>) t_utm stp)
- \<Longrightarrow> \<forall> stp. \<not> isS0 (steps (Suc 0, Bk\<^bsup>m\<^esup>, <[code tp, bl2wc (<lm>)]> @ Bk\<^bsup>n\<^esup>) t_utm stp)"
-apply(rule_tac allI, case_tac "(steps (Suc 0, Bk\<^bsup>m\<^esup>,
- <[code tp, bl2wc (<lm>)]> @ Bk\<^bsup>n\<^esup>) t_utm stp)", simp add: isS0_def)
-apply(erule_tac x = stp in allE)
-apply(case_tac "steps (Suc 0, [Bk, Bk], <[code tp, bl2wc (<lm>)]>) t_utm stp", simp)
-apply(drule_tac inres_tape, auto)
-apply(auto simp: tinres_def)
-apply(case_tac "m > Suc (Suc 0)")
-apply(rule_tac x = "m - Suc (Suc 0)" in exI)
-apply(case_tac m, simp_all add: exp_ind_def, case_tac nat, simp_all add: exp_ind_def)
-apply(rule_tac x = "2 - m" in exI, simp add: exp_ind_def[THEN sym] exp_add[THEN sym])
-apply(simp only: numeral_2_eq_2, simp add: exp_ind_def)
-done
-
-lemma tutm_uhalt:
- "\<lbrakk>turing_basic.t_correct tp;
- \<forall> stp. (\<not> TSTD (steps (Suc 0, Bk\<^bsup>l\<^esup>, <args>) tp stp))\<rbrakk>
- \<Longrightarrow> \<forall> stp. \<not> isS0 (steps (Suc 0, Bk\<^bsup>m\<^esup>, <[code tp, bl2wc (<args>)]> @ Bk\<^bsup>n\<^esup>) t_utm stp)"
-apply(rule_tac tape_normalize)
-apply(rule_tac tutm_uhalt', simp_all)
-done
-
-lemma UTM_uhalt_lemma_pre:
- "\<lbrakk>turing_basic.t_correct tp;
- \<forall> stp. (\<not> TSTD (steps (Suc 0, Bk\<^bsup>l\<^esup>, <args>) tp stp));
- args \<noteq> []\<rbrakk>
- \<Longrightarrow> \<forall> stp. \<not> isS0 (steps (Suc 0, [], <code tp # args>) UTM_pre stp)"
-proof -
- let ?P1 = "\<lambda> (l, r). l = [] \<and> r = <code tp # args>"
- let ?Q1 = "\<lambda> (l, r). (l = [Bk] \<and>
- (\<exists> rn. r = Oc\<^bsup>Suc (code tp)\<^esup> @ Bk # Oc\<^bsup>Suc (bl_bin (<args>))\<^esup> @ Bk\<^bsup>rn\<^esup>))"
- let ?P4 = ?Q1
- let ?P3 = "\<lambda> (l, r). False"
- assume h: "turing_basic.t_correct tp" "\<forall>stp. \<not> TSTD (steps (Suc 0, Bk\<^bsup>l\<^esup>, <args>) tp stp)"
- "args \<noteq> []"
- have "?P1 \<turnstile>-> \<lambda> tp. \<not> (\<exists> stp. isS0 (steps (Suc 0, tp) (t_wcode |+| t_utm) stp))"
- proof(rule_tac turing_merge.t_merge_uhalt [of "t_wcode" "t_utm"
- ?P1 ?P3 ?P3 ?P4 ?Q1 ?P3], auto simp: turing_merge_def)
- show "\<exists>stp. case steps (Suc 0, [], <code tp # args>) t_wcode stp of (st, tp') \<Rightarrow>
- st = 0 \<and> (case tp' of (l, r) \<Rightarrow> l = [Bk] \<and>
- (\<exists>rn. r = Oc\<^bsup>Suc (code tp)\<^esup> @ Bk # Oc\<^bsup>Suc (bl_bin (<args>))\<^esup> @ Bk\<^bsup>rn\<^esup>))"
- using wcode_lemma_1[of args "code tp"] h
- apply(simp, auto)
- apply(rule_tac x = stp in exI, auto)
- done
- next
- fix rn stp
- show " isS0 (steps (Suc 0, [Bk], Oc\<^bsup>Suc (code tp)\<^esup> @ Bk # Oc\<^bsup>Suc (bl_bin (<args>))\<^esup> @ Bk\<^bsup>rn\<^esup>) t_utm stp)
- \<Longrightarrow> False"
- using tutm_uhalt[of tp l args "Suc 0" rn] h
- apply(simp)
- apply(erule_tac x = stp in allE)
- apply(simp add: tape_of_nl_abv tape_of_nat_list.simps bin_wc_eq)
- done
- next
- fix rn stp
- show "isS0 (steps (Suc 0, [Bk], Oc\<^bsup>Suc (code tp)\<^esup> @ Bk # Oc\<^bsup>Suc (bl_bin (<args>))\<^esup> @ Bk\<^bsup>rn\<^esup>) t_utm stp) \<Longrightarrow>
- isS0 (steps (Suc 0, [Bk], Oc\<^bsup>Suc (code tp)\<^esup> @ Bk # Oc\<^bsup>Suc (bl_bin (<args>))\<^esup> @ Bk\<^bsup>rn\<^esup>) t_utm stp)"
- by simp
- next
- show "?Q1 \<turnstile>-> ?P4"
- apply(simp add: t_imply_def)
- done
- qed
- thus "?thesis"
- apply(simp add: t_imply_def UTM_pre_def)
- done
-qed
-
-text {*
- The correctness of @{text "UTM"}, the unhalt case.
- *}
-
-lemma UTM_uhalt_lemma:
- "\<lbrakk>turing_basic.t_correct tp;
- \<forall> stp. (\<not> TSTD (steps (Suc 0, Bk\<^bsup>l\<^esup>, <args>) tp stp));
- args \<noteq> []\<rbrakk>
- \<Longrightarrow> \<forall> stp. \<not> isS0 (steps (Suc 0, [], <code tp # args>) UTM stp)"
-using UTM_uhalt_lemma_pre[of tp l args]
-apply(simp add: UTM_pre_def t_utm_def UTM_def F_aprog_def F_tprog_def)
-apply(case_tac "rec_ci rec_F", simp)
-done
-
-end
\ No newline at end of file
--- a/utm/abacus.thy Mon Mar 04 21:01:55 2013 +0000
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,6923 +0,0 @@
-header {*
- {\em abacus} a kind of register machine
-*}
-
-theory abacus
-imports Main turing_basic
-begin
-
-text {*
- {\em Abacus} instructions:
-*}
-
-datatype abc_inst =
- -- {* @{text "Inc n"} increments the memory cell (or register) with address @{text "n"} by one.
- *}
- Inc nat
- -- {*
- @{text "Dec n label"} decrements the memory cell with address @{text "n"} by one.
- If cell @{text "n"} is already zero, no decrements happens and the executio jumps to
- the instruction labeled by @{text "label"}.
- *}
- | Dec nat nat
- -- {*
- @{text "Goto label"} unconditionally jumps to the instruction labeled by @{text "label"}.
- *}
- | Goto nat
-
-
-text {*
- Abacus programs are defined as lists of Abacus instructions.
-*}
-type_synonym abc_prog = "abc_inst list"
-
-section {*
- Sample Abacus programs
- *}
-
-text {*
- Abacus for addition and clearance.
-*}
-fun plus_clear :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> abc_prog"
- where
- "plus_clear m n e = [Dec m e, Inc n, Goto 0]"
-
-text {*
- Abacus for clearing memory untis.
-*}
-fun clear :: "nat \<Rightarrow> nat \<Rightarrow> abc_prog"
- where
- "clear n e = [Dec n e, Goto 0]"
-
-fun plus:: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> abc_prog"
- where
- "plus m n p e = [Dec m 4, Inc n, Inc p,
- Goto 0, Dec p e, Inc m, Goto 4]"
-
-fun mult :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> abc_prog"
- where
- "mult m1 m2 n p e = [Dec m1 e]@ plus m1 m2 p 1"
-
-fun expo :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> abc_prog"
- where
- "expo n m1 m2 p e = [Inc n, Dec m1 e] @ mult m2 n n p 2"
-
-
-text {*
- The state of Abacus machine.
- *}
-type_synonym abc_state = nat
-
-(* text {*
- The memory of Abacus machine is defined as a function from address to contents.
-*}
-type_synonym abc_mem = "nat \<Rightarrow> nat" *)
-
-text {*
- The memory of Abacus machine is defined as a list of contents, with
- every units addressed by index into the list.
- *}
-type_synonym abc_lm = "nat list"
-
-text {*
- Fetching contents out of memory. Units not represented by list elements are considered
- as having content @{text "0"}.
-*}
-fun abc_lm_v :: "abc_lm \<Rightarrow> nat \<Rightarrow> nat"
- where
- "abc_lm_v lm n = (if (n < length lm) then (lm!n) else 0)"
-
-(*
-fun abc_l2m :: "abc_lm \<Rightarrow> abc_mem"
- where
- "abc_l2m lm = abc_lm_v lm"
-*)
-
-text {*
- Set the content of memory unit @{text "n"} to value @{text "v"}.
- @{text "am"} is the Abacus memory before setting.
- If address @{text "n"} is outside to scope of @{text "am"}, @{text "am"}
- is extended so that @{text "n"} becomes in scope.
-*}
-fun abc_lm_s :: "abc_lm \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> abc_lm"
- where
- "abc_lm_s am n v = (if (n < length am) then (am[n:=v]) else
- am@ (replicate (n - length am) 0) @ [v])"
-
-
-text {*
- The configuration of Abaucs machines consists of its current state and its
- current memory:
-*}
-type_synonym abc_conf_l = "abc_state \<times> abc_lm"
-
-text {*
- Fetch instruction out of Abacus program:
-*}
-
-fun abc_fetch :: "nat \<Rightarrow> abc_prog \<Rightarrow> abc_inst option"
- where
- "abc_fetch s p = (if (s < length p) then Some (p ! s)
- else None)"
-
-text {*
- Single step execution of Abacus machine. If no instruction is feteched,
- configuration does not change.
-*}
-fun abc_step_l :: "abc_conf_l \<Rightarrow> abc_inst option \<Rightarrow> abc_conf_l"
- where
- "abc_step_l (s, lm) a = (case a of
- None \<Rightarrow> (s, lm) |
- Some (Inc n) \<Rightarrow> (let nv = abc_lm_v lm n in
- (s + 1, abc_lm_s lm n (nv + 1))) |
- Some (Dec n e) \<Rightarrow> (let nv = abc_lm_v lm n in
- if (nv = 0) then (e, abc_lm_s lm n 0)
- else (s + 1, abc_lm_s lm n (nv - 1))) |
- Some (Goto n) \<Rightarrow> (n, lm)
- )"
-
-text {*
- Multi-step execution of Abacus machine.
-*}
-fun abc_steps_l :: "abc_conf_l \<Rightarrow> abc_prog \<Rightarrow> nat \<Rightarrow> abc_conf_l"
- where
- "abc_steps_l (s, lm) p 0 = (s, lm)" |
- "abc_steps_l (s, lm) p (Suc n) = abc_steps_l (abc_step_l (s, lm) (abc_fetch s p)) p n"
-
-section {*
- Compiling Abacus machines into Truing machines
-*}
-
-
-subsection {*
- Compiling functions
-*}
-
-text {*
- @{text "findnth n"} returns the TM which locates the represention of
- memory cell @{text "n"} on the tape and changes representation of zero
- on the way.
-*}
-
-fun findnth :: "nat \<Rightarrow> tprog"
- where
- "findnth 0 = []" |
- "findnth (Suc n) = (findnth n @ [(W1, 2 * n + 1),
- (R, 2 * n + 2), (R, 2 * n + 3), (R, 2 * n + 2)])"
-
-text {*
- @{text "tinc_b"} returns the TM which increments the representation
- of the memory cell under rw-head by one and move the representation
- of cells afterwards to the right accordingly.
- *}
-
-definition tinc_b :: "tprog"
- where
- "tinc_b \<equiv> [(W1, 1), (R, 2), (W1, 3), (R, 2), (W1, 3), (R, 4),
- (L, 7), (W0, 5), (R, 6), (W0, 5), (W1, 3), (R, 6),
- (L, 8), (L, 7), (R, 9), (L, 7), (R, 10), (W0, 9)]"
-
-text {*
- @{text "tshift tm off"} shifts @{text "tm"} by offset @{text "off"}, leaving
- instructions concerning state @{text "0"} unchanged, because state @{text "0"}
- is the end state, which needs not be changed with shift operation.
- *}
-
-fun tshift :: "tprog \<Rightarrow> nat \<Rightarrow> tprog"
- where
- "tshift tp off = (map (\<lambda> (action, state).
- (action, (if state = 0 then 0
- else state + off))) tp)"
-
-text {*
- @{text "tinc ss n"} returns the TM which simulates the execution of
- Abacus instruction @{text "Inc n"}, assuming that TM is located at
- location @{text "ss"} in the final TM complied from the whole
- Abacus program.
-*}
-
-fun tinc :: "nat \<Rightarrow> nat \<Rightarrow> tprog"
- where
- "tinc ss n = tshift (findnth n @ tshift tinc_b (2 * n)) (ss - 1)"
-
-text {*
- @{text "tinc_b"} returns the TM which decrements the representation
- of the memory cell under rw-head by one and move the representation
- of cells afterwards to the left accordingly.
- *}
-
-definition tdec_b :: "tprog"
- where
- "tdec_b \<equiv> [(W1, 1), (R, 2), (L, 14), (R, 3), (L, 4), (R, 3),
- (R, 5), (W0, 4), (R, 6), (W0, 5), (L, 7), (L, 8),
- (L, 11), (W0, 7), (W1, 8), (R, 9), (L, 10), (R, 9),
- (R, 5), (W0, 10), (L, 12), (L, 11), (R, 13), (L, 11),
- (R, 17), (W0, 13), (L, 15), (L, 14), (R, 16), (L, 14),
- (R, 0), (W0, 16)]"
-
-text {*
- @{text "sete tp e"} attaches the termination edges (edges leading to state @{text "0"})
- of TM @{text "tp"} to the intruction labelled by @{text "e"}.
- *}
-
-fun sete :: "tprog \<Rightarrow> nat \<Rightarrow> tprog"
- where
- "sete tp e = map (\<lambda> (action, state). (action, if state = 0 then e else state)) tp"
-
-text {*
- @{text "tdec ss n label"} returns the TM which simulates the execution of
- Abacus instruction @{text "Dec n label"}, assuming that TM is located at
- location @{text "ss"} in the final TM complied from the whole
- Abacus program.
-*}
-
-fun tdec :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> tprog"
- where
- "tdec ss n e = sete (tshift (findnth n @ tshift tdec_b (2 * n))
- (ss - 1)) e"
-
-text {*
- @{text "tgoto f(label)"} returns the TM simulating the execution of Abacus instruction
- @{text "Goto label"}, where @{text "f(label)"} is the corresponding location of
- @{text "label"} in the final TM compiled from the overall Abacus program.
-*}
-
-fun tgoto :: "nat \<Rightarrow> tprog"
- where
- "tgoto n = [(Nop, n), (Nop, n)]"
-
-text {*
- The layout of the final TM compiled from an Abacus program is represented
- as a list of natural numbers, where the list element at index @{text "n"} represents the
- starting state of the TM simulating the execution of @{text "n"}-th instruction
- in the Abacus program.
-*}
-
-type_synonym layout = "nat list"
-
-text {*
- @{text "length_of i"} is the length of the
- TM simulating the Abacus instruction @{text "i"}.
-*}
-fun length_of :: "abc_inst \<Rightarrow> nat"
- where
- "length_of i = (case i of
- Inc n \<Rightarrow> 2 * n + 9 |
- Dec n e \<Rightarrow> 2 * n + 16 |
- Goto n \<Rightarrow> 1)"
-
-text {*
- @{text "layout_of ap"} returns the layout of Abacus program @{text "ap"}.
-*}
-fun layout_of :: "abc_prog \<Rightarrow> layout"
- where "layout_of ap = map length_of ap"
-
-
-text {*
- @{text "start_of layout n"} looks out the starting state of @{text "n"}-th
- TM in the finall TM.
-*}
-
-fun start_of :: "nat list \<Rightarrow> nat \<Rightarrow> nat"
- where
- "start_of ly 0 = Suc 0" |
- "start_of ly (Suc as) =
- (if as < length ly then start_of ly as + (ly ! as)
- else start_of ly as)"
-
-text {*
- @{text "ci lo ss i"} complies Abacus instruction @{text "i"}
- assuming the TM of @{text "i"} starts from state @{text "ss"}
- within the overal layout @{text "lo"}.
-*}
-
-fun ci :: "layout \<Rightarrow> nat \<Rightarrow> abc_inst \<Rightarrow> tprog"
- where
- "ci ly ss i = (case i of
- Inc n \<Rightarrow> tinc ss n |
- Dec n e \<Rightarrow> tdec ss n (start_of ly e) |
- Goto n \<Rightarrow> tgoto (start_of ly n))"
-
-text {*
- @{text "tpairs_of ap"} transfroms Abacus program @{text "ap"} pairing
- every instruction with its starting state.
-*}
-fun tpairs_of :: "abc_prog \<Rightarrow> (nat \<times> abc_inst) list"
- where "tpairs_of ap = (zip (map (start_of (layout_of ap))
- [0..<(length ap)]) ap)"
-
-
-text {*
- @{text "tms_of ap"} returns the list of TMs, where every one of them simulates
- the corresponding Abacus intruction in @{text "ap"}.
-*}
-
-fun tms_of :: "abc_prog \<Rightarrow> tprog list"
- where "tms_of ap = map (\<lambda> (n, tm). ci (layout_of ap) n tm)
- (tpairs_of ap)"
-
-text {*
- @{text "tm_of ap"} returns the final TM machine compiled from Abacus program @{text "ap"}.
-*}
-fun tm_of :: "abc_prog \<Rightarrow> tprog"
- where "tm_of ap = concat (tms_of ap)"
-
-text {*
- The following two functions specify the well-formedness of complied TM.
-*}
-fun t_ncorrect :: "tprog \<Rightarrow> bool"
- where
- "t_ncorrect tp = (length tp mod 2 = 0)"
-
-fun abc2t_correct :: "abc_prog \<Rightarrow> bool"
- where
- "abc2t_correct ap = list_all (\<lambda> (n, tm).
- t_ncorrect (ci (layout_of ap) n tm)) (tpairs_of ap)"
-
-lemma findnth_length: "length (findnth n) div 2 = 2 * n"
-apply(induct n, simp, simp)
-done
-
-lemma ci_length : "length (ci ns n ai) div 2 = length_of ai"
-apply(auto simp: ci.simps tinc_b_def tdec_b_def findnth_length
- split: abc_inst.splits)
-done
-
-subsection {*
- Representation of Abacus memory by TM tape
-*}
-
-consts tape_of :: "'a \<Rightarrow> block list" ("<_>" 100)
-
-text {*
- @{text "tape_of_nat_list am"} returns the TM tape representing
- Abacus memory @{text "am"}.
- *}
-
-fun tape_of_nat_list :: "nat list \<Rightarrow> block list"
- where
- "tape_of_nat_list [] = []" |
- "tape_of_nat_list [n] = Oc\<^bsup>n+1\<^esup>" |
- "tape_of_nat_list (n#ns) = (Oc\<^bsup>n+1\<^esup>) @ [Bk] @ (tape_of_nat_list ns)"
-
-defs (overloaded)
- tape_of_nl_abv: "<am> \<equiv> tape_of_nat_list am"
- tape_of_nat_abv : "<(n::nat)> \<equiv> Oc\<^bsup>n+1\<^esup>"
-
-text {*
- @{text "crsp_l acf tcf"} meams the abacus configuration @{text "acf"}
- is corretly represented by the TM configuration @{text "tcf"}.
-*}
-
-fun crsp_l :: "layout \<Rightarrow> abc_conf_l \<Rightarrow> t_conf \<Rightarrow> block list \<Rightarrow> bool"
- where
- "crsp_l ly (as, lm) (ts, (l, r)) inres =
- (ts = start_of ly as \<and> (\<exists> rn. r = <lm> @ Bk\<^bsup>rn\<^esup>)
- \<and> l = Bk # Bk # inres)"
-
-declare crsp_l.simps[simp del]
-
-subsection {*
- A more general definition of TM execution.
-*}
-
-(*
-fun nnth_of :: "(taction \<times> nat) list \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> (taction \<times> nat)"
- where
- "nnth_of p s b = (if 2*s < length p
- then (p ! (2*s + b)) else (Nop, 0))"
-
-thm nth_of.simps
-
-fun nfetch :: "tprog \<Rightarrow> nat \<Rightarrow> block \<Rightarrow> taction \<times> nat"
- where
- "nfetch p 0 b = (Nop, 0)" |
- "nfetch p (Suc s) b =
- (case b of
- Bk \<Rightarrow> nnth_of p s 0 |
- Oc \<Rightarrow> nnth_of p s 1)"
-*)
-
-text {*
- @{text "t_step tcf (tp, ss)"} returns the result of one step exection of TM @{text "tp"}
- assuming @{text "tp"} starts from instial state @{text "ss"}.
-*}
-
-fun t_step :: "t_conf \<Rightarrow> (tprog \<times> nat) \<Rightarrow> t_conf"
- where
- "t_step c (p, off) =
- (let (state, leftn, rightn) = c in
- let (action, next_state) = fetch p (state-off)
- (case rightn of
- [] \<Rightarrow> Bk |
- Bk # xs \<Rightarrow> Bk |
- Oc # xs \<Rightarrow> Oc
- )
- in
- (next_state, new_tape action (leftn, rightn)))"
-
-
-text {*
- @{text "t_steps tcf (tp, ss) n"} returns the result of @{text "n"}-step exection
- of TM @{text "tp"} assuming @{text "tp"} starts from instial state @{text "ss"}.
-*}
-
-fun t_steps :: "t_conf \<Rightarrow> (tprog \<times> nat) \<Rightarrow> nat \<Rightarrow> t_conf"
- where
- "t_steps c (p, off) 0 = c" |
- "t_steps c (p, off) (Suc n) = t_steps
- (t_step c (p, off)) (p, off) n"
-
-lemma stepn: "t_steps c (p, off) (Suc n) =
- t_step (t_steps c (p, off) n) (p, off)"
-apply(induct n arbitrary: c, simp add: t_steps.simps)
-apply(simp add: t_steps.simps)
-done
-
-text {*
- The type of invarints expressing correspondence between
- Abacus configuration and TM configuration.
-*}
-
-type_synonym inc_inv_t = "abc_conf_l \<Rightarrow> t_conf \<Rightarrow> block list \<Rightarrow> bool"
-
-declare tms_of.simps[simp del] tm_of.simps[simp del]
- layout_of.simps[simp del] abc_fetch.simps [simp del]
- t_step.simps[simp del] t_steps.simps[simp del]
- tpairs_of.simps[simp del] start_of.simps[simp del]
- fetch.simps [simp del] t_ncorrect.simps[simp del]
- new_tape.simps [simp del] ci.simps [simp del] length_of.simps[simp del]
- layout_of.simps[simp del] crsp_l.simps[simp del]
- abc2t_correct.simps[simp del]
-
-lemma tct_div2: "t_ncorrect tp \<Longrightarrow> (length tp) mod 2 = 0"
-apply(simp add: t_ncorrect.simps)
-done
-
-lemma t_shift_fetch:
- "\<lbrakk>t_ncorrect tp1; t_ncorrect tp;
- length tp1 div 2 < a \<and> a \<le> length tp1 div 2 + length tp div 2\<rbrakk>
- \<Longrightarrow> fetch tp (a - length tp1 div 2) b =
- fetch (tp1 @ tp @ tp2) a b"
-apply(subgoal_tac "\<exists> x. a = length tp1 div 2 + x", erule exE, simp)
-apply(case_tac x, simp)
-apply(subgoal_tac "length tp1 div 2 + Suc nat =
- Suc (length tp1 div 2 + nat)")
-apply(simp only: fetch.simps nth_of.simps, auto)
-apply(case_tac b, simp)
-apply(subgoal_tac "2 * (length tp1 div 2) = length tp1", simp)
-apply(subgoal_tac "2 * nat < length tp", simp add: nth_append, simp)
-apply(simp add: t_ncorrect.simps, auto)
-apply(subgoal_tac "2 * (length tp1 div 2) = length tp1", simp)
-apply(subgoal_tac "2 * nat < length tp", simp add: nth_append, auto)
-apply(simp add: t_ncorrect.simps, auto)
-apply(rule_tac x = "a - length tp1 div 2" in exI, simp)
-done
-
-lemma t_shift_in_step:
- "\<lbrakk>t_step (a, aa, ba) (tp, length tp1 div 2) = (s, l, r);
- t_ncorrect tp1; t_ncorrect tp;
- length tp1 div 2 < a \<and> a \<le> length tp1 div 2 + length tp div 2\<rbrakk>
- \<Longrightarrow> t_step (a, aa, ba) (tp1 @ tp @ tp2, 0) = (s, l, r)"
-apply(simp add: t_step.simps)
-apply(subgoal_tac "fetch tp (a - length tp1 div 2) (case ba of [] \<Rightarrow>
- Bk | x # xs \<Rightarrow> x)
- = fetch (tp1 @ tp @ tp2) a (case ba of [] \<Rightarrow> Bk | x # xs
- \<Rightarrow> x)")
-apply(case_tac "fetch tp (a - length tp1 div 2) (case ba of [] \<Rightarrow> Bk
- | x # xs \<Rightarrow> x)")
-apply(auto intro: t_shift_fetch)
-apply(case_tac ba, simp, simp)
-apply(case_tac aaa, simp, simp)
-done
-
-declare add_Suc_right[simp del]
-lemma t_step_add: "t_steps c (p, off) (m + n) =
- t_steps (t_steps c (p, off) m) (p, off) n"
-apply(induct m arbitrary: n, simp add: t_steps.simps, simp)
-apply(subgoal_tac "t_steps c (p, off) (Suc (m + n)) =
- t_steps c (p, off) (m + Suc n)", simp)
-apply(subgoal_tac "t_steps (t_steps c (p, off) m) (p, off) (Suc n) =
- t_steps (t_step (t_steps c (p, off) m) (p, off))
- (p, off) n")
-apply(simp, simp add: stepn)
-apply(simp only: t_steps.simps)
-apply(simp only: add_Suc_right)
-done
-declare add_Suc_right[simp]
-
-lemma s_out_fetch: "\<lbrakk>t_ncorrect tp;
- \<not> (length tp1 div 2 < a \<and> a \<le> length tp1 div 2 +
- length tp div 2)\<rbrakk>
- \<Longrightarrow> fetch tp (a - length tp1 div 2) b = (Nop, 0)"
-apply(auto)
-apply(simp add: fetch.simps)
-apply(subgoal_tac "\<exists> x. a - length tp1 div 2 = length tp div 2 + x")
-apply(erule exE, simp)
-apply(case_tac x, simp)
-apply(auto simp add: fetch.simps)
-apply(subgoal_tac "2 * (length tp div 2) = length tp")
-apply(auto simp: t_ncorrect.simps split: block.splits)
-apply(rule_tac x = "a - length tp1 div 2 - length tp div 2" in exI
- , simp)
-done
-
-lemma conf_keep_step:
- "\<lbrakk>t_ncorrect tp;
- \<not> (length tp1 div 2 < a \<and> a \<le> length tp1 div 2 +
- length tp div 2)\<rbrakk>
- \<Longrightarrow> t_step (a, aa, ba) (tp, length tp1 div 2) = (0, aa, ba)"
-apply(simp add: t_step.simps)
-apply(subgoal_tac "fetch tp (a - length tp1 div 2) (case ba of [] \<Rightarrow>
- Bk | Bk # xs \<Rightarrow> Bk | Oc # xs \<Rightarrow> Oc) = (Nop, 0)")
-apply(simp add: new_tape.simps)
-apply(rule s_out_fetch, simp, simp)
-done
-
-lemma conf_keep:
- "\<lbrakk>t_ncorrect tp;
- \<not> (length tp1 div 2 < a \<and>
- a \<le> length tp1 div 2 + length tp div 2); n > 0\<rbrakk>
- \<Longrightarrow> t_steps (a, aa, ba) (tp, length tp1 div 2) n = (0, aa, ba)"
-apply(induct n, simp)
-apply(case_tac n, simp add: t_steps.simps)
-apply(rule_tac conf_keep_step, simp+)
-apply(subgoal_tac " t_steps (a, aa, ba)
- (tp, length tp1 div 2) (Suc (Suc nat))
- = t_step (t_steps (a, aa, ba)
- (tp, length tp1 div 2) (Suc nat)) (tp, length tp1 div 2)")
-apply(simp)
-apply(rule_tac conf_keep_step, simp, simp)
-apply(rule stepn)
-done
-
-lemma state_bef_inside:
- "\<lbrakk>t_ncorrect tp1; t_ncorrect tp;
- t_steps (s0, l0, r0) (tp, length tp1 div 2) stp = (s, l, r);
- length tp1 div 2 < s0 \<and>
- s0 \<le> length tp1 div 2 + length tp div 2;
- length tp1 div 2 < s \<and> s \<le> length tp1 div 2 + length tp div 2;
- n < stp; t_steps (s0, l0, r0) (tp, length tp1 div 2) n =
- (a, aa, ba)\<rbrakk>
- \<Longrightarrow> length tp1 div 2 < a \<and>
- a \<le> length tp1 div 2 + length tp div 2"
-apply(subgoal_tac "\<exists> x. stp = n + x", erule exE)
-apply(simp only: t_step_add)
-apply(rule classical)
-apply(subgoal_tac "t_steps (a, aa, ba)
- (tp, length tp1 div 2) x = (0, aa, ba)")
-apply(simp)
-apply(rule conf_keep, simp, simp, simp)
-apply(rule_tac x = "stp - n" in exI, simp)
-done
-
-lemma turing_shift_inside:
- "\<lbrakk>t_steps (s0, l0, r0) (tp, length tp1 div 2) stp = (s, l, r);
- length tp1 div 2 < s0 \<and>
- s0 \<le> length tp1 div 2 + length tp div 2;
- t_ncorrect tp1; t_ncorrect tp;
- length tp1 div 2 < s \<and>
- s \<le> length tp1 div 2 + length tp div 2\<rbrakk>
- \<Longrightarrow> t_steps (s0, l0, r0) (tp1 @ tp @ tp2, 0) stp = (s, l, r)"
-apply(induct stp arbitrary: s l r)
-apply(simp add: t_steps.simps)
-apply(subgoal_tac " t_steps (s0, l0, r0)
- (tp, length tp1 div 2) (Suc stp)
- = t_step (t_steps (s0, l0, r0)
- (tp, length tp1 div 2) stp) (tp, length tp1 div 2)")
-apply(case_tac "t_steps (s0, l0, r0) (tp, length tp1 div 2) stp")
-apply(subgoal_tac "length tp1 div 2 < a \<and>
- a \<le> length tp1 div 2 + length tp div 2")
-apply(subgoal_tac "t_steps (s0, l0, r0)
- (tp1 @ tp @ tp2, 0) stp = (a, b, c)")
-apply(simp only: stepn, simp)
-apply(rule_tac t_shift_in_step, simp+)
-defer
-apply(rule stepn)
-apply(rule_tac n = stp and stp = "Suc stp" and a = a
- and aa = b and ba = c in state_bef_inside, simp+)
-done
-
-lemma take_Suc_last[elim]: "Suc as \<le> length xs \<Longrightarrow>
- take (Suc as) xs = take as xs @ [xs ! as]"
-apply(induct xs arbitrary: as, simp, simp)
-apply(case_tac as, simp, simp)
-done
-
-lemma concat_suc: "Suc as \<le> length xs \<Longrightarrow>
- concat (take (Suc as) xs) = concat (take as xs) @ xs! as"
-apply(subgoal_tac "take (Suc as) xs = take as xs @ [xs ! as]", simp)
-by auto
-
-lemma concat_take_suc_iff: "Suc n \<le> length tps \<Longrightarrow>
- concat (take n tps) @ (tps ! n) = concat (take (Suc n) tps)"
-apply(drule_tac concat_suc, simp)
-done
-
-lemma concat_drop_suc_iff:
- "Suc n < length tps \<Longrightarrow> concat (drop (Suc n) tps) =
- tps ! Suc n @ concat (drop (Suc (Suc n)) tps)"
-apply(induct tps arbitrary: n, simp, simp)
-apply(case_tac tps, simp, simp)
-apply(case_tac n, simp, simp)
-done
-
-declare append_assoc[simp del]
-
-lemma tm_append: "\<lbrakk>n < length tps; tp = tps ! n\<rbrakk> \<Longrightarrow>
- \<exists> tp1 tp2. concat tps = tp1 @ tp @ tp2 \<and> tp1 =
- concat (take n tps) \<and> tp2 = concat (drop (Suc n) tps)"
-apply(rule_tac x = "concat (take n tps)" in exI)
-apply(rule_tac x = "concat (drop (Suc n) tps)" in exI)
-apply(auto)
-apply(induct n, simp)
-apply(case_tac tps, simp, simp, simp)
-apply(subgoal_tac "concat (take n tps) @ (tps ! n) =
- concat (take (Suc n) tps)")
-apply(simp only: append_assoc[THEN sym], simp only: append_assoc)
-apply(subgoal_tac " concat (drop (Suc n) tps) = tps ! Suc n @
- concat (drop (Suc (Suc n)) tps)", simp)
-apply(rule_tac concat_drop_suc_iff, simp)
-apply(rule_tac concat_take_suc_iff, simp)
-done
-
-declare append_assoc[simp]
-
-lemma map_of: "n < length xs \<Longrightarrow> (map f xs) ! n = f (xs ! n)"
-by(auto)
-
-lemma [simp]: "length (tms_of aprog) = length aprog"
-apply(auto simp: tms_of.simps tpairs_of.simps)
-done
-
-lemma ci_nth: "\<lbrakk>ly = layout_of aprog; as < length aprog;
- abc_fetch as aprog = Some ins\<rbrakk>
- \<Longrightarrow> ci ly (start_of ly as) ins = tms_of aprog ! as"
-apply(simp add: tms_of.simps tpairs_of.simps
- abc_fetch.simps map_of del: map_append)
-done
-
-lemma t_split:"\<lbrakk>
- ly = layout_of aprog;
- as < length aprog; abc_fetch as aprog = Some ins\<rbrakk>
- \<Longrightarrow> \<exists> tp1 tp2. concat (tms_of aprog) =
- tp1 @ (ci ly (start_of ly as) ins) @ tp2
- \<and> tp1 = concat (take as (tms_of aprog)) \<and>
- tp2 = concat (drop (Suc as) (tms_of aprog))"
-apply(insert tm_append[of "as" "tms_of aprog"
- "ci ly (start_of ly as) ins"], simp)
-apply(subgoal_tac "ci ly (start_of ly as) ins = (tms_of aprog) ! as")
-apply(subgoal_tac "length (tms_of aprog) = length aprog", simp, simp)
-apply(rule_tac ci_nth, auto)
-done
-
-lemma math_sub: "\<lbrakk>x >= Suc 0; x - 1 = z\<rbrakk> \<Longrightarrow> x + y - Suc 0 = z + y"
-by auto
-
-lemma start_more_one: "as \<noteq> 0 \<Longrightarrow> start_of ly as >= Suc 0"
-apply(induct as, simp add: start_of.simps)
-apply(case_tac as, auto simp: start_of.simps)
-done
-
-lemma tm_ct: "\<lbrakk>abc2t_correct aprog; tp \<in> set (tms_of aprog)\<rbrakk> \<Longrightarrow>
- t_ncorrect tp"
-apply(simp add: abc2t_correct.simps tms_of.simps)
-apply(auto)
-apply(simp add:list_all_iff, auto)
-done
-
-lemma div_apart: "\<lbrakk>x mod (2::nat) = 0; y mod 2 = 0\<rbrakk>
- \<Longrightarrow> (x + y) div 2 = x div 2 + y div 2"
-apply(drule mod_eqD)+
-apply(auto)
-done
-
-lemma div_apart_iff: "\<lbrakk>x mod (2::nat) = 0; y mod 2 = 0\<rbrakk> \<Longrightarrow>
- (x + y) mod 2 = 0"
-apply(auto)
-done
-
-lemma tms_ct: "\<lbrakk>abc2t_correct aprog; n < length aprog\<rbrakk> \<Longrightarrow>
- t_ncorrect (concat (take n (tms_of aprog)))"
-apply(induct n, simp add: t_ncorrect.simps, simp)
-apply(subgoal_tac "concat (take (Suc n) (tms_of aprog)) =
- concat (take n (tms_of aprog)) @ (tms_of aprog ! n)", simp)
-apply(simp add: t_ncorrect.simps)
-apply(rule_tac div_apart_iff, simp)
-apply(subgoal_tac "t_ncorrect (tms_of aprog ! n)",
- simp add: t_ncorrect.simps)
-apply(rule_tac tm_ct, simp)
-apply(rule_tac nth_mem, simp add: tms_of.simps tpairs_of.simps)
-apply(rule_tac concat_suc, simp add: tms_of.simps tpairs_of.simps)
-done
-
-lemma tcorrect_div2: "\<lbrakk>abc2t_correct aprog; Suc as < length aprog\<rbrakk>
- \<Longrightarrow> (length (concat (take as (tms_of aprog))) + length (tms_of aprog
- ! as)) div 2 = length (concat (take as (tms_of aprog))) div 2 +
- length (tms_of aprog ! as) div 2"
-apply(subgoal_tac "t_ncorrect (tms_of aprog ! as)")
-apply(subgoal_tac "t_ncorrect (concat (take as (tms_of aprog)))")
-apply(rule_tac div_apart)
-apply(rule tct_div2, simp)+
-apply(erule_tac tms_ct, simp)
-apply(rule_tac tm_ct, simp)
-apply(rule_tac nth_mem)
-apply(simp add: tms_of.simps tpairs_of.simps)
-done
-
-lemma [simp]: "length (layout_of aprog) = length aprog"
-apply(auto simp: layout_of.simps)
-done
-
-lemma start_of_ind: "\<lbrakk>as < length aprog; ly = layout_of aprog\<rbrakk> \<Longrightarrow>
- start_of ly (Suc as) = start_of ly as +
- length ((tms_of aprog) ! as) div 2"
-apply(simp only: start_of.simps, simp)
-apply(auto simp: start_of.simps tms_of.simps layout_of.simps
- tpairs_of.simps)
-apply(simp add: ci_length)
-done
-
-lemma concat_take_suc: "Suc n \<le> length xs \<Longrightarrow>
- concat (take (Suc n) xs) = concat (take n xs) @ (xs ! n)"
-apply(subgoal_tac "take (Suc n) xs =
- take n xs @ [xs ! n]")
-apply(auto)
-done
-
-lemma ci_length_not0: "Suc 0 <= length (ci ly as i) div 2"
-apply(subgoal_tac "length (ci ly as i) div 2 = length_of i")
-apply(simp add: length_of.simps split: abc_inst.splits)
-apply(rule ci_length)
-done
-
-lemma findnth_length2: "length (findnth n) = 4 * n"
-apply(induct n, simp)
-apply(simp)
-done
-
-lemma ci_length2: "length (ci ly as i) = 2 * (length_of i)"
-apply(simp add: ci.simps length_of.simps tinc_b_def tdec_b_def
- split: abc_inst.splits, auto)
-apply(simp add: findnth_length2)+
-done
-
-lemma tm_mod2: "as < length aprog \<Longrightarrow>
- length (tms_of aprog ! as) mod 2 = 0"
-apply(simp add: tms_of.simps)
-apply(subgoal_tac "map (\<lambda>(x, y). ci (layout_of aprog) x y)
- (tpairs_of aprog) ! as
- = (\<lambda>(x, y). ci (layout_of aprog) x y)
- ((tpairs_of aprog) ! as)", simp)
-apply(case_tac "(tpairs_of aprog ! as)", simp)
-apply(subgoal_tac "length (ci (layout_of aprog) a b) =
- 2 * (length_of b)", simp)
-apply(rule ci_length2)
-apply(rule map_of, simp add: tms_of.simps tpairs_of.simps)
-done
-
-lemma tms_mod2: "as \<le> length aprog \<Longrightarrow>
- length (concat (take as (tms_of aprog))) mod 2 = 0"
-apply(induct as, simp, simp)
-apply(subgoal_tac "concat (take (Suc as) (tms_of aprog))
- = concat (take as (tms_of aprog)) @
- (tms_of aprog ! as)", auto)
-apply(rule div_apart_iff, simp, rule tm_mod2, simp)
-apply(rule concat_take_suc, simp add: tms_of.simps tpairs_of.simps)
-done
-
-lemma [simp]: "\<lbrakk>as < length aprog; (abc_fetch as aprog) = Some ins\<rbrakk>
- \<Longrightarrow> ci (layout_of aprog)
- (start_of (layout_of aprog) as) (ins) \<in> set (tms_of aprog)"
-apply(insert ci_nth[of "layout_of aprog" aprog as], simp)
-done
-
-lemma startof_not0: "start_of ly as > 0"
-apply(induct as, simp add: start_of.simps)
-apply(case_tac as, auto simp: start_of.simps)
-done
-
-declare abc_step_l.simps[simp del]
-lemma pre_lheq: "\<lbrakk>tp = concat (take as (tms_of aprog));
- abc2t_correct aprog; as \<le> length aprog\<rbrakk> \<Longrightarrow>
- start_of (layout_of aprog) as - Suc 0 = length tp div 2"
-apply(induct as arbitrary: tp, simp add: start_of.simps, simp)
-proof -
- fix as tp
- assume h1: "\<And>tp. tp = concat (take as (tms_of aprog)) \<Longrightarrow>
- start_of (layout_of aprog) as - Suc 0 =
- length (concat (take as (tms_of aprog))) div 2"
- and h2: " abc2t_correct aprog" "Suc as \<le> length aprog"
- from h2 show "start_of (layout_of aprog) (Suc as) - Suc 0 =
- length (concat (take (Suc as) (tms_of aprog))) div 2"
- apply(insert h1[of "concat (take as (tms_of aprog))"], simp)
- apply(insert start_of_ind[of as aprog "layout_of aprog"], simp)
- apply(subgoal_tac "(take (Suc as) (tms_of aprog)) =
- take as (tms_of aprog) @ [(tms_of aprog) ! as]", simp)
- apply(subgoal_tac "(length (concat (take as (tms_of aprog))) +
- length (tms_of aprog ! as)) div 2
- = length (concat (take as (tms_of aprog))) div 2 +
- length (tms_of aprog ! as) div 2", simp)
- apply(subgoal_tac "start_of (layout_of aprog) as =
- length (concat (take as (tms_of aprog))) div 2 + Suc 0", simp)
- apply(subgoal_tac "start_of (layout_of aprog) as > 0", simp,
- rule_tac startof_not0)
- apply(insert tm_mod2[of as aprog], simp)
- apply(insert tms_mod2[of as aprog], simp, arith)
- apply(rule take_Suc_last, simp)
- done
-qed
-
-lemma crsp2stateq:
- "\<lbrakk>as < length aprog; abc2t_correct aprog;
- crsp_l (layout_of aprog) (as, am) (a, aa, ba) inres\<rbrakk> \<Longrightarrow>
- a = length (concat (take as (tms_of aprog))) div 2 + 1"
-apply(simp add: crsp_l.simps)
-apply(insert pre_lheq[of "(concat (take as (tms_of aprog)))" as aprog]
-, simp)
-apply(subgoal_tac "start_of (layout_of aprog) as > 0",
- auto intro: startof_not0)
-done
-
-lemma turing_shift_outside:
- "\<lbrakk>t_steps (s0, l0, r0) (tp, length tp1 div 2) stp = (s, l, r);
- s \<noteq> 0; stp > 0;
- length tp1 div 2 < s0 \<and>
- s0 \<le> length tp1 div 2 + length tp div 2;
- t_ncorrect tp1; t_ncorrect tp;
- \<not> (length tp1 div 2 < s \<and>
- s \<le> length tp1 div 2 + length tp div 2)\<rbrakk>
- \<Longrightarrow> \<exists>stp' > 0. t_steps (s0, l0, r0) (tp1 @ tp @ tp2, 0) stp'
- = (s, l, r)"
-apply(rule_tac x = stp in exI)
-apply(case_tac stp, simp add: t_steps.simps)
-apply(simp only: stepn)
-apply(case_tac "t_steps (s0, l0, r0) (tp, length tp1 div 2) nat")
-apply(subgoal_tac "length tp1 div 2 < a \<and>
- a \<le> length tp1 div 2 + length tp div 2")
-apply(subgoal_tac "t_steps (s0, l0, r0) (tp1 @ tp @ tp2, 0) nat
- = (a, b, c)", simp)
-apply(rule_tac t_shift_in_step, simp+)
-apply(rule_tac turing_shift_inside, simp+)
-apply(rule classical)
-apply(subgoal_tac "t_step (a,b,c)
- (tp, length tp1 div 2) = (0, b, c)", simp)
-apply(rule_tac conf_keep_step, simp+)
-done
-
-lemma turing_shift:
- "\<lbrakk>t_steps (s0, (l0, r0)) (tp, (length tp1 div 2)) stp
- = (s, (l, r)); s \<noteq> 0; stp > 0;
- (length tp1 div 2 < s0 \<and> s0 <= length tp1 div 2 + length tp div 2);
- t_ncorrect tp1; t_ncorrect tp\<rbrakk> \<Longrightarrow>
- \<exists> stp' > 0. t_steps (s0, (l0, r0)) (tp1 @ tp @ tp2, 0) stp' =
- (s, (l, r))"
-apply(case_tac "s > length tp1 div 2 \<and>
- s <= length tp1 div 2 + length tp div 2")
-apply(subgoal_tac " t_steps (s0, l0, r0) (tp1 @ tp @ tp2, 0) stp =
- (s, l, r)")
-apply(rule_tac x = stp in exI, simp)
-apply(rule_tac turing_shift_inside, simp+)
-apply(rule_tac turing_shift_outside, simp+)
-done
-
-lemma inc_startof_not0: "start_of ly as \<ge> Suc 0"
-apply(induct as, simp add: start_of.simps)
-apply(simp add: start_of.simps)
-done
-
-lemma s_crsp:
- "\<lbrakk>as < length aprog; abc_fetch as aprog = Some ins;
- abc2t_correct aprog;
- crsp_l (layout_of aprog) (as, am) (a, aa, ba) inres\<rbrakk> \<Longrightarrow>
- length (concat (take as (tms_of aprog))) div 2 < a
- \<and> a \<le> length (concat (take as (tms_of aprog))) div 2 +
- length (ci (layout_of aprog) (start_of (layout_of aprog) as)
- ins) div 2"
-apply(subgoal_tac "a = length (concat (take as (tms_of aprog))) div
- 2 + 1", simp)
-apply(rule_tac ci_length_not0)
-apply(rule crsp2stateq, simp+)
-done
-
-lemma tms_out_ex:
- "\<lbrakk>ly = layout_of aprog; tprog = tm_of aprog;
- abc2t_correct aprog;
- crsp_l ly (as, am) tc inres; as < length aprog;
- abc_fetch as aprog = Some ins;
- t_steps tc (ci ly (start_of ly as) ins,
- (start_of ly as) - 1) n = (s, l, r);
- n > 0;
- abc_step_l (as, am) (abc_fetch as aprog) = (as', am');
- s = start_of ly as'
- \<rbrakk>
- \<Longrightarrow> \<exists> stp > 0. (t_steps tc (tprog, 0) stp = (s, (l, r)))"
-apply(simp only: tm_of.simps)
-apply(subgoal_tac "\<exists> tp1 tp2. concat (tms_of aprog) =
- tp1 @ (ci ly (start_of ly as) ins) @ tp2
- \<and> tp1 = concat (take as (tms_of aprog)) \<and>
- tp2 = concat (drop (Suc as) (tms_of aprog))")
-apply(erule exE, erule exE, erule conjE, erule conjE,
- case_tac tc, simp)
-apply(rule turing_shift)
-apply(subgoal_tac "start_of (layout_of aprog) as - Suc 0
- = length tp1 div 2", simp)
-apply(rule_tac pre_lheq, simp, simp, simp)
-apply(simp add: startof_not0, simp)
-apply(rule_tac s_crsp, simp, simp, simp, simp)
-apply(rule tms_ct, simp, simp)
-apply(rule tm_ct, simp)
-apply(subgoal_tac "ci (layout_of aprog)
- (start_of (layout_of aprog) as) ins
- = (tms_of aprog ! as)", simp)
-apply(simp add: tms_of.simps tpairs_of.simps)
-apply(simp add: tms_of.simps tpairs_of.simps abc_fetch.simps)
-apply(erule_tac t_split, auto simp: tm_of.simps)
-done
-
-(*
-subsection {* The compilation of @{text "Inc n"} *}
-*)
-
-text {*
- The lemmas in this section lead to the correctness of
- the compilation of @{text "Inc n"} instruction.
-*}
-
-fun at_begin_fst_bwtn :: "inc_inv_t"
- where
- "at_begin_fst_bwtn (as, lm) (s, l, r) ires =
- (\<exists> lm1 tn rn. lm1 = (lm @ (0\<^bsup>tn\<^esup>)) \<and> length lm1 = s \<and>
- (if lm1 = [] then l = Bk # Bk # ires
- else l = [Bk]@<rev lm1>@Bk#Bk#ires) \<and> r = (Bk\<^bsup>rn\<^esup>))"
-
-
-fun at_begin_fst_awtn :: "inc_inv_t"
- where
- "at_begin_fst_awtn (as, lm) (s, l, r) ires =
- (\<exists> lm1 tn rn. lm1 = (lm @ (0\<^bsup>tn\<^esup>)) \<and> length lm1 = s \<and>
- (if lm1 = [] then l = Bk # Bk # ires
- else l = [Bk]@<rev lm1>@Bk#Bk#ires) \<and> r = [Oc]@Bk\<^bsup>rn\<^esup>
- )"
-
-fun at_begin_norm :: "inc_inv_t"
- where
- "at_begin_norm (as, lm) (s, l, r) ires=
- (\<exists> lm1 lm2 rn. lm = lm1 @ lm2 \<and> length lm1 = s \<and>
- (if lm1 = [] then l = Bk # Bk # ires
- else l = Bk # <rev lm1> @ Bk# Bk # ires ) \<and> r = <lm2> @ (Bk\<^bsup>rn\<^esup>))"
-
-fun in_middle :: "inc_inv_t"
- where
- "in_middle (as, lm) (s, l, r) ires =
- (\<exists> lm1 lm2 tn m ml mr rn. lm @ 0\<^bsup>tn\<^esup> = lm1 @ [m] @ lm2
- \<and> length lm1 = s \<and> m + 1 = ml + mr \<and>
- ml \<noteq> 0 \<and> tn = s + 1 - length lm \<and>
- (if lm1 = [] then l = Oc\<^bsup>ml\<^esup> @ Bk # Bk # ires
- else l = (Oc\<^bsup>ml\<^esup>)@[Bk]@<rev lm1>@
- Bk # Bk # ires) \<and> (r = (Oc\<^bsup>mr\<^esup>) @ [Bk] @ <lm2>@ (Bk\<^bsup>rn\<^esup>) \<or>
- (lm2 = [] \<and> r = (Oc\<^bsup>mr\<^esup>)))
- )"
-
-fun inv_locate_a :: "inc_inv_t"
- where "inv_locate_a (as, lm) (s, l, r) ires =
- (at_begin_norm (as, lm) (s, l, r) ires \<or>
- at_begin_fst_bwtn (as, lm) (s, l, r) ires \<or>
- at_begin_fst_awtn (as, lm) (s, l, r) ires
- )"
-
-fun inv_locate_b :: "inc_inv_t"
- where "inv_locate_b (as, lm) (s, l, r) ires =
- (in_middle (as, lm) (s, l, r)) ires "
-
-fun inv_after_write :: "inc_inv_t"
- where "inv_after_write (as, lm) (s, l, r) ires =
- (\<exists> rn m lm1 lm2. lm = lm1 @ m # lm2 \<and>
- (if lm1 = [] then l = Oc\<^bsup>m\<^esup> @ Bk # Bk # ires
- else Oc # l = Oc\<^bsup>Suc m \<^esup>@ Bk # <rev lm1> @
- Bk # Bk # ires) \<and> r = [Oc] @ <lm2> @ (Bk\<^bsup>rn\<^esup>))"
-
-fun inv_after_move :: "inc_inv_t"
- where "inv_after_move (as, lm) (s, l, r) ires =
- (\<exists> rn m lm1 lm2. lm = lm1 @ m # lm2 \<and>
- (if lm1 = [] then l = Oc\<^bsup>Suc m\<^esup> @ Bk # Bk # ires
- else l = Oc\<^bsup>Suc m\<^esup>@ Bk # <rev lm1> @ Bk # Bk # ires) \<and>
- r = <lm2> @ (Bk\<^bsup>rn\<^esup>))"
-
-fun inv_after_clear :: "inc_inv_t"
- where "inv_after_clear (as, lm) (s, l, r) ires =
- (\<exists> rn m lm1 lm2 r'. lm = lm1 @ m # lm2 \<and>
- (if lm1 = [] then l = Oc\<^bsup>Suc m\<^esup> @ Bk # Bk # ires
- else l = Oc\<^bsup>Suc m\<^esup>@ Bk # <rev lm1> @ Bk # Bk # ires) \<and>
- r = Bk # r' \<and> Oc # r' = <lm2> @ (Bk\<^bsup>rn\<^esup>))"
-
-fun inv_on_right_moving :: "inc_inv_t"
- where "inv_on_right_moving (as, lm) (s, l, r) ires =
- (\<exists> lm1 lm2 m ml mr rn. lm = lm1 @ [m] @ lm2 \<and>
- ml + mr = m \<and>
- (if lm1 = [] then l = Oc\<^bsup>ml\<^esup> @ Bk # Bk # ires
- else l = (Oc\<^bsup>ml\<^esup>) @ [Bk] @ <rev lm1> @ Bk # Bk # ires) \<and>
- ((r = (Oc\<^bsup>mr\<^esup>) @ [Bk] @ <lm2> @ (Bk\<^bsup>rn\<^esup>)) \<or>
- (r = (Oc\<^bsup>mr\<^esup>) \<and> lm2 = [])))"
-
-fun inv_on_left_moving_norm :: "inc_inv_t"
- where "inv_on_left_moving_norm (as, lm) (s, l, r) ires =
- (\<exists> lm1 lm2 m ml mr rn. lm = lm1 @ [m] @ lm2 \<and>
- ml + mr = Suc m \<and> mr > 0 \<and> (if lm1 = [] then l = Oc\<^bsup>ml\<^esup> @ Bk # Bk # ires
- else l = (Oc\<^bsup>ml\<^esup>) @ Bk # <rev lm1> @ Bk # Bk # ires)
- \<and> (r = (Oc\<^bsup>mr\<^esup>) @ Bk # <lm2> @ (Bk\<^bsup>rn\<^esup>) \<or>
- (lm2 = [] \<and> r = Oc\<^bsup>mr\<^esup>)))"
-
-fun inv_on_left_moving_in_middle_B:: "inc_inv_t"
- where "inv_on_left_moving_in_middle_B (as, lm) (s, l, r) ires =
- (\<exists> lm1 lm2 rn. lm = lm1 @ lm2 \<and>
- (if lm1 = [] then l = Bk # ires
- else l = <rev lm1> @ Bk # Bk # ires) \<and>
- r = Bk # <lm2> @ (Bk\<^bsup>rn\<^esup>))"
-
-fun inv_on_left_moving :: "inc_inv_t"
- where "inv_on_left_moving (as, lm) (s, l, r) ires =
- (inv_on_left_moving_norm (as, lm) (s, l, r) ires \<or>
- inv_on_left_moving_in_middle_B (as, lm) (s, l, r) ires)"
-
-
-fun inv_check_left_moving_on_leftmost :: "inc_inv_t"
- where "inv_check_left_moving_on_leftmost (as, lm) (s, l, r) ires =
- (\<exists> rn. l = ires \<and> r = [Bk, Bk] @ <lm> @ (Bk\<^bsup>rn\<^esup>))"
-
-fun inv_check_left_moving_in_middle :: "inc_inv_t"
- where "inv_check_left_moving_in_middle (as, lm) (s, l, r) ires =
-
- (\<exists> lm1 lm2 r' rn. lm = lm1 @ lm2 \<and>
- (Oc # l = <rev lm1> @ Bk # Bk # ires) \<and> r = Oc # Bk # r' \<and>
- r' = <lm2> @ (Bk\<^bsup>rn\<^esup>))"
-
-fun inv_check_left_moving :: "inc_inv_t"
- where "inv_check_left_moving (as, lm) (s, l, r) ires =
- (inv_check_left_moving_on_leftmost (as, lm) (s, l, r) ires \<or>
- inv_check_left_moving_in_middle (as, lm) (s, l, r) ires)"
-
-fun inv_after_left_moving :: "inc_inv_t"
- where "inv_after_left_moving (as, lm) (s, l, r) ires=
- (\<exists> rn. l = Bk # ires \<and> r = Bk # <lm> @ (Bk\<^bsup>rn\<^esup>))"
-
-fun inv_stop :: "inc_inv_t"
- where "inv_stop (as, lm) (s, l, r) ires=
- (\<exists> rn. l = Bk # Bk # ires \<and> r = <lm> @ (Bk\<^bsup>rn\<^esup>))"
-
-
-fun inc_inv :: "layout \<Rightarrow> nat \<Rightarrow> inc_inv_t"
- where
- "inc_inv ly n (as, lm) (s, l, r) ires =
- (let ss = start_of ly as in
- let lm' = abc_lm_s lm n ((abc_lm_v lm n)+1) in
- if s = 0 then False
- else if s < ss then False
- else if s < ss + 2 * n then
- if (s - ss) mod 2 = 0 then
- inv_locate_a (as, lm) ((s - ss) div 2, l, r) ires
- else inv_locate_b (as, lm) ((s - ss) div 2, l, r) ires
- else if s = ss + 2 * n then
- inv_locate_a (as, lm) (n, l, r) ires
- else if s = ss + 2 * n + 1 then
- inv_locate_b (as, lm) (n, l, r) ires
- else if s = ss + 2 * n + 2 then
- inv_after_write (as, lm') (s - ss, l, r) ires
- else if s = ss + 2 * n + 3 then
- inv_after_move (as, lm') (s - ss, l, r) ires
- else if s = ss + 2 * n + 4 then
- inv_after_clear (as, lm') (s - ss, l, r) ires
- else if s = ss + 2 * n + 5 then
- inv_on_right_moving (as, lm') (s - ss, l, r) ires
- else if s = ss + 2 * n + 6 then
- inv_on_left_moving (as, lm') (s - ss, l, r) ires
- else if s = ss + 2 * n + 7 then
- inv_check_left_moving (as, lm') (s - ss, l, r) ires
- else if s = ss + 2 * n + 8 then
- inv_after_left_moving (as, lm') (s - ss, l, r) ires
- else if s = ss + 2 * n + 9 then
- inv_stop (as, lm') (s - ss, l, r) ires
- else False) "
-
-lemma fetch_intro:
- "\<lbrakk>\<And>xs.\<lbrakk>ba = Oc # xs\<rbrakk> \<Longrightarrow> P (fetch prog i Oc);
- \<And>xs.\<lbrakk>ba = Bk # xs\<rbrakk> \<Longrightarrow> P (fetch prog i Bk);
- ba = [] \<Longrightarrow> P (fetch prog i Bk)
- \<rbrakk> \<Longrightarrow> P (fetch prog i
- (case ba of [] \<Rightarrow> Bk | Bk # xs \<Rightarrow> Bk | Oc # xs \<Rightarrow> Oc))"
-by (auto split:list.splits block.splits)
-
-lemma length_findnth[simp]: "length (findnth n) = 4 * n"
-apply(induct n, simp)
-apply(simp)
-done
-
-declare tshift.simps[simp del]
-declare findnth.simps[simp del]
-
-lemma findnth_nth:
- "\<lbrakk>n > q; x < 4\<rbrakk> \<Longrightarrow>
- (findnth n) ! (4 * q + x) = (findnth (Suc q) ! (4 * q + x))"
-apply(induct n, simp)
-apply(case_tac "q < n", simp add: findnth.simps, auto)
-apply(simp add: nth_append)
-apply(subgoal_tac "q = n", simp)
-apply(arith)
-done
-
-lemma Suc_pre[simp]: "\<not> a < start_of ly as \<Longrightarrow>
- (Suc a - start_of ly as) = Suc (a - start_of ly as)"
-apply(arith)
-done
-
-lemma fetch_locate_a_o: "
-\<And>a q xs.
- \<lbrakk>\<not> a < start_of (layout_of aprog) as;
- a < start_of (layout_of aprog) as + 2 * n;
- a - start_of (layout_of aprog) as = 2 * q;
- start_of (layout_of aprog) as > 0\<rbrakk>
- \<Longrightarrow> (fetch (ci (layout_of aprog) (start_of (layout_of aprog) as)
- (Inc n)) (Suc (2 * q)) Oc) = (R, a+1)"
-apply(auto simp: ci.simps findnth.simps fetch.simps
- nth_of.simps tshift.simps nth_append Suc_pre)
-apply(subgoal_tac "(findnth n ! Suc (4 * q)) =
- findnth (Suc q) ! (4 * q + 1)")
-apply(simp add: findnth.simps nth_append)
-apply(subgoal_tac " findnth n !(4 * q + 1) =
- findnth (Suc q) ! (4 * q + 1)", simp)
-apply(rule_tac findnth_nth, auto)
-done
-
-lemma fetch_locate_a_b: "
-\<And>a q xs.
- \<lbrakk>abc_fetch as aprog = Some (Inc n);
- \<not> a < start_of (layout_of aprog) as;
- a < start_of (layout_of aprog) as + 2 * n;
- a - start_of (layout_of aprog) as = 2 * q;
- start_of (layout_of aprog) as > 0\<rbrakk>
- \<Longrightarrow> (fetch (ci (layout_of aprog)
- (start_of (layout_of aprog) as) (Inc n)) (Suc (2 * q)) Bk)
- = (W1, a)"
-apply(auto simp: ci.simps findnth.simps fetch.simps
- tshift.simps nth_append)
-apply(subgoal_tac "(findnth n ! (4 * q)) =
- findnth (Suc q) ! (4 * q )")
-apply(simp add: findnth.simps nth_append)
-apply(subgoal_tac " findnth n !(4 * q + 0) =
- findnth (Suc q) ! (4 * q + 0)", simp)
-apply(rule_tac findnth_nth, auto)
-done
-
-lemma [intro]: "x mod 2 = Suc 0 \<Longrightarrow> \<exists> q. x = Suc (2 * q)"
-apply(drule mod_eqD, auto)
-done
-
-lemma add3_Suc: "x + 3 = Suc (Suc (Suc x))"
-apply(arith)
-done
-
-declare start_of.simps[simp]
-(*
-lemma layout_not0: "start_of ly as > 0"
-by(induct as, auto)
-*)
-lemma [simp]:
- "\<lbrakk>\<not> a < start_of (layout_of aprog) as;
- a - start_of (layout_of aprog) as = Suc (2 * q);
- abc_fetch as aprog = Some (Inc n);
- start_of (layout_of aprog) as > 0\<rbrakk>
- \<Longrightarrow> Suc (Suc (2 * q + start_of (layout_of aprog) as - Suc 0)) = a"
-apply(subgoal_tac
-"Suc (Suc (2 * q + start_of (layout_of aprog) as - Suc 0))
- = 2 + 2 * q + start_of (layout_of aprog) as - Suc 0",
- simp, simp add: inc_startof_not0)
-done
-
-lemma fetch_locate_b_o: "
-\<And>a xs.
- \<lbrakk>0 < a; \<not> a < start_of (layout_of aprog) as;
- a < start_of (layout_of aprog) as + 2 * n;
- (a - start_of (layout_of aprog) as) mod 2 = Suc 0;
- start_of (layout_of aprog) as > 0\<rbrakk>
- \<Longrightarrow> (fetch (ci (layout_of aprog) (start_of (layout_of aprog) as)
- (Inc n)) (Suc (a - start_of (layout_of aprog) as)) Oc) = (R, a)"
-apply(auto simp: ci.simps findnth.simps fetch.simps
- nth_of.simps tshift.simps nth_append)
-apply(subgoal_tac "\<exists> q. (a - start_of (layout_of aprog) as) =
- 2 * q + 1", auto)
-apply(subgoal_tac "(findnth n ! Suc (Suc (Suc (4 * q))))
- = findnth (Suc q) ! (4 * q + 3)")
-apply(simp add: findnth.simps nth_append)
-apply(subgoal_tac " findnth n ! (4 * q + 3) =
- findnth (Suc q) ! (4 * q + 3)", simp add: add3_Suc)
-apply(rule_tac findnth_nth, auto)
-done
-
-lemma fetch_locate_b_b: "
-\<And>a xs.
- \<lbrakk>0 < a; \<not> a < start_of (layout_of aprog) as;
- a < start_of (layout_of aprog) as + 2 * n;
- (a - start_of (layout_of aprog) as) mod 2 = Suc 0;
- start_of (layout_of aprog) as > 0\<rbrakk>
- \<Longrightarrow> (fetch (ci (layout_of aprog) (start_of (layout_of aprog) as)
- (Inc n)) (Suc (a - start_of (layout_of aprog) as)) Bk)
- = (R, a + 1)"
-apply(auto simp: ci.simps findnth.simps fetch.simps
- nth_of.simps tshift.simps nth_append)
-apply(subgoal_tac "\<exists> q. (a - start_of (layout_of aprog) as) =
- 2 * q + 1", auto)
-apply(subgoal_tac "(findnth n ! Suc ((Suc (4 * q)))) =
- findnth (Suc q) ! (4 * q + 2)")
-apply(simp add: findnth.simps nth_append)
-apply(subgoal_tac " findnth n ! (4 * q + 2) =
- findnth (Suc q) ! (4 * q + 2)", simp)
-apply(rule_tac findnth_nth, auto)
-done
-
-lemma fetch_locate_n_a_o:
- "start_of (layout_of aprog) as > 0
- \<Longrightarrow> (fetch (ci (layout_of aprog)
- (start_of (layout_of aprog) as) (Inc n)) (Suc (2 * n)) Oc) =
- (R, start_of (layout_of aprog) as + 2 * n + 1)"
-apply(auto simp: ci.simps findnth.simps fetch.simps
- nth_of.simps tshift.simps nth_append tinc_b_def)
-done
-
-lemma fetch_locate_n_a_b: "
- start_of (layout_of aprog) as > 0
- \<Longrightarrow> (fetch (ci (layout_of aprog)
- (start_of (layout_of aprog) as) (Inc n)) (Suc (2 * n)) Bk)
- = (W1, start_of (layout_of aprog) as + 2 * n)"
-apply(auto simp: ci.simps findnth.simps fetch.simps
- nth_of.simps tshift.simps nth_append tinc_b_def)
-done
-
-lemma fetch_locate_n_b_o: "
- start_of (layout_of aprog) as > 0
- \<Longrightarrow> (fetch (ci (layout_of aprog) (start_of (layout_of aprog) as)
- (Inc n)) (Suc (Suc (2 * n))) Oc) =
- (R, start_of (layout_of aprog) as + 2 * n + 1)"
-apply(auto simp: ci.simps findnth.simps fetch.simps
- nth_of.simps tshift.simps nth_append tinc_b_def)
-done
-
-lemma fetch_locate_n_b_b: "
- start_of (layout_of aprog) as > 0
- \<Longrightarrow> (fetch (ci (layout_of aprog) (start_of (layout_of aprog) as)
- (Inc n)) (Suc (Suc (2 * n))) Bk) =
- (W1, start_of (layout_of aprog) as + 2 * n + 2)"
-apply(auto simp: ci.simps findnth.simps fetch.simps
- nth_of.simps tshift.simps nth_append tinc_b_def)
-done
-
-lemma fetch_after_write_o: "
- start_of (layout_of aprog) as > 0
- \<Longrightarrow> (fetch (ci (layout_of aprog) (start_of (layout_of aprog) as)
- (Inc n)) (Suc (Suc (Suc (2 * n)))) Oc) =
- (R, start_of (layout_of aprog) as + 2*n + 3)"
-apply(auto simp: ci.simps findnth.simps fetch.simps
- nth_of.simps tshift.simps nth_append tinc_b_def)
-done
-
-lemma fetch_after_move_o: "
- start_of (layout_of aprog) as > 0
- \<Longrightarrow> (fetch (ci (layout_of aprog)
- (start_of (layout_of aprog) as) (Inc n)) (4 + 2 * n) Oc)
- = (W0, start_of (layout_of aprog) as + 2 * n + 4)"
-apply(auto simp: ci.simps findnth.simps tshift.simps
- tinc_b_def add3_Suc)
-apply(subgoal_tac "4 + 2*n = Suc (2*n + 3)", simp only: fetch.simps)
-apply(auto simp: nth_of.simps nth_append)
-done
-
-lemma fetch_after_move_b: "
- start_of (layout_of aprog) as > 0
- \<Longrightarrow>(fetch (ci (layout_of aprog)
- (start_of (layout_of aprog) as) (Inc n)) (4 + 2 * n) Bk)
- = (L, start_of (layout_of aprog) as + 2 * n + 6)"
-apply(auto simp: ci.simps findnth.simps tshift.simps
- tinc_b_def add3_Suc)
-apply(subgoal_tac "4 + 2*n = Suc (2*n + 3)", simp only: fetch.simps)
-apply(auto simp: nth_of.simps nth_append)
-done
-
-lemma fetch_clear_b: "
- start_of (layout_of aprog) as > 0
- \<Longrightarrow> (fetch (ci (layout_of aprog)
- (start_of (layout_of aprog) as) (Inc n)) (5 + 2 * n) Bk)
- = (R, start_of (layout_of aprog) as + 2 * n + 5)"
-apply(auto simp: ci.simps findnth.simps
- tshift.simps tinc_b_def add3_Suc)
-apply(subgoal_tac "5 + 2*n = Suc (2*n + 4)", simp only: fetch.simps)
-apply(auto simp: nth_of.simps nth_append)
-done
-
-lemma fetch_right_move_o: "
- start_of (layout_of aprog) as > 0
- \<Longrightarrow> (fetch (ci (layout_of aprog)
- (start_of (layout_of aprog) as) (Inc n)) (6 + 2*n) Oc)
- = (R, start_of (layout_of aprog) as + 2 * n + 5)"
-apply(auto simp: ci.simps findnth.simps tshift.simps
- tinc_b_def add3_Suc)
-apply(subgoal_tac "6 + 2*n = Suc (2*n + 5)", simp only: fetch.simps)
-apply(auto simp: nth_of.simps nth_append)
-done
-
-lemma fetch_right_move_b: "
- start_of (layout_of aprog) as > 0
- \<Longrightarrow> (fetch (ci (layout_of aprog)
- (start_of (layout_of aprog) as) (Inc n)) (6 + 2*n) Bk)
- = (W1, start_of (layout_of aprog) as + 2 * n + 2)"
-apply(auto simp: ci.simps findnth.simps
- tshift.simps tinc_b_def add3_Suc)
-apply(subgoal_tac "6 + 2*n = Suc (2*n + 5)", simp only: fetch.simps)
-apply(auto simp: nth_of.simps nth_append)
-done
-
-lemma fetch_left_move_o: "
- start_of (layout_of aprog) as > 0
- \<Longrightarrow> (fetch (ci (layout_of aprog)
- (start_of (layout_of aprog) as) (Inc n)) (7 + 2*n) Oc)
- = (L, start_of (layout_of aprog) as + 2 * n + 6)"
-apply(auto simp: ci.simps findnth.simps tshift.simps
- tinc_b_def add3_Suc)
-apply(subgoal_tac "7 + 2*n = Suc (2*n + 6)", simp only: fetch.simps)
-apply(auto simp: nth_of.simps nth_append)
-done
-
-lemma fetch_left_move_b: "
- start_of (layout_of aprog) as > 0
- \<Longrightarrow> (fetch (ci (layout_of aprog)
- (start_of (layout_of aprog) as) (Inc n)) (7 + 2*n) Bk)
- = (L, start_of (layout_of aprog) as + 2 * n + 7)"
-apply(auto simp: ci.simps findnth.simps
- tshift.simps tinc_b_def add3_Suc)
-apply(subgoal_tac "7 + 2*n = Suc (2*n + 6)", simp only: fetch.simps)
-apply(auto simp: nth_of.simps nth_append)
-done
-
-lemma fetch_check_left_move_o: "
- start_of (layout_of aprog) as > 0
- \<Longrightarrow> (fetch (ci (layout_of aprog)
- (start_of (layout_of aprog) as) (Inc n)) (8 + 2*n) Oc)
- = (L, start_of (layout_of aprog) as + 2 * n + 6)"
-apply(auto simp: ci.simps findnth.simps tshift.simps tinc_b_def)
-apply(subgoal_tac "8 + 2 * n = Suc (2 * n + 7)",
- simp only: fetch.simps)
-apply(auto simp: nth_of.simps nth_append)
-done
-
-lemma fetch_check_left_move_b: "
- start_of (layout_of aprog) as > 0
- \<Longrightarrow> (fetch (ci (layout_of aprog)
- (start_of (layout_of aprog) as) (Inc n)) (8 + 2*n) Bk)
- = (R, start_of (layout_of aprog) as + 2 * n + 8) "
-apply(auto simp: ci.simps findnth.simps
- tshift.simps tinc_b_def add3_Suc)
-apply(subgoal_tac "8 + 2*n= Suc (2*n + 7)", simp only: fetch.simps)
-apply(auto simp: nth_of.simps nth_append)
-done
-
-lemma fetch_after_left_move: "
- start_of (layout_of aprog) as > 0
- \<Longrightarrow> (fetch (ci (layout_of aprog)
- (start_of (layout_of aprog) as) (Inc n)) (9 + 2*n) Bk)
- = (R, start_of (layout_of aprog) as + 2 * n + 9)"
-apply(auto simp: ci.simps findnth.simps fetch.simps
- nth_of.simps tshift.simps nth_append tinc_b_def)
-done
-
-lemma fetch_stop: "
- start_of (layout_of aprog) as > 0
- \<Longrightarrow> (fetch (ci (layout_of aprog)
- (start_of (layout_of aprog) as) (Inc n)) (10 + 2 *n) b)
- = (Nop, 0)"
-apply(auto simp: ci.simps findnth.simps fetch.simps
- nth_of.simps tshift.simps nth_append tinc_b_def
- split: block.splits)
-done
-
-lemma fetch_state0: "
- (fetch (ci (layout_of aprog)
- (start_of (layout_of aprog) as) (Inc n)) 0 b)
- = (Nop, 0)"
-apply(auto simp: ci.simps findnth.simps fetch.simps
- nth_of.simps tshift.simps nth_append tinc_b_def)
-done
-
-lemmas fetch_simps =
- fetch_locate_a_o fetch_locate_a_b fetch_locate_b_o fetch_locate_b_b
- fetch_locate_n_a_b fetch_locate_n_a_o fetch_locate_n_b_o
- fetch_locate_n_b_b fetch_after_write_o fetch_after_move_o
- fetch_after_move_b fetch_clear_b fetch_right_move_o
- fetch_right_move_b fetch_left_move_o fetch_left_move_b
- fetch_after_left_move fetch_check_left_move_o fetch_stop
- fetch_state0 fetch_check_left_move_b
-
-text {* *}
-declare exponent_def[simp del] tape_of_nat_list.simps[simp del]
- at_begin_norm.simps[simp del] at_begin_fst_bwtn.simps[simp del]
- at_begin_fst_awtn.simps[simp del] in_middle.simps[simp del]
- abc_lm_s.simps[simp del] abc_lm_v.simps[simp del]
- ci.simps[simp del] t_step.simps[simp del]
- inv_after_move.simps[simp del]
- inv_on_left_moving_norm.simps[simp del]
- inv_on_left_moving_in_middle_B.simps[simp del]
- inv_after_clear.simps[simp del]
- inv_after_write.simps[simp del] inv_on_left_moving.simps[simp del]
- inv_on_right_moving.simps[simp del]
- inv_check_left_moving.simps[simp del]
- inv_check_left_moving_in_middle.simps[simp del]
- inv_check_left_moving_on_leftmost.simps[simp del]
- inv_after_left_moving.simps[simp del]
- inv_stop.simps[simp del] inv_locate_a.simps[simp del]
- inv_locate_b.simps[simp del]
-declare tms_of.simps[simp del] tm_of.simps[simp del]
- layout_of.simps[simp del] abc_fetch.simps [simp del]
- t_step.simps[simp del] t_steps.simps[simp del]
- tpairs_of.simps[simp del] start_of.simps[simp del]
- fetch.simps [simp del] new_tape.simps [simp del]
- nth_of.simps [simp del] ci.simps [simp del]
- length_of.simps[simp del]
-
-(*! Start point *)
-lemma [simp]: "Suc (2 * q) mod 2 = Suc 0"
-by arith
-
-lemma [simp]: "Suc (2 * q) div 2 = q"
-by arith
-
-lemma [simp]: "\<lbrakk> \<not> a < start_of ly as;
- a < start_of ly as + 2 * n; a - start_of ly as = 2 * q\<rbrakk>
- \<Longrightarrow> Suc a < start_of ly as + 2 * n"
-apply(arith)
-done
-
-lemma [simp]: "x mod 2 = Suc 0 \<Longrightarrow> (Suc x) mod 2 = 0"
-by arith
-
-lemma [simp]: "x mod 2 = Suc 0 \<Longrightarrow> (Suc x) div 2 = Suc (x div 2)"
-by arith
-lemma exp_def[simp]: "a\<^bsup>Suc n \<^esup>= a # a\<^bsup>n\<^esup>"
-by(simp add: exponent_def)
-lemma [intro]: "Bk # r = Oc\<^bsup>mr\<^esup> @ r' \<Longrightarrow> mr = 0"
-by(case_tac mr, auto simp: exponent_def)
-
-lemma [intro]: "Bk # r = replicate mr Oc \<Longrightarrow> mr = 0"
-by(case_tac mr, auto)
-lemma tape_of_nl_abv_cons[simp]: "xs \<noteq> [] \<Longrightarrow>
- <x # xs> = Oc\<^bsup>Suc x\<^esup>@ Bk # <xs>"
-apply(simp add: tape_of_nl_abv tape_of_nat_list.simps)
-apply(case_tac xs, simp, simp add: tape_of_nat_list.simps)
-done
-
-lemma [simp]: "<[]::nat list> = []"
-by(auto simp: tape_of_nl_abv tape_of_nat_list.simps)
-lemma [simp]: "Oc # r = <(lm::nat list)> @ Bk\<^bsup>rn\<^esup>\<Longrightarrow> lm \<noteq> []"
-apply(auto simp: tape_of_nl_abv tape_of_nat_list.simps)
-apply(case_tac rn, auto simp: exponent_def)
-done
-lemma BkCons_nil: "Bk # xs = <lm::nat list> @ Bk\<^bsup>rn\<^esup>\<Longrightarrow> lm = []"
-apply(case_tac lm, simp)
-apply(case_tac list, auto simp: tape_of_nl_abv tape_of_nat_list.simps)
-done
-lemma BkCons_nil': "Bk # xs = <lm::nat list> @ Bk\<^bsup>ln\<^esup>\<Longrightarrow> lm = []"
-by(auto intro: BkCons_nil)
-
-lemma hd_tl_tape_of_nat_list:
- "tl (lm::nat list) \<noteq> [] \<Longrightarrow> <lm> = <hd lm> @ Bk # <tl lm>"
-apply(frule tape_of_nl_abv_cons[of "tl lm" "hd lm"])
-apply(simp add: tape_of_nat_abv Bk_def del: tape_of_nl_abv_cons)
-apply(subgoal_tac "lm = hd lm # tl lm", auto)
-apply(case_tac lm, auto)
-done
-lemma [simp]: "Oc # xs = Oc\<^bsup>mr\<^esup> @ Bk # <lm2> @ Bk\<^bsup>rn\<^esup>\<Longrightarrow> mr > 0"
-apply(case_tac mr, auto simp: exponent_def)
-done
-
-lemma tape_of_nat_list_cons: "xs \<noteq> [] \<Longrightarrow> tape_of_nat_list (x # xs) =
- replicate (Suc x) Oc @ Bk # tape_of_nat_list xs"
-apply(drule tape_of_nl_abv_cons[of xs x])
-apply(auto simp: tape_of_nl_abv tape_of_nat_abv Oc_def Bk_def exponent_def)
-done
-
-lemma rev_eq: "rev xs = rev ys \<Longrightarrow> xs = ys"
-by simp
-
-lemma tape_of_nat_list_eq: " xs = ys \<Longrightarrow>
- tape_of_nat_list xs = tape_of_nat_list ys"
-by simp
-
-lemma tape_of_nl_nil_eq: "<(lm::nat list)> = [] = (lm = [])"
-apply(simp add: tape_of_nl_abv tape_of_nat_list.simps)
-apply(case_tac lm, simp add: tape_of_nat_list.simps)
-apply(case_tac "list")
-apply(auto simp: tape_of_nat_list.simps)
-done
-
-lemma rep_ind: "replicate (Suc n) a = replicate n a @ [a]"
-apply(induct n, simp, simp)
-done
-
-lemma [simp]: "Oc # r = <lm::nat list> @ replicate rn Bk \<Longrightarrow> Suc 0 \<le> length lm"
-apply(rule_tac classical, auto)
-apply(case_tac lm, simp, case_tac rn, auto)
-done
-lemma Oc_Bk_Cons: "Oc # Bk # list = <lm::nat list> @ Bk\<^bsup>ln\<^esup> \<Longrightarrow>
- lm \<noteq> [] \<and> hd lm = 0"
-apply(case_tac lm, simp, case_tac ln, simp add: exponent_def, simp add: exponent_def, simp)
-apply(case_tac lista, auto simp: tape_of_nl_abv tape_of_nat_list.simps)
-done
-(*lemma Oc_Oc_Cons: "Oc # Oc # list = <lm::nat list> @ Bk\<^bsup>ln\<^esup> \<Longrightarrow>
- lm \<noteq> [] \<and> hd lm > 0"
-apply(case_tac lm, simp add: exponent_def, case_tac ln, simp, simp)
-apply(case_tac lista,
- auto simp: tape_of_nl_abv tape_of_nat_list.simps exponent_def)
-apply(case_tac [!] a, auto)
-apply(case_tac ln, auto)
-done
-*)
-lemma Oc_nil_zero[simp]: "[Oc] = <lm::nat list> @ Bk\<^bsup>ln\<^esup>
- \<Longrightarrow> lm = [0] \<and> ln = 0"
-apply(case_tac lm, simp)
-apply(case_tac ln, auto simp: exponent_def)
-apply(case_tac [!] list,
- auto simp: tape_of_nl_abv tape_of_nat_list.simps)
-done
-
-lemma [simp]: "Oc # r = <lm2> @ replicate rn Bk \<Longrightarrow>
- (\<exists>rn. r = replicate (hd lm2) Oc @ Bk # <tl lm2> @
- replicate rn Bk) \<or>
- tl lm2 = [] \<and> r = replicate (hd lm2) Oc"
-apply(rule_tac disjCI, simp)
-apply(case_tac "tl lm2 = []", simp)
-apply(case_tac lm2, simp add: tape_of_nl_abv tape_of_nat_list.simps)
-apply(case_tac rn, simp, simp, simp)
-apply(simp add: tape_of_nl_abv tape_of_nat_list.simps exponent_def)
-apply(case_tac rn, simp, simp)
-apply(rule_tac x = rn in exI)
-apply(simp add: hd_tl_tape_of_nat_list)
-apply(simp add: tape_of_nat_abv Oc_def exponent_def)
-done
-
-(*inv: from locate_a to locate_b*)
-lemma [simp]:
- "inv_locate_a (as, lm) (q, l, Oc # r) ires
- \<Longrightarrow> inv_locate_b (as, lm) (q, Oc # l, r) ires"
-apply(simp only: inv_locate_a.simps inv_locate_b.simps in_middle.simps
- at_begin_norm.simps at_begin_fst_bwtn.simps
- at_begin_fst_awtn.simps)
-apply(erule disjE, erule exE, erule exE, erule exE)
-apply(rule_tac x = lm1 in exI, rule_tac x = "tl lm2" in exI, simp)
-apply(rule_tac x = "0" in exI, rule_tac x = "hd lm2" in exI,
- auto simp: exponent_def)
-apply(rule_tac x = "Suc 0" in exI, simp add:exponent_def)
-apply(rule_tac x = "lm @ replicate tn 0" in exI,
- rule_tac x = "[]" in exI,
- rule_tac x = "Suc tn" in exI, rule_tac x = 0 in exI)
-apply(simp only: rep_ind, simp)
-apply(rule_tac x = "Suc 0" in exI, auto)
-apply(case_tac [1-3] rn, simp_all )
-apply(rule_tac x = "lm @ replicate tn 0" in exI,
- rule_tac x = "[]" in exI,
- rule_tac x = "Suc tn" in exI,
- rule_tac x = 0 in exI, simp add: rep_ind del: replicate_Suc split:if_splits)
-apply(rule_tac x = "Suc 0" in exI, auto)
-apply(case_tac rn, simp, simp)
-apply(rule_tac [!] x = "Suc 0" in exI, auto)
-apply(case_tac [!] rn, simp_all)
-done
-
-(*inv: from locate_a to _locate_a*)
-lemma locate_a_2_locate_a[simp]: "inv_locate_a (as, am) (q, aaa, Bk # xs) ires
- \<Longrightarrow> inv_locate_a (as, am) (q, aaa, Oc # xs) ires"
-apply(simp only: inv_locate_a.simps at_begin_norm.simps
- at_begin_fst_bwtn.simps at_begin_fst_awtn.simps)
-apply(erule_tac disjE, erule exE, erule exE, erule exE,
- rule disjI2, rule disjI2)
-defer
-apply(erule_tac disjE, erule exE, erule exE,
- erule exE, rule disjI2, rule disjI2)
-prefer 2
-apply(simp)
-proof-
- fix lm1 tn rn
- assume k: "lm1 = am @ 0\<^bsup>tn\<^esup> \<and> length lm1 = q \<and> (if lm1 = [] then aaa = Bk # Bk #
- ires else aaa = [Bk] @ <rev lm1> @ Bk # Bk # ires) \<and> Bk # xs = Bk\<^bsup>rn\<^esup>"
- thus "\<exists>lm1 tn rn. lm1 = am @ 0\<^bsup>tn\<^esup> \<and> length lm1 = q \<and> (if lm1 = [] then
- aaa = Bk # Bk # ires else aaa = [Bk] @ <rev lm1> @ Bk # Bk # ires) \<and> Oc # xs = [Oc] @ Bk\<^bsup>rn\<^esup>"
- (is "\<exists>lm1 tn rn. ?P lm1 tn rn")
- proof -
- from k have "?P lm1 tn (rn - 1)"
- apply(auto simp: Oc_def)
- by(case_tac [!] "rn::nat", auto simp: exponent_def)
- thus ?thesis by blast
- qed
-next
- fix lm1 lm2 rn
- assume h1: "am = lm1 @ lm2 \<and> length lm1 = q \<and> (if lm1 = []
- then aaa = Bk # Bk # ires else aaa = Bk # <rev lm1> @ Bk # Bk # ires) \<and>
- Bk # xs = <lm2> @ Bk\<^bsup>rn\<^esup>"
- from h1 have h2: "lm2 = []"
- proof(rule_tac xs = xs and rn = rn in BkCons_nil, simp)
- qed
- from h1 and h2 show "\<exists>lm1 tn rn. lm1 = am @ 0\<^bsup>tn\<^esup> \<and> length lm1 = q \<and>
- (if lm1 = [] then aaa = Bk # Bk # ires else aaa = [Bk] @ <rev lm1> @ Bk # Bk # ires) \<and>
- Oc # xs = [Oc] @ Bk\<^bsup>rn\<^esup>"
- (is "\<exists>lm1 tn rn. ?P lm1 tn rn")
- proof -
- from h1 and h2 have "?P lm1 0 (rn - 1)"
- apply(auto simp: Oc_def exponent_def
- tape_of_nl_abv tape_of_nat_list.simps)
- by(case_tac "rn::nat", simp, simp)
- thus ?thesis by blast
- qed
-qed
-
-lemma [intro]: "\<exists>rn. [a] = a\<^bsup>rn\<^esup>"
-by(rule_tac x = "Suc 0" in exI, simp add: exponent_def)
-
-lemma [intro]: "\<exists>tn. [] = a\<^bsup>tn\<^esup>"
-apply(rule_tac x = 0 in exI, simp add: exponent_def)
-done
-
-lemma [intro]: "at_begin_norm (as, am) (q, aaa, []) ires
- \<Longrightarrow> at_begin_norm (as, am) (q, aaa, [Bk]) ires"
-apply(simp add: at_begin_norm.simps, erule_tac exE, erule_tac exE)
-apply(rule_tac x = lm1 in exI, simp, auto)
-done
-
-lemma [intro]: "at_begin_fst_bwtn (as, am) (q, aaa, []) ires
- \<Longrightarrow> at_begin_fst_bwtn (as, am) (q, aaa, [Bk]) ires"
-apply(simp only: at_begin_fst_bwtn.simps, erule_tac exE, erule_tac exE, erule_tac exE)
-apply(rule_tac x = "am @ 0\<^bsup>tn\<^esup>" in exI, auto)
-done
-
-lemma [intro]: "at_begin_fst_awtn (as, am) (q, aaa, []) ires
- \<Longrightarrow> at_begin_fst_awtn (as, am) (q, aaa, [Bk]) ires"
-apply(auto simp: at_begin_fst_awtn.simps)
-done
-
-lemma [intro]: "inv_locate_a (as, am) (q, aaa, []) ires
- \<Longrightarrow> inv_locate_a (as, am) (q, aaa, [Bk]) ires"
-apply(simp only: inv_locate_a.simps)
-apply(erule disj_forward)
-defer
-apply(erule disj_forward, auto)
-done
-
-lemma [simp]: "inv_locate_a (as, am) (q, aaa, []) ires \<Longrightarrow>
- inv_locate_a (as, am) (q, aaa, [Oc]) ires"
-apply(insert locate_a_2_locate_a [of as am q aaa "[]"])
-apply(subgoal_tac "inv_locate_a (as, am) (q, aaa, [Bk]) ires", auto)
-done
-
-(*inv: from locate_b to locate_b*)
-lemma [simp]: "inv_locate_b (as, am) (q, aaa, Oc # xs) ires
- \<Longrightarrow> inv_locate_b (as, am) (q, Oc # aaa, xs) ires"
-apply(simp only: inv_locate_b.simps in_middle.simps)
-apply(erule exE)+
-apply(rule_tac x = lm1 in exI, rule_tac x = lm2 in exI,
- rule_tac x = tn in exI, rule_tac x = m in exI)
-apply(rule_tac x = "Suc ml" in exI, rule_tac x = "mr - 1" in exI,
- rule_tac x = rn in exI)
-apply(case_tac mr, simp_all add: exponent_def, auto)
-done
-lemma zero_and_nil[intro]: "(Bk # Bk\<^bsup>n\<^esup> = Oc\<^bsup>mr\<^esup> @ Bk # <lm::nat list> @
- Bk\<^bsup>rn \<^esup>) \<or> (lm2 = [] \<and> Bk # Bk\<^bsup>n\<^esup> = Oc\<^bsup>mr\<^esup>)
- \<Longrightarrow> mr = 0 \<and> lm = []"
-apply(rule context_conjI)
-apply(case_tac mr, auto simp:exponent_def)
-apply(insert BkCons_nil[of "replicate (n - 1) Bk" lm rn])
-apply(case_tac n, auto simp: exponent_def Bk_def tape_of_nl_nil_eq)
-done
-
-lemma tape_of_nat_def: "<[m::nat]> = Oc # Oc\<^bsup>m\<^esup>"
-apply(simp add: tape_of_nl_abv tape_of_nat_list.simps)
-done
-lemma [simp]: "\<lbrakk>inv_locate_b (as, am) (q, aaa, Bk # xs) ires; \<exists>n. xs = Bk\<^bsup>n\<^esup>\<rbrakk>
- \<Longrightarrow> inv_locate_a (as, am) (Suc q, Bk # aaa, xs) ires"
-apply(simp add: inv_locate_b.simps inv_locate_a.simps)
-apply(rule_tac disjI2, rule_tac disjI1)
-apply(simp only: in_middle.simps at_begin_fst_bwtn.simps)
-apply(erule_tac exE)+
-apply(rule_tac x = "lm1 @ [m]" in exI, rule_tac x = tn in exI, simp)
-apply(subgoal_tac "mr = 0 \<and> lm2 = []")
-defer
-apply(rule_tac n = n and mr = mr and lm = "lm2"
- and rn = rn and n = n in zero_and_nil)
-apply(auto simp: exponent_def)
-apply(case_tac "lm1 = []", auto simp: tape_of_nat_def)
-done
-
-lemma length_equal: "xs = ys \<Longrightarrow> length xs = length ys"
-by auto
-lemma [simp]: "a\<^bsup>0\<^esup> = []"
-by(simp add: exp_zero)
-(*inv: from locate_b to locate_a*)
-lemma [simp]: "length (a\<^bsup>b\<^esup>) = b"
-apply(simp add: exponent_def)
-done
-
-lemma [simp]: "\<lbrakk>inv_locate_b (as, am) (q, aaa, Bk # xs) ires;
- \<not> (\<exists>n. xs = Bk\<^bsup>n\<^esup>)\<rbrakk>
- \<Longrightarrow> inv_locate_a (as, am) (Suc q, Bk # aaa, xs) ires"
-apply(simp add: inv_locate_b.simps inv_locate_a.simps)
-apply(rule_tac disjI1)
-apply(simp only: in_middle.simps at_begin_norm.simps)
-apply(erule_tac exE)+
-apply(rule_tac x = "lm1 @ [m]" in exI, rule_tac x = lm2 in exI, simp)
-apply(subgoal_tac "tn = 0", simp add: exponent_def , auto split: if_splits)
-apply(case_tac [!] mr, simp_all add: tape_of_nat_def, auto)
-apply(case_tac lm2, simp, erule_tac x = rn in allE, simp)
-apply(case_tac am, simp, simp)
-apply(case_tac lm2, simp, erule_tac x = rn in allE, simp)
-apply(drule_tac length_equal, simp)
-done
-
-lemma locate_b_2_a[intro]:
- "inv_locate_b (as, am) (q, aaa, Bk # xs) ires
- \<Longrightarrow> inv_locate_a (as, am) (Suc q, Bk # aaa, xs) ires"
-apply(case_tac "\<exists> n. xs = Bk\<^bsup>n\<^esup>", simp, simp)
-done
-
-lemma locate_b_2_locate_a[simp]:
- "\<lbrakk>\<not> a < start_of ly as;
- a < start_of ly as + 2 * n;
- (a - start_of ly as) mod 2 = Suc 0;
- inv_locate_b (as, am) ((a - start_of ly as) div 2, aaa, Bk # xs) ires\<rbrakk>
- \<Longrightarrow> (Suc a < start_of ly as + 2 * n \<longrightarrow> inv_locate_a (as, am)
- (Suc ((a - start_of ly as) div 2), Bk # aaa, xs) ires) \<and>
- (\<not> Suc a < start_of ly as + 2 * n \<longrightarrow>
- inv_locate_a (as, am) (n, Bk # aaa, xs) ires)"
-apply(auto)
-apply(subgoal_tac "n > 0")
-apply(subgoal_tac "(a - start_of ly as) div 2 = n - 1")
-apply(insert locate_b_2_a [of as am "n - 1" aaa xs], simp)
-apply(arith)
-apply(case_tac n, simp, simp)
-done
-
-lemma [simp]: "inv_locate_b (as, am) (q, l, []) ires
- \<Longrightarrow> inv_locate_b (as, am) (q, l, [Bk]) ires"
-apply(simp only: inv_locate_b.simps in_middle.simps)
-apply(erule exE)+
-apply(rule_tac x = lm1 in exI, rule_tac x = lm2 in exI,
- rule_tac x = tn in exI, rule_tac x = m in exI,
- rule_tac x = ml in exI, rule_tac x = mr in exI)
-apply(auto)
-done
-
-lemma locate_b_2_locate_a_B[simp]:
- "\<lbrakk>\<not> a < start_of ly as;
- a < start_of ly as + 2 * n;
- (a - start_of ly as) mod 2 = Suc 0;
- inv_locate_b (as, am) ((a - start_of ly as) div 2, aaa, []) ires\<rbrakk>
- \<Longrightarrow> (Suc a < start_of ly as + 2 * n \<longrightarrow>
- inv_locate_a (as, am)
- (Suc ((a - start_of ly as) div 2), Bk # aaa, []) ires)
- \<and> (\<not> Suc a < start_of ly as + 2 * n \<longrightarrow>
- inv_locate_a (as, am) (n, Bk # aaa, []) ires)"
-apply(insert locate_b_2_locate_a [of a ly as n am aaa "[]"], simp)
-done
-
-(*inv: from locate_b to after_write*)
-lemma inv_locate_b_2_after_write[simp]:
- "inv_locate_b (as, am) (n, aaa, Bk # xs) ires
- \<Longrightarrow> inv_after_write (as, abc_lm_s am n (Suc (abc_lm_v am n)))
- (Suc (Suc (2 * n)), aaa, Oc # xs) ires"
-apply(auto simp: in_middle.simps inv_after_write.simps
- abc_lm_v.simps abc_lm_s.simps inv_locate_b.simps)
-apply(subgoal_tac [!] "mr = 0", auto simp: exponent_def split: if_splits)
-apply(subgoal_tac "lm2 = []", simp)
-apply(rule_tac x = rn in exI, rule_tac x = "Suc m" in exI,
- rule_tac x = "lm1" in exI, simp, rule_tac x = "[]" in exI, simp)
-apply(case_tac "Suc (length lm1) - length am", simp, simp only: rep_ind, simp)
-apply(subgoal_tac "length lm1 - length am = nat", simp, arith)
-apply(drule_tac length_equal, simp)
-done
-
-lemma [simp]: "inv_locate_b (as, am) (n, aaa, []) ires \<Longrightarrow>
- inv_after_write (as, abc_lm_s am n (Suc (abc_lm_v am n)))
- (Suc (Suc (2 * n)), aaa, [Oc]) ires"
-apply(insert inv_locate_b_2_after_write [of as am n aaa "[]"])
-by(simp)
-
-(*inv: from after_write to after_move*)
-lemma [simp]: "inv_after_write (as, lm) (Suc (Suc (2 * n)), l, Oc # r) ires
- \<Longrightarrow> inv_after_move (as, lm) (2 * n + 3, Oc # l, r) ires"
-apply(auto simp:inv_after_move.simps inv_after_write.simps split: if_splits)
-done
-
-lemma [simp]: "inv_after_write (as, abc_lm_s am n (Suc (abc_lm_v am n)
- )) (Suc (Suc (2 * n)), aaa, Bk # xs) ires = False"
-apply(simp add: inv_after_write.simps )
-done
-
-lemma [simp]:
- "inv_after_write (as, abc_lm_s am n (Suc (abc_lm_v am n)))
- (Suc (Suc (2 * n)), aaa, []) ires = False"
-apply(simp add: inv_after_write.simps )
-done
-
-(*inv: from after_move to after_clear*)
-lemma [simp]: "inv_after_move (as, lm) (s, l, Oc # r) ires
- \<Longrightarrow> inv_after_clear (as, lm) (s', l, Bk # r) ires"
-apply(auto simp: inv_after_move.simps inv_after_clear.simps split: if_splits)
-done
-
-(*inv: from after_move to on_leftmoving*)
-lemma inv_after_move_2_inv_on_left_moving[simp]:
- "inv_after_move (as, lm) (s, l, Bk # r) ires
- \<Longrightarrow> (l = [] \<longrightarrow>
- inv_on_left_moving (as, lm) (s', [], Bk # Bk # r) ires) \<and>
- (l \<noteq> [] \<longrightarrow>
- inv_on_left_moving (as, lm) (s', tl l, hd l # Bk # r) ires)"
-apply(simp only: inv_after_move.simps inv_on_left_moving.simps)
-apply(subgoal_tac "l \<noteq> []", rule conjI, simp, rule impI,
- rule disjI1, simp only: inv_on_left_moving_norm.simps)
-apply(erule exE)+
-apply(subgoal_tac "lm2 = []")
-apply(rule_tac x = lm1 in exI, rule_tac x = lm2 in exI,
- rule_tac x = m in exI, rule_tac x = m in exI,
- rule_tac x = 1 in exI,
- rule_tac x = "rn - 1" in exI, simp, case_tac rn)
-apply(auto simp: exponent_def intro: BkCons_nil split: if_splits)
-done
-
-lemma [elim]: "[] = <lm::nat list> \<Longrightarrow> lm = []"
-using tape_of_nl_nil_eq[of lm]
-by simp
-
-lemma inv_after_move_2_inv_on_left_moving_B[simp]:
- "inv_after_move (as, lm) (s, l, []) ires
- \<Longrightarrow> (l = [] \<longrightarrow> inv_on_left_moving (as, lm) (s', [], [Bk]) ires) \<and>
- (l \<noteq> [] \<longrightarrow> inv_on_left_moving (as, lm) (s', tl l, [hd l]) ires)"
-apply(simp only: inv_after_move.simps inv_on_left_moving.simps)
-apply(subgoal_tac "l \<noteq> []", rule conjI, simp, rule impI, rule disjI1,
- simp only: inv_on_left_moving_norm.simps)
-apply(erule exE)+
-apply(subgoal_tac "lm2 = []")
-apply(rule_tac x = lm1 in exI, rule_tac x = lm2 in exI,
- rule_tac x = m in exI, rule_tac x = m in exI,
- rule_tac x = 1 in exI, rule_tac x = "rn - 1" in exI, simp, case_tac rn)
-apply(auto simp: exponent_def tape_of_nl_nil_eq intro: BkCons_nil split: if_splits)
-done
-
-(*inv: from after_clear to on_right_moving*)
-lemma [simp]: "Oc # r = replicate rn Bk = False"
-apply(case_tac rn, simp, simp)
-done
-
-lemma inv_after_clear_2_inv_on_right_moving[simp]:
- "inv_after_clear (as, lm) (2 * n + 4, l, Bk # r) ires
- \<Longrightarrow> inv_on_right_moving (as, lm) (2 * n + 5, Bk # l, r) ires"
-apply(auto simp: inv_after_clear.simps inv_on_right_moving.simps )
-apply(subgoal_tac "lm2 \<noteq> []")
-apply(rule_tac x = "lm1 @ [m]" in exI, rule_tac x = "tl lm2" in exI,
- rule_tac x = "hd lm2" in exI, simp)
-apply(rule_tac x = 0 in exI, rule_tac x = "hd lm2" in exI)
-apply(simp add: exponent_def, rule conjI)
-apply(case_tac [!] "lm2::nat list", auto simp: exponent_def)
-apply(case_tac rn, auto split: if_splits simp: tape_of_nat_def)
-apply(case_tac list,
- simp add: tape_of_nl_abv tape_of_nat_list.simps exponent_def)
-apply(erule_tac x = "rn - 1" in allE,
- case_tac rn, auto simp: exponent_def)
-apply(case_tac list,
- simp add: tape_of_nl_abv tape_of_nat_list.simps exponent_def)
-apply(erule_tac x = "rn - 1" in allE,
- case_tac rn, auto simp: exponent_def)
-done
-
-
-lemma [simp]: "inv_after_clear (as, lm) (2 * n + 4, l, []) ires\<Longrightarrow>
- inv_after_clear (as, lm) (2 * n + 4, l, [Bk]) ires"
-by(auto simp: inv_after_clear.simps)
-
-lemma [simp]: "inv_after_clear (as, lm) (2 * n + 4, l, []) ires
- \<Longrightarrow> inv_on_right_moving (as, lm) (2 * n + 5, Bk # l, []) ires"
-by(insert
- inv_after_clear_2_inv_on_right_moving[of as lm n l "[]"], simp)
-
-(*inv: from on_right_moving to on_right_movign*)
-lemma [simp]: "inv_on_right_moving (as, lm) (2 * n + 5, l, Oc # r) ires
- \<Longrightarrow> inv_on_right_moving (as, lm) (2 * n + 5, Oc # l, r) ires"
-apply(auto simp: inv_on_right_moving.simps)
-apply(rule_tac x = lm1 in exI, rule_tac x = lm2 in exI,
- rule_tac x = "ml + mr" in exI, simp)
-apply(rule_tac x = "Suc ml" in exI,
- rule_tac x = "mr - 1" in exI, simp)
-apply(case_tac mr, auto simp: exponent_def )
-apply(rule_tac x = lm1 in exI, rule_tac x = "[]" in exI,
- rule_tac x = "ml + mr" in exI, simp)
-apply(rule_tac x = "Suc ml" in exI,
- rule_tac x = "mr - 1" in exI, simp)
-apply(case_tac mr, auto split: if_splits simp: exponent_def)
-done
-
-lemma inv_on_right_moving_2_inv_on_right_moving[simp]:
- "inv_on_right_moving (as, lm) (2 * n + 5, l, Bk # r) ires
- \<Longrightarrow> inv_after_write (as, lm) (Suc (Suc (2 * n)), l, Oc # r) ires"
-apply(auto simp: inv_on_right_moving.simps inv_after_write.simps )
-apply(case_tac mr, auto simp: exponent_def split: if_splits)
-apply(case_tac [!] mr, simp_all)
-done
-
-lemma [simp]: "inv_on_right_moving (as, lm) (2 * n + 5, l, []) ires\<Longrightarrow>
- inv_on_right_moving (as, lm) (2 * n + 5, l, [Bk]) ires"
-apply(auto simp: inv_on_right_moving.simps exponent_def)
-apply(rule_tac x = lm1 in exI, rule_tac x = "[]" in exI, simp)
-apply (rule_tac x = m in exI, auto split: if_splits simp: exponent_def)
-done
-
-(*inv: from on_right_moving to after_write*)
-lemma [simp]: "inv_on_right_moving (as, lm) (2 * n + 5, l, []) ires
- \<Longrightarrow> inv_after_write (as, lm) (Suc (Suc (2 * n)), l, [Oc]) ires"
-apply(rule_tac inv_on_right_moving_2_inv_on_right_moving, simp)
-done
-
-(*inv: from on_left_moving to on_left_moving*)
-lemma [simp]: "inv_on_left_moving_in_middle_B (as, lm)
- (s, l, Oc # r) ires = False"
-apply(auto simp: inv_on_left_moving_in_middle_B.simps )
-done
-
-lemma [simp]: "inv_on_left_moving_norm (as, lm) (s, l, Bk # r) ires
- = False"
-apply(auto simp: inv_on_left_moving_norm.simps)
-apply(case_tac [!] mr, auto simp: )
-done
-
-lemma [intro]: "\<exists>rna. Oc # Oc\<^bsup>m\<^esup> @ Bk # <lm> @ Bk\<^bsup>rn\<^esup> = <m # lm> @ Bk\<^bsup>rna\<^esup>"
-apply(case_tac lm, simp add: tape_of_nl_abv tape_of_nat_list.simps)
-apply(rule_tac x = "Suc rn" in exI, simp)
-apply(case_tac list, simp_all add: tape_of_nl_abv tape_of_nat_list.simps, auto)
-done
-
-
-lemma [simp]:
- "\<lbrakk>inv_on_left_moving_norm (as, lm) (s, l, Oc # r) ires;
- hd l = Bk; l \<noteq> []\<rbrakk> \<Longrightarrow>
- inv_on_left_moving_in_middle_B (as, lm) (s, tl l, Bk # Oc # r) ires"
-apply(case_tac l, simp, simp)
-apply(simp only: inv_on_left_moving_norm.simps
- inv_on_left_moving_in_middle_B.simps)
-apply(erule_tac exE)+
-apply(rule_tac x = lm1 in exI, rule_tac x = "m # lm2" in exI, auto)
-apply(case_tac [!] ml, auto)
-apply(rule_tac [!] x = 0 in exI, simp_all add: tape_of_nl_abv tape_of_nat_list.simps)
-done
-
-lemma [simp]: "\<lbrakk>inv_on_left_moving_norm (as, lm) (s, l, Oc # r) ires;
- hd l = Oc; l \<noteq> []\<rbrakk>
- \<Longrightarrow> inv_on_left_moving_norm (as, lm)
- (s, tl l, Oc # Oc # r) ires"
-apply(simp only: inv_on_left_moving_norm.simps)
-apply(erule exE)+
-apply(rule_tac x = lm1 in exI, rule_tac x = lm2 in exI,
- rule_tac x = m in exI, rule_tac x = "ml - 1" in exI,
- rule_tac x = "Suc mr" in exI, rule_tac x = rn in exI, simp)
-apply(case_tac ml, auto simp: exponent_def split: if_splits)
-done
-
-lemma [simp]: "inv_on_left_moving_norm (as, lm) (s, [], Oc # r) ires
- \<Longrightarrow> inv_on_left_moving_in_middle_B (as, lm) (s, [], Bk # Oc # r) ires"
-apply(auto simp: inv_on_left_moving_norm.simps
- inv_on_left_moving_in_middle_B.simps split: if_splits)
-done
-
-lemma [simp]:"inv_on_left_moving (as, lm) (s, l, Oc # r) ires
- \<Longrightarrow> (l = [] \<longrightarrow> inv_on_left_moving (as, lm) (s, [], Bk # Oc # r) ires)
- \<and> (l \<noteq> [] \<longrightarrow> inv_on_left_moving (as, lm) (s, tl l, hd l # Oc # r) ires)"
-apply(simp add: inv_on_left_moving.simps)
-apply(case_tac "l \<noteq> []", rule conjI, simp, simp)
-apply(case_tac "hd l", simp, simp, simp)
-done
-
-(*inv: from on_left_moving to check_left_moving*)
-lemma [simp]: "inv_on_left_moving_in_middle_B (as, lm)
- (s, Bk # list, Bk # r) ires
- \<Longrightarrow> inv_check_left_moving_on_leftmost (as, lm)
- (s', list, Bk # Bk # r) ires"
-apply(auto simp: inv_on_left_moving_in_middle_B.simps
- inv_check_left_moving_on_leftmost.simps split: if_splits)
-apply(case_tac [!] "rev lm1", simp_all)
-apply(case_tac [!] lista, simp_all add: tape_of_nl_abv tape_of_nat_list.simps)
-done
-
-lemma [simp]:
- "inv_check_left_moving_in_middle (as, lm) (s, l, Bk # r) ires= False"
-by(auto simp: inv_check_left_moving_in_middle.simps )
-
-lemma [simp]:
- "inv_on_left_moving_in_middle_B (as, lm) (s, [], Bk # r) ires\<Longrightarrow>
- inv_check_left_moving_on_leftmost (as, lm) (s', [], Bk # Bk # r) ires"
-apply(auto simp: inv_on_left_moving_in_middle_B.simps
- inv_check_left_moving_on_leftmost.simps split: if_splits)
-done
-
-
-lemma [simp]: "inv_check_left_moving_on_leftmost (as, lm)
- (s, list, Oc # r) ires= False"
-by(auto simp: inv_check_left_moving_on_leftmost.simps split: if_splits)
-
-lemma [simp]: "inv_on_left_moving_in_middle_B (as, lm)
- (s, Oc # list, Bk # r) ires
- \<Longrightarrow> inv_check_left_moving_in_middle (as, lm) (s', list, Oc # Bk # r) ires"
-apply(auto simp: inv_on_left_moving_in_middle_B.simps
- inv_check_left_moving_in_middle.simps split: if_splits)
-done
-
-lemma inv_on_left_moving_2_check_left_moving[simp]:
- "inv_on_left_moving (as, lm) (s, l, Bk # r) ires
- \<Longrightarrow> (l = [] \<longrightarrow> inv_check_left_moving (as, lm) (s', [], Bk # Bk # r) ires)
- \<and> (l \<noteq> [] \<longrightarrow>
- inv_check_left_moving (as, lm) (s', tl l, hd l # Bk # r) ires)"
-apply(simp add: inv_on_left_moving.simps inv_check_left_moving.simps)
-apply(case_tac l, simp, simp)
-apply(case_tac a, simp, simp)
-done
-
-lemma [simp]: "inv_on_left_moving_norm (as, lm) (s, l, []) ires = False"
-apply(auto simp: inv_on_left_moving_norm.simps)
-by(case_tac [!] mr, auto)
-
-lemma [simp]: "inv_on_left_moving (as, lm) (s, l, []) ires\<Longrightarrow>
- inv_on_left_moving (as, lm) (6 + 2 * n, l, [Bk]) ires"
-apply(simp add: inv_on_left_moving.simps)
-apply(auto simp: inv_on_left_moving_in_middle_B.simps)
-done
-
-lemma [simp]: "inv_on_left_moving (as, lm) (s, l, []) ires = False"
-apply(simp add: inv_on_left_moving.simps)
-apply(simp add: inv_on_left_moving_in_middle_B.simps)
-done
-
-lemma [simp]: "inv_on_left_moving (as, lm) (s, l, []) ires
- \<Longrightarrow> (l = [] \<longrightarrow> inv_check_left_moving (as, lm) (s', [], [Bk]) ires) \<and>
- (l \<noteq> [] \<longrightarrow> inv_check_left_moving (as, lm) (s', tl l, [hd l]) ires)"
-by simp
-
-lemma Oc_Bk_Cons_ex[simp]:
- "Oc # Bk # list = <lm::nat list> @ Bk\<^bsup>ln\<^esup> \<Longrightarrow>
- \<exists>ln. list = <tl (lm)> @ Bk\<^bsup>ln\<^esup>"
-apply(case_tac "lm", simp)
-apply(case_tac ln, simp_all add: exponent_def)
-apply(case_tac lista,
- auto simp: tape_of_nl_abv tape_of_nat_list.simps exponent_def)
-apply(case_tac [!] a, auto simp: )
-apply(case_tac ln, simp, rule_tac x = nat in exI, simp)
-done
-
-lemma [simp]:
- "Oc # Bk # list = <rev lm1::nat list> @ Bk\<^bsup>ln\<^esup> \<Longrightarrow>
- \<exists>rna. Oc # Bk # <lm2> @ Bk\<^bsup>rn\<^esup> = <hd (rev lm1) # lm2> @ Bk\<^bsup>rna\<^esup>"
-apply(frule Oc_Bk_Cons, simp)
-apply(case_tac lm2,
- auto simp: tape_of_nl_abv tape_of_nat_list.simps exponent_def )
-apply(rule_tac x = "Suc rn" in exI, simp)
-done
-
-(*inv: from check_left_moving to on_left_moving*)
-lemma [intro]: "\<exists>rna. a # a\<^bsup>rn\<^esup> = a\<^bsup>rna\<^esup>"
-apply(rule_tac x = "Suc rn" in exI, simp)
-done
-
-lemma
-inv_check_left_moving_in_middle_2_on_left_moving_in_middle_B[simp]:
-"inv_check_left_moving_in_middle (as, lm) (s, Bk # list, Oc # r) ires
- \<Longrightarrow> inv_on_left_moving_in_middle_B (as, lm) (s', list, Bk # Oc # r) ires"
-apply(simp only: inv_check_left_moving_in_middle.simps
- inv_on_left_moving_in_middle_B.simps)
-apply(erule_tac exE)+
-apply(rule_tac x = "rev (tl (rev lm1))" in exI,
- rule_tac x = "[hd (rev lm1)] @ lm2" in exI, auto)
-apply(case_tac [!] "rev lm1",simp_all add: tape_of_nl_abv tape_of_nat_list.simps)
-apply(case_tac [!] a, simp_all)
-apply(case_tac [1] lm2, simp_all add: tape_of_nat_list.simps, auto)
-apply(case_tac [3] lm2, simp_all add: tape_of_nat_list.simps, auto)
-apply(case_tac [!] lista, simp_all add: tape_of_nat_list.simps)
-done
-
-lemma [simp]:
- "inv_check_left_moving_in_middle (as, lm) (s, [], Oc # r) ires\<Longrightarrow>
- inv_check_left_moving_in_middle (as, lm) (s', [Bk], Oc # r) ires"
-apply(auto simp: inv_check_left_moving_in_middle.simps )
-done
-
-lemma [simp]:
- "inv_check_left_moving_in_middle (as, lm) (s, [], Oc # r) ires
- \<Longrightarrow> inv_on_left_moving_in_middle_B (as, lm) (s', [], Bk # Oc # r) ires"
-apply(insert
-inv_check_left_moving_in_middle_2_on_left_moving_in_middle_B[of
- as lm n "[]" r], simp)
-done
-
-lemma [simp]: "a\<^bsup>0\<^esup> = []"
-apply(simp add: exponent_def)
-done
-
-lemma [simp]: "inv_check_left_moving_in_middle (as, lm)
- (s, Oc # list, Oc # r) ires
- \<Longrightarrow> inv_on_left_moving_norm (as, lm) (s', list, Oc # Oc # r) ires"
-apply(auto simp: inv_check_left_moving_in_middle.simps
- inv_on_left_moving_norm.simps)
-apply(rule_tac x = "rev (tl (rev lm1))" in exI,
- rule_tac x = lm2 in exI, rule_tac x = "hd (rev lm1)" in exI)
-apply(rule_tac conjI)
-apply(case_tac "rev lm1", simp, simp)
-apply(rule_tac x = "hd (rev lm1) - 1" in exI, auto)
-apply(rule_tac [!] x = "Suc (Suc 0)" in exI, simp)
-apply(case_tac [!] "rev lm1", simp_all)
-apply(case_tac [!] a, simp_all add: tape_of_nl_abv tape_of_nat_list.simps, auto)
-done
-
-lemma [simp]: "inv_check_left_moving (as, lm) (s, l, Oc # r) ires
-\<Longrightarrow> (l = [] \<longrightarrow> inv_on_left_moving (as, lm) (s', [], Bk # Oc # r) ires) \<and>
- (l \<noteq> [] \<longrightarrow> inv_on_left_moving (as, lm) (s', tl l, hd l # Oc # r) ires)"
-apply(case_tac l,
- auto simp: inv_check_left_moving.simps inv_on_left_moving.simps)
-apply(case_tac a, simp, simp)
-done
-
-(*inv: check_left_moving to after_left_moving*)
-lemma [simp]: "inv_check_left_moving (as, lm) (s, l, Bk # r) ires
- \<Longrightarrow> inv_after_left_moving (as, lm) (s', Bk # l, r) ires"
-apply(auto simp: inv_check_left_moving.simps
- inv_check_left_moving_on_leftmost.simps inv_after_left_moving.simps)
-done
-
-
-lemma [simp]:"inv_check_left_moving (as, lm) (s, l, []) ires
- \<Longrightarrow> inv_after_left_moving (as, lm) (s', Bk # l, []) ires"
-by(simp add: inv_check_left_moving.simps
-inv_check_left_moving_in_middle.simps
-inv_check_left_moving_on_leftmost.simps)
-
-(*inv: after_left_moving to inv_stop*)
-lemma [simp]: "inv_after_left_moving (as, lm) (s, l, Bk # r) ires
- \<Longrightarrow> inv_stop (as, lm) (s', Bk # l, r) ires"
-apply(auto simp: inv_after_left_moving.simps inv_stop.simps)
-done
-
-lemma [simp]: "inv_after_left_moving (as, lm) (s, l, []) ires
- \<Longrightarrow> inv_stop (as, lm) (s', Bk # l, []) ires"
-by(auto simp: inv_after_left_moving.simps)
-
-(*inv: stop to stop*)
-lemma [simp]: "inv_stop (as, lm) (x, l, r) ires \<Longrightarrow>
- inv_stop (as, lm) (y, l, r) ires"
-apply(simp add: inv_stop.simps)
-done
-
-lemma [simp]: "inv_after_clear (as, lm) (s, aaa, Oc # xs) ires= False"
-apply(auto simp: inv_after_clear.simps )
-done
-
-lemma [simp]:
- "inv_after_left_moving (as, lm) (s, aaa, Oc # xs) ires = False"
-by(auto simp: inv_after_left_moving.simps )
-
-lemma start_of_not0: "as \<noteq> 0 \<Longrightarrow> start_of ly as > 0"
-apply(rule startof_not0)
-done
-
-text {*
- The single step currectness of the TM complied from Abacus instruction @{text "Inc n"}.
- It shows every single step execution of this TM keeps the invariant.
-*}
-
-lemma inc_inv_step:
- assumes
- -- {* Invariant holds on the start *}
- h11: "inc_inv ly n (as, am) tc ires"
- -- {* The layout of Abacus program @{text "aprog"} is @{text "ly"} *}
- and h12: "ly = layout_of aprog"
- -- {* The instruction at position @{text "as"} is @{text "Inc n"} *}
- and h21: "abc_fetch as aprog = Some (Inc n)"
- -- {* TM not yet reach the final state, where @{text "start_of ly as + 2*n + 9"} is the state
- where the current TM stops and the next TM starts. *}
- and h22: "(\<lambda> (s, l, r). s \<noteq> start_of ly as + 2*n + 9) tc"
- shows
- -- {*
- Single step execution of the TM keeps the invaraint, where
- the TM compiled from @{text "Inc n"} is @{text "(ci ly (start_of ly as) (Inc n))"}
- @{text "start_of ly as - Suc 0)"} is the offset used to execute this {\em shifted}
- TM.
- *}
- "inc_inv ly n (as, am) (t_step tc (ci ly (start_of ly as) (Inc n), start_of ly as - Suc 0)) ires"
-proof -
- from h21 h22 have h3 : "start_of (layout_of aprog) as > 0"
- apply(case_tac as, simp add: start_of.simps abc_fetch.simps)
- apply(insert start_of_not0[of as "layout_of aprog"], simp)
- done
- from h11 h12 and h21 h22 and this show ?thesis
- apply(case_tac tc, simp)
- apply(case_tac "a = 0",
- auto split:if_splits simp add:t_step.simps,
- tactic {* ALLGOALS (resolve_tac [@{thm fetch_intro}]) *})
- apply (simp_all add:fetch_simps new_tape.simps)
- done
-qed
-
-
-lemma t_steps_ind: "t_steps tc (p, off) (Suc n)
- = t_step (t_steps tc (p, off) n) (p, off)"
-apply(induct n arbitrary: tc)
-apply(simp add: t_steps.simps)
-apply(simp add: t_steps.simps)
-done
-
-definition lex_pair :: "((nat \<times> nat) \<times> (nat \<times> nat)) set"
- where
- "lex_pair \<equiv> less_than <*lex*> less_than"
-
-definition lex_triple ::
- "((nat \<times> (nat \<times> nat)) \<times> (nat \<times> (nat \<times> nat))) set"
- where "lex_triple \<equiv> less_than <*lex*> lex_pair"
-
-definition lex_square ::
- "((nat \<times> nat \<times> nat \<times> nat) \<times> (nat \<times> nat \<times> nat \<times> nat)) set"
- where "lex_square \<equiv> less_than <*lex*> lex_triple"
-
-fun abc_inc_stage1 :: "t_conf \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat"
- where
- "abc_inc_stage1 (s, l, r) ss n =
- (if s = 0 then 0
- else if s \<le> ss+2*n+1 then 5
- else if s\<le> ss+2*n+5 then 4
- else if s \<le> ss+2*n+7 then 3
- else if s = ss+2*n+8 then 2
- else 1)"
-
-fun abc_inc_stage2 :: "t_conf \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat"
- where
- "abc_inc_stage2 (s, l, r) ss n =
- (if s \<le> ss + 2*n + 1 then 0
- else if s = ss + 2*n + 2 then length r
- else if s = ss + 2*n + 3 then length r
- else if s = ss + 2*n + 4 then length r
- else if s = ss + 2*n + 5 then
- if r \<noteq> [] then length r
- else 1
- else if s = ss+2*n+6 then length l
- else if s = ss+2*n+7 then length l
- else 0)"
-
-fun abc_inc_stage3 :: "t_conf \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> block list \<Rightarrow> nat"
- where
- "abc_inc_stage3 (s, l, r) ss n ires = (
- if s = ss + 2*n + 3 then 4
- else if s = ss + 2*n + 4 then 3
- else if s = ss + 2*n + 5 then
- if r \<noteq> [] \<and> hd r = Oc then 2
- else 1
- else if s = ss + 2*n + 2 then 0
- else if s = ss + 2*n + 6 then
- if l = Bk # ires \<and> r \<noteq> [] \<and> hd r = Oc then 2
- else 1
- else if s = ss + 2*n + 7 then
- if r \<noteq> [] \<and> hd r = Oc then 3
- else 0
- else ss+2*n+9 - s)"
-
-fun abc_inc_stage4 :: "t_conf \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> block list \<Rightarrow> nat"
- where
- "abc_inc_stage4 (s, l, r) ss n ires =
- (if s \<le> ss+2*n+1 \<and> (s - ss) mod 2 = 0 then
- if (r\<noteq>[] \<and> hd r = Oc) then 0
- else 1
- else if (s \<le> ss+2*n+1 \<and> (s - ss) mod 2 = Suc 0)
- then length r
- else if s = ss + 2*n + 6 then
- if l = Bk # ires \<and> hd r = Bk then 0
- else Suc (length l)
- else 0)"
-
-fun abc_inc_measure :: "(t_conf \<times> nat \<times> nat \<times> block list) \<Rightarrow>
- (nat \<times> nat \<times> nat \<times> nat)"
- where
- "abc_inc_measure (c, ss, n, ires) =
- (abc_inc_stage1 c ss n, abc_inc_stage2 c ss n,
- abc_inc_stage3 c ss n ires, abc_inc_stage4 c ss n ires)"
-
-definition abc_inc_LE :: "(((nat \<times> block list \<times> block list) \<times> nat \<times>
- nat \<times> block list) \<times> ((nat \<times> block list \<times> block list) \<times> nat \<times> nat \<times> block list)) set"
- where "abc_inc_LE \<equiv> (inv_image lex_square abc_inc_measure)"
-
-lemma wf_lex_triple: "wf lex_triple"
-by (auto intro:wf_lex_prod simp:lex_triple_def lex_pair_def)
-
-lemma wf_lex_square: "wf lex_square"
-by (auto intro:wf_lex_triple simp:lex_triple_def lex_square_def lex_pair_def)
-
-lemma wf_abc_inc_le[intro]: "wf abc_inc_LE"
-by(auto intro:wf_inv_image wf_lex_square simp:abc_inc_LE_def)
-
-(********************************************************************)
-declare inc_inv.simps[simp del]
-
-lemma halt_lemma2':
- "\<lbrakk>wf LE; \<forall> n. ((\<not> P (f n) \<and> Q (f n)) \<longrightarrow>
- (Q (f (Suc n)) \<and> (f (Suc n), (f n)) \<in> LE)); Q (f 0)\<rbrakk>
- \<Longrightarrow> \<exists> n. P (f n)"
-apply(intro exCI, simp)
-apply(subgoal_tac "\<forall> n. Q (f n)", simp)
-apply(drule_tac f = f in wf_inv_image)
-apply(simp add: inv_image_def)
-apply(erule wf_induct, simp)
-apply(erule_tac x = x in allE)
-apply(erule_tac x = n in allE, erule_tac x = n in allE)
-apply(erule_tac x = "Suc x" in allE, simp)
-apply(rule_tac allI)
-apply(induct_tac n, simp)
-apply(erule_tac x = na in allE, simp)
-done
-
-lemma halt_lemma2'':
- "\<lbrakk>P (f n); \<not> P (f (0::nat))\<rbrakk> \<Longrightarrow>
- \<exists> n. (P (f n) \<and> (\<forall> i < n. \<not> P (f i)))"
-apply(induct n rule: nat_less_induct, auto)
-done
-
-lemma halt_lemma2''':
- "\<lbrakk>\<forall>n. \<not> P (f n) \<and> Q (f n) \<longrightarrow> Q (f (Suc n)) \<and> (f (Suc n), f n) \<in> LE;
- Q (f 0); \<forall>i<na. \<not> P (f i)\<rbrakk> \<Longrightarrow> Q (f na)"
-apply(induct na, simp, simp)
-done
-
-lemma halt_lemma2:
- "\<lbrakk>wf LE;
- \<forall> n. ((\<not> P (f n) \<and> Q (f n)) \<longrightarrow> (Q (f (Suc n)) \<and> (f (Suc n), (f n)) \<in> LE));
- Q (f 0); \<not> P (f 0)\<rbrakk>
- \<Longrightarrow> \<exists> n. P (f n) \<and> Q (f n)"
-apply(insert halt_lemma2' [of LE P f Q], simp, erule_tac exE)
-apply(subgoal_tac "\<exists> n. (P (f n) \<and> (\<forall> i < n. \<not> P (f i)))")
-apply(erule_tac exE)+
-apply(rule_tac x = na in exI, auto)
-apply(rule halt_lemma2''', simp, simp, simp)
-apply(erule_tac halt_lemma2'', simp)
-done
-
-lemma [simp]:
- "\<lbrakk>ly = layout_of aprog; abc_fetch as aprog = Some (Inc n)\<rbrakk>
- \<Longrightarrow> start_of ly (Suc as) = start_of ly as + 2*n +9"
-apply(case_tac as, auto simp: abc_fetch.simps start_of.simps
- layout_of.simps length_of.simps split: if_splits)
-done
-
-lemma inc_inv_init:
- "\<lbrakk>abc_fetch as aprog = Some (Inc n);
- crsp_l ly (as, am) (start_of ly as, l, r) ires; ly = layout_of aprog\<rbrakk>
- \<Longrightarrow> inc_inv ly n (as, am) (start_of ly as, l, r) ires"
-apply(auto simp: crsp_l.simps inc_inv.simps
- inv_locate_a.simps at_begin_fst_bwtn.simps
- at_begin_fst_awtn.simps at_begin_norm.simps )
-apply(auto intro: startof_not0)
-done
-
-lemma inc_inv_stop_pre[simp]:
- "\<lbrakk>ly = layout_of aprog; inc_inv ly n (as, am) (s, l, r) ires;
- s = start_of ly as; abc_fetch as aprog = Some (Inc n)\<rbrakk>
- \<Longrightarrow> (\<forall>na. \<not> (\<lambda>((s, l, r), ss, n', ires'). s = start_of ly (Suc as))
- (t_steps (s, l, r) (ci ly (start_of ly as)
- (Inc n), start_of ly as - Suc 0) na, s, n, ires) \<and>
- (\<lambda>((s, l, r), ss, n', ires'). inc_inv ly n (as, am) (s, l, r) ires')
- (t_steps (s, l, r) (ci ly (start_of ly as)
- (Inc n), start_of ly as - Suc 0) na, s, n, ires) \<longrightarrow>
- (\<lambda>((s, l, r), ss, n', ires'). inc_inv ly n (as, am) (s, l, r) ires')
- (t_steps (s, l, r) (ci ly (start_of ly as)
- (Inc n), start_of ly as - Suc 0) (Suc na), s, n, ires) \<and>
- ((t_steps (s, l, r) (ci ly (start_of ly as) (Inc n),
- start_of ly as - Suc 0) (Suc na), s, n, ires),
- t_steps (s, l, r) (ci ly (start_of ly as)
- (Inc n), start_of ly as - Suc 0) na, s, n, ires) \<in> abc_inc_LE)"
-apply(rule allI, rule impI, simp add: t_steps_ind,
- rule conjI, erule_tac conjE)
-apply(rule_tac inc_inv_step, simp, simp, simp)
-apply(case_tac "t_steps (start_of (layout_of aprog) as, l, r) (ci (layout_of aprog)
- (start_of (layout_of aprog) as) (Inc n), start_of (layout_of aprog) as - Suc 0) na", simp)
-proof -
- fix na
- assume h1: "abc_fetch as aprog = Some (Inc n)"
- "\<not> (\<lambda>(s, l, r) (ss, n', ires'). s = start_of (layout_of aprog) as + 2 * n + 9)
- (t_steps (start_of (layout_of aprog) as, l, r) (ci (layout_of aprog)
- (start_of (layout_of aprog) as) (Inc n), start_of (layout_of aprog) as - Suc 0) na)
- (start_of (layout_of aprog) as, n, ires) \<and>
- inc_inv (layout_of aprog) n (as, am) (t_steps (start_of (layout_of aprog) as, l, r)
- (ci (layout_of aprog) (start_of (layout_of aprog) as) (Inc n), start_of (layout_of aprog) as - Suc 0) na) ires"
- from h1 have h2: "start_of (layout_of aprog) as > 0"
- apply(rule_tac startof_not0)
- done
- from h1 and h2 show "((t_step (t_steps (start_of (layout_of aprog) as, l, r) (ci (layout_of aprog)
- (start_of (layout_of aprog) as) (Inc n), start_of (layout_of aprog) as - Suc 0) na)
- (ci (layout_of aprog) (start_of (layout_of aprog) as) (Inc n), start_of (layout_of aprog) as - Suc 0),
- start_of (layout_of aprog) as, n, ires),
- t_steps (start_of (layout_of aprog) as, l, r)
- (ci (layout_of aprog) (start_of (layout_of aprog) as) (Inc n), start_of (layout_of aprog) as - Suc 0) na,
- start_of (layout_of aprog) as, n, ires)
- \<in> abc_inc_LE"
- apply(case_tac "(t_steps (start_of (layout_of aprog) as, l, r)
- (ci (layout_of aprog)
- (start_of (layout_of aprog) as) (Inc n),
- start_of (layout_of aprog) as - Suc 0) na)", simp)
- apply(case_tac "a = 0",
- auto split:if_splits simp add:t_step.simps inc_inv.simps,
- tactic {* ALLGOALS (resolve_tac [@{thm fetch_intro}]) *})
- apply(simp_all add:fetch_simps new_tape.simps)
- apply(auto simp add: abc_inc_LE_def
- lex_square_def lex_triple_def lex_pair_def
- inv_after_write.simps inv_after_move.simps inv_after_clear.simps
- inv_on_left_moving.simps inv_on_left_moving_norm.simps split: if_splits)
- done
-qed
-
-lemma inc_inv_stop_pre1:
- "\<lbrakk>
- ly = layout_of aprog;
- abc_fetch as aprog = Some (Inc n);
- s = start_of ly as;
- inc_inv ly n (as, am) (s, l, r) ires
- \<rbrakk> \<Longrightarrow>
- (\<exists> stp > 0. (\<lambda> (s', l', r').
- s' = start_of ly (Suc as) \<and>
- inc_inv ly n (as, am) (s', l', r') ires)
- (t_steps (s, l, r) (ci ly (start_of ly as) (Inc n),
- start_of ly as - Suc 0) stp))"
-apply(insert halt_lemma2[of abc_inc_LE
- "\<lambda> ((s, l, r), ss, n', ires'). s = start_of ly (Suc as)"
- "(\<lambda> stp. (t_steps (s, l, r)
- (ci ly (start_of ly as) (Inc n),
- start_of ly as - Suc 0) stp, s, n, ires))"
- "\<lambda> ((s, l, r), ss, n'). inc_inv ly n (as, am) (s, l, r) ires"])
-apply(insert wf_abc_inc_le)
-apply(insert inc_inv_stop_pre[of ly aprog n as am s l r ires], simp)
-apply(simp only: t_steps.simps, auto)
-apply(rule_tac x = na in exI)
-apply(case_tac "(t_steps (start_of (layout_of aprog) as, l, r)
- (ci (layout_of aprog) (start_of (layout_of aprog) as)
- (Inc n), start_of (layout_of aprog) as - Suc 0) na)", simp)
-apply(case_tac na, simp add: t_steps.simps, simp)
-done
-
-lemma inc_inv_stop:
- assumes program_and_layout:
- -- {* There is an Abacus program @{text "aprog"} and its layout is @{text "ly"}: *}
- "ly = layout_of aprog"
- and an_instruction:
- -- {* There is an instruction @{text "Inc n"} at postion @{text "as"} of @{text "aprog"} *}
- "abc_fetch as aprog = Some (Inc n)"
- and the_start_state:
- -- {* According to @{text "ly"} and @{text "as"},
- the start state of the TM compiled from this
- @{text "Inc n"} instruction should be @{text "s"}:
- *}
- "s = start_of ly as"
- and inv:
- -- {* Invariant holds on configuration @{text "(s, l, r)"} *}
- "inc_inv ly n (as, am) (s, l, r) ires"
- shows -- {* After @{text "stp"} steps of execution, the compiled
- TM reaches the start state of next compiled TM and the invariant
- still holds.
- *}
- "(\<exists> stp > 0. (\<lambda> (s', l', r').
- s' = start_of ly (Suc as) \<and>
- inc_inv ly n (as, am) (s', l', r') ires)
- (t_steps (s, l, r) (ci ly (start_of ly as) (Inc n),
- start_of ly as - Suc 0) stp))"
-proof -
- from inc_inv_stop_pre1 [OF program_and_layout an_instruction the_start_state inv]
- show ?thesis .
-qed
-
-lemma inc_inv_stop_cond:
- "\<lbrakk>ly = layout_of aprog;
- s' = start_of ly (as + 1);
- inc_inv ly n (as, lm) (s', (l', r')) ires;
- abc_fetch as aprog = Some (Inc n)\<rbrakk> \<Longrightarrow>
- crsp_l ly (Suc as, abc_lm_s lm n (Suc (abc_lm_v lm n)))
- (s', l', r') ires"
-apply(subgoal_tac "s' = start_of ly as + 2*n + 9", simp)
-apply(auto simp: inc_inv.simps inv_stop.simps crsp_l.simps )
-done
-
-lemma inc_crsp_ex_pre:
- "\<lbrakk>ly = layout_of aprog;
- crsp_l ly (as, am) tc ires;
- abc_fetch as aprog = Some (Inc n)\<rbrakk>
- \<Longrightarrow> \<exists>stp > 0. crsp_l ly (abc_step_l (as, am) (Some (Inc n)))
- (t_steps tc (ci ly (start_of ly as) (Inc n),
- start_of ly as - Suc 0) stp) ires"
-proof(case_tac tc, simp add: abc_step_l.simps)
- fix a b c
- assume h1: "ly = layout_of aprog"
- "crsp_l (layout_of aprog) (as, am) (a, b, c) ires"
- "abc_fetch as aprog = Some (Inc n)"
- hence h2: "a = start_of ly as"
- by(auto simp: crsp_l.simps)
- from h1 and h2 have h3:
- "inc_inv ly n (as, am) (start_of ly as, b, c) ires"
- by(rule_tac inc_inv_init, simp, simp, simp)
- from h1 and h2 and h3 have h4:
- "(\<exists> stp > 0. (\<lambda> (s', l', r'). s' =
- start_of ly (Suc as) \<and> inc_inv ly n (as, am) (s', l', r') ires)
- (t_steps (a, b, c) (ci ly (start_of ly as)
- (Inc n), start_of ly as - Suc 0) stp))"
- apply(rule_tac inc_inv_stop, auto)
- done
- from h1 and h2 and h3 and h4 show
- "\<exists>stp > 0. crsp_l (layout_of aprog)
- (Suc as, abc_lm_s am n (Suc (abc_lm_v am n)))
- (t_steps (a, b, c) (ci (layout_of aprog)
- (start_of (layout_of aprog) as) (Inc n),
- start_of (layout_of aprog) as - Suc 0) stp) ires"
- apply(erule_tac exE)
- apply(rule_tac x = stp in exI)
- apply(case_tac "(t_steps (a, b, c) (ci (layout_of aprog)
- (start_of (layout_of aprog) as) (Inc n),
- start_of (layout_of aprog) as - Suc 0) stp)", simp)
- apply(rule_tac inc_inv_stop_cond, auto)
- done
-qed
-
-text {*
- The total correctness of the compilaton of @{text "Inc n"} instruction.
-*}
-
-lemma inc_crsp_ex:
- assumes layout:
- -- {* For any Abacus program @{text "aprog"}, assuming its layout is @{text "ly"} *}
- "ly = layout_of aprog"
- and corresponds:
- -- {* Abacus configuration @{text "(as, am)"} is in correspondence with
- TM configuration @{text "tc"} *}
- "crsp_l ly (as, am) tc ires"
- and inc:
- -- {* There is an instruction @{text "Inc n"} at postion @{text "as"} of @{text "aprog"} *}
- "abc_fetch as aprog = Some (Inc n)"
- shows
- -- {*
- After @{text "stp"} steps of execution, the TM compiled from this @{text "Inc n"}
- stops with a configuration which corresponds to the Abacus configuration obtained
- from the execution of this @{text "Inc n"} instruction.
- *}
- "\<exists>stp > 0. crsp_l ly (abc_step_l (as, am) (Some (Inc n)))
- (t_steps tc (ci ly (start_of ly as) (Inc n),
- start_of ly as - Suc 0) stp) ires"
-proof -
- from inc_crsp_ex_pre [OF layout corresponds inc] show ?thesis .
-qed
-
-(*
-subsection {* The compilation of @{text "Dec n e"} *}
-*)
-
-text {*
- The lemmas in this section lead to the correctness of the compilation
- of @{text "Dec n e"} instruction using the same techniques as
- @{text "Inc n"}.
-*}
-
-type_synonym dec_inv_t = "(nat * nat list) \<Rightarrow> t_conf \<Rightarrow> block list \<Rightarrow> bool"
-
-fun dec_first_on_right_moving :: "nat \<Rightarrow> dec_inv_t"
- where
- "dec_first_on_right_moving n (as, lm) (s, l, r) ires =
- (\<exists> lm1 lm2 m ml mr rn. lm = lm1 @ [m] @ lm2 \<and>
- ml + mr = Suc m \<and> length lm1 = n \<and> ml > 0 \<and> m > 0 \<and>
- (if lm1 = [] then l = Oc\<^bsup>ml\<^esup> @ Bk # Bk # ires
- else l = (Oc\<^bsup>ml\<^esup>) @ [Bk] @ <rev lm1> @ Bk # Bk # ires) \<and>
- ((r = (Oc\<^bsup>mr\<^esup>) @ [Bk] @ <lm2> @ (Bk\<^bsup>rn\<^esup>)) \<or> (r = (Oc\<^bsup>mr\<^esup>) \<and> lm2 = [])))"
-
-fun dec_on_right_moving :: "dec_inv_t"
- where
- "dec_on_right_moving (as, lm) (s, l, r) ires =
- (\<exists> lm1 lm2 m ml mr rn. lm = lm1 @ [m] @ lm2 \<and>
- ml + mr = Suc (Suc m) \<and>
- (if lm1 = [] then l = Oc\<^bsup>ml\<^esup> @ Bk # Bk # ires
- else l = (Oc\<^bsup>ml\<^esup>) @ [Bk] @ <rev lm1> @ Bk # Bk # ires) \<and>
- ((r = (Oc\<^bsup>mr\<^esup>) @ [Bk] @ <lm2> @ (Bk\<^bsup>rn\<^esup>)) \<or> (r = (Oc\<^bsup>mr\<^esup>) \<and> lm2 = [])))"
-
-fun dec_after_clear :: "dec_inv_t"
- where
- "dec_after_clear (as, lm) (s, l, r) ires =
- (\<exists> lm1 lm2 m ml mr rn. lm = lm1 @ [m] @ lm2 \<and>
- ml + mr = Suc m \<and> ml = Suc m \<and> r \<noteq> [] \<and> r \<noteq> [] \<and>
- (if lm1 = [] then l = Oc\<^bsup>ml\<^esup> @ Bk # Bk # ires
- else l = (Oc\<^bsup>ml \<^esup>) @ [Bk] @ <rev lm1> @ Bk # Bk # ires) \<and>
- (tl r = Bk # <lm2> @ (Bk\<^bsup>rn\<^esup>) \<or> tl r = [] \<and> lm2 = []))"
-
-fun dec_after_write :: "dec_inv_t"
- where
- "dec_after_write (as, lm) (s, l, r) ires =
- (\<exists> lm1 lm2 m ml mr rn. lm = lm1 @ [m] @ lm2 \<and>
- ml + mr = Suc m \<and> ml = Suc m \<and> lm2 \<noteq> [] \<and>
- (if lm1 = [] then l = Bk # Oc\<^bsup>ml\<^esup> @ Bk # Bk # ires
- else l = Bk # (Oc\<^bsup>ml \<^esup>) @ [Bk] @ <rev lm1> @ Bk # Bk # ires) \<and>
- tl r = <lm2> @ (Bk\<^bsup>rn\<^esup>))"
-
-fun dec_right_move :: "dec_inv_t"
- where
- "dec_right_move (as, lm) (s, l, r) ires =
- (\<exists> lm1 lm2 m ml mr rn. lm = lm1 @ [m] @ lm2
- \<and> ml = Suc m \<and> mr = (0::nat) \<and>
- (if lm1 = [] then l = Bk # Oc\<^bsup>ml\<^esup> @ Bk # Bk # ires
- else l = Bk # Oc\<^bsup>ml\<^esup>@ [Bk] @ <rev lm1> @ Bk # Bk # ires)
- \<and> (r = Bk # <lm2> @ Bk\<^bsup>rn\<^esup>\<or> r = [] \<and> lm2 = []))"
-
-fun dec_check_right_move :: "dec_inv_t"
- where
- "dec_check_right_move (as, lm) (s, l, r) ires =
- (\<exists> lm1 lm2 m ml mr rn. lm = lm1 @ [m] @ lm2 \<and>
- ml = Suc m \<and> mr = (0::nat) \<and>
- (if lm1 = [] then l = Bk # Bk # Oc\<^bsup>ml\<^esup> @ Bk # Bk # ires
- else l = Bk # Bk # Oc\<^bsup>ml \<^esup>@ [Bk] @ <rev lm1> @ Bk # Bk # ires) \<and>
- r = <lm2> @ Bk\<^bsup>rn\<^esup>)"
-
-fun dec_left_move :: "dec_inv_t"
- where
- "dec_left_move (as, lm) (s, l, r) ires =
- (\<exists> lm1 m rn. (lm::nat list) = lm1 @ [m::nat] \<and>
- rn > 0 \<and>
- (if lm1 = [] then l = Bk # Oc\<^bsup>Suc m\<^esup> @ Bk # Bk # ires
- else l = Bk # Oc\<^bsup>Suc m\<^esup> @ Bk # <rev lm1> @ Bk # Bk # ires) \<and> r = Bk\<^bsup>rn\<^esup>)"
-
-declare
- dec_on_right_moving.simps[simp del] dec_after_clear.simps[simp del]
- dec_after_write.simps[simp del] dec_left_move.simps[simp del]
- dec_check_right_move.simps[simp del] dec_right_move.simps[simp del]
- dec_first_on_right_moving.simps[simp del]
-
-fun inv_locate_n_b :: "inc_inv_t"
- where
- "inv_locate_n_b (as, lm) (s, l, r) ires=
- (\<exists> lm1 lm2 tn m ml mr rn. lm @ 0\<^bsup>tn\<^esup> = lm1 @ [m] @ lm2 \<and>
- length lm1 = s \<and> m + 1 = ml + mr \<and>
- ml = 1 \<and> tn = s + 1 - length lm \<and>
- (if lm1 = [] then l = Oc\<^bsup>ml\<^esup> @ Bk # Bk # ires
- else l = Oc\<^bsup>ml\<^esup>@Bk#<rev lm1>@Bk#Bk#ires) \<and>
- (r = (Oc\<^bsup>mr\<^esup>) @ [Bk] @ <lm2>@ (Bk\<^bsup>rn\<^esup>) \<or> (lm2 = [] \<and> r = (Oc\<^bsup>mr\<^esup>)))
- )"
-
-fun dec_inv_1 :: "layout \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> dec_inv_t"
- where
- "dec_inv_1 ly n e (as, am) (s, l, r) ires =
- (let ss = start_of ly as in
- let am' = abc_lm_s am n (abc_lm_v am n - Suc 0) in
- let am'' = abc_lm_s am n (abc_lm_v am n) in
- if s = start_of ly e then inv_stop (as, am'') (s, l, r) ires
- else if s = ss then False
- else if ss \<le> s \<and> s < ss + 2*n then
- if (s - ss) mod 2 = 0 then
- inv_locate_a (as, am) ((s - ss) div 2, l, r) ires
- \<or> inv_locate_a (as, am'') ((s - ss) div 2, l, r) ires
- else
- inv_locate_b (as, am) ((s - ss) div 2, l, r) ires
- \<or> inv_locate_b (as, am'') ((s - ss) div 2, l, r) ires
- else if s = ss + 2 * n then
- inv_locate_a (as, am) (n, l, r) ires
- \<or> inv_locate_a (as, am'') (n, l, r) ires
- else if s = ss + 2 * n + 1 then
- inv_locate_b (as, am) (n, l, r) ires
- else if s = ss + 2 * n + 13 then
- inv_on_left_moving (as, am'') (s, l, r) ires
- else if s = ss + 2 * n + 14 then
- inv_check_left_moving (as, am'') (s, l, r) ires
- else if s = ss + 2 * n + 15 then
- inv_after_left_moving (as, am'') (s, l, r) ires
- else False)"
-
-fun dec_inv_2 :: "layout \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> dec_inv_t"
- where
- "dec_inv_2 ly n e (as, am) (s, l, r) ires =
- (let ss = start_of ly as in
- let am' = abc_lm_s am n (abc_lm_v am n - Suc 0) in
- let am'' = abc_lm_s am n (abc_lm_v am n) in
- if s = 0 then False
- else if s = ss then False
- else if ss \<le> s \<and> s < ss + 2*n then
- if (s - ss) mod 2 = 0 then
- inv_locate_a (as, am) ((s - ss) div 2, l, r) ires
- else inv_locate_b (as, am) ((s - ss) div 2, l, r) ires
- else if s = ss + 2 * n then
- inv_locate_a (as, am) (n, l, r) ires
- else if s = ss + 2 * n + 1 then
- inv_locate_n_b (as, am) (n, l, r) ires
- else if s = ss + 2 * n + 2 then
- dec_first_on_right_moving n (as, am'') (s, l, r) ires
- else if s = ss + 2 * n + 3 then
- dec_after_clear (as, am') (s, l, r) ires
- else if s = ss + 2 * n + 4 then
- dec_right_move (as, am') (s, l, r) ires
- else if s = ss + 2 * n + 5 then
- dec_check_right_move (as, am') (s, l, r) ires
- else if s = ss + 2 * n + 6 then
- dec_left_move (as, am') (s, l, r) ires
- else if s = ss + 2 * n + 7 then
- dec_after_write (as, am') (s, l, r) ires
- else if s = ss + 2 * n + 8 then
- dec_on_right_moving (as, am') (s, l, r) ires
- else if s = ss + 2 * n + 9 then
- dec_after_clear (as, am') (s, l, r) ires
- else if s = ss + 2 * n + 10 then
- inv_on_left_moving (as, am') (s, l, r) ires
- else if s = ss + 2 * n + 11 then
- inv_check_left_moving (as, am') (s, l, r) ires
- else if s = ss + 2 * n + 12 then
- inv_after_left_moving (as, am') (s, l, r) ires
- else if s = ss + 2 * n + 16 then
- inv_stop (as, am') (s, l, r) ires
- else False)"
-
-(*begin: dec_fetch lemmas*)
-
-lemma dec_fetch_locate_a_o:
- "\<lbrakk>start_of ly as \<le> a;
- a < start_of ly as + 2 * n; start_of ly as > 0;
- a - start_of ly as = 2 * q\<rbrakk>
- \<Longrightarrow> fetch (ci (layout_of aprog)
- (start_of ly as) (Dec n e)) (Suc (2 * q)) Oc = (R, a + 1)"
-apply(auto simp: ci.simps findnth.simps fetch.simps
- nth_of.simps tshift.simps nth_append Suc_pre)
-apply(subgoal_tac "(findnth n ! Suc (4 * q)) =
- findnth (Suc q) ! (4 * q + 1)")
-apply(simp add: findnth.simps nth_append)
-apply(subgoal_tac " findnth n !(4 * q + 1) =
- findnth (Suc q) ! (4 * q + 1)", simp)
-apply(rule_tac findnth_nth, auto)
-done
-
-lemma dec_fetch_locate_a_b:
- "\<lbrakk>start_of ly as \<le> a;
- a < start_of ly as + 2 * n;
- start_of ly as > 0;
- a - start_of ly as = 2 * q\<rbrakk>
- \<Longrightarrow> fetch (ci (layout_of aprog) (start_of ly as) (Dec n e))
- (Suc (2 * q)) Bk = (W1, a)"
-apply(auto simp: ci.simps findnth.simps fetch.simps
- nth_of.simps tshift.simps nth_append)
-apply(subgoal_tac "(findnth n ! (4 * q)) =
- findnth (Suc q) ! (4 * q )")
-apply(simp add: findnth.simps nth_append)
-apply(subgoal_tac " findnth n !(4 * q + 0) =
- findnth (Suc q) ! (4 * q + 0)", simp)
-apply(rule_tac findnth_nth, auto)
-done
-
-lemma dec_fetch_locate_b_o:
- "\<lbrakk>start_of ly as \<le> a;
- a < start_of ly as + 2 * n;
- (a - start_of ly as) mod 2 = Suc 0;
- start_of ly as> 0\<rbrakk>
- \<Longrightarrow> fetch (ci (layout_of aprog) (start_of ly as) (Dec n e))
- (Suc (a - start_of ly as)) Oc = (R, a)"
-apply(auto simp: ci.simps findnth.simps fetch.simps
- nth_of.simps tshift.simps nth_append)
-apply(subgoal_tac "\<exists> q. (a - start_of ly as) = 2 * q + 1", auto)
-apply(subgoal_tac "(findnth n ! Suc (Suc (Suc (4 * q)))) =
- findnth (Suc q) ! (4 * q + 3)")
-apply(simp add: findnth.simps nth_append)
-apply(subgoal_tac " findnth n ! (4 * q + 3) =
- findnth (Suc q) ! (4 * q + 3)", simp add: add3_Suc)
-apply(rule_tac findnth_nth, auto)
-done
-
-lemma dec_fetch_locate_b_b:
- "\<lbrakk>\<not> a < start_of ly as;
- a < start_of ly as + 2 * n;
- (a - start_of ly as) mod 2 = Suc 0;
- start_of ly as > 0\<rbrakk>
- \<Longrightarrow> fetch (ci (layout_of aprog) (start_of ly as) (Dec n e))
- (Suc (a - start_of ly as)) Bk = (R, a + 1)"
-apply(auto simp: ci.simps findnth.simps fetch.simps
- nth_of.simps tshift.simps nth_append)
-apply(subgoal_tac "\<exists> q. (a - start_of ly as) = 2 * q + 1", auto)
-apply(subgoal_tac "(findnth n ! Suc ((Suc (4 * q)))) =
- findnth (Suc q) ! (4 * q + 2)")
-apply(simp add: findnth.simps nth_append)
-apply(subgoal_tac " findnth n ! (4 * q + 2) =
- findnth (Suc q) ! (4 * q + 2)", simp)
-apply(rule_tac findnth_nth, auto)
-done
-
-lemma dec_fetch_locate_n_a_o:
- "start_of ly as > 0 \<Longrightarrow> fetch (ci (layout_of aprog)
- (start_of ly as) (Dec n e)) (Suc (2 * n)) Oc
- = (R, start_of ly as + 2*n + 1)"
-apply(auto simp: ci.simps findnth.simps fetch.simps
- nth_of.simps tshift.simps nth_append tdec_b_def)
-done
-
-lemma dec_fetch_locate_n_a_b:
- "start_of ly as > 0 \<Longrightarrow> fetch (ci (layout_of aprog)
- (start_of ly as) (Dec n e)) (Suc (2 * n)) Bk
- = (W1, start_of ly as + 2*n)"
-apply(auto simp: ci.simps findnth.simps fetch.simps
- nth_of.simps tshift.simps nth_append tdec_b_def)
-done
-
-lemma dec_fetch_locate_n_b_o:
- "start_of ly as > 0 \<Longrightarrow>
- fetch (ci (layout_of aprog)
- (start_of ly as) (Dec n e)) (Suc (Suc (2 * n))) Oc
- = (R, start_of ly as + 2*n + 2)"
-apply(auto simp: ci.simps findnth.simps fetch.simps
- nth_of.simps tshift.simps nth_append tdec_b_def)
-done
-
-
-lemma dec_fetch_locate_n_b_b:
- "start_of ly as > 0 \<Longrightarrow>
- fetch (ci (layout_of aprog)
- (start_of ly as) (Dec n e)) (Suc (Suc (2 * n))) Bk
- = (L, start_of ly as + 2*n + 13)"
-apply(auto simp: ci.simps findnth.simps fetch.simps
- nth_of.simps tshift.simps nth_append tdec_b_def)
-done
-
-lemma dec_fetch_first_on_right_move_o:
- "start_of ly as > 0 \<Longrightarrow>
- fetch (ci (layout_of aprog)
- (start_of ly as) (Dec n e)) (Suc (Suc (Suc (2 * n)))) Oc
- = (R, start_of ly as + 2*n + 2)"
-apply(auto simp: ci.simps findnth.simps fetch.simps
- nth_of.simps tshift.simps nth_append tdec_b_def)
-done
-
-lemma dec_fetch_first_on_right_move_b:
- "start_of ly as > 0 \<Longrightarrow>
- fetch (ci (layout_of aprog) (start_of ly as) (Dec n e))
- (Suc (Suc (Suc (2 * n)))) Bk
- = (L, start_of ly as + 2*n + 3)"
-apply(auto simp: ci.simps findnth.simps fetch.simps
- nth_of.simps tshift.simps nth_append tdec_b_def)
-done
-
-lemma [simp]: "fetch x (a + 2 * n) b = fetch x (2 * n + a) b"
-thm arg_cong
-apply(rule_tac x = "a + 2*n" and y = "2*n + a" in arg_cong, simp)
-done
-
-lemma dec_fetch_first_after_clear_o:
- "start_of ly as > 0 \<Longrightarrow> fetch (ci (layout_of aprog)
- (start_of ly as) (Dec n e)) (2 * n + 4) Oc
- = (W0, start_of ly as + 2*n + 3)"
-apply(auto simp: ci.simps findnth.simps tshift.simps
- tdec_b_def add3_Suc)
-apply(subgoal_tac "2*n + 4 = Suc (2*n + 3)", simp only: fetch.simps)
-apply(auto simp: nth_of.simps nth_append)
-done
-
-lemma dec_fetch_first_after_clear_b:
- "start_of ly as > 0 \<Longrightarrow>
- fetch (ci (layout_of aprog)
- (start_of ly as) (Dec n e)) (2 * n + 4) Bk
- = (R, start_of ly as + 2*n + 4)"
-apply(auto simp: ci.simps findnth.simps
- tshift.simps tdec_b_def add3_Suc)
-apply(subgoal_tac "2*n + 4= Suc (2*n + 3)", simp only: fetch.simps)
-apply(auto simp: nth_of.simps nth_append)
-done
-
-lemma dec_fetch_right_move_b:
- "start_of ly as > 0 \<Longrightarrow> fetch (ci (layout_of aprog)
- (start_of ly as) (Dec n e)) (2 * n + 5) Bk
- = (R, start_of ly as + 2*n + 5)"
-apply(auto simp: ci.simps findnth.simps
- tshift.simps tdec_b_def add3_Suc)
-apply(subgoal_tac "2*n + 5= Suc (2*n + 4)", simp only: fetch.simps)
-apply(auto simp: nth_of.simps nth_append)
-done
-
-lemma dec_fetch_check_right_move_b:
- "start_of ly as > 0 \<Longrightarrow>
- fetch (ci (layout_of aprog)
- (start_of ly as) (Dec n e)) (2 * n + 6) Bk
- = (L, start_of ly as + 2*n + 6)"
-apply(auto simp: ci.simps findnth.simps
- tshift.simps tdec_b_def add3_Suc)
-apply(subgoal_tac "2*n + 6 = Suc (2*n + 5)", simp only: fetch.simps)
-apply(auto simp: nth_of.simps nth_append)
-done
-
-lemma dec_fetch_check_right_move_o:
- "start_of ly as > 0 \<Longrightarrow>
- fetch (ci (layout_of aprog) (start_of ly as)
- (Dec n e)) (2 * n + 6) Oc
- = (L, start_of ly as + 2*n + 7)"
-apply(auto simp: ci.simps findnth.simps
- tshift.simps tdec_b_def add3_Suc)
-apply(subgoal_tac "2*n + 6 = Suc (2*n + 5)", simp only: fetch.simps)
-apply(auto simp: nth_of.simps nth_append)
-done
-
-lemma dec_fetch_left_move_b:
- "start_of ly as > 0 \<Longrightarrow>
- fetch (ci (layout_of aprog)
- (start_of ly as) (Dec n e)) (2 * n + 7) Bk
- = (L, start_of ly as + 2*n + 10)"
-apply(auto simp: ci.simps findnth.simps
- tshift.simps tdec_b_def add3_Suc)
-apply(subgoal_tac "2*n + 7 = Suc (2*n + 6)", simp only: fetch.simps)
-apply(auto simp: nth_of.simps nth_append)
-done
-
-lemma dec_fetch_after_write_b:
- "start_of ly as > 0 \<Longrightarrow>
- fetch (ci (layout_of aprog)
- (start_of ly as) (Dec n e)) (2 * n + 8) Bk
- = (W1, start_of ly as + 2*n + 7)"
-apply(auto simp: ci.simps findnth.simps
- tshift.simps tdec_b_def add3_Suc)
-apply(subgoal_tac "2*n + 8 = Suc (2*n + 7)", simp only: fetch.simps)
-apply(auto simp: nth_of.simps nth_append)
-done
-
-lemma dec_fetch_after_write_o:
- "start_of ly as > 0 \<Longrightarrow>
- fetch (ci (layout_of aprog)
- (start_of ly as) (Dec n e)) (2 * n + 8) Oc
- = (R, start_of ly as + 2*n + 8)"
-apply(auto simp: ci.simps findnth.simps
- tshift.simps tdec_b_def add3_Suc)
-apply(subgoal_tac "2*n + 8 = Suc (2*n + 7)", simp only: fetch.simps)
-apply(auto simp: nth_of.simps nth_append)
-done
-
-lemma dec_fetch_on_right_move_b:
- "start_of ly as > 0 \<Longrightarrow>
- fetch (ci (layout_of aprog)
- (start_of ly as) (Dec n e)) (2 * n + 9) Bk
- = (L, start_of ly as + 2*n + 9)"
-apply(auto simp: ci.simps findnth.simps
- tshift.simps tdec_b_def add3_Suc)
-apply(subgoal_tac "2*n + 9 = Suc (2*n + 8)", simp only: fetch.simps)
-apply(auto simp: nth_of.simps nth_append)
-done
-
-lemma dec_fetch_on_right_move_o:
- "start_of ly as > 0 \<Longrightarrow>
- fetch (ci (layout_of aprog)
- (start_of ly as) (Dec n e)) (2 * n + 9) Oc
- = (R, start_of ly as + 2*n + 8)"
-apply(auto simp: ci.simps findnth.simps
- tshift.simps tdec_b_def add3_Suc)
-apply(subgoal_tac "2*n + 9 = Suc (2*n + 8)", simp only: fetch.simps)
-apply(auto simp: nth_of.simps nth_append)
-done
-
-lemma dec_fetch_after_clear_b:
- "start_of ly as > 0 \<Longrightarrow>
- fetch (ci (layout_of aprog)
- (start_of ly as) (Dec n e)) (2 * n + 10) Bk
- = (R, start_of ly as + 2*n + 4)"
-apply(auto simp: ci.simps findnth.simps
- tshift.simps tdec_b_def add3_Suc)
-apply(subgoal_tac "2*n + 10 = Suc (2*n + 9)", simp only: fetch.simps)
-apply(auto simp: nth_of.simps nth_append)
-done
-
-lemma dec_fetch_after_clear_o:
- "start_of ly as > 0 \<Longrightarrow>
- fetch (ci (layout_of aprog)
- (start_of ly as) (Dec n e)) (2 * n + 10) Oc
- = (W0, start_of ly as + 2*n + 9)"
-apply(auto simp: ci.simps findnth.simps
- tshift.simps tdec_b_def add3_Suc)
-apply(subgoal_tac "2*n + 10= Suc (2*n + 9)", simp only: fetch.simps)
-apply(auto simp: nth_of.simps nth_append)
-done
-
-lemma dec_fetch_on_left_move1_o:
- "start_of ly as > 0 \<Longrightarrow>
- fetch (ci (layout_of aprog)
- (start_of ly as) (Dec n e)) (2 * n + 11) Oc
- = (L, start_of ly as + 2*n + 10)"
-apply(auto simp: ci.simps findnth.simps
- tshift.simps tdec_b_def add3_Suc)
-apply(subgoal_tac "2*n + 11= Suc (2*n + 10)", simp only: fetch.simps)
-apply(auto simp: nth_of.simps nth_append)
-done
-
-lemma dec_fetch_on_left_move1_b:
- "start_of ly as > 0 \<Longrightarrow>
- fetch (ci (layout_of aprog)
- (start_of ly as) (Dec n e)) (2 * n + 11) Bk
- = (L, start_of ly as + 2*n + 11)"
-apply(auto simp: ci.simps findnth.simps
- tshift.simps tdec_b_def add3_Suc)
-apply(subgoal_tac "2*n + 11 = Suc (2*n + 10)",
- simp only: fetch.simps)
-apply(auto simp: nth_of.simps nth_append)
-done
-
-lemma dec_fetch_check_left_move1_o:
- "start_of ly as > 0 \<Longrightarrow>
- fetch (ci (layout_of aprog)
- (start_of ly as) (Dec n e)) (2 * n + 12) Oc
- = (L, start_of ly as + 2*n + 10)"
-apply(auto simp: ci.simps findnth.simps
- tshift.simps tdec_b_def add3_Suc)
-apply(subgoal_tac "2*n + 12= Suc (2*n + 11)", simp only: fetch.simps)
-apply(auto simp: nth_of.simps nth_append)
-done
-
-lemma dec_fetch_check_left_move1_b:
- "start_of ly as > 0 \<Longrightarrow>
- fetch (ci (layout_of aprog)
- (start_of ly as) (Dec n e)) (2 * n + 12) Bk
- = (R, start_of ly as + 2*n + 12)"
-apply(auto simp: ci.simps findnth.simps
- tshift.simps tdec_b_def add3_Suc)
-apply(subgoal_tac "2*n + 12 = Suc (2*n + 11)",
- simp only: fetch.simps)
-apply(auto simp: nth_of.simps nth_append)
-done
-
-lemma dec_fetch_after_left_move1_b:
- "start_of ly as > 0 \<Longrightarrow>
- fetch (ci (layout_of aprog)
- (start_of ly as) (Dec n e)) (2 * n + 13) Bk
- = (R, start_of ly as + 2*n + 16)"
-apply(auto simp: ci.simps findnth.simps
- tshift.simps tdec_b_def add3_Suc)
-apply(subgoal_tac "2*n + 13 = Suc (2*n + 12)",
- simp only: fetch.simps)
-apply(auto simp: nth_of.simps nth_append)
-done
-
-lemma dec_fetch_on_left_move2_o:
- "start_of ly as > 0 \<Longrightarrow>
- fetch (ci (layout_of aprog)
- (start_of ly as) (Dec n e)) (2 * n + 14) Oc
- = (L, start_of ly as + 2*n + 13)"
-apply(auto simp: ci.simps findnth.simps
- tshift.simps tdec_b_def add3_Suc)
-apply(subgoal_tac "2*n + 14 = Suc (2*n + 13)",
- simp only: fetch.simps)
-apply(auto simp: nth_of.simps nth_append)
-done
-
-lemma dec_fetch_on_left_move2_b:
- "start_of ly as > 0 \<Longrightarrow>
- fetch (ci (layout_of aprog)
- (start_of ly as) (Dec n e)) (2 * n + 14) Bk
- = (L, start_of ly as + 2*n + 14)"
-apply(auto simp: ci.simps findnth.simps
- tshift.simps tdec_b_def add3_Suc)
-apply(subgoal_tac "2*n + 14 = Suc (2*n + 13)",
- simp only: fetch.simps)
-apply(auto simp: nth_of.simps nth_append)
-done
-
-lemma dec_fetch_check_left_move2_o:
- "start_of ly as > 0 \<Longrightarrow>
- fetch (ci (layout_of aprog)
- (start_of ly as) (Dec n e)) (2 * n + 15) Oc
- = (L, start_of ly as + 2*n + 13)"
-apply(auto simp: ci.simps findnth.simps
- tshift.simps tdec_b_def add3_Suc)
-apply(subgoal_tac "2*n + 15 = Suc (2*n + 14)",
- simp only: fetch.simps)
-apply(auto simp: nth_of.simps nth_append)
-done
-
-lemma dec_fetch_check_left_move2_b:
- "start_of ly as > 0 \<Longrightarrow>
- fetch (ci (layout_of aprog)
- (start_of ly as) (Dec n e)) (2 * n + 15) Bk
- = (R, start_of ly as + 2*n + 15)"
-apply(auto simp: ci.simps findnth.simps
- tshift.simps tdec_b_def add3_Suc)
-apply(subgoal_tac "2*n + 15= Suc (2*n + 14)", simp only: fetch.simps)
-apply(auto simp: nth_of.simps nth_append)
-done
-
-lemma dec_fetch_after_left_move2_b:
- "\<lbrakk>ly = layout_of aprog;
- abc_fetch as aprog = Some (Dec n e);
- start_of ly as > 0\<rbrakk> \<Longrightarrow>
- fetch (ci (layout_of aprog) (start_of ly as)
- (Dec n e)) (2 * n + 16) Bk
- = (R, start_of ly e)"
-apply(auto simp: ci.simps findnth.simps
- tshift.simps tdec_b_def add3_Suc)
-apply(subgoal_tac "2*n + 16 = Suc (2*n + 15)",
- simp only: fetch.simps)
-apply(auto simp: nth_of.simps nth_append)
-done
-
-lemma dec_fetch_next_state:
- "start_of ly as > 0 \<Longrightarrow>
- fetch (ci (layout_of aprog)
- (start_of ly as) (Dec n e)) (2* n + 17) b
- = (Nop, 0)"
-apply(case_tac b)
-apply(auto simp: ci.simps findnth.simps
- tshift.simps tdec_b_def add3_Suc)
-apply(subgoal_tac [!] "2*n + 17 = Suc (2*n + 16)",
- simp_all only: fetch.simps)
-apply(auto simp: nth_of.simps nth_append)
-done
-
-(*End: dec_fetch lemmas*)
-lemmas dec_fetch_simps =
- dec_fetch_locate_a_o dec_fetch_locate_a_b dec_fetch_locate_b_o
- dec_fetch_locate_b_b dec_fetch_locate_n_a_o
- dec_fetch_locate_n_a_b dec_fetch_locate_n_b_o
- dec_fetch_locate_n_b_b dec_fetch_first_on_right_move_o
- dec_fetch_first_on_right_move_b dec_fetch_first_after_clear_b
- dec_fetch_first_after_clear_o dec_fetch_right_move_b
- dec_fetch_on_right_move_b dec_fetch_on_right_move_o
- dec_fetch_after_clear_b dec_fetch_after_clear_o
- dec_fetch_check_right_move_b dec_fetch_check_right_move_o
- dec_fetch_left_move_b dec_fetch_on_left_move1_b
- dec_fetch_on_left_move1_o dec_fetch_check_left_move1_b
- dec_fetch_check_left_move1_o dec_fetch_after_left_move1_b
- dec_fetch_on_left_move2_b dec_fetch_on_left_move2_o
- dec_fetch_check_left_move2_o dec_fetch_check_left_move2_b
- dec_fetch_after_left_move2_b dec_fetch_after_write_b
- dec_fetch_after_write_o dec_fetch_next_state
-
-lemma [simp]:
- "\<lbrakk>start_of ly as \<le> a;
- a < start_of ly as + 2 * n;
- (a - start_of ly as) mod 2 = Suc 0;
- inv_locate_b (as, am) ((a - start_of ly as) div 2, aaa, Bk # xs) ires\<rbrakk>
- \<Longrightarrow> \<not> Suc a < start_of ly as + 2 * n \<longrightarrow>
- inv_locate_a (as, am) (n, Bk # aaa, xs) ires"
-apply(insert locate_b_2_locate_a[of a ly as n am aaa xs], simp)
-done
-
-lemma [simp]:
- "\<lbrakk>start_of ly as \<le> a;
- a < start_of ly as + 2 * n;
- (a - start_of ly as) mod 2 = Suc 0;
- inv_locate_b (as, am) ((a - start_of ly as) div 2, aaa, []) ires\<rbrakk>
- \<Longrightarrow> \<not> Suc a < start_of ly as + 2 * n \<longrightarrow>
- inv_locate_a (as, am) (n, Bk # aaa, []) ires"
-apply(insert locate_b_2_locate_a_B[of a ly as n am aaa], simp)
-done
-
-(*
-lemma [simp]: "a\<^bsup>0\<^esup>=[]"
-apply(simp add: exponent_def)
-done
-*)
-
-lemma exp_ind: "a\<^bsup>Suc b\<^esup> = a\<^bsup>b\<^esup> @ [a]"
-apply(simp only: exponent_def rep_ind)
-done
-
-lemma [simp]:
- "inv_locate_b (as, am) (n, l, Oc # r) ires
- \<Longrightarrow> dec_first_on_right_moving n (as, abc_lm_s am n (abc_lm_v am n))
- (Suc (Suc (start_of ly as + 2 * n)), Oc # l, r) ires"
-apply(simp only: inv_locate_b.simps
- dec_first_on_right_moving.simps in_middle.simps
- abc_lm_s.simps abc_lm_v.simps)
-apply(erule_tac exE)+
-apply(erule conjE)+
-apply(case_tac "n < length am", simp)
-apply(rule_tac x = lm1 in exI, rule_tac x = lm2 in exI,
- rule_tac x = m in exI, simp)
-apply(rule_tac x = "Suc ml" in exI, rule_tac conjI, rule_tac [1-2] impI)
-prefer 3
-apply(rule_tac x = lm1 in exI, rule_tac x = lm2 in exI,
- rule_tac x = m in exI, simp)
-apply(subgoal_tac "Suc n - length am = Suc (n - length am)",
- simp only:exponent_def rep_ind, simp)
-apply(rule_tac x = "Suc ml" in exI, simp_all)
-apply(rule_tac [!] x = "mr - 1" in exI, simp_all)
-apply(case_tac [!] mr, auto)
-done
-
-lemma [simp]:
- "\<lbrakk>inv_locate_b (as, am) (n, l, r) ires; l \<noteq> []\<rbrakk> \<Longrightarrow>
- \<not> inv_on_left_moving_in_middle_B (as, abc_lm_s am n (abc_lm_v am n))
- (s, tl l, hd l # r) ires"
-apply(auto simp: inv_locate_b.simps
- inv_on_left_moving_in_middle_B.simps in_middle.simps)
-apply(case_tac [!] ml, auto split: if_splits)
-done
-
-lemma [simp]: "inv_locate_b (as, am) (n, l, r) ires \<Longrightarrow> l \<noteq> []"
-apply(auto simp: inv_locate_b.simps in_middle.simps split: if_splits)
-done
-
-lemma [simp]: "\<lbrakk>inv_locate_b (as, am) (n, l, Bk # r) ires; n < length am\<rbrakk>
- \<Longrightarrow> inv_on_left_moving_norm (as, am) (s, tl l, hd l # Bk # r) ires"
-apply(simp only: inv_locate_b.simps inv_on_left_moving_norm.simps
- in_middle.simps)
-apply(erule_tac exE)+
-apply(erule_tac conjE)+
-apply(rule_tac x = lm1 in exI, rule_tac x = lm2 in exI,
- rule_tac x = m in exI, simp)
-apply(rule_tac x = "ml - 1" in exI, auto)
-apply(rule_tac [!] x = "Suc mr" in exI)
-apply(case_tac [!] mr, auto)
-done
-
-lemma [simp]: "\<lbrakk>inv_locate_b (as, am) (n, l, Bk # r) ires; \<not> n < length am\<rbrakk>
- \<Longrightarrow> inv_on_left_moving_norm (as, am @
- replicate (n - length am) 0 @ [0]) (s, tl l, hd l # Bk # r) ires"
-apply(simp only: inv_locate_b.simps inv_on_left_moving_norm.simps
- in_middle.simps)
-apply(erule_tac exE)+
-apply(erule_tac conjE)+
-apply(rule_tac x = lm1 in exI, rule_tac x = lm2 in exI,
- rule_tac x = m in exI, simp)
-apply(subgoal_tac "Suc n - length am = Suc (n - length am)", simp only: rep_ind exponent_def, simp_all)
-apply(rule_tac x = "Suc mr" in exI, auto)
-done
-
-lemma inv_locate_b_2_on_left_moving[simp]:
- "\<lbrakk>inv_locate_b (as, am) (n, l, Bk # r) ires\<rbrakk>
- \<Longrightarrow> (l = [] \<longrightarrow> inv_on_left_moving (as,
- abc_lm_s am n (abc_lm_v am n)) (s, [], Bk # Bk # r) ires) \<and>
- (l \<noteq> [] \<longrightarrow> inv_on_left_moving (as,
- abc_lm_s am n (abc_lm_v am n)) (s, tl l, hd l # Bk # r) ires)"
-apply(subgoal_tac "l\<noteq>[]")
-apply(subgoal_tac "\<not> inv_on_left_moving_in_middle_B
- (as, abc_lm_s am n (abc_lm_v am n)) (s, tl l, hd l # Bk # r) ires")
-apply(simp add:inv_on_left_moving.simps
- abc_lm_s.simps abc_lm_v.simps split: if_splits, auto)
-done
-
-lemma [simp]:
- "inv_locate_b (as, am) (n, l, []) ires \<Longrightarrow>
- inv_locate_b (as, am) (n, l, [Bk]) ires"
-apply(auto simp: inv_locate_b.simps in_middle.simps)
-apply(rule_tac x = lm1 in exI, rule_tac x = "[]" in exI,
- rule_tac x = "Suc (length lm1) - length am" in exI,
- rule_tac x = m in exI, simp)
-apply(rule_tac x = ml in exI, rule_tac x = mr in exI)
-apply(auto)
-done
-
-lemma nil_2_nil: "<lm::nat list> = [] \<Longrightarrow> lm = []"
-apply(auto simp: tape_of_nl_abv)
-apply(case_tac lm, simp)
-apply(case_tac list, auto simp: tape_of_nat_list.simps)
-done
-
-lemma inv_locate_b_2_on_left_moving_b[simp]:
- "inv_locate_b (as, am) (n, l, []) ires
- \<Longrightarrow> (l = [] \<longrightarrow> inv_on_left_moving (as,
- abc_lm_s am n (abc_lm_v am n)) (s, [], [Bk]) ires) \<and>
- (l \<noteq> [] \<longrightarrow> inv_on_left_moving (as, abc_lm_s am n
- (abc_lm_v am n)) (s, tl l, [hd l]) ires)"
-apply(insert inv_locate_b_2_on_left_moving[of as am n l "[]" ires s])
-apply(simp only: inv_on_left_moving.simps, simp)
-apply(subgoal_tac "\<not> inv_on_left_moving_in_middle_B
- (as, abc_lm_s am n (abc_lm_v am n)) (s, tl l, [hd l]) ires", simp)
-apply(simp only: inv_on_left_moving_norm.simps)
-apply(erule_tac exE)+
-apply(erule_tac conjE)+
-apply(rule_tac x = lm1 in exI, rule_tac x = lm2 in exI,
- rule_tac x = m in exI, rule_tac x = ml in exI,
- rule_tac x = mr in exI, simp)
-apply(case_tac mr, simp, simp, case_tac nat, auto intro: nil_2_nil)
-done
-
-lemma [simp]:
- "\<lbrakk>dec_first_on_right_moving n (as, am) (s, aaa, Oc # xs) ires\<rbrakk>
- \<Longrightarrow> dec_first_on_right_moving n (as, am) (s', Oc # aaa, xs) ires"
-apply(simp only: dec_first_on_right_moving.simps)
-apply(erule exE)+
-apply(rule_tac x = lm1 in exI, rule_tac x = lm2 in exI,
- rule_tac x = m in exI, simp)
-apply(rule_tac x = "Suc ml" in exI,
- rule_tac x = "mr - 1" in exI, auto)
-apply(case_tac [!] mr, auto)
-done
-
-lemma [simp]:
- "dec_first_on_right_moving n (as, am) (s, l, Bk # xs) ires \<Longrightarrow> l \<noteq> []"
-apply(auto simp: dec_first_on_right_moving.simps split: if_splits)
-done
-
-lemma [elim]:
- "\<lbrakk>\<not> length lm1 < length am;
- am @ replicate (length lm1 - length am) 0 @ [0::nat] =
- lm1 @ m # lm2;
- 0 < m\<rbrakk>
- \<Longrightarrow> RR"
-apply(subgoal_tac "lm2 = []", simp)
-apply(drule_tac length_equal, simp)
-done
-
-lemma [simp]:
- "\<lbrakk>dec_first_on_right_moving n (as,
- abc_lm_s am n (abc_lm_v am n)) (s, l, Bk # xs) ires\<rbrakk>
-\<Longrightarrow> dec_after_clear (as, abc_lm_s am n
- (abc_lm_v am n - Suc 0)) (s', tl l, hd l # Bk # xs) ires"
-apply(simp only: dec_first_on_right_moving.simps
- dec_after_clear.simps abc_lm_s.simps abc_lm_v.simps)
-apply(erule_tac exE)+
-apply(case_tac "n < length am")
-apply(rule_tac x = lm1 in exI, rule_tac x = lm2 in exI,
- rule_tac x = "m - 1" in exI, auto simp: )
-apply(case_tac [!] mr, auto)
-done
-
-lemma [simp]:
- "\<lbrakk>dec_first_on_right_moving n (as,
- abc_lm_s am n (abc_lm_v am n)) (s, l, []) ires\<rbrakk>
-\<Longrightarrow> (l = [] \<longrightarrow> dec_after_clear (as,
- abc_lm_s am n (abc_lm_v am n - Suc 0)) (s', [], [Bk]) ires) \<and>
- (l \<noteq> [] \<longrightarrow> dec_after_clear (as, abc_lm_s am n
- (abc_lm_v am n - Suc 0)) (s', tl l, [hd l]) ires)"
-apply(subgoal_tac "l \<noteq> []",
- simp only: dec_first_on_right_moving.simps
- dec_after_clear.simps abc_lm_s.simps abc_lm_v.simps)
-apply(erule_tac exE)+
-apply(case_tac "n < length am", simp)
-apply(rule_tac x = lm1 in exI, rule_tac x = "m - 1" in exI, auto)
-apply(case_tac [1-2] mr, auto)
-apply(case_tac [1-2] m, auto simp: dec_first_on_right_moving.simps split: if_splits)
-done
-
-lemma [simp]: "\<lbrakk>dec_after_clear (as, am) (s, l, Oc # r) ires\<rbrakk>
- \<Longrightarrow> dec_after_clear (as, am) (s', l, Bk # r) ires"
-apply(auto simp: dec_after_clear.simps)
-done
-
-lemma [simp]: "\<lbrakk>dec_after_clear (as, am) (s, l, Bk # r) ires\<rbrakk>
- \<Longrightarrow> dec_right_move (as, am) (s', Bk # l, r) ires"
-apply(auto simp: dec_after_clear.simps dec_right_move.simps split: if_splits)
-done
-
-lemma [simp]: "\<lbrakk>dec_after_clear (as, am) (s, l, []) ires\<rbrakk>
- \<Longrightarrow> dec_right_move (as, am) (s', Bk # l, []) ires"
-apply(auto simp: dec_after_clear.simps dec_right_move.simps )
-done
-
-lemma [simp]: "\<exists>rn. a::block\<^bsup>rn\<^esup> = []"
-apply(rule_tac x = 0 in exI, simp)
-done
-
-lemma [simp]: "\<lbrakk>dec_after_clear (as, am) (s, l, []) ires\<rbrakk>
- \<Longrightarrow> dec_right_move (as, am) (s', Bk # l, [Bk]) ires"
-apply(auto simp: dec_after_clear.simps dec_right_move.simps split: if_splits)
-done
-
-lemma [simp]:"dec_right_move (as, am) (s, l, Oc # r) ires = False"
-apply(auto simp: dec_right_move.simps)
-done
-
-lemma dec_right_move_2_check_right_move[simp]:
- "\<lbrakk>dec_right_move (as, am) (s, l, Bk # r) ires\<rbrakk>
- \<Longrightarrow> dec_check_right_move (as, am) (s', Bk # l, r) ires"
-apply(auto simp: dec_right_move.simps dec_check_right_move.simps split: if_splits)
-done
-
-lemma [simp]:
- "dec_right_move (as, am) (s, l, []) ires=
- dec_right_move (as, am) (s, l, [Bk]) ires"
-apply(simp add: dec_right_move.simps)
-apply(rule_tac iffI)
-apply(erule_tac [!] exE)+
-apply(erule_tac [2] exE)
-apply(rule_tac [!] x = lm1 in exI, rule_tac x = "[]" in exI,
- rule_tac [!] x = m in exI, auto)
-apply(auto intro: nil_2_nil)
-done
-
-lemma [simp]: "\<lbrakk>dec_right_move (as, am) (s, l, []) ires\<rbrakk>
- \<Longrightarrow> dec_check_right_move (as, am) (s, Bk # l, []) ires"
-apply(insert dec_right_move_2_check_right_move[of as am s l "[]" s'],
- simp)
-done
-
-lemma [simp]: "dec_check_right_move (as, am) (s, l, r) ires\<Longrightarrow> l \<noteq> []"
-apply(auto simp: dec_check_right_move.simps split: if_splits)
-done
-
-lemma [simp]: "\<lbrakk>dec_check_right_move (as, am) (s, l, Oc # r) ires\<rbrakk>
- \<Longrightarrow> dec_after_write (as, am) (s', tl l, hd l # Oc # r) ires"
-apply(auto simp: dec_check_right_move.simps dec_after_write.simps)
-apply(rule_tac x = lm1 in exI, rule_tac x = lm2 in exI,
- rule_tac x = m in exI, auto)
-done
-
-lemma [simp]: "\<lbrakk>dec_check_right_move (as, am) (s, l, Bk # r) ires\<rbrakk>
- \<Longrightarrow> dec_left_move (as, am) (s', tl l, hd l # Bk # r) ires"
-apply(auto simp: dec_check_right_move.simps
- dec_left_move.simps inv_after_move.simps)
-apply(rule_tac x = lm1 in exI, rule_tac x = m in exI, auto)
-apply(auto intro: BkCons_nil nil_2_nil dest: BkCons_nil)
-apply(rule_tac x = "Suc rn" in exI)
-apply(auto intro: BkCons_nil nil_2_nil dest: BkCons_nil)
-done
-
-lemma [simp]: "\<lbrakk>dec_check_right_move (as, am) (s, l, []) ires\<rbrakk>
- \<Longrightarrow> dec_left_move (as, am) (s', tl l, [hd l]) ires"
-apply(auto simp: dec_check_right_move.simps
- dec_left_move.simps inv_after_move.simps)
-apply(rule_tac x = lm1 in exI, rule_tac x = m in exI, auto)
-apply(auto intro: BkCons_nil nil_2_nil dest: BkCons_nil)
-done
-
-lemma [simp]: "dec_left_move (as, am) (s, aaa, Oc # xs) ires = False"
-apply(auto simp: dec_left_move.simps inv_after_move.simps)
-apply(case_tac [!] rn, auto)
-done
-
-lemma [simp]: "dec_left_move (as, am) (s, l, r) ires
- \<Longrightarrow> l \<noteq> []"
-apply(auto simp: dec_left_move.simps split: if_splits)
-done
-
-lemma tape_of_nl_abv_cons_ex[simp]:
- "\<exists>lna. Oc # Oc\<^bsup>m\<^esup> @ Bk # <rev lm1> @ Bk\<^bsup>ln\<^esup> = <m # rev lm1> @ Bk\<^bsup>lna\<^esup>"
-apply(case_tac "lm1=[]", auto simp: tape_of_nl_abv
- tape_of_nat_list.simps)
-apply(rule_tac x = "ln" in exI, simp)
-apply(simp add: tape_of_nat_list_cons exponent_def)
-done
-
-(*
-lemma [simp]: "inv_on_left_moving_in_middle_B (as, lm1 @ [m])
- (s', Oc # Oc\<^bsup>m\<^esup> @ Bk # <rev lm1> @ Bk\<^bsup>ln\<^esup>, Bk # Bk\<^bsup>rn\<^esup>) ires"
-apply(simp only: inv_on_left_moving_in_middle_B.simps)
-apply(rule_tac x = "lm1 @ [m]" in exI, rule_tac x = "[]" in exI, auto)
-done
-*)
-lemma [simp]: "inv_on_left_moving_in_middle_B (as, [m])
- (s', Oc # Oc\<^bsup>m\<^esup> @ Bk # Bk # ires, Bk # Bk\<^bsup>rn\<^esup>) ires"
-apply(simp add: inv_on_left_moving_in_middle_B.simps)
-apply(rule_tac x = "[m]" in exI, simp, auto simp: tape_of_nat_def)
-done
-
-lemma [simp]: "inv_on_left_moving_in_middle_B (as, [m])
- (s', Oc # Oc\<^bsup>m\<^esup> @ Bk # Bk # ires, [Bk]) ires"
-apply(simp add: inv_on_left_moving_in_middle_B.simps)
-apply(rule_tac x = "[m]" in exI, simp, auto simp: tape_of_nat_def)
-done
-
-lemma [simp]: "lm1 \<noteq> [] \<Longrightarrow>
- inv_on_left_moving_in_middle_B (as, lm1 @ [m]) (s',
- Oc # Oc\<^bsup>m\<^esup> @ Bk # <rev lm1> @ Bk # Bk # ires, Bk # Bk\<^bsup>rn\<^esup>) ires"
-apply(simp only: inv_on_left_moving_in_middle_B.simps)
-apply(rule_tac x = "lm1 @ [m ]" in exI, rule_tac x = "[]" in exI, simp, auto)
-done
-
-lemma [simp]: "lm1 \<noteq> [] \<Longrightarrow>
- inv_on_left_moving_in_middle_B (as, lm1 @ [m]) (s',
- Oc # Oc\<^bsup>m\<^esup> @ Bk # <rev lm1> @ Bk # Bk # ires, [Bk]) ires"
-apply(simp only: inv_on_left_moving_in_middle_B.simps)
-apply(rule_tac x = "lm1 @ [m ]" in exI, rule_tac x = "[]" in exI, simp, auto)
-done
-
-lemma [simp]: "dec_left_move (as, am) (s, l, Bk # r) ires
- \<Longrightarrow> inv_on_left_moving (as, am) (s', tl l, hd l # Bk # r) ires"
-apply(auto simp: dec_left_move.simps inv_on_left_moving.simps split: if_splits)
-done
-
-(*
-lemma [simp]: "inv_on_left_moving_in_middle_B (as, lm1 @ [m])
- (s', Oc # Oc\<^bsup>m\<^esup> @ Bk # <rev lm1> @ Bk\<^bsup>ln\<^esup>, [Bk]) ires"
-apply(auto simp: inv_on_left_moving_in_middle_B.simps)
-apply(rule_tac x = "lm1 @ [m]" in exI, rule_tac x = "[]" in exI, auto)
-done
-*)
-
-lemma [simp]: "dec_left_move (as, am) (s, l, []) ires
- \<Longrightarrow> inv_on_left_moving (as, am) (s', tl l, [hd l]) ires"
-apply(auto simp: dec_left_move.simps inv_on_left_moving.simps split: if_splits)
-done
-
-lemma [simp]: "dec_after_write (as, am) (s, l, Oc # r) ires
- \<Longrightarrow> dec_on_right_moving (as, am) (s', Oc # l, r) ires"
-apply(auto simp: dec_after_write.simps dec_on_right_moving.simps)
-apply(rule_tac x = "lm1 @ [m]" in exI, rule_tac x = "tl lm2" in exI,
- rule_tac x = "hd lm2" in exI, simp)
-apply(rule_tac x = "Suc 0" in exI,rule_tac x = "Suc (hd lm2)" in exI)
-apply(case_tac lm2, simp, simp)
-apply(case_tac "list = []",
- auto simp: tape_of_nl_abv tape_of_nat_list.simps split: if_splits )
-apply(case_tac rn, auto)
-apply(case_tac "rev lm1", simp, simp add: tape_of_nat_list.simps)
-apply(case_tac rn, auto)
-apply(case_tac list, simp_all add: tape_of_nat_list.simps, auto)
-apply(case_tac "rev lm1", simp, simp add: tape_of_nat_list.simps)
-apply(case_tac list, simp_all add: tape_of_nat_list.simps, auto)
-done
-
-lemma [simp]: "dec_after_write (as, am) (s, l, Bk # r) ires
- \<Longrightarrow> dec_after_write (as, am) (s', l, Oc # r) ires"
-apply(auto simp: dec_after_write.simps)
-done
-
-lemma [simp]: "dec_after_write (as, am) (s, aaa, []) ires
- \<Longrightarrow> dec_after_write (as, am) (s', aaa, [Oc]) ires"
-apply(auto simp: dec_after_write.simps)
-done
-
-lemma [simp]: "dec_on_right_moving (as, am) (s, l, Oc # r) ires
- \<Longrightarrow> dec_on_right_moving (as, am) (s', Oc # l, r) ires"
-apply(simp only: dec_on_right_moving.simps)
-apply(erule_tac exE)+
-apply(erule conjE)+
-apply(rule_tac x = lm1 in exI, rule_tac x = lm2 in exI,
- rule_tac x = "m" in exI, rule_tac x = "Suc ml" in exI,
- rule_tac x = "mr - 1" in exI, simp)
-apply(case_tac mr, auto)
-done
-
-lemma [simp]: "dec_on_right_moving (as, am) (s, l, r) ires\<Longrightarrow> l \<noteq> []"
-apply(auto simp: dec_on_right_moving.simps split: if_splits)
-done
-
-lemma [simp]: "dec_on_right_moving (as, am) (s, l, Bk # r) ires
- \<Longrightarrow> dec_after_clear (as, am) (s', tl l, hd l # Bk # r) ires"
-apply(auto simp: dec_on_right_moving.simps dec_after_clear.simps)
-apply(case_tac [!] mr, auto split: if_splits)
-done
-
-lemma [simp]: "dec_on_right_moving (as, am) (s, l, []) ires
- \<Longrightarrow> dec_after_clear (as, am) (s', tl l, [hd l]) ires"
-apply(auto simp: dec_on_right_moving.simps dec_after_clear.simps)
-apply(case_tac mr, simp_all split: if_splits)
-apply(rule_tac x = lm1 in exI, simp)
-done
-
-lemma start_of_le: "a < b \<Longrightarrow> start_of ly a \<le> start_of ly b"
-proof(induct b arbitrary: a, simp, case_tac "a = b", simp)
- fix b a
- show "start_of ly b \<le> start_of ly (Suc b)"
- apply(case_tac "b::nat",
- simp add: start_of.simps, simp add: start_of.simps)
- done
-next
- fix b a
- assume h1: "\<And>a. a < b \<Longrightarrow> start_of ly a \<le> start_of ly b"
- "a < Suc b" "a \<noteq> b"
- hence "a < b"
- by(simp)
- from h1 and this have h2: "start_of ly a \<le> start_of ly b"
- by(drule_tac h1, simp)
- from h2 show "start_of ly a \<le> start_of ly (Suc b)"
- proof -
- have "start_of ly b \<le> start_of ly (Suc b)"
- apply(case_tac "b::nat",
- simp add: start_of.simps, simp add: start_of.simps)
- done
- from h2 and this show "start_of ly a \<le> start_of ly (Suc b)"
- by simp
- qed
-qed
-
-lemma start_of_dec_length[simp]:
- "\<lbrakk>abc_fetch a aprog = Some (Dec n e)\<rbrakk> \<Longrightarrow>
- start_of (layout_of aprog) (Suc a)
- = start_of (layout_of aprog) a + 2*n + 16"
-apply(case_tac a, auto simp: abc_fetch.simps start_of.simps
- layout_of.simps length_of.simps
- split: if_splits)
-done
-
-lemma start_of_ge:
- "\<lbrakk>abc_fetch a aprog = Some (Dec n e); a < e\<rbrakk> \<Longrightarrow>
- start_of (layout_of aprog) e >
- start_of (layout_of aprog) a + 2*n + 15"
-apply(case_tac "e = Suc a",
- simp add: start_of.simps abc_fetch.simps layout_of.simps
- length_of.simps split: if_splits)
-apply(subgoal_tac "Suc a < e", drule_tac a = "Suc a"
- and ly = "layout_of aprog" in start_of_le)
-apply(subgoal_tac "start_of (layout_of aprog) (Suc a)
- = start_of (layout_of aprog) a + 2*n + 16", simp)
-apply(rule_tac start_of_dec_length, simp)
-apply(arith)
-done
-
-lemma starte_not_equal[simp]:
- "\<lbrakk>abc_fetch as aprog = Some (Dec n e); ly = layout_of aprog\<rbrakk>
- \<Longrightarrow> (start_of ly e \<noteq> Suc (Suc (start_of ly as + 2 * n)) \<and>
- start_of ly e \<noteq> start_of ly as + 2 * n + 3 \<and>
- start_of ly e \<noteq> start_of ly as + 2 * n + 4 \<and>
- start_of ly e \<noteq> start_of ly as + 2 * n + 5 \<and>
- start_of ly e \<noteq> start_of ly as + 2 * n + 6 \<and>
- start_of ly e \<noteq> start_of ly as + 2 * n + 7 \<and>
- start_of ly e \<noteq> start_of ly as + 2 * n + 8 \<and>
- start_of ly e \<noteq> start_of ly as + 2 * n + 9 \<and>
- start_of ly e \<noteq> start_of ly as + 2 * n + 10 \<and>
- start_of ly e \<noteq> start_of ly as + 2 * n + 11 \<and>
- start_of ly e \<noteq> start_of ly as + 2 * n + 12 \<and>
- start_of ly e \<noteq> start_of ly as + 2 * n + 13 \<and>
- start_of ly e \<noteq> start_of ly as + 2 * n + 14 \<and>
- start_of ly e \<noteq> start_of ly as + 2 * n + 15)"
-apply(case_tac "e = as", simp)
-apply(case_tac "e < as")
-apply(drule_tac a = e and b = as and ly = ly in start_of_le, simp)
-apply(drule_tac a = as and e = e in start_of_ge, simp, simp)
-done
-
-lemma [simp]: "\<lbrakk>abc_fetch as aprog = Some (Dec n e); ly = layout_of aprog\<rbrakk>
- \<Longrightarrow> (Suc (Suc (start_of ly as + 2 * n)) \<noteq> start_of ly e \<and>
- start_of ly as + 2 * n + 3 \<noteq> start_of ly e \<and>
- start_of ly as + 2 * n + 4 \<noteq> start_of ly e \<and>
- start_of ly as + 2 * n + 5 \<noteq>start_of ly e \<and>
- start_of ly as + 2 * n + 6 \<noteq> start_of ly e \<and>
- start_of ly as + 2 * n + 7 \<noteq> start_of ly e \<and>
- start_of ly as + 2 * n + 8 \<noteq> start_of ly e \<and>
- start_of ly as + 2 * n + 9 \<noteq> start_of ly e \<and>
- start_of ly as + 2 * n + 10 \<noteq> start_of ly e \<and>
- start_of ly as + 2 * n + 11 \<noteq> start_of ly e \<and>
- start_of ly as + 2 * n + 12 \<noteq> start_of ly e \<and>
- start_of ly as + 2 * n + 13 \<noteq> start_of ly e \<and>
- start_of ly as + 2 * n + 14 \<noteq> start_of ly e \<and>
- start_of ly as + 2 * n + 15 \<noteq> start_of ly e)"
-apply(insert starte_not_equal[of as aprog n e ly],
- simp del: starte_not_equal)
-apply(erule_tac conjE)+
-apply(rule_tac conjI, simp del: starte_not_equal)+
-apply(rule not_sym, simp)
-done
-
-lemma [simp]: "start_of (layout_of aprog) as > 0 \<Longrightarrow>
- fetch (ci (layout_of aprog) (start_of (layout_of aprog) as)
- (Dec n as)) (Suc 0) Oc =
- (R, Suc (start_of (layout_of aprog) as))"
-
-apply(auto simp: ci.simps findnth.simps fetch.simps
- nth_of.simps tshift.simps nth_append
- Suc_pre tdec_b_def)
-apply(insert findnth_nth[of 0 n "Suc 0"], simp)
-apply(simp add: findnth.simps)
-done
-
-lemma start_of_inj[simp]:
- "\<lbrakk>abc_fetch as aprog = Some (Dec n e); e \<noteq> as; ly = layout_of aprog\<rbrakk>
- \<Longrightarrow> start_of ly as \<noteq> start_of ly e"
-apply(case_tac "e < as")
-apply(case_tac "as", simp, simp)
-apply(case_tac "e = nat", simp add: start_of.simps
- layout_of.simps length_of.simps)
-apply(subgoal_tac "e < length aprog", simp add: length_of.simps
- split: abc_inst.splits)
-apply(simp add: abc_fetch.simps split: if_splits)
-apply(subgoal_tac "e < nat", drule_tac a = e and b = nat
- and ly =ly in start_of_le, simp)
-apply(subgoal_tac "start_of ly nat < start_of ly (Suc nat)",
- simp, simp add: start_of.simps layout_of.simps)
-apply(subgoal_tac "nat < length aprog", simp)
-apply(case_tac "aprog ! nat", auto simp: length_of.simps)
-apply(simp add: abc_fetch.simps split: if_splits)
-apply(subgoal_tac "e > as", drule_tac start_of_ge, auto)
-done
-
-lemma [simp]: "\<lbrakk>abc_fetch as aprog = Some (Dec n e); e < as\<rbrakk>
- \<Longrightarrow> Suc (start_of (layout_of aprog) e) -
- start_of (layout_of aprog) as = 0"
-apply(frule_tac ly = "layout_of aprog" in start_of_le, simp)
-apply(subgoal_tac "start_of (layout_of aprog) as \<noteq>
- start_of (layout_of aprog) e", arith)
-apply(rule start_of_inj, auto)
-done
-
-lemma [simp]:
- "\<lbrakk>abc_fetch as aprog = Some (Dec n e);
- 0 < start_of (layout_of aprog) as\<rbrakk>
- \<Longrightarrow> (fetch (ci (layout_of aprog) (start_of (layout_of aprog) as)
- (Dec n e)) (Suc (start_of (layout_of aprog) e) -
- start_of (layout_of aprog) as) Oc)
- = (if e = as then (R, start_of (layout_of aprog) as + 1)
- else (Nop, 0))"
-apply(auto split: if_splits)
-apply(case_tac "e < as", simp add: fetch.simps)
-apply(subgoal_tac " e > as")
-apply(drule start_of_ge, simp,
- auto simp: fetch.simps ci_length nth_of.simps)
-apply(subgoal_tac
- "length (ci (layout_of aprog) (start_of (layout_of aprog) as)
- (Dec n e)) div 2= length_of (Dec n e)")
-defer
-apply(simp add: ci_length)
-apply(subgoal_tac
- "length (ci (layout_of aprog) (start_of (layout_of aprog) as)
- (Dec n e)) mod 2 = 0", auto simp: length_of.simps)
-done
-
-lemma [simp]:
- "start_of (layout_of aprog) as > 0 \<Longrightarrow>
- fetch (ci (layout_of aprog) (start_of (layout_of aprog) as)
- (Dec n as)) (Suc 0) Bk
- = (W1, start_of (layout_of aprog) as)"
-apply(auto simp: ci.simps findnth.simps fetch.simps nth_of.simps
- tshift.simps nth_append Suc_pre tdec_b_def)
-apply(insert findnth_nth[of 0 n "0"], simp)
-apply(simp add: findnth.simps)
-done
-
-lemma [simp]:
- "\<lbrakk>abc_fetch as aprog = Some (Dec n e);
- 0 < start_of (layout_of aprog) as\<rbrakk>
-\<Longrightarrow> (fetch (ci (layout_of aprog) (start_of (layout_of aprog) as)
- (Dec n e)) (Suc (start_of (layout_of aprog) e) -
- start_of (layout_of aprog) as) Bk)
- = (if e = as then (W1, start_of (layout_of aprog) as)
- else (Nop, 0))"
-apply(auto split: if_splits)
-apply(case_tac "e < as", simp add: fetch.simps)
-apply(subgoal_tac " e > as")
-apply(drule start_of_ge, simp, auto simp: fetch.simps
- ci_length nth_of.simps)
-apply(subgoal_tac
- "length (ci (layout_of aprog) (start_of (layout_of aprog) as)
- (Dec n e)) div 2= length_of (Dec n e)")
-defer
-apply(simp add: ci_length)
-apply(subgoal_tac
- "length (ci (layout_of aprog) (start_of (layout_of aprog) as)
- (Dec n e)) mod 2 = 0", auto simp: length_of.simps)
-apply(simp add: ci.simps tshift.simps tdec_b_def)
-done
-
-lemma [simp]:
- "inv_stop (as, abc_lm_s am n (abc_lm_v am n)) (s, l, r) ires \<Longrightarrow> l \<noteq> []"
-apply(auto simp: inv_stop.simps)
-done
-
-lemma [simp]:
- "\<lbrakk>abc_fetch as aprog = Some (Dec n e); e \<noteq> as; ly = layout_of aprog\<rbrakk>
- \<Longrightarrow> (\<not> (start_of ly as \<le> start_of ly e \<and>
- start_of ly e < start_of ly as + 2 * n))
- \<and> start_of ly e \<noteq> start_of ly as + 2*n \<and>
- start_of ly e \<noteq> Suc (start_of ly as + 2*n) "
-apply(case_tac "e < as")
-apply(drule_tac ly = ly in start_of_le, simp)
-apply(case_tac n, simp, drule start_of_inj, simp, simp, simp, simp)
-apply(drule_tac start_of_ge, simp, simp)
-done
-
-lemma [simp]:
- "\<lbrakk>abc_fetch as aprog = Some (Dec n e); start_of ly as \<le> s;
- s < start_of ly as + 2 * n; ly = layout_of aprog\<rbrakk>
- \<Longrightarrow> Suc s \<noteq> start_of ly e "
-apply(case_tac "e = as", simp)
-apply(case_tac "e < as")
-apply(drule_tac a = e and b = as and ly = ly in start_of_le, simp)
-apply(drule_tac start_of_ge, auto)
-done
-
-lemma [simp]: "\<lbrakk>abc_fetch as aprog = Some (Dec n e);
- ly = layout_of aprog\<rbrakk>
- \<Longrightarrow> Suc (start_of ly as + 2 * n) \<noteq> start_of ly e"
-apply(case_tac "e = as", simp)
-apply(case_tac "e < as")
-apply(drule_tac a = e and b = as and ly = ly in start_of_le, simp)
-apply(drule_tac start_of_ge, auto)
-done
-
-lemma dec_false_1[simp]:
- "\<lbrakk>abc_lm_v am n = 0; inv_locate_b (as, am) (n, aaa, Oc # xs) ires\<rbrakk>
- \<Longrightarrow> False"
-apply(auto simp: inv_locate_b.simps in_middle.simps exponent_def)
-apply(case_tac "length lm1 \<ge> length am", auto)
-apply(subgoal_tac "lm2 = []", simp, subgoal_tac "m = 0", simp)
-apply(case_tac mr, auto simp: )
-apply(subgoal_tac "Suc (length lm1) - length am =
- Suc (length lm1 - length am)",
- simp add: rep_ind del: replicate.simps, simp)
-apply(drule_tac xs = "am @ replicate (Suc (length lm1) - length am) 0"
- and ys = "lm1 @ m # lm2" in length_equal, simp)
-apply(case_tac mr, auto simp: abc_lm_v.simps)
-apply(case_tac "mr = 0", simp_all add: exponent_def split: if_splits)
-apply(subgoal_tac "Suc (length lm1) - length am =
- Suc (length lm1 - length am)",
- simp add: rep_ind del: replicate.simps, simp)
-done
-
-lemma [simp]:
- "\<lbrakk>inv_locate_b (as, am) (n, aaa, Bk # xs) ires;
- abc_lm_v am n = 0\<rbrakk>
- \<Longrightarrow> inv_on_left_moving (as, abc_lm_s am n 0)
- (s, tl aaa, hd aaa # Bk # xs) ires"
-apply(insert inv_locate_b_2_on_left_moving[of as am n aaa xs ires s], simp)
-done
-
-lemma [simp]:
- "\<lbrakk>abc_lm_v am n = 0; inv_locate_b (as, am) (n, aaa, []) ires\<rbrakk>
- \<Longrightarrow> inv_on_left_moving (as, abc_lm_s am n 0) (s, tl aaa, [hd aaa]) ires"
-apply(insert inv_locate_b_2_on_left_moving_b[of as am n aaa ires s], simp)
-done
-
-lemma [simp]: "\<lbrakk>am ! n = (0::nat); n < length am\<rbrakk> \<Longrightarrow> am[n := 0] = am"
-apply(simp add: list_update_same_conv)
-done
-
-lemma [simp]: "\<lbrakk>abc_lm_v am n = 0;
- inv_locate_b (as, abc_lm_s am n 0) (n, Oc # aaa, xs) ires\<rbrakk>
- \<Longrightarrow> inv_locate_b (as, am) (n, Oc # aaa, xs) ires"
-apply(simp only: inv_locate_b.simps in_middle.simps abc_lm_s.simps
- abc_lm_v.simps)
-apply(erule_tac exE)+
-apply(rule_tac x = lm1 in exI, rule_tac x = lm2 in exI, simp)
-apply(case_tac "n < length am", simp_all)
-apply(erule_tac conjE)+
-apply(rule_tac x = tn in exI, rule_tac x = m in exI, simp)
-apply(rule_tac x = ml in exI, rule_tac x = mr in exI, simp)
-defer
-apply(rule_tac x = "Suc n - length am" in exI, rule_tac x = m in exI)
-apply(subgoal_tac "Suc n - length am = Suc (n - length am)")
-apply(simp add: exponent_def rep_ind del: replicate.simps, auto)
-done
-
-lemma [intro]: "\<lbrakk>abc_lm_v (a # list) 0 = 0\<rbrakk> \<Longrightarrow> a = 0"
-apply(simp add: abc_lm_v.simps split: if_splits)
-done
-
-lemma [simp]:
- "inv_stop (as, abc_lm_s am n 0)
- (start_of (layout_of aprog) e, aaa, Oc # xs) ires
- \<Longrightarrow> inv_locate_a (as, abc_lm_s am n 0) (0, aaa, Oc # xs) ires"
-apply(simp add: inv_locate_a.simps)
-apply(rule disjI1)
-apply(auto simp: inv_stop.simps at_begin_norm.simps)
-done
-
-lemma [simp]:
- "\<lbrakk>abc_lm_v am 0 = 0;
- inv_stop (as, abc_lm_s am 0 0)
- (start_of (layout_of aprog) e, aaa, Oc # xs) ires\<rbrakk> \<Longrightarrow>
- inv_locate_b (as, am) (0, Oc # aaa, xs) ires"
-apply(auto simp: inv_stop.simps inv_locate_b.simps
- in_middle.simps abc_lm_s.simps)
-apply(case_tac "am = []", simp)
-apply(rule_tac x = "[]" in exI, rule_tac x = "Suc 0" in exI,
- rule_tac x = 0 in exI, simp)
-apply(rule_tac x = "Suc 0" in exI, rule_tac x = 0 in exI,
- simp add: tape_of_nl_abv tape_of_nat_list.simps, auto)
-apply(case_tac rn, auto)
-apply(rule_tac x = "tl am" in exI, rule_tac x = 0 in exI,
- rule_tac x = "hd am" in exI, simp)
-apply(rule_tac x = "Suc 0" in exI, rule_tac x = "hd am" in exI, simp)
-apply(case_tac am, simp, simp)
-apply(subgoal_tac "a = 0", case_tac list,
- auto simp: tape_of_nat_list.simps tape_of_nl_abv)
-apply(case_tac rn, auto)
-done
-
-lemma [simp]:
- "\<lbrakk>inv_stop (as, abc_lm_s am n 0)
- (start_of (layout_of aprog) e, aaa, Oc # xs) ires\<rbrakk>
- \<Longrightarrow> inv_locate_b (as, am) (0, Oc # aaa, xs) ires \<or>
- inv_locate_b (as, abc_lm_s am n 0) (0, Oc # aaa, xs) ires"
-apply(simp)
-done
-
-lemma [simp]:
-"\<lbrakk>abc_lm_v am n = 0;
- inv_stop (as, abc_lm_s am n 0)
- (start_of (layout_of aprog) e, aaa, Oc # xs) ires\<rbrakk>
- \<Longrightarrow> \<not> Suc 0 < 2 * n \<longrightarrow> e = as \<longrightarrow>
- inv_locate_b (as, am) (n, Oc # aaa, xs) ires"
-apply(case_tac n, simp, simp)
-done
-
-lemma dec_false2:
- "inv_stop (as, abc_lm_s am n 0)
- (start_of (layout_of aprog) e, aaa, Bk # xs) ires = False"
-apply(auto simp: inv_stop.simps abc_lm_s.simps)
-apply(case_tac "am", simp, case_tac n, simp add: tape_of_nl_abv)
-apply(case_tac list, simp add: tape_of_nat_list.simps )
-apply(simp add: tape_of_nat_list.simps , simp)
-apply(case_tac "list[nat := 0]",
- simp add: tape_of_nat_list.simps tape_of_nl_abv)
-apply(simp add: tape_of_nat_list.simps )
-apply(case_tac "am @ replicate (n - length am) 0 @ [0]", simp)
-apply(case_tac list, auto simp: tape_of_nl_abv
- tape_of_nat_list.simps )
-done
-
-lemma dec_false3:
- "inv_stop (as, abc_lm_s am n 0)
- (start_of (layout_of aprog) e, aaa, []) ires = False"
-apply(auto simp: inv_stop.simps abc_lm_s.simps)
-apply(case_tac "am", case_tac n, auto)
-apply(case_tac n, auto simp: tape_of_nl_abv)
-apply(case_tac "list::nat list",
- simp add: tape_of_nat_list.simps tape_of_nat_list.simps)
-apply(simp add: tape_of_nat_list.simps)
-apply(case_tac "list[nat := 0]",
- simp add: tape_of_nat_list.simps tape_of_nat_list.simps)
-apply(simp add: tape_of_nat_list.simps)
-apply(case_tac "(am @ replicate (n - length am) 0 @ [0])", simp)
-apply(case_tac list, auto simp: tape_of_nat_list.simps)
-done
-
-lemma [simp]:
- "fetch (ci (layout_of aprog)
- (start_of (layout_of aprog) as) (Dec n e)) 0 b = (Nop, 0)"
-by(simp add: fetch.simps)
-
-declare dec_inv_1.simps[simp del]
-
-declare inv_locate_n_b.simps [simp del]
-
-lemma [simp]:
-"\<lbrakk>0 < abc_lm_v am n; 0 < n;
- at_begin_norm (as, am) (n, aaa, Oc # xs) ires\<rbrakk>
- \<Longrightarrow> inv_locate_n_b (as, am) (n, Oc # aaa, xs) ires"
-apply(simp only: at_begin_norm.simps inv_locate_n_b.simps)
-apply(erule_tac exE)+
-apply(rule_tac x = lm1 in exI, simp)
-apply(case_tac "length lm2", simp)
-apply(case_tac rn, simp, simp)
-apply(rule_tac x = "tl lm2" in exI, rule_tac x = "hd lm2" in exI, simp)
-apply(rule conjI)
-apply(case_tac "lm2", simp, simp)
-apply(case_tac "lm2", auto simp: tape_of_nl_abv tape_of_nat_list.simps)
-apply(case_tac [!] "list", auto simp: tape_of_nl_abv tape_of_nat_list.simps)
-apply(case_tac rn, auto)
-done
-lemma [simp]: "(\<exists>rn. Oc # xs = Bk\<^bsup>rn\<^esup>) = False"
-apply(auto)
-apply(case_tac rn, auto simp: )
-done
-
-lemma [simp]:
- "\<lbrakk>0 < abc_lm_v am n; 0 < n;
- at_begin_fst_bwtn (as, am) (n, aaa, Oc # xs) ires\<rbrakk>
- \<Longrightarrow> inv_locate_n_b (as, am) (n, Oc # aaa, xs) ires"
-apply(simp add: at_begin_fst_bwtn.simps inv_locate_n_b.simps )
-done
-
-lemma Suc_minus:"length am + tn = n
- \<Longrightarrow> Suc tn = Suc n - length am "
-apply(arith)
-done
-
-lemma [simp]:
- "\<lbrakk>0 < abc_lm_v am n; 0 < n;
- at_begin_fst_awtn (as, am) (n, aaa, Oc # xs) ires\<rbrakk>
- \<Longrightarrow> inv_locate_n_b (as, am) (n, Oc # aaa, xs) ires"
-apply(simp only: at_begin_fst_awtn.simps inv_locate_n_b.simps )
-apply(erule exE)+
-apply(erule conjE)+
-apply(rule_tac x = lm1 in exI, rule_tac x = "[]" in exI,
- rule_tac x = "Suc tn" in exI, rule_tac x = 0 in exI)
-apply(simp add: exponent_def rep_ind del: replicate.simps)
-apply(rule conjI)+
-apply(auto)
-apply(case_tac [!] rn, auto)
-done
-
-lemma [simp]:
- "\<lbrakk>0 < abc_lm_v am n; 0 < n; inv_locate_a (as, am) (n, aaa, Oc # xs) ires\<rbrakk>
- \<Longrightarrow> inv_locate_n_b (as, am) (n, Oc#aaa, xs) ires"
-apply(auto simp: inv_locate_a.simps)
-done
-
-lemma [simp]:
- "\<lbrakk>inv_locate_n_b (as, am) (n, aaa, Oc # xs) ires\<rbrakk>
- \<Longrightarrow> dec_first_on_right_moving n (as, abc_lm_s am n (abc_lm_v am n))
- (s, Oc # aaa, xs) ires"
-apply(auto simp: inv_locate_n_b.simps dec_first_on_right_moving.simps
- abc_lm_s.simps abc_lm_v.simps)
-apply(rule_tac x = lm1 in exI, rule_tac x = lm2 in exI,
- rule_tac x = m in exI, simp)
-apply(rule_tac x = "Suc (Suc 0)" in exI,
- rule_tac x = "m - 1" in exI, simp)
-apply(case_tac m, auto simp: exponent_def)
-apply(rule_tac x = lm1 in exI, rule_tac x = lm2 in exI,
- rule_tac x = m in exI,
- simp add: Suc_diff_le rep_ind del: replicate.simps)
-apply(rule_tac x = "Suc (Suc 0)" in exI,
- rule_tac x = "m - 1" in exI, simp)
-apply(case_tac m, auto simp: exponent_def)
-apply(rule_tac x = lm1 in exI, rule_tac x = "[]" in exI,
- rule_tac x = m in exI, simp)
-apply(rule_tac x = "Suc (Suc 0)" in exI,
- rule_tac x = "m - 1" in exI, simp)
-apply(case_tac m, auto)
-apply(rule_tac x = lm1 in exI, rule_tac x = lm2 in exI,
- rule_tac x = m in exI,
- simp add: Suc_diff_le rep_ind del: replicate.simps, simp)
-done
-
-lemma dec_false_2:
- "\<lbrakk>0 < abc_lm_v am n; inv_locate_n_b (as, am) (n, aaa, Bk # xs) ires\<rbrakk>
- \<Longrightarrow> False"
-apply(auto simp: inv_locate_n_b.simps abc_lm_v.simps split: if_splits)
-apply(case_tac [!] m, auto)
-done
-
-lemma dec_false_2_b:
- "\<lbrakk>0 < abc_lm_v am n; inv_locate_n_b (as, am)
- (n, aaa, []) ires\<rbrakk> \<Longrightarrow> False"
-apply(auto simp: inv_locate_n_b.simps abc_lm_v.simps split: if_splits)
-apply(case_tac [!] m, auto simp: )
-done
-
-
-(*begin: dec halt1 lemmas*)
-thm abc_inc_stage1.simps
-fun abc_dec_1_stage1:: "t_conf \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat"
- where
- "abc_dec_1_stage1 (s, l, r) ss n =
- (if s > ss \<and> s \<le> ss + 2*n + 1 then 4
- else if s = ss + 2 * n + 13 \<or> s = ss + 2*n + 14 then 3
- else if s = ss + 2*n + 15 then 2
- else 0)"
-
-fun abc_dec_1_stage2:: "t_conf \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat"
- where
- "abc_dec_1_stage2 (s, l, r) ss n =
- (if s \<le> ss + 2 * n + 1 then (ss + 2 * n + 16 - s)
- else if s = ss + 2*n + 13 then length l
- else if s = ss + 2*n + 14 then length l
- else 0)"
-
-fun abc_dec_1_stage3 :: "t_conf \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> block list \<Rightarrow> nat"
- where
- "abc_dec_1_stage3 (s, l, r) ss n ires =
- (if s \<le> ss + 2*n + 1 then
- if (s - ss) mod 2 = 0 then
- if r \<noteq> [] \<and> hd r = Oc then 0 else 1
- else length r
- else if s = ss + 2 * n + 13 then
- if l = Bk # ires \<and> r \<noteq> [] \<and> hd r = Oc then 2
- else 1
- else if s = ss + 2 * n + 14 then
- if r \<noteq> [] \<and> hd r = Oc then 3 else 0
- else 0)"
-
-fun abc_dec_1_measure :: "(t_conf \<times> nat \<times> nat \<times> block list) \<Rightarrow> (nat \<times> nat \<times> nat)"
- where
- "abc_dec_1_measure (c, ss, n, ires) = (abc_dec_1_stage1 c ss n,
- abc_dec_1_stage2 c ss n, abc_dec_1_stage3 c ss n ires)"
-
-definition abc_dec_1_LE ::
- "(((nat \<times> block list \<times> block list) \<times> nat \<times>
- nat \<times> block list) \<times> ((nat \<times> block list \<times> block list) \<times> nat \<times> nat \<times> block list)) set"
- where "abc_dec_1_LE \<equiv> (inv_image lex_triple abc_dec_1_measure)"
-
-lemma wf_dec_le: "wf abc_dec_1_LE"
-by(auto intro:wf_inv_image wf_lex_triple simp:abc_dec_1_LE_def)
-
-declare dec_inv_1.simps[simp del] dec_inv_2.simps[simp del]
-
-lemma [elim]:
- "\<lbrakk>abc_fetch as aprog = Some (Dec n e);
- start_of (layout_of aprog) as < start_of (layout_of aprog) e;
- start_of (layout_of aprog) e \<le>
- Suc (start_of (layout_of aprog) as + 2 * n)\<rbrakk> \<Longrightarrow> False"
-apply(case_tac "e = as", simp)
-apply(case_tac "e < as")
-apply(drule_tac a = e and b = as and ly = "layout_of aprog" in
- start_of_le, simp)
-apply(drule_tac start_of_ge, auto)
-done
-
-lemma [elim]: "\<lbrakk>abc_fetch as aprog = Some (Dec n e);
- start_of (layout_of aprog) e
- = start_of (layout_of aprog) as + 2 * n + 13\<rbrakk>
- \<Longrightarrow> False"
-apply(insert starte_not_equal[of as aprog n e "layout_of aprog"],
- simp)
-done
-
-lemma [elim]: "\<lbrakk>abc_fetch as aprog = Some (Dec n e);
- start_of (layout_of aprog) e =
- start_of (layout_of aprog) as + 2 * n + 14\<rbrakk>
- \<Longrightarrow> False"
-apply(insert starte_not_equal[of as aprog n e "layout_of aprog"],
- simp)
-done
-
-lemma [elim]:
- "\<lbrakk>abc_fetch as aprog = Some (Dec n e);
- start_of (layout_of aprog) as < start_of (layout_of aprog) e;
- start_of (layout_of aprog) e \<le>
- Suc (start_of (layout_of aprog) as + 2 * n)\<rbrakk>
- \<Longrightarrow> False"
-apply(case_tac "e = as", simp)
-apply(case_tac "e < as")
-apply(drule_tac a = e and b = as and ly = "layout_of aprog" in
- start_of_le, simp)
-apply(drule_tac start_of_ge, auto)
-done
-
-lemma [elim]:
- "\<lbrakk>abc_fetch as aprog = Some (Dec n e);
- start_of (layout_of aprog) e =
- start_of (layout_of aprog) as + 2 * n + 13\<rbrakk>
- \<Longrightarrow> False"
-apply(insert starte_not_equal[of as aprog n e "layout_of aprog"],
- simp)
-done
-
-lemma [simp]:
- "abc_fetch as aprog = Some (Dec n e) \<Longrightarrow>
- Suc (start_of (layout_of aprog) as) \<noteq> start_of (layout_of aprog) e"
-apply(case_tac "e = as", simp)
-apply(case_tac "e < as")
-apply(drule_tac a = e and b = as and ly = "(layout_of aprog)" in
- start_of_le, simp)
-apply(drule_tac a = as and e = e in start_of_ge, simp, simp)
-done
-
-lemma [simp]: "inv_on_left_moving (as, am) (s, [], r) ires
- = False"
-apply(simp add: inv_on_left_moving.simps inv_on_left_moving_norm.simps
- inv_on_left_moving_in_middle_B.simps)
-done
-
-lemma [simp]:
- "inv_check_left_moving (as, abc_lm_s am n 0)
- (start_of (layout_of aprog) as + 2 * n + 14, [], Oc # xs) ires
- = False"
-apply(simp add: inv_check_left_moving.simps inv_check_left_moving_in_middle.simps)
-done
-
-lemma dec_inv_stop1_pre:
- "\<lbrakk>abc_fetch as aprog = Some (Dec n e); abc_lm_v am n = 0;
- start_of (layout_of aprog) as > 0\<rbrakk>
- \<Longrightarrow> \<forall>na. \<not> (\<lambda>(s, l, r) (ss, n', ires'). s = start_of (layout_of aprog) e)
- (t_steps (Suc (start_of (layout_of aprog) as), l, r)
- (ci (layout_of aprog) (start_of (layout_of aprog) as)
- (Dec n e), start_of (layout_of aprog) as - Suc 0) na)
- (start_of (layout_of aprog) as, n, ires) \<and>
- dec_inv_1 (layout_of aprog) n e (as, am)
- (t_steps (Suc (start_of (layout_of aprog) as), l, r)
- (ci (layout_of aprog) (start_of (layout_of aprog) as)
- (Dec n e), start_of (layout_of aprog) as - Suc 0) na) ires
- \<longrightarrow> dec_inv_1 (layout_of aprog) n e (as, am)
- (t_steps (Suc (start_of (layout_of aprog) as), l, r)
- (ci (layout_of aprog) (start_of (layout_of aprog) as)
- (Dec n e), start_of (layout_of aprog) as - Suc 0)
- (Suc na)) ires \<and>
- ((t_steps (Suc (start_of (layout_of aprog) as), l, r)
- (ci (layout_of aprog) (start_of (layout_of aprog) as)
- (Dec n e), start_of (layout_of aprog) as - Suc 0) (Suc na),
- start_of (layout_of aprog) as, n, ires),
- t_steps (Suc (start_of (layout_of aprog) as), l, r)
- (ci (layout_of aprog) (start_of (layout_of aprog) as)
- (Dec n e), start_of (layout_of aprog) as - Suc 0) na,
- start_of (layout_of aprog) as, n, ires)
- \<in> abc_dec_1_LE"
-apply(rule allI, rule impI, simp add: t_steps_ind)
-apply(case_tac "(t_steps (Suc (start_of (layout_of aprog) as), l, r)
-(ci (layout_of aprog) (start_of (layout_of aprog) as) (Dec n e),
-start_of (layout_of aprog) as - Suc 0) na)", simp)
-apply(auto split:if_splits simp add:t_step.simps dec_inv_1.simps,
- tactic {* ALLGOALS (resolve_tac [@{thm fetch_intro}]) *})
-apply(simp_all add:dec_fetch_simps new_tape.simps dec_inv_1.simps)
-apply(auto simp add: abc_dec_1_LE_def lex_square_def
- lex_triple_def lex_pair_def
- split: if_splits)
-apply(rule dec_false_1, simp, simp)
-done
-
-lemma dec_inv_stop1:
- "\<lbrakk>ly = layout_of aprog;
- dec_inv_1 ly n e (as, am) (start_of ly as + 1, l, r) ires;
- abc_fetch as aprog = Some (Dec n e); abc_lm_v am n = 0\<rbrakk> \<Longrightarrow>
- (\<exists> stp. (\<lambda> (s', l', r'). s' = start_of ly e \<and>
- dec_inv_1 ly n e (as, am) (s', l' , r') ires)
- (t_steps (start_of ly as + 1, l, r)
- (ci ly (start_of ly as) (Dec n e), start_of ly as - Suc 0) stp))"
-apply(insert halt_lemma2[of abc_dec_1_LE
- "\<lambda> ((s, l, r), ss, n', ires'). s = start_of ly e"
- "(\<lambda> stp. (t_steps (start_of ly as + 1, l, r)
- (ci ly (start_of ly as) (Dec n e), start_of ly as - Suc 0)
- stp, start_of ly as, n, ires))"
- "\<lambda> ((s, l, r), ss, n, ires'). dec_inv_1 ly n e (as, am) (s, l, r) ires'"],
- simp)
-apply(insert wf_dec_le, simp)
-apply(insert dec_inv_stop1_pre[of as aprog n e am l r], simp)
-apply(subgoal_tac "start_of (layout_of aprog) as > 0",
- simp add: t_steps.simps)
-apply(erule_tac exE, rule_tac x = na in exI)
-apply(case_tac
- "(t_steps (Suc (start_of (layout_of aprog) as), l, r)
- (ci (layout_of aprog) (start_of (layout_of aprog) as)
- (Dec n e), start_of (layout_of aprog) as - Suc 0) na)",
- case_tac b, auto)
-apply(rule startof_not0)
-done
-
-(*begin: dec halt2 lemmas*)
-
-lemma [simp]:
- "\<lbrakk>abc_fetch as aprog = Some (Dec n e);
- ly = layout_of aprog\<rbrakk> \<Longrightarrow>
- start_of ly (Suc as) = start_of ly as + 2*n + 16"
-by simp
-
-fun abc_dec_2_stage1 :: "t_conf \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat"
- where
- "abc_dec_2_stage1 (s, l, r) ss n =
- (if s \<le> ss + 2*n + 1 then 7
- else if s = ss + 2*n + 2 then 6
- else if s = ss + 2*n + 3 then 5
- else if s \<ge> ss + 2*n + 4 \<and> s \<le> ss + 2*n + 9 then 4
- else if s = ss + 2*n + 6 then 3
- else if s = ss + 2*n + 10 \<or> s = ss + 2*n + 11 then 2
- else if s = ss + 2*n + 12 then 1
- else 0)"
-
-thm new_tape.simps
-
-fun abc_dec_2_stage2 :: "t_conf \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat"
- where
- "abc_dec_2_stage2 (s, l, r) ss n =
- (if s \<le> ss + 2 * n + 1 then (ss + 2 * n + 16 - s)
- else if s = ss + 2*n + 10 then length l
- else if s = ss + 2*n + 11 then length l
- else if s = ss + 2*n + 4 then length r - 1
- else if s = ss + 2*n + 5 then length r
- else if s = ss + 2*n + 7 then length r - 1
- else if s = ss + 2*n + 8 then
- length r + length (takeWhile (\<lambda> a. a = Oc) l) - 1
- else if s = ss + 2*n + 9 then
- length r + length (takeWhile (\<lambda> a. a = Oc) l) - 1
- else 0)"
-
-fun abc_dec_2_stage3 :: "t_conf \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> block list \<Rightarrow> nat"
- where
- "abc_dec_2_stage3 (s, l, r) ss n ires =
- (if s \<le> ss + 2*n + 1 then
- if (s - ss) mod 2 = 0 then if r \<noteq> [] \<and>
- hd r = Oc then 0 else 1
- else length r
- else if s = ss + 2 * n + 10 then
- if l = Bk # ires \<and> r \<noteq> [] \<and> hd r = Oc then 2
- else 1
- else if s = ss + 2 * n + 11 then
- if r \<noteq> [] \<and> hd r = Oc then 3
- else 0
- else (ss + 2 * n + 16 - s))"
-
-fun abc_dec_2_stage4 :: "t_conf \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat"
- where
- "abc_dec_2_stage4 (s, l, r) ss n =
- (if s = ss + 2*n + 2 then length r
- else if s = ss + 2*n + 8 then length r
- else if s = ss + 2*n + 3 then
- if r \<noteq> [] \<and> hd r = Oc then 1
- else 0
- else if s = ss + 2*n + 7 then
- if r \<noteq> [] \<and> hd r = Oc then 0
- else 1
- else if s = ss + 2*n + 9 then
- if r \<noteq> [] \<and> hd r = Oc then 1
- else 0
- else 0)"
-
-fun abc_dec_2_measure :: "(t_conf \<times> nat \<times> nat \<times> block list) \<Rightarrow>
- (nat \<times> nat \<times> nat \<times> nat)"
- where
- "abc_dec_2_measure (c, ss, n, ires) =
- (abc_dec_2_stage1 c ss n, abc_dec_2_stage2 c ss n,
- abc_dec_2_stage3 c ss n ires, abc_dec_2_stage4 c ss n)"
-
-definition abc_dec_2_LE ::
- "(((nat \<times> block list \<times> block list) \<times> nat \<times> nat \<times> block list) \<times>
- ((nat \<times> block list \<times> block list) \<times> nat \<times> nat \<times> block list)) set"
- where "abc_dec_2_LE \<equiv> (inv_image lex_square abc_dec_2_measure)"
-
-lemma wf_dec_2_le: "wf abc_dec_2_LE"
-by(auto intro:wf_inv_image wf_lex_triple wf_lex_square
- simp:abc_dec_2_LE_def)
-
-lemma [simp]: "dec_after_write (as, am) (s, aa, r) ires
- \<Longrightarrow> takeWhile (\<lambda>a. a = Oc) aa = []"
-apply(simp only : dec_after_write.simps)
-apply(erule exE)+
-apply(erule_tac conjE)+
-apply(case_tac aa, simp)
-apply(case_tac a, simp only: takeWhile.simps , simp, simp split: if_splits)
-done
-
-lemma [simp]:
- "\<lbrakk>dec_on_right_moving (as, lm) (s, aa, []) ires;
- length (takeWhile (\<lambda>a. a = Oc) (tl aa))
- \<noteq> length (takeWhile (\<lambda>a. a = Oc) aa) - Suc 0\<rbrakk>
- \<Longrightarrow> length (takeWhile (\<lambda>a. a = Oc) (tl aa)) <
- length (takeWhile (\<lambda>a. a = Oc) aa) - Suc 0"
-apply(simp only: dec_on_right_moving.simps)
-apply(erule_tac exE)+
-apply(erule_tac conjE)+
-apply(case_tac mr, auto split: if_splits)
-done
-
-lemma [simp]:
- "dec_after_clear (as, abc_lm_s am n (abc_lm_v am n - Suc 0))
- (start_of (layout_of aprog) as + 2 * n + 9, aa, Bk # xs) ires
- \<Longrightarrow> length xs - Suc 0 < length xs +
- length (takeWhile (\<lambda>a. a = Oc) aa)"
-apply(simp only: dec_after_clear.simps)
-apply(erule_tac exE)+
-apply(erule conjE)+
-apply(simp split: if_splits )
-done
-
-lemma [simp]:
- "\<lbrakk>dec_after_clear (as, abc_lm_s am n (abc_lm_v am n - Suc 0))
- (start_of (layout_of aprog) as + 2 * n + 9, aa, []) ires\<rbrakk>
- \<Longrightarrow> Suc 0 < length (takeWhile (\<lambda>a. a = Oc) aa)"
-apply(simp add: dec_after_clear.simps split: if_splits)
-done
-
-lemma [simp]:
- "\<lbrakk>dec_on_right_moving (as, am) (s, aa, Bk # xs) ires;
- Suc (length (takeWhile (\<lambda>a. a = Oc) (tl aa)))
- \<noteq> length (takeWhile (\<lambda>a. a = Oc) aa)\<rbrakk>
- \<Longrightarrow> Suc (length (takeWhile (\<lambda>a. a = Oc) (tl aa)))
- < length (takeWhile (\<lambda>a. a = Oc) aa)"
-apply(simp only: dec_on_right_moving.simps)
-apply(erule exE)+
-apply(erule conjE)+
-apply(case_tac ml, auto split: if_splits )
-done
-
-(*
-lemma abc_dec_2_wf:
- "\<lbrakk>ly = layout_of aprog; dec_inv_2 ly n e (as, am) (start_of ly as + 1, l, r); abc_fetch as aprog = Dec n e; abc_lm_v am n > 0\<rbrakk>
- \<Longrightarrow> \<forall>na. \<not> (\<lambda>(s, l, r) (ss, n'). s = start_of (layout_of aprog) as + 2*n + 16)
- (t_steps (Suc (start_of (layout_of aprog) as), l, r) (ci (layout_of aprog) (start_of (layout_of aprog) as) (Dec n e), start_of (layout_of aprog) as - Suc 0) na)
- (start_of (layout_of aprog) as, n) \<longrightarrow>
- ((t_steps (Suc (start_of (layout_of aprog) as), l, r) (ci (layout_of aprog) (start_of (layout_of aprog) as) (Dec n e), start_of (layout_of aprog) as - Suc 0) (Suc na),
- start_of (layout_of aprog) as, n),
- t_steps (Suc (start_of (layout_of aprog) as), l, r) (ci (layout_of aprog) (start_of (layout_of aprog) as) (Dec n e), start_of (layout_of aprog) as - Suc 0) na,
- start_of (layout_of aprog) as, n)
- \<in> abc_dec_2_LE"
-proof(rule allI, rule impI, simp add: t_steps_ind)
- fix na
- assume h1 :"ly = layout_of aprog" "dec_inv_2 (layout_of aprog) n e (as, am) (Suc (start_of (layout_of aprog) as), l, r)"
- "abc_fetch as aprog = Dec n e" "abc_lm_v am n > 0"
- "\<not> (\<lambda>(s, l, r) (ss, n'). s = start_of (layout_of aprog) as + 2*n + 16)
- (t_steps (Suc (start_of (layout_of aprog) as), l, r) (ci (layout_of aprog) (start_of (layout_of aprog) as) (Dec n e), start_of (layout_of aprog) as - Suc 0) na)
- (start_of (layout_of aprog) as, n)"
- thus "((t_step (t_steps (Suc (start_of (layout_of aprog) as), l, r) (ci (layout_of aprog) (start_of (layout_of aprog) as) (Dec n e), start_of (layout_of aprog) as - Suc 0) na)
- (ci (layout_of aprog) (start_of (layout_of aprog) as) (Dec n e), start_of (layout_of aprog) as - Suc 0),
- start_of (layout_of aprog) as, n),
- t_steps (Suc (start_of (layout_of aprog) as), l, r) (ci (layout_of aprog) (start_of (layout_of aprog) as) (Dec n e), start_of (layout_of aprog) as - Suc 0) na,
- start_of (layout_of aprog) as, n)
- \<in> abc_dec_2_LE"
- proof(insert dec_inv_2_steps[of "layout_of aprog" n e as am "(start_of (layout_of aprog) as + 1, l, r)" aprog na],
- case_tac "(t_steps (start_of (layout_of aprog) as + 1, l, r) (ci (layout_of aprog) (start_of (layout_of aprog) as) (Dec n e), start_of (layout_of aprog) as - Suc 0) na)", case_tac b, simp)
- fix a b aa ba
- assume "dec_inv_2 (layout_of aprog) n e (as, am) (a, aa, ba)" " a \<noteq> start_of (layout_of aprog) as + 2*n + 16" "abc_lm_v am n > 0" "abc_fetch as aprog = Dec n e "
- thus "((t_step (a, aa, ba) (ci (layout_of aprog) (start_of (layout_of aprog) as) (Dec n e), start_of (layout_of aprog) as - Suc 0), start_of (layout_of aprog) as, n), (a, aa, ba),
- start_of (layout_of aprog) as, n)
- \<in> abc_dec_2_LE"
- apply(case_tac "a = 0", auto split:if_splits simp add:t_step.simps dec_inv_2.simps,
- tactic {* ALLGOALS (resolve_tac (thms "fetch_intro")) *})
- apply(simp_all add:dec_fetch_simps new_tape.simps)
- apply(auto simp add: abc_dec_2_LE_def lex_square_def lex_triple_def lex_pair_def
- split: if_splits)
-
- done
- qed
-qed
-*)
-
-lemma [simp]: "inv_check_left_moving (as, abc_lm_s am n (abc_lm_v am n - Suc 0))
- (start_of (layout_of aprog) as + 2 * n + 11, [], Oc # xs) ires = False"
-apply(simp add: inv_check_left_moving.simps inv_check_left_moving_in_middle.simps)
-done
-
-lemma dec_inv_stop2_pre:
- "\<lbrakk>abc_fetch as aprog = Some (Dec n e); abc_lm_v am n > 0\<rbrakk> \<Longrightarrow>
- \<forall>na. \<not> (\<lambda>(s, l, r) (ss, n', ires').
- s = start_of (layout_of aprog) as + 2 * n + 16)
- (t_steps (Suc (start_of (layout_of aprog) as), l, r)
- (ci (layout_of aprog) (start_of (layout_of aprog) as) (Dec n e),
- start_of (layout_of aprog) as - Suc 0) na)
- (start_of (layout_of aprog) as, n, ires) \<and>
- dec_inv_2 (layout_of aprog) n e (as, am)
- (t_steps (Suc (start_of (layout_of aprog) as), l, r)
- (ci (layout_of aprog) (start_of (layout_of aprog) as) (Dec n e),
- start_of (layout_of aprog) as - Suc 0) na) ires
- \<longrightarrow>
- dec_inv_2 (layout_of aprog) n e (as, am)
- (t_steps (Suc (start_of (layout_of aprog) as), l, r)
- (ci (layout_of aprog) (start_of (layout_of aprog) as) (Dec n e),
- start_of (layout_of aprog) as - Suc 0) (Suc na)) ires \<and>
- ((t_steps (Suc (start_of (layout_of aprog) as), l, r)
- (ci (layout_of aprog) (start_of (layout_of aprog) as) (Dec n e),
- start_of (layout_of aprog) as - Suc 0) (Suc na),
- start_of (layout_of aprog) as, n, ires),
- t_steps (Suc (start_of (layout_of aprog) as), l, r)
- (ci (layout_of aprog) (start_of (layout_of aprog) as) (Dec n e),
- start_of (layout_of aprog) as - Suc 0) na,
- start_of (layout_of aprog) as, n, ires)
- \<in> abc_dec_2_LE"
-apply(subgoal_tac "start_of (layout_of aprog) as > 0")
-apply(rule allI, rule impI, simp add: t_steps_ind)
-apply(case_tac "(t_steps (Suc (start_of (layout_of aprog) as), l, r)
- (ci (layout_of aprog) (start_of (layout_of aprog) as) (Dec n e),
- start_of (layout_of aprog) as - Suc 0) na)", simp)
-apply(auto split:if_splits simp add:t_step.simps dec_inv_2.simps,
- tactic {* ALLGOALS (resolve_tac [@{thm fetch_intro}]) *})
-apply(simp_all add:dec_fetch_simps new_tape.simps dec_inv_2.simps)
-apply(auto simp add: abc_dec_2_LE_def lex_square_def lex_triple_def
- lex_pair_def split: if_splits)
-apply(auto intro: dec_false_2_b dec_false_2)
-apply(rule startof_not0)
-done
-
-lemma dec_stop2:
- "\<lbrakk>ly = layout_of aprog;
- dec_inv_2 ly n e (as, am) (start_of ly as + 1, l, r) ires;
- abc_fetch as aprog = Some (Dec n e);
- abc_lm_v am n > 0\<rbrakk> \<Longrightarrow>
- (\<exists> stp. (\<lambda> (s', l', r'). s' = start_of ly (Suc as) \<and>
- dec_inv_2 ly n e (as, am) (s', l', r') ires)
- (t_steps (start_of ly as+1, l, r) (ci ly (start_of ly as)
- (Dec n e), start_of ly as - Suc 0) stp))"
-apply(insert halt_lemma2[of abc_dec_2_LE
- "\<lambda> ((s, l, r), ss, n', ires'). s = start_of ly (Suc as)"
- "(\<lambda> stp. (t_steps (start_of ly as + 1, l, r)
- (ci ly (start_of ly as) (Dec n e), start_of ly as - Suc 0) stp,
- start_of ly as, n, ires))"
- "(\<lambda> ((s, l, r), ss, n, ires'). dec_inv_2 ly n e (as, am) (s, l, r) ires')"])
-apply(insert wf_dec_2_le, simp)
-apply(insert dec_inv_stop2_pre[of as aprog n e am l r],
- simp add: t_steps.simps)
-apply(erule_tac exE)
-apply(rule_tac x = na in exI)
-apply(case_tac "(t_steps (Suc (start_of (layout_of aprog) as), l, r)
-(ci (layout_of aprog) (start_of (layout_of aprog) as) (Dec n e),
- start_of (layout_of aprog) as - Suc 0) na)",
- case_tac b, auto)
-done
-
-lemma dec_inv_stop_cond1:
- "\<lbrakk>ly = layout_of aprog;
- dec_inv_1 ly n e (as, lm) (s, (l, r)) ires; s = start_of ly e;
- abc_fetch as aprog = Some (Dec n e); abc_lm_v lm n = 0\<rbrakk>
- \<Longrightarrow> crsp_l ly (e, abc_lm_s lm n 0) (s, l, r) ires"
-apply(simp add: dec_inv_1.simps split: if_splits)
-apply(auto simp: crsp_l.simps inv_stop.simps )
-done
-
-lemma dec_inv_stop_cond2:
- "\<lbrakk>ly = layout_of aprog; s = start_of ly (Suc as);
- dec_inv_2 ly n e (as, lm) (s, (l, r)) ires;
- abc_fetch as aprog = Some (Dec n e);
- abc_lm_v lm n > 0\<rbrakk>
- \<Longrightarrow> crsp_l ly (Suc as,
- abc_lm_s lm n (abc_lm_v lm n - Suc 0)) (s, l, r) ires"
-apply(simp add: dec_inv_2.simps split: if_splits)
-apply(auto simp: crsp_l.simps inv_stop.simps )
-done
-
-lemma [simp]: "(case Bk\<^bsup>rn\<^esup> of [] \<Rightarrow> Bk |
- Bk # xs \<Rightarrow> Bk | Oc # xs \<Rightarrow> Oc) = Bk"
-apply(case_tac rn, auto)
-done
-
-lemma [simp]: "t_steps tc (p,off) (m + n) =
- t_steps (t_steps tc (p, off) m) (p, off) n"
-apply(induct m arbitrary: n)
-apply(simp add: t_steps.simps)
-proof -
- fix m n
- assume h1: "\<And>n. t_steps tc (p, off) (m + n) =
- t_steps (t_steps tc (p, off) m) (p, off) n"
- hence h2: "t_steps tc (p, off) (Suc m + n) =
- t_steps tc (p, off) (m + Suc n)"
- by simp
- from h1 and this show
- "t_steps tc (p, off) (Suc m + n) =
- t_steps (t_steps tc (p, off) (Suc m)) (p, off) n"
- proof(simp only: h2, simp add: t_steps.simps)
- have h3: "(t_step (t_steps tc (p, off) m) (p, off)) =
- (t_steps (t_step tc (p, off)) (p, off) m)"
- apply(simp add: t_steps.simps[THEN sym] t_steps_ind[THEN sym])
- done
- from h3 show
- "t_steps (t_step (t_steps tc (p, off) m) (p, off)) (p, off) n = t_steps (t_steps (t_step tc (p, off)) (p, off) m) (p, off) n"
- by simp
- qed
-qed
-
-lemma [simp]: " abc_fetch as aprog = Some (Dec n e) \<Longrightarrow>
- Suc (start_of (layout_of aprog) as) \<noteq>
- start_of (layout_of aprog) e"
-apply(case_tac "e = as", simp)
-apply(case_tac "e < as")
-apply(drule_tac a = e and b = as and ly = "layout_of aprog"
- in start_of_le, simp)
-apply(drule_tac start_of_ge, auto)
-done
-
-lemma [simp]: "inv_locate_b (as, []) (0, Oc # Bk # Bk # ires, Bk\<^bsup>rn - Suc 0\<^esup>) ires"
-apply(auto simp: inv_locate_b.simps in_middle.simps)
-apply(rule_tac x = "[]" in exI, rule_tac x = "Suc 0" in exI,
- rule_tac x = 0 in exI, simp)
-apply(rule_tac x = "Suc 0" in exI, rule_tac x = 0 in exI, auto)
-apply(case_tac rn, simp, case_tac nat, auto)
-done
-
-lemma [simp]:
- "inv_locate_n_b (as, []) (0, Oc # Bk # Bk # ires, Bk\<^bsup>rn - Suc 0\<^esup>) ires"
-apply(auto simp: inv_locate_n_b.simps in_middle.simps)
-apply(case_tac rn, simp, case_tac nat, auto)
-done
-
-lemma [simp]:
-"abc_fetch as aprog = Some (Dec n e) \<Longrightarrow>
- dec_inv_1 (layout_of aprog) n e (as, [])
- (Suc (start_of (layout_of aprog) as), Oc # Bk # Bk # ires, Bk\<^bsup>rn - Suc 0\<^esup>) ires
-\<and>
- dec_inv_2 (layout_of aprog) n e (as, [])
- (Suc (start_of (layout_of aprog) as), Oc # Bk # Bk # ires, Bk\<^bsup>rn - Suc 0\<^esup>) ires"
-apply(simp add: dec_inv_1.simps dec_inv_2.simps)
-apply(case_tac n, auto)
-done
-
-lemma [simp]:
- "\<lbrakk>am \<noteq> []; <am> = Oc # r';
- abc_fetch as aprog = Some (Dec n e)\<rbrakk>
- \<Longrightarrow> inv_locate_b (as, am) (0, Oc # Bk # Bk # ires, r' @ Bk\<^bsup>rn\<^esup>) ires"
-apply(auto simp: inv_locate_b.simps in_middle.simps)
-apply(rule_tac x = "tl am" in exI, rule_tac x = 0 in exI,
- rule_tac x = "hd am" in exI, simp)
-apply(rule_tac x = "Suc 0" in exI)
-apply(rule_tac x = "hd am" in exI, simp)
-apply(case_tac am, simp, case_tac list, auto simp: tape_of_nl_abv tape_of_nat_list.simps)
-apply(case_tac rn, auto)
-done
-
-lemma [simp]:
- "\<lbrakk><am> = Oc # r'; abc_fetch as aprog = Some (Dec n e)\<rbrakk> \<Longrightarrow>
- inv_locate_n_b (as, am) (0, Oc # Bk # Bk # ires, r' @ Bk\<^bsup>rn\<^esup>) ires"
-apply(auto simp: inv_locate_n_b.simps)
-apply(rule_tac x = "tl am" in exI, rule_tac x = "hd am" in exI, auto)
-apply(case_tac [!] am, auto simp: tape_of_nl_abv tape_of_nat_list.simps )
-apply(case_tac [!]list, auto simp: tape_of_nl_abv tape_of_nat_list.simps)
-apply(case_tac rn, simp, simp)
-apply(erule_tac x = nat in allE, simp)
-done
-
-lemma [simp]:
- "\<lbrakk>am \<noteq> [];
- <am> = Oc # r';
- abc_fetch as aprog = Some (Dec n e)\<rbrakk> \<Longrightarrow>
- dec_inv_1 (layout_of aprog) n e (as, am)
- (Suc (start_of (layout_of aprog) as),
- Oc # Bk # Bk # ires, r' @ Bk\<^bsup>rn\<^esup>) ires \<and>
- dec_inv_2 (layout_of aprog) n e (as, am)
- (Suc (start_of (layout_of aprog) as),
- Oc # Bk # Bk # ires, r' @ Bk\<^bsup>rn\<^esup>) ires"
-apply(simp add: dec_inv_1.simps dec_inv_2.simps)
-apply(case_tac n, auto)
-done
-
-lemma [simp]: "am \<noteq> [] \<Longrightarrow> \<exists>r'. <am::nat list> = Oc # r'"
-apply(case_tac am, simp, case_tac list)
-apply(auto simp: tape_of_nl_abv tape_of_nat_list.simps )
-done
-
-lemma [simp]: "start_of (layout_of aprog) as > 0 \<Longrightarrow>
- (fetch (ci (layout_of aprog)
- (start_of (layout_of aprog) as) (Dec n e)) (Suc 0) Bk)
- = (W1, start_of (layout_of aprog) as)"
-apply(auto simp: ci.simps findnth.simps fetch.simps
- nth_of.simps tshift.simps nth_append Suc_pre tdec_b_def)
-thm findnth_nth
-apply(insert findnth_nth[of 0 n 0], simp)
-apply(simp add: findnth.simps)
-done
-
-lemma [simp]:
- "start_of (layout_of aprog) as > 0
- \<Longrightarrow> (t_step (start_of (layout_of aprog) as, Bk # Bk # ires, Bk\<^bsup>rn\<^esup>)
- (ci (layout_of aprog) (start_of (layout_of aprog) as) (Dec n e),
- start_of (layout_of aprog) as - Suc 0))
- = (start_of (layout_of aprog) as, Bk # Bk # ires, Oc # Bk\<^bsup>rn- Suc 0\<^esup>)"
-apply(simp add: t_step.simps)
-apply(case_tac "start_of (layout_of aprog) as",
- auto simp: new_tape.simps)
-apply(case_tac rn, auto)
-done
-
-lemma [simp]: "start_of (layout_of aprog) as > 0 \<Longrightarrow>
- (fetch (ci (layout_of aprog) (start_of (layout_of aprog) as)
- (Dec n e)) (Suc 0) Oc)
- = (R, Suc (start_of (layout_of aprog) as))"
-
-apply(auto simp: ci.simps findnth.simps fetch.simps
- nth_of.simps tshift.simps nth_append
- Suc_pre tdec_b_def)
-apply(insert findnth_nth[of 0 n "Suc 0"], simp)
-apply(simp add: findnth.simps)
-done
-
-lemma [simp]: "start_of (layout_of aprog) as > 0 \<Longrightarrow>
- (t_step (start_of (layout_of aprog) as, Bk # Bk # ires, Oc # Bk\<^bsup>rn - Suc 0\<^esup>)
- (ci (layout_of aprog) (start_of (layout_of aprog) as) (Dec n e),
- start_of (layout_of aprog) as - Suc 0)) =
- (Suc (start_of (layout_of aprog) as), Oc # Bk # Bk # ires, Bk\<^bsup>rn-Suc 0\<^esup>)"
-apply(simp add: t_step.simps)
-apply(case_tac "start_of (layout_of aprog) as",
- auto simp: new_tape.simps)
-done
-
-lemma [simp]: "start_of (layout_of aprog) as > 0 \<Longrightarrow>
- t_step (start_of (layout_of aprog) as, Bk # Bk # ires, Oc # r' @ Bk\<^bsup>rn\<^esup>)
- (ci (layout_of aprog) (start_of (layout_of aprog) as) (Dec n e),
- start_of (layout_of aprog) as - Suc 0) =
- (Suc (start_of (layout_of aprog) as), Oc # Bk # Bk # ires, r' @ Bk\<^bsup>rn\<^esup>)"
-apply(simp add: t_step.simps)
-apply(case_tac "start_of (layout_of aprog) as",
- auto simp: new_tape.simps)
-done
-
-lemma crsp_next_state:
- "\<lbrakk>crsp_l (layout_of aprog) (as, am) tc ires;
- abc_fetch as aprog = Some (Dec n e)\<rbrakk>
- \<Longrightarrow> \<exists> stp' > 0. (\<lambda> (s, l, r).
- (s = Suc (start_of (layout_of aprog) as)
- \<and> (dec_inv_1 (layout_of aprog) n e (as, am) (s, l, r) ires)
- \<and> (dec_inv_2 (layout_of aprog) n e (as, am) (s, l, r)) ires))
- (t_steps tc (ci (layout_of aprog) (start_of (layout_of aprog) as)
- (Dec n e), start_of (layout_of aprog) as - Suc 0) stp')"
-apply(subgoal_tac "start_of (layout_of aprog) as > 0")
-apply(case_tac tc, case_tac b, auto simp: crsp_l.simps)
-apply(case_tac "am = []", simp)
-apply(rule_tac x = "Suc (Suc 0)" in exI, simp add: t_steps.simps)
-proof-
- fix rn
- assume h1: "am \<noteq> []" "abc_fetch as aprog = Some (Dec n e)"
- "start_of (layout_of aprog) as > 0"
- hence h2: "\<exists> r'. <am> = Oc # r'"
- by simp
- from h1 and h2 show
- "\<exists>stp'>0. case t_steps (start_of (layout_of aprog) as, Bk # Bk # ires, <am> @ Bk\<^bsup>rn\<^esup>)
- (ci (layout_of aprog) (start_of (layout_of aprog) as) (Dec n e),
- start_of (layout_of aprog) as - Suc 0) stp' of
- (s, ab) \<Rightarrow> s = Suc (start_of (layout_of aprog) as) \<and>
- dec_inv_1 (layout_of aprog) n e (as, am) (s, ab) ires \<and>
- dec_inv_2 (layout_of aprog) n e (as, am) (s, ab) ires"
- proof(erule_tac exE, simp, rule_tac x = "Suc 0" in exI,
- simp add: t_steps.simps)
- qed
-next
- assume "abc_fetch as aprog = Some (Dec n e)"
- thus "0 < start_of (layout_of aprog) as"
- apply(insert startof_not0[of "layout_of aprog" as], simp)
- done
-qed
-
-lemma dec_crsp_ex1:
- "\<lbrakk>crsp_l (layout_of aprog) (as, am) tc ires;
- abc_fetch as aprog = Some (Dec n e);
- abc_lm_v am n = 0\<rbrakk>
- \<Longrightarrow> \<exists>stp > 0. crsp_l (layout_of aprog) (e, abc_lm_s am n 0)
- (t_steps tc (ci (layout_of aprog) (start_of (layout_of aprog) as)
- (Dec n e), start_of (layout_of aprog) as - Suc 0) stp) ires"
-proof -
- assume h1: "crsp_l (layout_of aprog) (as, am) tc ires"
- "abc_fetch as aprog = Some (Dec n e)" "abc_lm_v am n = 0"
- hence h2: "\<exists> stp' > 0. (\<lambda> (s, l, r).
- (s = Suc (start_of (layout_of aprog) as) \<and>
- (dec_inv_1 (layout_of aprog) n e (as, am) (s, l, r)) ires))
- (t_steps tc (ci (layout_of aprog) (start_of (layout_of aprog) as)
- (Dec n e), start_of (layout_of aprog) as - Suc 0) stp')"
- apply(insert crsp_next_state[of aprog as am tc ires n e], auto)
- done
- from h1 and h2 show
- "\<exists>stp > 0. crsp_l (layout_of aprog) (e, abc_lm_s am n 0)
- (t_steps tc (ci (layout_of aprog) (start_of
- (layout_of aprog) as) (Dec n e),
- start_of (layout_of aprog) as - Suc 0) stp) ires"
- proof(erule_tac exE, case_tac "(t_steps tc (ci (layout_of aprog)
- (start_of (layout_of aprog) as) (Dec n e), start_of
- (layout_of aprog) as - Suc 0) stp')", simp)
- fix stp' a b c
- assume h3: "stp' > 0 \<and> a = Suc (start_of (layout_of aprog) as) \<and>
- dec_inv_1 (layout_of aprog) n e (as, am) (a, b, c) ires"
- "abc_fetch as aprog = Some (Dec n e)" "abc_lm_v am n = 0"
- "t_steps tc (ci (layout_of aprog) (start_of (layout_of aprog) as)
- (Dec n e), start_of (layout_of aprog) as - Suc 0) stp'
- = (Suc (start_of (layout_of aprog) as), b, c)"
- thus "\<exists>stp > 0. crsp_l (layout_of aprog) (e, abc_lm_s am n 0)
- (t_steps tc (ci (layout_of aprog) (start_of (layout_of aprog) as)
- (Dec n e), start_of (layout_of aprog) as - Suc 0) stp) ires"
- proof(erule_tac conjE, simp)
- assume "dec_inv_1 (layout_of aprog) n e (as, am)
- (Suc (start_of (layout_of aprog) as), b, c) ires"
- "abc_fetch as aprog = Some (Dec n e)"
- "abc_lm_v am n = 0"
- " t_steps tc (ci (layout_of aprog)
- (start_of (layout_of aprog) as) (Dec n e),
- start_of (layout_of aprog) as - Suc 0) stp'
- = (Suc (start_of (layout_of aprog) as), b, c)"
- hence h4: "\<exists>stp. (\<lambda>(s', l', r'). s' =
- start_of (layout_of aprog) e \<and>
- dec_inv_1 (layout_of aprog) n e (as, am) (s', l', r') ires)
- (t_steps (start_of (layout_of aprog) as + 1, b, c)
- (ci (layout_of aprog)
- (start_of (layout_of aprog) as) (Dec n e),
- start_of (layout_of aprog) as - Suc 0) stp)"
- apply(rule_tac dec_inv_stop1, auto)
- done
- from h3 and h4 show ?thesis
- apply(erule_tac exE)
- apply(rule_tac x = "stp' + stp" in exI, simp)
- apply(case_tac "(t_steps (Suc (start_of (layout_of aprog) as),
- b, c) (ci (layout_of aprog)
- (start_of (layout_of aprog) as) (Dec n e),
- start_of (layout_of aprog) as - Suc 0) stp)",
- simp)
- apply(rule_tac dec_inv_stop_cond1, auto)
- done
- qed
- qed
-qed
-
-lemma dec_crsp_ex2:
- "\<lbrakk>crsp_l (layout_of aprog) (as, am) tc ires;
- abc_fetch as aprog = Some (Dec n e);
- 0 < abc_lm_v am n\<rbrakk>
- \<Longrightarrow> \<exists>stp > 0. crsp_l (layout_of aprog)
- (Suc as, abc_lm_s am n (abc_lm_v am n - Suc 0))
- (t_steps tc (ci (layout_of aprog) (start_of (layout_of aprog) as)
- (Dec n e), start_of (layout_of aprog) as - Suc 0) stp) ires"
-proof -
- assume h1:
- "crsp_l (layout_of aprog) (as, am) tc ires"
- "abc_fetch as aprog = Some (Dec n e)"
- "abc_lm_v am n > 0"
- hence h2:
- "\<exists> stp' > 0. (\<lambda> (s, l, r). (s = Suc (start_of (layout_of aprog) as)
- \<and> (dec_inv_2 (layout_of aprog) n e (as, am) (s, l, r)) ires))
-(t_steps tc (ci (layout_of aprog) (start_of (layout_of aprog) as)
- (Dec n e), start_of (layout_of aprog) as - Suc 0) stp')"
- apply(insert crsp_next_state[of aprog as am tc ires n e], auto)
- done
- from h1 and h2 show
- "\<exists>stp >0. crsp_l (layout_of aprog)
- (Suc as, abc_lm_s am n (abc_lm_v am n - Suc 0))
- (t_steps tc (ci (layout_of aprog) (start_of (layout_of aprog) as)
- (Dec n e), start_of (layout_of aprog) as - Suc 0) stp) ires"
- proof(erule_tac exE,
- case_tac
- "(t_steps tc (ci (layout_of aprog) (start_of (layout_of aprog) as)
- (Dec n e), start_of (layout_of aprog) as - Suc 0) stp')", simp)
- fix stp' a b c
- assume h3: "0 < stp' \<and> a = Suc (start_of (layout_of aprog) as) \<and>
- dec_inv_2 (layout_of aprog) n e (as, am) (a, b, c) ires"
- "abc_fetch as aprog = Some (Dec n e)"
- "abc_lm_v am n > 0"
- "t_steps tc (ci (layout_of aprog)
- (start_of (layout_of aprog) as) (Dec n e),
- start_of (layout_of aprog) as - Suc 0) stp'
- = (Suc (start_of (layout_of aprog) as), b, c)"
- thus "?thesis"
- proof(erule_tac conjE, simp)
- assume
- "dec_inv_2 (layout_of aprog) n e (as, am)
- (Suc (start_of (layout_of aprog) as), b, c) ires"
- "abc_fetch as aprog = Some (Dec n e)" "abc_lm_v am n > 0"
- "t_steps tc (ci (layout_of aprog) (start_of (layout_of aprog) as)
- (Dec n e), start_of (layout_of aprog) as - Suc 0) stp'
- = (Suc (start_of (layout_of aprog) as), b, c)"
- hence h4:
- "\<exists>stp. (\<lambda>(s', l', r'). s' = start_of (layout_of aprog) (Suc as) \<and>
- dec_inv_2 (layout_of aprog) n e (as, am) (s', l', r') ires)
- (t_steps (start_of (layout_of aprog) as + 1, b, c)
- (ci (layout_of aprog) (start_of (layout_of aprog) as)
- (Dec n e), start_of (layout_of aprog) as - Suc 0) stp)"
- apply(rule_tac dec_stop2, auto)
- done
- from h3 and h4 show ?thesis
- apply(erule_tac exE)
- apply(rule_tac x = "stp' + stp" in exI, simp)
- apply(case_tac
- "(t_steps (Suc (start_of (layout_of aprog) as), b, c)
- (ci (layout_of aprog) (start_of (layout_of aprog) as)
- (Dec n e), start_of (layout_of aprog) as - Suc 0) stp)"
- ,simp)
- apply(rule_tac dec_inv_stop_cond2, auto)
- done
- qed
- qed
-qed
-
-lemma dec_crsp_ex_pre:
- "\<lbrakk>ly = layout_of aprog; crsp_l ly (as, am) tc ires;
- abc_fetch as aprog = Some (Dec n e)\<rbrakk>
- \<Longrightarrow> \<exists>stp > 0. crsp_l ly (abc_step_l (as, am) (Some (Dec n e)))
- (t_steps tc (ci (layout_of aprog) (start_of ly as) (Dec n e),
- start_of ly as - Suc 0) stp) ires"
-apply(auto simp: abc_step_l.simps intro: dec_crsp_ex2 dec_crsp_ex1)
-done
-
-lemma dec_crsp_ex:
- assumes layout: -- {* There is an Abacus program @{text "aprog"} with layout @{text "ly"} *}
- "ly = layout_of aprog"
- and dec: -- {* There is an @{text "Dec n e"} instruction at postion @{text "as"} of @{text "aprog"} *}
- "abc_fetch as aprog = Some (Dec n e)"
- and correspond:
- -- {* Abacus configuration @{text "(as, am)"} is in correspondence with TM
- configuration @{text "tc"}
- *}
- "crsp_l ly (as, am) tc ires"
-shows
- "\<exists>stp > 0. crsp_l ly (abc_step_l (as, am) (Some (Dec n e)))
- (t_steps tc (ci (layout_of aprog) (start_of ly as) (Dec n e),
- start_of ly as - Suc 0) stp) ires"
-proof -
- from dec_crsp_ex_pre layout dec correspond show ?thesis by blast
-qed
-
-(*
-subsection {* Compilation of @{text "Goto n"}*}
-*)
-
-lemma goto_fetch:
- "fetch (ci (layout_of aprog)
- (start_of (layout_of aprog) as) (Goto n)) (Suc 0) b
- = (Nop, start_of (layout_of aprog) n)"
-apply(auto simp: ci.simps fetch.simps nth_of.simps
- split: block.splits)
-done
-
-text {*
- Correctness of complied @{text "Goto n"}
- *}
-
-lemma goto_crsp_ex_pre:
- "\<lbrakk>ly = layout_of aprog;
- crsp_l ly (as, am) tc ires;
- abc_fetch as aprog = Some (Goto n)\<rbrakk>
- \<Longrightarrow> \<exists>stp > 0. crsp_l ly (abc_step_l (as, am) (Some (Goto n)))
- (t_steps tc (ci (layout_of aprog) (start_of ly as) (Goto n),
- start_of ly as - Suc 0) stp) ires"
-apply(rule_tac x = 1 in exI)
-apply(simp add: abc_step_l.simps t_steps.simps t_step.simps)
-apply(case_tac tc, simp)
-apply(subgoal_tac "a = start_of (layout_of aprog) as", auto)
-apply(subgoal_tac "start_of (layout_of aprog) as > 0", simp)
-apply(auto simp: goto_fetch new_tape.simps crsp_l.simps)
-apply(rule startof_not0)
-done
-
-lemma goto_crsp_ex:
- assumes layout: "ly = layout_of aprog"
- and goto: "abc_fetch as aprog = Some (Goto n)"
- and correspondence: "crsp_l ly (as, am) tc ires"
- shows "\<exists>stp>0. crsp_l ly (abc_step_l (as, am) (Some (Goto n)))
- (t_steps tc (ci (layout_of aprog) (start_of ly as) (Goto n),
- start_of ly as - Suc 0) stp) ires"
-proof -
- from goto_crsp_ex_pre and layout goto correspondence show "?thesis" by blast
-qed
-
-subsection {*
- The correctness of the compiler
- *}
-
-declare abc_step_l.simps[simp del]
-
-lemma tm_crsp_ex:
- "\<lbrakk>ly = layout_of aprog;
- crsp_l ly (as, am) tc ires;
- as < length aprog;
- abc_fetch as aprog = Some ins\<rbrakk>
- \<Longrightarrow> \<exists> n > 0. crsp_l ly (abc_step_l (as,am) (Some ins))
- (t_steps tc (ci (layout_of aprog) (start_of ly as)
- (ins), (start_of ly as) - (Suc 0)) n) ires"
-apply(case_tac "ins", simp)
-apply(auto intro: inc_crsp_ex_pre dec_crsp_ex goto_crsp_ex)
-done
-
-lemma start_of_pre:
- "n < length aprog \<Longrightarrow> start_of (layout_of aprog) n
- = start_of (layout_of (butlast aprog)) n"
-apply(induct n, simp add: start_of.simps, simp)
-apply(simp add: layout_of.simps start_of.simps)
-apply(subgoal_tac "n < length aprog - Suc 0", simp)
-apply(subgoal_tac "(aprog ! n) = (butlast aprog ! n)", simp)
-proof -
- fix n
- assume h1: "Suc n < length aprog"
- thus "aprog ! n = butlast aprog ! n"
- apply(case_tac "length aprog", simp, simp)
- apply(insert nth_append[of "butlast aprog" "[last aprog]" n])
- apply(subgoal_tac "(butlast aprog @ [last aprog]) = aprog")
- apply(simp split: if_splits)
- apply(rule append_butlast_last_id, case_tac aprog, simp, simp)
- done
-next
- fix n
- assume "Suc n < length aprog"
- thus "n < length aprog - Suc 0"
- apply(case_tac aprog, simp, simp)
- done
-qed
-
-lemma zip_eq: "xs = ys \<Longrightarrow> zip xs zs = zip ys zs"
-by simp
-
-lemma tpairs_of_append_iff: "length aprog = Suc n \<Longrightarrow>
- tpairs_of aprog = tpairs_of (butlast aprog) @
- [(start_of (layout_of aprog) n, aprog ! n)]"
-apply(simp add: tpairs_of.simps)
-apply(insert zip_append[of "map (start_of (layout_of aprog)) [0..<n]"
- "butlast aprog" "[start_of (layout_of aprog) n]" "[last aprog]"])
-apply(simp del: zip_append)
-apply(subgoal_tac "(butlast aprog @ [last aprog]) = aprog", auto)
-apply(rule_tac zip_eq, auto)
-apply(rule_tac start_of_pre, simp)
-apply(insert last_conv_nth[of aprog], case_tac aprog, simp, simp)
-apply(rule append_butlast_last_id, case_tac aprog, simp, simp)
-done
-
-lemma [simp]: "list_all (\<lambda>(n, tm). abacus.t_ncorrect (ci layout n tm))
- (zip (map (start_of layout) [0..<length aprog]) aprog)"
-proof(induct "length aprog" arbitrary: aprog, simp)
- fix x aprog
- assume ind: "\<And>aprog. x = length aprog \<Longrightarrow>
- list_all (\<lambda>(n, tm). abacus.t_ncorrect (ci layout n tm))
- (zip (map (start_of layout) [0..<length aprog]) aprog)"
- and h: "Suc x = length (aprog::abc_inst list)"
- have g1: "list_all (\<lambda>(n, tm). abacus.t_ncorrect (ci layout n tm))
- (zip (map (start_of layout) [0..<length (butlast aprog)])
- (butlast aprog))"
- using h
- apply(rule_tac ind, auto)
- done
- have g2: "(map (start_of layout) [0..<length aprog]) =
- map (start_of layout) ([0..<length aprog - 1]
- @ [length aprog - 1])"
- using h
- apply(case_tac aprog, simp, simp)
- done
- have "\<exists> xs a. aprog = xs @ [a]"
- using h
- apply(rule_tac x = "butlast aprog" in exI,
- rule_tac x = "last aprog" in exI)
- apply(case_tac "aprog = []", simp, simp)
- done
- from this obtain xs where "\<exists> a. aprog = xs @ [a]" ..
- from this obtain a where g3: "aprog = xs @ [a]" ..
- from g1 and g2 and g3 show "list_all (\<lambda>(n, tm).
- abacus.t_ncorrect (ci layout n tm))
- (zip (map (start_of layout) [0..<length aprog]) aprog)"
- apply(simp)
- apply(auto simp: t_ncorrect.simps ci.simps tshift.simps
- tinc_b_def tdec_b_def split: abc_inst.splits)
- apply arith+
- done
-qed
-
-lemma [intro]: "abc2t_correct aprog"
-apply(simp add: abc2t_correct.simps tpairs_of.simps
- split: abc_inst.splits)
-done
-
-lemma as_out: "\<lbrakk>ly = layout_of aprog; tprog = tm_of aprog;
- crsp_l ly (as, am) tc ires; length aprog \<le> as\<rbrakk>
- \<Longrightarrow> abc_step_l (as, am) (abc_fetch as aprog) = (as, am)"
-apply(simp add: abc_fetch.simps abc_step_l.simps)
-done
-
-lemma tm_merge_ex:
- "\<lbrakk>crsp_l (layout_of aprog) (as, am) tc ires;
- as < length aprog;
- abc_fetch as aprog = Some a;
- abc2t_correct aprog;
- crsp_l (layout_of aprog) (abc_step_l (as, am) (Some a))
- (t_steps tc (ci (layout_of aprog) (start_of (layout_of aprog) as)
- a, start_of (layout_of aprog) as - Suc 0) n) ires;
- n > 0\<rbrakk>
- \<Longrightarrow> \<exists>stp > 0. crsp_l (layout_of aprog) (abc_step_l (as, am)
- (Some a)) (t_steps tc (tm_of aprog, 0) stp) ires"
-apply(case_tac "(t_steps tc (ci (layout_of aprog)
- (start_of (layout_of aprog) as) a,
- start_of (layout_of aprog) as - Suc 0) n)", simp)
-apply(case_tac "(abc_step_l (as, am) (Some a))", simp)
-proof -
- fix aa b c aaa ba
- assume h:
- "crsp_l (layout_of aprog) (as, am) tc ires"
- "as < length aprog"
- "abc_fetch as aprog = Some a"
- "crsp_l (layout_of aprog) (aaa, ba) (aa, b, c) ires"
- "abc2t_correct aprog"
- "n>0"
- "t_steps tc (ci (layout_of aprog) (start_of (layout_of aprog) as) a,
- start_of (layout_of aprog) as - Suc 0) n = (aa, b, c)"
- "abc_step_l (as, am) (Some a) = (aaa, ba)"
- hence "aa = start_of (layout_of aprog) aaa"
- apply(simp add: crsp_l.simps)
- done
- from this and h show
- "\<exists>stp > 0. crsp_l (layout_of aprog) (aaa, ba)
- (t_steps tc (tm_of aprog, 0) stp) ires"
- apply(insert tms_out_ex[of "layout_of aprog" aprog
- "tm_of aprog" as am tc ires a n aa b c aaa ba], auto)
- done
-qed
-
-lemma crsp_inside:
- "\<lbrakk>ly = layout_of aprog;
- tprog = tm_of aprog;
- crsp_l ly (as, am) tc ires;
- as < length aprog\<rbrakk> \<Longrightarrow>
- (\<exists> stp > 0. crsp_l ly (abc_step_l (as,am) (abc_fetch as aprog))
- (t_steps tc (tprog, 0) stp) ires)"
-apply(case_tac "abc_fetch as aprog", simp add: abc_fetch.simps)
-proof -
- fix a
- assume "ly = layout_of aprog"
- "tprog = tm_of aprog"
- "crsp_l ly (as, am) tc ires"
- "as < length aprog"
- "abc_fetch as aprog = Some a"
- thus "\<exists>stp > 0. crsp_l ly (abc_step_l (as, am)
- (abc_fetch as aprog)) (t_steps tc (tprog, 0) stp) ires"
- proof(insert tm_crsp_ex[of ly aprog as am tc ires a],
- auto intro: tm_merge_ex)
- qed
-qed
-
-lemma crsp_outside:
- "\<lbrakk>ly = layout_of aprog; tprog = tm_of aprog;
- crsp_l ly (as, am) tc ires; as \<ge> length aprog\<rbrakk>
- \<Longrightarrow> (\<exists> stp. crsp_l ly (abc_step_l (as,am) (abc_fetch as aprog))
- (t_steps tc (tprog, 0) stp) ires)"
-apply(subgoal_tac "abc_step_l (as, am) (abc_fetch as aprog)
- = (as, am)", simp)
-apply(rule_tac x = 0 in exI, simp add: t_steps.simps)
-apply(rule as_out, simp+)
-done
-
-text {*
- Single-step correntess of the compiler.
-*}
-lemma astep_crsp_pre:
- "\<lbrakk>ly = layout_of aprog;
- tprog = tm_of aprog;
- crsp_l ly (as, am) tc ires\<rbrakk>
- \<Longrightarrow> (\<exists> stp. crsp_l ly (abc_step_l (as,am)
- (abc_fetch as aprog)) (t_steps tc (tprog, 0) stp) ires)"
-apply(case_tac "as < length aprog")
-apply(drule_tac crsp_inside, auto)
-apply(rule_tac crsp_outside, simp+)
-done
-
-text {*
- Single-step correntess of the compiler.
-*}
-lemma astep_crsp_pre1:
- "\<lbrakk>ly = layout_of aprog;
- tprog = tm_of aprog;
- crsp_l ly (as, am) tc ires\<rbrakk>
- \<Longrightarrow> (\<exists> stp. crsp_l ly (abc_step_l (as,am)
- (abc_fetch as aprog)) (t_steps tc (tprog, 0) stp) ires)"
-apply(case_tac "as < length aprog")
-apply(drule_tac crsp_inside, auto)
-apply(rule_tac crsp_outside, simp+)
-done
-
-lemma astep_crsp:
- assumes layout:
- -- {* There is a Abacus program @{text "aprog"} with layout @{text "ly"} *}
- "ly = layout_of aprog"
- and compiled:
- -- {* @{text "tprog"} is the TM compiled from @{text "aprog"} *}
- "tprog = tm_of aprog"
- and corresponds:
- -- {* Abacus configuration @{text "(as, am)"} is in correspondence with TM configuration
- @{text "tc"} *}
- "crsp_l ly (as, am) tc ires"
- -- {* One step execution of @{text "aprog"} can be simulated by multi-step execution
- of @{text "tprog"} *}
- shows "(\<exists> stp. crsp_l ly (abc_step_l (as,am)
- (abc_fetch as aprog)) (t_steps tc (tprog, 0) stp) ires)"
-proof -
- from astep_crsp_pre1 [OF layout compiled corresponds] show ?thesis .
-qed
-
-lemma steps_crsp_pre:
- "\<lbrakk>ly = layout_of aprog; tprog = tm_of aprog;
- crsp_l ly ac tc ires; ac' = abc_steps_l ac aprog n\<rbrakk> \<Longrightarrow>
- (\<exists> n'. crsp_l ly ac' (t_steps tc (tprog, 0) n') ires)"
-apply(induct n arbitrary: ac' ac tc, simp add: abc_steps_l.simps)
-apply(rule_tac x = 0 in exI)
-apply(case_tac ac, simp add: abc_steps_l.simps t_steps.simps)
-apply(case_tac ac, simp add: abc_steps_l.simps)
-apply(subgoal_tac
- "(\<exists> stp. crsp_l ly (abc_step_l (a, b)
- (abc_fetch a aprog)) (t_steps tc (tprog, 0) stp) ires)")
-apply(erule exE)
-apply(subgoal_tac
- "\<exists>n'. crsp_l (layout_of aprog)
- (abc_steps_l (abc_step_l (a, b) (abc_fetch a aprog)) aprog n)
- (t_steps ((t_steps tc (tprog, 0) stp)) (tm_of aprog, 0) n') ires")
-apply(erule exE)
-apply(subgoal_tac
- "t_steps (t_steps tc (tprog, 0) stp) (tm_of aprog, 0) n' =
- t_steps tc (tprog, 0) (stp + n')")
-apply(rule_tac x = "stp + n'" in exI, simp)
-apply(auto intro: astep_crsp simp: t_step_add)
-done
-
-text {*
- Multi-step correctess of the compiler.
-*}
-
-lemma steps_crsp:
- assumes layout:
- -- {* There is an Abacus program @{text "aprog"} with layout @{text "ly"} *}
- "ly = layout_of aprog"
- and compiled:
- -- {* @{text "tprog"} is the TM compiled from @{text "aprog"} *}
- "tprog = tm_of aprog"
- and correspond:
- -- {* Abacus configuration @{text "ac"} is in correspondence with TM configuration @{text "tc"} *}
- "crsp_l ly ac tc ires"
- and execution:
- -- {* @{text "ac'"} is the configuration obtained from @{text "n"}-step execution
- of @{text "aprog"} starting from configuration @{text "ac"} *}
- "ac' = abc_steps_l ac aprog n"
- -- {* There exists steps @{text "n'"} steps, after these steps of execution,
- the Turing configuration such obtained is in correspondence with @{text "ac'"} *}
- shows "(\<exists> n'. crsp_l ly ac' (t_steps tc (tprog, 0) n') ires)"
-proof -
- from steps_crsp_pre [OF layout compiled correspond execution] show ?thesis .
-qed
-
-subsection {* The Mop-up machine *}
-
-fun mop_bef :: "nat \<Rightarrow> tprog"
- where
- "mop_bef 0 = []" |
- "mop_bef (Suc n) = mop_bef n @
- [(R, 2*n + 3), (W0, 2*n + 2), (R, 2*n + 1), (W1, 2*n + 2)]"
-
-definition mp_up :: "tprog"
- where
- "mp_up \<equiv> [(R, 2), (R, 1), (L, 5), (W0, 3), (R, 4), (W0, 3),
- (R, 2), (W0, 3), (L, 5), (L, 6), (R, 0), (L, 6)]"
-
-fun tMp :: "nat \<Rightarrow> nat \<Rightarrow> tprog"
- where
- "tMp n off = tshift (mop_bef n @ tshift mp_up (2*n)) off"
-
-declare mp_up_def[simp del] tMp.simps[simp del] mop_bef.simps[simp del]
-(**********Begin: equiv among aba and turing***********)
-
-lemma tm_append_step:
- "\<lbrakk>t_ncorrect tp1; t_step tc (tp1, 0) = (s, l, r); s \<noteq> 0\<rbrakk>
- \<Longrightarrow> t_step tc (tp1 @ tp2, 0) = (s, l, r)"
-apply(simp add: t_step.simps)
-apply(case_tac tc, simp)
-apply(case_tac
- "(fetch tp1 a (case c of [] \<Rightarrow> Bk |
- Bk # xs \<Rightarrow> Bk | Oc # xs \<Rightarrow> Oc))", simp)
-apply(case_tac a, simp add: fetch.simps)
-apply(simp add: fetch.simps)
-apply(case_tac c, simp)
-apply(case_tac [!] "ab::block")
-apply(auto simp: nth_of.simps nth_append t_ncorrect.simps
- split: if_splits)
-done
-
-lemma state0_ind: "t_steps (0, l, r) (tp, 0) stp = (0, l, r)"
-apply(induct stp, simp add: t_steps.simps)
-apply(simp add: t_steps.simps t_step.simps fetch.simps new_tape.simps)
-done
-
-lemma tm_append_steps:
- "\<lbrakk>t_ncorrect tp1; t_steps tc (tp1, 0) stp = (s, l ,r); s \<noteq> 0\<rbrakk>
- \<Longrightarrow> t_steps tc (tp1 @ tp2, 0) stp = (s, l, r)"
-apply(induct stp arbitrary: tc s l r)
-apply(case_tac tc, simp)
-apply(simp add: t_steps.simps)
-proof -
- fix stp tc s l r
- assume h1: "\<And>tc s l r. \<lbrakk>t_ncorrect tp1; t_steps tc (tp1, 0) stp =
- (s, l, r); s \<noteq> 0\<rbrakk> \<Longrightarrow> t_steps tc (tp1 @ tp2, 0) stp = (s, l, r)"
- and h2: "t_steps tc (tp1, 0) (Suc stp) = (s, l, r)" "s \<noteq> 0"
- "t_ncorrect tp1"
- thus "t_steps tc (tp1 @ tp2, 0) (Suc stp) = (s, l, r)"
- apply(simp add: t_steps.simps)
- apply(case_tac "(t_step tc (tp1, 0))", simp)
- proof-
- fix a b c
- assume g1: "\<And>tc s l r. \<lbrakk>t_steps tc (tp1, 0) stp = (s, l, r);
- 0 < s\<rbrakk> \<Longrightarrow> t_steps tc (tp1 @ tp2, 0) stp = (s, l, r)"
- and g2: "t_step tc (tp1, 0) = (a, b, c)"
- "t_steps (a, b, c) (tp1, 0) stp = (s, l, r)"
- "0 < s"
- "t_ncorrect tp1"
- hence g3: "a > 0"
- apply(case_tac "a::nat", auto simp: t_steps.simps)
- apply(simp add: state0_ind)
- done
- from g1 and g2 and this have g4:
- "(t_step tc (tp1 @ tp2, 0)) = (a, b, c)"
- apply(rule_tac tm_append_step, simp, simp, simp)
- done
- from g1 and g2 and g3 and g4 show
- "t_steps (t_step tc (tp1 @ tp2, 0)) (tp1 @ tp2, 0) stp
- = (s, l, r)"
- apply(simp)
- done
- qed
-qed
-
-lemma shift_fetch:
- "\<lbrakk>n < length tp;
- (tp:: (taction \<times> nat) list) ! n = (aa, ba);
- ba \<noteq> 0\<rbrakk>
- \<Longrightarrow> (tshift tp (length tp div 2)) ! n =
- (aa , ba + length tp div 2)"
-apply(simp add: tshift.simps)
-done
-
-lemma tshift_length_equal: "length (tshift tp q) = length tp"
-apply(auto simp: tshift.simps)
-done
-
-thm nth_of.simps
-
-lemma [simp]: "t_ncorrect tp \<Longrightarrow> 2 * (length tp div 2) = length tp"
-apply(auto simp: t_ncorrect.simps)
-done
-
-lemma tm_append_step_equal':
- "\<lbrakk>t_ncorrect tp; t_ncorrect tp'; off = length tp div 2\<rbrakk> \<Longrightarrow>
- (\<lambda> (s, l, r). ((\<lambda> (s', l', r').
- (s'\<noteq> 0 \<longrightarrow> (s = s' + off \<and> l = l' \<and> r = r')))
- (t_step (a, b, c) (tp', 0))))
- (t_step (a + off, b, c) (tp @ tshift tp' off, 0))"
-apply(simp add: t_step.simps)
-apply(case_tac a, simp add: fetch.simps)
-apply(case_tac
-"(fetch tp' a (case c of [] \<Rightarrow> Bk | Bk # xs \<Rightarrow> Bk | Oc # xs \<Rightarrow> Oc))",
- simp)
-apply(case_tac
-"(fetch (tp @ tshift tp' (length tp div 2))
- (Suc (nat + length tp div 2))
- (case c of [] \<Rightarrow> Bk | Bk # xs \<Rightarrow> Bk | Oc # xs \<Rightarrow> Oc))",
- simp)
-apply(case_tac "(new_tape aa (b, c))",
- case_tac "(new_tape aaa (b, c))", simp,
- rule impI, simp add: fetch.simps split: block.splits option.splits)
-apply (auto simp: nth_of.simps t_ncorrect.simps
- nth_append tshift_length_equal tshift.simps split: if_splits)
-done
-
-
-lemma tm_append_step_equal:
- "\<lbrakk>t_ncorrect tp; t_ncorrect tp'; off = length tp div 2;
- t_step (a, b, c) (tp', 0) = (aa, ab, bb); aa \<noteq> 0\<rbrakk>
- \<Longrightarrow> t_step (a + length tp div 2, b, c)
- (tp @ tshift tp' (length tp div 2), 0)
- = (aa + length tp div 2, ab, bb)"
-apply(insert tm_append_step_equal'[of tp tp' off a b c], simp)
-apply(case_tac "(t_step (a + length tp div 2, b, c)
- (tp @ tshift tp' (length tp div 2), 0))", simp)
-done
-
-lemma tm_append_steps_equal:
- "\<lbrakk>t_ncorrect tp; t_ncorrect tp'; off = length tp div 2\<rbrakk> \<Longrightarrow>
- (\<lambda> (s, l, r). ((\<lambda> (s', l', r'). ((s'\<noteq> 0 \<longrightarrow> s = s' + off \<and> l = l'
- \<and> r = r'))) (t_steps (a, b, c) (tp', 0) stp)))
- (t_steps (a + off, b, c) (tp @ tshift tp' off, 0) stp)"
-apply(induct stp arbitrary : a b c, simp add: t_steps.simps)
-apply(simp add: t_steps.simps)
-apply(case_tac "(t_step (a, b, c) (tp', 0))", simp)
-apply(case_tac "aa = 0", simp add: state0_ind)
-apply(subgoal_tac "(t_step (a + length tp div 2, b, c)
- (tp @ tshift tp' (length tp div 2), 0))
- = (aa + length tp div 2, ba, ca)", simp)
-apply(rule tm_append_step_equal, auto)
-done
-
-(*********Begin: mop_up***************)
-type_synonym mopup_type = "t_conf \<Rightarrow> nat list \<Rightarrow> nat \<Rightarrow> block list \<Rightarrow> bool"
-
-fun mopup_stop :: "mopup_type"
- where
- "mopup_stop (s, l, r) lm n ires=
- (\<exists> ln rn. l = Bk\<^bsup>ln\<^esup> @ Bk # Bk # ires \<and> r = <abc_lm_v lm n> @ Bk\<^bsup>rn\<^esup>)"
-
-fun mopup_bef_erase_a :: "mopup_type"
- where
- "mopup_bef_erase_a (s, l, r) lm n ires=
- (\<exists> ln m rn. l = Bk \<^bsup>ln\<^esup> @ Bk # Bk # ires \<and>
- r = Oc\<^bsup>m \<^esup>@ Bk # <(drop ((s + 1) div 2) lm)> @ Bk\<^bsup>rn\<^esup>)"
-
-fun mopup_bef_erase_b :: "mopup_type"
- where
- "mopup_bef_erase_b (s, l, r) lm n ires =
- (\<exists> ln m rn. l = Bk\<^bsup>ln\<^esup> @ Bk # Bk # ires \<and> r = Bk # Oc\<^bsup>m\<^esup> @ Bk #
- <(drop (s div 2) lm)> @ Bk\<^bsup>rn\<^esup>)"
-
-
-fun mopup_jump_over1 :: "mopup_type"
- where
- "mopup_jump_over1 (s, l, r) lm n ires =
- (\<exists> ln m1 m2 rn. m1 + m2 = Suc (abc_lm_v lm n) \<and>
- l = Oc\<^bsup>m1\<^esup> @ Bk\<^bsup>ln\<^esup> @ Bk # Bk # ires \<and>
- (r = Oc\<^bsup>m2\<^esup> @ Bk # <(drop (Suc n) lm)> @ Bk\<^bsup>rn \<^esup>\<or>
- (r = Oc\<^bsup>m2\<^esup> \<and> (drop (Suc n) lm) = [])))"
-
-fun mopup_aft_erase_a :: "mopup_type"
- where
- "mopup_aft_erase_a (s, l, r) lm n ires =
- (\<exists> lnl lnr rn (ml::nat list) m.
- m = Suc (abc_lm_v lm n) \<and> l = Bk\<^bsup>lnr \<^esup>@ Oc\<^bsup>m \<^esup>@ Bk\<^bsup>lnl\<^esup> @ Bk # Bk # ires \<and>
- (r = <ml> @ Bk\<^bsup>rn\<^esup>))"
-
-fun mopup_aft_erase_b :: "mopup_type"
- where
- "mopup_aft_erase_b (s, l, r) lm n ires=
- (\<exists> lnl lnr rn (ml::nat list) m.
- m = Suc (abc_lm_v lm n) \<and>
- l = Bk\<^bsup>lnr \<^esup>@ Oc\<^bsup>m \<^esup>@ Bk\<^bsup>lnl\<^esup> @ Bk # Bk # ires \<and>
- (r = Bk # <ml> @ Bk\<^bsup>rn \<^esup>\<or>
- r = Bk # Bk # <ml> @ Bk\<^bsup>rn\<^esup>))"
-
-fun mopup_aft_erase_c :: "mopup_type"
- where
- "mopup_aft_erase_c (s, l, r) lm n ires =
- (\<exists> lnl lnr rn (ml::nat list) m.
- m = Suc (abc_lm_v lm n) \<and>
- l = Bk\<^bsup>lnr \<^esup>@ Oc\<^bsup>m \<^esup>@ Bk\<^bsup>lnl\<^esup> @ Bk # Bk # ires \<and>
- (r = <ml> @ Bk\<^bsup>rn \<^esup>\<or> r = Bk # <ml> @ Bk\<^bsup>rn\<^esup>))"
-
-fun mopup_left_moving :: "mopup_type"
- where
- "mopup_left_moving (s, l, r) lm n ires =
- (\<exists> lnl lnr rn m.
- m = Suc (abc_lm_v lm n) \<and>
- ((l = Bk\<^bsup>lnr \<^esup>@ Oc\<^bsup>m \<^esup>@ Bk\<^bsup>lnl\<^esup> @ Bk # Bk # ires \<and> r = Bk\<^bsup>rn\<^esup>) \<or>
- (l = Oc\<^bsup>m - 1\<^esup> @ Bk\<^bsup>lnl\<^esup> @ Bk # Bk # ires \<and> r = Oc # Bk\<^bsup>rn\<^esup>)))"
-
-fun mopup_jump_over2 :: "mopup_type"
- where
- "mopup_jump_over2 (s, l, r) lm n ires =
- (\<exists> ln rn m1 m2.
- m1 + m2 = Suc (abc_lm_v lm n)
- \<and> r \<noteq> []
- \<and> (hd r = Oc \<longrightarrow> (l = Oc\<^bsup>m1\<^esup> @ Bk\<^bsup>ln\<^esup> @ Bk # Bk # ires \<and> r = Oc\<^bsup>m2\<^esup> @ Bk\<^bsup>rn\<^esup>))
- \<and> (hd r = Bk \<longrightarrow> (l = Bk\<^bsup>ln\<^esup> @ Bk # ires \<and> r = Bk # Oc\<^bsup>m1 + m2\<^esup> @ Bk\<^bsup>rn\<^esup>)))"
-
-
-fun mopup_inv :: "mopup_type"
- where
- "mopup_inv (s, l, r) lm n ires =
- (if s = 0 then mopup_stop (s, l, r) lm n ires
- else if s \<le> 2*n then
- if s mod 2 = 1 then mopup_bef_erase_a (s, l, r) lm n ires
- else mopup_bef_erase_b (s, l, r) lm n ires
- else if s = 2*n + 1 then
- mopup_jump_over1 (s, l, r) lm n ires
- else if s = 2*n + 2 then mopup_aft_erase_a (s, l, r) lm n ires
- else if s = 2*n + 3 then mopup_aft_erase_b (s, l, r) lm n ires
- else if s = 2*n + 4 then mopup_aft_erase_c (s, l, r) lm n ires
- else if s = 2*n + 5 then mopup_left_moving (s, l, r) lm n ires
- else if s = 2*n + 6 then mopup_jump_over2 (s, l, r) lm n ires
- else False)"
-
-declare
- mopup_jump_over2.simps[simp del] mopup_left_moving.simps[simp del]
- mopup_aft_erase_c.simps[simp del] mopup_aft_erase_b.simps[simp del]
- mopup_aft_erase_a.simps[simp del] mopup_jump_over1.simps[simp del]
- mopup_bef_erase_a.simps[simp del] mopup_bef_erase_b.simps[simp del]
- mopup_stop.simps[simp del]
-
-lemma mopup_fetch_0[simp]:
- "(fetch (mop_bef n @ tshift mp_up (2 * n)) 0 b) = (Nop, 0)"
-by(simp add: fetch.simps)
-
-lemma mop_bef_length[simp]: "length (mop_bef n) = 4 * n"
-apply(induct n, simp add: mop_bef.simps, simp add: mop_bef.simps)
-done
-
-thm findnth_nth
-lemma mop_bef_nth:
- "\<lbrakk>q < n; x < 4\<rbrakk> \<Longrightarrow> mop_bef n ! (4 * q + x) =
- mop_bef (Suc q) ! ((4 * q) + x)"
-apply(induct n, simp)
-apply(case_tac "q < n", simp add: mop_bef.simps, auto)
-apply(simp add: nth_append)
-apply(subgoal_tac "q = n", simp)
-apply(arith)
-done
-
-lemma fetch_bef_erase_a_o[simp]:
- "\<lbrakk>0 < s; s \<le> 2 * n; s mod 2 = Suc 0\<rbrakk>
- \<Longrightarrow> (fetch (mop_bef n @ tshift mp_up (2 * n)) s Oc) = (W0, s + 1)"
-apply(subgoal_tac "\<exists> q. s = 2*q + 1", auto)
-apply(subgoal_tac "length (mop_bef n) = 4*n")
-apply(auto simp: fetch.simps nth_of.simps nth_append)
-apply(subgoal_tac "mop_bef n ! (4 * q + 1) =
- mop_bef (Suc q) ! ((4 * q) + 1)",
- simp add: mop_bef.simps nth_append)
-apply(rule mop_bef_nth, auto)
-done
-
-lemma fetch_bef_erase_a_b[simp]:
- "\<lbrakk>n < length lm; 0 < s; s \<le> 2 * n; s mod 2 = Suc 0\<rbrakk>
- \<Longrightarrow> (fetch (mop_bef n @ tshift mp_up (2 * n)) s Bk) = (R, s + 2)"
-apply(subgoal_tac "\<exists> q. s = 2*q + 1", auto)
-apply(subgoal_tac "length (mop_bef n) = 4*n")
-apply(auto simp: fetch.simps nth_of.simps nth_append)
-apply(subgoal_tac "mop_bef n ! (4 * q + 0) =
- mop_bef (Suc q) ! ((4 * q + 0))",
- simp add: mop_bef.simps nth_append)
-apply(rule mop_bef_nth, auto)
-done
-
-lemma fetch_bef_erase_b_b:
- "\<lbrakk>n < length lm; 0 < s; s \<le> 2 * n; s mod 2 = 0\<rbrakk> \<Longrightarrow>
- (fetch (mop_bef n @ tshift mp_up (2 * n)) s Bk) = (R, s - 1)"
-apply(subgoal_tac "\<exists> q. s = 2 * q", auto)
-apply(case_tac qa, simp, simp)
-apply(auto simp: fetch.simps nth_of.simps nth_append)
-apply(subgoal_tac "mop_bef n ! (4 * nat + 2) =
- mop_bef (Suc nat) ! ((4 * nat) + 2)",
- simp add: mop_bef.simps nth_append)
-apply(rule mop_bef_nth, auto)
-done
-
-lemma fetch_jump_over1_o:
- "fetch (mop_bef n @ tshift mp_up (2 * n)) (Suc (2 * n)) Oc
- = (R, Suc (2 * n))"
-apply(subgoal_tac "length (mop_bef n) = 4 * n")
-apply(auto simp: fetch.simps nth_of.simps mp_up_def nth_append
- tshift.simps)
-done
-
-lemma fetch_jump_over1_b:
- "fetch (mop_bef n @ tshift mp_up (2 * n)) (Suc (2 * n)) Bk
- = (R, Suc (Suc (2 * n)))"
-apply(subgoal_tac "length (mop_bef n) = 4 * n")
-apply(auto simp: fetch.simps nth_of.simps mp_up_def
- nth_append tshift.simps)
-done
-
-lemma fetch_aft_erase_a_o:
- "fetch (mop_bef n @ tshift mp_up (2 * n)) (Suc (Suc (2 * n))) Oc
- = (W0, Suc (2 * n + 2))"
-apply(subgoal_tac "length (mop_bef n) = 4 * n")
-apply(auto simp: fetch.simps nth_of.simps mp_up_def
- nth_append tshift.simps)
-done
-
-lemma fetch_aft_erase_a_b:
- "fetch (mop_bef n @ tshift mp_up (2 * n)) (Suc (Suc (2 * n))) Bk
- = (L, Suc (2 * n + 4))"
-apply(subgoal_tac "length (mop_bef n) = 4 * n")
-apply(auto simp: fetch.simps nth_of.simps mp_up_def
- nth_append tshift.simps)
-done
-
-lemma fetch_aft_erase_b_b:
- "fetch (mop_bef n @ tshift mp_up (2 * n)) (2*n + 3) Bk
- = (R, Suc (2 * n + 3))"
-apply(subgoal_tac "length (mop_bef n) = 4 * n")
-apply(subgoal_tac "2*n + 3 = Suc (2*n + 2)", simp only: fetch.simps)
-apply(auto simp: nth_of.simps mp_up_def nth_append tshift.simps)
-done
-
-lemma fetch_aft_erase_c_o:
- "fetch (mop_bef n @ tshift mp_up (2 * n)) (2 * n + 4) Oc
- = (W0, Suc (2 * n + 2))"
-apply(subgoal_tac "length (mop_bef n) = 4 * n")
-apply(subgoal_tac "2*n + 4 = Suc (2*n + 3)", simp only: fetch.simps)
-apply(auto simp: nth_of.simps mp_up_def nth_append tshift.simps)
-done
-
-lemma fetch_aft_erase_c_b:
- "fetch (mop_bef n @ tshift mp_up (2 * n)) (2 * n + 4) Bk
- = (R, Suc (2 * n + 1))"
-apply(subgoal_tac "length (mop_bef n) = 4 * n")
-apply(subgoal_tac "2*n + 4 = Suc (2*n + 3)", simp only: fetch.simps)
-apply(auto simp: nth_of.simps mp_up_def nth_append tshift.simps)
-done
-
-lemma fetch_left_moving_o:
- "(fetch (mop_bef n @ tshift mp_up (2 * n)) (2 * n + 5) Oc)
- = (L, 2*n + 6)"
-apply(subgoal_tac "length (mop_bef n) = 4 * n")
-apply(subgoal_tac "2*n + 5 = Suc (2*n + 4)", simp only: fetch.simps)
-apply(auto simp: nth_of.simps mp_up_def nth_append tshift.simps)
-done
-
-lemma fetch_left_moving_b:
- "(fetch (mop_bef n @ tshift mp_up (2 * n)) (2 * n + 5) Bk)
- = (L, 2*n + 5)"
-apply(subgoal_tac "length (mop_bef n) = 4 * n")
-apply(subgoal_tac "2*n + 5 = Suc (2*n + 4)", simp only: fetch.simps)
-apply(auto simp: nth_of.simps mp_up_def nth_append tshift.simps)
-done
-
-lemma fetch_jump_over2_b:
- "(fetch (mop_bef n @ tshift mp_up (2 * n)) (2 * n + 6) Bk)
- = (R, 0)"
-apply(subgoal_tac "length (mop_bef n) = 4 * n")
-apply(subgoal_tac "2*n + 6 = Suc (2*n + 5)", simp only: fetch.simps)
-apply(auto simp: nth_of.simps mp_up_def nth_append tshift.simps)
-done
-
-lemma fetch_jump_over2_o:
-"(fetch (mop_bef n @ tshift mp_up (2 * n)) (2 * n + 6) Oc)
- = (L, 2*n + 6)"
-apply(subgoal_tac "length (mop_bef n) = 4 * n")
-apply(subgoal_tac "2*n + 6 = Suc (2*n + 5)", simp only: fetch.simps)
-apply(auto simp: nth_of.simps mp_up_def nth_append tshift.simps)
-done
-
-lemmas mopupfetchs =
-fetch_bef_erase_a_o fetch_bef_erase_a_b fetch_bef_erase_b_b
-fetch_jump_over1_o fetch_jump_over1_b fetch_aft_erase_a_o
-fetch_aft_erase_a_b fetch_aft_erase_b_b fetch_aft_erase_c_o
-fetch_aft_erase_c_b fetch_left_moving_o fetch_left_moving_b
-fetch_jump_over2_b fetch_jump_over2_o
-
-lemma [simp]:
-"\<lbrakk>n < length lm; 0 < s; s mod 2 = Suc 0;
- mopup_bef_erase_a (s, l, Oc # xs) lm n ires;
- Suc s \<le> 2 * n\<rbrakk> \<Longrightarrow>
- mopup_bef_erase_b (Suc s, l, Bk # xs) lm n ires"
-apply(auto simp: mopup_bef_erase_a.simps mopup_bef_erase_b.simps )
-apply(rule_tac x = "m - 1" in exI, rule_tac x = rn in exI)
-apply(case_tac m, simp, simp)
-done
-
-lemma mopup_false1:
- "\<lbrakk>0 < s; s \<le> 2 * n; s mod 2 = Suc 0; \<not> Suc s \<le> 2 * n\<rbrakk>
- \<Longrightarrow> RR"
-apply(arith)
-done
-
-lemma [simp]:
- "\<lbrakk>n < length lm; 0 < s; s \<le> 2 * n; s mod 2 = Suc 0;
- mopup_bef_erase_a (s, l, Oc # xs) lm n ires; r = Oc # xs\<rbrakk>
- \<Longrightarrow> (Suc s \<le> 2 * n \<longrightarrow> mopup_bef_erase_b (Suc s, l, Bk # xs) lm n ires) \<and>
- (\<not> Suc s \<le> 2 * n \<longrightarrow> mopup_jump_over1 (Suc s, l, Bk # xs) lm n ires) "
-apply(auto elim: mopup_false1)
-done
-
-lemma drop_abc_lm_v_simp[simp]:
- "n < length lm \<Longrightarrow> drop n lm = abc_lm_v lm n # drop (Suc n) lm"
-apply(auto simp: abc_lm_v.simps)
-apply(drule drop_Suc_conv_tl, simp)
-done
-lemma [simp]: "(\<exists>rna. Bk\<^bsup>rn\<^esup> = Bk # Bk\<^bsup>rna\<^esup>) \<or> Bk\<^bsup>rn\<^esup> = []"
-apply(case_tac rn, simp, auto)
-done
-
-lemma [simp]: "\<exists>lna. Bk # Bk\<^bsup>ln\<^esup> = Bk\<^bsup>lna\<^esup>"
-apply(rule_tac x = "Suc ln" in exI, auto)
-done
-
-lemma mopup_bef_erase_a_2_jump_over[simp]:
- "\<lbrakk>n < length lm; 0 < s; s mod 2 = Suc 0;
- mopup_bef_erase_a (s, l, Bk # xs) lm n ires; Suc s = 2 * n\<rbrakk>
-\<Longrightarrow> mopup_jump_over1 (Suc (2 * n), Bk # l, xs) lm n ires"
-apply(auto simp: mopup_bef_erase_a.simps mopup_jump_over1.simps)
-apply(case_tac m, simp)
-apply(rule_tac x = "Suc ln" in exI, rule_tac x = 0 in exI,
- simp add: tape_of_nl_abv)
-apply(case_tac "drop (Suc n) lm", auto simp: tape_of_nat_list.simps )
-done
-
-lemma Suc_Suc_div: "\<lbrakk>0 < s; s mod 2 = Suc 0; Suc (Suc s) \<le> 2 * n\<rbrakk>
- \<Longrightarrow> (Suc (Suc (s div 2))) \<le> n"
-apply(arith)
-done
-
-lemma mopup_bef_erase_a_2_a[simp]:
- "\<lbrakk>n < length lm; 0 < s; s mod 2 = Suc 0;
- mopup_bef_erase_a (s, l, Bk # xs) lm n ires;
- Suc (Suc s) \<le> 2 * n\<rbrakk> \<Longrightarrow>
- mopup_bef_erase_a (Suc (Suc s), Bk # l, xs) lm n ires"
-apply(auto simp: mopup_bef_erase_a.simps )
-apply(subgoal_tac "drop (Suc (Suc (s div 2))) lm \<noteq> []")
-apply(case_tac m, simp)
-apply(rule_tac x = "Suc (abc_lm_v lm (Suc (s div 2)))" in exI,
- rule_tac x = rn in exI, simp, simp)
-apply(subgoal_tac "(Suc (Suc (s div 2))) \<le> n", simp,
- rule_tac Suc_Suc_div, auto)
-done
-
-lemma mopup_false2:
- "\<lbrakk>n < length lm; 0 < s; s \<le> 2 * n;
- s mod 2 = Suc 0; Suc s \<noteq> 2 * n;
- \<not> Suc (Suc s) \<le> 2 * n\<rbrakk> \<Longrightarrow> RR"
-apply(arith)
-done
-
-lemma [simp]:
- "\<lbrakk>n < length lm; 0 < s; s \<le> 2 * n;
- s mod 2 = Suc 0;
- mopup_bef_erase_a (s, l, Bk # xs) lm n ires;
- r = Bk # xs\<rbrakk>
- \<Longrightarrow> (Suc s = 2 * n \<longrightarrow>
- mopup_jump_over1 (Suc (2 * n), Bk # l, xs) lm n ires) \<and>
- (Suc s \<noteq> 2 * n \<longrightarrow>
- (Suc (Suc s) \<le> 2 * n \<longrightarrow>
- mopup_bef_erase_a (Suc (Suc s), Bk # l, xs) lm n ires) \<and>
- (\<not> Suc (Suc s) \<le> 2 * n \<longrightarrow>
- mopup_aft_erase_a (Suc (Suc s), Bk # l, xs) lm n ires))"
-apply(auto elim: mopup_false2)
-done
-
-lemma [simp]: "mopup_bef_erase_a (s, l, []) lm n ires \<Longrightarrow>
- mopup_bef_erase_a (s, l, [Bk]) lm n ires"
-apply(auto simp: mopup_bef_erase_a.simps)
-done
-
-lemma [simp]:
- "\<lbrakk>n < length lm; 0 < s; s \<le> 2 * n; s mod 2 = Suc 0;
- mopup_bef_erase_a (s, l, []) lm n ires; r = []\<rbrakk>
- \<Longrightarrow> (Suc s = 2 * n \<longrightarrow>
- mopup_jump_over1 (Suc (2 * n), Bk # l, []) lm n ires) \<and>
- (Suc s \<noteq> 2 * n \<longrightarrow>
- (Suc (Suc s) \<le> 2 * n \<longrightarrow>
- mopup_bef_erase_a (Suc (Suc s), Bk # l, []) lm n ires) \<and>
- (\<not> Suc (Suc s) \<le> 2 * n \<longrightarrow>
- mopup_aft_erase_a (Suc (Suc s), Bk # l, []) lm n ires))"
-apply(auto)
-done
-
-lemma "mopup_bef_erase_b (s, l, Oc # xs) lm n ires \<Longrightarrow> l \<noteq> []"
-apply(auto simp: mopup_bef_erase_b.simps)
-done
-
-lemma [simp]: "mopup_bef_erase_b (s, l, Oc # xs) lm n ires = False"
-apply(auto simp: mopup_bef_erase_b.simps )
-done
-
-lemma [simp]: "\<lbrakk>0 < s; s \<le> 2 *n; s mod 2 \<noteq> Suc 0\<rbrakk> \<Longrightarrow>
- (s - Suc 0) mod 2 = Suc 0"
-apply(arith)
-done
-
-lemma [simp]: "\<lbrakk>0 < s; s \<le> 2 *n; s mod 2 \<noteq> Suc 0\<rbrakk> \<Longrightarrow>
- s - Suc 0 \<le> 2 * n"
-apply(simp)
-done
-
-lemma [simp]: "\<lbrakk>0 < s; s \<le> 2 *n; s mod 2 \<noteq> Suc 0\<rbrakk> \<Longrightarrow> \<not> s \<le> Suc 0"
-apply(arith)
-done
-
-lemma [simp]: "\<lbrakk>n < length lm; 0 < s; s \<le> 2 * n;
- s mod 2 \<noteq> Suc 0;
- mopup_bef_erase_b (s, l, Bk # xs) lm n ires; r = Bk # xs\<rbrakk>
- \<Longrightarrow> mopup_bef_erase_a (s - Suc 0, Bk # l, xs) lm n ires"
-apply(auto simp: mopup_bef_erase_b.simps mopup_bef_erase_a.simps)
-done
-
-lemma [simp]: "\<lbrakk>mopup_bef_erase_b (s, l, []) lm n ires\<rbrakk> \<Longrightarrow>
- mopup_bef_erase_a (s - Suc 0, Bk # l, []) lm n ires"
-apply(auto simp: mopup_bef_erase_b.simps mopup_bef_erase_a.simps)
-done
-
-lemma [simp]:
- "\<lbrakk>n < length lm;
- mopup_jump_over1 (Suc (2 * n), l, Oc # xs) lm n ires;
- r = Oc # xs\<rbrakk>
- \<Longrightarrow> mopup_jump_over1 (Suc (2 * n), Oc # l, xs) lm n ires"
-apply(auto simp: mopup_jump_over1.simps)
-apply(rule_tac x = ln in exI, rule_tac x = "Suc m1" in exI,
- rule_tac x = "m2 - 1" in exI)
-apply(case_tac "m2", simp, simp, rule_tac x = rn in exI, simp)
-apply(rule_tac x = ln in exI, rule_tac x = "Suc m1" in exI,
- rule_tac x = "m2 - 1" in exI)
-apply(case_tac m2, simp, simp)
-done
-
-lemma mopup_jump_over1_2_aft_erase_a[simp]:
- "\<lbrakk>n < length lm; mopup_jump_over1 (Suc (2 * n), l, Bk # xs) lm n ires\<rbrakk>
- \<Longrightarrow> mopup_aft_erase_a (Suc (Suc (2 * n)), Bk # l, xs) lm n ires"
-apply(simp only: mopup_jump_over1.simps mopup_aft_erase_a.simps)
-apply(erule_tac exE)+
-apply(rule_tac x = ln in exI, rule_tac x = "Suc 0" in exI)
-apply(case_tac m2, simp)
-apply(rule_tac x = rn in exI, rule_tac x = "drop (Suc n) lm" in exI,
- simp)
-apply(simp)
-done
-
-lemma [simp]:
- "\<lbrakk>n < length lm; mopup_jump_over1 (Suc (2 * n), l, []) lm n ires\<rbrakk> \<Longrightarrow>
- mopup_aft_erase_a (Suc (Suc (2 * n)), Bk # l, []) lm n ires"
-apply(rule mopup_jump_over1_2_aft_erase_a, simp)
-apply(auto simp: mopup_jump_over1.simps)
-apply(rule_tac x = ln in exI, rule_tac x = m1 in exI,
- rule_tac x = m2 in exI, simp add: )
-apply(rule_tac x = 0 in exI, auto)
-done
-
-lemma [simp]:
- "\<lbrakk>n < length lm;
- mopup_aft_erase_a (Suc (Suc (2 * n)), l, Oc # xs) lm n ires\<rbrakk>
- \<Longrightarrow> mopup_aft_erase_b (Suc (Suc (Suc (2 * n))), l, Bk # xs) lm n ires"
-apply(auto simp: mopup_aft_erase_a.simps mopup_aft_erase_b.simps )
-apply(case_tac ml, simp, case_tac rn, simp, simp)
-apply(case_tac list, auto simp: tape_of_nl_abv
- tape_of_nat_list.simps )
-apply(case_tac a, simp, rule_tac x = rn in exI,
- rule_tac x = "[]" in exI,
- simp add: tape_of_nat_list.simps, simp)
-apply(rule_tac x = rn in exI, rule_tac x = "[nat]" in exI,
- simp add: tape_of_nat_list.simps )
-apply(case_tac a, simp, rule_tac x = rn in exI,
- rule_tac x = "aa # lista" in exI, simp, simp)
-apply(rule_tac x = rn in exI, rule_tac x = "nat # aa # lista" in exI,
- simp add: tape_of_nat_list.simps )
-done
-
-lemma [simp]:
- "mopup_aft_erase_a (Suc (Suc (2 * n)), l, Bk # xs) lm n ires \<Longrightarrow> l \<noteq> []"
-apply(auto simp: mopup_aft_erase_a.simps)
-done
-
-lemma [simp]:
- "\<lbrakk>n < length lm;
- mopup_aft_erase_a (Suc (Suc (2 * n)), l, Bk # xs) lm n ires\<rbrakk>
- \<Longrightarrow> mopup_left_moving (5 + 2 * n, tl l, hd l # Bk # xs) lm n ires"
-apply(simp only: mopup_aft_erase_a.simps mopup_left_moving.simps)
-apply(erule exE)+
-apply(case_tac lnr, simp)
-apply(rule_tac x = lnl in exI, simp, rule_tac x = rn in exI, simp)
-apply(subgoal_tac "ml = []", simp)
-apply(rule_tac xs = xs and rn = rn in BkCons_nil, simp, auto)
-apply(subgoal_tac "ml = []", auto)
-apply(rule_tac xs = xs and rn = rn in BkCons_nil, simp)
-done
-
-lemma [simp]:
- "mopup_aft_erase_a (Suc (Suc (2 * n)), l, []) lm n ires \<Longrightarrow> l \<noteq> []"
-apply(simp only: mopup_aft_erase_a.simps)
-apply(erule exE)+
-apply(auto)
-done
-
-lemma [simp]:
- "\<lbrakk>n < length lm; mopup_aft_erase_a (Suc (Suc (2 * n)), l, []) lm n ires\<rbrakk>
- \<Longrightarrow> mopup_left_moving (5 + 2 * n, tl l, [hd l]) lm n ires"
-apply(simp only: mopup_aft_erase_a.simps mopup_left_moving.simps)
-apply(erule exE)+
-apply(subgoal_tac "ml = [] \<and> rn = 0", erule conjE, erule conjE, simp)
-apply(case_tac lnr, simp, rule_tac x = lnl in exI, simp,
- rule_tac x = 0 in exI, simp)
-apply(rule_tac x = lnl in exI, rule_tac x = nat in exI,
- rule_tac x = "Suc 0" in exI, simp)
-apply(case_tac ml, simp, case_tac rn, simp, simp)
-apply(case_tac list, auto simp: tape_of_nl_abv tape_of_nat_list.simps)
-done
-
-lemma [simp]: "mopup_aft_erase_b (2 * n + 3, l, Oc # xs) lm n ires = False"
-apply(auto simp: mopup_aft_erase_b.simps )
-done
-
-lemma [simp]:
- "\<lbrakk>n < length lm;
- mopup_aft_erase_c (2 * n + 4, l, Oc # xs) lm n ires\<rbrakk>
- \<Longrightarrow> mopup_aft_erase_b (Suc (Suc (Suc (2 * n))), l, Bk # xs) lm n ires"
-apply(auto simp: mopup_aft_erase_c.simps mopup_aft_erase_b.simps )
-apply(case_tac ml, simp, case_tac rn, simp, simp, simp)
-apply(case_tac list, auto simp: tape_of_nl_abv
- tape_of_nat_list.simps tape_of_nat_abv )
-apply(case_tac a, rule_tac x = rn in exI,
- rule_tac x = "[]" in exI, simp add: tape_of_nat_list.simps)
-apply(rule_tac x = rn in exI, rule_tac x = "[nat]" in exI,
- simp add: tape_of_nat_list.simps )
-apply(case_tac a, simp, rule_tac x = rn in exI,
- rule_tac x = "aa # lista" in exI, simp)
-apply(rule_tac x = rn in exI, rule_tac x = "nat # aa # lista" in exI,
- simp add: tape_of_nat_list.simps )
-done
-
-lemma mopup_aft_erase_c_aft_erase_a[simp]:
- "\<lbrakk>n < length lm; mopup_aft_erase_c (2 * n + 4, l, Bk # xs) lm n ires\<rbrakk>
- \<Longrightarrow> mopup_aft_erase_a (Suc (Suc (2 * n)), Bk # l, xs) lm n ires"
-apply(simp only: mopup_aft_erase_c.simps mopup_aft_erase_a.simps )
-apply(erule_tac exE)+
-apply(erule conjE, erule conjE, erule disjE)
-apply(subgoal_tac "ml = []", simp, case_tac rn,
- simp, simp, rule conjI)
-apply(rule_tac x = lnl in exI, rule_tac x = "Suc lnr" in exI, simp)
-apply(rule_tac x = nat in exI, rule_tac x = "[]" in exI, simp)
-apply(rule_tac xs = xs and rn = rn in BkCons_nil, simp, simp,
- rule conjI)
-apply(rule_tac x = lnl in exI, rule_tac x = "Suc lnr" in exI, simp)
-apply(rule_tac x = rn in exI, rule_tac x = "ml" in exI, simp)
-done
-
-lemma [simp]:
- "\<lbrakk>n < length lm; mopup_aft_erase_c (2 * n + 4, l, []) lm n ires\<rbrakk>
- \<Longrightarrow> mopup_aft_erase_a (Suc (Suc (2 * n)), Bk # l, []) lm n ires"
-apply(rule mopup_aft_erase_c_aft_erase_a, simp)
-apply(simp only: mopup_aft_erase_c.simps)
-apply(erule exE)+
-apply(rule_tac x = lnl in exI, rule_tac x = lnr in exI, simp add: )
-apply(rule_tac x = 0 in exI, rule_tac x = "[]" in exI, simp)
-done
-
-lemma mopup_aft_erase_b_2_aft_erase_c[simp]:
- "\<lbrakk>n < length lm; mopup_aft_erase_b (2 * n + 3, l, Bk # xs) lm n ires\<rbrakk>
- \<Longrightarrow> mopup_aft_erase_c (4 + 2 * n, Bk # l, xs) lm n ires"
-apply(auto simp: mopup_aft_erase_b.simps mopup_aft_erase_c.simps)
-apply(rule_tac x = "lnl" in exI, rule_tac x = "Suc lnr" in exI, simp)
-apply(rule_tac x = "lnl" in exI, rule_tac x = "Suc lnr" in exI, simp)
-done
-
-lemma [simp]:
- "\<lbrakk>n < length lm; mopup_aft_erase_b (2 * n + 3, l, []) lm n ires\<rbrakk>
- \<Longrightarrow> mopup_aft_erase_c (4 + 2 * n, Bk # l, []) lm n ires"
-apply(rule_tac mopup_aft_erase_b_2_aft_erase_c, simp)
-apply(simp add: mopup_aft_erase_b.simps)
-done
-
-lemma [simp]:
- "mopup_left_moving (2 * n + 5, l, Oc # xs) lm n ires \<Longrightarrow> l \<noteq> []"
-apply(auto simp: mopup_left_moving.simps)
-done
-
-lemma [simp]:
- "\<lbrakk>n < length lm; mopup_left_moving (2 * n + 5, l, Oc # xs) lm n ires\<rbrakk>
- \<Longrightarrow> mopup_jump_over2 (2 * n + 6, tl l, hd l # Oc # xs) lm n ires"
-apply(simp only: mopup_left_moving.simps mopup_jump_over2.simps)
-apply(erule_tac exE)+
-apply(erule conjE, erule disjE, erule conjE)
-apply(case_tac rn, simp, simp add: )
-apply(case_tac "hd l", simp add: )
-apply(case_tac "abc_lm_v lm n", simp)
-apply(rule_tac x = "lnl" in exI, rule_tac x = rn in exI,
- rule_tac x = "Suc 0" in exI, rule_tac x = 0 in exI)
-apply(case_tac lnl, simp, simp, simp add: exp_ind[THEN sym], simp)
-apply(case_tac "abc_lm_v lm n", simp)
-apply(case_tac lnl, simp, simp)
-apply(rule_tac x = lnl in exI, rule_tac x = rn in exI)
-apply(rule_tac x = nat in exI, rule_tac x = "Suc (Suc 0)" in exI, simp)
-done
-
-lemma [simp]: "mopup_left_moving (2 * n + 5, l, xs) lm n ires \<Longrightarrow> l \<noteq> []"
-apply(auto simp: mopup_left_moving.simps)
-done
-
-lemma [simp]:
- "\<lbrakk>n < length lm; mopup_left_moving (2 * n + 5, l, Bk # xs) lm n ires\<rbrakk>
- \<Longrightarrow> mopup_left_moving (2 * n + 5, tl l, hd l # Bk # xs) lm n ires"
-apply(simp only: mopup_left_moving.simps)
-apply(erule exE)+
-apply(case_tac lnr, simp)
-apply(rule_tac x = lnl in exI, rule_tac x = 0 in exI,
- rule_tac x = rn in exI, simp, simp)
-apply(rule_tac x = lnl in exI, rule_tac x = nat in exI, simp)
-done
-
-lemma [simp]:
-"\<lbrakk>n < length lm; mopup_left_moving (2 * n + 5, l, []) lm n ires\<rbrakk>
- \<Longrightarrow> mopup_left_moving (2 * n + 5, tl l, [hd l]) lm n ires"
-apply(simp only: mopup_left_moving.simps)
-apply(erule exE)+
-apply(case_tac lnr, simp)
-apply(rule_tac x = lnl in exI, rule_tac x = 0 in exI,
- rule_tac x = 0 in exI, simp, auto)
-done
-
-lemma [simp]:
- "mopup_jump_over2 (2 * n + 6, l, Oc # xs) lm n ires \<Longrightarrow> l \<noteq> []"
-apply(auto simp: mopup_jump_over2.simps )
-done
-
-lemma [intro]: "\<exists>lna. Bk # Bk\<^bsup>ln\<^esup> = Bk\<^bsup>lna\<^esup> @ [Bk]"
-apply(simp only: exp_ind[THEN sym], auto)
-done
-
-lemma [simp]:
-"\<lbrakk>n < length lm; mopup_jump_over2 (2 * n + 6, l, Oc # xs) lm n ires\<rbrakk>
- \<Longrightarrow> mopup_jump_over2 (2 * n + 6, tl l, hd l # Oc # xs) lm n ires"
-apply(simp only: mopup_jump_over2.simps)
-apply(erule_tac exE)+
-apply(simp add: , erule conjE, erule_tac conjE)
-apply(case_tac m1, simp)
-apply(rule_tac x = ln in exI, rule_tac x = rn in exI,
- rule_tac x = 0 in exI, simp)
-apply(case_tac ln, simp, simp, simp only: exp_ind[THEN sym], simp)
-apply(rule_tac x = ln in exI, rule_tac x = rn in exI,
- rule_tac x = nat in exI, rule_tac x = "Suc m2" in exI, simp)
-done
-
-lemma [simp]: "\<exists>rna. Oc # Oc\<^bsup>a\<^esup> @ Bk\<^bsup>rn\<^esup> = <a> @ Bk\<^bsup>rna\<^esup>"
-apply(case_tac a, auto simp: tape_of_nat_abv )
-done
-
-lemma [simp]:
- "\<lbrakk>n < length lm; mopup_jump_over2 (2 * n + 6, l, Bk # xs) lm n ires\<rbrakk>
- \<Longrightarrow> mopup_stop (0, Bk # l, xs) lm n ires"
-apply(auto simp: mopup_jump_over2.simps mopup_stop.simps)
-done
-
-lemma [simp]: "mopup_jump_over2 (2 * n + 6, l, []) lm n ires = False"
-apply(simp only: mopup_jump_over2.simps, simp)
-done
-
-lemma mopup_inv_step:
- "\<lbrakk>n < length lm; mopup_inv (s, l, r) lm n ires\<rbrakk>
- \<Longrightarrow> mopup_inv (t_step (s, l, r)
- ((mop_bef n @ tshift mp_up (2 * n)), 0)) lm n ires"
-apply(auto split:if_splits simp add:t_step.simps,
- tactic {* ALLGOALS (resolve_tac [@{thm "fetch_intro"}]) *})
-apply(simp_all add: mopupfetchs new_tape.simps)
-done
-
-declare mopup_inv.simps[simp del]
-
-lemma mopup_inv_steps:
-"\<lbrakk>n < length lm; mopup_inv (s, l, r) lm n ires\<rbrakk> \<Longrightarrow>
- mopup_inv (t_steps (s, l, r)
- ((mop_bef n @ tshift mp_up (2 * n)), 0) stp) lm n ires"
-apply(induct stp, simp add: t_steps.simps)
-apply(simp add: t_steps_ind)
-apply(case_tac "(t_steps (s, l, r)
- (mop_bef n @ tshift mp_up (2 * n), 0) stp)", simp)
-apply(rule_tac mopup_inv_step, simp, simp)
-done
-
-lemma [simp]:
- "\<lbrakk>n < length lm; Suc 0 \<le> n\<rbrakk> \<Longrightarrow>
- mopup_bef_erase_a (Suc 0, Bk\<^bsup>ln\<^esup> @ Bk # Bk # ires, <lm> @ Bk\<^bsup>rn\<^esup>) lm n ires"
-apply(auto simp: mopup_bef_erase_a.simps abc_lm_v.simps)
-apply(case_tac lm, simp, case_tac list, simp, simp)
-apply(rule_tac x = "Suc a" in exI, rule_tac x = rn in exI, simp)
-done
-
-lemma [simp]:
- "lm \<noteq> [] \<Longrightarrow> mopup_jump_over1 (Suc 0, Bk\<^bsup>ln\<^esup> @ Bk # Bk # ires, <lm> @ Bk\<^bsup>rn\<^esup>) lm 0 ires"
-apply(auto simp: mopup_jump_over1.simps)
-apply(rule_tac x = ln in exI, rule_tac x = 0 in exI, simp add: )
-apply(case_tac lm, simp, simp add: abc_lm_v.simps)
-apply(case_tac rn, simp)
-apply(case_tac list, rule_tac disjI2,
- simp add: tape_of_nl_abv tape_of_nat_list.simps)
-apply(rule_tac disjI1,
- simp add: tape_of_nl_abv tape_of_nat_list.simps )
-apply(rule_tac disjI1, case_tac list,
- simp add: tape_of_nl_abv tape_of_nat_list.simps,
- rule_tac x = nat in exI, simp)
-apply(simp add: tape_of_nl_abv tape_of_nat_list.simps )
-done
-
-lemma mopup_init:
- "\<lbrakk>n < length lm; crsp_l ly (as, lm) (ac, l, r) ires\<rbrakk> \<Longrightarrow>
- mopup_inv (Suc 0, l, r) lm n ires"
-apply(auto simp: crsp_l.simps mopup_inv.simps)
-apply(case_tac n, simp, auto simp: mopup_bef_erase_a.simps )
-apply(rule_tac x = "Suc (hd lm)" in exI, rule_tac x = rn in exI, simp)
-apply(case_tac lm, simp, case_tac list, simp, case_tac lista, simp add: abc_lm_v.simps)
-apply(simp add: tape_of_nl_abv tape_of_nat_list.simps abc_lm_v.simps)
-apply(simp add: mopup_jump_over1.simps)
-apply(rule_tac x = 0 in exI, rule_tac x = 0 in exI, auto)
-apply(case_tac [!] n, simp_all)
-apply(case_tac [!] lm, simp, case_tac list, simp)
-apply(case_tac rn, simp add: tape_of_nl_abv tape_of_nat_list.simps abc_lm_v.simps)
-apply(erule_tac x = nat in allE, simp add: tape_of_nl_abv tape_of_nat_list.simps abc_lm_v.simps)
-apply(simp add: abc_lm_v.simps, auto)
-apply(case_tac list, simp_all add: tape_of_nl_abv tape_of_nat_list.simps abc_lm_v.simps)
-apply(erule_tac x = rn in allE, simp_all)
-done
-
-fun abc_mopup_stage1 :: "t_conf \<Rightarrow> nat \<Rightarrow> nat"
- where
- "abc_mopup_stage1 (s, l, r) n =
- (if s > 0 \<and> s \<le> 2*n then 6
- else if s = 2*n + 1 then 4
- else if s \<ge> 2*n + 2 \<and> s \<le> 2*n + 4 then 3
- else if s = 2*n + 5 then 2
- else if s = 2*n + 6 then 1
- else 0)"
-
-fun abc_mopup_stage2 :: "t_conf \<Rightarrow> nat \<Rightarrow> nat"
- where
- "abc_mopup_stage2 (s, l, r) n =
- (if s > 0 \<and> s \<le> 2*n then length r
- else if s = 2*n + 1 then length r
- else if s = 2*n + 5 then length l
- else if s = 2*n + 6 then length l
- else if s \<ge> 2*n + 2 \<and> s \<le> 2*n + 4 then length r
- else 0)"
-
-fun abc_mopup_stage3 :: "t_conf \<Rightarrow> nat \<Rightarrow> nat"
- where
- "abc_mopup_stage3 (s, l, r) n =
- (if s > 0 \<and> s \<le> 2*n then
- if hd r = Bk then 0
- else 1
- else if s = 2*n + 2 then 1
- else if s = 2*n + 3 then 0
- else if s = 2*n + 4 then 2
- else 0)"
-
-fun abc_mopup_measure :: "(t_conf \<times> nat) \<Rightarrow> (nat \<times> nat \<times> nat)"
- where
- "abc_mopup_measure (c, n) =
- (abc_mopup_stage1 c n, abc_mopup_stage2 c n,
- abc_mopup_stage3 c n)"
-
-definition abc_mopup_LE ::
- "(((nat \<times> block list \<times> block list) \<times> nat) \<times>
- ((nat \<times> block list \<times> block list) \<times> nat)) set"
- where
- "abc_mopup_LE \<equiv> (inv_image lex_triple abc_mopup_measure)"
-
-lemma wf_abc_mopup_le[intro]: "wf abc_mopup_LE"
-by(auto intro:wf_inv_image wf_lex_triple simp:abc_mopup_LE_def)
-
-lemma [simp]: "mopup_bef_erase_a (a, aa, []) lm n ires = False"
-apply(auto simp: mopup_bef_erase_a.simps)
-done
-
-lemma [simp]: "mopup_bef_erase_b (a, aa, []) lm n ires = False"
-apply(auto simp: mopup_bef_erase_b.simps)
-done
-
-lemma [simp]: "mopup_aft_erase_b (2 * n + 3, aa, []) lm n ires = False"
-apply(auto simp: mopup_aft_erase_b.simps)
-done
-
-lemma mopup_halt_pre:
- "\<lbrakk>n < length lm; mopup_inv (Suc 0, l, r) lm n ires; wf abc_mopup_LE\<rbrakk>
- \<Longrightarrow> \<forall>na. \<not> (\<lambda>(s, l, r) n. s = 0) (t_steps (Suc 0, l, r)
- (mop_bef n @ tshift mp_up (2 * n), 0) na) n \<longrightarrow>
- ((t_steps (Suc 0, l, r) (mop_bef n @ tshift mp_up (2 * n), 0)
- (Suc na), n),
- t_steps (Suc 0, l, r) (mop_bef n @ tshift mp_up (2 * n), 0)
- na, n) \<in> abc_mopup_LE"
-apply(rule allI, rule impI, simp add: t_steps_ind)
-apply(subgoal_tac "mopup_inv (t_steps (Suc 0, l, r)
- (mop_bef n @ tshift mp_up (2 * n), 0) na) lm n ires")
-apply(case_tac "(t_steps (Suc 0, l, r)
- (mop_bef n @ tshift mp_up (2 * n), 0) na)", simp)
-proof -
- fix na a b c
- assume "n < length lm" "mopup_inv (a, b, c) lm n ires" "0 < a"
- thus "((t_step (a, b, c) (mop_bef n @ tshift mp_up (2 * n), 0), n),
- (a, b, c), n) \<in> abc_mopup_LE"
- apply(auto split:if_splits simp add:t_step.simps mopup_inv.simps,
- tactic {* ALLGOALS (resolve_tac [@{thm "fetch_intro"}]) *})
- apply(simp_all add: mopupfetchs new_tape.simps abc_mopup_LE_def
- lex_triple_def lex_pair_def )
- done
-next
- fix na
- assume "n < length lm" "mopup_inv (Suc 0, l, r) lm n ires"
- thus "mopup_inv (t_steps (Suc 0, l, r)
- (mop_bef n @ tshift mp_up (2 * n), 0) na) lm n ires"
- apply(rule mopup_inv_steps)
- done
-qed
-
-lemma mopup_halt: "\<lbrakk>n < length lm; crsp_l ly (as, lm) (s, l, r) ires\<rbrakk> \<Longrightarrow>
- \<exists> stp. (\<lambda> (s, l, r). s = 0) (t_steps (Suc 0, l, r)
- ((mop_bef n @ tshift mp_up (2 * n)), 0) stp)"
-apply(subgoal_tac "mopup_inv (Suc 0, l, r) lm n ires")
-apply(insert wf_abc_mopup_le)
-apply(insert halt_lemma[of abc_mopup_LE
- "\<lambda> ((s, l, r), n). s = 0"
- "\<lambda> stp. (t_steps (Suc 0, l, r) ((mop_bef n @ tshift mp_up (2 * n))
- , 0) stp, n)"], auto)
-apply(insert mopup_halt_pre[of n lm l r], simp, erule exE)
-apply(rule_tac x = na in exI, case_tac "(t_steps (Suc 0, l, r)
- (mop_bef n @ tshift mp_up (2 * n), 0) na)", simp)
-apply(rule_tac mopup_init, auto)
-done
-(***End: mopup stop****)
-
-lemma mopup_halt_conf_pre:
- "\<lbrakk>n < length lm; crsp_l ly (as, lm) (s, l, r) ires\<rbrakk>
- \<Longrightarrow> \<exists> na. (\<lambda> (s', l', r'). s' = 0 \<and> mopup_stop (s', l', r') lm n ires)
- (t_steps (Suc 0, l, r)
- ((mop_bef n @ tshift mp_up (2 * n)), 0) na)"
-apply(subgoal_tac "\<exists> stp. (\<lambda> (s, l, r). s = 0)
- (t_steps (Suc 0, l, r) ((mop_bef n @ tshift mp_up (2 * n)), 0) stp)",
- erule exE)
-apply(rule_tac x = stp in exI,
- case_tac "(t_steps (Suc 0, l, r)
- (mop_bef n @ tshift mp_up (2 * n), 0) stp)", simp)
-apply(subgoal_tac " mopup_inv (Suc 0, l, r) lm n ires")
-apply(subgoal_tac "mopup_inv (t_steps (Suc 0, l, r)
- (mop_bef n @ tshift mp_up (2 * n), 0) stp) lm n ires", simp)
-apply(simp only: mopup_inv.simps)
-apply(rule_tac mopup_inv_steps, simp, simp)
-apply(rule_tac mopup_init, simp, simp)
-apply(rule_tac mopup_halt, simp, simp)
-done
-
-lemma mopup_halt_conf:
- assumes len: "n < length lm"
- and correspond: "crsp_l ly (as, lm) (s, l, r) ires"
- shows
- "\<exists> na. (\<lambda> (s', l', r'). ((\<exists>ln rn. s' = 0 \<and> l' = Bk\<^bsup>ln\<^esup> @ Bk # Bk # ires
- \<and> r' = Oc\<^bsup>Suc (abc_lm_v lm n)\<^esup> @ Bk\<^bsup>rn\<^esup>)))
- (t_steps (Suc 0, l, r)
- ((mop_bef n @ tshift mp_up (2 * n)), 0) na)"
-using len correspond mopup_halt_conf_pre[of n lm ly as s l r ires]
-apply(simp add: mopup_stop.simps tape_of_nat_abv tape_of_nat_list.simps)
-done
-
-subsection {* Final results about Abacus machine *}
-
-lemma mopup_halt_bef: "\<lbrakk>n < length lm; crsp_l ly (as, lm) (s, l, r) ires\<rbrakk>
- \<Longrightarrow> \<exists>stp. (\<lambda>(s, l, r). s \<noteq> 0 \<and> ((\<lambda> (s', l', r'). s' = 0)
- (t_step (s, l, r) (mop_bef n @ tshift mp_up (2 * n), 0))))
- (t_steps (Suc 0, l, r) (mop_bef n @ tshift mp_up (2 * n), 0) stp)"
-apply(insert mopup_halt[of n lm ly as s l r ires], simp, erule_tac exE)
-proof -
- fix stp
- assume "n < length lm"
- "crsp_l ly (as, lm) (s, l, r) ires"
- "(\<lambda>(s, l, r). s = 0)
- (t_steps (Suc 0, l, r)
- (mop_bef n @ tshift mp_up (2 * n), 0) stp)"
- thus "\<exists>stp. (\<lambda>(s, ab). 0 < s \<and> (\<lambda>(s', l', r'). s' = 0)
- (t_step (s, ab) (mop_bef n @ tshift mp_up (2 * n), 0)))
- (t_steps (Suc 0, l, r) (mop_bef n @ tshift mp_up (2 * n), 0) stp)"
- proof(induct stp, simp add: t_steps.simps, simp)
- fix stpa
- assume h1:
- "(\<lambda>(s, l, r). s = 0) (t_steps (Suc 0, l, r)
- (mop_bef n @ tshift mp_up (2 * n), 0) stpa) \<Longrightarrow>
- \<exists>stp. (\<lambda>(s, ab). 0 < s \<and> (\<lambda>(s', l', r'). s' = 0)
- (t_step (s, ab) (mop_bef n @ tshift mp_up (2 * n), 0)))
- (t_steps (Suc 0, l, r)
- (mop_bef n @ tshift mp_up (2 * n), 0) stp)"
- and h2:
- "(\<lambda>(s, l, r). s = 0) (t_steps (Suc 0, l, r)
- (mop_bef n @ tshift mp_up (2 * n), 0) (Suc stpa))"
- "n < length lm"
- "crsp_l ly (as, lm) (s, l, r) ires"
- thus "\<exists>stp. (\<lambda>(s, ab). 0 < s \<and> (\<lambda>(s', l', r'). s' = 0)
- (t_step (s, ab) (mop_bef n @ tshift mp_up (2 * n), 0))) (
- t_steps (Suc 0, l, r)
- (mop_bef n @ tshift mp_up (2 * n), 0) stp)"
- apply(case_tac "(\<lambda>(s, l, r). s = 0) (t_steps (Suc 0, l, r)
- (mop_bef n @ tshift mp_up (2 * n), 0) stpa)",
- simp)
- apply(rule_tac x = "stpa" in exI)
- apply(case_tac "(t_steps (Suc 0, l, r)
- (mop_bef n @ tshift mp_up (2 * n), 0) stpa)",
- simp add: t_steps_ind)
- done
- qed
-qed
-
-lemma tshift_nth_state0: "\<lbrakk>n < length tp; tp ! n = (a, 0)\<rbrakk>
- \<Longrightarrow> tshift tp off ! n = (a, 0)"
-apply(induct n, case_tac tp, simp)
-apply(auto simp: tshift.simps)
-done
-
-lemma shift_length: "length (tshift tp n) = length tp"
-apply(auto simp: tshift.simps)
-done
-
-lemma even_Suc_le: "\<lbrakk>y mod 2 = 0; 2 * x < y\<rbrakk> \<Longrightarrow> Suc (2 * x) < y"
-by arith
-
-lemma [simp]: "(4::nat) * n mod 2 = 0"
-by arith
-
-lemma tm_append_fetch_equal:
- "\<lbrakk>t_ncorrect (tm_of aprog); s'> 0;
- fetch (mop_bef n @ tshift mp_up (2 * n)) s' b = (a, 0)\<rbrakk>
-\<Longrightarrow> fetch (tm_of aprog @ tshift (mop_bef n @ tshift mp_up (2 * n))
- (length (tm_of aprog) div 2)) (s' + length (tm_of aprog) div 2) b
- = (a, 0)"
-apply(case_tac s', simp)
-apply(auto simp: fetch.simps nth_of.simps t_ncorrect.simps shift_length nth_append
- tshift.simps split: list.splits block.splits split: if_splits)
-done
-
-lemma [simp]:
- "\<lbrakk>t_ncorrect (tm_of aprog);
- t_step (s', l', r') (mop_bef n @ tshift mp_up (2 * n), 0) =
- (0, l'', r''); s' > 0\<rbrakk>
- \<Longrightarrow> t_step (s' + length (tm_of aprog) div 2, l', r')
- (tm_of aprog @ tshift (mop_bef n @ tshift mp_up (2 * n))
- (length (tm_of aprog) div 2), 0) = (0, l'', r'')"
-apply(simp add: t_step.simps)
-apply(subgoal_tac
- "(fetch (mop_bef n @ tshift mp_up (2 * n)) s'
- (case r' of [] \<Rightarrow> Bk | Bk # xs \<Rightarrow> Bk | Oc # xs \<Rightarrow> Oc))
- = (fetch (tm_of aprog @ tshift (mop_bef n @ tshift mp_up (2 * n))
- (length (tm_of aprog) div 2)) (s' + length (tm_of aprog) div 2)
- (case r' of [] \<Rightarrow> Bk | Bk # xs \<Rightarrow> Bk | Oc # xs \<Rightarrow> Oc))", simp)
-apply(case_tac "(fetch (mop_bef n @ tshift mp_up (2 * n)) s'
- (case r' of [] \<Rightarrow> Bk | Bk # xs \<Rightarrow> Bk | Oc # xs \<Rightarrow> Oc))", simp)
-apply(drule_tac tm_append_fetch_equal, auto)
-done
-
-lemma [intro]:
- "start_of (layout_of aprog) (length aprog) - Suc 0 =
- length (tm_of aprog) div 2"
-apply(subgoal_tac "abc2t_correct aprog")
-apply(insert pre_lheq[of "concat (take (length aprog)
- (tms_of aprog))" "length aprog" aprog], simp add: tm_of.simps)
-by auto
-
-lemma tm_append_stop_step:
- "\<lbrakk>t_ncorrect (tm_of aprog);
- t_ncorrect (mop_bef n @ tshift mp_up (2 * n)); n < length lm;
- (t_steps (Suc 0, l, r) (mop_bef n @ tshift mp_up (2 * n), 0) stp) =
- (s', l', r');
- s' \<noteq> 0;
- t_step (s', l', r') (mop_bef n @ tshift mp_up (2 * n), 0)
- = (0, l'', r'')\<rbrakk>
- \<Longrightarrow>
-(t_steps ((start_of (layout_of aprog) (length aprog), l, r))
- (tm_of aprog @ tshift (mop_bef n @ tshift mp_up (2 * n))
- (start_of (layout_of aprog) (length aprog) - Suc 0), 0) (Suc stp))
- = (0, l'', r'')"
-apply(insert tm_append_steps_equal[of "tm_of aprog"
- "(mop_bef n @ tshift mp_up (2 * n))"
- "(start_of (layout_of aprog) (length aprog) - Suc 0)"
- "Suc 0" l r stp], simp)
-apply(subgoal_tac "(start_of (layout_of aprog) (length aprog) - Suc 0)
- = (length (tm_of aprog) div 2)", simp add: t_steps_ind)
-apply(case_tac
- "(t_steps (start_of (layout_of aprog) (length aprog), l, r)
- (tm_of aprog @ tshift (mop_bef n @ tshift mp_up (2 * n))
- (length (tm_of aprog) div 2), 0) stp)", simp)
-apply(subgoal_tac "start_of (layout_of aprog) (length aprog) > 0",
- case_tac "start_of (layout_of aprog) (length aprog)",
- simp, simp)
-apply(rule startof_not0, auto)
-done
-
-lemma start_of_out_range:
-"as \<ge> length aprog \<Longrightarrow>
- start_of (layout_of aprog) as =
- start_of (layout_of aprog) (length aprog)"
-apply(induct as, simp)
-apply(case_tac "length aprog = Suc as", simp)
-apply(simp add: start_of.simps)
-done
-
-lemma [intro]: "t_ncorrect (tm_of aprog)"
-apply(simp add: tm_of.simps)
-apply(insert tms_mod2[of "length aprog" aprog],
- simp add: t_ncorrect.simps)
-done
-
-lemma abacus_turing_eq_halt_case_pre:
- "\<lbrakk>ly = layout_of aprog;
- tprog = tm_of aprog;
- crsp_l ly ac tc ires;
- n < length am;
- abc_steps_l ac aprog stp = (as, am);
- mop_ss = start_of ly (length aprog);
- as \<ge> length aprog\<rbrakk>
- \<Longrightarrow> \<exists> stp. (\<lambda> (s, l, r). s = 0 \<and> mopup_inv (0, l, r) am n ires)
- (t_steps tc (tprog @ (tMp n (mop_ss - 1)), 0) stp)"
-apply(insert steps_crsp[of ly aprog tprog ac tc ires "(as, am)" stp], auto)
-apply(case_tac "(t_steps tc (tm_of aprog, 0) n')",
- simp add: tMp.simps)
-apply(subgoal_tac "t_ncorrect (mop_bef n @ tshift mp_up (2 * n))")
-proof -
- fix n' a b c
- assume h1:
- "crsp_l (layout_of aprog) ac tc ires"
- "abc_steps_l ac aprog stp = (as, am)"
- "length aprog \<le> as"
- "crsp_l (layout_of aprog) (as, am) (a, b, c) ires"
- "t_steps tc (tm_of aprog, 0) n' = (a, b, c)"
- "n < length am"
- "t_ncorrect (mop_bef n @ tshift mp_up (2 * n))"
- hence h2:
- "t_steps tc (tm_of aprog @ tshift (mop_bef n @ tshift mp_up (2 * n))
- (start_of (layout_of aprog) (length aprog) - Suc 0), 0) n'
- = (a, b, c)"
- apply(rule_tac tm_append_steps, simp)
- apply(simp add: crsp_l.simps, auto)
- apply(simp add: crsp_l.simps)
- apply(rule startof_not0)
- done
- from h1 have h3:
- "\<exists>stp. (\<lambda>(s, l, r). s \<noteq> 0 \<and> ((\<lambda> (s', l', r'). s' = 0)
- (t_step (s, l, r) (mop_bef n @ tshift mp_up (2 * n), 0))))
- (t_steps (Suc 0, b, c)
- (mop_bef n @ tshift mp_up (2 * n), 0) stp)"
- apply(rule_tac mopup_halt_bef, auto)
- done
- from h1 and h2 and h3 show
- "\<exists>stp. case t_steps tc (tm_of aprog @ abacus.tshift (mop_bef n @ abacus.tshift mp_up (2 * n))
- (start_of (layout_of aprog) (length aprog) - Suc 0), 0) stp of (s, ab)
- \<Rightarrow> s = 0 \<and> mopup_inv (0, ab) am n ires"
- proof(erule_tac exE,
- case_tac "(t_steps (Suc 0, b, c)
- (mop_bef n @ tshift mp_up (2 * n), 0) stpa)", simp,
- case_tac "(t_step (aa, ba, ca)
- (mop_bef n @ tshift mp_up (2 * n), 0))", simp)
- fix stpa aa ba ca aaa baa caa
- assume g1: "0 < aa \<and> aaa = 0"
- "t_steps (Suc 0, b, c)
- (mop_bef n @ tshift mp_up (2 * n), 0) stpa = (aa, ba,ca)"
- "t_step (aa, ba, ca) (mop_bef n @ tshift mp_up (2 * n), 0)
- = (0, baa, caa)"
- from h1 and this have g2:
- "t_steps (start_of (layout_of aprog) (length aprog), b, c)
- (tm_of aprog @ tshift (mop_bef n @ tshift mp_up (2 * n))
- (start_of (layout_of aprog) (length aprog) - Suc 0), 0)
- (Suc stpa) = (0, baa, caa)"
- apply(rule_tac tm_append_stop_step, auto)
- done
- from h1 and h2 and g1 and this show "?thesis"
- apply(rule_tac x = "n' + Suc stpa" in exI)
- apply(simp add: t_steps_ind del: t_steps.simps)
- apply(subgoal_tac "a = start_of (layout_of aprog)
- (length aprog)", simp)
- apply(insert mopup_inv_steps[of n am "Suc 0" b c ires "Suc stpa"],
- simp add: t_steps_ind)
- apply(subgoal_tac "mopup_inv (Suc 0, b, c) am n ires", simp)
- apply(rule_tac mopup_init, simp, simp)
- apply(simp add: crsp_l.simps)
- apply(erule_tac start_of_out_range)
- done
- qed
-next
- show " t_ncorrect (mop_bef n @ tshift mp_up (2 * n))"
- apply(auto simp: t_ncorrect.simps tshift.simps mp_up_def)
- done
-qed
-
-text {*
- One of the main theorems about Abacus compilation.
-*}
-
-lemma abacus_turing_eq_halt_case:
- assumes layout:
- -- {* There is an Abacus program @{text "aprog"} with layout @{text "ly"}: *}
- "ly = layout_of aprog"
- and complied:
- -- {* The TM compiled from @{text "aprog"} is @{text "tprog"}: *}
- "tprog = tm_of aprog"
- and correspond:
- -- {* TM configuration @{text "tc"} and Abacus configuration @{text "ac"}
- are in correspondence: *}
- "crsp_l ly ac tc ires"
- and halt_state:
- -- {* @{text "as"} is a program label outside the range of @{text "aprog"}. So
- if Abacus is in such a state, it is in halt state: *}
- "as \<ge> length aprog"
- and abc_exec:
- -- {* Supposing after @{text "stp"} step of execution, Abacus program @{text "aprog"}
- reaches such a halt state: *}
- "abc_steps_l ac aprog stp = (as, am)"
- and rs_len:
- -- {* @{text "n"} is a memory address in the range of Abacus memory @{text "am"}: *}
- "n < length am"
- and mopup_start:
- -- {* The startling label for mopup mahines, according to the layout and Abacus program
- should be @{text "mop_ss"}: *}
- "mop_ss = start_of ly (length aprog)"
- shows
- -- {*
- After @{text "stp"} steps of execution of the TM composed of @{text "tprog"} and the mopup
- TM @{text "(tMp n (mop_ss - 1))"} will halt and gives rise to a configuration which
- only hold the content of memory cell @{text "n"}:
- *}
- "\<exists> stp. (\<lambda> (s, l, r). \<exists> ln rn. s = 0 \<and> l = Bk\<^bsup>ln\<^esup> @ Bk # Bk # ires
- \<and> r = Oc\<^bsup>Suc (abc_lm_v am n)\<^esup> @ Bk\<^bsup>rn\<^esup>)
- (t_steps tc (tprog @ (tMp n (mop_ss - 1)), 0) stp)"
-proof -
- from layout complied correspond halt_state abc_exec rs_len mopup_start
- and abacus_turing_eq_halt_case_pre [of ly aprog tprog ac tc ires n am stp as mop_ss]
- show "?thesis"
- apply(simp add: mopup_inv.simps mopup_stop.simps tape_of_nat_abv)
- done
-qed
-
-lemma abc_unhalt_case_zero:
-"\<lbrakk>crsp_l (layout_of aprog) ac tc ires;
- n < length am;
- \<forall>stp. (\<lambda>(as, am). as < length aprog) (abc_steps_l ac aprog stp)\<rbrakk>
- \<Longrightarrow> \<exists>astp bstp. 0 \<le> bstp \<and>
- crsp_l (layout_of aprog) (abc_steps_l ac aprog astp)
- (t_steps tc (tm_of aprog, 0) bstp) ires"
-apply(rule_tac x = "Suc 0" in exI)
-apply(case_tac " abc_steps_l ac aprog (Suc 0)", simp)
-proof -
- fix a b
- assume "crsp_l (layout_of aprog) ac tc ires"
- "abc_steps_l ac aprog (Suc 0) = (a, b)"
- thus "\<exists>bstp. crsp_l (layout_of aprog) (a, b)
- (t_steps tc (tm_of aprog, 0) bstp) ires"
- apply(insert steps_crsp[of "layout_of aprog" aprog
- "tm_of aprog" ac tc ires "(a, b)" "Suc 0"], auto)
- done
-qed
-
-declare abc_steps_l.simps[simp del]
-
-lemma abc_steps_ind:
- "let (as, am) = abc_steps_l ac aprog stp in
- abc_steps_l ac aprog (Suc stp) =
- abc_step_l (as, am) (abc_fetch as aprog) "
-proof(simp)
- show "(\<lambda>(as, am). abc_steps_l ac aprog (Suc stp) =
- abc_step_l (as, am) (abc_fetch as aprog))
- (abc_steps_l ac aprog stp)"
- proof(induct stp arbitrary: ac)
- fix ac
- show "(\<lambda>(as, am). abc_steps_l ac aprog (Suc 0) =
- abc_step_l (as, am) (abc_fetch as aprog))
- (abc_steps_l ac aprog 0)"
- apply(case_tac "ac:: nat \<times> nat list",
- simp add: abc_steps_l.simps)
- apply(case_tac "(abc_step_l (a, b) (abc_fetch a aprog))",
- simp add: abc_steps_l.simps)
- done
- next
- fix stp ac
- assume h1:
- "(\<And>ac. (\<lambda>(as, am). abc_steps_l ac aprog (Suc stp) =
- abc_step_l (as, am) (abc_fetch as aprog))
- (abc_steps_l ac aprog stp))"
- thus
- "(\<lambda>(as, am). abc_steps_l ac aprog (Suc (Suc stp)) =
- abc_step_l (as, am) (abc_fetch as aprog))
- (abc_steps_l ac aprog (Suc stp))"
- apply(case_tac "ac::nat \<times> nat list", simp)
- apply(subgoal_tac
- "abc_steps_l (a, b) aprog (Suc (Suc stp)) =
- abc_steps_l (abc_step_l (a, b) (abc_fetch a aprog))
- aprog (Suc stp)", simp)
- apply(case_tac "(abc_step_l (a, b) (abc_fetch a aprog))", simp)
- proof -
- fix a b aa ba
- assume h2: "abc_step_l (a, b) (abc_fetch a aprog) = (aa, ba)"
- from h1 and h2 show
- "(\<lambda>(as, am). abc_steps_l (aa, ba) aprog (Suc stp) =
- abc_step_l (as, am) (abc_fetch as aprog))
- (abc_steps_l (a, b) aprog (Suc stp))"
- apply(insert h1[of "(aa, ba)"])
- apply(simp add: abc_steps_l.simps)
- apply(insert h2, simp)
- done
- next
- fix a b
- show
- "abc_steps_l (a, b) aprog (Suc (Suc stp)) =
- abc_steps_l (abc_step_l (a, b) (abc_fetch a aprog))
- aprog (Suc stp)"
- apply(simp only: abc_steps_l.simps)
- done
- qed
- qed
-qed
-
-lemma abc_unhalt_case_induct:
- "\<lbrakk>crsp_l (layout_of aprog) ac tc ires;
- n < length am;
- \<forall>stp. (\<lambda>(as, am). as < length aprog) (abc_steps_l ac aprog stp);
- stp \<le> bstp;
- crsp_l (layout_of aprog) (abc_steps_l ac aprog astp)
- (t_steps tc (tm_of aprog, 0) bstp) ires\<rbrakk>
- \<Longrightarrow> \<exists>astp bstp. Suc stp \<le> bstp \<and> crsp_l (layout_of aprog)
- (abc_steps_l ac aprog astp) (t_steps tc (tm_of aprog, 0) bstp) ires"
-apply(rule_tac x = "Suc astp" in exI)
-apply(case_tac "abc_steps_l ac aprog astp")
-proof -
- fix a b
- assume
- "\<forall>stp. (\<lambda>(as, am). as < length aprog)
- (abc_steps_l ac aprog stp)"
- "stp \<le> bstp"
- "crsp_l (layout_of aprog) (abc_steps_l ac aprog astp)
- (t_steps tc (tm_of aprog, 0) bstp) ires"
- "abc_steps_l ac aprog astp = (a, b)"
- thus
- "\<exists>bstp\<ge>Suc stp. crsp_l (layout_of aprog)
- (abc_steps_l ac aprog (Suc astp))
- (t_steps tc (tm_of aprog, 0) bstp) ires"
- apply(insert crsp_inside[of "layout_of aprog" aprog
- "tm_of aprog" a b "(t_steps tc (tm_of aprog, 0) bstp)" "ires"], auto)
- apply(erule_tac x = astp in allE, auto)
- apply(rule_tac x = "bstp + stpa" in exI, simp)
- apply(insert abc_steps_ind[of ac aprog "astp"], simp)
- done
-qed
-
-lemma abc_unhalt_case:
- "\<lbrakk>crsp_l (layout_of aprog) ac tc ires;
- \<forall>stp. (\<lambda>(as, am). as < length aprog) (abc_steps_l ac aprog stp)\<rbrakk>
- \<Longrightarrow> (\<exists> astp bstp. bstp \<ge> stp \<and>
- crsp_l (layout_of aprog) (abc_steps_l ac aprog astp)
- (t_steps tc (tm_of aprog, 0) bstp) ires)"
-apply(induct stp)
-apply(rule_tac abc_unhalt_case_zero, auto)
-apply(rule_tac abc_unhalt_case_induct, auto)
-done
-
-lemma abacus_turing_eq_unhalt_case_pre:
- "\<lbrakk>ly = layout_of aprog;
- tprog = tm_of aprog;
- crsp_l ly ac tc ires;
- \<forall> stp. ((\<lambda> (as, am). as < length aprog)
- (abc_steps_l ac aprog stp));
- mop_ss = start_of ly (length aprog)\<rbrakk>
- \<Longrightarrow> (\<not> (\<exists> stp. (\<lambda> (s, l, r). s = 0)
- (t_steps tc (tprog @ (tMp n (mop_ss - 1)), 0) stp)))"
- apply(auto)
-proof -
- fix stp a b
- assume h1:
- "crsp_l (layout_of aprog) ac tc ires"
- "\<forall>stp. (\<lambda>(as, am). as < length aprog) (abc_steps_l ac aprog stp)"
- "t_steps tc (tm_of aprog @ tMp n (start_of (layout_of aprog)
- (length aprog) - Suc 0), 0) stp = (0, a, b)"
- thus "False"
- proof(insert abc_unhalt_case[of aprog ac tc ires stp], auto,
- case_tac "(abc_steps_l ac aprog astp)",
- case_tac "(t_steps tc (tm_of aprog, 0) bstp)", simp)
- fix astp bstp aa ba aaa baa c
- assume h2:
- "abc_steps_l ac aprog astp = (aa, ba)" "stp \<le> bstp"
- "t_steps tc (tm_of aprog, 0) bstp = (aaa, baa, c)"
- "crsp_l (layout_of aprog) (aa, ba) (aaa, baa, c) ires"
- hence h3:
- "t_steps tc (tm_of aprog @ tMp n
- (start_of (layout_of aprog) (length aprog) - Suc 0), 0) bstp
- = (aaa, baa, c)"
- apply(intro tm_append_steps, auto)
- apply(simp add: crsp_l.simps, rule startof_not0)
- done
- from h2 have h4: "\<exists> diff. bstp = stp + diff"
- apply(rule_tac x = "bstp - stp" in exI, simp)
- done
- from h4 and h3 and h2 and h1 show "?thesis"
- apply(auto)
- apply(simp add: state0_ind crsp_l.simps)
- apply(subgoal_tac "start_of (layout_of aprog) aa > 0", simp)
- apply(rule startof_not0)
- done
- qed
-qed
-
-lemma abacus_turing_eq_unhalt_case:
- assumes layout:
- -- {* There is an Abacus program @{text "aprog"} with layout @{text "ly"}: *}
- "ly = layout_of aprog"
- and compiled:
- -- {* The TM compiled from @{text "aprog"} is @{text "tprog"}: *}
- "tprog = tm_of aprog"
- and correspond:
- -- {*
- TM configuration @{text "tc"} and Abacus configuration @{text "ac"}
- are in correspondence:
- *}
- "crsp_l ly ac tc ires"
- and abc_unhalt:
- -- {*
- If, no matter how many steps the Abacus program @{text "aprog"} executes, it
- may never reach a halt state.
- *}
- "\<forall> stp. ((\<lambda> (as, am). as < length aprog)
- (abc_steps_l ac aprog stp))"
- and mopup_start: "mop_ss = start_of ly (length aprog)"
- shows
- -- {*
- The the TM composed of TM @{text "tprog"} and the moupup TM may never reach a halt state as well.
- *}
- "\<not> (\<exists> stp. (\<lambda> (s, l, r). s = 0)
- (t_steps tc (tprog @ (tMp n (mop_ss - 1)), 0) stp))"
- using layout compiled correspond abc_unhalt mopup_start
- apply(rule_tac abacus_turing_eq_unhalt_case_pre, auto)
- done
-
-
-definition abc_list_crsp:: "nat list \<Rightarrow> nat list \<Rightarrow> bool"
- where
- "abc_list_crsp xs ys = (\<exists> n. xs = ys @ 0\<^bsup>n\<^esup> \<or> ys = xs @ 0\<^bsup>n\<^esup>)"
-lemma [intro]: "abc_list_crsp (lm @ 0\<^bsup>m\<^esup>) lm"
-apply(auto simp: abc_list_crsp_def)
-done
-
-lemma abc_list_crsp_lm_v:
- "abc_list_crsp lma lmb \<Longrightarrow> abc_lm_v lma n = abc_lm_v lmb n"
-apply(auto simp: abc_list_crsp_def abc_lm_v.simps
- nth_append exponent_def)
-done
-
-lemma rep_app_cons_iff:
- "k < n \<Longrightarrow> replicate n a[k:=b] =
- replicate k a @ b # replicate (n - k - 1) a"
-apply(induct n arbitrary: k, simp)
-apply(simp split:nat.splits)
-done
-
-lemma abc_list_crsp_lm_s:
- "abc_list_crsp lma lmb \<Longrightarrow>
- abc_list_crsp (abc_lm_s lma m n) (abc_lm_s lmb m n)"
-apply(auto simp: abc_list_crsp_def abc_lm_v.simps abc_lm_s.simps)
-apply(simp_all add: list_update_append, auto simp: exponent_def)
-proof -
- fix na
- assume h: "m < length lmb + na" " \<not> m < length lmb"
- hence "m - length lmb < na" by simp
- hence "replicate na 0[(m- length lmb):= n] =
- replicate (m - length lmb) 0 @ n #
- replicate (na - (m - length lmb) - 1) 0"
- apply(erule_tac rep_app_cons_iff)
- done
- thus "\<exists>nb. replicate na 0[m - length lmb := n] =
- replicate (m - length lmb) 0 @ n # replicate nb 0 \<or>
- replicate (m - length lmb) 0 @ [n] =
- replicate na 0[m - length lmb := n] @ replicate nb 0"
- apply(auto)
- done
-next
- fix na
- assume h: "\<not> m < length lmb + na"
- show
- "\<exists>nb. replicate na 0 @ replicate (m - (length lmb + na)) 0 @ [n] =
- replicate (m - length lmb) 0 @ n # replicate nb 0 \<or>
- replicate (m - length lmb) 0 @ [n] =
- replicate na 0 @
- replicate (m - (length lmb + na)) 0 @ n # replicate nb 0"
- apply(rule_tac x = 0 in exI, simp, auto)
- using h
- apply(simp add: replicate_add[THEN sym])
- done
-next
- fix na
- assume h: "\<not> m < length lma" "m < length lma + na"
- hence "m - length lma < na" by simp
- hence
- "replicate na 0[(m- length lma):= n] = replicate (m - length lma)
- 0 @ n # replicate (na - (m - length lma) - 1) 0"
- apply(erule_tac rep_app_cons_iff)
- done
- thus "\<exists>nb. replicate (m - length lma) 0 @ [n] =
- replicate na 0[m - length lma := n] @ replicate nb 0
- \<or> replicate na 0[m - length lma := n] =
- replicate (m - length lma) 0 @ n # replicate nb 0"
- apply(auto)
- done
-next
- fix na
- assume "\<not> m < length lma + na"
- thus " \<exists>nb. replicate (m - length lma) 0 @ [n] =
- replicate na 0 @
- replicate (m - (length lma + na)) 0 @ n # replicate nb 0
- \<or> replicate na 0 @
- replicate (m - (length lma + na)) 0 @ [n] =
- replicate (m - length lma) 0 @ n # replicate nb 0"
- apply(rule_tac x = 0 in exI, simp, auto)
- apply(simp add: replicate_add[THEN sym])
- done
-qed
-
-lemma abc_list_crsp_step:
- "\<lbrakk>abc_list_crsp lma lmb; abc_step_l (aa, lma) i = (a, lma');
- abc_step_l (aa, lmb) i = (a', lmb')\<rbrakk>
- \<Longrightarrow> a' = a \<and> abc_list_crsp lma' lmb'"
-apply(case_tac i, auto simp: abc_step_l.simps
- abc_list_crsp_lm_s abc_list_crsp_lm_v Let_def
- split: abc_inst.splits if_splits)
-done
-
-lemma abc_steps_red:
- "abc_steps_l ac aprog stp = (as, am) \<Longrightarrow>
- abc_steps_l ac aprog (Suc stp) =
- abc_step_l (as, am) (abc_fetch as aprog)"
-using abc_steps_ind[of ac aprog stp]
-apply(simp)
-done
-
-lemma abc_list_crsp_steps:
- "\<lbrakk>abc_steps_l (0, lm @ 0\<^bsup>m\<^esup>) aprog stp = (a, lm'); aprog \<noteq> []\<rbrakk>
- \<Longrightarrow> \<exists> lma. abc_steps_l (0, lm) aprog stp = (a, lma) \<and>
- abc_list_crsp lm' lma"
-apply(induct stp arbitrary: a lm', simp add: abc_steps_l.simps, auto)
-apply(case_tac "abc_steps_l (0, lm @ 0\<^bsup>m\<^esup>) aprog stp",
- simp add: abc_steps_ind)
-proof -
- fix stp a lm' aa b
- assume ind:
- "\<And>a lm'. aa = a \<and> b = lm' \<Longrightarrow>
- \<exists>lma. abc_steps_l (0, lm) aprog stp = (a, lma) \<and>
- abc_list_crsp lm' lma"
- and h: "abc_steps_l (0, lm @ 0\<^bsup>m\<^esup>) aprog (Suc stp) = (a, lm')"
- "abc_steps_l (0, lm @ 0\<^bsup>m\<^esup>) aprog stp = (aa, b)"
- "aprog \<noteq> []"
- hence g1: "abc_steps_l (0, lm @ 0\<^bsup>m\<^esup>) aprog (Suc stp)
- = abc_step_l (aa, b) (abc_fetch aa aprog)"
- apply(rule_tac abc_steps_red, simp)
- done
- have "\<exists>lma. abc_steps_l (0, lm) aprog stp = (aa, lma) \<and>
- abc_list_crsp b lma"
- apply(rule_tac ind, simp)
- done
- from this obtain lma where g2:
- "abc_steps_l (0, lm) aprog stp = (aa, lma) \<and>
- abc_list_crsp b lma" ..
- hence g3: "abc_steps_l (0, lm) aprog (Suc stp)
- = abc_step_l (aa, lma) (abc_fetch aa aprog)"
- apply(rule_tac abc_steps_red, simp)
- done
- show "\<exists>lma. abc_steps_l (0, lm) aprog (Suc stp) = (a, lma) \<and>
- abc_list_crsp lm' lma"
- using g1 g2 g3 h
- apply(auto)
- apply(case_tac "abc_step_l (aa, b) (abc_fetch aa aprog)",
- case_tac "abc_step_l (aa, lma) (abc_fetch aa aprog)", simp)
- apply(rule_tac abc_list_crsp_step, auto)
- done
-qed
-
-lemma [simp]: "(case ca of [] \<Rightarrow> Bk | Bk # xs \<Rightarrow> Bk | Oc # xs \<Rightarrow> Oc) =
- (case ca of [] \<Rightarrow> Bk | x # xs \<Rightarrow> x)"
-by(case_tac ca, simp_all, case_tac a, simp, simp)
-
-lemma steps_eq: "length t mod 2 = 0 \<Longrightarrow>
- t_steps c (t, 0) stp = steps c t stp"
-apply(induct stp)
-apply(simp add: steps.simps t_steps.simps)
-apply(simp add:tstep_red t_steps_ind)
-apply(case_tac "steps c t stp", simp)
-apply(auto simp: t_step.simps tstep.simps)
-done
-
-lemma crsp_l_start: "crsp_l ly (0, lm) (Suc 0, Bk # Bk # ires, <lm> @ Bk\<^bsup>rn\<^esup>) ires"
-apply(simp add: crsp_l.simps, auto simp: start_of.simps)
-done
-
-lemma t_ncorrect_app: "\<lbrakk>t_ncorrect t1; t_ncorrect t2\<rbrakk> \<Longrightarrow>
- t_ncorrect (t1 @ t2)"
-apply(simp add: t_ncorrect.simps, auto)
-done
-
-lemma [simp]:
- "(length (tm_of aprog) +
- length (tMp n (start_of ly (length aprog) - Suc 0))) mod 2 = 0"
-apply(subgoal_tac
- "t_ncorrect (tm_of aprog @ tMp n
- (start_of ly (length aprog) - Suc 0))")
-apply(simp add: t_ncorrect.simps)
-apply(rule_tac t_ncorrect_app,
- auto simp: tMp.simps t_ncorrect.simps tshift.simps mp_up_def)
-apply(subgoal_tac
- "t_ncorrect (tm_of aprog)", simp add: t_ncorrect.simps)
-apply(auto)
-done
-
-lemma [simp]: "takeWhile (\<lambda>a. a = Oc)
- (replicate rs Oc @ replicate rn Bk) = replicate rs Oc"
-apply(induct rs, auto)
-apply(induct rn, auto)
-done
-
-lemma abacus_turing_eq_halt':
- "\<lbrakk>ly = layout_of aprog;
- tprog = tm_of aprog;
- n < length am;
- abc_steps_l (0, lm) aprog stp = (as, am);
- mop_ss = start_of ly (length aprog);
- as \<ge> length aprog\<rbrakk>
- \<Longrightarrow> \<exists> stp m l. steps (Suc 0, Bk # Bk # ires, <lm> @ Bk\<^bsup>rn\<^esup>)
- (tprog @ (tMp n (mop_ss - 1))) stp
- = (0, Bk\<^bsup>m\<^esup> @ Bk # Bk # ires, Oc\<^bsup>Suc (abc_lm_v am n)\<^esup> @ Bk\<^bsup>l\<^esup>)"
-apply(drule_tac tc = "(Suc 0, Bk # Bk # ires, <lm> @ Bk\<^bsup>rn\<^esup>)" in
- abacus_turing_eq_halt_case, auto intro: crsp_l_start)
-apply(subgoal_tac
- "length (tm_of aprog @ tMp n
- (start_of ly (length aprog) - Suc 0)) mod 2 = 0")
-apply(simp add: steps_eq)
-apply(rule_tac x = stpa in exI,
- simp add: exponent_def, auto)
-done
-
-
-lemma list_length: "xs = ys \<Longrightarrow> length xs = length ys"
-by simp
-lemma [elim]: "tinres (Bk\<^bsup>m\<^esup>) b \<Longrightarrow> \<exists>m. b = Bk\<^bsup>m\<^esup>"
-apply(auto simp: tinres_def)
-apply(rule_tac x = "m-n" in exI,
- auto simp: exponent_def replicate_add[THEN sym])
-apply(case_tac "m < n", auto)
-apply(drule_tac list_length, auto)
-apply(subgoal_tac "\<exists> d. m = d + n", auto simp: replicate_add)
-apply(rule_tac x = "m - n" in exI, simp)
-done
-lemma [intro]: "tinres [Bk] (Bk\<^bsup>k\<^esup>) "
-apply(auto simp: tinres_def exponent_def)
-apply(case_tac k, auto)
-apply(rule_tac x = "Suc 0" in exI, simp)
-done
-
-lemma abacus_turing_eq_halt_pre:
- "\<lbrakk>ly = layout_of aprog;
- tprog = tm_of aprog;
- n < length am;
- abc_steps_l (0, lm) aprog stp = (as, am);
- mop_ss = start_of ly (length aprog);
- as \<ge> length aprog\<rbrakk>
- \<Longrightarrow> \<exists> stp m l. steps (Suc 0, Bk # Bk # ires, <lm> @ Bk\<^bsup>rn\<^esup>)
- (tprog @ (tMp n (mop_ss - 1))) stp
- = (0, Bk\<^bsup>m\<^esup> @ Bk # Bk # ires, Oc\<^bsup>Suc (abc_lm_v am n)\<^esup> @ Bk\<^bsup>l\<^esup>)"
-using abacus_turing_eq_halt'
-apply(simp)
-done
-
-
-text {*
- Main theorem for the case when the original Abacus program does halt.
-*}
-
-lemma abacus_turing_eq_halt:
- assumes layout:
- "ly = layout_of aprog"
- -- {* There is an Abacus program @{text "aprog"} with layout @{text "ly"}: *}
- and compiled: "tprog = tm_of aprog"
- -- {* The TM compiled from @{text "aprog"} is @{text "tprog"}: *}
- and halt_state:
- -- {* @{text "as"} is a program label outside the range of @{text "aprog"}. So
- if Abacus is in such a state, it is in halt state: *}
- "as \<ge> length aprog"
- and abc_exec:
- -- {* Supposing after @{text "stp"} step of execution, Abacus program @{text "aprog"}
- reaches such a halt state: *}
- "abc_steps_l (0, lm) aprog stp = (as, am)"
- and rs_locate:
- -- {* @{text "n"} is a memory address in the range of Abacus memory @{text "am"}: *}
- "n < length am"
- and mopup_start:
- -- {* The startling label for mopup mahines, according to the layout and Abacus program
- should be @{text "mop_ss"}: *}
- "mop_ss = start_of ly (length aprog)"
- shows
- -- {*
- After @{text "stp"} steps of execution of the TM composed of @{text "tprog"} and the mopup
- TM @{text "(tMp n (mop_ss - 1))"} will halt and gives rise to a configuration which
- only hold the content of memory cell @{text "n"}:
- *}
- "\<exists> stp m l. steps (Suc 0, Bk # Bk # ires, <lm> @ Bk\<^bsup>rn\<^esup>) (tprog @ (tMp n (mop_ss - 1))) stp
- = (0, Bk\<^bsup>m\<^esup> @ Bk # Bk # ires, Oc\<^bsup>Suc (abc_lm_v am n)\<^esup> @ Bk\<^bsup>l\<^esup>)"
- using layout compiled halt_state abc_exec rs_locate mopup_start
- by(rule_tac abacus_turing_eq_halt_pre, auto)
-
-lemma abacus_turing_eq_uhalt':
- "\<lbrakk>ly = layout_of aprog;
- tprog = tm_of aprog;
- \<forall> stp. ((\<lambda> (as, am). as < length aprog)
- (abc_steps_l (0, lm) aprog stp));
- mop_ss = start_of ly (length aprog)\<rbrakk>
- \<Longrightarrow> (\<not> (\<exists> stp. isS0 (steps (Suc 0, [Bk, Bk], <lm>)
- (tprog @ (tMp n (mop_ss - 1))) stp)))"
-apply(drule_tac tc = "(Suc 0, [Bk, Bk], <lm>)" and n = n and ires = "[]" in
- abacus_turing_eq_unhalt_case, auto intro: crsp_l_start)
-apply(simp add: crsp_l.simps start_of.simps)
-apply(erule_tac x = stp in allE, erule_tac x = stp in allE)
-apply(subgoal_tac
- "length (tm_of aprog @ tMp n
- (start_of ly (length aprog) - Suc 0)) mod 2 = 0")
-apply(simp add: steps_eq, auto simp: isS0_def)
-done
-
-text {*
- Main theorem for the case when the original Abacus program does not halt.
- *}
-lemma abacus_turing_eq_uhalt:
- assumes layout:
- -- {* There is an Abacus program @{text "aprog"} with layout @{text "ly"}: *}
- "ly = layout_of aprog"
- and compiled:
- -- {* The TM compiled from @{text "aprog"} is @{text "tprog"}: *}
- "tprog = tm_of aprog"
- and abc_unhalt:
- -- {*
- If, no matter how many steps the Abacus program @{text "aprog"} executes, it
- may never reach a halt state.
- *}
- "\<forall> stp. ((\<lambda> (as, am). as < length aprog)
- (abc_steps_l (0, lm) aprog stp))"
- and mop_start: "mop_ss = start_of ly (length aprog)"
- shows
- -- {*
- The the TM composed of TM @{text "tprog"} and the moupup TM may never reach a halt state as well.
- *}
- "\<not> (\<exists> stp. isS0 (steps (Suc 0, [Bk, Bk], <lm>)
- (tprog @ (tMp n (mop_ss - 1))) stp))"
- using abacus_turing_eq_uhalt'
- layout compiled abc_unhalt mop_start
- by(auto)
-
-end
-
--- a/utm/document/root.tex Mon Mar 04 21:01:55 2013 +0000
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,83 +0,0 @@
-\documentclass[11pt,a4paper]{article}
-\usepackage{isabelle,isabellesym}
-%begin adding
-%\usepackage{pdfsetup}
-\usepackage{fancyhdr}
-\usepackage{beamerarticle}
-\usepackage[english]{babel}
-%\usepackage{enumitem}
-\usepackage{enumerate}
-\usepackage{cases}
-%\usepackage{CJK,cjknumb}
-%\usepackage{pgf,pgfarrows,pgfnodes,pgfautomata,pgfheaps,pgfshade}
-\usepackage{amsmath,amssymb}
-%\usepackage[latin1]{inputenc}
-%\usepackage{colortbl}
-\usepackage{tikz}
-\usetikzlibrary{arrows,automata,decorations,fit,calc}
-\usetikzlibrary{shapes,shapes.arrows,snakes,positioning}
-\usepgflibrary{shapes.misc} % LATEX and plain TEX and pure pgf
-\usetikzlibrary{matrix}
-\usepackage[latin1]{inputenc}
-\usepackage{verbatim}
-\usepackage{romannum}
-\usepackage{makeidx}
-\usepackage{listings}
-%end adding
-% further packages required for unusual symbols (see also
-% isabellesym.sty), use only when needed
-
-%\usepackage{amssymb}
- %for \<leadsto>, \<box>, \<diamond>, \<sqsupset>, \<mho>, \<Join>,
- %\<lhd>, \<lesssim>, \<greatersim>, \<lessapprox>, \<greaterapprox>,
- %\<triangleq>, \<yen>, \<lozenge>
-
-%\usepackage[greek,english]{babel}
- %option greek for \<euro>
- %option english (default language) for \<guillemotleft>, \<guillemotright>
-
-%\usepackage[only,bigsqcap]{stmaryrd}
- %for \<Sqinter>
-
-%\usepackage{eufrak}
- %for \<AA> ... \<ZZ>, \<aa> ... \<zz> (also included in amssymb)
-
-%\usepackage{textcomp}
- %for \<onequarter>, \<onehalf>, \<threequarters>, \<degree>, \<cent>,
- %\<currency>
-
-% this should be the last package used
-\usepackage{pdfsetup}
-
-% urls in roman style, theory text in math-similar italics
-\urlstyle{rm}
-\isabellestyle{it}
-
-% for uniform font size
-%\renewcommand{\isastyle}{\isastyleminor}
-\newcommand{\wuhao}{\fontsize{6pt}{10pt}\selectfont} % ÎåºÅ, µ¥±¶Ðоà
-
-\begin{document}
-
-\title{utm}
-\author{By xujian}
-\maketitle
-
-\tableofcontents
-
-% sane default for proof documents
-\parindent 0pt\parskip 0.5ex
-
-% generated text of all theories
-\input{session}
-
-% optional bibliography
-%\bibliographystyle{abbrv}
-%\bibliography{root}
-
-\end{document}
-
-%%% Local Variables:
-%%% mode: latex
-%%% TeX-master: t
-%%% End:
--- a/utm/rec_def.thy Mon Mar 04 21:01:55 2013 +0000
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,87 +0,0 @@
-theory rec_def
-imports Main
-begin
-
-section {*
- Recursive functions
-*}
-
-text {*
- Datatype of recursive operators.
-*}
-
-datatype recf =
- -- {* The zero function, which always resturns @{text "0"} as result. *}
- z |
- -- {* The successor function, which increments its arguments. *}
- s |
- -- {*
- The projection function, where @{text "id i j"} returns the @{text "j"}-th
- argment out of the @{text "i"} arguments.
- *}
- id nat nat |
- -- {*
- The compostion operator, where "@{text "Cn n f [g1; g2; \<dots> ;gm]"}
- computes @{text "f (g1(x1, x2, \<dots>, xn), g2(x1, x2, \<dots>, xn), \<dots> ,
- gm(x1, x2, \<dots> , xn))"} for input argments @{text "x1, \<dots>, xn"}.
- *}
- Cn nat recf "recf list" |
--- {*
- The primitive resursive operator, where @{text "Pr n f g"} computes:
- @{text "Pr n f g (x1, x2, \<dots>, xn-1, 0) = f(x1, \<dots>, xn-1)"}
- and @{text "Pr n f g (x1, x2, \<dots>, xn-1, k') = g(x1, x2, \<dots>, xn-1, k,
- Pr n f g (x1, \<dots>, xn-1, k))"}.
- *}
- Pr nat recf recf |
--- {*
- The minimization operator, where @{text "Mn n f (x1, x2, \<dots> , xn)"}
- computes the first i such that @{text "f (x1, \<dots>, xn, i) = 0"} and for all
- @{text "j"}, @{text "f (x1, x2, \<dots>, xn, j) > 0"}.
- *}
- Mn nat recf
-
-text {*
- The semantis of recursive operators is given by an inductively defined
- relation as follows, where
- @{text "rec_calc_rel R [x1, x2, \<dots>, xn] r"} means the computation of
- @{text "R"} over input arguments @{text "[x1, x2, \<dots>, xn"} terminates
- and gives rise to a result @{text "r"}
-*}
-
-inductive rec_calc_rel :: "recf \<Rightarrow> nat list \<Rightarrow> nat \<Rightarrow> bool"
-where
- calc_z: "rec_calc_rel z [n] 0" |
- calc_s: "rec_calc_rel s [n] (Suc n)" |
- calc_id: "\<lbrakk>length args = i; j < i; args!j = r\<rbrakk> \<Longrightarrow> rec_calc_rel (id i j) args r" |
- calc_cn: "\<lbrakk>length args = n;
- \<forall> k < length gs. rec_calc_rel (gs ! k) args (rs ! k);
- length rs = length gs;
- rec_calc_rel f rs r\<rbrakk>
- \<Longrightarrow> rec_calc_rel (Cn n f gs) args r" |
- calc_pr_zero:
- "\<lbrakk>length args = n;
- rec_calc_rel f args r0 \<rbrakk>
- \<Longrightarrow> rec_calc_rel (Pr n f g) (args @ [0]) r0" |
- calc_pr_ind: "
- \<lbrakk> length args = n;
- rec_calc_rel (Pr n f g) (args @ [k]) rk;
- rec_calc_rel g (args @ [k] @ [rk]) rk'\<rbrakk>
- \<Longrightarrow> rec_calc_rel (Pr n f g) (args @ [Suc k]) rk'" |
- calc_mn: "\<lbrakk>length args = n;
- rec_calc_rel f (args@[r]) 0;
- \<forall> i < r. (\<exists> ri. rec_calc_rel f (args@[i]) ri \<and> ri \<noteq> 0)\<rbrakk>
- \<Longrightarrow> rec_calc_rel (Mn n f) args r"
-
-inductive_cases calc_pr_reverse:
- "rec_calc_rel (Pr n f g) (lm) rSucy"
-
-inductive_cases calc_z_reverse: "rec_calc_rel z lm x"
-
-inductive_cases calc_s_reverse: "rec_calc_rel s lm x"
-
-inductive_cases calc_id_reverse: "rec_calc_rel (id m n) lm x"
-
-inductive_cases calc_cn_reverse: "rec_calc_rel (Cn n f gs) lm x"
-
-inductive_cases calc_mn_reverse:"rec_calc_rel (Mn n f) lm x"
-end
\ No newline at end of file
--- a/utm/recursive.thy Mon Mar 04 21:01:55 2013 +0000
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,5024 +0,0 @@
-theory recursive
-imports Main rec_def abacus
-begin
-
-section {*
- Compiling from recursive functions to Abacus machines
- *}
-
-text {*
- Some auxilliary Abacus machines used to construct the result Abacus machines.
-*}
-
-text {*
- @{text "get_paras_num recf"} returns the arity of recursive function @{text "recf"}.
-*}
-fun get_paras_num :: "recf \<Rightarrow> nat"
- where
- "get_paras_num z = 1" |
- "get_paras_num s = 1" |
- "get_paras_num (id m n) = m" |
- "get_paras_num (Cn n f gs) = n" |
- "get_paras_num (Pr n f g) = Suc n" |
- "get_paras_num (Mn n f) = n"
-
-fun addition :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> abc_prog"
- where
- "addition m n p = [Dec m 4, Inc n, Inc p, Goto 0, Dec p 7,
- Inc m, Goto 4]"
-
-fun empty :: "nat \<Rightarrow> nat \<Rightarrow> abc_prog"
- where
- "empty m n = [Dec m 3, Inc n, Goto 0]"
-
-fun abc_inst_shift :: "abc_inst \<Rightarrow> nat \<Rightarrow> abc_inst"
- where
- "abc_inst_shift (Inc m) n = Inc m" |
- "abc_inst_shift (Dec m e) n = Dec m (e + n)" |
- "abc_inst_shift (Goto m) n = Goto (m + n)"
-
-fun abc_shift :: "abc_inst list \<Rightarrow> nat \<Rightarrow> abc_inst list"
- where
- "abc_shift xs n = map (\<lambda> x. abc_inst_shift x n) xs"
-
-fun abc_append :: "abc_inst list \<Rightarrow> abc_inst list \<Rightarrow>
- abc_inst list" (infixl "[+]" 60)
- where
- "abc_append al bl = (let al_len = length al in
- al @ abc_shift bl al_len)"
-
-text {*
- The compilation of @{text "z"}-operator.
-*}
-definition rec_ci_z :: "abc_inst list"
- where
- "rec_ci_z \<equiv> [Goto 1]"
-
-text {*
- The compilation of @{text "s"}-operator.
-*}
-definition rec_ci_s :: "abc_inst list"
- where
- "rec_ci_s \<equiv> (addition 0 1 2 [+] [Inc 1])"
-
-
-text {*
- The compilation of @{text "id i j"}-operator
-*}
-
-fun rec_ci_id :: "nat \<Rightarrow> nat \<Rightarrow> abc_inst list"
- where
- "rec_ci_id i j = addition j i (i + 1)"
-
-
-fun mv_boxes :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> abc_inst list"
- where
- "mv_boxes ab bb 0 = []" |
- "mv_boxes ab bb (Suc n) = mv_boxes ab bb n [+] empty (ab + n)
- (bb + n)"
-
-fun empty_boxes :: "nat \<Rightarrow> abc_inst list"
- where
- "empty_boxes 0 = []" |
- "empty_boxes (Suc n) = empty_boxes n [+] [Dec n 2, Goto 0]"
-
-fun cn_merge_gs ::
- "(abc_inst list \<times> nat \<times> nat) list \<Rightarrow> nat \<Rightarrow> abc_inst list"
- where
- "cn_merge_gs [] p = []" |
- "cn_merge_gs (g # gs) p =
- (let (gprog, gpara, gn) = g in
- gprog [+] empty gpara p [+] cn_merge_gs gs (Suc p))"
-
-
-text {*
- The compiler of recursive functions, where @{text "rec_ci recf"} return
- @{text "(ap, arity, fp)"}, where @{text "ap"} is the Abacus program, @{text "arity"} is the
- arity of the recursive function @{text "recf"},
-@{text "fp"} is the amount of memory which is going to be
- used by @{text "ap"} for its execution.
-*}
-
-function rec_ci :: "recf \<Rightarrow> abc_inst list \<times> nat \<times> nat"
- where
- "rec_ci z = (rec_ci_z, 1, 2)" |
- "rec_ci s = (rec_ci_s, 1, 3)" |
- "rec_ci (id m n) = (rec_ci_id m n, m, m + 2)" |
- "rec_ci (Cn n f gs) =
- (let cied_gs = map (\<lambda> g. rec_ci g) (f # gs) in
- let (fprog, fpara, fn) = hd cied_gs in
- let pstr =
- Max (set (Suc n # fn # (map (\<lambda> (aprog, p, n). n) cied_gs))) in
- let qstr = pstr + Suc (length gs) in
- (cn_merge_gs (tl cied_gs) pstr [+] mv_boxes 0 qstr n [+]
- mv_boxes pstr 0 (length gs) [+] fprog [+]
- empty fpara pstr [+] empty_boxes (length gs) [+]
- empty pstr n [+] mv_boxes qstr 0 n, n, qstr + n))" |
- "rec_ci (Pr n f g) =
- (let (fprog, fpara, fn) = rec_ci f in
- let (gprog, gpara, gn) = rec_ci g in
- let p = Max (set ([n + 3, fn, gn])) in
- let e = length gprog + 7 in
- (empty n p [+] fprog [+] empty n (Suc n) [+]
- (([Dec p e] [+] gprog [+]
- [Inc n, Dec (Suc n) 3, Goto 1]) @
- [Dec (Suc (Suc n)) 0, Inc (Suc n), Goto (length gprog + 4)]),
- Suc n, p + 1))" |
- "rec_ci (Mn n f) =
- (let (fprog, fpara, fn) = rec_ci f in
- let len = length (fprog) in
- (fprog @ [Dec (Suc n) (len + 5), Dec (Suc n) (len + 3),
- Goto (len + 1), Inc n, Goto 0], n, max (Suc n) fn) )"
- by pat_completeness auto
-termination
-proof
-term size
- show "wf (measure size)" by auto
-next
- fix n f gs x
- assume "(x::recf) \<in> set (f # gs)"
- thus "(x, Cn n f gs) \<in> measure size"
- by(induct gs, auto)
-next
- fix n f g
- show "(f, Pr n f g) \<in> measure size" by auto
-next
- fix n f g x xa y xb ya
- show "(g, Pr n f g) \<in> measure size" by auto
-next
- fix n f
- show "(f, Mn n f) \<in> measure size" by auto
-qed
-
-declare rec_ci.simps [simp del] rec_ci_s_def[simp del]
- rec_ci_z_def[simp del] rec_ci_id.simps[simp del]
- mv_boxes.simps[simp del] abc_append.simps[simp del]
- empty.simps[simp del] addition.simps[simp del]
-
-thm rec_calc_rel.induct
-
-declare abc_steps_l.simps[simp del] abc_fetch.simps[simp del]
- abc_step_l.simps[simp del]
-
-lemma abc_steps_add:
- "abc_steps_l (as, lm) ap (m + n) =
- abc_steps_l (abc_steps_l (as, lm) ap m) ap n"
-apply(induct m arbitrary: n as lm, simp add: abc_steps_l.simps)
-proof -
- fix m n as lm
- assume ind:
- "\<And>n as lm. abc_steps_l (as, lm) ap (m + n) =
- abc_steps_l (abc_steps_l (as, lm) ap m) ap n"
- show "abc_steps_l (as, lm) ap (Suc m + n) =
- abc_steps_l (abc_steps_l (as, lm) ap (Suc m)) ap n"
- apply(insert ind[of as lm "Suc n"], simp)
- apply(insert ind[of as lm "Suc 0"], simp add: abc_steps_l.simps)
- apply(case_tac "(abc_steps_l (as, lm) ap m)", simp)
- apply(simp add: abc_steps_l.simps)
- apply(case_tac "abc_step_l (a, b) (abc_fetch a ap)",
- simp add: abc_steps_l.simps)
- done
-qed
-
-(*lemmas: rec_ci and rec_calc_rel*)
-
-lemma rec_calc_inj_case_z:
- "\<lbrakk>rec_calc_rel z l x; rec_calc_rel z l y\<rbrakk> \<Longrightarrow> x = y"
-apply(auto elim: calc_z_reverse)
-done
-
-lemma rec_calc_inj_case_s:
- "\<lbrakk>rec_calc_rel s l x; rec_calc_rel s l y\<rbrakk> \<Longrightarrow> x = y"
-apply(auto elim: calc_s_reverse)
-done
-
-lemma rec_calc_inj_case_id:
- "\<lbrakk>rec_calc_rel (recf.id nat1 nat2) l x;
- rec_calc_rel (recf.id nat1 nat2) l y\<rbrakk> \<Longrightarrow> x = y"
-apply(auto elim: calc_id_reverse)
-done
-
-lemma rec_calc_inj_case_mn:
- assumes ind: "\<And> l x y. \<lbrakk>rec_calc_rel f l x; rec_calc_rel f l y\<rbrakk>
- \<Longrightarrow> x = y"
- and h: "rec_calc_rel (Mn n f) l x" "rec_calc_rel (Mn n f) l y"
- shows "x = y"
- apply(insert h)
- apply(elim calc_mn_reverse)
- apply(case_tac "x > y", simp)
- apply(erule_tac x = "y" in allE, auto)
-proof -
- fix v va
- assume "rec_calc_rel f (l @ [y]) 0"
- "rec_calc_rel f (l @ [y]) v"
- "0 < v"
- thus "False"
- apply(insert ind[of "l @ [y]" 0 v], simp)
- done
-next
- fix v va
- assume
- "rec_calc_rel f (l @ [x]) 0"
- "\<forall>x<y. \<exists>v. rec_calc_rel f (l @ [x]) v \<and> 0 < v" "\<not> y < x"
- thus "x = y"
- apply(erule_tac x = "x" in allE)
- apply(case_tac "x = y", auto)
- apply(drule_tac y = v in ind, simp, simp)
- done
-qed
-
-lemma rec_calc_inj_case_pr:
- assumes f_ind:
- "\<And>l x y. \<lbrakk>rec_calc_rel f l x; rec_calc_rel f l y\<rbrakk> \<Longrightarrow> x = y"
- and g_ind:
- "\<And>x xa y xb ya l xc yb.
- \<lbrakk>x = rec_ci f; (xa, y) = x; (xb, ya) = y;
- rec_calc_rel g l xc; rec_calc_rel g l yb\<rbrakk> \<Longrightarrow> xc = yb"
- and h: "rec_calc_rel (Pr n f g) l x" "rec_calc_rel (Pr n f g) l y"
- shows "x = y"
- apply(case_tac "rec_ci f")
-proof -
- fix a b c
- assume "rec_ci f = (a, b, c)"
- hence ng_ind:
- "\<And> l xc yb. \<lbrakk>rec_calc_rel g l xc; rec_calc_rel g l yb\<rbrakk>
- \<Longrightarrow> xc = yb"
- apply(insert g_ind[of "(a, b, c)" "a" "(b, c)" b c], simp)
- done
- from h show "x = y"
- apply(erule_tac calc_pr_reverse, erule_tac calc_pr_reverse)
- apply(erule f_ind, simp, simp)
- apply(erule_tac calc_pr_reverse, simp, simp)
- proof -
- fix la ya ry laa yaa rya
- assume k1: "rec_calc_rel g (la @ [ya, ry]) x"
- "rec_calc_rel g (la @ [ya, rya]) y"
- and k2: "rec_calc_rel (Pr (length la) f g) (la @ [ya]) ry"
- "rec_calc_rel (Pr (length la) f g) (la @ [ya]) rya"
- from k2 have "ry = rya"
- apply(induct ya arbitrary: ry rya)
- apply(erule_tac calc_pr_reverse,
- erule_tac calc_pr_reverse, simp)
- apply(erule f_ind, simp, simp, simp)
- apply(erule_tac calc_pr_reverse, simp)
- apply(erule_tac rSucy = rya in calc_pr_reverse, simp, simp)
- proof -
- fix ya ry rya l y ryb laa yb ryc
- assume ind:
- "\<And>ry rya. \<lbrakk>rec_calc_rel (Pr (length l) f g) (l @ [y]) ry;
- rec_calc_rel (Pr (length l) f g) (l @ [y]) rya\<rbrakk> \<Longrightarrow> ry = rya"
- and j: "rec_calc_rel (Pr (length l) f g) (l @ [y]) ryb"
- "rec_calc_rel g (l @ [y, ryb]) ry"
- "rec_calc_rel (Pr (length l) f g) (l @ [y]) ryc"
- "rec_calc_rel g (l @ [y, ryc]) rya"
- from j show "ry = rya"
- apply(insert ind[of ryb ryc], simp)
- apply(insert ng_ind[of "l @ [y, ryc]" ry rya], simp)
- done
- qed
- from k1 and this show "x = y"
- apply(simp)
- apply(insert ng_ind[of "la @ [ya, rya]" x y], simp)
- done
- qed
-qed
-
-lemma Suc_nth_part_eq:
- "\<forall>k<Suc (length list). (a # xs) ! k = (aa # list) ! k
- \<Longrightarrow> \<forall>k<(length list). (xs) ! k = (list) ! k"
-apply(rule allI, rule impI)
-apply(erule_tac x = "Suc k" in allE, simp)
-done
-
-
-lemma list_eq_intro:
- "\<lbrakk>length xs = length ys; \<forall> k < length xs. xs ! k = ys ! k\<rbrakk>
- \<Longrightarrow> xs = ys"
-apply(induct xs arbitrary: ys, simp)
-apply(case_tac ys, simp, simp)
-proof -
- fix a xs ys aa list
- assume ind:
- "\<And>ys. \<lbrakk>length list = length ys; \<forall>k<length ys. xs ! k = ys ! k\<rbrakk>
- \<Longrightarrow> xs = ys"
- and h: "length xs = length list"
- "\<forall>k<Suc (length list). (a # xs) ! k = (aa # list) ! k"
- from h show "a = aa \<and> xs = list"
- apply(insert ind[of list], simp)
- apply(frule Suc_nth_part_eq, simp)
- apply(erule_tac x = "0" in allE, simp)
- done
-qed
-
-lemma rec_calc_inj_case_cn:
- assumes ind:
- "\<And>x l xa y.
- \<lbrakk>x = f \<or> x \<in> set gs; rec_calc_rel x l xa; rec_calc_rel x l y\<rbrakk>
- \<Longrightarrow> xa = y"
- and h: "rec_calc_rel (Cn n f gs) l x"
- "rec_calc_rel (Cn n f gs) l y"
- shows "x = y"
- apply(insert h, elim calc_cn_reverse)
- apply(subgoal_tac "rs = rsa")
- apply(rule_tac x = f and l = rsa and xa = x and y = y in ind,
- simp, simp, simp)
- apply(intro list_eq_intro, simp, rule allI, rule impI)
- apply(erule_tac x = k in allE, rule_tac x = k in allE, simp, simp)
- apply(rule_tac x = "gs ! k" in ind, simp, simp, simp)
- done
-
-lemma rec_calc_inj:
- "\<lbrakk>rec_calc_rel f l x;
- rec_calc_rel f l y\<rbrakk> \<Longrightarrow> x = y"
-apply(induct f arbitrary: l x y rule: rec_ci.induct)
-apply(simp add: rec_calc_inj_case_z)
-apply(simp add: rec_calc_inj_case_s)
-apply(simp add: rec_calc_inj_case_id, simp)
-apply(erule rec_calc_inj_case_cn,simp, simp)
-apply(erule rec_calc_inj_case_pr, auto)
-apply(erule rec_calc_inj_case_mn, auto)
-done
-
-
-lemma calc_rel_reverse_ind_step_ex:
- "\<lbrakk>rec_calc_rel (Pr n f g) (lm @ [Suc x]) rs\<rbrakk>
- \<Longrightarrow> \<exists> rs. rec_calc_rel (Pr n f g) (lm @ [x]) rs"
-apply(erule calc_pr_reverse, simp, simp)
-apply(rule_tac x = rk in exI, simp)
-done
-
-lemma [simp]: "Suc x \<le> y \<Longrightarrow> Suc (y - Suc x) = y - x"
-by arith
-
-lemma calc_pr_para_not_null:
- "rec_calc_rel (Pr n f g) lm rs \<Longrightarrow> lm \<noteq> []"
-apply(erule calc_pr_reverse, simp, simp)
-done
-
-lemma calc_pr_less_ex:
- "\<lbrakk>rec_calc_rel (Pr n f g) lm rs; x \<le> last lm\<rbrakk> \<Longrightarrow>
- \<exists>rs. rec_calc_rel (Pr n f g) (butlast lm @ [last lm - x]) rs"
-apply(subgoal_tac "lm \<noteq> []")
-apply(induct x, rule_tac x = rs in exI, simp, simp, erule exE)
-apply(rule_tac rs = xa in calc_rel_reverse_ind_step_ex, simp)
-apply(simp add: calc_pr_para_not_null)
-done
-
-lemma calc_pr_zero_ex:
- "rec_calc_rel (Pr n f g) lm rs \<Longrightarrow>
- \<exists>rs. rec_calc_rel f (butlast lm) rs"
-apply(drule_tac x = "last lm" in calc_pr_less_ex, simp,
- erule_tac exE, simp)
-apply(erule_tac calc_pr_reverse, simp)
-apply(rule_tac x = rs in exI, simp, simp)
-done
-
-
-lemma abc_steps_ind:
- "abc_steps_l (as, am) ap (Suc stp) =
- abc_steps_l (abc_steps_l (as, am) ap stp) ap (Suc 0)"
-apply(insert abc_steps_add[of as am ap stp "Suc 0"], simp)
-done
-
-lemma abc_steps_zero: "abc_steps_l asm ap 0 = asm"
-apply(case_tac asm, simp add: abc_steps_l.simps)
-done
-
-lemma abc_append_nth:
- "n < length ap + length bp \<Longrightarrow>
- (ap [+] bp) ! n =
- (if n < length ap then ap ! n
- else abc_inst_shift (bp ! (n - length ap)) (length ap))"
-apply(simp add: abc_append.simps nth_append map_nth split: if_splits)
-done
-
-lemma abc_state_keep:
- "as \<ge> length bp \<Longrightarrow> abc_steps_l (as, lm) bp stp = (as, lm)"
-apply(induct stp, simp add: abc_steps_zero)
-apply(simp add: abc_steps_ind)
-apply(simp add: abc_steps_zero)
-apply(simp add: abc_steps_l.simps abc_fetch.simps abc_step_l.simps)
-done
-
-lemma abc_halt_equal:
- "\<lbrakk>abc_steps_l (0, lm) bp stpa = (length bp, lm1);
- abc_steps_l (0, lm) bp stpb = (length bp, lm2)\<rbrakk> \<Longrightarrow> lm1 = lm2"
-apply(case_tac "stpa - stpb > 0")
-apply(insert abc_steps_add[of 0 lm bp stpb "stpa - stpb"], simp)
-apply(insert abc_state_keep[of bp "length bp" lm2 "stpa - stpb"],
- simp, simp add: abc_steps_zero)
-apply(insert abc_steps_add[of 0 lm bp stpa "stpb - stpa"], simp)
-apply(insert abc_state_keep[of bp "length bp" lm1 "stpb - stpa"],
- simp)
-done
-
-lemma abc_halt_point_ex:
- "\<lbrakk>\<exists>stp. abc_steps_l (0, lm) bp stp = (bs, lm');
- bs = length bp; bp \<noteq> []\<rbrakk>
- \<Longrightarrow> \<exists> stp. (\<lambda> (s, l). s < bs \<and>
- (abc_steps_l (s, l) bp (Suc 0)) = (bs, lm'))
- (abc_steps_l (0, lm) bp stp) "
-apply(erule_tac exE)
-proof -
- fix stp
- assume "bs = length bp"
- "abc_steps_l (0, lm) bp stp = (bs, lm')"
- "bp \<noteq> []"
- thus
- "\<exists>stp. (\<lambda>(s, l). s < bs \<and>
- abc_steps_l (s, l) bp (Suc 0) = (bs, lm'))
- (abc_steps_l (0, lm) bp stp)"
- apply(induct stp, simp add: abc_steps_zero, simp)
- proof -
- fix stpa
- assume ind:
- "abc_steps_l (0, lm) bp stpa = (length bp, lm')
- \<Longrightarrow> \<exists>stp. (\<lambda>(s, l). s < length bp \<and> abc_steps_l (s, l) bp
- (Suc 0) = (length bp, lm')) (abc_steps_l (0, lm) bp stp)"
- and h: "abc_steps_l (0, lm) bp (Suc stpa) = (length bp, lm')"
- "abc_steps_l (0, lm) bp stp = (length bp, lm')"
- "bp \<noteq> []"
- from h show
- "\<exists>stp. (\<lambda>(s, l). s < length bp \<and> abc_steps_l (s, l) bp (Suc 0)
- = (length bp, lm')) (abc_steps_l (0, lm) bp stp)"
- apply(case_tac "abc_steps_l (0, lm) bp stpa",
- case_tac "a = length bp")
- apply(insert ind, simp)
- apply(subgoal_tac "b = lm'", simp)
- apply(rule_tac abc_halt_equal, simp, simp)
- apply(rule_tac x = stpa in exI, simp add: abc_steps_ind)
- apply(simp add: abc_steps_zero)
- apply(rule classical, simp add: abc_steps_l.simps
- abc_fetch.simps abc_step_l.simps)
- done
- qed
-qed
-
-
-lemma abc_append_empty_r[simp]: "[] [+] ab = ab"
-apply(simp add: abc_append.simps abc_inst_shift.simps)
-apply(induct ab, simp, simp)
-apply(case_tac a, simp_all add: abc_inst_shift.simps)
-done
-
-lemma abc_append_empty_l[simp]: "ab [+] [] = ab"
-apply(simp add: abc_append.simps abc_inst_shift.simps)
-done
-
-
-lemma abc_append_length[simp]:
- "length (ap [+] bp) = length ap + length bp"
-apply(simp add: abc_append.simps)
-done
-
-lemma abc_append_commute: "as [+] bs [+] cs = as [+] (bs [+] cs)"
-apply(simp add: abc_append.simps abc_shift.simps abc_inst_shift.simps)
-apply(induct cs, simp, simp)
-apply(case_tac a, auto simp: abc_inst_shift.simps)
-done
-
-lemma abc_halt_point_step[simp]:
- "\<lbrakk>a < length bp; abc_steps_l (a, b) bp (Suc 0) = (length bp, lm')\<rbrakk>
- \<Longrightarrow> abc_steps_l (length ap + a, b) (ap [+] bp [+] cp) (Suc 0) =
- (length ap + length bp, lm')"
-apply(simp add: abc_steps_l.simps abc_fetch.simps abc_append_nth)
-apply(case_tac "bp ! a",
- auto simp: abc_steps_l.simps abc_step_l.simps)
-done
-
-lemma abc_step_state_in:
- "\<lbrakk>bs < length bp; abc_steps_l (a, b) bp (Suc 0) = (bs, l)\<rbrakk>
- \<Longrightarrow> a < length bp"
-apply(simp add: abc_steps_l.simps abc_fetch.simps)
-apply(rule_tac classical,
- simp add: abc_step_l.simps abc_steps_l.simps)
-done
-
-
-lemma abc_append_state_in_exc:
- "\<lbrakk>bs < length bp; abc_steps_l (0, lm) bp stpa = (bs, l)\<rbrakk>
- \<Longrightarrow> abc_steps_l (length ap, lm) (ap [+] bp [+] cp) stpa =
- (length ap + bs, l)"
-apply(induct stpa arbitrary: bs l, simp add: abc_steps_zero)
-proof -
- fix stpa bs l
- assume ind:
- "\<And>bs l. \<lbrakk>bs < length bp; abc_steps_l (0, lm) bp stpa = (bs, l)\<rbrakk>
- \<Longrightarrow> abc_steps_l (length ap, lm) (ap [+] bp [+] cp) stpa =
- (length ap + bs, l)"
- and h: "bs < length bp"
- "abc_steps_l (0, lm) bp (Suc stpa) = (bs, l)"
- from h show
- "abc_steps_l (length ap, lm) (ap [+] bp [+] cp) (Suc stpa) =
- (length ap + bs, l)"
- apply(simp add: abc_steps_ind)
- apply(case_tac "(abc_steps_l (0, lm) bp stpa)", simp)
- proof -
- fix a b
- assume g: "abc_steps_l (0, lm) bp stpa = (a, b)"
- "abc_steps_l (a, b) bp (Suc 0) = (bs, l)"
- from h and g have k1: "a < length bp"
- apply(simp add: abc_step_state_in)
- done
- from h and g and k1 show
- "abc_steps_l (abc_steps_l (length ap, lm) (ap [+] bp [+] cp) stpa)
- (ap [+] bp [+] cp) (Suc 0) = (length ap + bs, l)"
- apply(insert ind[of a b], simp)
- apply(simp add: abc_steps_l.simps abc_fetch.simps
- abc_append_nth)
- apply(case_tac "bp ! a", auto simp:
- abc_steps_l.simps abc_step_l.simps)
- done
- qed
-qed
-
-lemma [simp]: "abc_steps_l (0, am) [] stp = (0, am)"
-apply(induct stp, simp add: abc_steps_zero)
-apply(simp add: abc_steps_ind)
-apply(simp add: abc_steps_zero abc_steps_l.simps
- abc_fetch.simps abc_step_l.simps)
-done
-
-lemma abc_append_exc1:
- "\<lbrakk>\<exists> stp. abc_steps_l (0, lm) bp stp = (bs, lm');
- bs = length bp;
- as = length ap\<rbrakk>
- \<Longrightarrow> \<exists> stp. abc_steps_l (as, lm) (ap [+] bp [+] cp) stp
- = (as + bs, lm')"
-apply(case_tac "bp = []", erule_tac exE, simp,
- rule_tac x = 0 in exI, simp add: abc_steps_zero)
-apply(frule_tac abc_halt_point_ex, simp, simp,
- erule_tac exE, erule_tac exE)
-apply(rule_tac x = "stpa + Suc 0" in exI)
-apply(case_tac "(abc_steps_l (0, lm) bp stpa)",
- simp add: abc_steps_ind)
-apply(subgoal_tac
- "abc_steps_l (length ap, lm) (ap [+] bp [+] cp) stpa
- = (length ap + a, b)", simp)
-apply(simp add: abc_steps_zero)
-apply(rule_tac abc_append_state_in_exc, simp, simp)
-done
-
-lemma abc_append_exc3:
- "\<lbrakk>\<exists> stp. abc_steps_l (0, am) bp stp = (bs, bm); ss = length ap\<rbrakk>
- \<Longrightarrow> \<exists> stp. abc_steps_l (ss, am) (ap [+] bp) stp = (bs + ss, bm)"
-apply(erule_tac exE)
-proof -
- fix stp
- assume h: "abc_steps_l (0, am) bp stp = (bs, bm)" "ss = length ap"
- thus " \<exists>stp. abc_steps_l (ss, am) (ap [+] bp) stp = (bs + ss, bm)"
- proof(induct stp arbitrary: bs bm)
- fix bs bm
- assume "abc_steps_l (0, am) bp 0 = (bs, bm)"
- thus "\<exists>stp. abc_steps_l (ss, am) (ap [+] bp) stp = (bs + ss, bm)"
- apply(rule_tac x = 0 in exI, simp add: abc_steps_l.simps)
- done
- next
- fix stp bs bm
- assume ind:
- "\<And>bs bm. \<lbrakk>abc_steps_l (0, am) bp stp = (bs, bm);
- ss = length ap\<rbrakk> \<Longrightarrow>
- \<exists>stp. abc_steps_l (ss, am) (ap [+] bp) stp = (bs + ss, bm)"
- and g: "abc_steps_l (0, am) bp (Suc stp) = (bs, bm)"
- from g show
- "\<exists>stp. abc_steps_l (ss, am) (ap [+] bp) stp = (bs + ss, bm)"
- apply(insert abc_steps_add[of 0 am bp stp "Suc 0"], simp)
- apply(case_tac "(abc_steps_l (0, am) bp stp)", simp)
- proof -
- fix a b
- assume "(bs, bm) = abc_steps_l (a, b) bp (Suc 0)"
- "abc_steps_l (0, am) bp (Suc stp) =
- abc_steps_l (a, b) bp (Suc 0)"
- "abc_steps_l (0, am) bp stp = (a, b)"
- thus "?thesis"
- apply(insert ind[of a b], simp add: h, erule_tac exE)
- apply(rule_tac x = "Suc stp" in exI)
- apply(simp only: abc_steps_ind, simp add: abc_steps_zero)
- proof -
- fix stp
- assume "(bs, bm) = abc_steps_l (a, b) bp (Suc 0)"
- thus "abc_steps_l (a + length ap, b) (ap [+] bp) (Suc 0)
- = (bs + length ap, bm)"
- apply(simp add: abc_steps_l.simps abc_steps_zero
- abc_fetch.simps split: if_splits)
- apply(case_tac "bp ! a",
- simp_all add: abc_inst_shift.simps abc_append_nth
- abc_steps_l.simps abc_steps_zero abc_step_l.simps)
- apply(auto)
- done
- qed
- qed
- qed
-qed
-
-lemma abc_add_equal:
- "\<lbrakk>ap \<noteq> [];
- abc_steps_l (0, am) ap astp = (a, b);
- a < length ap\<rbrakk>
- \<Longrightarrow> (abc_steps_l (0, am) (ap @ bp) astp) = (a, b)"
-apply(induct astp arbitrary: a b, simp add: abc_steps_l.simps, simp)
-apply(simp add: abc_steps_ind)
-apply(case_tac "(abc_steps_l (0, am) ap astp)")
-proof -
- fix astp a b aa ba
- assume ind:
- "\<And>a b. \<lbrakk>abc_steps_l (0, am) ap astp = (a, b);
- a < length ap\<rbrakk> \<Longrightarrow>
- abc_steps_l (0, am) (ap @ bp) astp = (a, b)"
- and h: "abc_steps_l (abc_steps_l (0, am) ap astp) ap (Suc 0)
- = (a, b)"
- "a < length ap"
- "abc_steps_l (0, am) ap astp = (aa, ba)"
- from h show "abc_steps_l (abc_steps_l (0, am) (ap @ bp) astp)
- (ap @ bp) (Suc 0) = (a, b)"
- apply(insert ind[of aa ba], simp)
- apply(subgoal_tac "aa < length ap", simp)
- apply(simp add: abc_steps_l.simps abc_fetch.simps
- nth_append abc_steps_zero)
- apply(rule abc_step_state_in, auto)
- done
-qed
-
-
-lemma abc_add_exc1:
- "\<lbrakk>\<exists> astp. abc_steps_l (0, am) ap astp = (as, bm); as = length ap\<rbrakk>
- \<Longrightarrow> \<exists> stp. abc_steps_l (0, am) (ap @ bp) stp = (as, bm)"
-apply(case_tac "ap = []", simp,
- rule_tac x = 0 in exI, simp add: abc_steps_zero)
-apply(drule_tac abc_halt_point_ex, simp, simp)
-apply(erule_tac exE, case_tac "(abc_steps_l (0, am) ap astp)", simp)
-apply(rule_tac x = "Suc astp" in exI, simp add: abc_steps_ind, auto)
-apply(frule_tac bp = bp in abc_add_equal, simp, simp, simp)
-apply(simp add: abc_steps_l.simps abc_steps_zero
- abc_fetch.simps nth_append)
-done
-
-declare abc_shift.simps[simp del]
-
-lemma abc_append_exc2:
- "\<lbrakk>\<exists> astp. abc_steps_l (0, am) ap astp = (as, bm); as = length ap;
- \<exists> bstp. abc_steps_l (0, bm) bp bstp = (bs, bm'); bs = length bp;
- cs = as + bs; bp \<noteq> []\<rbrakk>
- \<Longrightarrow> \<exists> stp. abc_steps_l (0, am) (ap [+] bp) stp = (cs, bm')"
-apply(insert abc_append_exc1[of bm bp bs bm' as ap "[]"], simp)
-apply(drule_tac bp = "abc_shift bp (length ap)" in abc_add_exc1, simp)
-apply(subgoal_tac "ap @ abc_shift bp (length ap) = ap [+] bp",
- simp, auto)
-apply(rule_tac x = "stpa + stp" in exI, simp add: abc_steps_add)
-apply(simp add: abc_append.simps)
-done
-lemma exp_length[simp]: "length (a\<^bsup>b\<^esup>) = b"
-by(simp add: exponent_def)
-lemma exponent_add_iff: "a\<^bsup>b\<^esup> @ a\<^bsup>c \<^esup>@ xs = a\<^bsup>b + c \<^esup>@ xs"
-apply(auto simp: exponent_def replicate_add)
-done
-lemma exponent_cons_iff: "a # a\<^bsup>c \<^esup>@ xs = a\<^bsup>Suc c \<^esup>@ xs"
-apply(auto simp: exponent_def replicate_add)
-done
-
-
-lemma [simp]: "length lm = n \<Longrightarrow>
- abc_steps_l (Suc 0, lm @ Suc x # 0 # suf_lm)
- [Inc n, Dec (Suc n) 3, Goto (Suc 0)] (Suc (Suc 0))
- = (3, lm @ Suc x # 0 # suf_lm)"
-apply(simp add: abc_steps_l.simps abc_fetch.simps
- abc_step_l.simps abc_lm_v.simps abc_lm_s.simps
- nth_append list_update_append)
-done
-
-lemma [simp]:
- "length lm = n \<Longrightarrow>
- abc_steps_l (Suc 0, lm @ Suc x # Suc y # suf_lm)
- [Inc n, Dec (Suc n) 3, Goto (Suc 0)] (Suc (Suc 0))
- = (Suc 0, lm @ Suc x # y # suf_lm)"
-apply(simp add: abc_steps_l.simps abc_fetch.simps
- abc_step_l.simps abc_lm_v.simps abc_lm_s.simps
- nth_append list_update_append)
-done
-
-lemma pr_cycle_part_middle_inv:
- "\<lbrakk>length lm = n\<rbrakk> \<Longrightarrow>
- \<exists> stp. abc_steps_l (0, lm @ x # y # suf_lm)
- [Inc n, Dec (Suc n) 3, Goto (Suc 0)] stp
- = (3, lm @ Suc x # 0 # suf_lm)"
-proof -
- assume h: "length lm = n"
- hence k1: "\<exists> stp. abc_steps_l (0, lm @ x # y # suf_lm)
- [Inc n, Dec (Suc n) 3, Goto (Suc 0)] stp
- = (Suc 0, lm @ Suc x # y # suf_lm)"
- apply(rule_tac x = "Suc 0" in exI)
- apply(simp add: abc_steps_l.simps abc_step_l.simps
- abc_lm_v.simps abc_lm_s.simps nth_append
- list_update_append abc_fetch.simps)
- done
- from h have k2:
- "\<exists> stp. abc_steps_l (Suc 0, lm @ Suc x # y # suf_lm)
- [Inc n, Dec (Suc n) 3, Goto (Suc 0)] stp
- = (3, lm @ Suc x # 0 # suf_lm)"
- apply(induct y)
- apply(rule_tac x = "Suc (Suc 0)" in exI, simp, simp,
- erule_tac exE)
- apply(rule_tac x = "Suc (Suc 0) + stp" in exI,
- simp only: abc_steps_add, simp)
- done
- from k1 and k2 show
- "\<exists> stp. abc_steps_l (0, lm @ x # y # suf_lm)
- [Inc n, Dec (Suc n) 3, Goto (Suc 0)] stp
- = (3, lm @ Suc x # 0 # suf_lm)"
- apply(erule_tac exE, erule_tac exE)
- apply(rule_tac x = "stp + stpa" in exI, simp add: abc_steps_add)
- done
-qed
-
-lemma [simp]:
- "length lm = Suc n \<Longrightarrow>
- (abc_steps_l (length ap, lm @ x # Suc y # suf_lm)
- (ap @ [Dec (Suc (Suc n)) 0, Inc (Suc n), Goto (length ap)])
- (Suc (Suc (Suc 0))))
- = (length ap, lm @ Suc x # y # suf_lm)"
-apply(simp add: abc_steps_l.simps abc_fetch.simps abc_step_l.simps
- abc_lm_v.simps list_update_append nth_append abc_lm_s.simps)
-done
-
-lemma switch_para_inv:
- assumes bp_def:"bp = ap @ [Dec (Suc (Suc n)) 0, Inc (Suc n), Goto ss]"
- and h: "rec_ci (Pr n f g) = (aprog, rs_pos, a_md)"
- "ss = length ap"
- "length lm = Suc n"
- shows " \<exists>stp. abc_steps_l (ss, lm @ x # y # suf_lm) bp stp =
- (0, lm @ (x + y) # 0 # suf_lm)"
-apply(induct y arbitrary: x)
-apply(rule_tac x = "Suc 0" in exI,
- simp add: bp_def empty.simps abc_steps_l.simps
- abc_fetch.simps h abc_step_l.simps
- abc_lm_v.simps list_update_append nth_append
- abc_lm_s.simps)
-proof -
- fix y x
- assume ind:
- "\<And>x. \<exists>stp. abc_steps_l (ss, lm @ x # y # suf_lm) bp stp =
- (0, lm @ (x + y) # 0 # suf_lm)"
- show "\<exists>stp. abc_steps_l (ss, lm @ x # Suc y # suf_lm) bp stp =
- (0, lm @ (x + Suc y) # 0 # suf_lm)"
- apply(insert ind[of "Suc x"], erule_tac exE)
- apply(rule_tac x = "Suc (Suc (Suc 0)) + stp" in exI,
- simp only: abc_steps_add bp_def h)
- apply(simp add: h)
- done
-qed
-
-lemma [simp]:
- "length lm = rs_pos \<and> Suc (Suc rs_pos) < a_md \<and> 0 < rs_pos \<Longrightarrow>
- a_md - Suc 0 < Suc (Suc (Suc (a_md + length suf_lm -
- Suc (Suc (Suc 0)))))"
-apply(arith)
-done
-
-lemma [simp]:
- "Suc (Suc rs_pos) < a_md \<and> 0 < rs_pos \<Longrightarrow>
- \<not> a_md - Suc 0 < rs_pos - Suc 0"
-apply(arith)
-done
-
-lemma [simp]:
- "Suc (Suc rs_pos) < a_md \<and> 0 < rs_pos \<Longrightarrow>
- \<not> a_md - rs_pos < Suc (Suc (a_md - Suc (Suc rs_pos)))"
-apply(arith)
-done
-
-lemma butlast_append_last: "lm \<noteq> [] \<Longrightarrow> lm = butlast lm @ [last lm]"
-apply(auto)
-done
-
-lemma [simp]: "rec_ci (Pr n f g) = (aprog, rs_pos, a_md)
- \<Longrightarrow> (Suc (Suc rs_pos)) < a_md"
-apply(simp add: rec_ci.simps)
-apply(case_tac "rec_ci f", simp)
-apply(case_tac "rec_ci g", simp)
-apply(arith)
-done
-
-(*
-lemma pr_para_ge_suc0: "rec_calc_rel (Pr n f g) lm xs \<Longrightarrow> 0 < n"
-apply(erule calc_pr_reverse, simp, simp)
-done
-*)
-
-lemma ci_pr_para_eq: "rec_ci (Pr n f g) = (aprog, rs_pos, a_md)
- \<Longrightarrow> rs_pos = Suc n"
-apply(simp add: rec_ci.simps)
-apply(case_tac "rec_ci g", case_tac "rec_ci f", simp)
-done
-
-lemma [intro]:
- "\<lbrakk>rec_ci z = (aprog, rs_pos, a_md); rec_calc_rel z lm xs\<rbrakk>
- \<Longrightarrow> length lm = rs_pos"
-apply(simp add: rec_ci.simps rec_ci_z_def)
-apply(erule_tac calc_z_reverse, simp)
-done
-
-lemma [intro]:
- "\<lbrakk>rec_ci s = (aprog, rs_pos, a_md); rec_calc_rel s lm xs\<rbrakk>
- \<Longrightarrow> length lm = rs_pos"
-apply(simp add: rec_ci.simps rec_ci_s_def)
-apply(erule_tac calc_s_reverse, simp)
-done
-
-lemma [intro]:
- "\<lbrakk>rec_ci (recf.id nat1 nat2) = (aprog, rs_pos, a_md);
- rec_calc_rel (recf.id nat1 nat2) lm xs\<rbrakk> \<Longrightarrow> length lm = rs_pos"
-apply(simp add: rec_ci.simps rec_ci_id.simps)
-apply(erule_tac calc_id_reverse, simp)
-done
-
-lemma [intro]:
- "\<lbrakk>rec_ci (Cn n f gs) = (aprog, rs_pos, a_md);
- rec_calc_rel (Cn n f gs) lm xs\<rbrakk> \<Longrightarrow> length lm = rs_pos"
-apply(erule_tac calc_cn_reverse, simp)
-apply(simp add: rec_ci.simps)
-apply(case_tac "rec_ci f", simp)
-done
-
-lemma [intro]:
- "\<lbrakk>rec_ci (Pr n f g) = (aprog, rs_pos, a_md);
- rec_calc_rel (Pr n f g) lm xs\<rbrakk> \<Longrightarrow> length lm = rs_pos"
-apply(erule_tac calc_pr_reverse, simp)
-apply(drule_tac ci_pr_para_eq, simp, simp)
-apply(drule_tac ci_pr_para_eq, simp)
-done
-
-lemma [intro]:
- "\<lbrakk>rec_ci (Mn n f) = (aprog, rs_pos, a_md);
- rec_calc_rel (Mn n f) lm xs\<rbrakk> \<Longrightarrow> length lm = rs_pos"
-apply(erule_tac calc_mn_reverse)
-apply(simp add: rec_ci.simps)
-apply(case_tac "rec_ci f", simp)
-done
-
-lemma para_pattern:
- "\<lbrakk>rec_ci f = (aprog, rs_pos, a_md); rec_calc_rel f lm xs\<rbrakk>
- \<Longrightarrow> length lm = rs_pos"
-apply(case_tac f, auto)
-done
-
-lemma ci_pr_g_paras:
- "\<lbrakk>rec_ci (Pr n f g) = (aprog, rs_pos, a_md);
- rec_ci g = (a, aa, ba);
- rec_calc_rel (Pr n f g) (lm @ [x]) rs; x > 0\<rbrakk> \<Longrightarrow>
- aa = Suc rs_pos "
-apply(erule calc_pr_reverse, simp)
-apply(subgoal_tac "length (args @ [k, rk]) = aa", simp)
-apply(subgoal_tac "rs_pos = Suc n", simp)
-apply(simp add: ci_pr_para_eq)
-apply(erule para_pattern, simp)
-done
-
-lemma ci_pr_g_md_less:
- "\<lbrakk>rec_ci (Pr n f g) = (aprog, rs_pos, a_md);
- rec_ci g = (a, aa, ba)\<rbrakk> \<Longrightarrow> ba < a_md"
-apply(simp add: rec_ci.simps)
-apply(case_tac "rec_ci f", auto)
-done
-
-lemma [intro]: "rec_ci z = (ap, rp, ad) \<Longrightarrow> rp < ad"
- by(simp add: rec_ci.simps)
-
-lemma [intro]: "rec_ci s = (ap, rp, ad) \<Longrightarrow> rp < ad"
- by(simp add: rec_ci.simps)
-
-lemma [intro]: "rec_ci (recf.id nat1 nat2) = (ap, rp, ad) \<Longrightarrow> rp < ad"
- by(simp add: rec_ci.simps)
-
-lemma [intro]: "rec_ci (Cn n f gs) = (ap, rp, ad) \<Longrightarrow> rp < ad"
-apply(simp add: rec_ci.simps)
-apply(case_tac "rec_ci f", simp)
-done
-
-lemma [intro]: "rec_ci (Pr n f g) = (ap, rp, ad) \<Longrightarrow> rp < ad"
-apply(simp add: rec_ci.simps)
-by(case_tac "rec_ci f", case_tac "rec_ci g", auto)
-
-lemma [intro]: "rec_ci (Mn n f) = (ap, rp, ad) \<Longrightarrow> rp < ad"
-apply(simp add: rec_ci.simps)
-apply(case_tac "rec_ci f", simp)
-apply(arith)
-done
-
-lemma ci_ad_ge_paras: "rec_ci f = (ap, rp, ad) \<Longrightarrow> ad > rp"
-apply(case_tac f, auto)
-done
-
-lemma [elim]: "\<lbrakk>a [+] b = []; a \<noteq> [] \<or> b \<noteq> []\<rbrakk> \<Longrightarrow> RR"
-apply(auto simp: abc_append.simps abc_shift.simps)
-done
-
-lemma [intro]: "rec_ci z = ([], aa, ba) \<Longrightarrow> False"
-by(simp add: rec_ci.simps rec_ci_z_def)
-
-lemma [intro]: "rec_ci s = ([], aa, ba) \<Longrightarrow> False"
-by(auto simp: rec_ci.simps rec_ci_s_def addition.simps)
-
-lemma [intro]: "rec_ci (id m n) = ([], aa, ba) \<Longrightarrow> False"
-by(auto simp: rec_ci.simps rec_ci_id.simps addition.simps)
-
-lemma [intro]: "rec_ci (Cn n f gs) = ([], aa, ba) \<Longrightarrow> False"
-apply(case_tac "rec_ci f", auto simp: rec_ci.simps abc_append.simps)
-apply(simp add: abc_shift.simps empty.simps)
-done
-
-lemma [intro]: "rec_ci (Pr n f g) = ([], aa, ba) \<Longrightarrow> False"
-apply(simp add: rec_ci.simps)
-apply(case_tac "rec_ci f", case_tac "rec_ci g")
-by(auto)
-
-lemma [intro]: "rec_ci (Mn n f) = ([], aa, ba) \<Longrightarrow> False"
-apply(case_tac "rec_ci f", auto simp: rec_ci.simps)
-done
-
-lemma rec_ci_not_null: "rec_ci g = (a, aa, ba) \<Longrightarrow> a \<noteq> []"
-by(case_tac g, auto)
-
-lemma calc_pr_g_def:
- "\<lbrakk>rec_calc_rel (Pr rs_pos f g) (lm @ [Suc x]) rsa;
- rec_calc_rel (Pr rs_pos f g) (lm @ [x]) rsxa\<rbrakk>
- \<Longrightarrow> rec_calc_rel g (lm @ [x, rsxa]) rsa"
-apply(erule_tac calc_pr_reverse, simp, simp)
-apply(subgoal_tac "rsxa = rk", simp)
-apply(erule_tac rec_calc_inj, auto)
-done
-
-lemma ci_pr_md_def:
- "\<lbrakk>rec_ci (Pr n f g) = (aprog, rs_pos, a_md);
- rec_ci g = (a, aa, ba); rec_ci f = (ab, ac, bc)\<rbrakk>
- \<Longrightarrow> a_md = Suc (max (n + 3) (max bc ba))"
-by(simp add: rec_ci.simps)
-
-lemma ci_pr_f_paras:
- "\<lbrakk>rec_ci (Pr n f g) = (aprog, rs_pos, a_md);
- rec_calc_rel (Pr n f g) lm rs;
- rec_ci f = (ab, ac, bc)\<rbrakk> \<Longrightarrow> ac = rs_pos - Suc 0"
-apply(subgoal_tac "\<exists>rs. rec_calc_rel f (butlast lm) rs",
- erule_tac exE)
-apply(drule_tac f = f and lm = "butlast lm" in para_pattern,
- simp, simp)
-apply(drule_tac para_pattern, simp)
-apply(subgoal_tac "lm \<noteq> []", simp)
-apply(erule_tac calc_pr_reverse, simp, simp)
-apply(erule calc_pr_zero_ex)
-done
-
-lemma ci_pr_md_ge_f: "\<lbrakk>rec_ci (Pr n f g) = (aprog, rs_pos, a_md);
- rec_ci f = (ab, ac, bc)\<rbrakk> \<Longrightarrow> Suc bc \<le> a_md"
-apply(case_tac "rec_ci g")
-apply(simp add: rec_ci.simps, auto)
-done
-
-lemma ci_pr_md_ge_g: "\<lbrakk>rec_ci (Pr n f g) = (aprog, rs_pos, a_md);
- rec_ci g = (ab, ac, bc)\<rbrakk> \<Longrightarrow> bc < a_md"
-apply(case_tac "rec_ci f")
-apply(simp add: rec_ci.simps, auto)
-done
-
-lemma rec_calc_rel_def0:
- "\<lbrakk>rec_calc_rel (Pr n f g) lm rs; rec_calc_rel f (butlast lm) rsa\<rbrakk>
- \<Longrightarrow> rec_calc_rel (Pr n f g) (butlast lm @ [0]) rsa"
- apply(rule_tac calc_pr_zero, simp)
-apply(erule_tac calc_pr_reverse, simp, simp, simp)
-done
-
-lemma [simp]: "length (empty m n) = 3"
-by (auto simp: empty.simps)
-(*
-lemma
- "\<lbrakk>rec_ci (Pr n f g) = (aprog, rs_pos, a_md);
- rec_calc_rel (Pr n f g) lm rs;
- rec_ci g = (a, aa, ba);
- rec_ci f = (ab, ac, bc)\<rbrakk>
-\<Longrightarrow> \<exists>ap bp cp. aprog = ap [+] bp [+] cp \<and> length ap = 3 + length ab \<and> bp = recursive.empty (n - Suc 0) n 3"
-apply(simp add: rec_ci.simps)
-apply(rule_tac x = "recursive.empty (n - Suc 0) (max (Suc (Suc n)) (max bc ba)) 3 [+] ab" in exI, simp)
-apply(rule_tac x = "([Dec (max (Suc (Suc n)) (max bc ba)) (length a + 7)] [+] a [+]
- [Inc (n - Suc 0), Dec n 3, Goto (Suc 0)]) @ [Dec (Suc n) 0, Inc n, Goto (length a + 4)]" in exI, simp)
-apply(auto simp: abc_append_commute)
-done
-
-lemma "\<lbrakk>rec_ci (Pr n f g) = (aprog, rs_pos, a_md);
- rec_ci g = (a, aa, ba); rec_ci f = (ab, ac, bc)\<rbrakk>
- \<Longrightarrow> \<exists>ap bp cp. aprog = ap [+] bp [+] cp \<and> length ap = 3 \<and> bp = ab"
-apply(simp add: rec_ci.simps)
-apply(rule_tac x = "recursive.empty (n - Suc 0) (max (Suc (Suc n)) (max bc ba)) 3" in exI, simp)
-apply(rule_tac x = "recursive.empty (n - Suc 0) n 3 [+]
- ([Dec (max (Suc (Suc n)) (max bc ba)) (length a + 7)] [+] a
- [+] [Inc (n - Suc 0), Dec n 3, Goto (Suc 0)]) @ [Dec (Suc n) 0, Inc n, Goto (length a + 4)]" in exI, auto)
-apply(simp add: abc_append_commute)
-done
-*)
-
-lemma [simp]: "\<lbrakk>rec_ci (Pr n f g) = (aprog, rs_pos, a_md); rec_calc_rel (Pr n f g) lm rs\<rbrakk>
- \<Longrightarrow> rs_pos = Suc n"
-apply(simp add: ci_pr_para_eq)
-done
-
-
-lemma [simp]: "\<lbrakk>rec_ci (Pr n f g) = (aprog, rs_pos, a_md); rec_calc_rel (Pr n f g) lm rs\<rbrakk>
- \<Longrightarrow> length lm = Suc n"
-apply(subgoal_tac "rs_pos = Suc n", rule_tac para_pattern, simp, simp)
-apply(case_tac "rec_ci f", case_tac "rec_ci g", simp add: rec_ci.simps)
-done
-
-lemma [simp]: "rec_ci (Pr n f g) = (a, rs_pos, a_md) \<Longrightarrow> Suc (Suc n) < a_md"
-apply(case_tac "rec_ci f", case_tac "rec_ci g", simp add: rec_ci.simps)
-apply arith
-done
-
-lemma [simp]: "rec_ci (Pr n f g) = (aprog, rs_pos, a_md) \<Longrightarrow> 0 < rs_pos"
-apply(case_tac "rec_ci f", case_tac "rec_ci g")
-apply(simp add: rec_ci.simps)
-done
-
-lemma [simp]: "Suc (Suc rs_pos) < a_md \<Longrightarrow>
- butlast lm @ (last lm - xa) # (rsa::nat) # 0 # 0\<^bsup>a_md - Suc (Suc (Suc rs_pos))\<^esup> @ xa # suf_lm =
- butlast lm @ (last lm - xa) # rsa # 0\<^bsup>a_md - Suc (Suc rs_pos)\<^esup> @ xa # suf_lm"
-apply(simp add: exp_ind_def[THEN sym])
-done
-
-lemma pr_cycle_part_ind:
- assumes g_ind:
- "\<And>lm rs suf_lm. rec_calc_rel g lm rs \<Longrightarrow>
- \<exists>stp. abc_steps_l (0, lm @ 0\<^bsup>ba - aa\<^esup> @ suf_lm) a stp =
- (length a, lm @ rs # 0\<^bsup>ba - Suc aa\<^esup> @ suf_lm)"
- and ap_def:
- "ap = ([Dec (a_md - Suc 0) (length a + 7)] [+]
- (a [+] [Inc (rs_pos - Suc 0), Dec rs_pos 3, Goto (Suc 0)])) @
- [Dec (Suc (Suc n)) 0, Inc (Suc n), Goto (length a + 4)]"
- and h: "rec_ci (Pr n f g) = (aprog, rs_pos, a_md)"
- "rec_calc_rel (Pr n f g)
- (butlast lm @ [last lm - Suc xa]) rsxa"
- "Suc xa \<le> last lm"
- "rec_ci g = (a, aa, ba)"
- "rec_calc_rel (Pr n f g) (butlast lm @ [last lm - xa]) rsa"
- "lm \<noteq> []"
- shows
- "\<exists>stp. abc_steps_l
- (0, butlast lm @ (last lm - Suc xa) # rsxa #
- 0\<^bsup>a_md - Suc (Suc rs_pos)\<^esup> @ Suc xa # suf_lm) ap stp =
- (0, butlast lm @ (last lm - xa) # rsa
- # 0\<^bsup>a_md - Suc (Suc rs_pos)\<^esup> @ xa # suf_lm)"
-proof -
- have k1: "\<exists>stp. abc_steps_l (0, butlast lm @ (last lm - Suc xa) #
- rsxa # 0\<^bsup>a_md - Suc (Suc rs_pos)\<^esup> @ Suc xa # suf_lm) ap stp =
- (length a + 4, butlast lm @ (last lm - xa) # 0 # rsa #
- 0\<^bsup>a_md - Suc (Suc (Suc rs_pos))\<^esup> @ xa # suf_lm)"
- apply(simp add: ap_def, rule_tac abc_add_exc1)
- apply(rule_tac as = "Suc 0" and
- bm = "butlast lm @ (last lm - Suc xa) #
- rsxa # 0\<^bsup>a_md - Suc (Suc rs_pos)\<^esup> @ xa # suf_lm" in abc_append_exc2,
- auto)
- proof -
- show
- "\<exists>astp. abc_steps_l (0, butlast lm @ (last lm - Suc xa) # rsxa
- # 0\<^bsup>a_md - Suc (Suc rs_pos)\<^esup> @ Suc xa # suf_lm)
- [Dec (a_md - Suc 0)(length a + 7)] astp =
- (Suc 0, butlast lm @ (last lm - Suc xa) #
- rsxa # 0\<^bsup>a_md - Suc (Suc rs_pos)\<^esup> @ xa # suf_lm)"
- apply(rule_tac x = "Suc 0" in exI,
- simp add: abc_steps_l.simps abc_step_l.simps
- abc_fetch.simps)
- apply(subgoal_tac "length lm = Suc n \<and> rs_pos = Suc n \<and>
- a_md > Suc (Suc rs_pos)")
- apply(simp add: abc_lm_v.simps nth_append abc_lm_s.simps)
- apply(insert nth_append[of
- "(last lm - Suc xa) # rsxa # 0\<^bsup>a_md - Suc (Suc rs_pos)\<^esup>"
- "Suc xa # suf_lm" "(a_md - rs_pos)"], simp)
- apply(simp add: list_update_append del: list_update.simps)
- apply(insert list_update_append[of "(last lm - Suc xa) # rsxa #
- 0\<^bsup>a_md - Suc (Suc rs_pos)\<^esup>"
- "Suc xa # suf_lm" "a_md - rs_pos" "xa"], simp)
- apply(case_tac a_md, simp, simp)
- apply(insert h, simp)
- apply(insert para_pattern[of "Pr n f g" aprog rs_pos a_md
- "(butlast lm @ [last lm - Suc xa])" rsxa], simp)
- done
- next
- show "\<exists>bstp. abc_steps_l (0, butlast lm @ (last lm - Suc xa) #
- rsxa # 0\<^bsup>a_md - Suc (Suc rs_pos)\<^esup> @ xa # suf_lm) (a [+]
- [Inc (rs_pos - Suc 0), Dec rs_pos 3, Goto (Suc 0)]) bstp =
- (3 + length a, butlast lm @ (last lm - xa) # 0 # rsa #
- 0\<^bsup>a_md - Suc (Suc (Suc rs_pos))\<^esup> @ xa # suf_lm)"
- apply(rule_tac as = "length a" and
- bm = "butlast lm @ (last lm - Suc xa) # rsxa # rsa #
- 0\<^bsup>a_md - Suc (Suc (Suc rs_pos))\<^esup> @ xa # suf_lm"
- in abc_append_exc2, simp_all)
- proof -
- from h have j1: "aa = Suc rs_pos \<and> a_md > ba \<and> ba > Suc rs_pos"
- apply(insert h)
- apply(insert ci_pr_g_paras[of n f g aprog rs_pos
- a_md a aa ba "butlast lm" "last lm - xa" rsa], simp)
- apply(drule_tac ci_pr_md_ge_g, auto)
- apply(erule_tac ci_ad_ge_paras)
- done
- from h have j2: "rec_calc_rel g (butlast lm @
- [last lm - Suc xa, rsxa]) rsa"
- apply(rule_tac calc_pr_g_def, simp, simp)
- done
- from j1 and j2 show
- "\<exists>astp. abc_steps_l (0, butlast lm @ (last lm - Suc xa) #
- rsxa # 0\<^bsup>a_md - Suc (Suc rs_pos)\<^esup> @ xa # suf_lm) a astp =
- (length a, butlast lm @ (last lm - Suc xa) # rsxa # rsa
- # 0\<^bsup>a_md - Suc (Suc (Suc rs_pos))\<^esup> @ xa # suf_lm)"
- apply(insert g_ind[of
- "butlast lm @ (last lm - Suc xa) # [rsxa]" rsa
- "0\<^bsup>a_md - ba - Suc 0 \<^esup> @ xa # suf_lm"], simp, auto)
- apply(simp add: exponent_add_iff)
- apply(rule_tac x = stp in exI, simp add: numeral_3_eq_3)
- done
- next
- from h have j3: "length lm = rs_pos \<and> rs_pos > 0"
- apply(rule_tac conjI)
- apply(drule_tac lm = "(butlast lm @ [last lm - Suc xa])"
- and xs = rsxa in para_pattern, simp, simp, simp)
- done
- from h have j4: "Suc (last lm - Suc xa) = last lm - xa"
- apply(case_tac "last lm", simp, simp)
- done
- from j3 and j4 show
- "\<exists>bstp. abc_steps_l (0, butlast lm @ (last lm - Suc xa) # rsxa #
- rsa # 0\<^bsup>a_md - Suc (Suc (Suc rs_pos))\<^esup> @ xa # suf_lm)
- [Inc (rs_pos - Suc 0), Dec rs_pos 3, Goto (Suc 0)] bstp =
- (3, butlast lm @ (last lm - xa) # 0 # rsa #
- 0\<^bsup>a_md - Suc (Suc (Suc rs_pos))\<^esup> @ xa # suf_lm)"
- apply(insert pr_cycle_part_middle_inv[of "butlast lm"
- "rs_pos - Suc 0" "(last lm - Suc xa)" rsxa
- "rsa # 0\<^bsup>a_md - Suc (Suc (Suc rs_pos))\<^esup> @ xa # suf_lm"], simp)
- done
- qed
- qed
- from h have k2:
- "\<exists>stp. abc_steps_l (length a + 4, butlast lm @ (last lm - xa) # 0
- # rsa # 0\<^bsup>a_md - Suc (Suc (Suc rs_pos))\<^esup> @ xa # suf_lm) ap stp =
- (0, butlast lm @ (last lm - xa) # rsa # 0\<^bsup>a_md - Suc (Suc rs_pos)\<^esup> @ xa # suf_lm)"
- apply(insert switch_para_inv[of ap
- "([Dec (a_md - Suc 0) (length a + 7)] [+]
- (a [+] [Inc (rs_pos - Suc 0), Dec rs_pos 3, Goto (Suc 0)]))"
- n "length a + 4" f g aprog rs_pos a_md
- "butlast lm @ [last lm - xa]" 0 rsa
- "0\<^bsup>a_md - Suc (Suc (Suc rs_pos))\<^esup> @ xa # suf_lm"])
- apply(simp add: h ap_def)
- apply(subgoal_tac "length lm = Suc n \<and> Suc (Suc rs_pos) < a_md",
- simp)
- apply(insert h, simp)
- apply(frule_tac lm = "(butlast lm @ [last lm - Suc xa])"
- and xs = rsxa in para_pattern, simp, simp)
- done
- from k1 and k2 show "?thesis"
- apply(auto)
- apply(rule_tac x = "stp + stpa" in exI, simp add: abc_steps_add)
- done
-qed
-
-lemma ci_pr_ex1:
- "\<lbrakk>rec_ci (Pr n f g) = (aprog, rs_pos, a_md);
- rec_ci g = (a, aa, ba);
- rec_ci f = (ab, ac, bc)\<rbrakk>
-\<Longrightarrow> \<exists>ap bp. length ap = 6 + length ab \<and>
- aprog = ap [+] bp \<and>
- bp = ([Dec (a_md - Suc 0) (length a + 7)] [+] (a [+]
- [Inc (rs_pos - Suc 0), Dec rs_pos 3, Goto (Suc 0)])) @
- [Dec (Suc (Suc n)) 0, Inc (Suc n), Goto (length a + 4)]"
-apply(simp add: rec_ci.simps)
-apply(rule_tac x = "recursive.empty n (max (Suc (Suc (Suc n)))
- (max bc ba)) [+] ab [+] recursive.empty n (Suc n)" in exI,
- simp)
-apply(auto simp add: abc_append_commute add3_Suc)
-done
-
-lemma pr_cycle_part:
- "\<lbrakk>\<And>lm rs suf_lm. rec_calc_rel g lm rs \<Longrightarrow>
- \<exists>stp. abc_steps_l (0, lm @ 0\<^bsup>ba - aa\<^esup> @ suf_lm) a stp =
- (length a, lm @ rs # 0\<^bsup>ba - Suc aa\<^esup> @ suf_lm);
- rec_ci (Pr n f g) = (aprog, rs_pos, a_md);
- rec_calc_rel (Pr n f g) lm rs;
- rec_ci g = (a, aa, ba);
- rec_calc_rel (Pr n f g) (butlast lm @ [last lm - x]) rsx;
- rec_ci f = (ab, ac, bc);
- lm \<noteq> [];
- x \<le> last lm\<rbrakk> \<Longrightarrow>
- \<exists>stp. abc_steps_l (6 + length ab, butlast lm @ (last lm - x) #
- rsx # 0\<^bsup>a_md - Suc (Suc rs_pos)\<^esup> @ x # suf_lm) aprog stp =
- (6 + length ab, butlast lm @ last lm # rs #
- 0\<^bsup>a_md - Suc (Suc rs_pos)\<^esup> @ 0 # suf_lm)"
-proof -
- assume g_ind:
- "\<And>lm rs suf_lm. rec_calc_rel g lm rs \<Longrightarrow>
- \<exists>stp. abc_steps_l (0, lm @ 0\<^bsup>ba - aa\<^esup> @ suf_lm) a stp =
- (length a, lm @ rs # 0\<^bsup>ba - Suc aa\<^esup> @ suf_lm)"
- and h: "rec_ci (Pr n f g) = (aprog, rs_pos, a_md)"
- "rec_calc_rel (Pr n f g) lm rs"
- "rec_ci g = (a, aa, ba)"
- "rec_calc_rel (Pr n f g) (butlast lm @ [last lm - x]) rsx"
- "lm \<noteq> []"
- "x \<le> last lm"
- "rec_ci f = (ab, ac, bc)"
- from h show
- "\<exists>stp. abc_steps_l (6 + length ab, butlast lm @ (last lm - x) #
- rsx # 0\<^bsup>a_md - Suc (Suc rs_pos)\<^esup> @ x # suf_lm) aprog stp =
- (6 + length ab, butlast lm @ last lm # rs #
- 0\<^bsup>a_md - Suc (Suc rs_pos)\<^esup> @ 0 # suf_lm)"
- proof(induct x arbitrary: rsx, simp_all)
- fix rsxa
- assume "rec_calc_rel (Pr n f g) lm rsxa"
- "rec_calc_rel (Pr n f g) lm rs"
- from h and this have "rs = rsxa"
- apply(subgoal_tac "lm \<noteq> [] \<and> rs_pos = Suc n", simp)
- apply(rule_tac rec_calc_inj, simp, simp)
- apply(simp)
- done
- thus "\<exists>stp. abc_steps_l (6 + length ab, butlast lm @ last lm #
- rsxa # 0\<^bsup>a_md - Suc (Suc rs_pos)\<^esup> @ 0 # suf_lm) aprog stp =
- (6 + length ab, butlast lm @ last lm # rs #
- 0\<^bsup>a_md - Suc (Suc rs_pos)\<^esup> @ 0 # suf_lm)"
- by(rule_tac x = 0 in exI, simp add: abc_steps_l.simps)
- next
- fix xa rsxa
- assume ind:
- "\<And>rsx. rec_calc_rel (Pr n f g) (butlast lm @ [last lm - xa]) rsx
- \<Longrightarrow> \<exists>stp. abc_steps_l (6 + length ab, butlast lm @ (last lm - xa) #
- rsx # 0\<^bsup>a_md - Suc (Suc rs_pos)\<^esup> @ xa # suf_lm) aprog stp =
- (6 + length ab, butlast lm @ last lm # rs #
- 0\<^bsup>a_md - Suc (Suc rs_pos)\<^esup> @ 0 # suf_lm)"
- and g: "rec_calc_rel (Pr n f g)
- (butlast lm @ [last lm - Suc xa]) rsxa"
- "Suc xa \<le> last lm"
- "rec_ci (Pr n f g) = (aprog, rs_pos, a_md)"
- "rec_calc_rel (Pr n f g) lm rs"
- "rec_ci g = (a, aa, ba)"
- "rec_ci f = (ab, ac, bc)" "lm \<noteq> []"
- from g have k1:
- "\<exists> rs. rec_calc_rel (Pr n f g) (butlast lm @ [last lm - xa]) rs"
- apply(rule_tac rs = rs in calc_pr_less_ex, simp, simp)
- done
- from g and this show
- "\<exists>stp. abc_steps_l (6 + length ab,
- butlast lm @ (last lm - Suc xa) # rsxa #
- 0\<^bsup>a_md - Suc (Suc rs_pos)\<^esup> @ Suc xa # suf_lm) aprog stp =
- (6 + length ab, butlast lm @ last lm # rs #
- 0\<^bsup>a_md - Suc (Suc rs_pos)\<^esup> @ 0 # suf_lm)"
- proof(erule_tac exE)
- fix rsa
- assume k2: "rec_calc_rel (Pr n f g)
- (butlast lm @ [last lm - xa]) rsa"
- from g and k2 have
- "\<exists>stp. abc_steps_l (6 + length ab, butlast lm @
- (last lm - Suc xa) # rsxa #
- 0\<^bsup>a_md - Suc (Suc rs_pos)\<^esup> @ Suc xa # suf_lm) aprog stp
- = (6 + length ab, butlast lm @ (last lm - xa) # rsa #
- 0\<^bsup>a_md - Suc (Suc rs_pos)\<^esup> @ xa # suf_lm)"
- proof -
- from g have k2_1:
- "\<exists> ap bp. length ap = 6 + length ab \<and>
- aprog = ap [+] bp \<and>
- bp = ([Dec (a_md - Suc 0) (length a + 7)] [+]
- (a [+] [Inc (rs_pos - Suc 0), Dec rs_pos 3,
- Goto (Suc 0)])) @
- [Dec (Suc (Suc n)) 0, Inc (Suc n), Goto (length a + 4)]"
- apply(rule_tac ci_pr_ex1, auto)
- done
- from k2_1 and k2 and g show "?thesis"
- proof(erule_tac exE, erule_tac exE)
- fix ap bp
- assume
- "length ap = 6 + length ab \<and>
- aprog = ap [+] bp \<and> bp =
- ([Dec (a_md - Suc 0) (length a + 7)] [+]
- (a [+] [Inc (rs_pos - Suc 0), Dec rs_pos 3,
- Goto (Suc 0)])) @
- [Dec (Suc (Suc n)) 0, Inc (Suc n), Goto (length a + 4)]"
- from g and this and k2 and g_ind show "?thesis"
- apply(insert abc_append_exc3[of
- "butlast lm @ (last lm - Suc xa) # rsxa #
- 0\<^bsup>a_md - Suc (Suc rs_pos)\<^esup> @ Suc xa # suf_lm" bp 0
- "butlast lm @ (last lm - xa) # rsa #
- 0\<^bsup>a_md - Suc (Suc rs_pos)\<^esup> @ xa # suf_lm" "length ap" ap],
- simp)
- apply(subgoal_tac
- "\<exists>stp. abc_steps_l (0, butlast lm @ (last lm - Suc xa)
- # rsxa # 0\<^bsup>a_md - Suc (Suc rs_pos)\<^esup> @ Suc xa #
- suf_lm) bp stp =
- (0, butlast lm @ (last lm - xa) # rsa #
- 0\<^bsup>a_md - Suc (Suc rs_pos)\<^esup> @ xa # suf_lm)",
- simp, erule_tac conjE, erule conjE)
- apply(erule pr_cycle_part_ind, auto)
- done
- qed
- qed
- from g and k2 and this show "?thesis"
- apply(erule_tac exE)
- apply(insert ind[of rsa], simp)
- apply(erule_tac exE)
- apply(rule_tac x = "stp + stpa" in exI,
- simp add: abc_steps_add)
- done
- qed
- qed
-qed
-
-lemma ci_pr_length:
- "\<lbrakk>rec_ci (Pr n f g) = (aprog, rs_pos, a_md);
- rec_ci g = (a, aa, ba);
- rec_ci f = (ab, ac, bc)\<rbrakk>
- \<Longrightarrow> length aprog = 13 + length ab + length a"
-apply(auto simp: rec_ci.simps)
-done
-
-thm empty.simps
-term max
-fun empty_inv :: "nat \<times> nat list \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat list \<Rightarrow> bool"
- where
- "empty_inv (as, lm) m n initlm =
- (let plus = initlm ! m + initlm ! n in
- length initlm > max m n \<and> m \<noteq> n \<and>
- (if as = 0 then \<exists> k l. lm = initlm[m := k, n := l] \<and>
- k + l = plus \<and> k \<le> initlm ! m
- else if as = 1 then \<exists> k l. lm = initlm[m := k, n := l]
- \<and> k + l + 1 = plus \<and> k < initlm ! m
- else if as = 2 then \<exists> k l. lm = initlm[m := k, n := l]
- \<and> k + l = plus \<and> k \<le> initlm ! m
- else if as = 3 then lm = initlm[m := 0, n := plus]
- else False))"
-
-fun empty_stage1 :: "nat \<times> nat list \<Rightarrow> nat \<Rightarrow> nat"
- where
- "empty_stage1 (as, lm) m =
- (if as = 3 then 0
- else 1)"
-
-fun empty_stage2 :: "nat \<times> nat list \<Rightarrow> nat \<Rightarrow> nat"
- where
- "empty_stage2 (as, lm) m = (lm ! m)"
-
-fun empty_stage3 :: "nat \<times> nat list \<Rightarrow> nat \<Rightarrow> nat"
- where
- "empty_stage3 (as, lm) m = (if as = 1 then 3
- else if as = 2 then 2
- else if as = 0 then 1
- else 0)"
-
-
-
-fun empty_measure :: "((nat \<times> nat list) \<times> nat) \<Rightarrow> (nat \<times> nat \<times> nat)"
- where
- "empty_measure ((as, lm), m) =
- (empty_stage1 (as, lm) m, empty_stage2 (as, lm) m,
- empty_stage3 (as, lm) m)"
-
-definition lex_pair :: "((nat \<times> nat) \<times> nat \<times> nat) set"
- where
- "lex_pair = less_than <*lex*> less_than"
-
-definition lex_triple ::
- "((nat \<times> (nat \<times> nat)) \<times> (nat \<times> (nat \<times> nat))) set"
- where
- "lex_triple \<equiv> less_than <*lex*> lex_pair"
-
-definition empty_LE ::
- "(((nat \<times> nat list) \<times> nat) \<times> ((nat \<times> nat list) \<times> nat)) set"
- where
- "empty_LE \<equiv> (inv_image lex_triple empty_measure)"
-
-lemma wf_lex_triple: "wf lex_triple"
- by (auto intro:wf_lex_prod simp:lex_triple_def lex_pair_def)
-
-lemma wf_empty_le[intro]: "wf empty_LE"
-by(auto intro:wf_inv_image wf_lex_triple simp: empty_LE_def)
-
-declare empty_inv.simps[simp del]
-
-lemma empty_inv_init:
-"\<lbrakk>m < length initlm; n < length initlm; m \<noteq> n\<rbrakk> \<Longrightarrow>
- empty_inv (0, initlm) m n initlm"
-apply(simp add: abc_steps_l.simps empty_inv.simps)
-apply(rule_tac x = "initlm ! m" in exI,
- rule_tac x = "initlm ! n" in exI, simp)
-done
-
-lemma [simp]: "abc_fetch 0 (recursive.empty m n) = Some (Dec m 3)"
-apply(simp add: empty.simps abc_fetch.simps)
-done
-
-lemma [simp]: "abc_fetch (Suc 0) (recursive.empty m n) =
- Some (Inc n)"
-apply(simp add: empty.simps abc_fetch.simps)
-done
-
-lemma [simp]: "abc_fetch 2 (recursive.empty m n) = Some (Goto 0)"
-apply(simp add: empty.simps abc_fetch.simps)
-done
-
-lemma [simp]: "abc_fetch 3 (recursive.empty m n) = None"
-apply(simp add: empty.simps abc_fetch.simps)
-done
-
-lemma [simp]:
- "\<lbrakk>m \<noteq> n; m < length initlm; n < length initlm;
- k + l = initlm ! m + initlm ! n; k \<le> initlm ! m; 0 < k\<rbrakk>
- \<Longrightarrow> \<exists>ka la. initlm[m := k, n := l, m := k - Suc 0] =
- initlm[m := ka, n := la] \<and>
- Suc (ka + la) = initlm ! m + initlm ! n \<and>
- ka < initlm ! m"
-apply(rule_tac x = "k - Suc 0" in exI, rule_tac x = l in exI,
- simp, auto)
-apply(subgoal_tac
- "initlm[m := k, n := l, m := k - Suc 0] =
- initlm[n := l, m := k, m := k - Suc 0]")
-apply(simp add: list_update_overwrite )
-apply(simp add: list_update_swap)
-apply(simp add: list_update_swap)
-done
-
-lemma [simp]:
- "\<lbrakk>m \<noteq> n; m < length initlm; n < length initlm;
- Suc (k + l) = initlm ! m + initlm ! n;
- k < initlm ! m\<rbrakk>
- \<Longrightarrow> \<exists>ka la. initlm[m := k, n := l, n := Suc l] =
- initlm[m := ka, n := la] \<and>
- ka + la = initlm ! m + initlm ! n \<and>
- ka \<le> initlm ! m"
-apply(rule_tac x = k in exI, rule_tac x = "Suc l" in exI, auto)
-done
-
-lemma [simp]:
- "\<lbrakk>length initlm > max m n; m \<noteq> n\<rbrakk> \<Longrightarrow>
- \<forall>na. \<not> (\<lambda>(as, lm) m. as = 3)
- (abc_steps_l (0, initlm) (recursive.empty m n) na) m \<and>
- empty_inv (abc_steps_l (0, initlm)
- (recursive.empty m n) na) m n initlm \<longrightarrow>
- empty_inv (abc_steps_l (0, initlm)
- (recursive.empty m n) (Suc na)) m n initlm \<and>
- ((abc_steps_l (0, initlm) (recursive.empty m n) (Suc na), m),
- abc_steps_l (0, initlm) (recursive.empty m n) na, m) \<in> empty_LE"
-apply(rule allI, rule impI, simp add: abc_steps_ind)
-apply(case_tac "(abc_steps_l (0, initlm) (recursive.empty m n) na)",
- simp)
-apply(auto split:if_splits simp add:abc_steps_l.simps empty_inv.simps)
-apply(auto simp add: empty_LE_def lex_triple_def lex_pair_def
- abc_step_l.simps abc_steps_l.simps
- empty_inv.simps abc_lm_v.simps abc_lm_s.simps
- split: if_splits )
-apply(rule_tac x = k in exI, rule_tac x = "Suc l" in exI, simp)
-done
-
-lemma empty_inv_halt:
- "\<lbrakk>length initlm > max m n; m \<noteq> n\<rbrakk> \<Longrightarrow>
- \<exists> stp. (\<lambda> (as, lm). as = 3 \<and>
- empty_inv (as, lm) m n initlm)
- (abc_steps_l (0::nat, initlm) (empty m n) stp)"
-apply(insert halt_lemma2[of empty_LE
- "\<lambda> ((as, lm), m). as = (3::nat)"
- "\<lambda> stp. (abc_steps_l (0, initlm) (recursive.empty m n) stp, m)"
- "\<lambda> ((as, lm), m). empty_inv (as, lm) m n initlm"])
-apply(insert wf_empty_le, simp add: empty_inv_init abc_steps_zero)
-apply(erule_tac exE)
-apply(rule_tac x = na in exI)
-apply(case_tac "(abc_steps_l (0, initlm) (recursive.empty m n) na)",
- simp, auto)
-done
-
-lemma empty_halt_cond:
- "\<lbrakk>m \<noteq> n; empty_inv (a, b) m n lm; a = 3\<rbrakk> \<Longrightarrow>
- b = lm[n := lm ! m + lm ! n, m := 0]"
-apply(simp add: empty_inv.simps, auto)
-apply(simp add: list_update_swap)
-done
-
-lemma empty_ex:
- "\<lbrakk>length lm > max m n; m \<noteq> n\<rbrakk> \<Longrightarrow>
- \<exists> stp. abc_steps_l (0::nat, lm) (empty m n) stp
- = (3, (lm[n := (lm ! m + lm ! n)])[m := 0::nat])"
-apply(drule empty_inv_halt, simp, erule_tac exE)
-apply(rule_tac x = stp in exI)
-apply(case_tac "abc_steps_l (0, lm) (recursive.empty m n) stp",
- simp)
-apply(erule_tac empty_halt_cond, auto)
-done
-
-lemma [simp]:
- "\<lbrakk>a_md = Suc (max (Suc (Suc n)) (max bc ba));
- length lm = rs_pos \<and> rs_pos = n \<and> n > 0\<rbrakk>
- \<Longrightarrow> n - Suc 0 < length lm +
- (Suc (max (Suc (Suc n)) (max bc ba)) - rs_pos + length suf_lm) \<and>
- Suc (Suc n) < length lm + (Suc (max (Suc (Suc n)) (max bc ba)) -
- rs_pos + length suf_lm) \<and> bc < length lm + (Suc (max (Suc (Suc n))
- (max bc ba)) - rs_pos + length suf_lm) \<and> ba < length lm +
- (Suc (max (Suc (Suc n)) (max bc ba)) - rs_pos + length suf_lm)"
-apply(arith)
-done
-
-lemma [simp]:
- "\<lbrakk>a_md = Suc (max (Suc (Suc n)) (max bc ba));
- length lm = rs_pos \<and> rs_pos = n \<and> n > 0\<rbrakk>
- \<Longrightarrow> n - Suc 0 < Suc (length suf_lm + max (Suc (Suc n)) (max bc ba)) \<and>
- Suc n < length suf_lm + max (Suc (Suc n)) (max bc ba) \<and>
- bc < Suc (length suf_lm + max (Suc (Suc n)) (max bc ba)) \<and>
- ba < Suc (length suf_lm + max (Suc (Suc n)) (max bc ba))"
-apply(arith)
-done
-
-lemma [simp]: "n - Suc 0 \<noteq> max (Suc (Suc n)) (max bc ba)"
-apply(arith)
-done
-
-lemma [simp]:
- "a_md \<ge> Suc bc \<and> rs_pos > 0 \<and> bc \<ge> rs_pos \<Longrightarrow>
- bc - (rs_pos - Suc 0) + a_md - Suc bc = Suc (a_md - rs_pos - Suc 0)"
-apply(arith)
-done
-
-lemma [simp]: "length lm = n \<and> rs_pos = n \<and> 0 < rs_pos \<and>
- Suc rs_pos < a_md
- \<Longrightarrow> n - Suc 0 < Suc (Suc (a_md + length suf_lm - Suc (Suc 0)))
- \<and> n < Suc (Suc (a_md + length suf_lm - Suc (Suc 0)))"
-apply(arith)
-done
-
-lemma [simp]: "length lm = n \<and> rs_pos = n \<and> 0 < rs_pos \<and>
- Suc rs_pos < a_md \<Longrightarrow> n - Suc 0 \<noteq> n"
-by arith
-
-lemma ci_pr_ex2:
- "\<lbrakk>rec_ci (Pr n f g) = (aprog, rs_pos, a_md);
- rec_calc_rel (Pr n f g) lm rs;
- rec_ci g = (a, aa, ba);
- rec_ci f = (ab, ac, bc)\<rbrakk>
- \<Longrightarrow> \<exists>ap bp. aprog = ap [+] bp \<and>
- ap = empty n (max (Suc (Suc (Suc n))) (max bc ba))"
-apply(simp add: rec_ci.simps)
-apply(rule_tac x = "(ab [+] (recursive.empty n (Suc n) [+]
- ([Dec (max (n + 3) (max bc ba)) (length a + 7)]
- [+] (a [+] [Inc n, Dec (Suc n) 3, Goto (Suc 0)])) @
- [Dec (Suc (Suc n)) 0, Inc (Suc n), Goto (length a + 4)]))" in exI, auto)
-apply(simp add: abc_append_commute add3_Suc)
-done
-
-lemma [simp]:
- "max (Suc (Suc (Suc n))) (max bc ba) - n <
- Suc (max (Suc (Suc (Suc n))) (max bc ba)) - n"
-apply(arith)
-done
-lemma exp_nth[simp]: "n < m \<Longrightarrow> a\<^bsup>m\<^esup> ! n = a"
-apply(simp add: exponent_def)
-done
-
-lemma [simp]: "length lm = n \<and> rs_pos = n \<and> 0 < n \<Longrightarrow>
- lm[n - Suc 0 := 0::nat] = butlast lm @ [0]"
-apply(auto)
-apply(insert list_update_append[of "butlast lm" "[last lm]"
- "length lm - Suc 0" "0"], simp)
-done
-
-lemma [simp]: "\<lbrakk>length lm = n; 0 < n\<rbrakk> \<Longrightarrow> lm ! (n - Suc 0) = last lm"
-apply(insert nth_append[of "butlast lm" "[last lm]" "n - Suc 0"],
- simp)
-apply(insert butlast_append_last[of lm], auto)
-done
-lemma exp_suc_iff: "a\<^bsup>b\<^esup> @ [a] = a\<^bsup>b + Suc 0\<^esup>"
-apply(simp add: exponent_def rep_ind del: replicate.simps)
-done
-
-lemma less_not_less[simp]: "n > 0 \<Longrightarrow> \<not> n < n - Suc 0"
-by auto
-
-lemma [simp]:
- "Suc n < length suf_lm + max (Suc (Suc n)) (max bc ba) \<and>
- bc < Suc (length suf_lm + max (Suc (Suc n))
- (max bc ba)) \<and>
- ba < Suc (length suf_lm + max (Suc (Suc n)) (max bc ba))"
- by arith
-
-lemma [simp]: "length lm = n \<and> rs_pos = n \<and> n > 0 \<Longrightarrow>
-(lm @ 0\<^bsup>Suc (max (Suc (Suc n)) (max bc ba)) - n\<^esup> @ suf_lm)
- [max (Suc (Suc n)) (max bc ba) :=
- (lm @ 0\<^bsup>Suc (max (Suc (Suc n)) (max bc ba)) - n\<^esup> @ suf_lm) ! (n - Suc 0) +
- (lm @ 0\<^bsup>Suc (max (Suc (Suc n)) (max bc ba)) - n\<^esup> @ suf_lm) !
- max (Suc (Suc n)) (max bc ba), n - Suc 0 := 0::nat]
- = butlast lm @ 0 # 0\<^bsup>max (Suc (Suc n)) (max bc ba) - n\<^esup> @ last lm # suf_lm"
-apply(simp add: nth_append exp_nth list_update_append)
-apply(insert list_update_append[of "0\<^bsup>(max (Suc (Suc n)) (max bc ba)) - n\<^esup>"
- "[0]" "max (Suc (Suc n)) (max bc ba) - n" "last lm"], simp)
-apply(simp add: exp_suc_iff Suc_diff_le del: list_update.simps)
-done
-
-lemma exp_eq: "(a = b) = (c\<^bsup>a\<^esup> = c\<^bsup>b\<^esup>)"
-apply(auto simp: exponent_def)
-done
-
-lemma [simp]:
- "\<lbrakk>length lm = n; 0 < n; Suc n < a_md\<rbrakk> \<Longrightarrow>
- (butlast lm @ rsa # 0\<^bsup>a_md - Suc n\<^esup> @ last lm # suf_lm)
- [n := (butlast lm @ rsa # 0\<^bsup>a_md - Suc n\<^esup> @ last lm # suf_lm) !
- (n - Suc 0) + (butlast lm @ rsa # (0::nat)\<^bsup>a_md - Suc n\<^esup> @
- last lm # suf_lm) ! n, n - Suc 0 := 0]
- = butlast lm @ 0 # rsa # 0\<^bsup>a_md - Suc (Suc n)\<^esup> @ last lm # suf_lm"
-apply(simp add: nth_append exp_nth list_update_append)
-apply(case_tac "a_md - Suc n", simp, simp add: exponent_def)
-done
-
-lemma [simp]:
- "Suc (Suc rs_pos) \<le> a_md \<and> length lm = rs_pos \<and> 0 < rs_pos
- \<Longrightarrow> a_md - Suc 0 <
- Suc (Suc (Suc (a_md + length suf_lm - Suc (Suc (Suc 0)))))"
-by arith
-
-lemma [simp]:
- "Suc (Suc rs_pos) \<le> a_md \<and> length lm = rs_pos \<and> 0 < rs_pos \<Longrightarrow>
- \<not> a_md - Suc 0 < rs_pos - Suc 0"
-by arith
-
-lemma [simp]: "Suc (Suc rs_pos) \<le> a_md \<Longrightarrow>
- \<not> a_md - Suc 0 < rs_pos - Suc 0"
-by arith
-
-lemma [simp]: "\<lbrakk>Suc (Suc rs_pos) \<le> a_md\<rbrakk> \<Longrightarrow>
- \<not> a_md - rs_pos < Suc (Suc (a_md - Suc (Suc rs_pos)))"
-by arith
-
-lemma [simp]:
- "Suc (Suc rs_pos) \<le> a_md \<and> length lm = rs_pos \<and> 0 < rs_pos
- \<Longrightarrow> (abc_lm_v (butlast lm @ last lm # rs # 0\<^bsup>a_md - Suc (Suc rs_pos)\<^esup> @
- 0 # suf_lm) (a_md - Suc 0) = 0 \<longrightarrow>
- abc_lm_s (butlast lm @ last lm # rs # 0\<^bsup>a_md - Suc (Suc rs_pos)\<^esup> @
- 0 # suf_lm) (a_md - Suc 0) 0 =
- lm @ rs # 0\<^bsup>a_md - Suc rs_pos\<^esup> @ suf_lm) \<and>
- abc_lm_v (butlast lm @ last lm # rs # 0\<^bsup>a_md - Suc (Suc rs_pos)\<^esup> @
- 0 # suf_lm) (a_md - Suc 0) = 0"
-apply(simp add: abc_lm_v.simps nth_append abc_lm_s.simps)
-apply(insert nth_append[of "last lm # rs # 0\<^bsup>a_md - Suc (Suc rs_pos)\<^esup>"
- "0 # suf_lm" "(a_md - rs_pos)"], auto)
-apply(simp only: exp_suc_iff)
-apply(subgoal_tac "a_md - Suc 0 < a_md + length suf_lm", simp)
-apply(case_tac "lm = []", auto)
-done
-
-lemma pr_prog_ex[simp]: "\<lbrakk>rec_ci (Pr n f g) = (aprog, rs_pos, a_md);
- rec_ci g = (a, aa, ba); rec_ci f = (ab, ac, bc)\<rbrakk>
- \<Longrightarrow> \<exists>cp. aprog = recursive.empty n (max (n + 3)
- (max bc ba)) [+] cp"
-apply(simp add: rec_ci.simps)
-apply(rule_tac x = "(ab [+] (recursive.empty n (Suc n) [+]
- ([Dec (max (n + 3) (max bc ba)) (length a + 7)]
- [+] (a [+] [Inc n, Dec (Suc n) 3, Goto (Suc 0)]))
- @ [Dec (Suc (Suc n)) 0, Inc (Suc n), Goto (length a + 4)]))" in exI)
-apply(auto simp: abc_append_commute)
-done
-
-lemma [simp]: "empty m n \<noteq> []"
-by (simp add: empty.simps)
-(*
-lemma [simp]: "\<lbrakk>rs_pos = n; 0 < rs_pos ; Suc rs_pos < a_md\<rbrakk> \<Longrightarrow>
- n - Suc 0 < a_md + length suf_lm"
-by arith
-*)
-lemma [intro]:
- "\<lbrakk>rec_ci (Pr n f g) = (aprog, rs_pos, a_md);
- rec_ci f = (ab, ac, bc)\<rbrakk> \<Longrightarrow>
- \<exists>ap. (\<exists>cp. aprog = ap [+] ab [+] cp) \<and> length ap = 3"
-apply(case_tac "rec_ci g", simp add: rec_ci.simps)
-apply(rule_tac x = "empty n
- (max (n + 3) (max bc c))" in exI, simp)
-apply(rule_tac x = "recursive.empty n (Suc n) [+]
- ([Dec (max (n + 3) (max bc c)) (length a + 7)]
- [+] a [+] [Inc n, Dec (Suc n) 3, Goto (Suc 0)])
- @ [Dec (Suc (Suc n)) 0, Inc (Suc n), Goto (length a + 4)]" in exI,
- auto)
-apply(simp add: abc_append_commute)
-done
-
-lemma [intro]:
- "\<lbrakk>rec_ci (Pr n f g) = (aprog, rs_pos, a_md);
- rec_ci g = (a, aa, ba);
- rec_ci f = (ab, ac, bc)\<rbrakk> \<Longrightarrow>
- \<exists>ap. (\<exists>cp. aprog = ap [+] recursive.empty n (Suc n) [+] cp)
- \<and> length ap = 3 + length ab"
-apply(simp add: rec_ci.simps)
-apply(rule_tac x = "recursive.empty n (max (n + 3)
- (max bc ba)) [+] ab" in exI, simp)
-apply(rule_tac x = "([Dec (max (n + 3) (max bc ba))
- (length a + 7)] [+] a [+]
- [Inc n, Dec (Suc n) 3, Goto (Suc 0)]) @
- [Dec (Suc (Suc n)) 0, Inc (Suc n), Goto (length a + 4)]" in exI)
-apply(auto simp: abc_append_commute)
-done
-
-(*
-lemma [simp]:
- "n - Suc 0 < Suc (max (Suc (Suc n)) (max bc ba) + length suf_lm) \<and>
- Suc n < max (Suc (Suc n)) (max bc ba) + length suf_lm \<and>
- bc < Suc (max (Suc (Suc n)) (max bc ba) + length suf_lm) \<and>
- ba < Suc (max (Suc (Suc n)) (max bc ba) + length suf_lm)"
-by arith
-*)
-
-lemma [intro]:
- "\<lbrakk>rec_ci (Pr n f g) = (aprog, rs_pos, a_md);
- rec_ci g = (a, aa, ba);
- rec_ci f = (ab, ac, bc)\<rbrakk>
- \<Longrightarrow> \<exists>ap. (\<exists>cp. aprog = ap [+] ([Dec (a_md - Suc 0) (length a + 7)]
- [+] (a [+] [Inc (rs_pos - Suc 0), Dec rs_pos 3,
- Goto (Suc 0)])) @ [Dec (Suc (Suc n)) 0, Inc (Suc n),
- Goto (length a + 4)] [+] cp) \<and>
- length ap = 6 + length ab"
-apply(simp add: rec_ci.simps)
-apply(rule_tac x = "recursive.empty n
- (max (n + 3) (max bc ba)) [+] ab [+]
- recursive.empty n (Suc n)" in exI, simp)
-apply(rule_tac x = "[]" in exI, auto)
-apply(simp add: abc_append_commute)
-done
-
-(*
-lemma [simp]: "\<lbrakk>rs_pos = n; 0 < rs_pos ; Suc rs_pos < a_md\<rbrakk> \<Longrightarrow>
- n - Suc 0 < Suc (Suc (a_md + length suf_lm - 2)) \<and>
- n < Suc (Suc (a_md + length suf_lm - 2))"
-by arith
-*)
-
-lemma [simp]:
- "n < Suc (max (n + 3) (max bc ba) + length suf_lm) \<and>
- Suc (Suc n) < max (n + 3) (max bc ba) + length suf_lm \<and>
- bc < Suc (max (n + 3) (max bc ba) + length suf_lm) \<and>
- ba < Suc (max (n + 3) (max bc ba) + length suf_lm)"
-by arith
-
-lemma [simp]: "n \<noteq> max (n + (3::nat)) (max bc ba)"
-by arith
-
-lemma [simp]:"length lm = Suc n \<Longrightarrow> lm[n := (0::nat)] = butlast lm @ [0]"
-apply(subgoal_tac "\<exists> xs x. lm = xs @ [x]", auto simp: list_update_append)
-apply(rule_tac x = "butlast lm" in exI, rule_tac x = "last lm" in exI)
-apply(case_tac lm, auto)
-done
-
-lemma [simp]: "length lm = Suc n \<Longrightarrow> lm ! n =last lm"
-apply(subgoal_tac "lm \<noteq> []")
-apply(simp add: last_conv_nth, case_tac lm, simp_all)
-done
-
-lemma [simp]: "length lm = Suc n \<Longrightarrow>
- (lm @ (0::nat)\<^bsup>max (n + 3) (max bc ba) - n\<^esup> @ suf_lm)
- [max (n + 3) (max bc ba) := (lm @ 0\<^bsup>max (n + 3) (max bc ba) - n\<^esup> @ suf_lm) ! n +
- (lm @ 0\<^bsup>max (n + 3) (max bc ba) - n\<^esup> @ suf_lm) ! max (n + 3) (max bc ba), n := 0]
- = butlast lm @ 0 # 0\<^bsup>max (n + 3) (max bc ba) - Suc n\<^esup> @ last lm # suf_lm"
-apply(auto simp: list_update_append nth_append)
-apply(subgoal_tac "(0\<^bsup>max (n + 3) (max bc ba) - n\<^esup>) = 0\<^bsup>max (n + 3) (max bc ba) - Suc n\<^esup> @ [0::nat]")
-apply(simp add: list_update_append)
-apply(simp add: exp_suc_iff)
-done
-
-lemma [simp]: "Suc (Suc n) < a_md \<Longrightarrow>
- n < Suc (Suc (a_md + length suf_lm - 2)) \<and>
- n < Suc (a_md + length suf_lm - 2)"
-by(arith)
-
-lemma [simp]: "\<lbrakk>length lm = Suc n; Suc (Suc n) < a_md\<rbrakk>
- \<Longrightarrow>(butlast lm @ (rsa::nat) # 0\<^bsup>a_md - Suc (Suc n)\<^esup> @ last lm # suf_lm)
- [Suc n := (butlast lm @ rsa # 0\<^bsup>a_md - Suc (Suc n)\<^esup> @ last lm # suf_lm) ! n +
- (butlast lm @ rsa # 0\<^bsup>a_md - Suc (Suc n)\<^esup> @ last lm # suf_lm) ! Suc n, n := 0]
- = butlast lm @ 0 # rsa # 0\<^bsup>a_md - Suc (Suc (Suc n))\<^esup> @ last lm # suf_lm"
-apply(auto simp: list_update_append)
-apply(subgoal_tac "(0\<^bsup>a_md - Suc (Suc n)\<^esup>) = (0::nat) # (0\<^bsup>a_md - Suc (Suc (Suc n))\<^esup>)", simp add: nth_append)
-apply(simp add: exp_ind_def[THEN sym])
-done
-
-lemma pr_case:
- assumes nf_ind:
- "\<And> lm rs suf_lm. rec_calc_rel f lm rs \<Longrightarrow>
- \<exists>stp. abc_steps_l (0, lm @ 0\<^bsup>bc - ac\<^esup> @ suf_lm) ab stp =
- (length ab, lm @ rs # 0\<^bsup>bc - Suc ac\<^esup> @ suf_lm)"
- and ng_ind: "\<And> lm rs suf_lm. rec_calc_rel g lm rs \<Longrightarrow>
- \<exists>stp. abc_steps_l (0, lm @ 0\<^bsup>ba - aa\<^esup> @ suf_lm) a stp =
- (length a, lm @ rs # 0\<^bsup>ba - Suc aa\<^esup> @ suf_lm)"
- and h: "rec_ci (Pr n f g) = (aprog, rs_pos, a_md)" "rec_calc_rel (Pr n f g) lm rs"
- "rec_ci g = (a, aa, ba)" "rec_ci f = (ab, ac, bc)"
- shows "\<exists>stp. abc_steps_l (0, lm @ 0\<^bsup>a_md - rs_pos\<^esup> @ suf_lm) aprog stp = (length aprog, lm @ rs # 0\<^bsup>a_md - Suc rs_pos\<^esup> @ suf_lm)"
-proof -
- from h have k1: "\<exists> stp. abc_steps_l (0, lm @ 0\<^bsup>a_md - rs_pos\<^esup> @ suf_lm) aprog stp
- = (3, butlast lm @ 0 # 0\<^bsup>a_md - rs_pos - 1\<^esup> @ last lm # suf_lm)"
- proof -
- have "\<exists>bp cp. aprog = bp [+] cp \<and> bp = empty n
- (max (n + 3) (max bc ba))"
- apply(insert h, simp)
- apply(erule pr_prog_ex, auto)
- done
- thus "?thesis"
- apply(erule_tac exE, erule_tac exE, simp)
- apply(subgoal_tac
- "\<exists>stp. abc_steps_l (0, lm @ 0\<^bsup>a_md - rs_pos\<^esup> @ suf_lm)
- ([] [+] recursive.empty n
- (max (n + 3) (max bc ba)) [+] cp) stp =
- (0 + 3, butlast lm @ 0 # 0\<^bsup>a_md - Suc rs_pos\<^esup> @
- last lm # suf_lm)", simp)
- apply(rule_tac abc_append_exc1, simp_all)
- apply(insert empty_ex[of "n" "(max (n + 3)
- (max bc ba))" "lm @ 0\<^bsup>a_md - rs_pos\<^esup> @ suf_lm"], simp)
- apply(subgoal_tac "a_md = Suc (max (n + 3) (max bc ba))",
- simp)
- apply(subgoal_tac "length lm = Suc n \<and> rs_pos = Suc n", simp)
- apply(insert h)
- apply(simp add: para_pattern ci_pr_para_eq)
- apply(rule ci_pr_md_def, auto)
- done
- qed
- from h have k2:
- "\<exists> stp. abc_steps_l (3, butlast lm @ 0 # 0\<^bsup>a_md - rs_pos - 1\<^esup> @
- last lm # suf_lm) aprog stp
- = (length aprog, lm @ rs # 0\<^bsup>a_md - Suc rs_pos\<^esup> @ suf_lm)"
- proof -
- from h have k2_1: "\<exists> rs. rec_calc_rel f (butlast lm) rs"
- apply(erule_tac calc_pr_zero_ex)
- done
- thus "?thesis"
- proof(erule_tac exE)
- fix rsa
- assume k2_2: "rec_calc_rel f (butlast lm) rsa"
- from h and k2_2 have k2_2_1:
- "\<exists> stp. abc_steps_l (3, butlast lm @ 0 # 0\<^bsup>a_md - rs_pos - 1\<^esup>
- @ last lm # suf_lm) aprog stp
- = (3 + length ab, butlast lm @ rsa # 0\<^bsup>a_md - rs_pos - 1\<^esup> @
- last lm # suf_lm)"
- proof -
- from h have j1: "
- \<exists> ap bp cp. aprog = ap [+] bp [+] cp \<and> length ap = 3 \<and>
- bp = ab"
- apply(auto)
- done
- from h have j2: "ac = rs_pos - 1"
- apply(drule_tac ci_pr_f_paras, simp, auto)
- done
- from h and j2 have j3: "a_md \<ge> Suc bc \<and> rs_pos > 0 \<and> bc \<ge> rs_pos"
- apply(rule_tac conjI)
- apply(erule_tac ab = ab and ac = ac in ci_pr_md_ge_f, simp)
- apply(rule_tac context_conjI)
- apply(simp_all add: rec_ci.simps)
- apply(drule_tac ci_ad_ge_paras, drule_tac ci_ad_ge_paras)
- apply(arith)
- done
- from j1 and j2 show "?thesis"
- apply(auto simp del: abc_append_commute)
- apply(rule_tac abc_append_exc1, simp_all)
- apply(insert nf_ind[of "butlast lm" "rsa"
- "0\<^bsup>a_md - bc - Suc 0\<^esup> @ last lm # suf_lm"],
- simp add: k2_2 j2, erule_tac exE)
- apply(simp add: exponent_add_iff j3)
- apply(rule_tac x = "stp" in exI, simp)
- done
- qed
- from h have k2_2_2:
- "\<exists> stp. abc_steps_l (3 + length ab, butlast lm @ rsa #
- 0\<^bsup>a_md - rs_pos - 1\<^esup> @ last lm # suf_lm) aprog stp
- = (6 + length ab, butlast lm @ 0 # rsa #
- 0\<^bsup>a_md - rs_pos - 2\<^esup> @ last lm # suf_lm)"
- proof -
- from h have "\<exists> ap bp cp. aprog = ap [+] bp [+] cp \<and>
- length ap = 3 + length ab \<and> bp = recursive.empty n (Suc n)"
- by auto
- thus "?thesis"
- proof(erule_tac exE, erule_tac exE, erule_tac exE,
- erule_tac exE)
- fix ap cp bp apa
- assume "aprog = ap [+] bp [+] cp \<and> length ap = 3 +
- length ab \<and> bp = recursive.empty n (Suc n)"
- thus "?thesis"
- apply(simp del: abc_append_commute)
- apply(subgoal_tac
- "\<exists>stp. abc_steps_l (3 + length ab,
- butlast lm @ rsa # 0\<^bsup>a_md - Suc rs_pos\<^esup> @
- last lm # suf_lm) (ap [+]
- recursive.empty n (Suc n) [+] cp) stp =
- ((3 + length ab) + 3, butlast lm @ 0 # rsa #
- 0\<^bsup>a_md - Suc (Suc rs_pos)\<^esup> @ last lm # suf_lm)", simp)
- apply(rule_tac abc_append_exc1, simp_all)
- apply(insert empty_ex[of n "Suc n"
- "butlast lm @ rsa # 0\<^bsup>a_md - Suc rs_pos\<^esup> @
- last lm # suf_lm"], simp)
- apply(subgoal_tac "length lm = Suc n \<and> rs_pos = Suc n \<and> a_md > Suc (Suc n)", simp)
- apply(insert h, simp)
- done
- qed
- qed
- from h have k2_3: "lm \<noteq> []"
- apply(rule_tac calc_pr_para_not_null, simp)
- done
- from h and k2_2 and k2_3 have k2_2_3:
- "\<exists> stp. abc_steps_l (6 + length ab, butlast lm @
- (last lm - last lm) # rsa #
- 0\<^bsup>a_md - (Suc (Suc rs_pos))\<^esup> @ last lm # suf_lm) aprog stp
- = (6 + length ab, butlast lm @ last lm # rs #
- 0\<^bsup>a_md - Suc (Suc (rs_pos))\<^esup> @ 0 # suf_lm)"
- apply(rule_tac x = "last lm" and g = g in pr_cycle_part, auto)
- apply(rule_tac ng_ind, simp)
- apply(rule_tac rec_calc_rel_def0, simp, simp)
- done
- from h have k2_2_4:
- "\<exists> stp. abc_steps_l (6 + length ab,
- butlast lm @ last lm # rs # 0\<^bsup>a_md - rs_pos - 2\<^esup> @
- 0 # suf_lm) aprog stp
- = (13 + length ab + length a,
- lm @ rs # 0\<^bsup>a_md - rs_pos - 1\<^esup> @ suf_lm)"
- proof -
- from h have
- "\<exists> ap bp cp. aprog = ap [+] bp [+] cp \<and>
- length ap = 6 + length ab \<and>
- bp = ([Dec (a_md - Suc 0) (length a + 7)] [+]
- (a [+] [Inc (rs_pos - Suc 0),
- Dec rs_pos 3, Goto (Suc 0)])) @
- [Dec (Suc (Suc n)) 0, Inc (Suc n), Goto (length a + 4)]"
- by auto
- thus "?thesis"
- apply(auto)
- apply(subgoal_tac
- "\<exists>stp. abc_steps_l (6 + length ab, butlast lm @
- last lm # rs # 0\<^bsup>a_md - Suc (Suc rs_pos)\<^esup> @ 0 # suf_lm)
- (ap [+] ([Dec (a_md - Suc 0) (length a + 7)] [+]
- (a [+] [Inc (rs_pos - Suc 0), Dec rs_pos 3,
- Goto (Suc 0)])) @ [Dec (Suc (Suc n)) 0, Inc (Suc n),
- Goto (length a + 4)] [+] cp) stp =
- (6 + length ab + (length a + 7) ,
- lm @ rs # 0\<^bsup>a_md - Suc rs_pos\<^esup> @ suf_lm)", simp)
- apply(subgoal_tac "13 + (length ab + length a) =
- 13 + length ab + length a", simp)
- apply(arith)
- apply(rule abc_append_exc1, simp_all)
- apply(rule_tac x = "Suc 0" in exI,
- simp add: abc_steps_l.simps abc_fetch.simps
- nth_append abc_append_nth abc_step_l.simps)
- apply(subgoal_tac "a_md > Suc (Suc rs_pos) \<and>
- length lm = rs_pos \<and> rs_pos > 0", simp)
- apply(insert h, simp)
- apply(subgoal_tac "rs_pos = Suc n", simp, simp)
- done
- qed
- from h have k2_2_5: "length aprog = 13 + length ab + length a"
- apply(rule_tac ci_pr_length, simp_all)
- done
- from k2_2_1 and k2_2_2 and k2_2_3 and k2_2_4 and k2_2_5
- show "?thesis"
- apply(auto)
- apply(rule_tac x = "stp + stpa + stpb + stpc" in exI,
- simp add: abc_steps_add)
- done
- qed
- qed
- from k1 and k2 show
- "\<exists>stp. abc_steps_l (0, lm @ 0\<^bsup>a_md - rs_pos\<^esup> @ suf_lm) aprog stp
- = (length aprog, lm @ rs # 0\<^bsup>a_md - Suc rs_pos\<^esup> @ suf_lm)"
- apply(erule_tac exE)
- apply(erule_tac exE)
- apply(rule_tac x = "stp + stpa" in exI)
- apply(simp add: abc_steps_add)
- done
-qed
-
-thm rec_calc_rel.induct
-
-lemma eq_switch: "x = y \<Longrightarrow> y = x"
-by simp
-
-lemma [simp]:
- "\<lbrakk>rec_ci f = (a, aa, ba);
- rec_ci (Mn n f) = (aprog, rs_pos, a_md)\<rbrakk> \<Longrightarrow> \<exists>bp. aprog = a @ bp"
-apply(simp add: rec_ci.simps)
-apply(rule_tac x = "[Dec (Suc n) (length a + 5),
- Dec (Suc n) (length a + 3), Goto (Suc (length a)),
- Inc n, Goto 0]" in exI, auto)
-done
-
-lemma ci_mn_para_eq[simp]:
- "rec_ci (Mn n f) = (aprog, rs_pos, a_md) \<Longrightarrow> rs_pos = n"
-apply(case_tac "rec_ci f", simp add: rec_ci.simps)
-done
-(*
-lemma [simp]: "\<lbrakk>rec_ci f = (a, aa, ba); rec_ci (Mn n f) = (aprog, rs_pos, a_md); rec_calc_rel (Mn n f) lm rs\<rbrakk> \<Longrightarrow> aa = Suc rs_pos"
-apply(rule_tac calc_mn_reverse, simp)
-apply(insert para_pattern [of f a aa ba "lm @ [rs]" 0], simp)
-apply(subgoal_tac "rs_pos = length lm", simp)
-apply(drule_tac ci_mn_para_eq, simp)
-done
-*)
-lemma [simp]: "rec_ci f = (a, aa, ba) \<Longrightarrow> aa < ba"
-apply(simp add: ci_ad_ge_paras)
-done
-
-lemma [simp]: "\<lbrakk>rec_ci f = (a, aa, ba);
- rec_ci (Mn n f) = (aprog, rs_pos, a_md)\<rbrakk>
- \<Longrightarrow> ba \<le> a_md"
-apply(simp add: rec_ci.simps)
-by arith
-
-lemma mn_calc_f:
- assumes ind:
- "\<And>aprog a_md rs_pos rs suf_lm lm.
- \<lbrakk>rec_ci f = (aprog, rs_pos, a_md); rec_calc_rel f lm rs\<rbrakk>
- \<Longrightarrow> \<exists>stp. abc_steps_l (0, lm @ 0\<^bsup>a_md - rs_pos\<^esup> @ suf_lm) aprog stp
- = (length aprog, lm @ [rs] @ 0\<^bsup>a_md - rs_pos - 1\<^esup> @ suf_lm)"
- and h: "rec_ci f = (a, aa, ba)"
- "rec_ci (Mn n f) = (aprog, rs_pos, a_md)"
- "rec_calc_rel f (lm @ [x]) rsx"
- "aa = Suc n"
- shows "\<exists>stp. abc_steps_l (0, lm @ x # 0\<^bsup>a_md - Suc rs_pos\<^esup> @ suf_lm)
- aprog stp = (length a,
- lm @ x # rsx # 0\<^bsup>a_md - Suc (Suc rs_pos)\<^esup> @ suf_lm)"
-proof -
- from h have k1: "\<exists> ap bp. aprog = ap @ bp \<and> ap = a"
- by simp
- from h have k2: "rs_pos = n"
- apply(erule_tac ci_mn_para_eq)
- done
- from h and k1 and k2 show "?thesis"
-
- proof(erule_tac exE, erule_tac exE, simp,
- rule_tac abc_add_exc1, auto)
- fix bp
- show
- "\<exists>astp. abc_steps_l (0, lm @ x # 0\<^bsup>a_md - Suc n\<^esup> @ suf_lm) a astp
- = (length a, lm @ x # rsx # 0\<^bsup>a_md - Suc (Suc n)\<^esup> @ suf_lm)"
- apply(insert ind[of a "Suc n" ba "lm @ [x]" rsx
- "0\<^bsup>a_md - ba\<^esup> @ suf_lm"], simp add: exponent_add_iff h k2)
- apply(subgoal_tac "ba > aa \<and> a_md \<ge> ba \<and> aa = Suc n",
- insert h, auto)
- done
- qed
-qed
-thm rec_ci.simps
-
-fun mn_ind_inv ::
- "nat \<times> nat list \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat list \<Rightarrow> nat list \<Rightarrow> bool"
- where
- "mn_ind_inv (as, lm') ss x rsx suf_lm lm =
- (if as = ss then lm' = lm @ x # rsx # suf_lm
- else if as = ss + 1 then
- \<exists>y. (lm' = lm @ x # y # suf_lm) \<and> y \<le> rsx
- else if as = ss + 2 then
- \<exists>y. (lm' = lm @ x # y # suf_lm) \<and> y \<le> rsx
- else if as = ss + 3 then lm' = lm @ x # 0 # suf_lm
- else if as = ss + 4 then lm' = lm @ Suc x # 0 # suf_lm
- else if as = 0 then lm' = lm @ Suc x # 0 # suf_lm
- else False
-)"
-
-fun mn_stage1 :: "nat \<times> nat list \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat"
- where
- "mn_stage1 (as, lm) ss n =
- (if as = 0 then 0
- else if as = ss + 4 then 1
- else if as = ss + 3 then 2
- else if as = ss + 2 \<or> as = ss + 1 then 3
- else if as = ss then 4
- else 0
-)"
-
-fun mn_stage2 :: "nat \<times> nat list \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat"
- where
- "mn_stage2 (as, lm) ss n =
- (if as = ss + 1 \<or> as = ss + 2 then (lm ! (Suc n))
- else 0)"
-
-fun mn_stage3 :: "nat \<times> nat list \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat"
- where
- "mn_stage3 (as, lm) ss n = (if as = ss + 2 then 1 else 0)"
-
-
-fun mn_measure :: "((nat \<times> nat list) \<times> nat \<times> nat) \<Rightarrow>
- (nat \<times> nat \<times> nat)"
- where
- "mn_measure ((as, lm), ss, n) =
- (mn_stage1 (as, lm) ss n, mn_stage2 (as, lm) ss n,
- mn_stage3 (as, lm) ss n)"
-
-definition mn_LE :: "(((nat \<times> nat list) \<times> nat \<times> nat) \<times>
- ((nat \<times> nat list) \<times> nat \<times> nat)) set"
- where "mn_LE \<equiv> (inv_image lex_triple mn_measure)"
-
-thm halt_lemma2
-lemma wf_mn_le[intro]: "wf mn_LE"
-by(auto intro:wf_inv_image wf_lex_triple simp: mn_LE_def)
-
-declare mn_ind_inv.simps[simp del]
-
-lemma mn_inv_init:
- "mn_ind_inv (abc_steps_l (length a, lm @ x # rsx # suf_lm) aprog 0)
- (length a) x rsx suf_lm lm"
-apply(simp add: mn_ind_inv.simps abc_steps_zero)
-done
-
-lemma mn_halt_init:
- "rec_ci f = (a, aa, ba) \<Longrightarrow>
- \<not> (\<lambda>(as, lm') (ss, n). as = 0)
- (abc_steps_l (length a, lm @ x # rsx # suf_lm) aprog 0)
- (length a, n)"
-apply(simp add: abc_steps_zero)
-apply(erule_tac rec_ci_not_null)
-done
-
-thm rec_ci.simps
-lemma [simp]:
- "\<lbrakk>rec_ci f = (a, aa, ba);
- rec_ci (Mn n f) = (aprog, rs_pos, a_md)\<rbrakk>
- \<Longrightarrow> abc_fetch (length a) aprog =
- Some (Dec (Suc n) (length a + 5))"
-apply(simp add: rec_ci.simps abc_fetch.simps,
- erule_tac conjE, erule_tac conjE, simp)
-apply(drule_tac eq_switch, drule_tac eq_switch, simp)
-done
-
-lemma [simp]: "\<lbrakk>rec_ci f = (a, aa, ba); rec_ci (Mn n f) = (aprog, rs_pos, a_md)\<rbrakk>
- \<Longrightarrow> abc_fetch (Suc (length a)) aprog = Some (Dec (Suc n) (length a + 3))"
-apply(simp add: rec_ci.simps abc_fetch.simps, erule_tac conjE, erule_tac conjE, simp)
-apply(drule_tac eq_switch, drule_tac eq_switch, simp add: nth_append)
-done
-
-lemma [simp]:
- "\<lbrakk>rec_ci f = (a, aa, ba);
- rec_ci (Mn n f) = (aprog, rs_pos, a_md)\<rbrakk>
- \<Longrightarrow> abc_fetch (Suc (Suc (length a))) aprog =
- Some (Goto (length a + 1))"
-apply(simp add: rec_ci.simps abc_fetch.simps,
- erule_tac conjE, erule_tac conjE, simp)
-apply(drule_tac eq_switch, drule_tac eq_switch, simp add: nth_append)
-done
-
-lemma [simp]:
- "\<lbrakk>rec_ci f = (a, aa, ba);
- rec_ci (Mn n f) = (aprog, rs_pos, a_md)\<rbrakk>
- \<Longrightarrow> abc_fetch (length a + 3) aprog = Some (Inc n)"
-apply(simp add: rec_ci.simps abc_fetch.simps,
- erule_tac conjE, erule_tac conjE, simp)
-apply(drule_tac eq_switch, drule_tac eq_switch, simp add: nth_append)
-done
-
-lemma [simp]: "\<lbrakk>rec_ci f = (a, aa, ba); rec_ci (Mn n f) = (aprog, rs_pos, a_md)\<rbrakk>
- \<Longrightarrow> abc_fetch (length a + 4) aprog = Some (Goto 0)"
-apply(simp add: rec_ci.simps abc_fetch.simps, erule_tac conjE, erule_tac conjE, simp)
-apply(drule_tac eq_switch, drule_tac eq_switch, simp add: nth_append)
-done
-
-lemma [simp]:
- "0 < rsx
- \<Longrightarrow> \<exists>y. (lm @ x # rsx # suf_lm)[Suc (length lm) := rsx - Suc 0]
- = lm @ x # y # suf_lm \<and> y \<le> rsx"
-apply(case_tac rsx, simp, simp)
-apply(rule_tac x = nat in exI, simp add: list_update_append)
-done
-
-lemma [simp]:
- "\<lbrakk>y \<le> rsx; 0 < y\<rbrakk>
- \<Longrightarrow> \<exists>ya. (lm @ x # y # suf_lm)[Suc (length lm) := y - Suc 0]
- = lm @ x # ya # suf_lm \<and> ya \<le> rsx"
-apply(case_tac y, simp, simp)
-apply(rule_tac x = nat in exI, simp add: list_update_append)
-done
-
-lemma mn_halt_lemma:
- "\<lbrakk>rec_ci f = (a, aa, ba);
- rec_ci (Mn n f) = (aprog, rs_pos, a_md);
- 0 < rsx; length lm = n\<rbrakk>
- \<Longrightarrow>
- \<forall>na. \<not> (\<lambda>(as, lm') (ss, n). as = 0)
- (abc_steps_l (length a, lm @ x # rsx # suf_lm) aprog na)
- (length a, n)
- \<and> mn_ind_inv (abc_steps_l (length a, lm @ x # rsx # suf_lm)
- aprog na) (length a) x rsx suf_lm lm
-\<longrightarrow> mn_ind_inv (abc_steps_l (length a, lm @ x # rsx # suf_lm) aprog
- (Suc na)) (length a) x rsx suf_lm lm
- \<and> ((abc_steps_l (length a, lm @ x # rsx # suf_lm) aprog (Suc na),
- length a, n),
- abc_steps_l (length a, lm @ x # rsx # suf_lm) aprog na,
- length a, n) \<in> mn_LE"
-apply(rule allI, rule impI, simp add: abc_steps_ind)
-apply(case_tac "(abc_steps_l (length a, lm @ x # rsx # suf_lm)
- aprog na)", simp)
-apply(auto split:if_splits simp add:abc_steps_l.simps
- mn_ind_inv.simps abc_steps_zero)
-apply(auto simp add: mn_LE_def lex_triple_def lex_pair_def
- abc_step_l.simps abc_steps_l.simps mn_ind_inv.simps
- abc_lm_v.simps abc_lm_s.simps nth_append
- split: if_splits)
-apply(drule_tac rec_ci_not_null, simp)
-done
-
-lemma mn_halt:
- "\<lbrakk>rec_ci f = (a, aa, ba);
- rec_ci (Mn n f) = (aprog, rs_pos, a_md);
- 0 < rsx; length lm = n\<rbrakk>
- \<Longrightarrow> \<exists> stp. (\<lambda> (as, lm'). (as = 0 \<and>
- mn_ind_inv (as, lm') (length a) x rsx suf_lm lm))
- (abc_steps_l (length a, lm @ x # rsx # suf_lm) aprog stp)"
-apply(insert wf_mn_le)
-apply(insert halt_lemma2[of mn_LE
- "\<lambda> ((as, lm'), ss, n). as = 0"
- "\<lambda> stp. (abc_steps_l (length a, lm @ x # rsx # suf_lm) aprog stp,
- length a, n)"
- "\<lambda> ((as, lm'), ss, n). mn_ind_inv (as, lm') ss x rsx suf_lm lm"],
- simp)
-apply(simp add: mn_halt_init mn_inv_init)
-apply(drule_tac x = x and suf_lm = suf_lm in mn_halt_lemma, auto)
-apply(rule_tac x = n in exI,
- case_tac "(abc_steps_l (length a, lm @ x # rsx # suf_lm)
- aprog n)", simp)
-done
-
-lemma [simp]: "Suc rs_pos < a_md \<Longrightarrow>
- Suc (a_md - Suc (Suc rs_pos)) = a_md - Suc rs_pos"
-by arith
-
-term rec_ci
-(*
-lemma [simp]: "\<lbrakk>rec_ci (Mn n f) = (aprog, rs_pos, a_md); rec_calc_rel (Mn n f) lm rs\<rbrakk> \<Longrightarrow> Suc rs_pos < a_md"
-apply(case_tac "rec_ci f")
-apply(subgoal_tac "c > b \<and> b = Suc rs_pos \<and> a_md \<ge> c")
-apply(arith, auto)
-done
-*)
-lemma mn_ind_step:
- assumes ind:
- "\<And>aprog a_md rs_pos rs suf_lm lm.
- \<lbrakk>rec_ci f = (aprog, rs_pos, a_md);
- rec_calc_rel f lm rs\<rbrakk> \<Longrightarrow>
- \<exists>stp. abc_steps_l (0, lm @ 0\<^bsup>a_md - rs_pos\<^esup> @ suf_lm) aprog stp
- = (length aprog, lm @ [rs] @ 0\<^bsup>a_md - rs_pos - 1\<^esup> @ suf_lm)"
- and h: "rec_ci f = (a, aa, ba)"
- "rec_ci (Mn n f) = (aprog, rs_pos, a_md)"
- "rec_calc_rel f (lm @ [x]) rsx"
- "rsx > 0"
- "Suc rs_pos < a_md"
- "aa = Suc rs_pos"
- shows "\<exists>stp. abc_steps_l (0, lm @ x # 0\<^bsup>a_md - Suc rs_pos\<^esup> @ suf_lm)
- aprog stp = (0, lm @ Suc x # 0\<^bsup>a_md - Suc rs_pos\<^esup> @ suf_lm)"
-thm abc_add_exc1
-proof -
- have k1:
- "\<exists> stp. abc_steps_l (0, lm @ x # 0\<^bsup>a_md - Suc (rs_pos)\<^esup> @ suf_lm)
- aprog stp =
- (length a, lm @ x # rsx # 0\<^bsup>a_md - Suc (Suc rs_pos) \<^esup>@ suf_lm)"
- apply(insert h)
- apply(auto intro: mn_calc_f ind)
- done
- from h have k2: "length lm = n"
- apply(subgoal_tac "rs_pos = n")
- apply(drule_tac para_pattern, simp, simp, simp)
- done
- from h have k3: "a_md > (Suc rs_pos)"
- apply(simp)
- done
- from k2 and h and k3 have k4:
- "\<exists> stp. abc_steps_l (length a,
- lm @ x # rsx # 0\<^bsup>a_md - Suc (Suc rs_pos) \<^esup>@ suf_lm) aprog stp =
- (0, lm @ Suc x # 0\<^bsup>a_md - rs_pos - 1\<^esup> @ suf_lm)"
- apply(frule_tac x = x and
- suf_lm = "0\<^bsup>a_md - Suc (Suc rs_pos)\<^esup> @ suf_lm" in mn_halt, auto)
- apply(rule_tac x = "stp" in exI,
- simp add: mn_ind_inv.simps rec_ci_not_null exponent_def)
- apply(simp only: replicate.simps[THEN sym], simp)
- done
-
- from k1 and k4 show "?thesis"
- apply(auto)
- apply(rule_tac x = "stp + stpa" in exI, simp add: abc_steps_add)
- done
-qed
-
-lemma [simp]:
- "\<lbrakk>rec_ci f = (a, aa, ba); rec_ci (Mn n f) = (aprog, rs_pos, a_md);
- rec_calc_rel (Mn n f) lm rs\<rbrakk> \<Longrightarrow> aa = Suc rs_pos"
-apply(rule_tac calc_mn_reverse, simp)
-apply(insert para_pattern [of f a aa ba "lm @ [rs]" 0], simp)
-apply(subgoal_tac "rs_pos = length lm", simp)
-apply(drule_tac ci_mn_para_eq, simp)
-done
-
-lemma [simp]: "\<lbrakk>rec_ci (Mn n f) = (aprog, rs_pos, a_md);
- rec_calc_rel (Mn n f) lm rs\<rbrakk> \<Longrightarrow> Suc rs_pos < a_md"
-apply(case_tac "rec_ci f")
-apply(subgoal_tac "c > b \<and> b = Suc rs_pos \<and> a_md \<ge> c")
-apply(arith, auto)
-done
-
-lemma mn_ind_steps:
- assumes ind:
- "\<And>aprog a_md rs_pos rs suf_lm lm.
- \<lbrakk>rec_ci f = (aprog, rs_pos, a_md); rec_calc_rel f lm rs\<rbrakk> \<Longrightarrow>
- \<exists>stp. abc_steps_l (0, lm @ 0\<^bsup>a_md - rs_pos\<^esup> @ suf_lm) aprog stp =
- (length aprog, lm @ [rs] @ 0\<^bsup>a_md - rs_pos - 1\<^esup> @ suf_lm)"
- and h: "rec_ci f = (a, aa, ba)"
- "rec_ci (Mn n f) = (aprog, rs_pos, a_md)"
- "rec_calc_rel (Mn n f) lm rs"
- "rec_calc_rel f (lm @ [rs]) 0"
- "\<forall>x<rs. (\<exists> v. rec_calc_rel f (lm @ [x]) v \<and> 0 < v)"
- "n = length lm"
- "x \<le> rs"
- shows "\<exists>stp. abc_steps_l (0, lm @ 0 # 0\<^bsup>a_md - Suc rs_pos\<^esup> @ suf_lm)
- aprog stp = (0, lm @ x # 0\<^bsup>a_md - Suc rs_pos\<^esup> @ suf_lm)"
-apply(insert h, induct x,
- rule_tac x = 0 in exI, simp add: abc_steps_zero, simp)
-proof -
- fix x
- assume k1:
- "\<exists>stp. abc_steps_l (0, lm @ 0 # 0\<^bsup>a_md - Suc rs_pos\<^esup> @ suf_lm)
- aprog stp = (0, lm @ x # 0\<^bsup>a_md - Suc rs_pos\<^esup> @ suf_lm)"
- and k2: "rec_ci (Mn (length lm) f) = (aprog, rs_pos, a_md)"
- "rec_calc_rel (Mn (length lm) f) lm rs"
- "rec_calc_rel f (lm @ [rs]) 0"
- "\<forall>x<rs.(\<exists> v. rec_calc_rel f (lm @ [x]) v \<and> v > 0)"
- "n = length lm"
- "Suc x \<le> rs"
- "rec_ci f = (a, aa, ba)"
- hence k2:
- "\<exists>stp. abc_steps_l (0, lm @ x # 0\<^bsup>a_md - rs_pos - 1\<^esup> @ suf_lm) aprog
- stp = (0, lm @ Suc x # 0\<^bsup>a_md - rs_pos - 1\<^esup> @ suf_lm)"
- apply(erule_tac x = x in allE)
- apply(auto)
- apply(rule_tac x = x in mn_ind_step)
- apply(rule_tac ind, auto)
- done
- from k1 and k2 show
- "\<exists>stp. abc_steps_l (0, lm @ 0 # 0\<^bsup>a_md - Suc rs_pos\<^esup> @ suf_lm)
- aprog stp = (0, lm @ Suc x # 0\<^bsup>a_md - Suc rs_pos\<^esup> @ suf_lm)"
- apply(auto)
- apply(rule_tac x = "stp + stpa" in exI, simp only: abc_steps_add)
- done
-qed
-
-lemma [simp]:
-"\<lbrakk>rec_ci f = (a, aa, ba);
- rec_ci (Mn n f) = (aprog, rs_pos, a_md);
- rec_calc_rel (Mn n f) lm rs;
- length lm = n\<rbrakk>
- \<Longrightarrow> abc_lm_v (lm @ rs # 0\<^bsup>a_md - Suc rs_pos\<^esup> @ suf_lm) (Suc n) = 0"
-apply(auto simp: abc_lm_v.simps nth_append)
-done
-
-lemma [simp]:
- "\<lbrakk>rec_ci f = (a, aa, ba);
- rec_ci (Mn n f) = (aprog, rs_pos, a_md);
- rec_calc_rel (Mn n f) lm rs;
- length lm = n\<rbrakk>
- \<Longrightarrow> abc_lm_s (lm @ rs # 0\<^bsup>a_md - Suc rs_pos\<^esup> @ suf_lm) (Suc n) 0 =
- lm @ rs # 0\<^bsup>a_md - Suc rs_pos\<^esup> @ suf_lm"
-apply(auto simp: abc_lm_s.simps list_update_append)
-done
-
-lemma mn_length:
- "\<lbrakk>rec_ci f = (a, aa, ba);
- rec_ci (Mn n f) = (aprog, rs_pos, a_md)\<rbrakk>
- \<Longrightarrow> length aprog = length a + 5"
-apply(simp add: rec_ci.simps, erule_tac conjE)
-apply(drule_tac eq_switch, drule_tac eq_switch, simp)
-done
-
-lemma mn_final_step:
- assumes ind:
- "\<And>aprog a_md rs_pos rs suf_lm lm.
- \<lbrakk>rec_ci f = (aprog, rs_pos, a_md);
- rec_calc_rel f lm rs\<rbrakk> \<Longrightarrow>
- \<exists>stp. abc_steps_l (0, lm @ 0\<^bsup>a_md - rs_pos\<^esup> @ suf_lm) aprog stp =
- (length aprog, lm @ [rs] @ 0\<^bsup>a_md - rs_pos - 1\<^esup> @ suf_lm)"
- and h: "rec_ci f = (a, aa, ba)"
- "rec_ci (Mn n f) = (aprog, rs_pos, a_md)"
- "rec_calc_rel (Mn n f) lm rs"
- "rec_calc_rel f (lm @ [rs]) 0"
- shows "\<exists>stp. abc_steps_l (0, lm @ rs # 0\<^bsup>a_md - Suc rs_pos\<^esup> @ suf_lm)
- aprog stp = (length aprog, lm @ rs # 0\<^bsup>a_md - Suc rs_pos\<^esup> @ suf_lm)"
-proof -
- from h and ind have k1:
- "\<exists>stp. abc_steps_l (0, lm @ rs # 0\<^bsup>a_md - Suc rs_pos\<^esup> @ suf_lm)
- aprog stp = (length a, lm @ rs # 0\<^bsup>a_md - Suc rs_pos\<^esup> @ suf_lm)"
- thm mn_calc_f
- apply(insert mn_calc_f[of f a aa ba n aprog
- rs_pos a_md lm rs 0 suf_lm], simp)
- apply(subgoal_tac "aa = Suc n", simp add: exponent_cons_iff)
- apply(subgoal_tac "rs_pos = n", simp, simp)
- done
- from h have k2: "length lm = n"
- apply(subgoal_tac "rs_pos = n")
- apply(drule_tac f = "Mn n f" in para_pattern, simp, simp, simp)
- done
- from h and k2 have k3:
- "\<exists>stp. abc_steps_l (length a, lm @ rs # 0\<^bsup>a_md - Suc rs_pos\<^esup> @ suf_lm)
- aprog stp = (length a + 5, lm @ rs # 0\<^bsup>a_md - Suc rs_pos\<^esup> @ suf_lm)"
- apply(rule_tac x = "Suc 0" in exI,
- simp add: abc_step_l.simps abc_steps_l.simps)
- done
- from h have k4: "length aprog = length a + 5"
- apply(simp add: mn_length)
- done
- from k1 and k3 and k4 show "?thesis"
- apply(auto)
- apply(rule_tac x = "stp + stpa" in exI, simp add: abc_steps_add)
- done
-qed
-
-lemma mn_case:
- assumes ind:
- "\<And>aprog a_md rs_pos rs suf_lm lm.
- \<lbrakk>rec_ci f = (aprog, rs_pos, a_md); rec_calc_rel f lm rs\<rbrakk> \<Longrightarrow>
- \<exists>stp. abc_steps_l (0, lm @ 0\<^bsup>a_md - rs_pos\<^esup> @ suf_lm) aprog stp =
- (length aprog, lm @ [rs] @ 0\<^bsup>a_md - rs_pos - 1\<^esup> @ suf_lm)"
- and h: "rec_ci (Mn n f) = (aprog, rs_pos, a_md)"
- "rec_calc_rel (Mn n f) lm rs"
- shows "\<exists>stp. abc_steps_l (0, lm @ 0\<^bsup>a_md - rs_pos\<^esup> @ suf_lm) aprog stp
- = (length aprog, lm @ [rs] @ 0\<^bsup>a_md - rs_pos - 1\<^esup> @ suf_lm)"
-apply(case_tac "rec_ci f", simp)
-apply(insert h, rule_tac calc_mn_reverse, simp)
-proof -
- fix a b c v
- assume h: "rec_ci f = (a, b, c)"
- "rec_ci (Mn n f) = (aprog, rs_pos, a_md)"
- "rec_calc_rel (Mn n f) lm rs"
- "rec_calc_rel f (lm @ [rs]) 0"
- "\<forall>x<rs. \<exists>v. rec_calc_rel f (lm @ [x]) v \<and> 0 < v"
- "n = length lm"
- hence k1:
- "\<exists>stp. abc_steps_l (0, lm @ 0 # 0\<^bsup>a_md - Suc rs_pos\<^esup> @ suf_lm) aprog
- stp = (0, lm @ rs # 0\<^bsup>a_md - Suc rs_pos\<^esup> @ suf_lm)"
- thm mn_ind_steps
- apply(auto intro: mn_ind_steps ind)
- done
- from h have k2:
- "\<exists>stp. abc_steps_l (0, lm @ rs # 0\<^bsup>a_md - Suc rs_pos\<^esup> @ suf_lm) aprog
- stp = (length aprog, lm @ rs # 0\<^bsup>a_md - Suc rs_pos\<^esup> @ suf_lm)"
- apply(auto intro: mn_final_step ind)
- done
- from k1 and k2 show
- "\<exists>stp. abc_steps_l (0, lm @ 0\<^bsup>a_md - rs_pos\<^esup> @ suf_lm) aprog stp =
- (length aprog, lm @ rs # 0\<^bsup>a_md - Suc rs_pos\<^esup> @ suf_lm)"
- apply(auto, insert h)
- apply(subgoal_tac "Suc rs_pos < a_md")
- apply(rule_tac x = "stp + stpa" in exI,
- simp only: abc_steps_add exponent_cons_iff, simp, simp)
- done
-qed
-
-lemma z_rs: "rec_calc_rel z lm rs \<Longrightarrow> rs = 0"
-apply(rule_tac calc_z_reverse, auto)
-done
-
-lemma z_case:
- "\<lbrakk>rec_ci z = (aprog, rs_pos, a_md); rec_calc_rel z lm rs\<rbrakk>
- \<Longrightarrow> \<exists>stp. abc_steps_l (0, lm @ 0\<^bsup>a_md - rs_pos\<^esup> @ suf_lm) aprog stp =
- (length aprog, lm @ [rs] @ 0\<^bsup>a_md - rs_pos - 1\<^esup> @ suf_lm)"
-apply(simp add: rec_ci.simps rec_ci_z_def, auto)
-apply(rule_tac x = "Suc 0" in exI, simp add: abc_steps_l.simps
- abc_fetch.simps abc_step_l.simps z_rs)
-done
-thm addition.simps
-
-thm addition.simps
-thm rec_ci_s_def
-fun addition_inv :: "nat \<times> nat list \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow>
- nat list \<Rightarrow> bool"
- where
- "addition_inv (as, lm') m n p lm =
- (let sn = lm ! n in
- let sm = lm ! m in
- lm ! p = 0 \<and>
- (if as = 0 then \<exists> x. x \<le> lm ! m \<and> lm' = lm[m := x,
- n := (sn + sm - x), p := (sm - x)]
- else if as = 1 then \<exists> x. x < lm ! m \<and> lm' = lm[m := x,
- n := (sn + sm - x - 1), p := (sm - x - 1)]
- else if as = 2 then \<exists> x. x < lm ! m \<and> lm' = lm[m := x,
- n := (sn + sm - x), p := (sm - x - 1)]
- else if as = 3 then \<exists> x. x < lm ! m \<and> lm' = lm[m := x,
- n := (sn + sm - x), p := (sm - x)]
- else if as = 4 then \<exists> x. x \<le> lm ! m \<and> lm' = lm[m := x,
- n := (sn + sm), p := (sm - x)]
- else if as = 5 then \<exists> x. x < lm ! m \<and> lm' = lm[m := x,
- n := (sn + sm), p := (sm - x - 1)]
- else if as = 6 then \<exists> x. x < lm ! m \<and> lm' =
- lm[m := Suc x, n := (sn + sm), p := (sm - x - 1)]
- else if as = 7 then lm' = lm[m := sm, n := (sn + sm)]
- else False))"
-
-fun addition_stage1 :: "nat \<times> nat list \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat"
- where
- "addition_stage1 (as, lm) m p =
- (if as = 0 \<or> as = 1 \<or> as = 2 \<or> as = 3 then 2
- else if as = 4 \<or> as = 5 \<or> as = 6 then 1
- else 0)"
-
-fun addition_stage2 :: "nat \<times> nat list \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat"
- where
- "addition_stage2 (as, lm) m p =
- (if 0 \<le> as \<and> as \<le> 3 then lm ! m
- else if 4 \<le> as \<and> as \<le> 6 then lm ! p
- else 0)"
-
-fun addition_stage3 :: "nat \<times> nat list \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat"
- where
- "addition_stage3 (as, lm) m p =
- (if as = 1 then 4
- else if as = 2 then 3
- else if as = 3 then 2
- else if as = 0 then 1
- else if as = 5 then 2
- else if as = 6 then 1
- else if as = 4 then 0
- else 0)"
-
-fun addition_measure :: "((nat \<times> nat list) \<times> nat \<times> nat) \<Rightarrow>
- (nat \<times> nat \<times> nat)"
- where
- "addition_measure ((as, lm), m, p) =
- (addition_stage1 (as, lm) m p,
- addition_stage2 (as, lm) m p,
- addition_stage3 (as, lm) m p)"
-
-definition addition_LE :: "(((nat \<times> nat list) \<times> nat \<times> nat) \<times>
- ((nat \<times> nat list) \<times> nat \<times> nat)) set"
- where "addition_LE \<equiv> (inv_image lex_triple addition_measure)"
-
-lemma [simp]: "wf addition_LE"
-by(simp add: wf_inv_image wf_lex_triple addition_LE_def)
-
-declare addition_inv.simps[simp del]
-
-lemma addition_inv_init:
- "\<lbrakk>m \<noteq> n; max m n < p; length lm > p; lm ! p = 0\<rbrakk> \<Longrightarrow>
- addition_inv (0, lm) m n p lm"
-apply(simp add: addition_inv.simps)
-apply(rule_tac x = "lm ! m" in exI, simp)
-done
-
-thm addition.simps
-
-lemma [simp]: "abc_fetch 0 (addition m n p) = Some (Dec m 4)"
-by(simp add: abc_fetch.simps addition.simps)
-
-lemma [simp]: "abc_fetch (Suc 0) (addition m n p) = Some (Inc n)"
-by(simp add: abc_fetch.simps addition.simps)
-
-lemma [simp]: "abc_fetch 2 (addition m n p) = Some (Inc p)"
-by(simp add: abc_fetch.simps addition.simps)
-
-lemma [simp]: "abc_fetch 3 (addition m n p) = Some (Goto 0)"
-by(simp add: abc_fetch.simps addition.simps)
-
-lemma [simp]: "abc_fetch 4 (addition m n p) = Some (Dec p 7)"
-by(simp add: abc_fetch.simps addition.simps)
-
-lemma [simp]: "abc_fetch 5 (addition m n p) = Some (Inc m)"
-by(simp add: abc_fetch.simps addition.simps)
-
-lemma [simp]: "abc_fetch 6 (addition m n p) = Some (Goto 4)"
-by(simp add: abc_fetch.simps addition.simps)
-
-lemma [simp]:
- "\<lbrakk>m \<noteq> n; p < length lm; lm ! p = 0; m < p; n < p; x \<le> lm ! m; 0 < x\<rbrakk>
- \<Longrightarrow> \<exists>xa<lm ! m. lm[m := x, n := lm ! n + lm ! m - x,
- p := lm ! m - x, m := x - Suc 0] =
- lm[m := xa, n := lm ! n + lm ! m - Suc xa,
- p := lm ! m - Suc xa]"
-apply(case_tac x, simp, simp)
-apply(rule_tac x = nat in exI, simp add: list_update_swap
- list_update_overwrite)
-done
-
-lemma [simp]:
- "\<lbrakk>m \<noteq> n; p < length lm; lm ! p = 0; m < p; n < p; x < lm ! m\<rbrakk>
- \<Longrightarrow> \<exists>xa<lm ! m. lm[m := x, n := lm ! n + lm ! m - Suc x,
- p := lm ! m - Suc x, n := lm ! n + lm ! m - x]
- = lm[m := xa, n := lm ! n + lm ! m - xa,
- p := lm ! m - Suc xa]"
-apply(rule_tac x = x in exI,
- simp add: list_update_swap list_update_overwrite)
-done
-
-lemma [simp]:
- "\<lbrakk>m \<noteq> n; p < length lm; lm ! p = 0; m < p; n < p; x < lm ! m\<rbrakk>
- \<Longrightarrow> \<exists>xa<lm ! m. lm[m := x, n := lm ! n + lm ! m - x,
- p := lm ! m - Suc x, p := lm ! m - x]
- = lm[m := xa, n := lm ! n + lm ! m - xa,
- p := lm ! m - xa]"
-apply(rule_tac x = x in exI, simp add: list_update_overwrite)
-done
-
-lemma [simp]:
- "\<lbrakk>m \<noteq> n; p < length lm; lm ! p = (0::nat); m < p; n < p; x < lm ! m\<rbrakk>
- \<Longrightarrow> \<exists>xa\<le>lm ! m. lm[m := x, n := lm ! n + lm ! m - x,
- p := lm ! m - x] =
- lm[m := xa, n := lm ! n + lm ! m - xa,
- p := lm ! m - xa]"
-apply(rule_tac x = x in exI, simp)
-done
-
-lemma [simp]:
- "\<lbrakk>m \<noteq> n; p < length lm; lm ! p = 0; m < p; n < p;
- x \<le> lm ! m; lm ! m \<noteq> x\<rbrakk>
- \<Longrightarrow> \<exists>xa<lm ! m. lm[m := x, n := lm ! n + lm ! m,
- p := lm ! m - x, p := lm ! m - Suc x]
- = lm[m := xa, n := lm ! n + lm ! m,
- p := lm ! m - Suc xa]"
-apply(rule_tac x = x in exI, simp add: list_update_overwrite)
-done
-
-lemma [simp]:
- "\<lbrakk>m \<noteq> n; p < length lm; lm ! p = 0; m < p; n < p; x < lm ! m\<rbrakk>
- \<Longrightarrow> \<exists>xa<lm ! m. lm[m := x, n := lm ! n + lm ! m,
- p := lm ! m - Suc x, m := Suc x]
- = lm[m := Suc xa, n := lm ! n + lm ! m,
- p := lm ! m - Suc xa]"
-apply(rule_tac x = x in exI,
- simp add: list_update_swap list_update_overwrite)
-done
-
-lemma [simp]:
- "\<lbrakk>m \<noteq> n; p < length lm; lm ! p = 0; m < p; n < p; x < lm ! m\<rbrakk>
- \<Longrightarrow> \<exists>xa\<le>lm ! m. lm[m := Suc x, n := lm ! n + lm ! m,
- p := lm ! m - Suc x]
- = lm[m := xa, n := lm ! n + lm ! m, p := lm ! m - xa]"
-apply(rule_tac x = "Suc x" in exI, simp)
-done
-
-lemma addition_halt_lemma:
- "\<lbrakk>m \<noteq> n; max m n < p; length lm > p; lm ! p = 0\<rbrakk> \<Longrightarrow>
- \<forall>na. \<not> (\<lambda>(as, lm') (m, p). as = 7)
- (abc_steps_l (0, lm) (addition m n p) na) (m, p) \<and>
- addition_inv (abc_steps_l (0, lm) (addition m n p) na) m n p lm
-\<longrightarrow> addition_inv (abc_steps_l (0, lm) (addition m n p)
- (Suc na)) m n p lm
- \<and> ((abc_steps_l (0, lm) (addition m n p) (Suc na), m, p),
- abc_steps_l (0, lm) (addition m n p) na, m, p) \<in> addition_LE"
-apply(rule allI, rule impI, simp add: abc_steps_ind)
-apply(case_tac "(abc_steps_l (0, lm) (addition m n p) na)", simp)
-apply(auto split:if_splits simp add: addition_inv.simps
- abc_steps_zero)
-apply(simp_all add: abc_steps_l.simps abc_steps_zero)
-apply(auto simp add: addition_LE_def lex_triple_def lex_pair_def
- abc_step_l.simps addition_inv.simps
- abc_lm_v.simps abc_lm_s.simps nth_append
- split: if_splits)
-apply(rule_tac x = x in exI, simp)
-done
-
-lemma addition_ex:
- "\<lbrakk>m \<noteq> n; max m n < p; length lm > p; lm ! p = 0\<rbrakk> \<Longrightarrow>
- \<exists> stp. (\<lambda> (as, lm'). as = 7 \<and> addition_inv (as, lm') m n p lm)
- (abc_steps_l (0, lm) (addition m n p) stp)"
-apply(insert halt_lemma2[of addition_LE
- "\<lambda> ((as, lm'), m, p). as = 7"
- "\<lambda> stp. (abc_steps_l (0, lm) (addition m n p) stp, m, p)"
- "\<lambda> ((as, lm'), m, p). addition_inv (as, lm') m n p lm"],
- simp add: abc_steps_zero addition_inv_init)
-apply(drule_tac addition_halt_lemma, simp, simp, simp,
- simp, erule_tac exE)
-apply(rule_tac x = na in exI,
- case_tac "(abc_steps_l (0, lm) (addition m n p) na)", auto)
-done
-
-lemma [simp]: "length (addition m n p) = 7"
-by (simp add: addition.simps)
-
-lemma [elim]: "addition 0 (Suc 0) 2 = [] \<Longrightarrow> RR"
-by(simp add: addition.simps)
-
-lemma [simp]: "(0\<^bsup>2\<^esup>)[0 := n] = [n, 0::nat]"
-apply(subgoal_tac "2 = Suc 1",
- simp only: replicate.simps exponent_def)
-apply(auto)
-done
-
-lemma [simp]:
- "\<exists>stp. abc_steps_l (0, n # 0\<^bsup>2\<^esup> @ suf_lm)
- (addition 0 (Suc 0) 2 [+] [Inc (Suc 0)]) stp =
- (8, n # Suc n # 0 # suf_lm)"
-apply(rule_tac bm = "n # n # 0 # suf_lm" in abc_append_exc2, auto)
-apply(insert addition_ex[of 0 "Suc 0" 2 "n # 0\<^bsup>2\<^esup> @ suf_lm"],
- simp add: nth_append numeral_2_eq_2, erule_tac exE)
-apply(rule_tac x = stp in exI,
- case_tac "(abc_steps_l (0, n # 0\<^bsup>2\<^esup> @ suf_lm)
- (addition 0 (Suc 0) 2) stp)",
- simp add: addition_inv.simps nth_append list_update_append numeral_2_eq_2)
-apply(simp add: nth_append numeral_2_eq_2, erule_tac exE)
-apply(rule_tac x = "Suc 0" in exI,
- simp add: abc_steps_l.simps abc_fetch.simps
- abc_steps_zero abc_step_l.simps abc_lm_s.simps abc_lm_v.simps)
-done
-
-lemma s_case:
- "\<lbrakk>rec_ci s = (aprog, rs_pos, a_md); rec_calc_rel s lm rs\<rbrakk>
- \<Longrightarrow> \<exists>stp. abc_steps_l (0, lm @ 0\<^bsup>a_md - rs_pos\<^esup> @ suf_lm) aprog stp =
- (length aprog, lm @ [rs] @ 0\<^bsup>a_md - rs_pos - 1\<^esup> @ suf_lm)"
-apply(simp add: rec_ci.simps rec_ci_s_def, auto)
-apply(rule_tac calc_s_reverse, auto)
-done
-
-lemma [simp]:
- "\<lbrakk>n < length lm; lm ! n = rs\<rbrakk>
- \<Longrightarrow> \<exists>stp. abc_steps_l (0, lm @ 0 # 0 #suf_lm)
- (addition n (length lm) (Suc (length lm))) stp
- = (7, lm @ rs # 0 # suf_lm)"
-apply(insert addition_ex[of n "length lm"
- "Suc (length lm)" "lm @ 0 # 0 # suf_lm"])
-apply(simp add: nth_append, erule_tac exE)
-apply(rule_tac x = stp in exI)
-apply(case_tac "abc_steps_l (0, lm @ 0 # 0 # suf_lm) (addition n (length lm)
- (Suc (length lm))) stp", simp)
-apply(simp add: addition_inv.simps)
-apply(insert nth_append[of lm "0 # 0 # suf_lm" "n"], simp)
-done
-
-lemma [simp]: "0\<^bsup>2\<^esup> = [0, 0::nat]"
-apply(auto simp: exponent_def numeral_2_eq_2)
-done
-
-lemma id_case:
- "\<lbrakk>rec_ci (id m n) = (aprog, rs_pos, a_md);
- rec_calc_rel (id m n) lm rs\<rbrakk>
- \<Longrightarrow> \<exists>stp. abc_steps_l (0, lm @ 0\<^bsup>a_md - rs_pos\<^esup> @ suf_lm) aprog stp =
- (length aprog, lm @ [rs] @ 0\<^bsup>a_md - rs_pos - 1\<^esup> @ suf_lm)"
-apply(simp add: rec_ci.simps rec_ci_id.simps, auto)
-apply(rule_tac calc_id_reverse, simp, simp)
-done
-
-lemma list_tl_induct:
- "\<lbrakk>P []; \<And>a list. P list \<Longrightarrow> P (list @ [a::'a])\<rbrakk> \<Longrightarrow>
- P ((list::'a list))"
-apply(case_tac "length list", simp)
-proof -
- fix nat
- assume ind: "\<And>a list. P list \<Longrightarrow> P (list @ [a])"
- and h: "length list = Suc nat" "P []"
- from h show "P list"
- proof(induct nat arbitrary: list, case_tac lista, simp, simp)
- fix lista a listaa
- from h show "P [a]"
- by(insert ind[of "[]"], simp add: h)
- next
- fix nat list
- assume nind: "\<And>list. \<lbrakk>length list = Suc nat; P []\<rbrakk> \<Longrightarrow> P list"
- and g: "length (list:: 'a list) = Suc (Suc nat)"
- from g show "P (list::'a list)"
- apply(insert nind[of "butlast list"], simp add: h)
- apply(insert ind[of "butlast list" "last list"], simp)
- apply(subgoal_tac "butlast list @ [last list] = list", simp)
- apply(case_tac "list::'a list", simp, simp)
- done
- qed
-qed
-
-thm list.induct
-
-lemma nth_eq_butlast_nth: "\<lbrakk>length ys > Suc k\<rbrakk> \<Longrightarrow>
- ys ! k = butlast ys ! k"
-apply(subgoal_tac "\<exists> xs y. ys = xs @ [y]", auto simp: nth_append)
-apply(rule_tac x = "butlast ys" in exI, rule_tac x = "last ys" in exI)
-apply(case_tac "ys = []", simp, simp)
-done
-
-lemma [simp]:
-"\<lbrakk>\<forall>k<Suc (length list). rec_calc_rel ((list @ [a]) ! k) lm (ys ! k);
- length ys = Suc (length list)\<rbrakk>
- \<Longrightarrow> \<forall>k<length list. rec_calc_rel (list ! k) lm (butlast ys ! k)"
-apply(rule allI, rule impI)
-apply(erule_tac x = k in allE, simp add: nth_append)
-apply(subgoal_tac "ys ! k = butlast ys ! k", simp)
-apply(rule_tac nth_eq_butlast_nth, arith)
-done
-
-
-thm cn_merge_gs.simps
-lemma cn_merge_gs_tl_app:
- "cn_merge_gs (gs @ [g]) pstr =
- cn_merge_gs gs pstr [+] cn_merge_gs [g] (pstr + length gs)"
-apply(induct gs arbitrary: pstr, simp add: cn_merge_gs.simps, simp)
-apply(case_tac a, simp add: abc_append_commute)
-done
-
-lemma cn_merge_gs_length:
- "length (cn_merge_gs (map rec_ci list) pstr) =
- (\<Sum>(ap, pos, n)\<leftarrow>map rec_ci list. length ap) + 3 * length list "
-apply(induct list arbitrary: pstr, simp, simp)
-apply(case_tac "rec_ci a", simp)
-done
-
-lemma [simp]: "Suc n \<le> pstr \<Longrightarrow> pstr + x - n > 0"
-by arith
-
-lemma [simp]:
- "\<lbrakk>Suc (pstr + length list) \<le> a_md;
- length ys = Suc (length list);
- length lm = n;
- Suc n \<le> pstr\<rbrakk>
- \<Longrightarrow> (ys ! length list # 0\<^bsup>pstr - Suc n\<^esup> @ butlast ys @
- 0\<^bsup>a_md - (pstr + length list)\<^esup> @ suf_lm) !
- (pstr + length list - n) = (0 :: nat)"
-apply(insert nth_append[of "ys ! length list # 0\<^bsup>pstr - Suc n\<^esup> @
- butlast ys" "0\<^bsup>a_md - (pstr + length list)\<^esup> @ suf_lm"
- "(pstr + length list - n)"], simp add: nth_append)
-done
-
-lemma [simp]:
- "\<lbrakk>Suc (pstr + length list) \<le> a_md;
- length ys = Suc (length list);
- length lm = n;
- Suc n \<le> pstr\<rbrakk>
- \<Longrightarrow> (lm @ last ys # 0\<^bsup>pstr - Suc n\<^esup> @ butlast ys @
- 0\<^bsup>a_md - (pstr + length list)\<^esup> @ suf_lm)[pstr + length list :=
- last ys, n := 0] =
- lm @ 0::nat\<^bsup>pstr - n\<^esup> @ ys @ 0\<^bsup>a_md - Suc (pstr + length list)\<^esup> @ suf_lm"
-apply(insert list_update_length[of
- "lm @ last ys # 0\<^bsup>pstr - Suc n\<^esup> @ butlast ys" 0
- "0\<^bsup>a_md - Suc (pstr + length list)\<^esup> @ suf_lm" "last ys"], simp)
-apply(simp add: exponent_cons_iff)
-apply(insert list_update_length[of "lm"
- "last ys" "0\<^bsup>pstr - Suc n\<^esup> @ butlast ys @
- last ys # 0\<^bsup>a_md - Suc (pstr + length list)\<^esup> @ suf_lm" 0], simp)
-apply(simp add: exponent_cons_iff)
-apply(case_tac "ys = []", simp_all add: append_butlast_last_id)
-done
-
-
-lemma cn_merge_gs_ex:
- "\<lbrakk>\<And>x aprog a_md rs_pos rs suf_lm lm.
- \<lbrakk>x \<in> set gs; rec_ci x = (aprog, rs_pos, a_md);
- rec_calc_rel x lm rs\<rbrakk>
- \<Longrightarrow> \<exists>stp. abc_steps_l (0, lm @ 0\<^bsup>a_md - rs_pos\<^esup> @ suf_lm) aprog stp
- = (length aprog, lm @ [rs] @ 0\<^bsup>a_md - rs_pos - 1\<^esup> @ suf_lm);
- pstr + length gs\<le> a_md;
- \<forall>k<length gs. rec_calc_rel (gs ! k) lm (ys ! k);
- length ys = length gs; length lm = n;
- pstr \<ge> Max (set (Suc n # map (\<lambda>(aprog, p, n). n) (map rec_ci gs)))\<rbrakk>
- \<Longrightarrow> \<exists> stp. abc_steps_l (0, lm @ 0\<^bsup>a_md - n\<^esup> @ suf_lm)
- (cn_merge_gs (map rec_ci gs) pstr) stp
- = (listsum (map ((\<lambda>(ap, pos, n). length ap) \<circ> rec_ci) gs) +
- 3 * length gs, lm @ 0\<^bsup>pstr - n\<^esup> @ ys @ 0\<^bsup>a_md - (pstr + length gs)\<^esup> @ suf_lm)"
-apply(induct gs arbitrary: ys rule: list_tl_induct)
-apply(simp add: exponent_add_iff, simp)
-proof -
- fix a list ys
- assume ind: "\<And>x aprog a_md rs_pos rs suf_lm lm.
- \<lbrakk>x = a \<or> x \<in> set list; rec_ci x = (aprog, rs_pos, a_md);
- rec_calc_rel x lm rs\<rbrakk>
- \<Longrightarrow> \<exists>stp. abc_steps_l (0, lm @ 0\<^bsup>a_md - rs_pos\<^esup> @ suf_lm) aprog stp =
- (length aprog, lm @ rs # 0\<^bsup>a_md - Suc rs_pos\<^esup> @ suf_lm)"
- and ind2:
- "\<And>ys. \<lbrakk>\<And>x aprog a_md rs_pos rs suf_lm lm.
- \<lbrakk>x \<in> set list; rec_ci x = (aprog, rs_pos, a_md);
- rec_calc_rel x lm rs\<rbrakk>
- \<Longrightarrow> \<exists>stp. abc_steps_l (0, lm @ 0\<^bsup>a_md - rs_pos\<^esup> @ suf_lm) aprog stp
- = (length aprog, lm @ rs # 0\<^bsup>a_md - Suc rs_pos\<^esup> @ suf_lm);
- \<forall>k<length list. rec_calc_rel (list ! k) lm (ys ! k);
- length ys = length list\<rbrakk>
- \<Longrightarrow> \<exists>stp. abc_steps_l (0, lm @ 0\<^bsup>a_md - n\<^esup> @ suf_lm)
- (cn_merge_gs (map rec_ci list) pstr) stp =
- (listsum (map ((\<lambda>(ap, pos, n). length ap) \<circ> rec_ci) list) +
- 3 * length list,
- lm @ 0\<^bsup>pstr - n\<^esup> @ ys @ 0\<^bsup>a_md - (pstr + length list)\<^esup> @ suf_lm)"
- and h: "Suc (pstr + length list) \<le> a_md"
- "\<forall>k<Suc (length list).
- rec_calc_rel ((list @ [a]) ! k) lm (ys ! k)"
- "length ys = Suc (length list)"
- "length lm = n"
- "Suc n \<le> pstr \<and> (\<lambda>(aprog, p, n). n) (rec_ci a) \<le> pstr \<and>
- (\<forall>a\<in>set list. (\<lambda>(aprog, p, n). n) (rec_ci a) \<le> pstr)"
- from h have k1:
- "\<exists>stp. abc_steps_l (0, lm @ 0\<^bsup>a_md - n\<^esup> @ suf_lm)
- (cn_merge_gs (map rec_ci list) pstr) stp =
- (listsum (map ((\<lambda>(ap, pos, n). length ap) \<circ> rec_ci) list) +
- 3 * length list, lm @ 0\<^bsup>pstr - n\<^esup> @ butlast ys @
- 0\<^bsup>a_md - (pstr + length list)\<^esup> @ suf_lm) "
- apply(rule_tac ind2)
- apply(rule_tac ind, auto)
- done
- from k1 and h show
- "\<exists>stp. abc_steps_l (0, lm @ 0\<^bsup>a_md - n\<^esup> @ suf_lm)
- (cn_merge_gs (map rec_ci list @ [rec_ci a]) pstr) stp =
- (listsum (map ((\<lambda>(ap, pos, n). length ap) \<circ> rec_ci) list) +
- (\<lambda>(ap, pos, n). length ap) (rec_ci a) + (3 + 3 * length list),
- lm @ 0\<^bsup>pstr - n\<^esup> @ ys @ 0\<^bsup>a_md - Suc (pstr + length list)\<^esup> @ suf_lm)"
- apply(simp add: cn_merge_gs_tl_app)
- thm abc_append_exc2
- apply(rule_tac as =
- "(\<Sum>(ap, pos, n)\<leftarrow>map rec_ci list. length ap) + 3 * length list"
- and bm = "lm @ 0\<^bsup>pstr - n\<^esup> @ butlast ys @
- 0\<^bsup>a_md - (pstr + length list)\<^esup> @ suf_lm"
- and bs = "(\<lambda>(ap, pos, n). length ap) (rec_ci a) + 3"
- and bm' = "lm @ 0\<^bsup>pstr - n\<^esup> @ ys @ 0\<^bsup>a_md - Suc (pstr + length list)\<^esup> @
- suf_lm" in abc_append_exc2, simp)
- apply(simp add: cn_merge_gs_length)
- proof -
- from h show
- "\<exists>bstp. abc_steps_l (0, lm @ 0\<^bsup>pstr - n\<^esup> @ butlast ys @
- 0\<^bsup>a_md - (pstr + length list)\<^esup> @ suf_lm)
- ((\<lambda>(gprog, gpara, gn). gprog [+] recursive.empty gpara
- (pstr + length list)) (rec_ci a)) bstp =
- ((\<lambda>(ap, pos, n). length ap) (rec_ci a) + 3,
- lm @ 0\<^bsup>pstr - n\<^esup> @ ys @ 0\<^bsup>a_md - Suc (pstr + length list)\<^esup> @ suf_lm)"
- apply(case_tac "rec_ci a", simp)
- apply(rule_tac as = "length aa" and
- bm = "lm @ (ys ! (length list)) #
- 0\<^bsup>pstr - Suc n\<^esup> @ butlast ys @ 0\<^bsup>a_md - (pstr + length list)\<^esup> @ suf_lm"
- and bs = "3" and bm' = "lm @ 0\<^bsup>pstr - n\<^esup> @ ys @
- 0\<^bsup>a_md - Suc (pstr + length list)\<^esup> @ suf_lm" in abc_append_exc2)
- proof -
- fix aa b c
- assume g: "rec_ci a = (aa, b, c)"
- from h and g have k2: "b = n"
- apply(erule_tac x = "length list" in allE, simp)
- apply(subgoal_tac "length lm = b", simp)
- apply(rule para_pattern, simp, simp)
- done
- from h and g and this show
- "\<exists>astp. abc_steps_l (0, lm @ 0\<^bsup>pstr - n\<^esup> @ butlast ys @
- 0\<^bsup>a_md - (pstr + length list)\<^esup> @ suf_lm) aa astp =
- (length aa, lm @ ys ! length list # 0\<^bsup>pstr - Suc n\<^esup> @
- butlast ys @ 0\<^bsup>a_md - (pstr + length list)\<^esup> @ suf_lm)"
- apply(subgoal_tac "c \<ge> Suc n")
- apply(insert ind[of a aa b c lm "ys ! length list"
- "0\<^bsup>pstr - c\<^esup> @ butlast ys @ 0\<^bsup>a_md - (pstr + length list)\<^esup> @ suf_lm"], simp)
- apply(erule_tac x = "length list" in allE,
- simp add: exponent_add_iff)
- apply(rule_tac Suc_leI, rule_tac ci_ad_ge_paras, simp)
- done
- next
- fix aa b c
- show "length aa = length aa" by simp
- next
- fix aa b c
- assume "rec_ci a = (aa, b, c)"
- from h and this show
- "\<exists>bstp. abc_steps_l (0, lm @ ys ! length list #
- 0\<^bsup>pstr - Suc n\<^esup> @ butlast ys @ 0\<^bsup>a_md - (pstr + length list)\<^esup> @ suf_lm)
- (recursive.empty b (pstr + length list)) bstp =
- (3, lm @ 0\<^bsup>pstr - n\<^esup> @ ys @ 0\<^bsup>a_md - Suc (pstr + length list)\<^esup> @ suf_lm)"
- apply(insert empty_ex [of b "pstr + length list"
- "lm @ ys ! length list # 0\<^bsup>pstr - Suc n\<^esup> @ butlast ys @
- 0\<^bsup>a_md - (pstr + length list)\<^esup> @ suf_lm"], simp)
- apply(subgoal_tac "b = n")
- apply(simp add: nth_append split: if_splits)
- apply(erule_tac x = "length list" in allE, simp)
- apply(drule para_pattern, simp, simp)
- done
- next
- fix aa b c
- show "3 = length (recursive.empty b (pstr + length list))"
- by simp
- next
- fix aa b aaa ba
- show "length aa + 3 = length aa + 3" by simp
- next
- fix aa b c
- show "empty b (pstr + length list) \<noteq> []"
- by(simp add: empty.simps)
- qed
- next
- show "(\<lambda>(ap, pos, n). length ap) (rec_ci a) + 3 =
- length ((\<lambda>(gprog, gpara, gn). gprog [+]
- recursive.empty gpara (pstr + length list)) (rec_ci a))"
- by(case_tac "rec_ci a", simp)
- next
- show "listsum (map ((\<lambda>(ap, pos, n). length ap) \<circ> rec_ci) list) +
- (\<lambda>(ap, pos, n). length ap) (rec_ci a) + (3 + 3 * length list)=
- (\<Sum>(ap, pos, n)\<leftarrow>map rec_ci list. length ap) + 3 * length list +
- ((\<lambda>(ap, pos, n). length ap) (rec_ci a) + 3)" by simp
- next
- show "(\<lambda>(gprog, gpara, gn). gprog [+]
- recursive.empty gpara (pstr + length list)) (rec_ci a) \<noteq> []"
- by(case_tac "rec_ci a",
- simp add: abc_append.simps abc_shift.simps)
- qed
-qed
-
-declare drop_abc_lm_v_simp[simp del]
-
-lemma [simp]: "length (mv_boxes aa ba n) = 3*n"
-by(induct n, auto simp: mv_boxes.simps)
-
-lemma exp_suc: "a\<^bsup>Suc b\<^esup> = a\<^bsup>b\<^esup> @ [a]"
-by(simp add: exponent_def rep_ind del: replicate.simps)
-
-lemma [simp]:
- "\<lbrakk>Suc n \<le> ba - aa; length lm2 = Suc n;
- length lm3 = ba - Suc (aa + n)\<rbrakk>
- \<Longrightarrow> (last lm2 # lm3 @ butlast lm2 @ 0 # lm4) ! (ba - aa) = (0::nat)"
-proof -
- assume h: "Suc n \<le> ba - aa"
- and g: "length lm2 = Suc n" "length lm3 = ba - Suc (aa + n)"
- from h and g have k: "ba - aa = Suc (length lm3 + n)"
- by arith
- from k show
- "(last lm2 # lm3 @ butlast lm2 @ 0 # lm4) ! (ba - aa) = 0"
- apply(simp, insert g)
- apply(simp add: nth_append)
- done
-qed
-
-lemma [simp]: "length lm1 = aa \<Longrightarrow>
- (lm1 @ 0\<^bsup>n\<^esup> @ last lm2 # lm3 @ butlast lm2 @ 0 # lm4) ! (aa + n) = last lm2"
-apply(simp add: nth_append)
-done
-
-lemma [simp]: "\<lbrakk>Suc n \<le> ba - aa; aa < ba\<rbrakk> \<Longrightarrow>
- (ba < Suc (aa + (ba - Suc (aa + n) + n))) = False"
-apply arith
-done
-
-lemma [simp]: "\<lbrakk>Suc n \<le> ba - aa; aa < ba; length lm1 = aa;
- length lm2 = Suc n; length lm3 = ba - Suc (aa + n)\<rbrakk>
- \<Longrightarrow> (lm1 @ 0\<^bsup>n\<^esup> @ last lm2 # lm3 @ butlast lm2 @ 0 # lm4) ! (ba + n) = 0"
-using nth_append[of "lm1 @ 0\<Colon>'a\<^bsup>n\<^esup> @ last lm2 # lm3 @ butlast lm2"
- "(0\<Colon>'a) # lm4" "ba + n"]
-apply(simp)
-done
-
-lemma [simp]:
- "\<lbrakk>Suc n \<le> ba - aa; aa < ba; length lm1 = aa; length lm2 = Suc n;
- length lm3 = ba - Suc (aa + n)\<rbrakk>
- \<Longrightarrow> (lm1 @ 0\<^bsup>n\<^esup> @ last lm2 # lm3 @ butlast lm2 @ (0::nat) # lm4)
- [ba + n := last lm2, aa + n := 0] =
- lm1 @ 0 # 0\<^bsup>n\<^esup> @ lm3 @ lm2 @ lm4"
-using list_update_append[of "lm1 @ 0\<^bsup>n\<^esup> @ last lm2 # lm3 @ butlast lm2" "0 # lm4"
- "ba + n" "last lm2"]
-apply(simp)
-apply(simp add: list_update_append)
-apply(simp only: exponent_cons_iff exp_suc, simp)
-apply(case_tac lm2, simp, simp)
-done
-
-
-lemma mv_boxes_ex:
- "\<lbrakk>n \<le> ba - aa; ba > aa; length lm1 = aa;
- length (lm2::nat list) = n; length lm3 = ba - aa - n\<rbrakk>
- \<Longrightarrow> \<exists> stp. abc_steps_l (0, lm1 @ lm2 @ lm3 @ 0\<^bsup>n\<^esup> @ lm4)
- (mv_boxes aa ba n) stp = (3 * n, lm1 @ 0\<^bsup>n\<^esup> @ lm3 @ lm2 @ lm4)"
-apply(induct n arbitrary: lm2 lm3 lm4, simp)
-apply(rule_tac x = 0 in exI, simp add: abc_steps_zero,
- simp add: mv_boxes.simps del: exp_suc_iff)
-apply(rule_tac as = "3 *n" and bm = "lm1 @ 0\<^bsup>n\<^esup> @ last lm2 # lm3 @
- butlast lm2 @ 0 # lm4" in abc_append_exc2, simp_all)
-apply(simp only: exponent_cons_iff, simp only: exp_suc, simp)
-proof -
- fix n lm2 lm3 lm4
- assume ind:
- "\<And>lm2 lm3 lm4. \<lbrakk>length lm2 = n; length lm3 = ba - (aa + n)\<rbrakk> \<Longrightarrow>
- \<exists>stp. abc_steps_l (0, lm1 @ lm2 @ lm3 @ 0\<^bsup>n\<^esup> @ lm4)
- (mv_boxes aa ba n) stp = (3 * n, lm1 @ 0\<^bsup>n\<^esup> @ lm3 @ lm2 @ lm4)"
- and h: "Suc n \<le> ba - aa" "aa < ba" "length (lm1::nat list) = aa"
- "length (lm2::nat list) = Suc n"
- "length (lm3::nat list) = ba - Suc (aa + n)"
- from h show
- "\<exists>astp. abc_steps_l (0, lm1 @ lm2 @ lm3 @ 0\<^bsup>n\<^esup> @ 0 # lm4)
- (mv_boxes aa ba n) astp =
- (3 * n, lm1 @ 0\<^bsup>n\<^esup> @ last lm2 # lm3 @ butlast lm2 @ 0 # lm4)"
- apply(insert ind[of "butlast lm2" "last lm2 # lm3" "0 # lm4"],
- simp)
- apply(subgoal_tac "lm1 @ butlast lm2 @ last lm2 # lm3 @ 0\<^bsup>n\<^esup> @
- 0 # lm4 = lm1 @ lm2 @ lm3 @ 0\<^bsup>n\<^esup> @ 0 # lm4", simp, simp)
- apply(case_tac "lm2 = []", simp, simp)
- done
-next
- fix n lm2 lm3 lm4
- assume h: "Suc n \<le> ba - aa"
- "aa < ba"
- "length (lm1::nat list) = aa"
- "length (lm2::nat list) = Suc n"
- "length (lm3::nat list) = ba - Suc (aa + n)"
- thus " \<exists>bstp. abc_steps_l (0, lm1 @ 0\<^bsup>n\<^esup> @ last lm2 # lm3 @
- butlast lm2 @ 0 # lm4)
- (recursive.empty (aa + n) (ba + n)) bstp
- = (3, lm1 @ 0 # 0\<^bsup>n\<^esup> @ lm3 @ lm2 @ lm4)"
- apply(insert empty_ex[of "aa + n" "ba + n"
- "lm1 @ 0\<^bsup>n\<^esup> @ last lm2 # lm3 @ butlast lm2 @ 0 # lm4"], simp)
- done
-qed
-(*
-lemma [simp]: "\<lbrakk>Suc n \<le> aa - ba;
- ba < aa;
- length lm2 = aa - Suc (ba + n)\<rbrakk>
- \<Longrightarrow> ((0::nat) # lm2 @ 0\<^bsup>n\<^esup> @ last lm3 # lm4) ! (aa - ba)
- = last lm3"
-proof -
- assume h: "Suc n \<le> aa - ba"
- and g: " ba < aa" "length lm2 = aa - Suc (ba + n)"
- from h and g have k: "aa - ba = Suc (length lm2 + n)"
- by arith
- thus "((0::nat) # lm2 @ 0\<^bsup>n\<^esup> @ last lm3 # lm4) ! (aa - ba) = last lm3"
- apply(simp, simp add: nth_append)
- done
-qed
-*)
-
-lemma [simp]: "\<lbrakk>Suc n \<le> aa - ba; ba < aa; length lm1 = ba;
- length lm2 = aa - Suc (ba + n); length lm3 = Suc n\<rbrakk>
- \<Longrightarrow> (lm1 @ butlast lm3 @ 0 # lm2 @ 0\<^bsup>n\<^esup> @ last lm3 # lm4) ! (aa + n) = last lm3"
-using nth_append[of "lm1 @ butlast lm3 @ 0 # lm2 @ 0\<^bsup>n\<^esup>" "last lm3 # lm4" "aa + n"]
-apply(simp)
-done
-
-lemma [simp]: "\<lbrakk>Suc n \<le> aa - ba; ba < aa; length lm1 = ba;
- length lm2 = aa - Suc (ba + n); length lm3 = Suc n\<rbrakk>
- \<Longrightarrow> (lm1 @ butlast lm3 @ 0 # lm2 @ 0\<^bsup>n\<^esup> @ last lm3 # lm4) ! (ba + n) = 0"
-apply(simp add: nth_append)
-done
-
-
-lemma [simp]: "\<lbrakk>Suc n \<le> aa - ba; ba < aa; length lm1 = ba;
- length lm2 = aa - Suc (ba + n); length lm3 = Suc n\<rbrakk>
- \<Longrightarrow> (lm1 @ butlast lm3 @ 0 # lm2 @ 0\<^bsup>n\<^esup> @ last lm3 # lm4)[ba + n := last lm3, aa + n := 0]
- = lm1 @ lm3 @ lm2 @ 0 # 0\<^bsup>n\<^esup> @ lm4"
-using list_update_append[of "lm1 @ butlast lm3" "(0\<Colon>'a) # lm2 @ 0\<Colon>'a\<^bsup>n\<^esup> @ last lm3 # lm4"]
-apply(simp)
-using list_update_append[of "lm1 @ butlast lm3 @ last lm3 # lm2 @ 0\<Colon>'a\<^bsup>n\<^esup>"
- "last lm3 # lm4" "aa + n" "0"]
-apply(simp)
-apply(simp only: exp_ind_def[THEN sym] exp_suc, simp)
-apply(case_tac lm3, simp, simp)
-done
-
-
-lemma mv_boxes_ex2:
- "\<lbrakk>n \<le> aa - ba;
- ba < aa;
- length (lm1::nat list) = ba;
- length (lm2::nat list) = aa - ba - n;
- length (lm3::nat list) = n\<rbrakk>
- \<Longrightarrow> \<exists> stp. abc_steps_l (0, lm1 @ 0\<^bsup>n\<^esup> @ lm2 @ lm3 @ lm4)
- (mv_boxes aa ba n) stp =
- (3 * n, lm1 @ lm3 @ lm2 @ 0\<^bsup>n\<^esup> @ lm4)"
-apply(induct n arbitrary: lm2 lm3 lm4, simp)
-apply(rule_tac x = 0 in exI, simp add: abc_steps_zero,
- simp add: mv_boxes.simps del: exp_suc_iff)
-apply(rule_tac as = "3 *n" and bm = "lm1 @ butlast lm3 @ 0 # lm2 @
- 0\<^bsup>n\<^esup> @ last lm3 # lm4" in abc_append_exc2, simp_all)
-apply(simp only: exponent_cons_iff, simp only: exp_suc, simp)
-proof -
- fix n lm2 lm3 lm4
- assume ind:
-"\<And>lm2 lm3 lm4. \<lbrakk>length lm2 = aa - (ba + n); length lm3 = n\<rbrakk> \<Longrightarrow>
- \<exists>stp. abc_steps_l (0, lm1 @ 0\<^bsup>n\<^esup> @ lm2 @ lm3 @ lm4)
- (mv_boxes aa ba n) stp =
- (3 * n, lm1 @ lm3 @ lm2 @ 0\<^bsup>n\<^esup> @ lm4)"
- and h: "Suc n \<le> aa - ba"
- "ba < aa"
- "length (lm1::nat list) = ba"
- "length (lm2::nat list) = aa - Suc (ba + n)"
- "length (lm3::nat list) = Suc n"
- from h show
- "\<exists>astp. abc_steps_l (0, lm1 @ 0\<^bsup>n\<^esup> @ 0 # lm2 @ lm3 @ lm4)
- (mv_boxes aa ba n) astp =
- (3 * n, lm1 @ butlast lm3 @ 0 # lm2 @ 0\<^bsup>n\<^esup> @ last lm3 # lm4)"
- apply(insert ind[of "0 # lm2" "butlast lm3" "last lm3 # lm4"],
- simp)
- apply(subgoal_tac
- "lm1 @ 0\<^bsup>n\<^esup> @ 0 # lm2 @ butlast lm3 @ last lm3 # lm4 =
- lm1 @ 0\<^bsup>n\<^esup> @ 0 # lm2 @ lm3 @ lm4", simp, simp)
- apply(case_tac "lm3 = []", simp, simp)
- done
-next
- fix n lm2 lm3 lm4
- assume h:
- "Suc n \<le> aa - ba"
- "ba < aa"
- "length lm1 = ba"
- "length (lm2::nat list) = aa - Suc (ba + n)"
- "length (lm3::nat list) = Suc n"
- thus
- "\<exists>bstp. abc_steps_l (0, lm1 @ butlast lm3 @ 0 # lm2 @ 0\<^bsup>n\<^esup> @
- last lm3 # lm4)
- (recursive.empty (aa + n) (ba + n)) bstp =
- (3, lm1 @ lm3 @ lm2 @ 0 # 0\<^bsup>n\<^esup> @ lm4)"
- apply(insert empty_ex[of "aa + n" "ba + n" "lm1 @ butlast lm3 @
- 0 # lm2 @ 0\<^bsup>n\<^esup> @ last lm3 # lm4"], simp)
- done
-qed
-
-lemma cn_merge_gs_len:
- "length (cn_merge_gs (map rec_ci gs) pstr) =
- (\<Sum>(ap, pos, n)\<leftarrow>map rec_ci gs. length ap) + 3 * length gs"
-apply(induct gs arbitrary: pstr, simp, simp)
-apply(case_tac "rec_ci a", simp)
-done
-
-lemma [simp]: "n < pstr \<Longrightarrow>
- Suc (pstr + length ys - n) = Suc (pstr + length ys) - n"
-by arith
-
-lemma save_paras':
- "\<lbrakk>length lm = n; pstr > n; a_md > pstr + length ys + n\<rbrakk>
- \<Longrightarrow> \<exists>stp. abc_steps_l (0, lm @ 0\<^bsup>pstr - n\<^esup> @ ys @
- 0\<^bsup>a_md - pstr - length ys\<^esup> @ suf_lm)
- (mv_boxes 0 (pstr + Suc (length ys)) n) stp
- = (3 * n, 0\<^bsup>pstr\<^esup> @ ys @ 0 # lm @ 0\<^bsup>a_md - Suc (pstr + length ys + n)\<^esup> @ suf_lm)"
-thm mv_boxes_ex
-apply(insert mv_boxes_ex[of n "pstr + Suc (length ys)" 0 "[]" "lm"
- "0\<^bsup>pstr - n\<^esup> @ ys @ [0]" "0\<^bsup>a_md - pstr - length ys - n - Suc 0\<^esup> @ suf_lm"], simp)
-apply(erule_tac exE, rule_tac x = stp in exI,
- simp add: exponent_add_iff)
-apply(simp only: exponent_cons_iff, simp)
-done
-
-lemma [simp]:
- "(max ba (Max (insert ba (((\<lambda>(aprog, p, n). n) o rec_ci) ` set gs))))
- = (Max (insert ba (((\<lambda>(aprog, p, n). n) o rec_ci) ` set gs)))"
-apply(rule min_max.sup_absorb2, auto)
-done
-
-lemma [simp]:
- "((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs) =
- (((\<lambda>(aprog, p, n). n) o rec_ci) ` set gs)"
-apply(induct gs)
-apply(simp, simp)
-done
-
-lemma ci_cn_md_def:
- "\<lbrakk>rec_ci (Cn n f gs) = (aprog, rs_pos, a_md);
- rec_ci f = (a, aa, ba)\<rbrakk>
- \<Longrightarrow> a_md = max (Suc n) (Max (insert ba (((\<lambda>(aprog, p, n). n) o
- rec_ci) ` set gs))) + Suc (length gs) + n"
-apply(simp add: rec_ci.simps, auto)
-done
-
-lemma save_paras_prog_ex:
- "\<lbrakk>rec_ci (Cn n f gs) = (aprog, rs_pos, a_md);
- rec_ci f = (a, aa, ba);
- pstr = Max (set (Suc n # ba # map (\<lambda>(aprog, p, n). n)
- (map rec_ci (f # gs))))\<rbrakk>
- \<Longrightarrow> \<exists>ap bp cp.
- aprog = ap [+] bp [+] cp \<and>
- length ap = (\<Sum>(ap, pos, n)\<leftarrow>map rec_ci gs. length ap) +
- 3 * length gs \<and> bp = mv_boxes 0 (pstr + Suc (length gs)) n"
-apply(simp add: rec_ci.simps)
-apply(rule_tac x =
- "cn_merge_gs (map rec_ci gs) (max (Suc n) (Max (insert ba
- (((\<lambda>(aprog, p, n). n) o rec_ci) ` set gs))))" in exI,
- simp add: cn_merge_gs_len)
-apply(rule_tac x =
- "mv_boxes (max (Suc n) (Max (insert ba (((\<lambda>(aprog, p, n). n) \<circ> rec_ci) ` set gs))))
- 0 (length gs) [+] a [+]recursive.empty aa (max (Suc n)
- (Max (insert ba (((\<lambda>(aprog, p, n). n) \<circ> rec_ci) ` set gs)))) [+]
- empty_boxes (length gs) [+] recursive.empty (max (Suc n)
- (Max (insert ba (((\<lambda>(aprog, p, n). n) \<circ> rec_ci) ` set gs)))) n [+]
- mv_boxes (Suc (max (Suc n) (Max (insert ba (((\<lambda>(aprog, p, n). n) \<circ> rec_ci)
- ` set gs))) + length gs)) 0 n" in exI, auto)
-apply(simp add: abc_append_commute)
-done
-
-lemma save_paras:
- "\<lbrakk>rec_ci (Cn n f gs) = (aprog, rs_pos, a_md);
- rs_pos = n;
- \<forall>k<length gs. rec_calc_rel (gs ! k) lm (ys ! k);
- length ys = length gs;
- length lm = n;
- rec_ci f = (a, aa, ba);
- pstr = Max (set (Suc n # ba # map (\<lambda>(aprog, p, n). n)
- (map rec_ci (f # gs))))\<rbrakk>
- \<Longrightarrow> \<exists>stp. abc_steps_l ((\<Sum>(ap, pos, n)\<leftarrow>map rec_ci gs. length ap) +
- 3 * length gs, lm @ 0\<^bsup>pstr - n\<^esup> @ ys @
- 0\<^bsup>a_md - pstr - length ys\<^esup> @ suf_lm) aprog stp =
- ((\<Sum>(ap, pos, n)\<leftarrow>map rec_ci gs. length ap) +
- 3 * length gs + 3 * n,
- 0\<^bsup>pstr\<^esup> @ ys @ 0 # lm @ 0\<^bsup>a_md - Suc (pstr + length ys + n)\<^esup> @ suf_lm)"
-proof -
- assume h:
- "rec_ci (Cn n f gs) = (aprog, rs_pos, a_md)"
- "rs_pos = n"
- "\<forall>k<length gs. rec_calc_rel (gs ! k) lm (ys ! k)"
- "length ys = length gs"
- "length lm = n"
- "rec_ci f = (a, aa, ba)"
- and g: "pstr = Max (set (Suc n # ba # map (\<lambda>(aprog, p, n). n)
- (map rec_ci (f # gs))))"
- from h and g have k1:
- "\<exists> ap bp cp. aprog = ap [+] bp [+] cp \<and>
- length ap = (\<Sum>(ap, pos, n)\<leftarrow>map rec_ci gs. length ap) +
- 3 *length gs \<and> bp = mv_boxes 0 (pstr + Suc (length ys)) n"
- apply(drule_tac save_paras_prog_ex, auto)
- done
- from h have k2:
- "\<exists> stp. abc_steps_l (0, lm @ 0\<^bsup>pstr - n\<^esup> @ ys @
- 0\<^bsup>a_md - pstr - length ys\<^esup> @ suf_lm)
- (mv_boxes 0 (pstr + Suc (length ys)) n) stp =
- (3 * n, 0\<^bsup>pstr\<^esup> @ ys @ 0 # lm @ 0\<^bsup>a_md - Suc (pstr + length ys + n)\<^esup> @ suf_lm)"
- apply(rule_tac save_paras', simp, simp_all add: g)
- apply(drule_tac a = a and aa = aa and ba = ba in
- ci_cn_md_def, simp, simp)
- done
- from k1 show
- "\<exists>stp. abc_steps_l ((\<Sum>(ap, pos, n)\<leftarrow>map rec_ci gs. length ap) +
- 3 * length gs, lm @ 0\<^bsup>pstr - n\<^esup> @ ys @
- 0\<^bsup>a_md - pstr - length ys\<^esup> @ suf_lm) aprog stp =
- ((\<Sum>(ap, pos, n)\<leftarrow>map rec_ci gs. length ap) +
- 3 * length gs + 3 * n,
- 0\<^bsup>pstr\<^esup> @ ys @ 0 # lm @ 0\<^bsup>a_md - Suc (pstr + length ys + n)\<^esup> @ suf_lm)"
- proof(erule_tac exE, erule_tac exE, erule_tac exE, erule_tac exE)
- fix ap bp apa cp
- assume "aprog = ap [+] bp [+] cp \<and> length ap =
- (\<Sum>(ap, pos, n)\<leftarrow>map rec_ci gs. length ap) + 3 * length gs
- \<and> bp = mv_boxes 0 (pstr + Suc (length ys)) n"
- from this and k2 show "?thesis"
- apply(simp)
- apply(rule_tac abc_append_exc1, simp, simp, simp)
- done
- qed
-qed
-
-lemma ci_cn_para_eq:
- "rec_ci (Cn n f gs) = (aprog, rs_pos, a_md) \<Longrightarrow> rs_pos = n"
-apply(simp add: rec_ci.simps, case_tac "rec_ci f", simp)
-done
-
-lemma calc_gs_prog_ex:
- "\<lbrakk>rec_ci (Cn n f gs) = (aprog, rs_pos, a_md);
- rec_ci f = (a, aa, ba);
- Max (set (Suc n # ba # map (\<lambda>(aprog, p, n). n)
- (map rec_ci (f # gs)))) = pstr\<rbrakk>
- \<Longrightarrow> \<exists>ap bp. aprog = ap [+] bp \<and>
- ap = cn_merge_gs (map rec_ci gs) pstr"
-apply(simp add: rec_ci.simps)
-apply(rule_tac x = "mv_boxes 0 (Suc (max (Suc n)
- (Max (insert ba (((\<lambda>(aprog, p, n). n) \<circ> rec_ci) ` set gs))) + length gs)) n [+]
- mv_boxes (max (Suc n) (Max (insert ba
- (((\<lambda>(aprog, p, n). n) \<circ> rec_ci) ` set gs)))) 0 (length gs) [+]
- a [+] recursive.empty aa (max (Suc n)
- (Max (insert ba (((\<lambda>(aprog, p, n). n) \<circ> rec_ci) ` set gs)))) [+]
- empty_boxes (length gs) [+] recursive.empty (max (Suc n)
- (Max (insert ba (((\<lambda>(aprog, p, n). n) \<circ> rec_ci) ` set gs)))) n [+]
- mv_boxes (Suc (max (Suc n) (Max
- (insert ba (((\<lambda>(aprog, p, n). n) \<circ> rec_ci) ` set gs))) + length gs)) 0 n"
- in exI)
-apply(auto simp: abc_append_commute)
-done
-
-lemma cn_calc_gs:
- assumes ind:
- "\<And>x aprog a_md rs_pos rs suf_lm lm.
- \<lbrakk>x \<in> set gs;
- rec_ci x = (aprog, rs_pos, a_md);
- rec_calc_rel x lm rs\<rbrakk>
- \<Longrightarrow> \<exists>stp. abc_steps_l (0, lm @ 0\<^bsup>a_md - rs_pos\<^esup> @ suf_lm) aprog stp =
- (length aprog, lm @ [rs] @ 0\<^bsup>a_md - rs_pos - 1\<^esup> @ suf_lm)"
- and h: "rec_ci (Cn n f gs) = (aprog, rs_pos, a_md)"
- "\<forall>k<length gs. rec_calc_rel (gs ! k) lm (ys ! k)"
- "length ys = length gs"
- "length lm = n"
- "rec_ci f = (a, aa, ba)"
- "Max (set (Suc n # ba # map (\<lambda>(aprog, p, n). n)
- (map rec_ci (f # gs)))) = pstr"
- shows
- "\<exists>stp. abc_steps_l (0, lm @ 0\<^bsup>a_md - rs_pos\<^esup> @ suf_lm) aprog stp =
- ((\<Sum>(ap, pos, n)\<leftarrow>map rec_ci gs. length ap) + 3 * length gs,
- lm @ 0\<^bsup>pstr - n\<^esup> @ ys @ 0\<^bsup>a_md -pstr - length ys\<^esup> @ suf_lm) "
-proof -
- from h have k1:
- "\<exists> ap bp. aprog = ap [+] bp \<and> ap =
- cn_merge_gs (map rec_ci gs) pstr"
- by(erule_tac calc_gs_prog_ex, auto)
- from h have j1: "rs_pos = n"
- by(simp add: ci_cn_para_eq)
- from h have j2: "a_md \<ge> pstr"
- by(drule_tac a = a and aa = aa and ba = ba in
- ci_cn_md_def, simp, simp)
- from h have j3: "pstr > n"
- by(auto)
- from j1 and j2 and j3 and h have k2:
- "\<exists>stp. abc_steps_l (0, lm @ 0\<^bsup>a_md - rs_pos\<^esup> @ suf_lm)
- (cn_merge_gs (map rec_ci gs) pstr) stp
- = ((\<Sum>(ap, pos, n)\<leftarrow>map rec_ci gs. length ap) + 3 * length gs,
- lm @ 0\<^bsup>pstr - n\<^esup> @ ys @ 0\<^bsup>a_md - pstr - length ys\<^esup> @ suf_lm)"
- apply(simp)
- apply(rule_tac cn_merge_gs_ex, rule_tac ind, simp, simp, auto)
- apply(drule_tac a = a and aa = aa and ba = ba in
- ci_cn_md_def, simp, simp)
- apply(rule min_max.le_supI2, auto)
- done
- from k1 show "?thesis"
- proof(erule_tac exE, erule_tac exE, simp)
- fix ap bp
- from k2 show
- "\<exists>stp. abc_steps_l (0, lm @ 0\<^bsup>a_md - rs_pos\<^esup> @ suf_lm)
- (cn_merge_gs (map rec_ci gs) pstr [+] bp) stp =
- (listsum (map ((\<lambda>(ap, pos, n). length ap) \<circ> rec_ci) gs) +
- 3 * length gs,
- lm @ 0\<^bsup>pstr - n\<^esup> @ ys @ 0\<^bsup>a_md - (pstr + length ys)\<^esup> @ suf_lm)"
- apply(insert abc_append_exc1[of
- "lm @ 0\<^bsup>a_md - rs_pos\<^esup> @ suf_lm"
- "(cn_merge_gs (map rec_ci gs) pstr)"
- "length (cn_merge_gs (map rec_ci gs) pstr)"
- "lm @ 0\<^bsup>pstr - n\<^esup> @ ys @ 0\<^bsup>a_md - pstr - length ys\<^esup> @ suf_lm" 0
- "[]" bp], simp add: cn_merge_gs_len)
- done
- qed
-qed
-
-lemma reset_new_paras':
- "\<lbrakk>length lm = n;
- pstr > 0;
- a_md \<ge> pstr + length ys + n;
- pstr > length ys\<rbrakk> \<Longrightarrow>
- \<exists>stp. abc_steps_l (0, 0\<^bsup>pstr\<^esup> @ ys @ 0 # lm @ 0\<^bsup>a_md - Suc (pstr + length ys + n)\<^esup> @
- suf_lm) (mv_boxes pstr 0 (length ys)) stp =
- (3 * length ys, ys @ 0\<^bsup>pstr\<^esup> @ 0 # lm @ 0\<^bsup>a_md - Suc (pstr + length ys + n)\<^esup> @ suf_lm)"
-thm mv_boxes_ex2
-apply(insert mv_boxes_ex2[of "length ys" "pstr" 0 "[]"
- "0\<^bsup>pstr - length ys\<^esup>" "ys"
- "0 # lm @ 0\<^bsup>a_md - Suc (pstr + length ys + n)\<^esup> @ suf_lm"],
- simp add: exponent_add_iff)
-done
-
-lemma [simp]:
- "\<lbrakk>rec_ci (Cn n f gs) = (aprog, rs_pos, a_md);
- rec_calc_rel f ys rs; rec_ci f = (a, aa, ba);
- pstr = Max (set (Suc n # ba # map (\<lambda>(aprog, p, n). n)
- (map rec_ci (f # gs))))\<rbrakk>
- \<Longrightarrow> length ys < pstr"
-apply(subgoal_tac "length ys = aa", simp)
-apply(subgoal_tac "aa < ba \<and> ba \<le> pstr",
- rule basic_trans_rules(22), auto)
-apply(rule min_max.le_supI2)
-apply(auto)
-apply(erule_tac para_pattern, simp)
-done
-
-lemma reset_new_paras_prog_ex:
- "\<lbrakk>rec_ci (Cn n f gs) = (aprog, rs_pos, a_md);
- rec_ci f = (a, aa, ba);
- Max (set (Suc n # ba # map (\<lambda>(aprog, p, n). n)
- (map rec_ci (f # gs)))) = pstr\<rbrakk>
- \<Longrightarrow> \<exists> ap bp cp. aprog = ap [+] bp [+] cp \<and>
- length ap = (\<Sum>(ap, pos, n)\<leftarrow>map rec_ci gs. length ap) +
- 3 *length gs + 3 * n \<and> bp = mv_boxes pstr 0 (length gs)"
-apply(simp add: rec_ci.simps)
-apply(rule_tac x = "cn_merge_gs (map rec_ci gs) (max (Suc n)
- (Max (insert ba (((\<lambda>(aprog, p, n). n) \<circ> rec_ci) ` set gs)))) [+]
- mv_boxes 0 (Suc (max (Suc n) (Max (insert ba
- (((\<lambda>(aprog, p, n). n) \<circ> rec_ci) ` set gs))) + length gs)) n" in exI,
- simp add: cn_merge_gs_len)
-apply(rule_tac x = "a [+]
- recursive.empty aa (max (Suc n) (Max (insert ba
- (((\<lambda>(aprog, p, n). n) \<circ> rec_ci) ` set gs)))) [+]
- empty_boxes (length gs) [+] recursive.empty
- (max (Suc n) (Max (insert ba (((\<lambda>(aprog, p, n). n) \<circ> rec_ci) ` set gs)))) n
- [+] mv_boxes (Suc (max (Suc n) (Max (insert ba
- (((\<lambda>(aprog, p, n). n) \<circ> rec_ci) ` set gs))) + length gs)) 0 n" in exI,
- auto simp: abc_append_commute)
-done
-
-
-lemma reset_new_paras:
- "\<lbrakk>rec_ci (Cn n f gs) = (aprog, rs_pos, a_md);
- rs_pos = n;
- \<forall>k<length gs. rec_calc_rel (gs ! k) lm (ys ! k);
- length ys = length gs;
- length lm = n;
- length ys = aa;
- rec_ci f = (a, aa, ba);
- pstr = Max (set (Suc n # ba # map (\<lambda>(aprog, p, n). n)
- (map rec_ci (f # gs))))\<rbrakk>
-\<Longrightarrow> \<exists>stp. abc_steps_l ((\<Sum>(ap, pos, n)\<leftarrow>map rec_ci gs. length ap) +
- 3 * length gs + 3 * n,
- 0\<^bsup>pstr \<^esup>@ ys @ 0 # lm @ 0\<^bsup>a_md - Suc (pstr + length ys + n)\<^esup> @ suf_lm) aprog stp =
- ((\<Sum>(ap, pos, n)\<leftarrow>map rec_ci gs. length ap) + 6 * length gs + 3 * n,
- ys @ 0\<^bsup>pstr\<^esup> @ 0 # lm @ 0\<^bsup>a_md - Suc (pstr + length ys + n)\<^esup> @ suf_lm)"
-proof -
- assume h:
- "rec_ci (Cn n f gs) = (aprog, rs_pos, a_md)"
- "rs_pos = n"
- "length ys = aa"
- "\<forall>k<length gs. rec_calc_rel (gs ! k) lm (ys ! k)"
- "length ys = length gs" "length lm = n"
- "rec_ci f = (a, aa, ba)"
- and g: "pstr = Max (set (Suc n # ba # map (\<lambda>(aprog, p, n). n)
- (map rec_ci (f # gs))))"
- thm rec_ci.simps
- from h and g have k1:
- "\<exists> ap bp cp. aprog = ap [+] bp [+] cp \<and> length ap =
- (\<Sum>(ap, pos, n)\<leftarrow>map rec_ci gs. length ap) +
- 3 *length gs + 3 * n \<and> bp = mv_boxes pstr 0 (length ys)"
- by(drule_tac reset_new_paras_prog_ex, auto)
- from h have k2:
- "\<exists> stp. abc_steps_l (0, 0\<^bsup>pstr \<^esup>@ ys @ 0 # lm @ 0\<^bsup>a_md - Suc (pstr + length ys + n)\<^esup> @
- suf_lm) (mv_boxes pstr 0 (length ys)) stp =
- (3 * (length ys),
- ys @ 0\<^bsup>pstr\<^esup> @ 0 # lm @ 0\<^bsup>a_md - Suc (pstr + length ys + n)\<^esup> @ suf_lm)"
- apply(rule_tac reset_new_paras', simp)
- apply(simp add: g)
- apply(drule_tac a = a and aa = aa and ba = ba in ci_cn_md_def,
- simp, simp add: g, simp)
- apply(subgoal_tac "length gs = aa \<and> aa < ba \<and> ba \<le> pstr", arith,
- simp add: para_pattern)
- apply(insert g, auto intro: min_max.le_supI2)
- done
- from k1 show
- "\<exists>stp. abc_steps_l ((\<Sum>(ap, pos, n)\<leftarrow>map rec_ci gs. length ap) + 3
- * length gs + 3 * n, 0\<^bsup>pstr\<^esup> @ ys @ 0 # lm @ 0\<^bsup>a_md - Suc (pstr + length ys + n)\<^esup> @
- suf_lm) aprog stp =
- ((\<Sum>(ap, pos, n)\<leftarrow>map rec_ci gs. length ap) + 6 * length gs +
- 3 * n, ys @ 0\<^bsup>pstr\<^esup> @ 0 # lm @ 0\<^bsup>a_md - Suc (pstr + length ys + n)\<^esup> @ suf_lm)"
- proof(erule_tac exE, erule_tac exE, erule_tac exE, erule_tac exE)
- fix ap bp apa cp
- assume "aprog = ap [+] bp [+] cp \<and> length ap =
- (\<Sum>(ap, pos, n)\<leftarrow>map rec_ci gs. length ap) + 3 * length gs +
- 3 * n \<and> bp = mv_boxes pstr 0 (length ys)"
- from this and k2 show "?thesis"
- apply(simp)
- apply(drule_tac as =
- "(\<Sum>(ap, pos, n)\<leftarrow>map rec_ci gs. length ap) + 3 * length gs +
- 3 * n" and ap = ap and cp = cp in abc_append_exc1, auto)
- apply(rule_tac x = stp in exI, simp add: h)
- using h
- apply(simp)
- done
- qed
-qed
-
-thm rec_ci.simps
-
-lemma calc_f_prog_ex:
- "\<lbrakk>rec_ci (Cn n f gs) = (aprog, rs_pos, a_md);
- rec_ci f = (a, aa, ba);
- Max (set (Suc n # ba # map (\<lambda>(aprog, p, n). n)
- (map rec_ci (f # gs)))) = pstr\<rbrakk>
- \<Longrightarrow> \<exists> ap bp cp. aprog = ap [+] bp [+] cp \<and>
- length ap = (\<Sum>(ap, pos, n)\<leftarrow>map rec_ci gs. length ap) +
- 6 *length gs + 3 * n \<and> bp = a"
-apply(simp add: rec_ci.simps)
-apply(rule_tac x = "cn_merge_gs (map rec_ci gs) (max (Suc n) (Max (insert ba
- (((\<lambda>(aprog, p, n). n) \<circ> rec_ci) ` set gs)))) [+]
- mv_boxes 0 (Suc (max (Suc n) (Max (insert ba
- (((\<lambda>(aprog, p, n). n) \<circ> rec_ci) ` set gs))) + length gs)) n [+]
- mv_boxes (max (Suc n) (Max (insert ba
- (((\<lambda>(aprog, p, n). n) \<circ> rec_ci) ` set gs)))) 0 (length gs)" in exI,
- simp add: cn_merge_gs_len)
-apply(rule_tac x = "recursive.empty aa (max (Suc n) (Max (insert ba
- (((\<lambda>(aprog, p, n). n) \<circ> rec_ci) ` set gs)))) [+]
- empty_boxes (length gs) [+] recursive.empty (max (Suc n) (
- Max (insert ba (((\<lambda>(aprog, p, n). n) \<circ> rec_ci) ` set gs)))) n [+]
- mv_boxes (Suc (max (Suc n) (Max (insert ba
- (((\<lambda>(aprog, p, n). n) \<circ> rec_ci) ` set gs))) + length gs)) 0 n" in exI,
- auto simp: abc_append_commute)
-done
-
-lemma calc_cn_f:
- assumes ind:
- "\<And>x aprog a_md rs_pos rs suf_lm lm.
- \<lbrakk>x \<in> set (f # gs);
- rec_ci x = (aprog, rs_pos, a_md);
- rec_calc_rel x lm rs\<rbrakk>
- \<Longrightarrow> \<exists>stp. abc_steps_l (0, lm @ 0\<^bsup>a_md - rs_pos\<^esup> @ suf_lm) aprog stp =
- (length aprog, lm @ [rs] @ 0\<^bsup>a_md - rs_pos - 1\<^esup> @ suf_lm)"
- and h: "rec_ci (Cn n f gs) = (aprog, rs_pos, a_md)"
- "rec_calc_rel (Cn n f gs) lm rs"
- "length ys = length gs"
- "rec_calc_rel f ys rs"
- "length lm = n"
- "rec_ci f = (a, aa, ba)"
- and p: "pstr = Max (set (Suc n # ba # map (\<lambda>(aprog, p, n). n)
- (map rec_ci (f # gs))))"
- shows "\<exists>stp. abc_steps_l
- ((\<Sum>(ap, pos, n)\<leftarrow>map rec_ci gs. length ap) + 6 * length gs + 3 * n,
- ys @ 0\<^bsup>pstr\<^esup> @ 0 # lm @ 0\<^bsup>a_md - Suc (pstr + length ys + n)\<^esup> @ suf_lm) aprog stp =
- ((\<Sum>(ap, pos, n)\<leftarrow>map rec_ci gs. length ap) + 6 * length gs +
- 3 * n + length a,
- ys @ rs # 0\<^bsup>pstr\<^esup> @ lm @ 0\<^bsup>a_md - Suc (pstr + length ys + n)\<^esup> @ suf_lm)"
-proof -
- from h have k1:
- "\<exists> ap bp cp. aprog = ap [+] bp [+] cp \<and>
- length ap = (\<Sum>(ap, pos, n)\<leftarrow>map rec_ci gs. length ap) +
- 6 *length gs + 3 * n \<and> bp = a"
- by(drule_tac calc_f_prog_ex, auto)
- from h and k1 show "?thesis"
- proof (erule_tac exE, erule_tac exE, erule_tac exE, erule_tac exE)
- fix ap bp apa cp
- assume
- "aprog = ap [+] bp [+] cp \<and>
- length ap = (\<Sum>(ap, pos, n)\<leftarrow>map rec_ci gs. length ap) +
- 6 * length gs + 3 * n \<and> bp = a"
- from h and this show "?thesis"
- apply(simp, rule_tac abc_append_exc1, simp_all)
- apply(insert ind[of f "a" aa ba ys rs
- "0\<^bsup>pstr - ba + length gs \<^esup> @ 0 # lm @
- 0\<^bsup>a_md - Suc (pstr + length gs + n)\<^esup> @ suf_lm"], simp)
- apply(subgoal_tac "ba > aa \<and> aa = length gs\<and> pstr \<ge> ba", simp)
- apply(simp add: exponent_add_iff)
- apply(case_tac pstr, simp add: p)
- apply(simp only: exp_suc, simp)
- apply(rule conjI, rule ci_ad_ge_paras, simp, rule conjI)
- apply(subgoal_tac "length ys = aa", simp,
- rule para_pattern, simp, simp)
- apply(insert p, simp)
- apply(auto intro: min_max.le_supI2)
- done
- qed
-qed
-(*
-lemma [simp]:
- "\<lbrakk>pstr + length ys + n \<le> a_md; ys \<noteq> []\<rbrakk> \<Longrightarrow>
- pstr < a_md + length suf_lm"
-apply(case_tac "length ys", simp)
-apply(arith)
-done
-*)
-lemma [simp]:
- "pstr > length ys
- \<Longrightarrow> (ys @ rs # 0\<^bsup>pstr\<^esup> @ lm @
- 0\<^bsup>a_md - Suc (pstr + length ys + n)\<^esup> @ suf_lm) ! pstr = (0::nat)"
-apply(simp add: nth_append)
-done
-
-(*
-lemma [simp]: "\<lbrakk>length ys < pstr; pstr - length ys = Suc x\<rbrakk>
- \<Longrightarrow> pstr - Suc (length ys) = x"
-by arith
-*)
-lemma [simp]: "pstr > length ys \<Longrightarrow>
- (ys @ rs # 0\<^bsup>pstr\<^esup> @ lm @ 0\<^bsup>a_md - Suc (pstr + length ys + n)\<^esup> @ suf_lm)
- [pstr := rs, length ys := 0] =
- ys @ 0\<^bsup>pstr - length ys\<^esup> @ (rs::nat) # 0\<^bsup>length ys\<^esup> @ lm @ 0\<^bsup>a_md - Suc (pstr + length ys + n)\<^esup> @ suf_lm"
-apply(auto simp: list_update_append)
-apply(case_tac "pstr - length ys",simp_all)
-using list_update_length[of
- "0\<^bsup>pstr - Suc (length ys)\<^esup>" "0" "0\<^bsup>length ys\<^esup> @ lm @
- 0\<^bsup>a_md - Suc (pstr + length ys + n)\<^esup> @ suf_lm" rs]
-apply(simp only: exponent_cons_iff exponent_add_iff, simp)
-apply(subgoal_tac "pstr - Suc (length ys) = nat", simp, simp)
-done
-
-lemma save_rs':
- "\<lbrakk>pstr > length ys\<rbrakk>
- \<Longrightarrow> \<exists>stp. abc_steps_l (0, ys @ rs # 0\<^bsup>pstr\<^esup> @ lm @
- 0\<^bsup>a_md - Suc (pstr + length ys + n)\<^esup> @ suf_lm)
- (recursive.empty (length ys) pstr) stp =
- (3, ys @ 0\<^bsup>pstr - (length ys)\<^esup> @ rs #
- 0\<^bsup>length ys \<^esup> @ lm @ 0\<^bsup>a_md - Suc (pstr + length ys + n)\<^esup> @ suf_lm)"
-apply(insert empty_ex[of "length ys" pstr
- "ys @ rs # 0\<^bsup>pstr\<^esup> @ lm @ 0\<^bsup>a_md - Suc(pstr + length ys + n)\<^esup> @ suf_lm"],
- simp)
-done
-
-
-lemma save_rs_prog_ex:
- "\<lbrakk>rec_ci (Cn n f gs) = (aprog, rs_pos, a_md);
- rec_ci f = (a, aa, ba);
- Max (set (Suc n # ba # map (\<lambda>(aprog, p, n). n)
- (map rec_ci (f # gs)))) = pstr\<rbrakk>
- \<Longrightarrow> \<exists> ap bp cp. aprog = ap [+] bp [+] cp \<and>
- length ap = (\<Sum>(ap, pos, n)\<leftarrow>map rec_ci gs. length ap) +
- 6 *length gs + 3 * n + length a
- \<and> bp = empty aa pstr"
-apply(simp add: rec_ci.simps)
-apply(rule_tac x =
- "cn_merge_gs (map rec_ci gs) (max (Suc n) (Max (insert ba
- (((\<lambda>(aprog, p, n). n) \<circ> rec_ci) ` set gs))))
- [+] mv_boxes 0 (Suc (max (Suc n) (Max (insert ba
- (((\<lambda>(aprog, p, n). n) \<circ> rec_ci) ` set gs))) + length gs)) n [+]
- mv_boxes (max (Suc n) (Max (insert ba (((\<lambda>(aprog, p, n). n) \<circ> rec_ci) ` set gs))))
- 0 (length gs) [+] a"
- in exI, simp add: cn_merge_gs_len)
-apply(rule_tac x =
- "empty_boxes (length gs) [+]
- recursive.empty (max (Suc n) (Max (insert ba
- (((\<lambda>(aprog, p, n). n) \<circ> rec_ci) ` set gs)))) n [+]
- mv_boxes (Suc (max (Suc n) (Max (insert ba (((\<lambda>(aprog, p, n). n) \<circ> rec_ci) ` set gs)))
- + length gs)) 0 n" in exI,
- auto simp: abc_append_commute)
-done
-
-lemma save_rs:
- assumes h:
- "rec_ci (Cn n f gs) = (aprog, rs_pos, a_md)"
- "rec_calc_rel (Cn n f gs) lm rs"
- "\<forall>k<length gs. rec_calc_rel (gs ! k) lm (ys ! k)"
- "length ys = length gs"
- "rec_calc_rel f ys rs"
- "rec_ci f = (a, aa, ba)"
- "length lm = n"
- and pdef: "pstr = Max (set (Suc n # ba # map (\<lambda>(aprog, p, n). n)
- (map rec_ci (f # gs))))"
- shows "\<exists>stp. abc_steps_l
- ((\<Sum>(ap, pos, n)\<leftarrow>map rec_ci gs. length ap) + 6 * length gs
- + 3 * n + length a, ys @ rs # 0\<^bsup>pstr\<^esup> @ lm @
- 0\<^bsup>a_md - Suc (pstr + length ys + n)\<^esup> @ suf_lm) aprog stp =
- ((\<Sum>(ap, pos, n)\<leftarrow>map rec_ci gs. length ap) + 6 * length gs
- + 3 * n + length a + 3,
- ys @ 0\<^bsup>pstr - length ys \<^esup> @ rs # 0\<^bsup>length ys\<^esup> @ lm @
- 0\<^bsup>a_md - Suc (pstr + length ys + n)\<^esup> @ suf_lm)"
-proof -
- thm rec_ci.simps
- from h and pdef have k1:
- "\<exists> ap bp cp. aprog = ap [+] bp [+] cp \<and>
- length ap = (\<Sum>(ap, pos, n)\<leftarrow>map rec_ci gs. length ap) +
- 6 *length gs + 3 * n + length a \<and> bp = empty (length ys) pstr "
- apply(subgoal_tac "length ys = aa")
- apply(drule_tac a = a and aa = aa and ba = ba in save_rs_prog_ex,
- simp, simp, simp)
- by(rule_tac para_pattern, simp, simp)
- from k1 show
- "\<exists>stp. abc_steps_l
- ((\<Sum>(ap, pos, n)\<leftarrow>map rec_ci gs. length ap) + 6 * length gs + 3 * n
- + length a, ys @ rs # 0\<^bsup>pstr \<^esup>@ lm @ 0\<^bsup>a_md - Suc (pstr + length ys + n)\<^esup>
- @ suf_lm) aprog stp =
- ((\<Sum>(ap, pos, n)\<leftarrow>map rec_ci gs. length ap) + 6 * length gs + 3 * n
- + length a + 3, ys @ 0\<^bsup>pstr - length ys\<^esup> @ rs #
- 0\<^bsup>length ys\<^esup> @ lm @ 0\<^bsup>a_md - Suc (pstr + length ys + n)\<^esup> @ suf_lm)"
- proof (erule_tac exE, erule_tac exE, erule_tac exE, erule_tac exE)
- fix ap bp apa cp
- assume "aprog = ap [+] bp [+] cp \<and> length ap =
- (\<Sum>(ap, pos, n)\<leftarrow>map rec_ci gs. length ap) + 6 * length gs +
- 3 * n + length a \<and> bp = recursive.empty (length ys) pstr"
- thus"?thesis"
- apply(simp, rule_tac abc_append_exc1, simp_all)
- apply(rule_tac save_rs', insert h)
- apply(subgoal_tac "length gs = aa \<and> pstr \<ge> ba \<and> ba > aa",
- arith)
- apply(simp add: para_pattern, insert pdef, auto)
- apply(rule_tac min_max.le_supI2, simp)
- done
- qed
-qed
-
-lemma [simp]: "length (empty_boxes n) = 2*n"
-apply(induct n, simp, simp)
-done
-
-lemma empty_step_ex: "length lm = n \<Longrightarrow>
- \<exists>stp. abc_steps_l (0, lm @ Suc x # suf_lm) [Dec n 2, Goto 0] stp
- = (0, lm @ x # suf_lm)"
-apply(rule_tac x = "Suc (Suc 0)" in exI,
- simp add: abc_steps_l.simps abc_step_l.simps abc_fetch.simps
- abc_lm_v.simps abc_lm_s.simps nth_append list_update_append)
-done
-
-lemma empty_box_ex:
- "\<lbrakk>length lm = n\<rbrakk> \<Longrightarrow>
- \<exists> stp. abc_steps_l (0, lm @ x # suf_lm) [Dec n 2, Goto 0] stp =
- (Suc (Suc 0), lm @ 0 # suf_lm)"
-apply(induct x)
-apply(rule_tac x = "Suc 0" in exI,
- simp add: abc_steps_l.simps abc_fetch.simps abc_step_l.simps
- abc_lm_v.simps nth_append abc_lm_s.simps, simp)
-apply(drule_tac x = x and suf_lm = suf_lm in empty_step_ex,
- erule_tac exE, erule_tac exE)
-apply(rule_tac x = "stpa + stp" in exI, simp add: abc_steps_add)
-done
-
-lemma [simp]: "drop n lm = a # list \<Longrightarrow> list = drop (Suc n) lm"
-apply(induct n arbitrary: lm a list, simp)
-apply(case_tac "lm", simp, simp)
-done
-
-lemma empty_boxes_ex: "\<lbrakk>length lm \<ge> n\<rbrakk>
- \<Longrightarrow> \<exists>stp. abc_steps_l (0, lm) (empty_boxes n) stp =
- (2*n, 0\<^bsup>n\<^esup> @ drop n lm)"
-apply(induct n, simp, simp)
-apply(rule_tac abc_append_exc2, auto)
-apply(case_tac "drop n lm", simp, simp)
-proof -
- fix n stp a list
- assume h: "Suc n \<le> length lm" "drop n lm = a # list"
- thus "\<exists>bstp. abc_steps_l (0, 0\<^bsup>n\<^esup> @ a # list) [Dec n 2, Goto 0] bstp =
- (Suc (Suc 0), 0 # 0\<^bsup>n\<^esup> @ drop (Suc n) lm)"
- apply(insert empty_box_ex[of "0\<^bsup>n\<^esup>" n a list], simp, erule_tac exE)
- apply(rule_tac x = stp in exI, simp, simp only: exponent_cons_iff)
- apply(simp add: exponent_def rep_ind del: replicate.simps)
- done
-qed
-
-
-lemma empty_paras_prog_ex:
- "\<lbrakk>rec_ci (Cn n f gs) = (aprog, rs_pos, a_md);
- rec_ci f = (a, aa, ba);
- Max (set (Suc n # ba # map (\<lambda>(aprog, p, n). n)
- (map rec_ci (f # gs)))) = pstr\<rbrakk>
- \<Longrightarrow> \<exists> ap bp cp. aprog = ap [+] bp [+] cp \<and>
- length ap = (\<Sum>(ap, pos, n)\<leftarrow>map rec_ci gs. length ap) +
- 6 *length gs + 3 * n + length a + 3 \<and> bp = empty_boxes (length gs)"
-apply(simp add: rec_ci.simps)
-apply(rule_tac x = "cn_merge_gs (map rec_ci gs) (max (Suc n)
- (Max (insert ba (((\<lambda>(aprog, p, n). n) \<circ> rec_ci) ` set gs)))) [+]
- mv_boxes 0 (Suc (max (Suc n) (Max
- (insert ba (((\<lambda>(aprog, p, n). n) \<circ> rec_ci) ` set gs))) + length gs)) n
- [+] mv_boxes (max (Suc n) (Max (insert ba
- (((\<lambda>(aprog, p, n). n) \<circ> rec_ci) ` set gs)))) 0 (length gs) [+]
- a [+] recursive.empty aa (max (Suc n)
- (Max (insert ba (((\<lambda>(aprog, p, n). n) \<circ> rec_ci) ` set gs))))"
- in exI, simp add: cn_merge_gs_len)
-apply(rule_tac x = " recursive.empty (max (Suc n) (Max (insert ba
- (((\<lambda>(aprog, p, n). n) \<circ> rec_ci) ` set gs)))) n [+]
- mv_boxes (Suc (max (Suc n) (Max (insert ba
- (((\<lambda>(aprog, p, n). n) \<circ> rec_ci) ` set gs))) + length gs)) 0 n" in exI,
- auto simp: abc_append_commute)
-done
-
-lemma empty_paras:
- assumes h:
- "rec_ci (Cn n f gs) = (aprog, rs_pos, a_md)"
- "rec_calc_rel (Cn n f gs) lm rs"
- "\<forall>k<length gs. rec_calc_rel (gs ! k) lm (ys ! k)"
- "length ys = length gs"
- "rec_calc_rel f ys rs"
- "rec_ci f = (a, aa, ba)"
- and pdef: "pstr = Max (set (Suc n # ba # map (\<lambda>(aprog, p, n). n)
- (map rec_ci (f # gs))))"
- and starts: "ss = (\<Sum>(ap, pos, n)\<leftarrow>map rec_ci gs. length ap) +
- 6 * length gs + 3 * n + length a + 3"
- shows "\<exists>stp. abc_steps_l
- (ss, ys @ 0\<^bsup>pstr - length ys\<^esup> @ rs # 0\<^bsup>length ys\<^esup>
- @ lm @ 0\<^bsup>a_md - Suc (pstr + length ys + n)\<^esup> @ suf_lm) aprog stp =
- (ss + 2 * length gs, 0\<^bsup>pstr\<^esup> @ rs # 0\<^bsup>length ys \<^esup> @ lm @
- 0\<^bsup>a_md - Suc (pstr + length ys + n)\<^esup> @ suf_lm)"
-proof -
- from h and pdef and starts have k1:
- "\<exists> ap bp cp. aprog = ap [+] bp [+] cp \<and>
- length ap = (\<Sum>(ap, pos, n)\<leftarrow>map rec_ci gs. length ap) +
- 6 *length gs + 3 * n + length a + 3
- \<and> bp = empty_boxes (length ys)"
- by(drule_tac empty_paras_prog_ex, auto)
- from h have j1: "aa < ba"
- by(simp add: ci_ad_ge_paras)
- from h have j2: "length gs = aa"
- by(drule_tac f = f in para_pattern, simp, simp)
- from h and pdef have j3: "ba \<le> pstr"
- apply simp
- apply(rule_tac min_max.le_supI2, simp)
- done
- from k1 show "?thesis"
- proof (erule_tac exE, erule_tac exE, erule_tac exE, erule_tac exE)
- fix ap bp apa cp
- assume "aprog = ap [+] bp [+] cp \<and>
- length ap = (\<Sum>(ap, pos, n)\<leftarrow>map rec_ci gs. length ap) +
- 6 * length gs + 3 * n + length a + 3 \<and>
- bp = empty_boxes (length ys)"
- thus"?thesis"
- apply(simp, rule_tac abc_append_exc1, simp_all add: starts h)
- apply(insert empty_boxes_ex[of
- "length gs" "ys @ 0\<^bsup>pstr - (length gs)\<^esup> @ rs #
- 0\<^bsup>length gs\<^esup> @ lm @ 0\<^bsup>a_md - Suc (pstr + length gs + n)\<^esup> @ suf_lm"],
- simp add: h)
- apply(erule_tac exE, rule_tac x = stp in exI,
- simp add: exponent_def replicate.simps[THEN sym]
- replicate_add[THEN sym] del: replicate.simps)
- apply(subgoal_tac "pstr >(length gs)", simp)
- apply(subgoal_tac "ba > aa \<and> length gs = aa \<and> pstr \<ge> ba", simp)
- apply(simp add: j1 j2 j3)
- done
- qed
-qed
-
-(*
-lemma [simp]: " n < pstr \<Longrightarrow>
- (0\<^bsup>pstr\<^esup>)[n := rs] @ [0::nat] = 0\<^bsup>n\<^esup> @ rs # 0\<^bsup>pstr - n\<^esup>"
-apply(insert list_update_length[of "0\<^bsup>n\<^esup>" 0 "0\<^bsup>pstr - Suc n\<^esup>" rs])
-apply(insert exponent_cons_iff[of "0::nat" "pstr - Suc n" "[]"], simp)
-apply(insert exponent_add_iff[of "0::nat" n "pstr - n" "[]"], simp)
-apply(case_tac "pstr - n", simp, simp only: exp_suc, simp)
-apply(subgoal_tac "pstr - Suc n = nat", simp)
-by arith
-*)
-
-lemma restore_rs_prog_ex:
- "\<lbrakk>rec_ci (Cn n f gs) = (aprog, rs_pos, a_md);
- rec_ci f = (a, aa, ba);
- Max (set (Suc n # ba # map (\<lambda>(aprog, p, n). n)
- (map rec_ci (f # gs)))) = pstr;
- ss = (\<Sum>(ap, pos, n)\<leftarrow>map rec_ci gs. length ap) +
- 8 * length gs + 3 * n + length a + 3\<rbrakk>
- \<Longrightarrow> \<exists> ap bp cp. aprog = ap [+] bp [+] cp \<and> length ap = ss \<and>
- bp = empty pstr n"
-apply(simp add: rec_ci.simps)
-apply(rule_tac x = "cn_merge_gs (map rec_ci gs) (max (Suc n)
- (Max (insert ba (((\<lambda>(aprog, p, n). n) \<circ> rec_ci) ` set gs)))) [+]
- mv_boxes 0 (Suc (max (Suc n) (Max (insert ba (((\<lambda>(aprog, p, n). n)
- \<circ> rec_ci) ` set gs))) + length gs)) n [+]
- mv_boxes (max (Suc n) (Max (insert ba
- (((\<lambda>(aprog, p, n). n) \<circ> rec_ci) ` set gs)))) 0 (length gs) [+]
- a [+] recursive.empty aa (max (Suc n)
- (Max (insert ba (((\<lambda>(aprog, p, n). n) \<circ> rec_ci) ` set gs)))) [+]
- empty_boxes (length gs)" in exI, simp add: cn_merge_gs_len)
-apply(rule_tac x = "mv_boxes (Suc (max (Suc n)
- (Max (insert ba (((\<lambda>(aprog, p, n). n) \<circ> rec_ci) ` set gs)))
- + length gs)) 0 n"
- in exI, auto simp: abc_append_commute)
-done
-
-lemma exp_add: "a\<^bsup>b+c\<^esup> = a\<^bsup>b\<^esup> @ a\<^bsup>c\<^esup>"
-apply(simp add: exponent_def replicate_add)
-done
-
-lemma [simp]: "n < pstr \<Longrightarrow> (0\<^bsup>pstr\<^esup>)[n := rs] @ [0::nat] = 0\<^bsup>n\<^esup> @ rs # 0\<^bsup>pstr - n\<^esup>"
-using list_update_length[of "0\<^bsup>n\<^esup>" "0::nat" "0\<^bsup>pstr - Suc n\<^esup>" rs]
-apply(simp add: exp_ind_def[THEN sym] exp_add[THEN sym] exp_suc[THEN sym])
-done
-
-lemma restore_rs:
- assumes h: "rec_ci (Cn n f gs) = (aprog, rs_pos, a_md)"
- "rec_calc_rel (Cn n f gs) lm rs"
- "\<forall>k<length gs. rec_calc_rel (gs ! k) lm (ys ! k)"
- "length ys = length gs"
- "rec_calc_rel f ys rs"
- "rec_ci f = (a, aa, ba)"
- and pdef: "pstr = Max (set (Suc n # ba # map (\<lambda>(aprog, p, n). n)
- (map rec_ci (f # gs))))"
- and starts: "ss = (\<Sum>(ap, pos, n)\<leftarrow>map rec_ci gs. length ap) +
- 8 * length gs + 3 * n + length a + 3"
- shows "\<exists>stp. abc_steps_l
- (ss, 0\<^bsup>pstr\<^esup> @ rs # 0\<^bsup>length ys \<^esup> @ lm @
- 0\<^bsup>a_md - Suc (pstr + length ys + n)\<^esup> @ suf_lm) aprog stp =
- (ss + 3, 0\<^bsup>n\<^esup> @ rs # 0\<^bsup>pstr - n\<^esup> @ 0\<^bsup>length ys \<^esup> @ lm @
- 0\<^bsup>a_md - Suc (pstr + length ys + n)\<^esup> @ suf_lm)"
-proof -
- from h and pdef and starts have k1:
- "\<exists> ap bp cp. aprog = ap [+] bp [+] cp \<and> length ap = ss \<and>
- bp = empty pstr n"
- by(drule_tac restore_rs_prog_ex, auto)
- from k1 show "?thesis"
- proof (erule_tac exE, erule_tac exE, erule_tac exE, erule_tac exE)
- fix ap bp apa cp
- assume "aprog = ap [+] bp [+] cp \<and> length ap = ss \<and>
- bp = recursive.empty pstr n"
- thus"?thesis"
- apply(simp, rule_tac abc_append_exc1, simp_all add: starts h)
- apply(insert empty_ex[of pstr n "0\<^bsup>pstr\<^esup> @ rs # 0\<^bsup>length gs\<^esup> @
- lm @ 0\<^bsup>a_md - Suc (pstr + length gs + n)\<^esup> @ suf_lm"], simp)
- apply(subgoal_tac "pstr > n", simp)
- apply(erule_tac exE, rule_tac x = stp in exI,
- simp add: nth_append list_update_append)
- apply(simp add: pdef)
- done
- qed
-qed
-
-lemma [simp]:"xs \<noteq> [] \<Longrightarrow> length xs \<ge> Suc 0"
-by(case_tac xs, auto)
-
-lemma [simp]: "n < max (Suc n) (max ba (Max (((\<lambda>(aprog, p, n). n) o
- rec_ci) ` set gs)))"
-by(simp)
-
-lemma restore_paras_prog_ex:
- "\<lbrakk>rec_ci (Cn n f gs) = (aprog, rs_pos, a_md);
- rec_ci f = (a, aa, ba);
- Max (set (Suc n # ba # map (\<lambda>(aprog, p, n). n)
- (map rec_ci (f # gs)))) = pstr;
- ss = (\<Sum>(ap, pos, n)\<leftarrow>map rec_ci gs. length ap) +
- 8 * length gs + 3 * n + length a + 6\<rbrakk>
- \<Longrightarrow> \<exists> ap bp cp. aprog = ap [+] bp [+] cp \<and> length ap = ss \<and>
- bp = mv_boxes (pstr + Suc (length gs)) (0::nat) n"
-apply(simp add: rec_ci.simps)
-apply(rule_tac x = "cn_merge_gs (map rec_ci gs) (max (Suc n)
- (Max (insert ba (((\<lambda>(aprog, p, n). n) \<circ> rec_ci) ` set gs))))
- [+] mv_boxes 0 (Suc (max (Suc n)
- (Max (insert ba (((\<lambda>(aprog, p, n). n) \<circ> rec_ci) ` set gs)))
- + length gs)) n [+] mv_boxes (max (Suc n)
- (Max (insert ba (((\<lambda>(aprog, p, n). n) \<circ> rec_ci) ` set gs)))) 0 (length gs) [+]
- a [+] recursive.empty aa (max (Suc n)
- (Max (insert ba (((\<lambda>(aprog, p, n). n) \<circ> rec_ci) ` set gs)))) [+]
- empty_boxes (length gs) [+]
- recursive.empty (max (Suc n) (Max (insert ba
- (((\<lambda>(aprog, p, n). n) \<circ> rec_ci) ` set gs)))) n" in exI, simp add: cn_merge_gs_len)
-apply(rule_tac x = "[]" in exI, auto simp: abc_append_commute)
-done
-
-lemma restore_paras:
- assumes h: "rec_ci (Cn n f gs) = (aprog, rs_pos, a_md)"
- "rec_calc_rel (Cn n f gs) lm rs"
- "\<forall>k<length gs. rec_calc_rel (gs ! k) lm (ys ! k)"
- "length ys = length gs"
- "rec_calc_rel f ys rs"
- "rec_ci f = (a, aa, ba)"
- and pdef:
- "pstr = Max (set (Suc n # ba # map (\<lambda>(aprog, p, n). n)
- (map rec_ci (f # gs))))"
- and starts: "ss = (\<Sum>(ap, pos, n)\<leftarrow>map rec_ci gs. length ap) +
- 8 * length gs + 3 * n + length a + 6"
- shows "\<exists>stp. abc_steps_l (ss, 0\<^bsup>n\<^esup> @ rs # 0\<^bsup>pstr - n+ length ys\<^esup> @
- lm @ 0\<^bsup>a_md - Suc (pstr + length ys + n)\<^esup> @ suf_lm)
- aprog stp = (ss + 3 * n, lm @ rs # 0\<^bsup>a_md - Suc n\<^esup> @ suf_lm)"
-proof -
- thm rec_ci.simps
- from h and pdef and starts have k1:
- "\<exists> ap bp cp. aprog = ap [+] bp [+] cp \<and> length ap = ss \<and>
- bp = mv_boxes (pstr + Suc (length gs)) (0::nat) n"
- by(drule_tac restore_paras_prog_ex, auto)
- from k1 show "?thesis"
- proof (erule_tac exE, erule_tac exE, erule_tac exE, erule_tac exE)
- fix ap bp apa cp
- assume "aprog = ap [+] bp [+] cp \<and> length ap = ss \<and>
- bp = mv_boxes (pstr + Suc (length gs)) 0 n"
- thus"?thesis"
- apply(simp, rule_tac abc_append_exc1, simp_all add: starts h)
- apply(insert mv_boxes_ex2[of n "pstr + Suc (length gs)" 0 "[]"
- "rs # 0\<^bsup>pstr - n + length gs\<^esup>" "lm"
- "0\<^bsup>a_md - Suc (pstr + length gs + n)\<^esup> @ suf_lm"], simp)
- apply(subgoal_tac "pstr > n \<and>
- a_md > pstr + length gs + n \<and> length lm = n" , simp add: exponent_add_iff h)
- using h pdef
- apply(simp)
- apply(frule_tac a = a and
- aa = aa and ba = ba in ci_cn_md_def, simp, simp)
- apply(subgoal_tac "length lm = rs_pos",
- simp add: ci_cn_para_eq, erule_tac para_pattern, simp)
- done
- qed
-qed
-
-lemma ci_cn_length:
- "\<lbrakk>rec_ci (Cn n f gs) = (aprog, rs_pos, a_md);
- rec_calc_rel (Cn n f gs) lm rs;
- rec_ci f = (a, aa, ba)\<rbrakk>
- \<Longrightarrow> length aprog = (\<Sum>(ap, pos, n)\<leftarrow>map rec_ci gs. length ap) +
- 8 * length gs + 6 * n + length a + 6"
-apply(simp add: rec_ci.simps, auto simp: cn_merge_gs_len)
-done
-
-
-lemma cn_case:
- assumes ind:
- "\<And>x aprog a_md rs_pos rs suf_lm lm.
- \<lbrakk>x \<in> set (f # gs);
- rec_ci x = (aprog, rs_pos, a_md);
- rec_calc_rel x lm rs\<rbrakk>
- \<Longrightarrow> \<exists>stp. abc_steps_l (0, lm @ 0\<^bsup>a_md - rs_pos\<^esup> @ suf_lm) aprog stp =
- (length aprog, lm @ [rs] @ 0\<^bsup>a_md - rs_pos - 1\<^esup> @ suf_lm)"
- and h: "rec_ci (Cn n f gs) = (aprog, rs_pos, a_md)"
- "rec_calc_rel (Cn n f gs) lm rs"
-
- shows "\<exists>stp. abc_steps_l (0, lm @ 0\<^bsup>a_md - rs_pos\<^esup> @ suf_lm) aprog stp
- = (length aprog, lm @ [rs] @ 0\<^bsup>a_md - rs_pos - 1\<^esup> @ suf_lm)"
-apply(insert h, case_tac "rec_ci f", rule_tac calc_cn_reverse, simp)
-proof -
- fix a b c ys
- let ?pstr = "Max (set (Suc n # c # (map (\<lambda>(aprog, p, n). n)
- (map rec_ci (f # gs)))))"
- let ?gs_len = "listsum (map (\<lambda> (ap, pos, n). length ap)
- (map rec_ci (gs)))"
- assume g: "rec_ci (Cn n f gs) = (aprog, rs_pos, a_md)"
- "rec_calc_rel (Cn n f gs) lm rs"
- "\<forall>k<length gs. rec_calc_rel (gs ! k) lm (ys ! k)"
- "length ys = length gs"
- "rec_calc_rel f ys rs"
- "n = length lm"
- "rec_ci f = (a, b, c)"
- hence k1:
- "\<exists> stp. abc_steps_l (0, lm @ 0\<^bsup>a_md - rs_pos\<^esup> @ suf_lm) aprog stp =
- (?gs_len + 3 * length gs, lm @ 0\<^bsup>?pstr - n\<^esup> @ ys @
- 0\<^bsup>a_md - ?pstr - length ys\<^esup> @ suf_lm)"
- apply(rule_tac a = a and aa = b and ba = c in cn_calc_gs)
- apply(rule_tac ind, auto)
- done
- thm rec_ci.simps
- from g have k2:
- "\<exists> stp. abc_steps_l (?gs_len + 3 * length gs, lm @
- 0\<^bsup>?pstr - n\<^esup> @ ys @ 0\<^bsup>a_md - ?pstr - length ys\<^esup> @ suf_lm) aprog stp =
- (?gs_len + 3 * length gs + 3 * n, 0\<^bsup>?pstr\<^esup> @ ys @ 0 # lm @
- 0\<^bsup>a_md - Suc (?pstr + length ys + n )\<^esup> @ suf_lm)"
- thm save_paras
- apply(erule_tac ba = c in save_paras, auto intro: ci_cn_para_eq)
- done
- from g have k3:
- "\<exists> stp. abc_steps_l (?gs_len + 3 * length gs + 3 * n,
- 0\<^bsup>?pstr\<^esup> @ ys @ 0 # lm @ 0\<^bsup>a_md - Suc (?pstr + length ys + n)\<^esup> @ suf_lm) aprog stp =
- (?gs_len + 6 * length gs + 3 * n,
- ys @ 0\<^bsup>?pstr\<^esup> @ 0 # lm @ 0\<^bsup>a_md - Suc (?pstr + length ys + n)\<^esup> @ suf_lm)"
- apply(erule_tac ba = c in reset_new_paras,
- auto intro: ci_cn_para_eq)
- using para_pattern[of f a b c ys rs]
- apply(simp)
- done
- from g have k4:
- "\<exists>stp. abc_steps_l (?gs_len + 6 * length gs + 3 * n,
- ys @ 0\<^bsup>?pstr\<^esup> @ 0 # lm @ 0\<^bsup>a_md - Suc (?pstr + length ys + n)\<^esup> @ suf_lm) aprog stp =
- (?gs_len + 6 * length gs + 3 * n + length a,
- ys @ rs # 0\<^bsup>?pstr \<^esup> @ lm @ 0\<^bsup>a_md - Suc (?pstr + length ys + n)\<^esup> @ suf_lm)"
- apply(rule_tac ba = c in calc_cn_f, rule_tac ind, auto)
- done
-thm rec_ci.simps
- from g h have k5:
- "\<exists> stp. abc_steps_l (?gs_len + 6 * length gs + 3 * n + length a,
- ys @ rs # 0\<^bsup>?pstr \<^esup>@ lm @ 0\<^bsup>a_md - Suc (?pstr + length ys + n)\<^esup> @ suf_lm)
- aprog stp =
- (?gs_len + 6 * length gs + 3 * n + length a + 3,
- ys @ 0\<^bsup>?pstr - length ys\<^esup> @ rs # 0\<^bsup>length ys\<^esup> @ lm @
- 0\<^bsup>a_md - Suc (?pstr + length ys + n)\<^esup> @ suf_lm)"
- apply(rule_tac save_rs, auto simp: h)
- done
- thm rec_ci.simps
- thm empty_boxes.simps
- from g have k6:
- "\<exists> stp. abc_steps_l (?gs_len + 6 * length gs + 3 * n +
- length a + 3, ys @ 0\<^bsup>?pstr - length ys\<^esup> @ rs # 0\<^bsup>length ys\<^esup> @ lm @
- 0\<^bsup>a_md - Suc (?pstr + length ys + n)\<^esup> @ suf_lm)
- aprog stp =
- (?gs_len + 8 * length gs + 3 *n + length a + 3,
- 0\<^bsup>?pstr \<^esup> @ rs # 0\<^bsup>length ys\<^esup> @ lm @
- 0\<^bsup>a_md -Suc (?pstr + length ys + n)\<^esup> @ suf_lm)"
- apply(drule_tac suf_lm = suf_lm in empty_paras, auto)
- apply(rule_tac x = stp in exI, simp)
- done
- from g have k7:
- "\<exists> stp. abc_steps_l (?gs_len + 8 * length gs + 3 *n +
- length a + 3, 0\<^bsup>?pstr \<^esup> @ rs # 0\<^bsup>length ys\<^esup> @ lm @
- 0\<^bsup>a_md -Suc (?pstr + length ys + n)\<^esup> @ suf_lm) aprog stp =
- (?gs_len + 8 * length gs + 3 * n + length a + 6,
- 0\<^bsup>n\<^esup> @ rs # 0\<^bsup>?pstr - n\<^esup> @ 0\<^bsup>length ys\<^esup> @ lm @
- 0\<^bsup>a_md -Suc (?pstr + length ys + n) \<^esup> @ suf_lm)"
- apply(drule_tac suf_lm = suf_lm in restore_rs, auto)
- apply(rule_tac x = stp in exI, simp)
- done
- from g have k8: "\<exists> stp. abc_steps_l (?gs_len + 8 * length gs +
- 3 * n + length a + 6,
- 0\<^bsup>n\<^esup> @ rs # 0\<^bsup>?pstr - n\<^esup> @ 0\<^bsup>length ys\<^esup> @ lm @
- 0\<^bsup>a_md -Suc (?pstr + length ys + n) \<^esup> @ suf_lm) aprog stp =
- (?gs_len + 8 * length gs + 6 * n + length a + 6,
- lm @ rs # 0\<^bsup>a_md - Suc n \<^esup>@ suf_lm)"
- apply(drule_tac suf_lm = suf_lm in restore_paras, auto)
- apply(simp add: exponent_add_iff)
- apply(rule_tac x = stp in exI, simp)
- done
- from g have j1:
- "length aprog = ?gs_len + 8 * length gs + 6 * n + length a + 6"
- by(drule_tac a = a and aa = b and ba = c in ci_cn_length,
- simp, simp, simp)
- from g have j2: "rs_pos = n"
- by(simp add: ci_cn_para_eq)
- from k1 and k2 and k3 and k4 and k5 and k6 and k7 and k8
- and j1 and j2 show
- "\<exists>stp. abc_steps_l (0, lm @ 0\<^bsup>a_md - rs_pos\<^esup> @ suf_lm) aprog stp =
- (length aprog, lm @ [rs] @ 0\<^bsup>a_md - rs_pos - 1\<^esup> @ suf_lm)"
- apply(auto)
- apply(rule_tac x = "stp + stpa + stpb + stpc +
- stpd + stpe + stpf + stpg" in exI, simp add: abc_steps_add)
- done
-qed
-
-text {*
- Correctness of the complier (terminate case), which says if the execution of
- a recursive function @{text "recf"} terminates and gives result, then
- the Abacus program compiled from @{text "recf"} termintes and gives the same result.
- Additionally, to facilitate induction proof, we append @{text "anything"} to the
- end of Abacus memory.
-*}
-
-lemma aba_rec_equality:
- "\<lbrakk>rec_ci recf = (ap, arity, fp);
- rec_calc_rel recf args r\<rbrakk>
- \<Longrightarrow> (\<exists> stp. (abc_steps_l (0, args @ 0\<^bsup>fp - arity\<^esup> @ anything) ap stp) =
- (length ap, args@[r]@0\<^bsup>fp - arity - 1\<^esup> @ anything))"
-apply(induct arbitrary: ap fp arity r anything args
- rule: rec_ci.induct)
-prefer 5
-proof(case_tac "rec_ci g", case_tac "rec_ci f", simp)
- fix n f g ap fp arity r anything args a b c aa ba ca
- assume f_ind:
- "\<And>ap fp arity r anything args.
- \<lbrakk>aa = ap \<and> ba = arity \<and> ca = fp; rec_calc_rel f args r\<rbrakk> \<Longrightarrow>
- \<exists>stp. abc_steps_l (0, args @ 0\<^bsup>fp - arity\<^esup> @ anything) ap stp =
- (length ap, args @ r # 0\<^bsup>fp - Suc arity\<^esup> @ anything)"
- and g_ind:
- "\<And>x xa y xb ya ap fp arity r anything args.
- \<lbrakk>x = (aa, ba, ca); xa = aa \<and> y = (ba, ca); xb = ba \<and> ya = ca;
- a = ap \<and> b = arity \<and> c = fp; rec_calc_rel g args r\<rbrakk>
- \<Longrightarrow> \<exists>stp. abc_steps_l (0, args @ 0\<^bsup>fp - arity\<^esup> @ anything) ap stp =
- (length ap, args @ r # 0\<^bsup>fp - Suc arity\<^esup> @ anything)"
- and h: "rec_ci (Pr n f g) = (ap, arity, fp)"
- "rec_calc_rel (Pr n f g) args r"
- "rec_ci g = (a, b, c)"
- "rec_ci f = (aa, ba, ca)"
- from h have nf_ind:
- "\<And> args r anything. rec_calc_rel f args r \<Longrightarrow>
- \<exists>stp. abc_steps_l (0, args @ 0\<^bsup>ca - ba\<^esup> @ anything) aa stp =
- (length aa, args @ r # 0\<^bsup>ca - Suc ba\<^esup> @ anything)"
- and ng_ind:
- "\<And> args r anything. rec_calc_rel g args r \<Longrightarrow>
- \<exists>stp. abc_steps_l (0, args @ 0\<^bsup>c - b\<^esup> @ anything) a stp =
- (length a, args @ r # 0\<^bsup>c - Suc b \<^esup> @ anything)"
- apply(insert f_ind[of aa ba ca], simp)
- apply(insert g_ind[of "(aa, ba, ca)" aa "(ba, ca)" ba ca a b c],
- simp)
- done
- from nf_ind and ng_ind and h show
- "\<exists>stp. abc_steps_l (0, args @ 0\<^bsup>fp - arity\<^esup> @ anything) ap stp =
- (length ap, args @ r # 0\<^bsup>fp - Suc arity\<^esup> @ anything)"
- apply(auto intro: nf_ind ng_ind pr_case)
- done
-next
- fix ap fp arity r anything args
- assume h:
- "rec_ci z = (ap, arity, fp)" "rec_calc_rel z args r"
- thus "\<exists>stp. abc_steps_l (0, args @ 0\<^bsup>fp - arity\<^esup> @ anything) ap stp =
- (length ap, args @ [r] @ 0\<^bsup>fp - arity - 1\<^esup> @ anything)"
- by (rule_tac z_case)
-next
- fix ap fp arity r anything args
- assume h:
- "rec_ci s = (ap, arity, fp)"
- "rec_calc_rel s args r"
- thus
- "\<exists>stp. abc_steps_l (0, args @ 0\<^bsup>fp - arity\<^esup> @ anything) ap stp =
- (length ap, args @ [r] @ 0\<^bsup>fp - arity - 1\<^esup> @ anything)"
- by(erule_tac s_case, simp)
-next
- fix m n ap fp arity r anything args
- assume h: "rec_ci (id m n) = (ap, arity, fp)"
- "rec_calc_rel (id m n) args r"
- thus "\<exists>stp. abc_steps_l (0, args @ 0\<^bsup>fp - arity\<^esup> @ anything) ap stp
- = (length ap, args @ [r] @ 0\<^bsup>fp - arity - 1\<^esup> @ anything)"
- by(erule_tac id_case)
-next
- fix n f gs ap fp arity r anything args
- assume ind: "\<And>x ap fp arity r anything args.
- \<lbrakk>x \<in> set (f # gs);
- rec_ci x = (ap, arity, fp);
- rec_calc_rel x args r\<rbrakk>
- \<Longrightarrow> \<exists>stp. abc_steps_l (0, args @ 0\<^bsup>fp - arity\<^esup> @ anything) ap stp =
- (length ap, args @ [r] @ 0\<^bsup>fp - arity - 1\<^esup> @ anything)"
- and h: "rec_ci (Cn n f gs) = (ap, arity, fp)"
- "rec_calc_rel (Cn n f gs) args r"
- from h show
- "\<exists>stp. abc_steps_l (0, args @ 0\<^bsup>fp - arity\<^esup> @ anything)
- ap stp = (length ap, args @ [r] @ 0\<^bsup>fp - arity - 1\<^esup> @ anything)"
- apply(rule_tac cn_case, rule_tac ind, auto)
- done
-next
- fix n f ap fp arity r anything args
- assume ind:
- "\<And>ap fp arity r anything args.
- \<lbrakk>rec_ci f = (ap, arity, fp); rec_calc_rel f args r\<rbrakk> \<Longrightarrow>
- \<exists>stp. abc_steps_l (0, args @ 0\<^bsup>fp - arity\<^esup> @ anything) ap stp =
- (length ap, args @ [r] @ 0\<^bsup>fp - arity - 1\<^esup> @ anything)"
- and h: "rec_ci (Mn n f) = (ap, arity, fp)"
- "rec_calc_rel (Mn n f) args r"
- from h show
- "\<exists>stp. abc_steps_l (0, args @ 0\<^bsup>fp - arity\<^esup> @ anything) ap stp =
- (length ap, args @ [r] @ 0\<^bsup>fp - arity - 1\<^esup> @ anything)"
- apply(rule_tac mn_case, rule_tac ind, auto)
- done
-qed
-
-
-thm abc_append_state_in_exc
-lemma abc_append_uhalt1:
- "\<lbrakk>\<forall> stp. (\<lambda> (ss, e). ss < length bp) (abc_steps_l (0, lm) bp stp);
- p = ap [+] bp [+] cp\<rbrakk>
- \<Longrightarrow> \<forall> stp. (\<lambda> (ss, e). ss < length p)
- (abc_steps_l (length ap, lm) p stp)"
-apply(auto)
-apply(erule_tac x = stp in allE, auto)
-apply(frule_tac ap = ap and cp = cp in abc_append_state_in_exc, auto)
-done
-
-
-lemma abc_append_unhalt2:
- "\<lbrakk>abc_steps_l (0, am) ap stp = (length ap, lm); bp \<noteq> [];
- \<forall> stp. (\<lambda> (ss, e). ss < length bp) (abc_steps_l (0, lm) bp stp);
- p = ap [+] bp [+] cp\<rbrakk>
- \<Longrightarrow> \<forall> stp. (\<lambda> (ss, e). ss < length p) (abc_steps_l (0, am) p stp)"
-proof -
- assume h:
- "abc_steps_l (0, am) ap stp = (length ap, lm)"
- "bp \<noteq> []"
- "\<forall> stp. (\<lambda> (ss, e). ss < length bp) (abc_steps_l (0, lm) bp stp)"
- "p = ap [+] bp [+] cp"
- have "\<exists> stp. (abc_steps_l (0, am) p stp) = (length ap, lm)"
- using h
- thm abc_add_exc1
- apply(simp add: abc_append.simps)
- apply(rule_tac abc_add_exc1, auto)
- done
- from this obtain stpa where g1:
- "(abc_steps_l (0, am) p stpa) = (length ap, lm)" ..
- moreover have g2: "\<forall> stp. (\<lambda> (ss, e). ss < length p)
- (abc_steps_l (length ap, lm) p stp)"
- using h
- apply(erule_tac abc_append_uhalt1, simp)
- done
- moreover from g1 and g2 have
- "\<forall> stp. (\<lambda> (ss, e). ss < length p)
- (abc_steps_l (0, am) p (stpa + stp))"
- apply(simp add: abc_steps_add)
- done
- thus "\<forall> stp. (\<lambda> (ss, e). ss < length p)
- (abc_steps_l (0, am) p stp)"
- apply(rule_tac allI, auto)
- apply(case_tac "stp \<ge> stpa")
- apply(erule_tac x = "stp - stpa" in allE, simp)
- proof -
- fix stp a b
- assume g3: "abc_steps_l (0, am) p stp = (a, b)"
- "\<not> stpa \<le> stp"
- thus "a < length p"
- using g1 h
- apply(case_tac "a < length p", simp, simp)
- apply(subgoal_tac "\<exists> d. stpa = stp + d")
- using abc_state_keep[of p a b "stpa - stp"]
- apply(erule_tac exE, simp add: abc_steps_add)
- apply(rule_tac x = "stpa - stp" in exI, simp)
- done
- qed
-qed
-
-text {*
- Correctness of the complier (non-terminating case for Mn). There are many cases when a
- recursive function does not terminate. For the purpose of Uiversal Turing Machine, we only
- need to prove the case for @{text "Mn"} and @{text "Cn"}.
- This lemma is for @{text "Mn"}. For @{text "Mn n f"}, this lemma describes what
- happens when @{text "f"} always terminates but always does not return zero, so that
- @{text "Mn"} has to loop forever.
- *}
-
-lemma Mn_unhalt:
- assumes mn_rf: "rf = Mn n f"
- and compiled_mnrf: "rec_ci rf = (aprog, rs_pos, a_md)"
- and compiled_f: "rec_ci f = (aprog', rs_pos', a_md')"
- and args: "length lm = n"
- and unhalt_condition: "\<forall> y. (\<exists> rs. rec_calc_rel f (lm @ [y]) rs \<and> rs \<noteq> 0)"
- shows "\<forall> stp. case abc_steps_l (0, lm @ 0\<^bsup>a_md - rs_pos\<^esup> @ suf_lm)
- aprog stp of (ss, e) \<Rightarrow> ss < length aprog"
- using mn_rf compiled_mnrf compiled_f args unhalt_condition
-proof(rule_tac allI)
- fix stp
- assume h: "rf = Mn n f"
- "rec_ci rf = (aprog, rs_pos, a_md)"
- "rec_ci f = (aprog', rs_pos', a_md')"
- "\<forall>y. \<exists>rs. rec_calc_rel f (lm @ [y]) rs \<and> rs \<noteq> 0" "length lm = n"
- thm mn_ind_step
- have "\<exists>stpa \<ge> stp. abc_steps_l (0, lm @ 0 # 0\<^bsup>a_md - Suc rs_pos\<^esup> @ suf_lm) aprog stpa
- = (0, lm @ stp # 0\<^bsup>a_md - Suc rs_pos\<^esup> @ suf_lm)"
- proof(induct stp, auto)
- show "\<exists>stpa. abc_steps_l (0, lm @ 0 # 0\<^bsup>a_md - Suc rs_pos\<^esup> @ suf_lm)
- aprog stpa = (0, lm @ 0 # 0\<^bsup>a_md - Suc rs_pos\<^esup> @ suf_lm)"
- apply(rule_tac x = 0 in exI, simp add: abc_steps_l.simps)
- done
- next
- fix stp stpa
- assume g1: "stp \<le> stpa"
- and g2: "abc_steps_l (0, lm @ 0 # 0\<^bsup>a_md - Suc rs_pos\<^esup> @ suf_lm)
- aprog stpa
- = (0, lm @ stp # 0\<^bsup>a_md - Suc rs_pos\<^esup> @ suf_lm)"
- have "\<exists>rs. rec_calc_rel f (lm @ [stp]) rs \<and> rs \<noteq> 0"
- using h
- apply(erule_tac x = stp in allE, simp)
- done
- from this obtain rs where g3:
- "rec_calc_rel f (lm @ [stp]) rs \<and> rs \<noteq> 0" ..
- hence "\<exists> stpb. abc_steps_l (0, lm @ stp # 0\<^bsup>a_md - Suc rs_pos\<^esup> @
- suf_lm) aprog stpb
- = (0, lm @ Suc stp # 0\<^bsup>a_md - Suc rs_pos\<^esup> @ suf_lm)"
- using h
- apply(rule_tac mn_ind_step)
- apply(rule_tac aba_rec_equality, simp, simp)
- proof -
- show "rec_ci f = ((aprog', rs_pos', a_md'))" using h by simp
- next
- show "rec_ci (Mn n f) = (aprog, rs_pos, a_md)" using h by simp
- next
- show "rec_calc_rel f (lm @ [stp]) rs" using g3 by simp
- next
- show "0 < rs" using g3 by simp
- next
- show "Suc rs_pos < a_md"
- using g3 h
- apply(auto)
- apply(frule_tac f = f in para_pattern, simp, simp)
- apply(simp add: rec_ci.simps, auto)
- apply(subgoal_tac "Suc (length lm) < a_md'")
- apply(arith)
- apply(simp add: ci_ad_ge_paras)
- done
- next
- show "rs_pos' = Suc rs_pos"
- using g3 h
- apply(auto)
- apply(frule_tac f = f in para_pattern, simp, simp)
- apply(simp add: rec_ci.simps)
- done
- qed
- thus "\<exists>stpa\<ge>Suc stp. abc_steps_l (0, lm @ 0 # 0\<^bsup>a_md - Suc rs_pos\<^esup> @
- suf_lm) aprog stpa
- = (0, lm @ Suc stp # 0\<^bsup>a_md - Suc rs_pos\<^esup> @ suf_lm)"
- using g2
- apply(erule_tac exE)
- apply(case_tac "stpb = 0", simp add: abc_steps_l.simps)
- apply(rule_tac x = "stpa + stpb" in exI, simp add:
- abc_steps_add)
- using g1
- apply(arith)
- done
- qed
- from this obtain stpa where
- "stp \<le> stpa \<and> abc_steps_l (0, lm @ 0 # 0\<^bsup>a_md - Suc rs_pos\<^esup> @ suf_lm)
- aprog stpa = (0, lm @ stp # 0\<^bsup>a_md - Suc rs_pos\<^esup> @ suf_lm)" ..
- thus "case abc_steps_l (0, lm @ 0\<^bsup>a_md - rs_pos\<^esup> @ suf_lm) aprog stp
- of (ss, e) \<Rightarrow> ss < length aprog"
- apply(case_tac "abc_steps_l (0, lm @ 0\<^bsup>a_md - rs_pos\<^esup> @ suf_lm) aprog
- stp", simp, case_tac "a \<ge> length aprog",
- simp, simp)
- apply(subgoal_tac "\<exists> d. stpa = stp + d", erule_tac exE)
- apply(subgoal_tac "lm @ 0\<^bsup>a_md - rs_pos\<^esup> @ suf_lm = lm @ 0 #
- 0\<^bsup>a_md - Suc rs_pos\<^esup> @ suf_lm", simp add: abc_steps_add)
- apply(frule_tac as = a and lm = b and stp = d in abc_state_keep,
- simp)
- using h
- apply(simp add: rec_ci.simps, simp,
- simp only: exp_ind_def[THEN sym])
- apply(case_tac rs_pos, simp, simp)
- apply(rule_tac x = "stpa - stp" in exI, simp, simp)
- done
-qed
-
-
-lemma abc_append_cons_eq[intro!]:
- "\<lbrakk>ap = bp; cp = dp\<rbrakk> \<Longrightarrow> ap [+] cp = bp [+] dp"
-by simp
-
-lemma cn_merge_gs_split:
- "\<lbrakk>i < length gs; rec_ci (gs!i) = (ga, gb, gc)\<rbrakk> \<Longrightarrow>
- cn_merge_gs (map rec_ci gs) p =
- cn_merge_gs (map rec_ci (take i gs)) p [+] ga [+]
- empty gb (p + i) [+]
- cn_merge_gs (map rec_ci (drop (Suc i) gs)) (p + Suc i)"
-apply(induct i arbitrary: gs p, case_tac gs, simp, simp)
-apply(case_tac gs, simp, case_tac "rec_ci a",
- simp add: abc_append_commute[THEN sym])
-done
-
-text {*
- Correctness of the complier (non-terminating case for Mn). There are many cases when a
- recursive function does not terminate. For the purpose of Uiversal Turing Machine, we only
- need to prove the case for @{text "Mn"} and @{text "Cn"}.
- This lemma is for @{text "Cn"}. For @{text "Cn f g1 g2 \<dots>gi, gi+1, \<dots> gn"}, this lemma describes what
- happens when every one of @{text "g1, g2, \<dots> gi"} terminates, but
- @{text "gi+1"} does not terminate, so that whole function @{text "Cn f g1 g2 \<dots>gi, gi+1, \<dots> gn"}
- does not terminate.
- *}
-
-lemma cn_gi_uhalt:
- assumes cn_recf: "rf = Cn n f gs"
- and compiled_cn_recf: "rec_ci rf = (aprog, rs_pos, a_md)"
- and args_length: "length lm = n"
- and exist_unhalt_recf: "i < length gs" "gi = gs ! i"
- and complied_unhalt_recf: "rec_ci gi = (ga, gb, gc)" "gb = n"
- and all_halt_before_gi: "\<forall> j < i. (\<exists> rs. rec_calc_rel (gs!j) lm rs)"
- and unhalt_condition: "\<And> slm. \<forall> stp. case abc_steps_l (0, lm @ 0\<^bsup>gc - gb\<^esup> @ slm)
- ga stp of (se, e) \<Rightarrow> se < length ga"
- shows " \<forall> stp. case abc_steps_l (0, lm @ 0\<^bsup>a_md - rs_pos\<^esup> @ suflm) aprog
- stp of (ss, e) \<Rightarrow> ss < length aprog"
- using cn_recf compiled_cn_recf args_length exist_unhalt_recf complied_unhalt_recf
- all_halt_before_gi unhalt_condition
-proof(case_tac "rec_ci f", simp)
- fix a b c
- assume h1: "rf = Cn n f gs"
- "rec_ci (Cn n f gs) = (aprog, rs_pos, a_md)"
- "length lm = n"
- "gi = gs ! i"
- "rec_ci (gs!i) = (ga, n, gc)"
- "gb = n" "rec_ci f = (a, b, c)"
- and h2: "\<forall>j<i. \<exists>rs. rec_calc_rel (gs ! j) lm rs"
- "i < length gs"
- and ind:
- "\<And> slm. \<forall> stp. case abc_steps_l (0, lm @ 0\<^bsup>gc - n\<^esup> @ slm) ga stp of (se, e) \<Rightarrow> se < length ga"
- have h3: "rs_pos = n"
- using h1
- by(rule_tac ci_cn_para_eq, simp)
- let ?ggs = "take i gs"
- have "\<exists> ys. (length ys = i \<and>
- (\<forall> k < i. rec_calc_rel (?ggs ! k) lm (ys ! k)))"
- using h2
- apply(induct i, simp, simp)
- apply(erule_tac exE)
- apply(erule_tac x = ia in allE, simp)
- apply(erule_tac exE)
- apply(rule_tac x = "ys @ [x]" in exI, simp add: nth_append, auto)
- apply(subgoal_tac "k = length ys", simp, simp)
- done
- from this obtain ys where g1:
- "(length ys = i \<and> (\<forall> k < i. rec_calc_rel (?ggs ! k)
- lm (ys ! k)))" ..
- let ?pstr = "Max (set (Suc n # c # map (\<lambda>(aprog, p, n). n)
- (map rec_ci (f # gs))))"
- have "\<exists>stp. abc_steps_l (0, lm @ 0\<^bsup>a_md - n\<^esup> @ suflm)
- (cn_merge_gs (map rec_ci ?ggs) ?pstr) stp =
- (listsum (map ((\<lambda>(ap, pos, n). length ap) \<circ> rec_ci) ?ggs) +
- 3 * length ?ggs, lm @ 0\<^bsup>?pstr - n\<^esup> @ ys @ 0\<^bsup>a_md -(?pstr + length ?ggs)\<^esup> @
- suflm) "
- apply(rule_tac cn_merge_gs_ex)
- apply(rule_tac aba_rec_equality, simp, simp)
- using h1
- apply(simp add: rec_ci.simps, auto)
- using g1
- apply(simp)
- using h2 g1
- apply(simp)
- apply(rule_tac min_max.le_supI2)
- apply(rule_tac Max_ge, simp, simp, rule_tac disjI2)
- apply(subgoal_tac "aa \<in> set gs", simp)
- using h2
- apply(rule_tac A = "set (take i gs)" in subsetD,
- simp add: set_take_subset, simp)
- done
- thm cn_merge_gs.simps
- from this obtain stpa where g2:
- "abc_steps_l (0, lm @ 0\<^bsup>a_md - n\<^esup> @ suflm)
- (cn_merge_gs (map rec_ci ?ggs) ?pstr) stpa =
- (listsum (map ((\<lambda>(ap, pos, n). length ap) \<circ> rec_ci) ?ggs) +
- 3 * length ?ggs, lm @ 0\<^bsup>?pstr - n\<^esup> @ ys @ 0\<^bsup>a_md -(?pstr + length ?ggs)\<^esup> @
- suflm)" ..
- moreover have
- "\<exists> cp. aprog = (cn_merge_gs
- (map rec_ci ?ggs) ?pstr) [+] ga [+] cp"
- using h1
- apply(simp add: rec_ci.simps)
- apply(rule_tac x = "empty n (?pstr + i) [+]
- (cn_merge_gs (map rec_ci (drop (Suc i) gs)) (?pstr + Suc i))
- [+]mv_boxes 0 (Suc (max (Suc n) (Max (insert c
- (((\<lambda>(aprog, p, n). n) \<circ> rec_ci) ` set gs))) +
- length gs)) n [+] mv_boxes (max (Suc n) (Max (insert c
- (((\<lambda>(aprog, p, n). n) \<circ> rec_ci) ` set gs)))) 0 (length gs) [+]
- a [+] recursive.empty b (max (Suc n)
- (Max (insert c (((\<lambda>(aprog, p, n). n) \<circ> rec_ci) ` set gs)))) [+]
- empty_boxes (length gs) [+] recursive.empty (max (Suc n)
- (Max (insert c (((\<lambda>(aprog, p, n). n) \<circ> rec_ci) ` set gs)))) n [+]
- mv_boxes (Suc (max (Suc n) (Max (insert c
- (((\<lambda>(aprog, p, n). n) \<circ> rec_ci) ` set gs))) + length gs)) 0 n" in exI)
- apply(simp add: abc_append_commute [THEN sym])
- apply(auto)
- using cn_merge_gs_split[of i gs ga "length lm" gc
- "(max (Suc (length lm))
- (Max (insert c (((\<lambda>(aprog, p, n). n) \<circ> rec_ci) ` set gs))))"]
- h2
- apply(simp)
- done
- from this obtain cp where g3:
- "aprog = (cn_merge_gs (map rec_ci ?ggs) ?pstr) [+] ga [+] cp" ..
- show "\<forall> stp. case abc_steps_l (0, lm @ 0\<^bsup>a_md - rs_pos\<^esup> @ suflm)
- aprog stp of (ss, e) \<Rightarrow> ss < length aprog"
- proof(rule_tac abc_append_unhalt2)
- show "abc_steps_l (0, lm @ 0\<^bsup>a_md - rs_pos\<^esup> @ suflm) (
- cn_merge_gs (map rec_ci ?ggs) ?pstr) stpa =
- (length ((cn_merge_gs (map rec_ci ?ggs) ?pstr)),
- lm @ 0\<^bsup>?pstr - n\<^esup> @ ys @ 0\<^bsup>a_md -(?pstr + length ?ggs)\<^esup> @ suflm)"
- using h3 g2
- apply(simp add: cn_merge_gs_length)
- done
- next
- show "ga \<noteq> []"
- using h1
- apply(simp add: rec_ci_not_null)
- done
- next
- show "\<forall>stp. case abc_steps_l (0, lm @ 0\<^bsup>?pstr - n\<^esup> @ ys
- @ 0\<^bsup>a_md - (?pstr + length (take i gs))\<^esup> @ suflm) ga stp of
- (ss, e) \<Rightarrow> ss < length ga"
- using ind[of "0\<^bsup>?pstr -gc\<^esup> @ ys @ 0\<^bsup>a_md - (?pstr + length (take i gs))\<^esup>
- @ suflm"]
- apply(subgoal_tac "lm @ 0\<^bsup>?pstr - n\<^esup> @ ys
- @ 0\<^bsup>a_md - (?pstr + length (take i gs))\<^esup> @ suflm
- = lm @ 0\<^bsup>gc - n \<^esup>@
- 0\<^bsup>?pstr -gc\<^esup> @ ys @ 0\<^bsup>a_md - (?pstr + length (take i gs))\<^esup> @ suflm", simp)
- apply(simp add: exponent_def replicate_add[THEN sym])
- apply(subgoal_tac "gc > n \<and> ?pstr \<ge> gc")
- apply(erule_tac conjE)
- apply(simp add: h1)
- using h1
- apply(auto)
- apply(rule_tac min_max.le_supI2)
- apply(rule_tac Max_ge, simp, simp)
- apply(rule_tac disjI2)
- using h2
- thm rev_image_eqI
- apply(rule_tac x = "gs!i" in rev_image_eqI, simp, simp)
- done
- next
- show "aprog = cn_merge_gs (map rec_ci (take i gs))
- ?pstr [+] ga [+] cp"
- using g3 by simp
- qed
-qed
-
-
-lemma abc_rec_halt_eq':
- "\<lbrakk>rec_ci re = (ap, ary, fp);
- rec_calc_rel re args r\<rbrakk>
- \<Longrightarrow> (\<exists> stp. (abc_steps_l (0, args @ 0\<^bsup>fp - ary\<^esup>) ap stp) =
- (length ap, args@[r]@0\<^bsup>fp - ary - 1\<^esup>))"
-using aba_rec_equality[of re ap ary fp args r "[]"]
-by simp
-
-thm abc_step_l.simps
-definition dummy_abc :: "nat \<Rightarrow> abc_inst list"
-where
-"dummy_abc k = [Inc k, Dec k 0, Goto 3]"
-
-lemma abc_rec_halt_eq'':
- "\<lbrakk>rec_ci re = (aprog, rs_pos, a_md);
- rec_calc_rel re lm rs\<rbrakk>
- \<Longrightarrow> (\<exists> stp lm' m. (abc_steps_l (0, lm) aprog stp) =
- (length aprog, lm') \<and> abc_list_crsp lm' (lm @ rs # 0\<^bsup>m\<^esup>))"
-apply(frule_tac abc_rec_halt_eq', auto)
-apply(drule_tac abc_list_crsp_steps)
-apply(rule_tac rec_ci_not_null, simp)
-apply(erule_tac exE, rule_tac x = stp in exI,
- auto simp: abc_list_crsp_def)
-done
-
-lemma [simp]: "length (dummy_abc (length lm)) = 3"
-apply(simp add: dummy_abc_def)
-done
-
-lemma [simp]: "dummy_abc (length lm) \<noteq> []"
-apply(simp add: dummy_abc_def)
-done
-
-lemma dummy_abc_steps_ex:
- "\<exists>bstp. abc_steps_l (0, lm') (dummy_abc (length lm)) bstp =
- ((Suc (Suc (Suc 0))), abc_lm_s lm' (length lm) (abc_lm_v lm' (length lm)))"
-apply(rule_tac x = "Suc (Suc (Suc 0))" in exI)
-apply(auto simp: abc_steps_l.simps abc_step_l.simps
- dummy_abc_def abc_fetch.simps)
-apply(auto simp: abc_lm_s.simps abc_lm_v.simps nth_append)
-apply(simp add: butlast_append)
-done
-
-lemma [elim]:
- "lm @ rs # 0\<^bsup>m\<^esup> = lm' @ 0\<^bsup>n\<^esup> \<Longrightarrow>
- \<exists>m. abc_lm_s lm' (length lm) (abc_lm_v lm' (length lm)) =
- lm @ rs # 0\<^bsup>m\<^esup>"
-proof(cases "length lm' > length lm")
- case True
- assume h: "lm @ rs # 0\<^bsup>m\<^esup> = lm' @ 0\<^bsup>n\<^esup>" "length lm < length lm'"
- hence "m \<ge> n"
- apply(drule_tac list_length)
- apply(simp)
- done
- hence "\<exists> d. m = d + n"
- apply(rule_tac x = "m - n" in exI, simp)
- done
- from this obtain d where "m = d + n" ..
- from h and this show "?thesis"
- apply(auto simp: abc_lm_s.simps abc_lm_v.simps
- exponent_def replicate_add)
- done
-next
- case False
- assume h:"lm @ rs # 0\<^bsup>m\<^esup> = lm' @ 0\<^bsup>n\<^esup>"
- and g: "\<not> length lm < length lm'"
- have "take (Suc (length lm)) (lm @ rs # 0\<^bsup>m\<^esup>) =
- take (Suc (length lm)) (lm' @ 0\<^bsup>n\<^esup>)"
- using h by simp
- moreover have "n \<ge> (Suc (length lm) - length lm')"
- using h g
- apply(drule_tac list_length)
- apply(simp)
- done
- ultimately show
- "\<exists>m. abc_lm_s lm' (length lm) (abc_lm_v lm' (length lm)) =
- lm @ rs # 0\<^bsup>m\<^esup>"
- using g h
- apply(simp add: abc_lm_s.simps abc_lm_v.simps
- exponent_def min_def)
- apply(rule_tac x = 0 in exI,
- simp add:replicate_append_same replicate_Suc[THEN sym]
- del:replicate_Suc)
- done
-qed
-
-lemma [elim]:
- "abc_list_crsp lm' (lm @ rs # 0\<^bsup>m\<^esup>)
- \<Longrightarrow> \<exists>m. abc_lm_s lm' (length lm) (abc_lm_v lm' (length lm))
- = lm @ rs # 0\<^bsup>m\<^esup>"
-apply(auto simp: abc_list_crsp_def)
-apply(simp add: abc_lm_v.simps abc_lm_s.simps)
-apply(rule_tac x = "m + n" in exI,
- simp add: exponent_def replicate_add)
-done
-
-
-lemma abc_append_dummy_complie:
- "\<lbrakk>rec_ci recf = (ap, ary, fp);
- rec_calc_rel recf args r;
- length args = k\<rbrakk>
- \<Longrightarrow> (\<exists> stp m. (abc_steps_l (0, args) (ap [+] dummy_abc k) stp) =
- (length ap + 3, args @ r # 0\<^bsup>m\<^esup>))"
-apply(drule_tac abc_rec_halt_eq'', auto simp: numeral_3_eq_3)
-proof -
- fix stp lm' m
- assume h: "rec_calc_rel recf args r"
- "abc_steps_l (0, args) ap stp = (length ap, lm')"
- "abc_list_crsp lm' (args @ r # 0\<^bsup>m\<^esup>)"
- thm abc_append_exc2
- thm abc_lm_s.simps
- have "\<exists>stp. abc_steps_l (0, args) (ap [+]
- (dummy_abc (length args))) stp = (length ap + 3,
- abc_lm_s lm' (length args) (abc_lm_v lm' (length args)))"
- using h
- apply(rule_tac bm = lm' in abc_append_exc2,
- auto intro: dummy_abc_steps_ex simp: numeral_3_eq_3)
- done
- thus "\<exists>stp m. abc_steps_l (0, args) (ap [+]
- dummy_abc (length args)) stp = (Suc (Suc (Suc (length ap))), args @ r # 0\<^bsup>m\<^esup>)"
- using h
- apply(erule_tac exE)
- apply(rule_tac x = stpa in exI, auto)
- done
-qed
-
-lemma [simp]: "length (dummy_abc k) = 3"
-apply(simp add: dummy_abc_def)
-done
-
-lemma [simp]: "length args = k \<Longrightarrow> abc_lm_v (args @ r # 0\<^bsup>m\<^esup>) k = r "
-apply(simp add: abc_lm_v.simps nth_append)
-done
-
-lemma t_compiled_by_rec:
- "\<lbrakk>rec_ci recf = (ap, ary, fp);
- rec_calc_rel recf args r;
- length args = k;
- ly = layout_of (ap [+] dummy_abc k);
- mop_ss = start_of ly (length (ap [+] dummy_abc k));
- tp = tm_of (ap [+] dummy_abc k)\<rbrakk>
- \<Longrightarrow> \<exists> stp m l. steps (Suc 0, Bk # Bk # ires, <args> @ Bk\<^bsup>rn\<^esup>) (tp @ (tMp k (mop_ss - 1))) stp
- = (0, Bk\<^bsup>m\<^esup> @ Bk # Bk # ires, Oc\<^bsup>Suc r\<^esup> @ Bk\<^bsup>l\<^esup>)"
- using abc_append_dummy_complie[of recf ap ary fp args r k]
-apply(simp)
-apply(erule_tac exE)+
-apply(frule_tac tprog = tp and as = "length ap + 3" and n = k
- and ires = ires and rn = rn in abacus_turing_eq_halt, simp_all, simp)
-apply(erule_tac exE)+
-apply(simp)
-apply(rule_tac x = stpa in exI, rule_tac x = ma in exI, rule_tac x = l in exI, simp)
-done
-
-thm tms_of.simps
-
-lemma [simp]:
- "list_all (\<lambda>(acn, s). s \<le> Suc (Suc (Suc (Suc (Suc (Suc (2 * n))))))) xs \<Longrightarrow>
- list_all (\<lambda>(acn, s). s \<le> Suc (Suc (Suc (Suc (Suc (Suc (Suc (Suc (2 * n))))))))) xs"
-apply(induct xs, simp, simp)
-apply(case_tac a, simp)
-done
-
-(*
-lemma [simp]: "t_correct (tMp n 0)"
-apply(simp add: t_correct.simps tMp.simps shift_length mp_up_def iseven_def, auto)
-apply(rule_tac x = "2*n + 6" in exI, simp)
-apply(induct n, auto simp: mop_bef.simps)
-apply(simp add: tshift.simps)
-done
-*)
-
-lemma tshift_append: "tshift (xs @ ys) n = tshift xs n @ tshift ys n"
-apply(simp add: tshift.simps)
-done
-
-lemma [simp]: "length (tMp n ss) = 4 * n + 12"
-apply(auto simp: tMp.simps tshift_append shift_length mp_up_def)
-done
-
-lemma length_tm_even[intro]: "\<exists>x. length (tm_of ap) = 2*x"
-apply(subgoal_tac "t_ncorrect (tm_of ap)")
-apply(simp add: t_ncorrect.simps, auto)
-done
-
-lemma [simp]: "k < length ap \<Longrightarrow> tms_of ap ! k =
- ci (layout_of ap) (start_of (layout_of ap) k) (ap ! k)"
-apply(simp add: tms_of.simps tpairs_of.simps)
-done
-
-lemma [elim]: "\<lbrakk>k < length ap; ap ! k = Inc n;
- (a, b) \<in> set (abacus.tshift (abacus.tshift tinc_b (2 * n))
- (start_of (layout_of ap) k - Suc 0))\<rbrakk>
- \<Longrightarrow> b \<le> start_of (layout_of ap) (length ap)"
-apply(subgoal_tac "b \<le> start_of (layout_of ap) (Suc k)")
-apply(subgoal_tac "start_of (layout_of ap) (Suc k) \<le> start_of (layout_of ap) (length ap) ")
-apply(arith)
-apply(case_tac "Suc k = length ap", simp)
-apply(rule_tac start_of_le, simp)
-apply(auto simp: tinc_b_def tshift.simps start_of.simps
- layout_of.simps length_of.simps startof_not0)
-done
-
-lemma findnth_le[elim]: "(a, b) \<in> set (abacus.tshift (findnth n) (start_of (layout_of ap) k - Suc 0))
- \<Longrightarrow> b \<le> Suc (start_of (layout_of ap) k + 2 * n)"
-apply(induct n, simp add: findnth.simps tshift.simps)
-apply(simp add: findnth.simps tshift_append, auto)
-apply(auto simp: tshift.simps)
-done
-
-
-lemma [elim]: "\<lbrakk>k < length ap; ap ! k = Inc n; (a, b) \<in>
- set (abacus.tshift (findnth n) (start_of (layout_of ap) k - Suc 0))\<rbrakk>
- \<Longrightarrow> b \<le> start_of (layout_of ap) (length ap)"
-apply(subgoal_tac "b \<le> start_of (layout_of ap) (Suc k)")
-apply(subgoal_tac "start_of (layout_of ap) (Suc k) \<le> start_of (layout_of ap) (length ap) ")
-apply(arith)
-apply(case_tac "Suc k = length ap", simp)
-apply(rule_tac start_of_le, simp)
-apply(subgoal_tac "b \<le> start_of (layout_of ap) k + 2*n + 1 \<and>
- start_of (layout_of ap) k + 2*n + 1 \<le> start_of (layout_of ap) (Suc k)", auto)
-apply(auto simp: tinc_b_def tshift.simps start_of.simps
- layout_of.simps length_of.simps startof_not0)
-done
-
-lemma start_of_eq: "length ap < as \<Longrightarrow> start_of (layout_of ap) as = start_of (layout_of ap) (length ap)"
-apply(induct as, simp)
-apply(case_tac "length ap < as", simp add: start_of.simps)
-apply(subgoal_tac "as = length ap")
-apply(simp add: start_of.simps)
-apply arith
-done
-
-lemma start_of_all_le: "start_of (layout_of ap) as \<le> start_of (layout_of ap) (length ap)"
-apply(subgoal_tac "as > length ap \<or> as = length ap \<or> as < length ap",
- auto simp: start_of_eq start_of_le)
-done
-
-lemma [elim]: "\<lbrakk>k < length ap;
- ap ! k = Dec n e;
- (a, b) \<in> set (abacus.tshift (findnth n) (start_of (layout_of ap) k - Suc 0))\<rbrakk>
- \<Longrightarrow> b \<le> start_of (layout_of ap) (length ap)"
-apply(subgoal_tac "b \<le> start_of (layout_of ap) k + 2*n + 1 \<and>
- start_of (layout_of ap) k + 2*n + 1 \<le> start_of (layout_of ap) (Suc k) \<and>
- start_of (layout_of ap) (Suc k) \<le> start_of (layout_of ap) (length ap)", auto)
-apply(simp add: tshift.simps start_of.simps
- layout_of.simps length_of.simps startof_not0)
-apply(rule_tac start_of_all_le)
-done
-
-thm length_of.simps
-lemma [elim]: "\<lbrakk>k < length ap; ap ! k = Dec n e; (a, b) \<in> set (abacus.tshift (abacus.tshift tdec_b (2 * n))
- (start_of (layout_of ap) k - Suc 0))\<rbrakk>
- \<Longrightarrow> b \<le> start_of (layout_of ap) (length ap)"
-apply(subgoal_tac "2*n + start_of (layout_of ap) k + 16 \<le> start_of (layout_of ap) (length ap) \<and> start_of (layout_of ap) k > 0")
-prefer 2
-apply(subgoal_tac "2 * n + start_of (layout_of ap) k + 16 = start_of (layout_of ap) (Suc k)
- \<and> start_of (layout_of ap) (Suc k) \<le> start_of (layout_of ap) (length ap)")
-apply(simp add: startof_not0, rule_tac conjI)
-apply(simp add: start_of.simps layout_of.simps length_of.simps)
-apply(rule_tac start_of_all_le)
-apply(auto simp: tdec_b_def tshift.simps)
-done
-
-lemma tms_any_less: "\<lbrakk>k < length ap; (a, b) \<in> set (tms_of ap ! k)\<rbrakk> \<Longrightarrow> b \<le> start_of (layout_of ap) (length ap)"
-apply(simp)
-apply(case_tac "ap!k", simp_all add: ci.simps tshift_append, auto intro: start_of_all_le)
-done
-lemma concat_in: "i < length (concat xs) \<Longrightarrow> \<exists>k < length xs. concat xs ! i \<in> set (xs ! k)"
-apply(induct xs rule: list_tl_induct, simp, simp)
-apply(case_tac "i < length (concat list)", simp)
-apply(erule_tac exE, rule_tac x = k in exI)
-apply(simp add: nth_append)
-apply(rule_tac x = "length list" in exI, simp)
-apply(simp add: nth_append)
-done
-
-lemma [simp]: "length (tms_of ap) = length ap"
-apply(simp add: tms_of.simps tpairs_of.simps)
-done
-
-lemma in_tms: "i < length (tm_of ap) \<Longrightarrow> \<exists> k < length ap. (tm_of ap ! i) \<in> set (tms_of ap ! k)"
-apply(simp add: tm_of.simps)
-using concat_in[of i "tms_of ap"]
-by simp
-
-lemma all_le_start_of: "list_all (\<lambda>(acn, s). s \<le> start_of (layout_of ap) (length ap)) (tm_of ap)"
-apply(simp add: list_all_length)
-apply(rule_tac allI, rule_tac impI)
-apply(drule_tac in_tms, auto elim: tms_any_less)
-done
-
-lemma length_ci: "\<lbrakk>k < length ap; length (ci ly y (ap ! k)) = 2 * qa\<rbrakk>
- \<Longrightarrow> layout_of ap ! k = qa"
-apply(case_tac "ap ! k")
-apply(auto simp: layout_of.simps ci.simps
- length_of.simps shift_length tinc_b_def tdec_b_def)
-done
-
-lemma [intro]: "length (ci ly y i) mod 2 = 0"
-apply(auto simp: ci.simps shift_length tinc_b_def tdec_b_def
- split: abc_inst.splits)
-done
-
-lemma [intro]: "listsum (map (length \<circ> (\<lambda>(x, y). ci ly x y)) zs) mod 2 = 0"
-apply(induct zs rule: list_tl_induct, simp)
-apply(case_tac a, simp)
-apply(subgoal_tac "length (ci ly aa b) mod 2 = 0")
-apply(auto)
-done
-
-lemma zip_pre:
- "(length ys) \<le> length ap \<Longrightarrow>
- zip ys ap = zip ys (take (length ys) (ap::'a list))"
-proof(induct ys arbitrary: ap, simp, case_tac ap, simp)
- fix a ys ap aa list
- assume ind: "\<And>(ap::'a list). length ys \<le> length ap \<Longrightarrow>
- zip ys ap = zip ys (take (length ys) ap)"
- and h: "length (a # ys) \<le> length ap" "(ap::'a list) = aa # (list::'a list)"
- from h show "zip (a # ys) ap = zip (a # ys) (take (length (a # ys)) ap)"
- using ind[of list]
- apply(simp)
- done
-qed
-
-lemma start_of_listsum:
- "\<lbrakk>k \<le> length ap; length ss = k\<rbrakk> \<Longrightarrow> start_of (layout_of ap) k =
- Suc (listsum (map (length \<circ> (\<lambda>(x, y). ci ly x y)) (zip ss ap)) div 2)"
-proof(induct k arbitrary: ss, simp add: start_of.simps, simp)
- fix k ss
- assume ind: "\<And>ss. length ss = k \<Longrightarrow> start_of (layout_of ap) k =
- Suc (listsum (map (length \<circ> (\<lambda>(x, y). ci ly x y)) (zip ss ap)) div 2)"
- and h: "Suc k \<le> length ap" "length (ss::nat list) = Suc k"
- have "\<exists> ys y. ss = ys @ [y]"
- using h
- apply(rule_tac x = "butlast ss" in exI,
- rule_tac x = "last ss" in exI)
- apply(case_tac "ss = []", auto)
- done
- from this obtain ys y where k1: "ss = (ys::nat list) @ [y]"
- by blast
- from h and this have k2:
- "start_of (layout_of ap) k =
- Suc (listsum (map (length \<circ> (\<lambda>(x, y). ci ly x y)) (zip ys ap)) div 2)"
- apply(rule_tac ind, simp)
- done
- have k3: "zip ys ap = zip ys (take k ap)"
- using zip_pre[of ys ap] k1 h
- apply(simp)
- done
- have k4: "(zip [y] (drop (length ys) ap)) = [(y, ap ! length ys)]"
- using k1 h
- apply(case_tac "drop (length ys) ap", simp)
- apply(subgoal_tac "hd (drop (length ys) ap) = ap ! length ys")
- apply(simp)
- apply(rule_tac hd_drop_conv_nth, simp)
- done
- from k1 and h k2 k3 k4 show "start_of (layout_of ap) (Suc k) =
- Suc (listsum (map (length \<circ> (\<lambda>(x, y). ci ly x y)) (zip ss ap)) div 2)"
- apply(simp add: zip_append1 start_of.simps)
- apply(subgoal_tac
- "listsum (map (length \<circ> (\<lambda>(x, y). ci ly x y)) (zip ys (take k ap))) mod 2 = 0 \<and>
- length (ci ly y (ap!k)) mod 2 = 0")
- apply(auto)
- apply(rule_tac length_ci, simp, simp)
- done
-qed
-
-lemma length_start_of_tm: "start_of (layout_of ap) (length ap) = Suc (length (tm_of ap) div 2)"
-apply(simp add: tm_of.simps length_concat tms_of.simps tpairs_of.simps)
-apply(rule_tac start_of_listsum, simp, simp)
-done
-
-lemma tm_even: "length (tm_of ap) mod 2 = 0"
-apply(subgoal_tac "t_ncorrect (tm_of ap)", auto)
-apply(simp add: t_ncorrect.simps)
-done
-
-lemma [elim]: "list_all (\<lambda>(acn, s). s \<le> Suc q) xs
- \<Longrightarrow> list_all (\<lambda>(acn, s). s \<le> q + (2 * n + 6)) xs"
-apply(simp add: list_all_length)
-apply(auto)
-done
-
-lemma [simp]: "length mp_up = 12"
-apply(simp add: mp_up_def)
-done
-
-lemma [elim]: "\<lbrakk>na < 4 * n; tshift (mop_bef n) q ! na = (a, b)\<rbrakk> \<Longrightarrow> b \<le> q + (2 * n + 6)"
-apply(induct n, simp, simp add: mop_bef.simps nth_append tshift_append shift_length)
-apply(case_tac "na < 4*n", simp, simp)
-apply(subgoal_tac "na = 4*n \<or> na = 1 + 4*n \<or> na = 2 + 4*n \<or> na = 3 + 4*n",
- auto simp: shift_length)
-apply(simp_all add: tshift.simps)
-done
-
-lemma mp_up_all_le: "list_all (\<lambda>(acn, s). s \<le> q + (2 * n + 6))
- [(R, Suc (Suc (2 * n + q))), (R, Suc (2 * n + q)),
- (L, 5 + 2 * n + q), (W0, Suc (Suc (Suc (2 * n + q)))), (R, 4 + 2 * n + q),
- (W0, Suc (Suc (Suc (2 * n + q)))), (R, Suc (Suc (2 * n + q))),
- (W0, Suc (Suc (Suc (2 * n + q)))), (L, 5 + 2 * n + q),
- (L, 6 + 2 * n + q), (R, 0), (L, 6 + 2 * n + q)]"
-apply(auto)
-done
-
-
-lemma [intro]: "list_all (\<lambda>(acn, s). s \<le> q + (2 * n + 6)) (tMp n q)"
-apply(auto simp: list_all_length tMp.simps tshift_append nth_append shift_length)
-apply(auto simp: tshift.simps mp_up_def)
-apply(subgoal_tac "na - 4*n \<ge> 0 \<and> na - 4 *n < 12", auto split: nat.splits)
-apply(insert mp_up_all_le[of q n])
-apply(simp add: list_all_length)
-apply(erule_tac x = "na - 4 * n" in allE, simp add: numeral_3_eq_3)
-done
-
-lemma t_compiled_correct:
- "\<lbrakk>tp = tm_of ap; ly = layout_of ap; mop_ss = start_of ly (length ap)\<rbrakk> \<Longrightarrow>
- t_correct (tp @ tMp n (mop_ss - Suc 0))"
- using tm_even[of ap] length_start_of_tm[of ap] all_le_start_of[of ap]
-apply(auto simp: t_correct.simps iseven_def)
-apply(rule_tac x = "q + 2*n + 6" in exI, simp)
-done
-
-end
-
-
-
-
-
-
-
--- a/utm/turing_basic.thy Mon Mar 04 21:01:55 2013 +0000
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,736 +0,0 @@
-theory turing_basic
-imports Main
-begin
-
-section {* Basic definitions of Turing machine *}
-
-(* Title: Turing machine's definition and its charater
- Author: Xu Jian <xujian817@hotmail.com>
- Maintainer: Xu Jian
-*)
-
-text {*
- Actions of Turing machine (Abbreviated TM in the following* ).
-*}
-
-datatype taction =
- -- {* Write zero *}
- W0 |
- -- {* Write one *}
- W1 |
- -- {* Move left *}
- L |
- -- {* Move right *}
- R |
- -- {* Do nothing *}
- Nop
-
-text {*
- Tape contents in every block.
-*}
-
-datatype block =
- -- {* Blank *}
- Bk |
- -- {* Occupied *}
- Oc
-
-text {*
- Tape is represented as a pair of lists $(L_{left}, L_{right})$,
- where $L_left$, named {\em left list}, is used to represent
- the tape to the left of RW-head and
- $L_{right}$, named {\em right list}, is used to represent the tape
- under and to the right of RW-head.
-*}
-
-type_synonym tape = "block list \<times> block list"
-
-text {* The state of turing machine.*}
-type_synonym tstate = nat
-
-text {*
- Turing machine instruction is represented as a
- pair @{text "(action, next_state)"},
- where @{text "action"} is the action to take at the current state
- and @{text "next_state"} is the next state the machine is getting into
- after the action.
-*}
-type_synonym tinst = "taction \<times> tstate"
-
-text {*
- Program of Turing machine is represented as a list of Turing instructions
- and the execution of the program starts from the head of the list.
- *}
-type_synonym tprog = "tinst list"
-
-
-text {*
- Turing machine configuration, which consists of the current state
- and the tape.
-*}
-type_synonym t_conf = "tstate \<times> tape"
-
-fun nth_of :: "'a list \<Rightarrow> nat \<Rightarrow> 'a option"
- where
- "nth_of xs n = (if n < length xs then Some (xs!n)
- else None)"
-
-text {*
- The function used to fetech instruction out of Turing program.
- *}
-
-fun fetch :: "tprog \<Rightarrow> tstate \<Rightarrow> block \<Rightarrow> tinst"
- where
- "fetch p s b = (if s = 0 then (Nop, 0) else
- case b of
- Bk \<Rightarrow> case nth_of p (2 * (s - 1)) of
- Some i \<Rightarrow> i
- | None \<Rightarrow> (Nop, 0)
- | Oc \<Rightarrow> case nth_of p (2 * (s - 1) +1) of
- Some i \<Rightarrow> i
- | None \<Rightarrow> (Nop, 0))"
-
-
-fun new_tape :: "taction \<Rightarrow> tape \<Rightarrow> tape"
-where
- "new_tape action (leftn, rightn) = (case action of
- W0 \<Rightarrow> (leftn, Bk#(tl rightn)) |
- W1 \<Rightarrow> (leftn, Oc#(tl rightn)) |
- L \<Rightarrow> (if leftn = [] then (tl leftn, Bk#rightn)
- else (tl leftn, (hd leftn) # rightn)) |
- R \<Rightarrow> if rightn = [] then (Bk#leftn,tl rightn)
- else ((hd rightn)#leftn, tl rightn) |
- Nop \<Rightarrow> (leftn, rightn)
- )"
-
-text {*
- The one step function used to transfer Turing machine configuration.
-*}
-fun tstep :: "t_conf \<Rightarrow> tprog \<Rightarrow> t_conf"
- where
- "tstep c p = (let (s, l, r) = c in
- let (ac, ns) = (fetch p s (case r of [] \<Rightarrow> Bk |
- x # xs \<Rightarrow> x)) in
- (ns, new_tape ac (l, r)))"
-
-text {*
- The many-step function.
-*}
-fun steps :: "t_conf \<Rightarrow> tprog \<Rightarrow> nat \<Rightarrow> t_conf"
- where
- "steps c p 0 = c" |
- "steps c p (Suc n) = steps (tstep c p) p n"
-
-lemma tstep_red: "steps c p (Suc n) = tstep (steps c p n) p"
-proof(induct n arbitrary: c)
- fix c
- show "steps c p (Suc 0) = tstep (steps c p 0) p" by(simp add: steps.simps)
-next
- fix n c
- assume ind: "\<And> c. steps c p (Suc n) = tstep (steps c p n) p"
- have "steps (tstep c p) p (Suc n) = tstep (steps (tstep c p) p n) p"
- by(rule ind)
- thus "steps c p (Suc (Suc n)) = tstep (steps c p (Suc n)) p" by(simp add: steps.simps)
-qed
-
-declare Let_def[simp] option.split[split]
-
-definition
- "iseven n \<equiv> \<exists> x. n = 2 * x"
-
-
-text {*
- The following @{text "t_correct"} function is used to specify the wellformedness of Turing
- machine.
-*}
-fun t_correct :: "tprog \<Rightarrow> bool"
- where
- "t_correct p = (length p \<ge> 2 \<and> iseven (length p) \<and>
- list_all (\<lambda> (acn, s). s \<le> length p div 2) p)"
-
-declare t_correct.simps[simp del]
-
-lemma allimp: "\<lbrakk>\<forall>x. P x \<longrightarrow> Q x; \<forall>x. P x\<rbrakk> \<Longrightarrow> \<forall>x. Q x"
-by(auto elim: allE)
-
-lemma halt_lemma: "\<lbrakk>wf LE; \<forall> n. (\<not> P (f n) \<longrightarrow> (f (Suc n), (f n)) \<in> LE)\<rbrakk> \<Longrightarrow> \<exists> n. P (f n)"
-apply(rule exCI, drule allimp, auto)
-apply(drule_tac f = f in wf_inv_image, simp add: inv_image_def)
-apply(erule wf_induct, auto)
-done
-
-lemma steps_add: "steps c t (x + y) = steps (steps c t x) t y"
-by(induct x arbitrary: c, auto simp: steps.simps tstep_red)
-
-lemma listall_set: "list_all p t \<Longrightarrow> \<forall> a \<in> set t. p a"
-by(induct t, auto)
-
-lemma fetch_ex: "\<exists>b a. fetch T aa ab = (b, a)"
-by(simp add: fetch.simps)
-definition exponent :: "'a \<Rightarrow> nat \<Rightarrow> 'a list" ("_\<^bsup>_\<^esup>" [0, 0]100)
- where "exponent x n = replicate n x"
-
-text {*
- @{text "tinres l1 l2"} means left list @{text "l1"} is congruent with
- @{text "l2"} with respect to the execution of Turing machine.
- Appending Blank to the right of eigther one does not affect the
- outcome of excution.
-*}
-
-definition tinres :: "block list \<Rightarrow> block list \<Rightarrow> bool"
- where
- "tinres bx by = (\<exists> n. bx = by@Bk\<^bsup>n\<^esup> \<or> by = bx @ Bk\<^bsup>n\<^esup>)"
-
-lemma exp_zero: "a\<^bsup>0\<^esup> = []"
-by(simp add: exponent_def)
-lemma exp_ind_def: "a\<^bsup>Suc x \<^esup> = a # a\<^bsup>x\<^esup>"
-by(simp add: exponent_def)
-
-text {*
- The following lemma shows the meaning of @{text "tinres"} with respect to
- one step execution.
- *}
-lemma tinres_step:
- "\<lbrakk>tinres l l'; tstep (ss, l, r) t = (sa, la, ra); tstep (ss, l', r) t = (sb, lb, rb)\<rbrakk>
- \<Longrightarrow> tinres la lb \<and> ra = rb \<and> sa = sb"
-apply(auto simp: tstep.simps fetch.simps new_tape.simps
- split: if_splits taction.splits list.splits
- block.splits)
-apply(case_tac [!] "t ! (2 * (ss - Suc 0))",
- auto simp: exponent_def tinres_def split: if_splits taction.splits list.splits
- block.splits)
-apply(case_tac [!] "t ! (2 * (ss - Suc 0) + Suc 0)",
- auto simp: exponent_def tinres_def split: if_splits taction.splits list.splits
- block.splits)
-done
-
-declare tstep.simps[simp del] steps.simps[simp del]
-
-text {*
- The following lemma shows the meaning of @{text "tinres"} with respect to
- many step execution.
- *}
-lemma tinres_steps:
- "\<lbrakk>tinres l l'; steps (ss, l, r) t stp = (sa, la, ra); steps (ss, l', r) t stp = (sb, lb, rb)\<rbrakk>
- \<Longrightarrow> tinres la lb \<and> ra = rb \<and> sa = sb"
-apply(induct stp arbitrary: sa la ra sb lb rb, simp add: steps.simps)
-apply(simp add: tstep_red)
-apply(case_tac "(steps (ss, l, r) t stp)")
-apply(case_tac "(steps (ss, l', r) t stp)")
-proof -
- fix stp sa la ra sb lb rb a b c aa ba ca
- assume ind: "\<And>sa la ra sb lb rb. \<lbrakk>steps (ss, l, r) t stp = (sa, la, ra);
- steps (ss, l', r) t stp = (sb, lb, rb)\<rbrakk> \<Longrightarrow> tinres la lb \<and> ra = rb \<and> sa = sb"
- and h: " tinres l l'" "tstep (steps (ss, l, r) t stp) t = (sa, la, ra)"
- "tstep (steps (ss, l', r) t stp) t = (sb, lb, rb)" "steps (ss, l, r) t stp = (a, b, c)"
- "steps (ss, l', r) t stp = (aa, ba, ca)"
- have "tinres b ba \<and> c = ca \<and> a = aa"
- apply(rule_tac ind, simp_all add: h)
- done
- thus "tinres la lb \<and> ra = rb \<and> sa = sb"
- apply(rule_tac l = b and l' = ba and r = c and ss = a
- and t = t in tinres_step)
- using h
- apply(simp, simp, simp)
- done
-qed
-
-text {*
- The following function @{text "tshift tp n"} is used to shift Turing programs
- @{text "tp"} by @{text "n"} when it is going to be combined with others.
- *}
-
-fun tshift :: "tprog \<Rightarrow> nat \<Rightarrow> tprog"
- where
- "tshift tp off = (map (\<lambda> (action, state). (action, (if state = 0 then 0
- else state + off))) tp)"
-
-text {*
- When two Turing programs are combined, the end state (state @{text "0"}) of the one
- at the prefix position needs to be connected to the start state
- of the one at postfix position. If @{text "tp"} is the Turing program
- to be at the prefix, @{text "change_termi_state tp"} is the transformed Turing program.
- *}
-fun change_termi_state :: "tprog \<Rightarrow> tprog"
- where
- "change_termi_state t =
- (map (\<lambda> (acn, ns). if ns = 0 then (acn, Suc ((length t) div 2)) else (acn, ns)) t)"
-
-text {*
- @{text "t_add tp1 tp2"} is the combined Truing program.
-*}
-
-fun t_add :: "tprog \<Rightarrow> tprog \<Rightarrow> tprog" ("_ |+| _" [0, 0] 100)
- where
- "t_add t1 t2 = ((change_termi_state t1) @ (tshift t2 ((length t1) div 2)))"
-
-text {*
- Tests whether the current configuration is at state @{text "0"}.
-*}
-definition isS0 :: "t_conf \<Rightarrow> bool"
- where
- "isS0 c = (let (s, l, r) = c in s = 0)"
-
-declare tstep.simps[simp del] steps.simps[simp del]
- t_add.simps[simp del] fetch.simps[simp del]
- new_tape.simps[simp del]
-
-
-text {*
- Single step execution starting from state @{text "0"} will not make any progress.
-*}
-lemma tstep_0: "tstep (0, tp) p = (0, tp)"
-apply(simp add: tstep.simps fetch.simps new_tape.simps)
-done
-
-
-text {*
- Many step executions starting from state @{text "0"} will not make any progress.
-*}
-
-lemma steps_0: "steps (0, tp) p stp = (0, tp)"
-apply(induct stp)
-apply(simp add: steps.simps)
-apply(simp add: tstep_red tstep_0)
-done
-
-lemma s_keep_step: "\<lbrakk>a \<le> length A div 2; tstep (a, b, c) A = (s, l, r); t_correct A\<rbrakk>
- \<Longrightarrow> s \<le> length A div 2"
-apply(simp add: tstep.simps fetch.simps t_correct.simps iseven_def
- split: if_splits block.splits list.splits)
-apply(case_tac [!] a, auto simp: list_all_length)
-apply(erule_tac x = "2 * nat" in allE, auto)
-apply(erule_tac x = "2 * nat" in allE, auto)
-apply(erule_tac x = "Suc (2 * nat)" in allE, auto)
-done
-
-lemma s_keep: "\<lbrakk>steps (Suc 0, tp) A stp = (s, l, r); t_correct A\<rbrakk> \<Longrightarrow> s \<le> length A div 2"
-proof(induct stp arbitrary: s l r)
- case 0 thus "?case" by(auto simp: t_correct.simps steps.simps)
-next
- fix stp s l r
- assume ind: "\<And>s l r. \<lbrakk>steps (Suc 0, tp) A stp = (s, l, r); t_correct A\<rbrakk> \<Longrightarrow> s \<le> length A div 2"
- and h1: "steps (Suc 0, tp) A (Suc stp) = (s, l, r)"
- and h2: "t_correct A"
- from h1 h2 show "s \<le> length A div 2"
- proof(simp add: tstep_red, cases "(steps (Suc 0, tp) A stp)", simp)
- fix a b c
- assume h3: "tstep (a, b, c) A = (s, l, r)"
- and h4: "steps (Suc 0, tp) A stp = (a, b, c)"
- have "a \<le> length A div 2"
- using h2 h4
- by(rule_tac l = b and r = c in ind, auto)
- thus "?thesis"
- using h3 h2
- by(simp add: s_keep_step)
- qed
-qed
-
-lemma t_merge_fetch_pre:
- "\<lbrakk>fetch A s b = (ac, ns); s \<le> length A div 2; t_correct A; s \<noteq> 0\<rbrakk> \<Longrightarrow>
- fetch (A |+| B) s b = (ac, if ns = 0 then Suc (length A div 2) else ns)"
-apply(subgoal_tac "2 * (s - Suc 0) < length A \<and> Suc (2 * (s - Suc 0)) < length A")
-apply(auto simp: fetch.simps t_add.simps split: if_splits block.splits)
-apply(simp_all add: nth_append change_termi_state.simps)
-done
-
-lemma [simp]: "\<lbrakk>\<not> a \<le> length A div 2; t_correct A\<rbrakk> \<Longrightarrow> fetch A a b = (Nop, 0)"
-apply(auto simp: fetch.simps del: nth_of.simps split: block.splits)
-apply(case_tac [!] a, auto simp: t_correct.simps iseven_def)
-done
-
-lemma [elim]: "\<lbrakk>t_correct A; \<not> isS0 (tstep (a, b, c) A)\<rbrakk> \<Longrightarrow> a \<le> length A div 2"
-apply(rule_tac classical, auto simp: tstep.simps new_tape.simps isS0_def)
-done
-
-lemma [elim]: "\<lbrakk>t_correct A; \<not> isS0 (tstep (a, b, c) A)\<rbrakk> \<Longrightarrow> 0 < a"
-apply(rule_tac classical, simp add: tstep_0 isS0_def)
-done
-
-
-lemma t_merge_pre_eq_step: "\<lbrakk>tstep (a, b, c) A = cf; t_correct A; \<not> isS0 cf\<rbrakk>
- \<Longrightarrow> tstep (a, b, c) (A |+| B) = cf"
-apply(subgoal_tac "a \<le> length A div 2 \<and> a \<noteq> 0")
-apply(simp add: tstep.simps)
-apply(case_tac "fetch A a (case c of [] \<Rightarrow> Bk | x # xs \<Rightarrow> x)", simp)
-apply(drule_tac B = B in t_merge_fetch_pre, simp, simp, simp, simp add: isS0_def, auto)
-done
-
-lemma t_merge_pre_eq: "\<lbrakk>steps (Suc 0, tp) A stp = cf; \<not> isS0 cf; t_correct A\<rbrakk>
- \<Longrightarrow> steps (Suc 0, tp) (A |+| B) stp = cf"
-proof(induct stp arbitrary: cf)
- case 0 thus "?case" by(simp add: steps.simps)
-next
- fix stp cf
- assume ind: "\<And>cf. \<lbrakk>steps (Suc 0, tp) A stp = cf; \<not> isS0 cf; t_correct A\<rbrakk>
- \<Longrightarrow> steps (Suc 0, tp) (A |+| B) stp = cf"
- and h1: "steps (Suc 0, tp) A (Suc stp) = cf"
- and h2: "\<not> isS0 cf"
- and h3: "t_correct A"
- from h1 h2 h3 show "steps (Suc 0, tp) (A |+| B) (Suc stp) = cf"
- proof(simp add: tstep_red, cases "steps (Suc 0, tp) (A) stp", simp)
- fix a b c
- assume h4: "tstep (a, b, c) A = cf"
- and h5: "steps (Suc 0, tp) A stp = (a, b, c)"
- have "steps (Suc 0, tp) (A |+| B) stp = (a, b, c)"
- proof(cases a)
- case 0 thus "?thesis"
- using h4 h2
- apply(simp add: tstep_0, cases cf, simp add: isS0_def)
- done
- next
- case (Suc n) thus "?thesis"
- using h5 h3
- apply(rule_tac ind, auto simp: isS0_def)
- done
- qed
- thus "tstep (steps (Suc 0, tp) (A |+| B) stp) (A |+| B) = cf"
- using h4 h5 h3 h2
- apply(simp)
- apply(rule t_merge_pre_eq_step, auto)
- done
- qed
-qed
-
-declare nth.simps[simp del] tshift.simps[simp del] change_termi_state.simps[simp del]
-
-lemma [simp]: "length (change_termi_state A) = length A"
-by(simp add: change_termi_state.simps)
-
-lemma first_halt_point: "steps (Suc 0, tp) A stp = (0, tp')
- \<Longrightarrow> \<exists>stp. \<not> isS0 (steps (Suc 0, tp) A stp) \<and> steps (Suc 0, tp) A (Suc stp) = (0, tp')"
-proof(induct stp)
- case 0 thus "?case" by(simp add: steps.simps)
-next
- case (Suc n)
- fix stp
- assume ind: "steps (Suc 0, tp) A stp = (0, tp') \<Longrightarrow>
- \<exists>stp. \<not> isS0 (steps (Suc 0, tp) A stp) \<and> steps (Suc 0, tp) A (Suc stp) = (0, tp')"
- and h: "steps (Suc 0, tp) A (Suc stp) = (0, tp')"
- from h show "\<exists>stp. \<not> isS0 (steps (Suc 0, tp) A stp) \<and> steps (Suc 0, tp) A (Suc stp) = (0, tp')"
- proof(simp add: tstep_red, cases "steps (Suc 0, tp) A stp", simp, case_tac a)
- fix a b c
- assume g1: "a = (0::nat)"
- and g2: "tstep (a, b, c) A = (0, tp')"
- and g3: "steps (Suc 0, tp) A stp = (a, b, c)"
- have "steps (Suc 0, tp) A stp = (0, tp')"
- using g2 g1 g3
- by(simp add: tstep_0)
- hence "\<exists> stp. \<not> isS0 (steps (Suc 0, tp) A stp) \<and> steps (Suc 0, tp) A (Suc stp) = (0, tp')"
- by(rule ind)
- thus "\<exists>stp. \<not> isS0 (steps (Suc 0, tp) A stp) \<and> tstep (steps (Suc 0, tp) A stp) A = (0, tp')"
- apply(simp add: tstep_red)
- done
- next
- fix a b c nat
- assume g1: "steps (Suc 0, tp) A stp = (a, b, c)"
- and g2: "steps (Suc 0, tp) A (Suc stp) = (0, tp')" "a= Suc nat"
- thus "\<exists>stp. \<not> isS0 (steps (Suc 0, tp) A stp) \<and> tstep (steps (Suc 0, tp) A stp) A = (0, tp')"
- apply(rule_tac x = stp in exI)
- apply(simp add: isS0_def tstep_red)
- done
- qed
-qed
-
-lemma t_merge_pre_halt_same':
- "\<lbrakk>\<not> isS0 (steps (Suc 0, tp) A stp) ; steps (Suc 0, tp) A (Suc stp) = (0, tp'); t_correct A\<rbrakk>
- \<Longrightarrow> steps (Suc 0, tp) (A |+| B) (Suc stp) = (Suc (length A div 2), tp')"
-proof(simp add: tstep_red, cases "steps (Suc 0, tp) A stp", simp)
- fix a b c
- assume h1: "\<not> isS0 (a, b, c)"
- and h2: "tstep (a, b, c) A = (0, tp')"
- and h3: "t_correct A"
- and h4: "steps (Suc 0, tp) A stp = (a, b, c)"
- have "steps (Suc 0, tp) (A |+| B) stp = (a, b, c)"
- using h1 h4 h3
- apply(rule_tac t_merge_pre_eq, auto)
- done
- moreover have "tstep (a, b, c) (A |+| B) = (Suc (length A div 2), tp')"
- using h2 h3 h1 h4
- apply(simp add: tstep.simps)
- apply(case_tac " fetch A a (case c of [] \<Rightarrow> Bk | x # xs \<Rightarrow> x)", simp)
- apply(drule_tac B = B in t_merge_fetch_pre, auto simp: isS0_def intro: s_keep)
- done
- ultimately show "tstep (steps (Suc 0, tp) (A |+| B) stp) (A |+| B) = (Suc (length A div 2), tp')"
- by(simp)
-qed
-
-text {*
- When Turing machine @{text "A"} and @{text "B"} are combined and the execution
- of @{text "A"} can termination within @{text "stp"} steps,
- the combined machine @{text "A |+| B"} will eventually get into the starting
- state of machine @{text "B"}.
-*}
-lemma t_merge_pre_halt_same: "
- \<lbrakk>steps (Suc 0, tp) A stp = (0, tp'); t_correct A; t_correct B\<rbrakk>
- \<Longrightarrow> \<exists> stp. steps (Suc 0, tp) (A |+| B) stp = (Suc (length A div 2), tp')"
-proof -
- assume a_wf: "t_correct A"
- and b_wf: "t_correct B"
- and a_ht: "steps (Suc 0, tp) A stp = (0, tp')"
- have halt_point: "\<exists> stp. \<not> isS0 (steps (Suc 0, tp) A stp) \<and> steps (Suc 0, tp) A (Suc stp) = (0, tp')"
- using a_ht
- by(erule_tac first_halt_point)
- then obtain stp' where "\<not> isS0 (steps (Suc 0, tp) A stp') \<and> steps (Suc 0, tp) A (Suc stp') = (0, tp')"..
- hence "steps (Suc 0, tp) (A |+| B) (Suc stp') = (Suc (length A div 2), tp')"
- using a_wf
- apply(rule_tac t_merge_pre_halt_same', auto)
- done
- thus "?thesis" ..
-qed
-
-lemma fetch_0: "fetch p 0 b = (Nop, 0)"
-by(simp add: fetch.simps)
-
-lemma [simp]: "length (tshift B x) = length B"
-by(simp add: tshift.simps)
-
-lemma [simp]: "t_correct A \<Longrightarrow> 2 * (length A div 2) = length A"
-apply(simp add: t_correct.simps iseven_def, auto)
-done
-
-lemma t_merge_fetch_snd:
- "\<lbrakk>fetch B a b = (ac, ns); t_correct A; t_correct B; a > 0 \<rbrakk>
- \<Longrightarrow> fetch (A |+| B) (a + length A div 2) b
- = (ac, if ns = 0 then 0 else ns + length A div 2)"
-apply(auto simp: fetch.simps t_add.simps split: if_splits block.splits)
-apply(case_tac [!] a, simp_all)
-apply(simp_all add: nth_append change_termi_state.simps tshift.simps)
-done
-
-lemma t_merge_snd_eq_step:
- "\<lbrakk>tstep (s, l, r) B = (s', l', r'); t_correct A; t_correct B; s > 0\<rbrakk>
- \<Longrightarrow> tstep (s + length A div 2, l, r) (A |+| B) =
- (if s' = 0 then 0 else s' + length A div 2, l' ,r') "
-apply(simp add: tstep.simps)
-apply(cases "fetch B s (case r of [] \<Rightarrow> Bk | x # xs \<Rightarrow> x)")
-apply(auto simp: t_merge_fetch_snd)
-apply(frule_tac [!] t_merge_fetch_snd, auto)
-done
-
-text {*
- Relates the executions of TM @{text "B"}, one is when @{text "B"} is executed alone,
- the other is the execution when @{text "B"} is in the combined TM.
-*}
-lemma t_merge_snd_eq_steps:
- "\<lbrakk>t_correct A; t_correct B; steps (s, l, r) B stp = (s', l', r'); s > 0\<rbrakk>
- \<Longrightarrow> steps (s + length A div 2, l, r) (A |+| B) stp =
- (if s' = 0 then 0 else s' + length A div 2, l', r')"
-proof(induct stp arbitrary: s' l' r')
- case 0 thus "?case"
- by(simp add: steps.simps)
-next
- fix stp s' l' r'
- assume ind: "\<And>s' l' r'. \<lbrakk>t_correct A; t_correct B; steps (s, l, r) B stp = (s', l', r'); 0 < s\<rbrakk>
- \<Longrightarrow> steps (s + length A div 2, l, r) (A |+| B) stp =
- (if s' = 0 then 0 else s' + length A div 2, l', r')"
- and h1: "steps (s, l, r) B (Suc stp) = (s', l', r')"
- and h2: "t_correct A"
- and h3: "t_correct B"
- and h4: "0 < s"
- from h1 show "steps (s + length A div 2, l, r) (A |+| B) (Suc stp)
- = (if s' = 0 then 0 else s' + length A div 2, l', r')"
- proof(simp only: tstep_red, cases "steps (s, l, r) B stp")
- fix a b c
- assume h5: "steps (s, l, r) B stp = (a, b, c)" "tstep (steps (s, l, r) B stp) B = (s', l', r')"
- hence h6: "(steps (s + length A div 2, l, r) (A |+| B) stp) =
- ((if a = 0 then 0 else a + length A div 2, b, c))"
- using h2 h3 h4
- by(rule_tac ind, auto)
- thus "tstep (steps (s + length A div 2, l, r) (A |+| B) stp) (A |+| B) =
- (if s' = 0 then 0 else s'+ length A div 2, l', r')"
- using h5
- proof(auto)
- assume "tstep (0, b, c) B = (0, l', r')" thus "tstep (0, b, c) (A |+| B) = (0, l', r')"
- by(simp add: tstep_0)
- next
- assume "tstep (0, b, c) B = (s', l', r')" "0 < s'"
- thus "tstep (0, b, c) (A |+| B) = (s' + length A div 2, l', r')"
- by(simp add: tstep_0)
- next
- assume "tstep (a, b, c) B = (0, l', r')" "0 < a"
- thus "tstep (a + length A div 2, b, c) (A |+| B) = (0, l', r')"
- using h2 h3
- by(drule_tac t_merge_snd_eq_step, auto)
- next
- assume "tstep (a, b, c) B = (s', l', r')" "0 < a" "0 < s'"
- thus "tstep (a + length A div 2, b, c) (A |+| B) = (s' + length A div 2, l', r')"
- using h2 h3
- by(drule_tac t_merge_snd_eq_step, auto)
- qed
- qed
-qed
-
-lemma t_merge_snd_halt_eq:
- "\<lbrakk>steps (Suc 0, tp) B stp = (0, tp'); t_correct A; t_correct B\<rbrakk>
- \<Longrightarrow> \<exists>stp. steps (Suc (length A div 2), tp) (A |+| B) stp = (0, tp')"
-apply(case_tac tp, cases tp', simp)
-apply(drule_tac s = "Suc 0" in t_merge_snd_eq_steps, auto)
-done
-
-lemma t_inj: "\<lbrakk>steps (Suc 0, tp) A stpa = (0, tp1); steps (Suc 0, tp) A stpb = (0, tp2)\<rbrakk>
- \<Longrightarrow> tp1 = tp2"
-proof -
- assume h1: "steps (Suc 0, tp) A stpa = (0, tp1)"
- and h2: "steps (Suc 0, tp) A stpb = (0, tp2)"
- thus "?thesis"
- proof(cases "stpa < stpb")
- case True thus "?thesis"
- using h1 h2
- apply(drule_tac less_imp_Suc_add, auto)
- apply(simp del: add_Suc_right add_Suc add: add_Suc_right[THEN sym] steps_add steps_0)
- done
- next
- case False thus "?thesis"
- using h1 h2
- apply(drule_tac leI)
- apply(case_tac "stpb = stpa", auto)
- apply(subgoal_tac "stpb < stpa")
- apply(drule_tac less_imp_Suc_add, auto)
- apply(simp del: add_Suc_right add_Suc add: add_Suc_right[THEN sym] steps_add steps_0)
- done
- qed
-qed
-
-type_synonym t_assert = "tape \<Rightarrow> bool"
-
-definition t_imply :: "t_assert \<Rightarrow> t_assert \<Rightarrow> bool" ("_ \<turnstile>-> _" [0, 0] 100)
- where
- "t_imply a1 a2 = (\<forall> tp. a1 tp \<longrightarrow> a2 tp)"
-
-
-locale turing_merge =
- fixes A :: "tprog" and B :: "tprog" and P1 :: "t_assert"
- and P2 :: "t_assert"
- and P3 :: "t_assert"
- and P4 :: "t_assert"
- and Q1:: "t_assert"
- and Q2 :: "t_assert"
- assumes
- A_wf : "t_correct A"
- and B_wf : "t_correct B"
- and A_halt : "P1 tp \<Longrightarrow> \<exists> stp. let (s, tp') = steps (Suc 0, tp) A stp in s = 0 \<and> Q1 tp'"
- and B_halt : "P2 tp \<Longrightarrow> \<exists> stp. let (s, tp') = steps (Suc 0, tp) B stp in s = 0 \<and> Q2 tp'"
- and A_uhalt : "P3 tp \<Longrightarrow> \<not> (\<exists> stp. isS0 (steps (Suc 0, tp) A stp))"
- and B_uhalt: "P4 tp \<Longrightarrow> \<not> (\<exists> stp. isS0 (steps (Suc 0, tp) B stp))"
-begin
-
-
-text {*
- The following lemma tries to derive the Hoare logic rule for sequentially combined TMs.
- It deals with the situtation when both @{text "A"} and @{text "B"} are terminated.
-*}
-
-lemma t_merge_halt:
- assumes aimpb: "Q1 \<turnstile>-> P2"
- shows "P1 \<turnstile>-> \<lambda> tp. (\<exists> stp tp'. steps (Suc 0, tp) (A |+| B) stp = (0, tp') \<and> Q2 tp')"
-proof(simp add: t_imply_def, auto)
- fix a b
- assume h: "P1 (a, b)"
- hence "\<exists> stp. let (s, tp') = steps (Suc 0, a, b) A stp in s = 0 \<and> Q1 tp'"
- using A_halt by simp
- from this obtain stp1 where "let (s, tp') = steps (Suc 0, a, b) A stp1 in s = 0 \<and> Q1 tp'" ..
- thus "\<exists>stp aa ba. steps (Suc 0, a, b) (A |+| B) stp = (0, aa, ba) \<and> Q2 (aa, ba)"
- proof(case_tac "steps (Suc 0, a, b) A stp1", simp, erule_tac conjE)
- fix aa ba c
- assume g1: "Q1 (ba, c)"
- and g2: "steps (Suc 0, a, b) A stp1 = (0, ba, c)"
- hence "P2 (ba, c)"
- using aimpb apply(simp add: t_imply_def)
- done
- hence "\<exists> stp. let (s, tp') = steps (Suc 0, ba, c) B stp in s = 0 \<and> Q2 tp'"
- using B_halt by simp
- from this obtain stp2 where "let (s, tp') = steps (Suc 0, ba, c) B stp2 in s = 0 \<and> Q2 tp'" ..
- thus "?thesis"
- proof(case_tac "steps (Suc 0, ba, c) B stp2", simp, erule_tac conjE)
- fix aa bb ca
- assume g3: " Q2 (bb, ca)" "steps (Suc 0, ba, c) B stp2 = (0, bb, ca)"
- have "\<exists> stp. steps (Suc 0, a, b) (A |+| B) stp = (Suc (length A div 2), ba , c)"
- using g2 A_wf B_wf
- by(rule_tac t_merge_pre_halt_same, auto)
- moreover have "\<exists> stp. steps (Suc (length A div 2), ba, c) (A |+| B) stp = (0, bb, ca)"
- using g3 A_wf B_wf
- apply(rule_tac t_merge_snd_halt_eq, auto)
- done
- ultimately show "\<exists>stp aa ba. steps (Suc 0, a, b) (A |+| B) stp = (0, aa, ba) \<and> Q2 (aa, ba)"
- apply(erule_tac exE, erule_tac exE)
- apply(rule_tac x = "stp + stpa" in exI, simp add: steps_add)
- using g3 by simp
- qed
- qed
-qed
-
-lemma t_merge_uhalt_tmp:
- assumes B_uh: "\<forall>stp. \<not> isS0 (steps (Suc 0, b, c) B stp)"
- and merge_ah: "steps (Suc 0, tp) (A |+| B) stpa = (Suc (length A div 2), b, c)"
- shows "\<forall> stp. \<not> isS0 (steps (Suc 0, tp) (A |+| B) stp)"
- using B_uh merge_ah
-apply(rule_tac allI)
-apply(case_tac "stp > stpa")
-apply(erule_tac x = "stp - stpa" in allE)
-apply(case_tac "(steps (Suc 0, b, c) B (stp - stpa))", simp)
-proof -
- fix stp a ba ca
- assume h1: "\<not> isS0 (a, ba, ca)" "stpa < stp"
- and h2: "steps (Suc 0, b, c) B (stp - stpa) = (a, ba, ca)"
- have "steps (Suc 0 + length A div 2, b, c) (A |+| B) (stp - stpa) =
- (if a = 0 then 0 else a + length A div 2, ba, ca)"
- using A_wf B_wf h2
- by(rule_tac t_merge_snd_eq_steps, auto)
- moreover have "a > 0" using h1 by(simp add: isS0_def)
- moreover have "\<exists> stpb. stp = stpa + stpb"
- using h1 by(rule_tac x = "stp - stpa" in exI, simp)
- ultimately show "\<not> isS0 (steps (Suc 0, tp) (A |+| B) stp)"
- using merge_ah
- by(auto simp: steps_add isS0_def)
-next
- fix stp
- assume h: "steps (Suc 0, tp) (A |+| B) stpa = (Suc (length A div 2), b, c)" "\<not> stpa < stp"
- hence "\<exists> stpb. stpa = stp + stpb" apply(rule_tac x = "stpa - stp" in exI, auto) done
- thus "\<not> isS0 (steps (Suc 0, tp) (A |+| B) stp)"
- using h
- apply(auto)
- apply(cases "steps (Suc 0, tp) (A |+| B) stp", simp add: steps_add isS0_def steps_0)
- done
-qed
-
-text {*
- The following lemma deals with the situation when TM @{text "B"} can not terminate.
- *}
-
-lemma t_merge_uhalt:
- assumes aimpb: "Q1 \<turnstile>-> P4"
- shows "P1 \<turnstile>-> \<lambda> tp. \<not> (\<exists> stp. isS0 (steps (Suc 0, tp) (A |+| B) stp))"
-proof(simp only: t_imply_def, rule_tac allI, rule_tac impI)
- fix tp
- assume init_asst: "P1 tp"
- show "\<not> (\<exists>stp. isS0 (steps (Suc 0, tp) (A |+| B) stp))"
- proof -
- have "\<exists> stp. let (s, tp') = steps (Suc 0, tp) A stp in s = 0 \<and> Q1 tp'"
- using A_halt[of tp] init_asst
- by(simp)
- from this obtain stpx where "let (s, tp') = steps (Suc 0, tp) A stpx in s = 0 \<and> Q1 tp'" ..
- thus "?thesis"
- proof(cases "steps (Suc 0, tp) A stpx", simp, erule_tac conjE)
- fix a b c
- assume "Q1 (b, c)"
- and h3: "steps (Suc 0, tp) A stpx = (0, b, c)"
- hence h2: "P4 (b, c)" using aimpb
- by(simp add: t_imply_def)
- have "\<exists> stp. steps (Suc 0, tp) (A |+| B) stp = (Suc (length A div 2), b, c)"
- using h3 A_wf B_wf
- apply(rule_tac stp = stpx in t_merge_pre_halt_same, auto)
- done
- from this obtain stpa where h4:"steps (Suc 0, tp) (A |+| B) stpa = (Suc (length A div 2), b, c)" ..
- have " \<not> (\<exists> stp. isS0 (steps (Suc 0, b, c) B stp))"
- using B_uhalt [of "(b, c)"] h2 apply simp
- done
- from this and h4 show "\<forall>stp. \<not> isS0 (steps (Suc 0, tp) (A |+| B) stp)"
- by(rule_tac t_merge_uhalt_tmp, auto)
- qed
- qed
-qed
-end
-
-end
-
--- a/utm/uncomputable.thy Mon Mar 04 21:01:55 2013 +0000
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,1614 +0,0 @@
-(* Title: Turing machine's definition and its charater
- Author: XuJian <xujian817@hotmail.com>
- Maintainer: Xujian
-*)
-
-header {* Undeciablity of the {\em Halting problem} *}
-
-theory uncomputable
-imports Main turing_basic
-begin
-
-text {*
- The {\em Copying} TM, which duplicates its input.
-*}
-definition tcopy :: "tprog"
-where
-"tcopy \<equiv> [(W0, 0), (R, 2), (R, 3), (R, 2),
- (W1, 3), (L, 4), (L, 4), (L, 5), (R, 11), (R, 6),
- (R, 7), (W0, 6), (R, 7), (R, 8), (W1, 9), (R, 8),
- (L, 10), (L, 9), (L, 10), (L, 5), (R, 12), (R, 12),
- (W1, 13), (L, 14), (R, 12), (R, 12), (L, 15), (W0, 14),
- (R, 0), (L, 15)]"
-
-text {*
- @{text "wipeLastBs tp"} removes all blanks at the end of tape @{text "tp"}.
-*}
-fun wipeLastBs :: "block list \<Rightarrow> block list"
- where
- "wipeLastBs bl = rev (dropWhile (\<lambda>a. a = Bk) (rev bl))"
-
-fun isBk :: "block \<Rightarrow> bool"
- where
- "isBk b = (b = Bk)"
-
-text {*
- The following functions are used to expression invariants of {\em Copying} TM.
-*}
-fun tcopy_F0 :: "nat \<Rightarrow> tape \<Rightarrow> bool"
- where
- "tcopy_F0 x (l, r) = (\<exists> i. l = Bk\<^bsup>i\<^esup> \<and> r = Oc\<^bsup>x\<^esup> @ Bk # Oc\<^bsup>x\<^esup>)"
-
-fun tcopy_F1 :: "nat \<Rightarrow> tape \<Rightarrow> bool"
- where
- "tcopy_F1 x (l, r) = (l = [] \<and> r = Oc\<^bsup>x\<^esup>)"
-
-fun tcopy_F2 :: "nat \<Rightarrow> tape \<Rightarrow> bool"
- where
- "tcopy_F2 x (l, r) = (\<exists> i j. i > 0 \<and> i + j = x \<and> l = Oc\<^bsup>i\<^esup> \<and> r = Oc\<^bsup>j\<^esup>)"
-
-fun tcopy_F3 :: "nat \<Rightarrow> tape \<Rightarrow> bool"
- where
- "tcopy_F3 x (l, r) = (x > 0 \<and> l = Bk # Oc\<^bsup>x\<^esup> \<and> tl r = [])"
-
-fun tcopy_F4 :: "nat \<Rightarrow> tape \<Rightarrow> bool"
- where
- "tcopy_F4 x (l, r) = (x > 0 \<and> ((l = Oc\<^bsup>x\<^esup> \<and> r = [Bk, Oc]) \<or> (l = Oc\<^bsup>x - 1\<^esup> \<and> r = [Oc, Bk, Oc])))"
-
-fun tcopy_F5_loop :: "nat \<Rightarrow> tape \<Rightarrow> bool"
- where
- "tcopy_F5_loop x (l, r) =
- (\<exists> i j. i + j + 1 = x \<and> l = Oc\<^bsup>i\<^esup> \<and> r = Oc # Oc # Bk\<^bsup>j\<^esup> @ Oc\<^bsup>j\<^esup> \<and> j > 0)"
-
-fun tcopy_F5_exit :: "nat \<Rightarrow> tape \<Rightarrow> bool"
- where
- "tcopy_F5_exit x (l, r) =
- (l = [] \<and> r = Bk # Oc # Bk\<^bsup>x\<^esup> @ Oc\<^bsup>x\<^esup> \<and> x > 0 )"
-
-fun tcopy_F5 :: "nat \<Rightarrow> tape \<Rightarrow> bool"
- where
- "tcopy_F5 x (l, r) = (tcopy_F5_loop x (l, r) \<or> tcopy_F5_exit x (l, r))"
-
-fun tcopy_F6 :: "nat \<Rightarrow> tape \<Rightarrow> bool"
- where
- "tcopy_F6 x (l, r) =
- (\<exists> i j any. i + j = x \<and> x > 0 \<and> i > 0 \<and> j > 0 \<and> l = Oc\<^bsup>i\<^esup> \<and> r = any#Bk\<^bsup>j\<^esup> @ Oc\<^bsup>j\<^esup>)"
-
-fun tcopy_F7 :: "nat \<Rightarrow> tape \<Rightarrow> bool"
- where
- "tcopy_F7 x (l, r) =
- (\<exists> i j k t. i + j = x \<and> i > 0 \<and> j > 0 \<and> k + t = Suc j \<and> l = Bk\<^bsup>k\<^esup> @ Oc\<^bsup>i\<^esup> \<and> r = Bk\<^bsup>t\<^esup> @ Oc\<^bsup>j\<^esup>)"
-
-fun tcopy_F8 :: "nat \<Rightarrow> tape \<Rightarrow> bool"
- where
- "tcopy_F8 x (l, r) =
- (\<exists> i j k t. i + j = x \<and> i > 0 \<and> j > 0 \<and> k + t = j \<and> l = Oc\<^bsup>k\<^esup> @ Bk\<^bsup>Suc j\<^esup> @ Oc\<^bsup>i\<^esup> \<and> r = Oc\<^bsup>t\<^esup>)"
-
-fun tcopy_F9_loop :: "nat \<Rightarrow> tape \<Rightarrow> bool"
-where
- "tcopy_F9_loop x (l, r) =
- (\<exists> i j k t. i + j = Suc x \<and> i > 0 \<and> j > 0 \<and> k + t = j \<and> t > 0\<and> l = Oc\<^bsup>k\<^esup> @ Bk\<^bsup>j\<^esup> @ Oc\<^bsup>i\<^esup> \<and> r = Oc\<^bsup>t\<^esup>)"
-
-fun tcopy_F9_exit :: "nat \<Rightarrow> tape \<Rightarrow> bool"
- where
- "tcopy_F9_exit x (l, r) = (\<exists> i j. i + j = Suc x \<and> i > 0 \<and> j > 0 \<and> l = Bk\<^bsup>j - 1\<^esup> @ Oc\<^bsup>i\<^esup> \<and> r = Bk # Oc\<^bsup>j\<^esup>)"
-
-fun tcopy_F9 :: "nat \<Rightarrow> tape \<Rightarrow> bool"
- where
- "tcopy_F9 x (l, r) = (tcopy_F9_loop x (l, r) \<or>
- tcopy_F9_exit x (l, r))"
-
-fun tcopy_F10_loop :: "nat \<Rightarrow> tape \<Rightarrow> bool"
- where
- "tcopy_F10_loop x (l, r) =
- (\<exists> i j k t. i + j = Suc x \<and> i > 0 \<and> k + t + 1 = j \<and> l = Bk\<^bsup>k\<^esup> @ Oc\<^bsup>i\<^esup> \<and> r = Bk\<^bsup>Suc t\<^esup> @ Oc\<^bsup>j\<^esup>)"
-
-fun tcopy_F10_exit :: "nat \<Rightarrow> tape \<Rightarrow> bool"
- where
- "tcopy_F10_exit x (l, r) =
- (\<exists> i j. i + j = x \<and> j > 0 \<and> l = Oc\<^bsup>i\<^esup> \<and> r = Oc # Bk\<^bsup>j\<^esup> @ Oc\<^bsup>j\<^esup>)"
-
-fun tcopy_F10 :: "nat \<Rightarrow> tape \<Rightarrow> bool"
- where
- "tcopy_F10 x (l, r) = (tcopy_F10_loop x (l, r) \<or> tcopy_F10_exit x (l, r))"
-
-fun tcopy_F11 :: "nat \<Rightarrow> tape \<Rightarrow> bool"
- where
- "tcopy_F11 x (l, r) = (x > 0 \<and> l = [Bk] \<and> r = Oc # Bk\<^bsup>x\<^esup> @ Oc\<^bsup>x\<^esup>)"
-
-fun tcopy_F12 :: "nat \<Rightarrow> tape \<Rightarrow> bool"
- where
- "tcopy_F12 x (l, r) = (\<exists> i j. i + j = Suc x \<and> x > 0 \<and> l = Oc\<^bsup>i\<^esup> @ [Bk] \<and> r = Bk\<^bsup>j\<^esup> @ Oc\<^bsup>x\<^esup>)"
-
-fun tcopy_F13 :: "nat \<Rightarrow> tape \<Rightarrow> bool"
- where
- "tcopy_F13 x (l, r) =
- (\<exists> i j. x > 0 \<and> i + j = x \<and> l = Oc\<^bsup>i\<^esup> @ [Bk] \<and> r = Oc # Bk\<^bsup>j\<^esup> @ Oc\<^bsup>x\<^esup> )"
-
-fun tcopy_F14 :: "nat \<Rightarrow> tape \<Rightarrow> bool"
- where
- "tcopy_F14 x (l, r) = (\<exists> any. x > 0 \<and> l = Oc\<^bsup>x\<^esup> @ [Bk] \<and> r = any#Oc\<^bsup>x\<^esup>)"
-
-fun tcopy_F15_loop :: "nat \<Rightarrow> tape \<Rightarrow> bool"
- where
- "tcopy_F15_loop x (l, r) =
- (\<exists> i j. i + j = x \<and> x > 0 \<and> j > 0 \<and> l = Oc\<^bsup>i\<^esup> @ [Bk] \<and> r = Oc\<^bsup>j\<^esup> @ Bk # Oc\<^bsup>x\<^esup>)"
-
-fun tcopy_F15_exit :: "nat \<Rightarrow> tape \<Rightarrow> bool"
- where
- "tcopy_F15_exit x (l, r) = (x > 0 \<and> l = [] \<and> r = Bk # Oc\<^bsup>x\<^esup> @ Bk # Oc\<^bsup>x\<^esup>)"
-
-fun tcopy_F15 :: "nat \<Rightarrow> tape \<Rightarrow> bool"
- where
- "tcopy_F15 x (l, r) = (tcopy_F15_loop x (l, r) \<or> tcopy_F15_exit x (l, r))"
-
-text {*
- The following @{text "inv_tcopy"} is the invariant of the {\em Copying} TM.
-*}
-fun inv_tcopy :: "nat \<Rightarrow> t_conf \<Rightarrow> bool"
- where
- "inv_tcopy x c = (let (state, tp) = c in
- if state = 0 then tcopy_F0 x tp
- else if state = 1 then tcopy_F1 x tp
- else if state = 2 then tcopy_F2 x tp
- else if state = 3 then tcopy_F3 x tp
- else if state = 4 then tcopy_F4 x tp
- else if state = 5 then tcopy_F5 x tp
- else if state = 6 then tcopy_F6 x tp
- else if state = 7 then tcopy_F7 x tp
- else if state = 8 then tcopy_F8 x tp
- else if state = 9 then tcopy_F9 x tp
- else if state = 10 then tcopy_F10 x tp
- else if state = 11 then tcopy_F11 x tp
- else if state = 12 then tcopy_F12 x tp
- else if state = 13 then tcopy_F13 x tp
- else if state = 14 then tcopy_F14 x tp
- else if state = 15 then tcopy_F15 x tp
- else False)"
-declare tcopy_F0.simps [simp del]
- tcopy_F1.simps [simp del]
- tcopy_F2.simps [simp del]
- tcopy_F3.simps [simp del]
- tcopy_F4.simps [simp del]
- tcopy_F5.simps [simp del]
- tcopy_F6.simps [simp del]
- tcopy_F7.simps [simp del]
- tcopy_F8.simps [simp del]
- tcopy_F9.simps [simp del]
- tcopy_F10.simps [simp del]
- tcopy_F11.simps [simp del]
- tcopy_F12.simps [simp del]
- tcopy_F13.simps [simp del]
- tcopy_F14.simps [simp del]
- tcopy_F15.simps [simp del]
-
-lemma exp_zero_simp: "(a\<^bsup>b\<^esup> = []) = (b = 0)"
-apply(auto simp: exponent_def)
-done
-
-lemma exp_zero_simp2: "([] = a\<^bsup>b\<^esup> ) = (b = 0)"
-apply(auto simp: exponent_def)
-done
-
-lemma [elim]: "\<lbrakk>tstep (0, a, b) tcopy = (s, l, r); s \<noteq> 0\<rbrakk> \<Longrightarrow> RR"
-apply(simp add: tstep.simps tcopy_def fetch.simps)
-done
-
-lemma [elim]: "\<lbrakk>tstep (Suc 0, a, b) tcopy = (s, l, r); s \<noteq> 0; s \<noteq> 2\<rbrakk>
- \<Longrightarrow> RR"
-apply(simp add: tstep.simps tcopy_def fetch.simps)
-apply(simp split: block.splits list.splits)
-done
-
-lemma [elim]: "\<lbrakk>tstep (2, a, b) tcopy = (s, l, r); s \<noteq> 2; s \<noteq> 3\<rbrakk>
- \<Longrightarrow> RR"
-apply(simp add: tstep.simps tcopy_def fetch.simps)
-apply(simp split: block.splits list.splits)
-done
-
-lemma [elim]: "\<lbrakk>tstep (3, a, b) tcopy = (s, l, r); s \<noteq> 3; s \<noteq> 4\<rbrakk>
- \<Longrightarrow> RR"
-by(simp add: tstep.simps tcopy_def fetch.simps
- split: block.splits list.splits)
-
-lemma [elim]: "\<lbrakk>tstep (4, a, b) tcopy = (s, l, r); s \<noteq> 4; s \<noteq> 5\<rbrakk>
- \<Longrightarrow> RR"
-by(simp add: tstep.simps tcopy_def fetch.simps
- split: block.splits list.splits)
-
-lemma [elim]: "\<lbrakk>tstep (5, a, b) tcopy = (s, l, r); s \<noteq> 6; s \<noteq> 11\<rbrakk>
- \<Longrightarrow> RR"
-by(simp add: tstep.simps tcopy_def fetch.simps
- split: block.splits list.splits)
-
-lemma [elim]: "\<lbrakk>tstep (6, a, b) tcopy = (s, l, r); s \<noteq> 6; s \<noteq> 7\<rbrakk>
- \<Longrightarrow> RR"
-by(simp add: tstep.simps tcopy_def fetch.simps
- split: block.splits list.splits)
-
-lemma [elim]: "\<lbrakk>tstep (7, a, b) tcopy = (s, l, r); s \<noteq> 7; s \<noteq> 8\<rbrakk>
- \<Longrightarrow> RR"
-by(simp add: tstep.simps tcopy_def fetch.simps
- split: block.splits list.splits)
-
-lemma [elim]: "\<lbrakk>tstep (8, a, b) tcopy = (s, l, r); s \<noteq> 8; s \<noteq> 9\<rbrakk>
- \<Longrightarrow> RR"
-by(simp add: tstep.simps tcopy_def fetch.simps
- split: block.splits list.splits)
-
-lemma [elim]: "\<lbrakk>tstep (9, a, b) tcopy = (s, l, r); s \<noteq> 9; s \<noteq> 10\<rbrakk>
- \<Longrightarrow> RR"
-by(simp add: tstep.simps tcopy_def fetch.simps
- split: block.splits list.splits)
-
-lemma [elim]: "\<lbrakk>tstep (10, a, b) tcopy = (s, l, r); s \<noteq> 10; s \<noteq> 5\<rbrakk>
- \<Longrightarrow> RR"
-by(simp add: tstep.simps tcopy_def fetch.simps
- split: block.splits list.splits)
-
-lemma [elim]: "\<lbrakk>tstep (11, a, b) tcopy = (s, l, r); s \<noteq> 12\<rbrakk> \<Longrightarrow> RR"
-by(simp add: tstep.simps tcopy_def fetch.simps
- split: block.splits list.splits)
-
-lemma [elim]: "\<lbrakk>tstep (12, a, b) tcopy = (s, l, r); s \<noteq> 13; s \<noteq> 14\<rbrakk>
- \<Longrightarrow> RR"
-by(simp add: tstep.simps tcopy_def fetch.simps
- split: block.splits list.splits)
-
-lemma [elim]: "\<lbrakk>tstep (13, a, b) tcopy = (s, l, r); s \<noteq> 12\<rbrakk> \<Longrightarrow> RR"
-by(simp add: tstep.simps tcopy_def fetch.simps
- split: block.splits list.splits)
-
-lemma [elim]: "\<lbrakk>tstep (14, a, b) tcopy = (s, l, r); s \<noteq> 14; s \<noteq> 15\<rbrakk>
- \<Longrightarrow> RR"
-by(simp add: tstep.simps tcopy_def fetch.simps
- split: block.splits list.splits)
-
-lemma [elim]: "\<lbrakk>tstep (15, a, b) tcopy = (s, l, r); s \<noteq> 0; s \<noteq> 15\<rbrakk>
- \<Longrightarrow> RR"
-by(simp add: tstep.simps tcopy_def fetch.simps
- split: block.splits list.splits)
-
-(*
-lemma min_Suc4: "min (Suc (Suc x)) x = x"
-by auto
-
-lemma takeWhile2replicate:
- "\<exists>n. takeWhile (\<lambda>a. a = b) list = replicate n b"
-apply(induct list)
-apply(rule_tac x = 0 in exI, simp)
-apply(auto)
-apply(rule_tac x = "Suc n" in exI, simp)
-done
-
-lemma rev_replicate_same: "rev (replicate x b) = replicate x b"
-by(simp)
-
-lemma rev_equal: "a = b \<Longrightarrow> rev a = rev b"
-by simp
-
-lemma rev_equal_rev: "rev a = rev b \<Longrightarrow> a = b"
-by simp
-
-lemma rep_suc_rev[simp]:"replicate n b @ [b] = replicate (Suc n) b"
-apply(rule rev_equal_rev)
-apply(simp only: rev_append rev_replicate_same)
-apply(auto)
-done
-
-lemma replicate_Cons_simp: "b # replicate n b @ xs =
- replicate n b @ b # xs"
-apply(simp)
-done
-*)
-
-lemma [elim]: "\<lbrakk>tstep (14, b, c) tcopy = (15, ab, ba);
- tcopy_F14 x (b, c)\<rbrakk> \<Longrightarrow> tcopy_F15 x (ab, ba)"
-apply(auto simp: tstep.simps tcopy_def
- tcopy_F14.simps tcopy_F15.simps fetch.simps new_tape.simps
- split: if_splits list.splits block.splits)
-apply(erule_tac [!] x = "x - 1" in allE)
-apply(case_tac [!] x, simp_all add: exp_ind_def exp_zero)
-apply(erule_tac [!] x = "Suc 0" in allE, simp_all)
-done
-
-(*
-lemma dropWhile_drophd: "\<not> p a \<Longrightarrow>
- (dropWhile p xs @ (a # as)) = (dropWhile p (xs @ [a]) @ as)"
-apply(induct xs)
-apply(auto)
-done
-*)
-(*
-lemma dropWhile_append3: "\<lbrakk>\<not> p a;
- listall ((dropWhile p xs) @ [a]) isBk\<rbrakk> \<Longrightarrow>
- listall (dropWhile p (xs @ [a])) isBk"
-apply(drule_tac p = p and xs = xs and a = a in dropWhile_drophd, simp)
-done
-
-lemma takeWhile_append3: "\<lbrakk>\<not>p a; (takeWhile p xs) = b\<rbrakk>
- \<Longrightarrow> takeWhile p (xs @ (a # as)) = b"
-apply(drule_tac P = p and xs = xs and x = a and l = as in
- takeWhile_tail)
-apply(simp)
-done
-
-lemma listall_append: "list_all p (xs @ ys) =
- (list_all p xs \<and> list_all p ys)"
-apply(induct xs)
-apply(simp+)
-done
-*)
-lemma false_case1:
- "\<lbrakk>Oc\<^bsup>j\<^esup> @ Bk # Oc\<^bsup>i + j\<^esup> = Oc # list;
- 0 < i;
- \<forall>ia. tl (Oc\<^bsup>i\<^esup> @ [Bk]) = Oc\<^bsup>ia\<^esup> @ [Bk] \<longrightarrow> (\<forall>ja. ia + ja = i + j
- \<longrightarrow> hd (Oc\<^bsup>i\<^esup> @ [Bk]) # Oc # list \<noteq> Oc\<^bsup>ja\<^esup> @ Bk # Oc\<^bsup>i + j\<^esup>)\<rbrakk>
- \<Longrightarrow> RR"
-apply(case_tac i, auto simp: exp_ind_def)
-apply(erule_tac x = nat in allE, simp add:exp_ind_def)
-apply(erule_tac x = "Suc j" in allE, simp)
-done
-
-lemma false_case3:"\<forall>ja. ja \<noteq> i \<Longrightarrow> RR"
-by auto
-
-lemma [elim]: "\<lbrakk>tstep (15, b, c) tcopy = (15, ab, ba);
- tcopy_F15 x (b, c)\<rbrakk> \<Longrightarrow> tcopy_F15 x (ab, ba)"
-apply(auto simp: tstep.simps tcopy_F15.simps
- tcopy_def fetch.simps new_tape.simps
- split: if_splits list.splits block.splits elim: false_case1)
-apply(case_tac [!] i, simp_all add: exp_zero exp_ind_def)
-apply(erule_tac [!] x = nat in allE, simp_all add: exp_ind_def)
-apply(auto elim: false_case3)
-done
-
-lemma [elim]: "\<lbrakk>tstep (14, b, c) tcopy = (14, ab, ba);
- tcopy_F14 x (b, c)\<rbrakk> \<Longrightarrow> tcopy_F14 x (ab, ba)"
-apply(auto simp: tcopy_F14.simps tcopy_def tstep.simps
- tcopy_F14.simps fetch.simps new_tape.simps
- split: if_splits list.splits block.splits)
-done
-
-
-lemma [elim]: "\<lbrakk>tstep (12, b, c) tcopy = (14, ab, ba);
- tcopy_F12 x (b, c)\<rbrakk> \<Longrightarrow> tcopy_F14 x (ab, ba)"
-apply(auto simp:tcopy_F12.simps tcopy_F14.simps
- tcopy_def tstep.simps fetch.simps new_tape.simps
- split: if_splits list.splits block.splits)
-apply(case_tac [!] j, simp_all add: exp_zero exp_ind_def)
-done
-
-lemma [elim]: "\<lbrakk>tstep (12, b, c) tcopy = (13, ab, ba);
- tcopy_F12 x (b, c)\<rbrakk> \<Longrightarrow> tcopy_F13 x (ab, ba)"
-apply(auto simp:tcopy_F12.simps tcopy_F13.simps
- tcopy_def tstep.simps fetch.simps new_tape.simps
- split: if_splits list.splits block.splits)
-apply(case_tac x, simp_all add: exp_ind_def exp_zero)
-apply(rule_tac [!] x = i in exI, simp_all)
-apply(rule_tac [!] x = "j - 1" in exI)
-apply(case_tac [!] j, simp_all add: exp_ind_def exp_zero)
-apply(case_tac x, simp_all add: exp_ind_def exp_zero)
-done
-
-lemma [elim]: "\<lbrakk>tstep (11, b, c) tcopy = (12, ab, ba);
- tcopy_F11 x (b, c)\<rbrakk> \<Longrightarrow> tcopy_F12 x (ab, ba)"
-apply(simp_all add:tcopy_F12.simps tcopy_F11.simps
- tcopy_def tstep.simps fetch.simps new_tape.simps)
-apply(auto)
-apply(rule_tac x = "Suc 0" in exI,
- rule_tac x = x in exI, simp add: exp_ind_def exp_zero)
-done
-
-
-lemma [elim]: "\<lbrakk>tstep (13, b, c) tcopy = (12, ab, ba);
- tcopy_F13 x (b, c)\<rbrakk> \<Longrightarrow> tcopy_F12 x (ab, ba)"
-apply(auto simp:tcopy_F12.simps tcopy_F13.simps
- tcopy_def tstep.simps fetch.simps new_tape.simps
- split: if_splits list.splits block.splits)
-apply(rule_tac [!] x = "Suc i" in exI, simp_all add: exp_ind_def)
-done
-
-lemma [elim]: "\<lbrakk>tstep (5, b, c) tcopy = (11, ab, ba);
- tcopy_F5 x (b, c)\<rbrakk> \<Longrightarrow> tcopy_F11 x (ab, ba)"
-apply(simp_all add:tcopy_F11.simps tcopy_F5.simps tcopy_def
- tstep.simps fetch.simps new_tape.simps)
-apply(simp split: if_splits list.splits block.splits)
-done
-
-lemma F10_false: "tcopy_F10 x (b, []) = False"
-apply(auto simp: tcopy_F10.simps exp_ind_def)
-done
-
-lemma F10_false2: "tcopy_F10 x ([], Bk # list) = False"
-apply(auto simp:tcopy_F10.simps)
-apply(case_tac i, simp_all add: exp_ind_def exp_zero)
-done
-
-lemma [simp]: "tcopy_F10_exit x (b, Bk # list) = False"
-apply(auto simp: tcopy_F10.simps)
-done
-
-declare tcopy_F10_loop.simps[simp del] tcopy_F10_exit.simps[simp del]
-
-lemma [simp]: "tcopy_F10_loop x (b, [Bk]) = False"
-apply(auto simp: tcopy_F10_loop.simps)
-apply(simp add: exp_ind_def)
-done
-
-lemma [elim]: "\<lbrakk>tstep (10, b, c) tcopy = (10, ab, ba);
- tcopy_F10 x (b, c)\<rbrakk> \<Longrightarrow> tcopy_F10 x (ab, ba)"
-apply(simp add: tcopy_def tstep.simps fetch.simps
- new_tape.simps exp_ind_def exp_zero_simp exp_zero_simp2 F10_false F10_false2
- split: if_splits list.splits block.splits)
-apply(simp add: tcopy_F10.simps del: tcopy_F10_loop.simps tcopy_F10_exit.simps)
-apply(case_tac b, simp, case_tac aa)
-apply(rule_tac disjI1)
-apply(simp only: tcopy_F10_loop.simps)
-apply(erule_tac exE)+
-apply(rule_tac x = i in exI, rule_tac x = j in exI,
- rule_tac x = "k - 1" in exI, rule_tac x = "Suc t" in exI, simp)
-apply(case_tac k, simp_all add: exp_ind_def exp_zero)
-apply(case_tac i, simp_all add: exp_ind_def exp_zero)
-apply(rule_tac disjI2)
-apply(simp only: tcopy_F10_loop.simps tcopy_F10_exit.simps)
-apply(erule_tac exE)+
-apply(rule_tac x = "i - 1" in exI, rule_tac x = "j" in exI)
-apply(case_tac k, simp_all add: exp_ind_def exp_zero)
-apply(case_tac i, simp_all add: exp_ind_def exp_zero)
-apply(auto)
-apply(simp add: exp_ind_def)
-done
-
-(*
-lemma false_case4: "\<lbrakk>i + (k + t) = Suc x;
- 0 < i;
- Bk # list = Oc\<^bsup>t\<^esup>;
- \<forall>ia j. ia + j = Suc x \<longrightarrow> ia = 0 \<or> (\<forall>ka. tl (Oc\<^bsup>k\<^esup>) @ Bk\<^bsup>k + t\<^esup> @ Oc\<^bsup>i\<^esup> = Bk\<^bsup>ka\<^esup> @ Oc\<^bsup>ia\<^esup> \<longrightarrow> (\<forall>ta. Suc (ka + ta) = j \<longrightarrow> Oc # Oc\<^bsup>t\<^esup> \<noteq> Bk\<^bsup>Suc ta\<^esup> @ Oc\<^bsup>j\<^esup>));
- 0 < k\<rbrakk>
- \<Longrightarrow> RR"
-apply(case_tac t, simp_all add: exp_ind_def exp_zero)
-done
-
-lemma false_case5: "
- \<lbrakk>Suc (i + nata) = x;
- 0 < i;
- \<forall>ia j. ia + j = Suc x \<longrightarrow> ia = 0 \<or> (\<forall>k. Bk\<^bsup>nata\<^esup> @ Oc\<^bsup>i\<^esup> = Bk\<^bsup>k\<^esup> @ Oc\<^bsup>ia\<^esup> \<longrightarrow> (\<forall>t. Suc (k + t) = j \<longrightarrow> Bk # Oc # Oc # Oc\<^bsup>nata\<^esup> \<noteq> Bk\<^bsup>t\<^esup> @ Oc\<^bsup>j\<^esup>))\<rbrakk>
- \<Longrightarrow> False"
-apply(erule_tac x = i in allE, simp)
-apply(erule_tac x = "Suc (Suc nata)" in allE, simp)
-apply(erule_tac x = nata in allE, simp, simp add: exp_ind_def exp_zero)
-done
-
-lemma false_case6: "\<lbrakk>0 < x; \<forall>i. tl (Oc\<^bsup>x\<^esup>) = Oc\<^bsup>i\<^esup> \<longrightarrow> (\<forall>j. i + j = x \<longrightarrow> j = 0 \<or> [Bk, Oc] \<noteq> Bk\<^bsup>j\<^esup> @ Oc\<^bsup>j\<^esup>)\<rbrakk>
- \<Longrightarrow> False"
-apply(erule_tac x = "x - 1" in allE)
-apply(case_tac x, simp_all add: exp_ind_def exp_zero)
-apply(erule_tac x = "Suc 0" in allE, simp)
-done
-*)
-
-lemma [simp]: "tcopy_F9 x ([], b) = False"
-apply(auto simp: tcopy_F9.simps)
-apply(case_tac [!] i, simp_all add: exp_ind_def exp_zero)
-done
-
-lemma [simp]: "tcopy_F9 x (b, []) = False"
-apply(auto simp: tcopy_F9.simps)
-apply(case_tac [!] t, simp_all add: exp_ind_def exp_zero)
-done
-
-declare tcopy_F9_loop.simps[simp del] tcopy_F9_exit.simps[simp del]
-lemma [simp]: "tcopy_F9_loop x (b, Bk # list) = False"
-apply(auto simp: tcopy_F9_loop.simps)
-apply(case_tac [!] t, simp_all add: exp_ind_def exp_zero)
-done
-
-lemma [elim]: "\<lbrakk>tstep (9, b, c) tcopy = (10, ab, ba);
- tcopy_F9 x (b, c)\<rbrakk> \<Longrightarrow> tcopy_F10 x (ab, ba)"
-apply(auto simp:tcopy_def
- tstep.simps fetch.simps new_tape.simps exp_zero_simp
- exp_zero_simp2
- split: if_splits list.splits block.splits)
-apply(case_tac "hd b", simp add:tcopy_F9.simps tcopy_F10.simps )
-apply(simp only: tcopy_F9_exit.simps tcopy_F10_loop.simps)
-apply(erule_tac exE)+
-apply(rule_tac x = i in exI, rule_tac x = j in exI, simp)
-apply(rule_tac x = "j - 2" in exI, simp add: exp_ind_def)
-apply(case_tac j, simp, simp)
-apply(case_tac nat, simp_all add: exp_zero exp_ind_def)
-apply(case_tac x, simp_all add: exp_ind_def exp_zero)
-apply(simp add: tcopy_F9.simps tcopy_F10.simps)
-apply(rule_tac disjI2)
-apply(simp only: tcopy_F10_exit.simps tcopy_F9_exit.simps)
-apply(erule_tac exE)+
-apply(simp)
-apply(case_tac j, simp_all, case_tac nat, simp_all add: exp_ind_def exp_zero)
-apply(case_tac x, simp_all add: exp_ind_def exp_zero)
-apply(rule_tac x = nata in exI, rule_tac x = 1 in exI, simp add: exp_ind_def exp_zero)
-done
-
-lemma false_case7:
- "\<lbrakk>i + (n + t) = x; 0 < i; 0 < t; Oc # list = Oc\<^bsup>t\<^esup>; k = Suc n;
- \<forall>j. i + j = Suc x \<longrightarrow> (\<forall>k. Oc\<^bsup>n\<^esup> @ Bk # Bk\<^bsup>n + t\<^esup> = Oc\<^bsup>k\<^esup> @ Bk\<^bsup>j\<^esup> \<longrightarrow>
- (\<forall>ta. k + ta = j \<longrightarrow> ta = 0 \<or> Oc # Oc\<^bsup>t\<^esup> \<noteq> Oc\<^bsup>ta\<^esup>))\<rbrakk>
- \<Longrightarrow> RR"
-apply(erule_tac x = "k + t" in allE, simp)
-apply(erule_tac x = n in allE, simp add: exp_ind_def)
-apply(erule_tac x = "Suc t" in allE, simp)
-done
-
-lemma false_case8:
- "\<lbrakk>i + t = Suc x;
- 0 < i;
- 0 < t;
- \<forall>ia j. tl (Bk\<^bsup>t\<^esup> @ Oc\<^bsup>i\<^esup>) = Bk\<^bsup>j - Suc 0\<^esup> @ Oc\<^bsup>ia\<^esup> \<longrightarrow>
- ia + j = Suc x \<longrightarrow> ia = 0 \<or> j = 0 \<or> Oc\<^bsup>t\<^esup> \<noteq> Oc\<^bsup>j\<^esup>\<rbrakk> \<Longrightarrow>
- RR"
-apply(erule_tac x = i in allE, simp)
-apply(erule_tac x = t in allE, simp)
-apply(case_tac t, simp_all add: exp_ind_def exp_zero)
-done
-
-lemma [elim]: "\<lbrakk>tstep (9, b, c) tcopy = (9, ab, ba);
- tcopy_F9 x (b, c)\<rbrakk> \<Longrightarrow> tcopy_F9 x (ab, ba)"
-apply(auto simp: tcopy_F9.simps tcopy_def
- tstep.simps fetch.simps new_tape.simps exp_zero_simp exp_zero_simp2
- tcopy_F9_exit.simps tcopy_F9_loop.simps
- split: if_splits list.splits block.splits)
-apply(case_tac [!] k, simp_all add: exp_ind_def exp_zero)
-apply(erule_tac [!] x = i in allE, simp)
-apply(erule_tac false_case7, simp_all)+
-apply(case_tac t, simp_all add: exp_zero exp_ind_def)
-apply(erule_tac false_case7, simp_all)+
-apply(erule_tac false_case8, simp_all)
-apply(erule_tac false_case7, simp_all)+
-apply(case_tac t, simp_all add: exp_ind_def exp_zero)
-apply(erule_tac false_case7, simp_all)
-apply(erule_tac false_case8, simp_all)
-apply(erule_tac false_case7, simp_all)
-done
-
-lemma [elim]: "\<lbrakk>tstep (8, b, c) tcopy = (9, ab, ba);
- tcopy_F8 x (b, c)\<rbrakk> \<Longrightarrow> tcopy_F9 x (ab, ba)"
-apply(auto simp:tcopy_F8.simps tcopy_F9.simps tcopy_def
- tstep.simps fetch.simps new_tape.simps tcopy_F9_loop.simps
- tcopy_F9_exit.simps
- split: if_splits list.splits block.splits)
-apply(case_tac [!] t, simp_all add: exp_ind_def exp_zero)
-apply(rule_tac x = i in exI)
-apply(rule_tac x = "Suc k" in exI, simp)
-apply(rule_tac x = "k" in exI, simp add: exp_ind_def exp_zero)
-done
-
-
-lemma [elim]: "\<lbrakk>tstep (8, b, c) tcopy = (8, ab, ba);
- tcopy_F8 x (b, c)\<rbrakk> \<Longrightarrow> tcopy_F8 x (ab, ba)"
-apply(auto simp:tcopy_F8.simps tcopy_def tstep.simps
- fetch.simps new_tape.simps exp_zero_simp exp_zero split: if_splits list.splits
-
- block.splits)
-apply(rule_tac x = i in exI, rule_tac x = "k + t" in exI, simp)
-apply(rule_tac x = "Suc k" in exI, simp)
-apply(rule_tac x = "t - 1" in exI, simp)
-apply(case_tac t, simp_all add: exp_zero exp_ind_def)
-done
-
-
-lemma [elim]: "\<lbrakk>tstep (7, b, c) tcopy = (7, ab, ba);
- tcopy_F7 x (b, c)\<rbrakk> \<Longrightarrow> tcopy_F7 x (ab, ba)"
-apply(auto simp:tcopy_F7.simps tcopy_def tstep.simps fetch.simps
- new_tape.simps exp_ind_def exp_zero_simp
- split: if_splits list.splits block.splits)
-apply(rule_tac x = i in exI)
-apply(rule_tac x = j in exI, simp)
-apply(rule_tac x = "Suc k" in exI, simp)
-apply(rule_tac x = "t - 1" in exI)
-apply(case_tac t, simp_all add: exp_zero exp_ind_def)
-apply(case_tac j, simp_all add: exp_zero exp_ind_def)
-done
-
-lemma [elim]: "\<lbrakk>tstep (7, b, c) tcopy = (8, ab, ba);
- tcopy_F7 x (b, c)\<rbrakk> \<Longrightarrow> tcopy_F8 x (ab, ba)"
-apply(auto simp:tcopy_F7.simps tcopy_def tstep.simps tcopy_F8.simps
- fetch.simps new_tape.simps exp_zero_simp
- split: if_splits list.splits block.splits)
-apply(rule_tac x = i in exI, simp)
-apply(rule_tac x = "Suc 0" in exI, simp add: exp_ind_def exp_zero)
-apply(rule_tac x = "j - 1" in exI, simp)
-apply(case_tac t, simp_all add: exp_ind_def )
-apply(case_tac j, simp_all add: exp_ind_def exp_zero)
-done
-
-lemma [elim]: "\<lbrakk>tstep (6, b, c) tcopy = (7, ab, ba);
- tcopy_F6 x (b, c)\<rbrakk> \<Longrightarrow> tcopy_F7 x (ab, ba)"
-apply(case_tac x)
-apply(auto simp:tcopy_F7.simps tcopy_F6.simps
- tcopy_def tstep.simps fetch.simps new_tape.simps exp_zero_simp
- split: if_splits list.splits block.splits)
-apply(case_tac i, simp_all add: exp_ind_def exp_zero)
-apply(rule_tac x = i in exI, simp)
-apply(rule_tac x = j in exI, simp)
-apply(rule_tac x = "Suc 0" in exI, simp add: exp_ind_def exp_zero)
-done
-
-lemma [elim]: "\<lbrakk>tstep (6, b, c) tcopy = (6, ab, ba);
- tcopy_F6 x (b, c)\<rbrakk> \<Longrightarrow> tcopy_F6 x (ab, ba)"
-apply(auto simp:tcopy_F6.simps tcopy_def tstep.simps
- new_tape.simps fetch.simps
- split: if_splits list.splits block.splits)
-done
-
-lemma [elim]: "\<lbrakk>tstep (5, b, c) tcopy = (6, ab, ba);
- tcopy_F5 x (b, c)\<rbrakk> \<Longrightarrow> tcopy_F6 x (ab, ba)"
-apply(auto simp:tcopy_F5.simps tcopy_F6.simps tcopy_def
- tstep.simps fetch.simps new_tape.simps exp_zero_simp2
- split: if_splits list.splits block.splits)
-apply(rule_tac x = "Suc 0" in exI, simp add: exp_ind_def exp_zero)
-apply(rule_tac x = "Suc i" in exI, simp add: exp_ind_def)
-done
-
-lemma [elim]: "\<lbrakk>tstep (10, b, c) tcopy = (5, ab, ba);
- tcopy_F10 x (b, c)\<rbrakk> \<Longrightarrow> tcopy_F5 x (ab, ba)"
-apply(auto simp:tcopy_F5.simps tcopy_F10.simps tcopy_def
- tstep.simps fetch.simps new_tape.simps exp_zero_simp exp_zero_simp2
- exp_ind_def tcopy_F10.simps tcopy_F10_loop.simps tcopy_F10_exit.simps
- split: if_splits list.splits block.splits )
-apply(erule_tac [!] x = "i - 1" in allE)
-apply(erule_tac [!] x = j in allE, simp_all)
-apply(case_tac [!] i, simp_all add: exp_ind_def)
-done
-
-lemma [elim]: "\<lbrakk>tstep (4, b, c) tcopy = (5, ab, ba);
- tcopy_F4 x (b, c)\<rbrakk> \<Longrightarrow> tcopy_F5 x (ab, ba)"
-apply(auto simp:tcopy_F5.simps tcopy_F4.simps tcopy_def
- tstep.simps fetch.simps new_tape.simps exp_zero_simp exp_zero_simp2
- split: if_splits list.splits block.splits)
-apply(case_tac x, simp, simp add: exp_ind_def exp_zero)
-apply(erule_tac [!] x = "x - 2" in allE)
-apply(erule_tac [!] x = "Suc 0" in allE)
-apply(case_tac [!] x, simp_all add: exp_ind_def exp_zero)
-apply(case_tac [!] nat, simp_all add: exp_ind_def exp_zero)
-done
-
-lemma [elim]: "\<lbrakk>tstep (3, b, c) tcopy = (4, ab, ba);
- tcopy_F3 x (b, c)\<rbrakk> \<Longrightarrow> tcopy_F4 x (ab, ba)"
-apply(auto simp:tcopy_F3.simps tcopy_F4.simps
- tcopy_def tstep.simps fetch.simps new_tape.simps
- split: if_splits list.splits block.splits)
-done
-
-lemma [elim]: "\<lbrakk>tstep (4, b, c) tcopy = (4, ab, ba);
- tcopy_F4 x (b, c)\<rbrakk> \<Longrightarrow> tcopy_F4 x (ab, ba)"
-apply(case_tac x)
-apply(auto simp:tcopy_F3.simps tcopy_F4.simps
- tcopy_def tstep.simps fetch.simps new_tape.simps exp_zero_simp exp_zero_simp2 exp_ind_def
- split: if_splits list.splits block.splits)
-done
-
-lemma [elim]: "\<lbrakk>tstep (3, b, c) tcopy = (3, ab, ba);
- tcopy_F3 x (b, c)\<rbrakk> \<Longrightarrow> tcopy_F3 x (ab, ba)"
-apply(auto simp:tcopy_F3.simps tcopy_F4.simps
- tcopy_def tstep.simps fetch.simps new_tape.simps
- split: if_splits list.splits block.splits)
-done
-
-lemma [elim]: "\<lbrakk>tstep (2, b, c) tcopy = (3, ab, ba);
- tcopy_F2 x (b, c)\<rbrakk> \<Longrightarrow> tcopy_F3 x (ab, ba)"
-apply(case_tac x)
-apply(auto simp:tcopy_F3.simps tcopy_F2.simps
- tcopy_def tstep.simps fetch.simps new_tape.simps
- exp_zero_simp exp_zero_simp2 exp_zero
- split: if_splits list.splits block.splits)
-apply(case_tac [!] j, simp_all add: exp_zero exp_ind_def)
-done
-
-lemma [elim]: "\<lbrakk>tstep (2, b, c) tcopy = (2, ab, ba);
- tcopy_F2 x (b, c)\<rbrakk> \<Longrightarrow> tcopy_F2 x (ab, ba)"
-apply(auto simp:tcopy_F3.simps tcopy_F2.simps
- tcopy_def tstep.simps fetch.simps new_tape.simps
- exp_zero_simp exp_zero_simp2 exp_zero
- split: if_splits list.splits block.splits)
-apply(rule_tac x = "Suc i" in exI, simp add: exp_ind_def exp_zero)
-apply(rule_tac x = "j - 1" in exI, simp)
-apply(case_tac j, simp_all add: exp_ind_def exp_zero)
-done
-
-lemma [elim]: "\<lbrakk>tstep (Suc 0, b, c) tcopy = (2, ab, ba);
- tcopy_F1 x (b, c)\<rbrakk> \<Longrightarrow> tcopy_F2 x (ab, ba)"
-apply(auto simp:tcopy_F1.simps tcopy_F2.simps
- tcopy_def tstep.simps fetch.simps new_tape.simps
- exp_zero_simp exp_zero_simp2 exp_zero
- split: if_splits list.splits block.splits)
-apply(rule_tac x = "Suc 0" in exI, simp)
-apply(rule_tac x = "x - 1" in exI, simp)
-apply(case_tac x, simp_all add: exp_ind_def exp_zero)
-done
-
-lemma [elim]: "\<lbrakk>tstep (Suc 0, b, c) tcopy = (0, ab, ba);
- tcopy_F1 x (b, c)\<rbrakk> \<Longrightarrow> tcopy_F0 x (ab, ba)"
-apply(simp_all add:tcopy_F0.simps tcopy_F1.simps
- tcopy_def tstep.simps fetch.simps new_tape.simps
- exp_zero_simp exp_zero_simp2 exp_zero
- split: if_splits list.splits block.splits )
-apply(case_tac x, simp_all add: exp_ind_def exp_zero, auto)
-done
-
-lemma [elim]: "\<lbrakk>tstep (15, b, c) tcopy = (0, ab, ba);
- tcopy_F15 x (b, c)\<rbrakk> \<Longrightarrow> tcopy_F0 x (ab, ba)"
-apply(auto simp: tcopy_F15.simps tcopy_F0.simps
- tcopy_def tstep.simps new_tape.simps fetch.simps
- split: if_splits list.splits block.splits)
-apply(rule_tac x = "Suc 0" in exI, simp add: exp_ind_def exp_zero)
-apply(case_tac [!] j, simp_all add: exp_ind_def exp_zero)
-done
-
-
-lemma [elim]: "\<lbrakk>tstep (0, b, c) tcopy = (0, ab, ba);
- tcopy_F0 x (b, c)\<rbrakk> \<Longrightarrow> tcopy_F0 x (ab, ba)"
-apply(case_tac x)
-apply(simp_all add: tcopy_F0.simps tcopy_def
- tstep.simps new_tape.simps fetch.simps)
-done
-
-declare tstep.simps[simp del]
-
-text {*
- Finally establishes the invariant of Copying TM, which is used to dervie
- the parital correctness of Copying TM.
-*}
-lemma inv_tcopy_step:"inv_tcopy x c \<Longrightarrow> inv_tcopy x (tstep c tcopy)"
-apply(induct c)
-apply(auto split: if_splits block.splits list.splits taction.splits)
-apply(auto simp: tstep.simps tcopy_def fetch.simps new_tape.simps
- split: if_splits list.splits block.splits taction.splits)
-done
-
-declare inv_tcopy.simps[simp del]
-
-text {*
- Invariant under mult-step execution.
- *}
-lemma inv_tcopy_steps:
- "inv_tcopy x (steps (Suc 0, [], Oc\<^bsup>x\<^esup>) tcopy stp) "
-apply(induct stp)
-apply(simp add: tstep.simps tcopy_def steps.simps
- tcopy_F1.simps inv_tcopy.simps)
-apply(drule_tac inv_tcopy_step, simp add: tstep_red)
-done
-
-
-
-
-(*----------halt problem of tcopy----------------------------------------*)
-
-section {*
- The following definitions are used to construct the measure function used to show
- the termnation of Copying TM.
-*}
-
-definition lex_pair :: "((nat \<times> nat) \<times> nat \<times> nat) set"
- where
- "lex_pair \<equiv> less_than <*lex*> less_than"
-
-definition lex_triple ::
- "((nat \<times> (nat \<times> nat)) \<times> (nat \<times> (nat \<times> nat))) set"
- where
-"lex_triple \<equiv> less_than <*lex*> lex_pair"
-
-definition lex_square ::
- "((nat \<times> nat \<times> nat \<times> nat) \<times> (nat \<times> nat \<times> nat \<times> nat)) set"
- where
-"lex_square \<equiv> less_than <*lex*> lex_triple"
-
-lemma wf_lex_triple: "wf lex_triple"
- by (auto intro:wf_lex_prod simp:lex_triple_def lex_pair_def)
-
-lemma wf_lex_square: "wf lex_square"
- by (auto intro:wf_lex_prod
- simp:lex_triple_def lex_square_def lex_pair_def)
-
-text {*
- A measurement functions used to show the termination of copying machine:
-*}
-fun tcopy_phase :: "t_conf \<Rightarrow> nat"
- where
- "tcopy_phase c = (let (state, tp) = c in
- if state > 0 & state <= 4 then 5
- else if state >=5 & state <= 10 then 4
- else if state = 11 then 3
- else if state = 12 | state = 13 then 2
- else if state = 14 | state = 15 then 1
- else 0)"
-
-fun tcopy_phase4_stage :: "tape \<Rightarrow> nat"
- where
- "tcopy_phase4_stage (ln, rn) =
- (let lrn = (rev ln) @ rn
- in length (takeWhile (\<lambda>a. a = Oc) lrn))"
-
-fun tcopy_stage :: "t_conf \<Rightarrow> nat"
- where
- "tcopy_stage c = (let (state, ln, rn) = c in
- if tcopy_phase c = 5 then 0
- else if tcopy_phase c = 4 then
- tcopy_phase4_stage (ln, rn)
- else if tcopy_phase c = 3 then 0
- else if tcopy_phase c = 2 then length rn
- else if tcopy_phase c = 1 then 0
- else 0)"
-
-fun tcopy_phase4_state :: "t_conf \<Rightarrow> nat"
- where
- "tcopy_phase4_state c = (let (state, ln, rn) = c in
- if state = 6 & hd rn = Oc then 0
- else if state = 5 then 1
- else 12 - state)"
-
-fun tcopy_state :: "t_conf \<Rightarrow> nat"
- where
- "tcopy_state c = (let (state, ln, rn) = c in
- if tcopy_phase c = 5 then 4 - state
- else if tcopy_phase c = 4 then
- tcopy_phase4_state c
- else if tcopy_phase c = 3 then 0
- else if tcopy_phase c = 2 then 13 - state
- else if tcopy_phase c = 1 then 15 - state
- else 0)"
-
-fun tcopy_step2 :: "t_conf \<Rightarrow> nat"
- where
- "tcopy_step2 (s, l, r) = length r"
-
-fun tcopy_step3 :: "t_conf \<Rightarrow> nat"
- where
- "tcopy_step3 (s, l, r) = (if r = [] | r = [Bk] then Suc 0 else 0)"
-
-fun tcopy_step4 :: "t_conf \<Rightarrow> nat"
- where
- "tcopy_step4 (s, l, r) = length l"
-
-fun tcopy_step7 :: "t_conf \<Rightarrow> nat"
- where
- "tcopy_step7 (s, l, r) = length r"
-
-fun tcopy_step8 :: "t_conf \<Rightarrow> nat"
- where
- "tcopy_step8 (s, l, r) = length r"
-
-fun tcopy_step9 :: "t_conf \<Rightarrow> nat"
- where
- "tcopy_step9 (s, l, r) = length l"
-
-fun tcopy_step10 :: "t_conf \<Rightarrow> nat"
- where
- "tcopy_step10 (s, l, r) = length l"
-
-fun tcopy_step14 :: "t_conf \<Rightarrow> nat"
- where
- "tcopy_step14 (s, l, r) = (case hd r of
- Oc \<Rightarrow> 1 |
- Bk \<Rightarrow> 0)"
-
-fun tcopy_step15 :: "t_conf \<Rightarrow> nat"
- where
- "tcopy_step15 (s, l, r) = length l"
-
-fun tcopy_step :: "t_conf \<Rightarrow> nat"
- where
- "tcopy_step c = (let (state, ln, rn) = c in
- if state = 0 | state = 1 | state = 11 |
- state = 5 | state = 6 | state = 12 | state = 13 then 0
- else if state = 2 then tcopy_step2 c
- else if state = 3 then tcopy_step3 c
- else if state = 4 then tcopy_step4 c
- else if state = 7 then tcopy_step7 c
- else if state = 8 then tcopy_step8 c
- else if state = 9 then tcopy_step9 c
- else if state = 10 then tcopy_step10 c
- else if state = 14 then tcopy_step14 c
- else if state = 15 then tcopy_step15 c
- else 0)"
-
-text {*
- The measure function used to show the termination of Copying TM.
-*}
-fun tcopy_measure :: "t_conf \<Rightarrow> (nat * nat * nat * nat)"
- where
- "tcopy_measure c =
- (tcopy_phase c, tcopy_stage c, tcopy_state c, tcopy_step c)"
-
-definition tcopy_LE :: "((nat \<times> block list \<times> block list) \<times>
- (nat \<times> block list \<times> block list)) set"
- where
- "tcopy_LE \<equiv> (inv_image lex_square tcopy_measure)"
-
-lemma wf_tcopy_le: "wf tcopy_LE"
-by(auto intro:wf_inv_image wf_lex_square simp:tcopy_LE_def)
-
-
-declare steps.simps[simp del]
-
-declare tcopy_phase.simps[simp del] tcopy_stage.simps[simp del]
- tcopy_state.simps[simp del] tcopy_step.simps[simp del]
- inv_tcopy.simps[simp del]
-declare tcopy_F0.simps [simp]
- tcopy_F1.simps [simp]
- tcopy_F2.simps [simp]
- tcopy_F3.simps [simp]
- tcopy_F4.simps [simp]
- tcopy_F5.simps [simp]
- tcopy_F6.simps [simp]
- tcopy_F7.simps [simp]
- tcopy_F8.simps [simp]
- tcopy_F9.simps [simp]
- tcopy_F10.simps [simp]
- tcopy_F11.simps [simp]
- tcopy_F12.simps [simp]
- tcopy_F13.simps [simp]
- tcopy_F14.simps [simp]
- tcopy_F15.simps [simp]
- fetch.simps[simp]
- new_tape.simps[simp]
-lemma [elim]: "tcopy_F1 x (b, c) \<Longrightarrow>
- (tstep (Suc 0, b, c) tcopy, Suc 0, b, c) \<in> tcopy_LE"
-apply(simp add: tcopy_F1.simps tstep.simps tcopy_def tcopy_LE_def
- lex_square_def lex_triple_def lex_pair_def tcopy_phase.simps
- tcopy_stage.simps tcopy_state.simps tcopy_step.simps)
-apply(simp split: if_splits list.splits block.splits taction.splits)
-done
-
-lemma [elim]: "tcopy_F2 x (b, c) \<Longrightarrow>
- (tstep (2, b, c) tcopy, 2, b, c) \<in> tcopy_LE"
-apply(simp add:tstep.simps tcopy_def tcopy_LE_def lex_square_def
- lex_triple_def lex_pair_def tcopy_phase.simps tcopy_stage.simps
- tcopy_state.simps tcopy_step.simps)
-apply(simp split: if_splits list.splits block.splits taction.splits)
-done
-
-lemma [elim]: "tcopy_F3 x (b, c) \<Longrightarrow>
- (tstep (3, b, c) tcopy, 3, b, c) \<in> tcopy_LE"
-apply(simp add: tstep.simps tcopy_def tcopy_LE_def lex_square_def
- lex_triple_def lex_pair_def tcopy_phase.simps tcopy_stage.simps
- tcopy_state.simps tcopy_step.simps)
-apply(simp split: if_splits list.splits block.splits taction.splits)
-apply(auto)
-done
-
-lemma [elim]: "tcopy_F4 x (b, c) \<Longrightarrow>
- (tstep (4, b, c) tcopy, 4, b, c) \<in> tcopy_LE"
-apply(case_tac x, simp)
-apply(simp add: tcopy_F4.simps tstep.simps tcopy_def tcopy_LE_def
- lex_square_def lex_triple_def lex_pair_def tcopy_phase.simps
- tcopy_stage.simps tcopy_state.simps tcopy_step.simps)
-apply(simp split: if_splits list.splits block.splits taction.splits)
-apply(auto simp: exp_ind_def)
-done
-
-lemma[simp]: "takeWhile (\<lambda>a. a = b) (replicate x b @ ys) =
- replicate x b @ (takeWhile (\<lambda>a. a = b) ys)"
-apply(induct x)
-apply(simp+)
-done
-
-lemma [elim]: "tcopy_F5 x (b, c) \<Longrightarrow>
- (tstep (5, b, c) tcopy, 5, b, c) \<in> tcopy_LE"
-apply(case_tac x, simp)
-apply(simp add: tstep.simps tcopy_def tcopy_LE_def
- lex_square_def lex_triple_def lex_pair_def tcopy_phase.simps)
-apply(simp split: if_splits list.splits block.splits taction.splits)
-apply(auto)
-apply(simp_all add: tcopy_phase.simps
- tcopy_stage.simps tcopy_state.simps)
-done
-
-lemma [elim]: "\<lbrakk>replicate n x = []; n > 0\<rbrakk> \<Longrightarrow> RR"
-apply(case_tac n, simp+)
-done
-
-lemma [elim]: "tcopy_F6 x (b, c) \<Longrightarrow>
- (tstep (6, b, c) tcopy, 6, b, c) \<in> tcopy_LE"
-apply(case_tac x, simp)
-apply(simp add: tstep.simps tcopy_def tcopy_LE_def
- lex_square_def lex_triple_def lex_pair_def
- tcopy_phase.simps)
-apply(simp split: if_splits list.splits block.splits taction.splits)
-apply(auto)
-apply(simp_all add: tcopy_phase.simps tcopy_stage.simps
- tcopy_state.simps tcopy_step.simps exponent_def)
-done
-
-lemma [elim]: "tcopy_F7 x (b, c) \<Longrightarrow>
- (tstep (7, b, c) tcopy, 7, b, c) \<in> tcopy_LE"
-apply(case_tac x, simp)
-apply(simp add: tstep.simps tcopy_def tcopy_LE_def lex_square_def
- lex_triple_def lex_pair_def tcopy_phase.simps)
-apply(simp split: if_splits list.splits block.splits taction.splits)
-apply(auto simp: exp_zero_simp)
-apply(simp_all add: tcopy_phase.simps tcopy_stage.simps
- tcopy_state.simps tcopy_step.simps)
-done
-
-lemma [elim]: "tcopy_F8 x (b, c) \<Longrightarrow>
- (tstep (8, b, c) tcopy, 8, b, c) \<in> tcopy_LE"
-apply(case_tac x, simp)
-apply(simp add: tstep.simps tcopy_def tcopy_LE_def lex_square_def
- lex_triple_def lex_pair_def tcopy_phase.simps)
-apply(simp split: if_splits list.splits block.splits taction.splits)
-apply(auto simp: exp_zero_simp)
-apply(simp_all add: tcopy_phase.simps tcopy_stage.simps
- tcopy_state.simps tcopy_step.simps exponent_def)
-done
-
-lemma rev_equal_rev: "rev a = rev b \<Longrightarrow> a = b"
-by simp
-
-lemma app_app_app_equal: "xs @ ys @ zs = (xs @ ys) @ zs"
-by simp
-
-lemma append_cons_assoc: "as @ b # bs = (as @ [b]) @ bs"
-apply(rule rev_equal_rev)
-apply(simp)
-done
-
-lemma rev_tl_hd_merge: "bs \<noteq> [] \<Longrightarrow>
- rev (tl bs) @ hd bs # as = rev bs @ as"
-apply(rule rev_equal_rev)
-apply(simp)
-done
-
-lemma[simp]: "takeWhile (\<lambda>a. a = b) (replicate x b @ ys) =
- replicate x b @ (takeWhile (\<lambda>a. a = b) ys)"
-apply(induct x)
-apply(simp+)
-done
-
-lemma [elim]: "tcopy_F9 x (b, c) \<Longrightarrow>
- (tstep (9, b, c) tcopy, 9, b, c) \<in> tcopy_LE"
-apply(simp add: tstep.simps tcopy_def tcopy_LE_def lex_square_def
- lex_triple_def lex_pair_def tcopy_phase.simps tcopy_F9.simps
- tcopy_F9_loop.simps tcopy_F9_exit.simps)
-apply(simp split: if_splits list.splits block.splits taction.splits)
-apply(auto)
-apply(simp_all add: tcopy_phase.simps tcopy_stage.simps tcopy_F9_loop.simps
- tcopy_state.simps tcopy_step.simps tstep.simps exp_zero_simp
- exponent_def)
-apply(case_tac [1-2] t, simp_all add: rev_tl_hd_merge)
-apply(case_tac j, simp, simp)
-apply(case_tac nat, simp_all)
-apply(case_tac nata, simp_all)
-done
-
-lemma [elim]: "tcopy_F10 x (b, c) \<Longrightarrow>
- (tstep (10, b, c) tcopy, 10, b, c) \<in> tcopy_LE"
-apply(simp add: tstep.simps tcopy_def tcopy_LE_def lex_square_def
- lex_triple_def lex_pair_def tcopy_phase.simps tcopy_F10_loop.simps
- tcopy_F10_exit.simps exp_zero_simp)
-apply(simp split: if_splits list.splits block.splits taction.splits)
-apply(auto simp: exp_zero_simp)
-apply(simp_all add: tcopy_phase.simps tcopy_stage.simps
- tcopy_state.simps tcopy_step.simps exponent_def
- rev_tl_hd_merge)
-apply(case_tac k, simp_all)
-apply(case_tac nat, simp_all)
-done
-
-lemma [elim]: "tcopy_F11 x (b, c) \<Longrightarrow>
- (tstep (11, b, c) tcopy, 11, b, c) \<in> tcopy_LE"
-apply(case_tac x, simp)
-apply(simp add: tstep.simps tcopy_def tcopy_LE_def
- lex_square_def lex_triple_def lex_pair_def
- tcopy_phase.simps)
-done
-
-lemma [elim]: "tcopy_F12 x (b, c) \<Longrightarrow>
- (tstep (12, b, c) tcopy, 12, b, c) \<in> tcopy_LE"
-apply(case_tac x, simp)
-apply(simp add: tstep.simps tcopy_def tcopy_LE_def lex_square_def
- lex_triple_def lex_pair_def tcopy_phase.simps)
-apply(simp split: if_splits list.splits block.splits taction.splits)
-apply(auto)
-apply(simp_all add: tcopy_phase.simps tcopy_stage.simps
- tcopy_state.simps tcopy_step.simps)
-apply(simp_all add: exp_ind_def)
-done
-
-lemma [elim]: "tcopy_F13 x (b, c) \<Longrightarrow>
- (tstep (13, b, c) tcopy, 13, b, c) \<in> tcopy_LE"
-apply(case_tac x, simp)
-apply(simp add: tstep.simps tcopy_def tcopy_LE_def lex_square_def
- lex_triple_def lex_pair_def tcopy_phase.simps)
-apply(simp split: if_splits list.splits block.splits taction.splits)
-apply(auto)
-apply(simp_all add: tcopy_phase.simps tcopy_stage.simps
- tcopy_state.simps tcopy_step.simps)
-done
-
-lemma [elim]: "tcopy_F14 x (b, c) \<Longrightarrow>
- (tstep (14, b, c) tcopy, 14, b, c) \<in> tcopy_LE"
-apply(case_tac x, simp)
-apply(simp add: tstep.simps tcopy_def tcopy_LE_def lex_square_def
- lex_triple_def lex_pair_def tcopy_phase.simps)
-apply(simp split: if_splits list.splits block.splits taction.splits)
-apply(auto)
-apply(simp_all add: tcopy_phase.simps tcopy_stage.simps
- tcopy_state.simps tcopy_step.simps)
-done
-
-lemma [elim]: "tcopy_F15 x (b, c) \<Longrightarrow>
- (tstep (15, b, c) tcopy, 15, b, c) \<in> tcopy_LE"
-apply(case_tac x, simp)
-apply(simp add: tstep.simps tcopy_def tcopy_LE_def lex_square_def
- lex_triple_def lex_pair_def tcopy_phase.simps )
-apply(simp split: if_splits list.splits block.splits taction.splits)
-apply(auto)
-apply(simp_all add: tcopy_phase.simps tcopy_stage.simps
- tcopy_state.simps tcopy_step.simps)
-done
-
-lemma exp_length: "length (a\<^bsup>b\<^esup>) = b"
-apply(induct b, simp_all add: exp_zero exp_ind_def)
-done
-
-declare tcopy_F9.simps[simp del] tcopy_F10.simps[simp del]
-
-lemma length_eq: "xs = ys \<Longrightarrow> length xs = length ys"
-by simp
-
-lemma tcopy_wf_step:"\<lbrakk>a > 0; inv_tcopy x (a, b, c)\<rbrakk> \<Longrightarrow>
- (tstep (a, b, c) tcopy, (a, b, c)) \<in> tcopy_LE"
-apply(simp add:inv_tcopy.simps split: if_splits, auto)
-apply(auto simp: tstep.simps tcopy_def tcopy_LE_def lex_square_def
- lex_triple_def lex_pair_def tcopy_phase.simps
- tcopy_stage.simps tcopy_state.simps tcopy_step.simps
- exp_length exp_zero_simp exponent_def
- split: if_splits list.splits block.splits taction.splits)
-apply(case_tac [!] t, simp_all)
-apply(case_tac j, simp_all)
-apply(drule_tac length_eq, simp)
-done
-
-lemma tcopy_wf:
-"\<forall>n. let nc = steps (Suc 0, [], Oc\<^bsup>x\<^esup>) tcopy n in
- let Sucnc = steps (Suc 0, [], Oc\<^bsup>x\<^esup>) tcopy (Suc n) in
- \<not> isS0 nc \<longrightarrow> ((Sucnc, nc) \<in> tcopy_LE)"
-proof(rule allI, case_tac
- "steps (Suc 0, [], Oc\<^bsup>x\<^esup>) tcopy n", auto simp: tstep_red)
- fix n a b c
- assume h: "\<not> isS0 (a, b, c)"
- "steps (Suc 0, [], Oc\<^bsup>x\<^esup>) tcopy n = (a, b, c)"
- hence "inv_tcopy x (a, b, c)"
- using inv_tcopy_steps[of x n] by(simp)
- thus "(tstep (a, b, c) tcopy, a, b, c) \<in> tcopy_LE"
- using h
- by(rule_tac tcopy_wf_step, auto simp: isS0_def)
-qed
-
-text {*
- The termination of Copying TM:
-*}
-lemma tcopy_halt:
- "\<exists>n. isS0 (steps (Suc 0, [], Oc\<^bsup>x\<^esup>) tcopy n)"
-apply(insert halt_lemma
- [of tcopy_LE isS0 "steps (Suc 0, [], Oc\<^bsup>x\<^esup>) tcopy"])
-apply(insert tcopy_wf [of x])
-apply(simp only: Let_def)
-apply(insert wf_tcopy_le)
-apply(simp)
-done
-
-text {*
- The total correntess of Copying TM:
-*}
-theorem tcopy_halt_rs:
- "\<exists>stp m.
- steps (Suc 0, [], Oc\<^bsup>x\<^esup>) tcopy stp =
- (0, Bk\<^bsup>m\<^esup>, Oc\<^bsup>x\<^esup> @ Bk # Oc\<^bsup>x\<^esup>)"
-using tcopy_halt[of x]
-proof(erule_tac exE)
- fix n
- assume h: "isS0 (steps (Suc 0, [], Oc\<^bsup>x\<^esup>) tcopy n)"
- have "inv_tcopy x (steps (Suc 0, [], Oc\<^bsup>x\<^esup>) tcopy n)"
- using inv_tcopy_steps[of x n] by simp
- thus "?thesis"
- using h
- apply(cases "(steps (Suc 0, [], Oc\<^bsup>x\<^esup>) tcopy n)",
- auto simp: isS0_def inv_tcopy.simps)
- done
-qed
-
-section {*
- The {\em Dithering} Turing Machine
-*}
-
-text {*
- The {\em Dithering} TM, when the input is @{text "1"}, it will loop forever, otherwise, it will
- terminate.
-*}
-definition dither :: "tprog"
- where
- "dither \<equiv> [(W0, 1), (R, 2), (L, 1), (L, 0)] "
-
-lemma dither_halt_rs:
- "\<exists> stp. steps (Suc 0, Bk\<^bsup>m\<^esup>, [Oc, Oc]) dither stp =
- (0, Bk\<^bsup>m\<^esup>, [Oc, Oc])"
-apply(rule_tac x = "Suc (Suc (Suc 0))" in exI)
-apply(simp add: dither_def steps.simps
- tstep.simps fetch.simps new_tape.simps)
-done
-
-lemma dither_unhalt_state:
- "(steps (Suc 0, Bk\<^bsup>m\<^esup>, [Oc]) dither stp =
- (Suc 0, Bk\<^bsup>m\<^esup>, [Oc])) \<or>
- (steps (Suc 0, Bk\<^bsup>m\<^esup>, [Oc]) dither stp = (2, Oc # Bk\<^bsup>m\<^esup>, []))"
- apply(induct stp, simp add: steps.simps)
- apply(simp add: tstep_red, auto)
- apply(auto simp: tstep.simps fetch.simps dither_def new_tape.simps)
- done
-
-lemma dither_unhalt_rs:
- "\<not> (\<exists> stp. isS0 (steps (Suc 0, Bk\<^bsup>m\<^esup>, [Oc]) dither stp))"
-proof(auto)
- fix stp
- assume h1: "isS0 (steps (Suc 0, Bk\<^bsup>m\<^esup>, [Oc]) dither stp)"
- have "\<not> isS0 ((steps (Suc 0, Bk\<^bsup>m\<^esup>, [Oc]) dither stp))"
- using dither_unhalt_state[of m stp]
- by(auto simp: isS0_def)
- from h1 and this show False by (auto)
-qed
-
-section {*
- The final diagnal arguments to show the undecidability of Halting problem.
-*}
-
-text {*
- @{text "haltP tp x"} means TM @{text "tp"} terminates on input @{text "x"}
- and the final configuration is standard.
-*}
-definition haltP :: "tprog \<Rightarrow> nat \<Rightarrow> bool"
- where
- "haltP t x = (\<exists>n a b c. steps (Suc 0, [], Oc\<^bsup>x\<^esup>) t n = (0, Bk\<^bsup>a\<^esup>, Oc\<^bsup>b\<^esup> @ Bk\<^bsup>c\<^esup>))"
-
-lemma [simp]: "length (A |+| B) = length A + length B"
-by(auto simp: t_add.simps tshift.simps)
-
-lemma [intro]: "\<lbrakk>iseven (x::nat); iseven y\<rbrakk> \<Longrightarrow> iseven (x + y)"
-apply(auto simp: iseven_def)
-apply(rule_tac x = "x + xa" in exI, simp)
-done
-
-lemma t_correct_add[intro]:
- "\<lbrakk>t_correct A; t_correct B\<rbrakk> \<Longrightarrow> t_correct (A |+| B)"
-apply(auto simp: t_correct.simps tshift.simps t_add.simps
- change_termi_state.simps list_all_iff)
-apply(erule_tac x = "(a, b)" in ballE, auto)
-apply(case_tac "ba = 0", auto)
-done
-
-lemma [intro]: "t_correct tcopy"
-apply(simp add: t_correct.simps tcopy_def iseven_def)
-apply(rule_tac x = 15 in exI, simp)
-done
-
-lemma [intro]: "t_correct dither"
-apply(simp add: t_correct.simps dither_def iseven_def)
-apply(rule_tac x = 2 in exI, simp)
-done
-
-text {*
- The following locale specifies that TM @{text "H"} can be used to solve
- the {\em Halting Problem} and @{text "False"} is going to be derived
- under this locale. Therefore, the undecidability of {\em Halting Problem}
- is established.
-*}
-locale uncomputable =
- -- {* The coding function of TM, interestingly, the detailed definition of this
- funciton @{text "code"} does not affect the final result. *}
- fixes code :: "tprog \<Rightarrow> nat"
- -- {*
- The TM @{text "H"} is the one which is assummed being able to solve the Halting problem.
- *}
- and H :: "tprog"
- assumes h_wf[intro]: "t_correct H"
- -- {*
- The following two assumptions specifies that @{text "H"} does solve the Halting problem.
- *}
- and h_case:
- "\<And> M n. \<lbrakk>(haltP M n)\<rbrakk> \<Longrightarrow>
- \<exists> na nb. (steps (Suc 0, [], Oc\<^bsup>code M\<^esup> @ Bk # Oc\<^bsup>n\<^esup>) H na = (0, Bk\<^bsup>nb\<^esup>, [Oc]))"
- and nh_case:
- "\<And> M n. \<lbrakk>(\<not> haltP M n)\<rbrakk> \<Longrightarrow>
- \<exists> na nb. (steps (Suc 0, [], Oc\<^bsup>code M\<^esup> @ Bk # Oc\<^bsup>n\<^esup>) H na = (0, Bk\<^bsup>nb\<^esup>, [Oc, Oc]))"
-begin
-
-term t_correct
-declare haltP_def[simp del]
-definition tcontra :: "tprog \<Rightarrow> tprog"
- where
- "tcontra h \<equiv> ((tcopy |+| h) |+| dither)"
-
-lemma [simp]: "a\<^bsup>0\<^esup> = []"
- by(simp add: exponent_def)
-
-lemma tinres_ex1:
- "tinres (Bk\<^bsup>nb\<^esup>) b \<Longrightarrow> \<exists>nb. b = Bk\<^bsup>nb\<^esup>"
-apply(auto simp: tinres_def)
-proof -
- fix n
- assume "Bk\<^bsup>nb\<^esup> = b @ Bk\<^bsup>n\<^esup>"
- thus "\<exists>nb. b = Bk\<^bsup>nb\<^esup>"
- proof(induct b arbitrary: nb)
- show "\<exists>nb. [] = Bk\<^bsup>nb\<^esup>"
- by(rule_tac x = 0 in exI, simp add: exp_zero)
- next
- fix a b nb
- assume ind: "\<And>nb. Bk\<^bsup>nb\<^esup> = b @ Bk\<^bsup>n\<^esup> \<Longrightarrow> \<exists>nb. b = Bk\<^bsup>nb\<^esup>"
- and h: "Bk\<^bsup>nb\<^esup> = (a # b) @ Bk\<^bsup>n\<^esup>"
- from h show "\<exists>nb. a # b = Bk\<^bsup>nb\<^esup>"
- proof(case_tac a, case_tac nb, simp_all add: exp_ind_def)
- fix nat
- assume "Bk\<^bsup>nat\<^esup> = b @ Bk\<^bsup>n\<^esup>"
- thus "\<exists>nb. Bk # b = Bk\<^bsup>nb\<^esup>"
- using ind[of nat]
- apply(auto)
- apply(rule_tac x = "Suc nb" in exI, simp add: exp_ind_def)
- done
- next
- assume "Bk\<^bsup>nb\<^esup> = Oc # b @ Bk\<^bsup>n\<^esup>"
- thus "\<exists>nb. Oc # b = Bk\<^bsup>nb\<^esup>"
- apply(case_tac nb, simp_all add: exp_ind_def)
- done
- qed
- qed
-next
- fix n
- show "\<exists>nba. Bk\<^bsup>nb\<^esup> @ Bk\<^bsup>n\<^esup> = Bk\<^bsup>nba\<^esup>"
- apply(rule_tac x = "nb + n" in exI)
- apply(simp add: exponent_def replicate_add)
- done
-qed
-
-lemma h_newcase: "\<And> M n. \<lbrakk>(haltP M n)\<rbrakk> \<Longrightarrow>
- \<exists> na nb. (steps (Suc 0, Bk\<^bsup>x\<^esup>, Oc\<^bsup>code M\<^esup> @ Bk # Oc\<^bsup>n\<^esup>) H na = (0, Bk\<^bsup>nb\<^esup>, [Oc]))"
-proof -
- fix M n x
- assume "haltP M n"
- hence " \<exists> na nb. (steps (Suc 0, [], Oc\<^bsup>code M\<^esup> @ Bk # Oc\<^bsup>n\<^esup>) H na
- = (0, Bk\<^bsup>nb\<^esup>, [Oc]))"
- apply(erule_tac h_case)
- done
- from this obtain na nb where
- cond1:"(steps (Suc 0, [], Oc\<^bsup>code M\<^esup> @ Bk # Oc\<^bsup>n\<^esup>) H na
- = (0, Bk\<^bsup>nb\<^esup>, [Oc]))" by blast
- thus "\<exists> na nb. (steps (Suc 0, Bk\<^bsup>x\<^esup>, Oc\<^bsup>code M\<^esup> @ Bk # Oc\<^bsup>n\<^esup>) H na = (0, Bk\<^bsup>nb\<^esup>, [Oc]))"
- proof(rule_tac x = na in exI, case_tac "steps (Suc 0, Bk\<^bsup>x\<^esup>, Oc\<^bsup>code M\<^esup> @ Bk # Oc\<^bsup>n\<^esup>) H na", simp)
- fix a b c
- assume cond2: "steps (Suc 0, Bk\<^bsup>x\<^esup>, Oc\<^bsup>code M\<^esup> @ Bk # Oc\<^bsup>n\<^esup>) H na = (a, b, c)"
- have "tinres (Bk\<^bsup>nb\<^esup>) b \<and> [Oc] = c \<and> 0 = a"
- proof(rule_tac tinres_steps)
- show "tinres [] (Bk\<^bsup>x\<^esup>)"
- apply(simp add: tinres_def)
- apply(auto)
- done
- next
- show "(steps (Suc 0, [], Oc\<^bsup>code M\<^esup> @ Bk # Oc\<^bsup>n\<^esup>) H na
- = (0, Bk\<^bsup>nb\<^esup>, [Oc]))"
- by(simp add: cond1)
- next
- show "steps (Suc 0, Bk\<^bsup>x\<^esup>, Oc\<^bsup>code M\<^esup> @ Bk # Oc\<^bsup>n\<^esup>) H na = (a, b, c)"
- by(simp add: cond2)
- qed
- thus "a = 0 \<and> (\<exists>nb. b = Bk\<^bsup>nb\<^esup>) \<and> c = [Oc]"
- apply(auto simp: tinres_ex1)
- done
- qed
-qed
-
-lemma nh_newcase: "\<And> M n. \<lbrakk>\<not> (haltP M n)\<rbrakk> \<Longrightarrow>
- \<exists> na nb. (steps (Suc 0, Bk\<^bsup>x\<^esup>, Oc\<^bsup>code M\<^esup> @ Bk # Oc\<^bsup>n\<^esup>) H na = (0, Bk\<^bsup>nb\<^esup>, [Oc, Oc]))"
-proof -
- fix M n
- assume "\<not> haltP M n"
- hence "\<exists> na nb. (steps (Suc 0, [], Oc\<^bsup>code M\<^esup> @ Bk # Oc\<^bsup>n\<^esup>) H na
- = (0, Bk\<^bsup>nb\<^esup>, [Oc, Oc]))"
- apply(erule_tac nh_case)
- done
- from this obtain na nb where
- cond1: "(steps (Suc 0, [], Oc\<^bsup>code M\<^esup> @ Bk # Oc\<^bsup>n\<^esup>) H na
- = (0, Bk\<^bsup>nb\<^esup>, [Oc, Oc]))" by blast
- thus "\<exists> na nb. (steps (Suc 0, Bk\<^bsup>x\<^esup>, Oc\<^bsup>code M\<^esup> @ Bk # Oc\<^bsup>n\<^esup>) H na = (0, Bk\<^bsup>nb\<^esup>, [Oc, Oc]))"
- proof(rule_tac x = na in exI, case_tac "steps (Suc 0, Bk\<^bsup>x\<^esup>, Oc\<^bsup>code M\<^esup> @ Bk # Oc\<^bsup>n\<^esup>) H na", simp)
- fix a b c
- assume cond2: "steps (Suc 0, Bk\<^bsup>x\<^esup>, Oc\<^bsup>code M\<^esup> @ Bk # Oc\<^bsup>n\<^esup>) H na = (a, b, c)"
- have "tinres (Bk\<^bsup>nb\<^esup>) b \<and> [Oc, Oc] = c \<and> 0 = a"
- proof(rule_tac tinres_steps)
- show "tinres [] (Bk\<^bsup>x\<^esup>)"
- apply(simp add: tinres_def)
- apply(auto)
- done
- next
- show "(steps (Suc 0, [], Oc\<^bsup>code M\<^esup> @ Bk # Oc\<^bsup>n\<^esup>) H na
- = (0, Bk\<^bsup>nb\<^esup>, [Oc, Oc]))"
- by(simp add: cond1)
- next
- show "steps (Suc 0, Bk\<^bsup>x\<^esup>, Oc\<^bsup>code M\<^esup> @ Bk # Oc\<^bsup>n\<^esup>) H na = (a, b, c)"
- by(simp add: cond2)
- qed
- thus "a = 0 \<and> (\<exists>nb. b = Bk\<^bsup>nb\<^esup>) \<and> c = [Oc, Oc]"
- apply(auto simp: tinres_ex1)
- done
- qed
-qed
-
-lemma haltP_weaking:
- "haltP (tcontra H) (code (tcontra H)) \<Longrightarrow>
- \<exists>stp. isS0 (steps (Suc 0, [], Oc\<^bsup>code (tcontra H)\<^esup>)
- ((tcopy |+| H) |+| dither) stp)"
- apply(simp add: haltP_def, auto)
- apply(rule_tac x = n in exI, simp add: isS0_def tcontra_def)
- done
-
-lemma h_uh: "haltP (tcontra H) (code (tcontra H))
- \<Longrightarrow> \<not> haltP (tcontra H) (code (tcontra H))"
-proof -
- let ?cn = "code (tcontra H)"
- let ?P1 = "\<lambda> tp. let (l, r) = tp in (l = [] \<and>
- (r::block list) = Oc\<^bsup>(?cn)\<^esup>)"
- let ?Q1 = "\<lambda> (l, r).(\<exists> nb. l = Bk\<^bsup>nb\<^esup> \<and>
- r = Oc\<^bsup>(?cn)\<^esup> @ Bk # Oc\<^bsup>(?cn)\<^esup>)"
- let ?P2 = ?Q1
- let ?Q2 = "\<lambda> (l, r). (\<exists> nd. l = Bk\<^bsup>nd \<^esup>\<and> r = [Oc])"
- let ?P3 = "\<lambda> tp. False"
- assume h: "haltP (tcontra H) (code (tcontra H))"
- hence h1: "\<And> x. \<exists> na nb. steps (Suc 0, Bk\<^bsup>x\<^esup>, Oc\<^bsup>code (tcontra H)\<^esup> @ Bk #
- Oc\<^bsup>code (tcontra H)\<^esup>) H na = (0, Bk\<^bsup>nb\<^esup>, [Oc])"
- by(drule_tac x = x in h_newcase, simp)
- have "?P1 \<turnstile>-> \<lambda> tp. (\<exists> stp tp'. steps (Suc 0, tp) (tcopy |+| H) stp = (0, tp') \<and> ?Q2 tp')"
- proof(rule_tac turing_merge.t_merge_halt[of tcopy H "?P1" "?P2" "?P3"
- "?P3" "?Q1" "?Q2"], auto simp: turing_merge_def)
- show "\<exists>stp. case steps (Suc 0, [], Oc\<^bsup>?cn\<^esup>) tcopy stp of (s, tp') \<Rightarrow>
- s = 0 \<and> (case tp' of (l, r) \<Rightarrow> (\<exists>nb. l = Bk\<^bsup>nb\<^esup>) \<and> r = Oc\<^bsup>?cn\<^esup> @ Bk # Oc\<^bsup>?cn\<^esup>)"
- using tcopy_halt_rs[of "?cn"]
- apply(auto)
- apply(rule_tac x = stp in exI, auto simp: exponent_def)
- done
- next
- fix nb
- show "\<exists>stp. case steps (Suc 0, Bk\<^bsup>nb\<^esup>, Oc\<^bsup>code (tcontra H)\<^esup> @ Bk # Oc\<^bsup>code (tcontra H)\<^esup>) H stp of
- (s, tp') \<Rightarrow> s = 0 \<and> (case tp' of (l, r) \<Rightarrow> (\<exists>nd. l = Bk\<^bsup>nd\<^esup>) \<and> r = [Oc])"
- using h1[of nb]
- apply(auto)
- apply(rule_tac x = na in exI, auto)
- done
- next
- show "\<lambda>(l, r). ((\<exists>nb. l = Bk\<^bsup>nb\<^esup>) \<and> r = Oc\<^bsup>code (tcontra H)\<^esup> @ Bk # Oc\<^bsup>code (tcontra H)\<^esup>) \<turnstile>->
- \<lambda>(l, r). ((\<exists>nb. l = Bk\<^bsup>nb\<^esup>) \<and> r = Oc\<^bsup>code (tcontra H)\<^esup> @ Bk # Oc\<^bsup>code (tcontra H)\<^esup>)"
- apply(simp add: t_imply_def)
- done
- qed
- hence "\<exists>stp tp'. steps (Suc 0, [], Oc\<^bsup>?cn\<^esup>) (tcopy |+| H) stp = (0, tp') \<and>
- (case tp' of (l, r) \<Rightarrow> \<exists>nd. l = Bk\<^bsup>nd\<^esup> \<and> r = [Oc])"
- apply(simp add: t_imply_def)
- done
- hence "?P1 \<turnstile>-> \<lambda> tp. \<not> (\<exists> stp. isS0 (steps (Suc 0, tp) ((tcopy |+| H) |+| dither) stp))"
- proof(rule_tac turing_merge.t_merge_uhalt[of "tcopy |+| H" dither "?P1" "?P3" "?P3"
- "?Q2" "?Q2" "?Q2"], simp add: turing_merge_def, auto)
- fix stp nd
- assume "steps (Suc 0, [], Oc\<^bsup>code (tcontra H)\<^esup>) (tcopy |+| H) stp = (0, Bk\<^bsup>nd\<^esup>, [Oc])"
- thus "\<exists>stp. case steps (Suc 0, [], Oc\<^bsup>code (tcontra H)\<^esup>) (tcopy |+| H) stp of (s, tp')
- \<Rightarrow> s = 0 \<and> (case tp' of (l, r) \<Rightarrow> (\<exists>nd. l = Bk\<^bsup>nd\<^esup>) \<and> r = [Oc])"
- apply(rule_tac x = stp in exI, auto)
- done
- next
- fix stp nd nda stpa
- assume "isS0 (steps (Suc 0, Bk\<^bsup>nda\<^esup>, [Oc]) dither stpa)"
- thus "False"
- using dither_unhalt_rs[of nda]
- apply auto
- done
- next
- fix stp nd
- show "\<lambda>(l, r). ((\<exists>nd. l = Bk\<^bsup>nd\<^esup>) \<and> r = [Oc]) \<turnstile>->
- \<lambda>(l, r). ((\<exists>nd. l = Bk\<^bsup>nd\<^esup>) \<and> r = [Oc])"
- by (simp add: t_imply_def)
- qed
- thus "\<not> haltP (tcontra H) (code (tcontra H))"
- apply(simp add: t_imply_def haltP_def tcontra_def, auto)
- apply(erule_tac x = n in allE, simp add: isS0_def)
- done
-qed
-
-lemma uh_h:
- assumes uh: "\<not> haltP (tcontra H) (code (tcontra H))"
- shows "haltP (tcontra H) (code (tcontra H))"
-proof -
- let ?cn = "code (tcontra H)"
- have h1: "\<And> x. \<exists> na nb. steps (Suc 0, Bk\<^bsup>x\<^esup>, Oc\<^bsup>?cn\<^esup> @ Bk # Oc\<^bsup>?cn\<^esup>)
- H na = (0, Bk\<^bsup>nb\<^esup>, [Oc, Oc])"
- using uh
- by(drule_tac x = x in nh_newcase, simp)
- let ?P1 = "\<lambda> tp. let (l, r) = tp in (l = [] \<and>
- (r::block list) = Oc\<^bsup>(?cn)\<^esup>)"
- let ?Q1 = "\<lambda> (l, r).(\<exists> na. l = Bk\<^bsup>na\<^esup> \<and> r = [Oc, Oc])"
- let ?P2 = ?Q1
- let ?Q2 = ?Q1
- let ?P3 = "\<lambda> tp. False"
- have "?P1 \<turnstile>-> \<lambda> tp. (\<exists> stp tp'. steps (Suc 0, tp) ((tcopy |+| H ) |+| dither)
- stp = (0, tp') \<and> ?Q2 tp')"
- proof(rule_tac turing_merge.t_merge_halt[of "tcopy |+| H" dither ?P1 ?P2 ?P3 ?P3
- ?Q1 ?Q2], auto simp: turing_merge_def)
- show "\<exists>stp. case steps (Suc 0, [], Oc\<^bsup>code (tcontra H)\<^esup>) (tcopy |+| H) stp of (s, tp') \<Rightarrow>
-
- s = 0 \<and> (case tp' of (l, r) \<Rightarrow> (\<exists>na. l = Bk\<^bsup>na\<^esup>) \<and> r = [Oc, Oc])"
- proof -
- let ?Q1 = "\<lambda> (l, r).(\<exists> nb. l = Bk\<^bsup>nb\<^esup> \<and> r = Oc\<^bsup>(?cn)\<^esup> @ Bk # Oc\<^bsup>(?cn)\<^esup>)"
- let ?P2 = "?Q1"
- let ?Q2 = "\<lambda> (l, r).(\<exists> na. l = Bk\<^bsup>na\<^esup> \<and> r = [Oc, Oc])"
- have "?P1 \<turnstile>-> \<lambda> tp. (\<exists> stp tp'. steps (Suc 0, tp) (tcopy |+| H )
- stp = (0, tp') \<and> ?Q2 tp')"
- proof(rule_tac turing_merge.t_merge_halt[of tcopy H ?P1 ?P2 ?P3 ?P3
- ?Q1 ?Q2], auto simp: turing_merge_def)
- show "\<exists>stp. case steps (Suc 0, [], Oc\<^bsup>code (tcontra H)\<^esup>) tcopy stp of (s, tp') \<Rightarrow> s = 0
- \<and> (case tp' of (l, r) \<Rightarrow> (\<exists>nb. l = Bk\<^bsup>nb\<^esup>) \<and> r = Oc\<^bsup>code (tcontra H)\<^esup> @ Bk # Oc\<^bsup>code (tcontra H)\<^esup>)"
- using tcopy_halt_rs[of "?cn"]
- apply(auto)
- apply(rule_tac x = stp in exI, simp add: exponent_def)
- done
- next
- fix nb
- show "\<exists>stp. case steps (Suc 0, Bk\<^bsup>nb\<^esup>, Oc\<^bsup>code (tcontra H)\<^esup> @ Bk # Oc\<^bsup>code (tcontra H)\<^esup>) H stp of
- (s, tp') \<Rightarrow> s = 0 \<and> (case tp' of (l, r) \<Rightarrow> (\<exists>na. l = Bk\<^bsup>na\<^esup>) \<and> r = [Oc, Oc])"
- using h1[of nb]
- apply(auto)
- apply(rule_tac x = na in exI, auto)
- done
- next
- show "\<lambda>(l, r). ((\<exists>nb. l = Bk\<^bsup>nb\<^esup>) \<and> r = Oc\<^bsup>code (tcontra H)\<^esup> @ Bk # Oc\<^bsup>code (tcontra H)\<^esup>) \<turnstile>->
- \<lambda>(l, r). ((\<exists>nb. l = Bk\<^bsup>nb\<^esup>) \<and> r = Oc\<^bsup>code (tcontra H)\<^esup> @ Bk # Oc\<^bsup>code (tcontra H)\<^esup>)"
- by(simp add: t_imply_def)
- qed
- hence "(\<exists> stp tp'. steps (Suc 0, [], Oc\<^bsup>?cn\<^esup>) (tcopy |+| H ) stp = (0, tp') \<and> ?Q2 tp')"
- apply(simp add: t_imply_def)
- done
- thus "?thesis"
- apply(auto)
- apply(rule_tac x = stp in exI, auto)
- done
- qed
- next
- fix na
- show "\<exists>stp. case steps (Suc 0, Bk\<^bsup>na\<^esup>, [Oc, Oc]) dither stp of (s, tp')
- \<Rightarrow> s = 0 \<and> (case tp' of (l, r) \<Rightarrow> (\<exists>na. l = Bk\<^bsup>na\<^esup>) \<and> r = [Oc, Oc])"
- using dither_halt_rs[of na]
- apply(auto)
- apply(rule_tac x = stp in exI, auto)
- done
- next
- show "\<lambda>(l, r). ((\<exists>na. l = Bk\<^bsup>na\<^esup>) \<and> r = [Oc, Oc]) \<turnstile>->
- (\<lambda>(l, r). (\<exists>na. l = Bk\<^bsup>na\<^esup>) \<and> r = [Oc, Oc])"
- by (simp add: t_imply_def)
- qed
- hence "\<exists> stp tp'. steps (Suc 0, [], Oc\<^bsup>?cn\<^esup>) ((tcopy |+| H ) |+| dither)
- stp = (0, tp') \<and> ?Q2 tp'"
- apply(simp add: t_imply_def)
- done
- thus "haltP (tcontra H) (code (tcontra H))"
- apply(auto simp: haltP_def tcontra_def)
- apply(rule_tac x = stp in exI,
- rule_tac x = na in exI,
- rule_tac x = "Suc (Suc 0)" in exI,
- rule_tac x = "0" in exI, simp add: exp_ind_def)
- done
-qed
-
-text {*
- @{text "False"} is finally derived.
-*}
-
-lemma "False"
-using uh_h h_uh
-by auto
-end
-
-end
-