thys/uncomputable.thy
changeset 97 d6f04e3e9894
parent 96 bd320b5365e2
child 99 fe7a257bdff4
--- a/thys/uncomputable.thy	Tue Jan 29 16:37:38 2013 +0000
+++ b/thys/uncomputable.thy	Wed Jan 30 02:26:56 2013 +0000
@@ -63,14 +63,16 @@
 | "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, l, r) = 
-        (if s = 0 then inv_begin0 n (l, r) else
-         if s = 1 then inv_begin1 n (l, r) else
-         if s = 2 then inv_begin2 n (l, r) else
-         if s = 3 then inv_begin3 n (l, r) else
-         if s = 4 then inv_begin4 n (l, r) 
+  "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)"
 
 lemma [elim]: "\<lbrakk>0 < i; 0 < j\<rbrakk> \<Longrightarrow> 
@@ -120,8 +122,13 @@
 lemma [simp]: "\<lbrakk>tl r = []; r \<noteq> []; r \<noteq> [Bk]\<rbrakk> \<Longrightarrow> r = [Oc]"
 by (case_tac r, auto, case_tac a, auto)
 
+
+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)"
+by (metis wf_iff_no_infinite_down_chain)
+
 lemma begin_halt: 
-  "x > 0 \<Longrightarrow> \<exists> stp. is_final (steps0 (1, [], Oc\<up>x) tcopy_begin stp)"
+  "x > 0 \<Longrightarrow> \<exists> stp. is_final (steps0 (1, [], Oc \<up> x) tcopy_begin stp)"
 proof(rule_tac LE = begin_LE in halt_lemma) 
   show "wf begin_LE" unfolding begin_LE_def by (auto) 
 next
@@ -155,22 +162,22 @@
 qed
     
 lemma begin_correct: 
-  "0 < x \<Longrightarrow> {inv_begin1 x} tcopy_begin {inv_begin0 x}"
+  "0 < n \<Longrightarrow> {inv_begin1 n} tcopy_begin {inv_begin0 n}"
 proof(rule_tac Hoare_haltI)
   fix l r
-  assume h: "0 < x" "inv_begin1 x (l, r)"
-  hence "\<exists> stp. is_final (steps0 (1, [], Oc \<up> x) tcopy_begin stp)"
+  assume h: "0 < n" "inv_begin1 n (l, r)"
+  then have "\<exists> stp. is_final (steps0 (1, [], Oc \<up> n) tcopy_begin stp)"
     by (rule_tac begin_halt)    
-  then obtain stp where "is_final (steps (1, [], Oc\<up>x) (tcopy_begin, 0) stp)" ..
-  moreover have "inv_begin x (steps (1, [], Oc\<up>x) (tcopy_begin, 0) stp)"
+  then obtain stp where "is_final (steps0 (1, [], Oc \<up> n) tcopy_begin stp)" ..
+  moreover have "inv_begin n (steps0 (1, [], Oc \<up> n) tcopy_begin stp)"
     apply(rule_tac inv_begin_steps)
     using h by(simp_all add: inv_begin.simps)
   ultimately show
-    "\<exists>n. is_final (steps (1, l, r) (tcopy_begin, 0) n) \<and> 
-    inv_begin0 x holds_for steps (1, l, r) (tcopy_begin, 0) n"
+    "\<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
     apply(rule_tac x = stp in exI)
-    apply(case_tac "(steps (1, [], Oc \<up> x) (tcopy_begin, 0) stp)", simp add: inv_begin.simps)
+    apply(case_tac "(steps0 (1, [], Oc \<up> n) tcopy_begin stp)", simp add: inv_begin.simps)
     done
 qed
 
@@ -893,8 +900,11 @@
     by (metis assms loop_correct) 
   moreover
   have "inv_begin0 x \<mapsto> inv_loop1 x"
-    by (auto simp: inv_begin0.simps inv_loop1.simps assert_imp_def)
-       (rule_tac x = "Suc 0" in exI, auto)
+    unfolding assert_imp_def
+    unfolding inv_begin0.simps inv_loop1.simps
+    unfolding inv_loop1_loop.simps inv_loop1_exit.simps
+    apply(auto simp add: numeral Cons_eq_append_conv)
+    by (rule_tac x = "Suc 0" in exI, auto)
   ultimately 
   have "{inv_begin1 x} (tcopy_begin |+| tcopy_loop) {inv_loop0 x}"
     by (rule_tac Hoare_plus_halt) (auto)
@@ -922,10 +932,10 @@
     by (rule tcopy_correct1) (simp)
   moreover
   have "pre_tcopy n = inv_begin1 (Suc n)" 
-    by (auto simp add: tape_of_nl_abv)
+    by (auto simp add: tape_of_nl_abv tape_of_nat_abv)
   moreover
   have "inv_end0 (Suc n) = post_tcopy n" 
-    by (auto simp add: inv_end0.simps tape_of_nl_abv)
+    by (auto simp add: inv_end0.simps tape_of_nat_abv tape_of_nl_abv)
   ultimately
   show "{pre_tcopy n} tcopy {post_tcopy n}" 
     by simp