(* Title: thys/Uncomputable.thy

   Author: Jian Xu, Xingyuan Zhang, and Christian Urban

*)

chapter {* Undeciablity of the Halting Problem *}

theory Uncomputable

imports Turing_Hoare

begin

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" 

  and "7 = Suc 6"

  and "8 = Suc 7" 

  and "9 = Suc 8" 

  and "10 = Suc 9"

  and "11 = Suc 10"

  and "12 = Suc 11"

by simp_all

text {* The Copying TM, which duplicates its input. *}

definition 

  tcopy_begin :: "instr list"

where

  "tcopy_begin \<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_begin |+| tcopy_loop) |+| tcopy_end"

(* tcopy_begin *)

fun 

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

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

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

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

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

where

  "inv_begin0 n (l, r) = ((n > 1 \<and> (l, r) = (Oc \<up> (n - 2), [Oc, Oc, Bk, Oc])) \<or>   

                          (n = 1 \<and> (l, r) = ([], [Bk, Oc, Bk, Oc])))"

| "inv_begin1 n (l, r) = ((l, r) = ([], Oc \<up> n))"

| "inv_begin2 n (l, r) = (\<exists> i j. i > 0 \<and> i + j = n \<and> (l, r) = (Oc \<up> i, Oc \<up> j))"

| "inv_begin3 n (l, r) = (n > 0 \<and> (l, tl r) = (Bk # Oc \<up> n, []))"

| "inv_begin4 n (l, r) = (n > 0 \<and> (l, r) = (Oc \<up> n, [Bk, Oc]) \<or> (l, r) = (Oc \<up> (n - 1), [Oc, Bk, Oc]))"

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

  where

  "inv_begin n (s, tp) = 

        (if s = 0 then inv_begin0 n tp else

         if s = 1 then inv_begin1 n tp else

         if s = 2 then inv_begin2 n tp else

         if s = 3 then inv_begin3 n tp else

         if s = 4 then inv_begin4 n tp 

         else False)"

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

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

lemma inv_begin_step: 

  assumes "inv_begin n cf"

  and "n > 0"

  shows "inv_begin n (step0 cf tcopy_begin)"

using assms

unfolding tcopy_begin_def

apply(cases cf)

apply(case_tac "hd c")

apply(auto)

apply(case_tac c)

apply(simp_all)

done

lemma inv_begin_steps: 

  assumes "inv_begin n cf"

  and "n > 0"

  shows "inv_begin n (steps0 cf tcopy_begin stp)"

apply(induct stp)

apply(simp add: assms)

apply(auto simp del: steps.simps)

apply(rule_tac inv_begin_step)

apply(simp_all add: assms)

done

lemma begin_partial_correctness:

  assumes "is_final (steps0 (1, [], Oc \<up> n) tcopy_begin stp)"

  shows "0 < n \<Longrightarrow> {inv_begin1 n} tcopy_begin {inv_begin0 n}"

proof(rule_tac Hoare_haltI)

  fix l r

  assume h: "0 < n" "inv_begin1 n (l, r)"

  have "inv_begin n (steps0 (1, [], Oc \<up> n) tcopy_begin stp)"

    using h by (rule_tac inv_begin_steps) (simp_all add: inv_begin.simps)

  then show

    "\<exists>stp. is_final (steps0 (1, l, r) tcopy_begin stp) \<and> 

    inv_begin0 n holds_for steps (1, l, r) (tcopy_begin, 0) stp"

    using h assms

    apply(rule_tac x = stp in exI)

    apply(case_tac "(steps0 (1, [], Oc \<up> n) tcopy_begin stp)", simp add: inv_begin.simps)

    done

qed

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

  where

  "measure_begin_state (s, l, r) = (if s = 0 then 0 else 5 - s)"

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

  where

  "measure_begin_step (s, l, r) = 

        (if s = 2 then length r else

         if s = 3 then (if r = [] \<or> r = [Bk] then 1 else 0) else

         if s = 4 then length l 

         else 0)"

definition

  "measure_begin = measures [measure_begin_state, measure_begin_step]"

lemma wf_measure_begin:

  shows "wf measure_begin" 

unfolding measure_begin_def 

by auto

lemma measure_begin_induct [case_names Step]: 

  "\<lbrakk>\<And>n. \<not> P (f n) \<Longrightarrow> (f (Suc n), (f n)) \<in> measure_begin\<rbrakk> \<Longrightarrow> \<exists>n. P (f n)"

using wf_measure_begin

by (metis wf_iff_no_infinite_down_chain)

lemma begin_halts: 

  assumes h: "x > 0"

  shows "\<exists> stp. is_final (steps0 (1, [], Oc \<up> x) tcopy_begin stp)"

proof (induct rule: measure_begin_induct) 

  case (Step n)

  have "\<not> is_final (steps0 (1, [], Oc \<up> x) tcopy_begin n)" by fact

  moreover

  have "inv_begin x (steps0 (1, [], Oc \<up> x) tcopy_begin n)"

    by (rule_tac inv_begin_steps) (simp_all add: inv_begin.simps h)

  moreover

  obtain s l r where eq: "(steps0 (1, [], Oc \<up> x) tcopy_begin n) = (s, l, r)"

    by (metis measure_begin_state.cases)

  ultimately 

  have "(step0 (s, l, r) tcopy_begin, s, l, r) \<in> measure_begin"

    apply(auto simp: measure_begin_def tcopy_begin_def numeral split: if_splits)

    apply(subgoal_tac "r = [Oc]")

    apply(auto)

    by (metis cell.exhaust list.exhaust list.sel(3))

  then 

  show "(steps0 (1, [], Oc \<up> x) tcopy_begin (Suc n), steps0 (1, [], Oc \<up> x) tcopy_begin n) \<in> measure_begin"

    using eq by (simp only: step_red)

qed

lemma begin_correct: 

  shows "0 < n \<Longrightarrow> {inv_begin1 n} tcopy_begin {inv_begin0 n}"

using begin_partial_correctness begin_halts by blast

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]

(* tcopy_loop *)

fun 

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

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

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

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

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

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

where

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

| "inv_loop1_exit n (l, r) = (0 < n \<and> (l, r) = ([], Bk#Oc#Bk\<up>n @ Oc\<up>n))"

| "inv_loop5_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, r) = (Oc\<up>k@Bk\<up>j@Oc\<up>i, Oc\<up>t))"

| "inv_loop5_exit x (l, r) = 

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

| "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, r) = (Bk\<up>k @ Oc\<up>i, Bk\<up>(Suc t) @ Oc\<up>j))"

| "inv_loop6_exit x (l, r) = 

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

fun 

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

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

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

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

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

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

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

where

  "inv_loop0 n (l, r) =  (0 < n \<and> (l, r) = ([Bk], Oc # Bk\<up>n @ Oc\<up>n))"

| "inv_loop1 n (l, r) = (inv_loop1_loop n (l, r) \<or> inv_loop1_exit n (l, r))"

| "inv_loop2 n (l, r) = (\<exists> i j any. i + j = n \<and> n > 0 \<and> i > 0 \<and> j > 0 \<and> (l, r) = (Oc\<up>i, any#Bk\<up>j@Oc\<up>j))"

| "inv_loop3 n (l, r) = 

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

| "inv_loop4 n (l, r) = 

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

| "inv_loop5 n (l, r) = (inv_loop5_loop n (l, r) \<or> inv_loop5_exit n (l, r))"

| "inv_loop6 n (l, r) = (inv_loop6_loop n (l, r) \<or> inv_loop6_exit n (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]

by (case_tac t, auto)

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

by (auto simp: inv_loop3.simps)

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

by (auto simp: inv_loop1.simps)

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

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

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

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

by (auto simp: inv_loop5.simps)

by (auto simp: inv_loop6.simps)

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]

          \<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

by (auto simp: inv_loop6_loop.simps)

  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

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

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

done

              \<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

        \<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

apply(simp add: inv_loop6.simps)

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

done

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

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

done

by (auto simp: inv_loop2.simps)

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

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

by (auto simp: inv_loop5_exit.simps)

  \<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

           \<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

apply(simp add: inv_loop5.simps)

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

done

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 measure_loop :: "(config \<times> config) set"

  where

   "measure_loop = measures [loop_stage, loop_state, loop_step]"

lemma wf_measure_loop: "wf measure_loop"

unfolding measure_loop_def

by (auto)

lemma measure_loop_induct [case_names Step]: 

  "\<lbrakk>\<And>n. \<not> P (f n) \<Longrightarrow> (f (Suc n), (f n)) \<in> measure_loop\<rbrakk> \<Longrightarrow> \<exists>n. P (f n)"

using wf_measure_loop

by (metis wf_iff_no_infinite_down_chain)

  length (takeWhile (\<lambda>a. a = Oc) (rev l' @ [Oc])) \<noteq> 

  length (takeWhile (\<lambda>a. a = Oc) (rev l'))\<rbrakk>

apply(auto simp: inv_loop4.simps)

apply(case_tac [!] j, simp_all add: List.takeWhile_tail)

done

lemma takeWhile_replicate_append: 

  "P a \<Longrightarrow> takeWhile P (a\<up>x @ ys) = a\<up>x @ takeWhile P ys"

by (induct x, auto)

lemma takeWhile_replicate: 

  "P a \<Longrightarrow> takeWhile P (a\<up>x) = a\<up>x"

by (induct x, auto)

   length (takeWhile (\<lambda>a. a = Oc) (rev (tl l') @ hd l' # Bk # list)) \<noteq>

   length (takeWhile (\<lambda>a. a = Oc) (rev l' @ Bk # list))\<rbrakk>

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

apply(case_tac [!] j, simp_all)

apply(case_tac [!] "nat", simp_all)

apply(case_tac  nata, simp_all add: List.takeWhile_tail)

apply(simp add: takeWhile_replicate_append takeWhile_replicate)

apply(case_tac  nata, simp_all add: List.takeWhile_tail)

done