(* 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_hoare

begin

declare tm_comp.simps [simp del] 

declare adjust.simps[simp del] 

declare shift.simps[simp del]

declare tm_wf.simps[simp del]

declare step.simps[simp del]

declare steps.simps[simp del]

lemma numeral:

  shows "1 = Suc 0"

  and "2 = Suc 1"

  and "3 = Suc 2"

  and "4 = Suc 3" 

  and "5 = Suc 4" 

  and "6 = Suc 5" by arith+

text {*

  The {\em Copying} TM, which duplicates its input. 

*}

definition 

  tcopy_init :: "instr list"

where

  "tcopy_init \<equiv> [(W0, 0), (R, 2), (R, 3), (R, 2),

                 (W1, 3), (L, 4), (L, 4), (L, 0)]"

definition 

  tcopy_loop :: "instr list"

where

  "tcopy_loop \<equiv> [(R, 0), (R, 2),  (R, 3), (W0, 2),

                 (R, 3), (R, 4), (W1, 5), (R, 4),

                 (L, 6), (L, 5), (L, 6), (L, 1)]"

definition 

  tcopy_end :: "instr list"

where

  "tcopy_end \<equiv> [(L, 0), (R, 2), (W1, 3), (L, 4),

                (R, 2), (R, 2), (L, 5), (W0, 4),

                (R, 0), (L, 5)]"

definition 

  tcopy :: "instr list"

where

  "tcopy \<equiv> (tcopy_init |+| tcopy_loop) |+| tcopy_end"

(* tcopy_init *)

fun 

  inv_init0 :: "nat \<Rightarrow> tape \<Rightarrow> bool" and

  inv_init1 :: "nat \<Rightarrow> tape \<Rightarrow> bool" and

  inv_init2 :: "nat \<Rightarrow> tape \<Rightarrow> bool" and

  inv_init3 :: "nat \<Rightarrow> tape \<Rightarrow> bool" and

  inv_init4 :: "nat \<Rightarrow> tape \<Rightarrow> bool"

where

fun inv_init :: "nat \<Rightarrow> config \<Rightarrow> bool"

  where

         else False)"

lemma [elim]: "\<lbrakk>0 < i; 0 < j\<rbrakk> \<Longrightarrow> 

  \<exists>ia>0. ia + j - Suc 0 = i + j \<and> Oc # Oc \<up> i = Oc \<up> ia"

apply(rule_tac x = "Suc i" in exI, simp)

done

lemma inv_init_step: 

  "\<lbrakk>inv_init x cf; x > 0\<rbrakk>

 \<Longrightarrow> inv_init x (step cf (tcopy_init, 0))"

unfolding tcopy_init_def

apply(case_tac cf)

apply(auto simp: inv_init.simps step.simps tcopy_init_def numeral split: if_splits)

apply(case_tac "hd c", auto simp: inv_init.simps)

apply(case_tac c, simp_all)

done

lemma inv_init_steps: 

  "\<lbrakk>inv_init x (s, l, r); x > 0\<rbrakk>

 \<Longrightarrow> inv_init x (steps (s, l, r) (tcopy_init, 0) stp)"

apply(induct stp, simp add: steps.simps)

apply(auto simp: step_red)

apply(rule_tac inv_init_step, simp_all)

done

fun init_state :: "config \<Rightarrow> nat"

  where

fun init_step :: "config \<Rightarrow> nat"

  where

fun init_measure :: "config \<Rightarrow> nat \<times> nat"

  where

definition lex_pair :: "((nat \<times> nat) \<times> nat \<times> nat) set"

  where

  "lex_pair \<equiv> less_than <*lex*> less_than"

definition init_LE :: "(config \<times> config) set"

  where

lemma [simp]: "\<lbrakk>tl r = []; r \<noteq> []; r \<noteq> [Bk]\<rbrakk> \<Longrightarrow> r = [Oc]"

lemma wf_init_le: "wf init_LE"

by(auto intro:wf_inv_image simp:init_LE_def lex_pair_def)

lemma init_halt: 

  "x > 0 \<Longrightarrow> \<exists> stp. is_final (steps (Suc 0, [], Oc\<up>x) (tcopy_init, 0) stp)"

proof(rule_tac LE = init_LE in halt_lemma)

  show "wf init_LE" by(simp add: wf_init_le)

next

  assume h: "0 < x"

  show "\<forall>n. \<not> is_final (steps (Suc 0, [], Oc \<up> x) (tcopy_init, 0) n) \<longrightarrow>

        (steps (Suc 0, [], Oc \<up> x) (tcopy_init, 0) (Suc n), 

            steps (Suc 0, [], Oc \<up> x) (tcopy_init, 0) n) \<in> init_LE"

  proof(rule_tac allI, rule_tac impI)

    fix n

    assume a: "\<not> is_final (steps (Suc 0, [], Oc \<up> x) (tcopy_init, 0) n)"

    have b: "inv_init x (steps (Suc 0, [], Oc \<up> x) (tcopy_init, 0) n)"

      apply(rule_tac inv_init_steps)

      apply(simp_all add: inv_init.simps h)

      done 

    obtain s l r where c: "(steps (Suc 0, [], Oc \<up> x) (tcopy_init, 0) n) = (s, l, r)"

      apply(case_tac "steps (Suc 0, [], Oc \<up> x) (tcopy_init, 0) n", auto)

      done

    moreover hence "inv_init x (s, l, r)" 

      using c b by simp

    ultimately show "(steps (Suc 0, [], Oc \<up> x) (tcopy_init, 0) (Suc n), 

      steps (Suc 0, [], Oc \<up> x) (tcopy_init, 0) n) \<in> init_LE"

      using a 

      assume "inv_init x (s, l, r)" "0 < s"

      thus "(step (s, l, r) (tcopy_init, 0), s, l, r) \<in> init_LE"

        apply(case_tac r, auto, case_tac a, auto)

        done

    qed

  qed

qed

lemma init_correct: 

  "x > 0 \<Longrightarrow> {inv_init1 x} tcopy_init {inv_init0 x}"

proof(rule_tac Hoare_haltI)

  fix l r

  assume h: "0 < x"

    "inv_init1 x (l, r)"

  hence "\<exists> stp. is_final (steps (Suc 0, [], Oc\<up>x) (tcopy_init, 0) stp)"

    by(erule_tac init_halt)    

  then obtain stp where "is_final (steps (Suc 0, [], Oc\<up>x) (tcopy_init, 0) stp)" ..

  moreover have "inv_init x (steps (Suc 0, [], Oc\<up>x) (tcopy_init, 0) stp)"

    apply(rule_tac inv_init_steps)

    using h by(simp_all add: inv_init.simps)

  ultimately show

    "\<exists>n. is_final (steps (1, l, r) (tcopy_init, 0) n) \<and> 

    inv_init0 x holds_for steps (1, l, r) (tcopy_init, 0) n"

    using h

    apply(rule_tac x = stp in exI)

    apply(case_tac "(steps (Suc 0, [], Oc \<up> x) (tcopy_init, 0) stp)", simp add: inv_init.simps)

    done

qed

(* tcopy_loop *)

where

fun inv_loop6_loop :: "nat \<Rightarrow> tape \<Rightarrow> bool"

  where

  "inv_loop6_loop x (l, r) = 

     (\<exists> i j k t. i + j = Suc x \<and> i > 0 \<and> k + t + 1 = j \<and> l = Bk\<up>k @ Oc\<up>i \<and> r = Bk\<up>(Suc t) @ Oc\<up>j)"

fun inv_loop6_exit :: "nat \<Rightarrow> tape \<Rightarrow> bool"

  where

  "inv_loop6_exit x (l, r) = 

     (\<exists> i j. i + j = x \<and> j > 0 \<and> l = Oc\<up>i \<and> r = Oc # Bk\<up>j @ Oc\<up>j)"

fun inv_loop6 :: "nat \<Rightarrow> tape \<Rightarrow> bool"

  where

  "inv_loop6 x (l, r) = (inv_loop6_loop x (l, r) \<or> inv_loop6_exit x (l, r))"

fun inv_loop :: "nat \<Rightarrow> config \<Rightarrow> bool"

  where

  "inv_loop x (s, l, r) = 

         (if s = 0 then inv_loop0 x (l, r)

          else if s = 1 then inv_loop1 x (l, r)

          else if s = 2 then inv_loop2 x (l, r)

          else if s = 3 then inv_loop3 x (l, r)

          else if s = 4 then inv_loop4 x (l, r)

          else if s = 5 then inv_loop5 x (l, r)

          else if s = 6 then inv_loop6 x (l, r)

          else False)"

declare inv_loop.simps[simp del] inv_loop1.simps[simp del]

        inv_loop2.simps[simp del] inv_loop3.simps[simp del] 

        inv_loop4.simps[simp del] inv_loop5.simps[simp del] 

        inv_loop6.simps[simp del]

lemma [elim]: "Bk # list = Oc \<up> t \<Longrightarrow> RR"

lemma [simp]: "inv_loop1 x (b, []) = False"

by(simp add: inv_loop1.simps)

lemma [elim]: "\<lbrakk>0 < x; inv_loop2 x (b, [])\<rbrakk> \<Longrightarrow> inv_loop3 x (Bk # b, [])"

lemma [elim]: "\<lbrakk>0 < x; inv_loop3 x (b, [])\<rbrakk> \<Longrightarrow> inv_loop3 x (Bk # b, [])"

lemma [elim]: "\<lbrakk>0 < x; inv_loop4 x (b, [])\<rbrakk> \<Longrightarrow> inv_loop5 x (b, [Oc])"

apply(auto simp: inv_loop4.simps inv_loop5.simps)

apply(rule_tac [!] x = i in exI, 

      rule_tac [!] x  = "Suc j" in exI, simp_all)

done

lemma [elim]: "\<lbrakk>0 < x; inv_loop5 x ([], [])\<rbrakk> \<Longrightarrow> RR"

apply(auto simp: inv_loop4.simps inv_loop5.simps)

done

lemma [elim]: "\<lbrakk>0 < x; inv_loop5 x (b, []); b \<noteq> []\<rbrakk> \<Longrightarrow> RR"

apply(auto simp: inv_loop4.simps inv_loop5.simps)

done

lemma [elim]: "inv_loop6 x ([], []) \<Longrightarrow> RR"

apply(auto simp: inv_loop6.simps)

done

thm inv_loop6_exit.simps

lemma [elim]: "inv_loop6 x (b, []) \<Longrightarrow> RR" 

apply(auto simp: inv_loop6.simps)

done

lemma [elim]: "\<lbrakk>0 < x; inv_loop1 x (b, Bk # list)\<rbrakk> \<Longrightarrow> b = []"

apply(auto simp: inv_loop1.simps)

done

lemma [elim]: "\<lbrakk>0 < x; inv_loop1 x (b, Bk # list)\<rbrakk> \<Longrightarrow> list = Oc # Bk \<up> x @ Oc \<up> x"

apply(auto simp: inv_loop1.simps)

done

lemma [elim]: "\<lbrakk>0 < x; inv_loop2 x (b, Bk # list)\<rbrakk> \<Longrightarrow> inv_loop3 x (Bk # b, list)"

apply(auto simp: inv_loop2.simps inv_loop3.simps)

apply(rule_tac [!] x = i  in exI, rule_tac [!] x = j in exI, simp_all)

done

lemma [elim]: "Bk # list = Oc \<up> j \<Longrightarrow> RR"

apply(case_tac j, simp_all)

done

lemma [elim]: "\<lbrakk>0 < x; inv_loop3 x (b, Bk # list)\<rbrakk> \<Longrightarrow> inv_loop3 x (Bk # b, list)"

apply(auto simp: inv_loop3.simps)

apply(rule_tac [!] x = i in exI, 

      rule_tac [!] x = j in exI, simp_all)

apply(case_tac [!] t, auto)

done

lemma [elim]: "\<lbrakk>0 < x; inv_loop4 x (b, Bk # list)\<rbrakk> \<Longrightarrow> inv_loop5 x (b, Oc # list)"

apply(auto simp: inv_loop4.simps inv_loop5.simps)

done

lemma [elim]: "\<lbrakk>0 < x; inv_loop5 x ([], Bk # list)\<rbrakk> \<Longrightarrow> inv_loop6 x ([], Bk # Bk # list)"

apply(auto simp: inv_loop6.simps inv_loop5.simps)

done

lemma [simp]: "inv_loop5_loop x (b, Bk # list) = False"

apply(auto simp: inv_loop5_loop.simps)

done

lemma [simp]: "inv_loop6_exit x (b, Bk # list) = False"

apply(auto simp: inv_loop6.simps)

done

declare inv_loop5_loop.simps[simp del]  inv_loop5_exit.simps[simp del]

       inv_loop6_loop.simps[simp del]  inv_loop6_exit.simps[simp del]

lemma [elim]:"\<lbrakk>0 < x; inv_loop5_exit x (b, Bk # list); b \<noteq> []; hd b = Bk\<rbrakk> 

          \<Longrightarrow> inv_loop6_loop x (tl b, Bk # Bk # list)"

apply(simp only: inv_loop5_exit.simps inv_loop6_loop.simps )

apply(erule_tac exE)+

apply(rule_tac x = i in exI, 

      rule_tac x = j in exI,

      rule_tac x = "j - Suc (Suc 0)" in exI, 

      rule_tac x = "Suc 0" in exI, auto)

apply(case_tac [!] j, simp_all)

apply(case_tac [!] nat, simp_all)

done

lemma [simp]: "inv_loop6_loop x (b, Oc # Bk # list) = False"

apply(auto simp: inv_loop6_loop.simps)

done

lemma [elim]: "\<lbrakk>x > 0; inv_loop5_exit x (b, Bk # list); b \<noteq> []; hd b = Oc\<rbrakk> \<Longrightarrow> 

  inv_loop6_exit x (tl b, Oc # Bk # list)"

apply(simp only: inv_loop5_exit.simps inv_loop6_exit.simps)

apply(erule_tac exE)+

apply(rule_tac x = "x - 1" in exI, rule_tac x = 1 in exI, simp)

apply(case_tac j, auto)

apply(case_tac [!] nat, auto)

done

lemma [elim]: "\<lbrakk>0 < x; inv_loop5 x (b, Bk # list); b \<noteq> []\<rbrakk> \<Longrightarrow> inv_loop6 x (tl b, hd b # Bk # list)"

apply(simp add: inv_loop5.simps inv_loop6.simps)

apply(case_tac "hd b", simp_all, auto)

done

lemma  [simp]: "inv_loop6 x ([], Bk # xs) = False"

apply(simp add: inv_loop6.simps inv_loop6_loop.simps

                inv_loop6_exit.simps)

apply(auto)

done

lemma [elim]: "\<lbrakk>0 < x; inv_loop6 x ([], Bk # list)\<rbrakk> \<Longrightarrow> inv_loop6 x ([], Bk # Bk # list)"

apply(simp)

done

lemma [simp]: "inv_loop6_exit x (b, Bk # list) = False"

apply(simp add: inv_loop6_exit.simps)

done

lemma [elim]: "\<lbrakk>0 < x; inv_loop6_loop x (b, Bk # list); b \<noteq> []; hd b = Bk\<rbrakk>

              \<Longrightarrow> inv_loop6_loop x (tl b, Bk # Bk # list)"

apply(simp only: inv_loop6_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, auto)

apply(case_tac [!] k, auto)

done

lemma [elim]: "\<lbrakk>0 < x; inv_loop6_loop x (b, Bk # list); b \<noteq> []; hd b = Oc\<rbrakk> 

        \<Longrightarrow> inv_loop6_exit x (tl b, Oc # Bk # list)"

apply(simp only: inv_loop6_loop.simps inv_loop6_exit.simps)

apply(erule_tac exE)+

apply(rule_tac x = "i - 1" in exI, rule_tac x = j in exI, auto)

apply(case_tac [!] k, auto)

done

lemma [elim]: "\<lbrakk>0 < x; inv_loop6 x (b, Bk # list); b \<noteq> []\<rbrakk> \<Longrightarrow> inv_loop6 x (tl b, hd b # Bk # list)"

apply(simp add: inv_loop6.simps)

apply(case_tac "hd b", simp_all, auto)

done

lemma [elim]: "\<lbrakk>0 < x; inv_loop1 x (b, Oc # list)\<rbrakk> \<Longrightarrow> inv_loop2 x (Oc # b, list)"

apply(auto simp: inv_loop1.simps inv_loop2.simps)

apply(rule_tac x = "Suc i" in exI, auto)

done

lemma [elim]: "\<lbrakk>0 < x; inv_loop2 x (b, Oc # list)\<rbrakk> \<Longrightarrow> inv_loop2 x (b, Bk # list)"

apply(auto simp: inv_loop2.simps)

done

lemma [elim]: "\<lbrakk>0 < x; inv_loop3 x (b, Oc # list)\<rbrakk> \<Longrightarrow> inv_loop4 x (Oc # b, list)"

apply(auto simp: inv_loop3.simps inv_loop4.simps)

apply(rule_tac [!] x = i in exI, auto)

apply(rule_tac [!] x = "Suc 0" in exI, rule_tac [!] x = "j - 1" in exI, auto)

apply(case_tac [!] t, auto)

apply(case_tac [!] j, auto)

done

lemma [elim]: "\<lbrakk>0 < x; inv_loop4 x (b, Oc # list)\<rbrakk> \<Longrightarrow> inv_loop4 x (Oc # b, list)"

apply(auto simp: inv_loop4.simps)

apply(rule_tac [!] x = "i" in exI, auto)

apply(rule_tac [!] x = "Suc k" in exI, rule_tac [!] x = "t - 1" in exI, auto)

apply(case_tac [!] t, simp_all)

done

lemma [simp]: "inv_loop5 x ([], list) = False"

apply(auto simp: inv_loop5.simps inv_loop5_exit.simps inv_loop5_loop.simps)

done

lemma [simp]: "inv_loop5_exit x (b, Oc # list) = False"

apply(auto simp: inv_loop5_exit.simps)

done

lemma [elim]: " \<lbrakk>inv_loop5_loop x (b, Oc # list); b \<noteq> []; hd b = Bk\<rbrakk>

  \<Longrightarrow> inv_loop5_exit x (tl b, Bk # Oc # list)"

apply(simp only: inv_loop5_loop.simps inv_loop5_exit.simps)

apply(erule_tac exE)+

apply(rule_tac x = i in exI, auto)

apply(case_tac [!] k, auto)

done

lemma [elim]: "\<lbrakk>inv_loop5_loop x (b, Oc # list); b \<noteq> []; hd b = Oc\<rbrakk> 

           \<Longrightarrow> inv_loop5_loop x (tl b, Oc # Oc # list)"

apply(simp only:  inv_loop5_loop.simps)

apply(erule_tac exE)+

apply(rule_tac x = i in exI, rule_tac x = j in exI)

apply(rule_tac x = "k - 1" in exI, rule_tac x = "Suc t" in exI, auto)

apply(case_tac [!] k, auto)

done

lemma [elim]: "\<lbrakk>inv_loop5 x (b, Oc # list); b \<noteq> []\<rbrakk> \<Longrightarrow> 

  inv_loop5 x (tl b, hd b # Oc # list)"

apply(simp add: inv_loop5.simps)

apply(case_tac "hd b", simp_all, auto)

done

lemma [elim]: "\<lbrakk>0 < x; inv_loop6 x ([], Oc # list)\<rbrakk> \<Longrightarrow> 

               inv_loop1 x ([], Bk # Oc # list)"

apply(auto simp: inv_loop6.simps inv_loop1.simps 

  inv_loop6_loop.simps inv_loop6_exit.simps)

done

lemma [elim]: "\<lbrakk>0 < x; inv_loop6 x (b, Oc # list); b \<noteq> []\<rbrakk> 

           \<Longrightarrow> inv_loop1 x (tl b, hd b # Oc # list)"

apply(auto simp: inv_loop6.simps inv_loop1.simps 

  inv_loop6_loop.simps inv_loop6_exit.simps)

done

lemma inv_loop_step: 

  "\<lbrakk>inv_loop x cf; x > 0\<rbrakk>

 \<Longrightarrow> inv_loop x (step cf (tcopy_loop, 0))"

apply(case_tac cf, case_tac c, case_tac [2] aa)

apply(auto simp: inv_loop.simps step.simps tcopy_loop_def numeral split: if_splits)

done

lemma inv_loop_steps:

  "\<lbrakk>inv_loop x cf; x > 0\<rbrakk>

  \<Longrightarrow> inv_loop x (steps cf (tcopy_loop, 0) stp)"

apply(induct stp, simp add: steps.simps, simp)

apply(erule_tac inv_loop_step, simp)

done

fun loop_stage :: "config \<Rightarrow> nat"

  where

  "loop_stage (s, l, r) = (if s = 0 then 0

                           else (Suc (length (takeWhile (\<lambda>a. a = Oc) (rev l @ r)))))"

fun loop_state :: "config \<Rightarrow> nat"

  where

  "loop_state (s, l, r) = (if s = 2 \<and> hd r = Oc then 0

                           else if s = 1 then 1

                           else 10 - s)"

fun loop_step :: "config \<Rightarrow> nat"

  where

  "loop_step (s, l, r) = (if s = 3 then length r

                          else if s = 4 then length r

                          else if s = 5 then length l 

                          else if s = 6 then length l

                          else 0)"

definition lex_triple :: 

 "((nat \<times> (nat \<times> nat)) \<times> (nat \<times> (nat \<times> nat))) set"

  where

  "lex_triple \<equiv> less_than <*lex*> lex_pair"

lemma wf_lex_triple: "wf lex_triple"

  by (auto intro:wf_lex_prod simp:lex_triple_def lex_pair_def)

fun loop_measure :: "config \<Rightarrow> nat \<times> nat \<times> nat"

  where

  "loop_measure c = 

   (loop_stage c, loop_state c, loop_step c)"

definition loop_LE :: "(config \<times> config) set"

  where

   "loop_LE \<equiv> (inv_image lex_triple loop_measure)"