thys/uncomputable.thy
author Christian Urban <christian dot urban at kcl dot ac dot uk>
Tue, 29 Jan 2013 13:00:51 +0000
changeset 95 5317c92ff2a7
parent 94 aeaf1374dc67
child 96 bd320b5365e2
permissions -rwxr-xr-x
updated paper
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
     1
(* Title: Turing machine's definition and its charater
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
     2
   Author: XuJian <xujian817@hotmail.com>
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
     3
   Maintainer: Xujian
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
     4
*)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
     5
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
     6
header {* Undeciablity of the {\em Halting problem} *}
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
     7
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
     8
theory uncomputable
55
cd4ef33c8fb1 added turing_hoare
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 54
diff changeset
     9
imports Main turing_hoare
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    10
begin
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    11
63
35fe8fe12e65 small updates
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 61
diff changeset
    12
declare tm_comp.simps [simp del] 
35fe8fe12e65 small updates
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 61
diff changeset
    13
declare adjust.simps[simp del] 
35fe8fe12e65 small updates
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 61
diff changeset
    14
declare shift.simps[simp del]
35fe8fe12e65 small updates
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 61
diff changeset
    15
declare tm_wf.simps[simp del]
35fe8fe12e65 small updates
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 61
diff changeset
    16
declare step.simps[simp del]
35fe8fe12e65 small updates
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 61
diff changeset
    17
declare steps.simps[simp del]
35fe8fe12e65 small updates
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 61
diff changeset
    18
35fe8fe12e65 small updates
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 61
diff changeset
    19
35fe8fe12e65 small updates
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 61
diff changeset
    20
lemma numeral:
35fe8fe12e65 small updates
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 61
diff changeset
    21
  shows "1 = Suc 0"
35fe8fe12e65 small updates
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 61
diff changeset
    22
  and "2 = Suc 1"
35fe8fe12e65 small updates
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 61
diff changeset
    23
  and "3 = Suc 2"
35fe8fe12e65 small updates
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 61
diff changeset
    24
  and "4 = Suc 3" 
35fe8fe12e65 small updates
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 61
diff changeset
    25
  and "5 = Suc 4" 
35fe8fe12e65 small updates
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 61
diff changeset
    26
  and "6 = Suc 5" by arith+
35fe8fe12e65 small updates
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 61
diff changeset
    27
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    28
text {*
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    29
  The {\em Copying} TM, which duplicates its input. 
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    30
*}
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    31
68
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 67
diff changeset
    32
definition 
89
c67e8ed4c865 updated uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 84
diff changeset
    33
  tcopy_begin :: "instr list"
68
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 67
diff changeset
    34
where
89
c67e8ed4c865 updated uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 84
diff changeset
    35
  "tcopy_begin \<equiv> [(W0, 0), (R, 2), (R, 3), (R, 2),
68
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 67
diff changeset
    36
                 (W1, 3), (L, 4), (L, 4), (L, 0)]"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 67
diff changeset
    37
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 67
diff changeset
    38
definition 
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 67
diff changeset
    39
  tcopy_loop :: "instr list"
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    40
where
68
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 67
diff changeset
    41
  "tcopy_loop \<equiv> [(R, 0), (R, 2),  (R, 3), (W0, 2),
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 67
diff changeset
    42
                 (R, 3), (R, 4), (W1, 5), (R, 4),
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 67
diff changeset
    43
                 (L, 6), (L, 5), (L, 6), (L, 1)]"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 67
diff changeset
    44
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 67
diff changeset
    45
definition 
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 67
diff changeset
    46
  tcopy_end :: "instr list"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 67
diff changeset
    47
where
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 67
diff changeset
    48
  "tcopy_end \<equiv> [(L, 0), (R, 2), (W1, 3), (L, 4),
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 67
diff changeset
    49
                (R, 2), (R, 2), (L, 5), (W0, 4),
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 67
diff changeset
    50
                (R, 0), (L, 5)]"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 67
diff changeset
    51
92
b9d0dd18c81e updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 91
diff changeset
    52
definition 
68
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 67
diff changeset
    53
  tcopy :: "instr list"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 67
diff changeset
    54
where
89
c67e8ed4c865 updated uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 84
diff changeset
    55
  "tcopy \<equiv> (tcopy_begin |+| tcopy_loop) |+| tcopy_end"
68
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 67
diff changeset
    56
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 67
diff changeset
    57
89
c67e8ed4c865 updated uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 84
diff changeset
    58
(* tcopy_begin *)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    59
71
8c7f10b3da7b updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 70
diff changeset
    60
fun 
89
c67e8ed4c865 updated uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 84
diff changeset
    61
  inv_begin0 :: "nat \<Rightarrow> tape \<Rightarrow> bool" and
c67e8ed4c865 updated uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 84
diff changeset
    62
  inv_begin1 :: "nat \<Rightarrow> tape \<Rightarrow> bool" and
c67e8ed4c865 updated uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 84
diff changeset
    63
  inv_begin2 :: "nat \<Rightarrow> tape \<Rightarrow> bool" and
c67e8ed4c865 updated uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 84
diff changeset
    64
  inv_begin3 :: "nat \<Rightarrow> tape \<Rightarrow> bool" and
c67e8ed4c865 updated uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 84
diff changeset
    65
  inv_begin4 :: "nat \<Rightarrow> tape \<Rightarrow> bool"
71
8c7f10b3da7b updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 70
diff changeset
    66
where
89
c67e8ed4c865 updated uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 84
diff changeset
    67
  "inv_begin0 n (l, r) = ((n > 1 \<and> (l, r) = (Oc \<up> (n - 2), [Oc, Oc, Bk, Oc])) \<or>   
95
5317c92ff2a7 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 94
diff changeset
    68
                          (n = 1 \<and> (l, r) = ([], [Bk, Oc, Bk, Oc])))"
89
c67e8ed4c865 updated uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 84
diff changeset
    69
| "inv_begin1 n (l, r) = ((l, r) = ([], Oc \<up> n))"
c67e8ed4c865 updated uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 84
diff changeset
    70
| "inv_begin2 n (l, r) = (\<exists> i j. i > 0 \<and> i + j = n \<and> (l, r) = (Oc \<up> i, Oc \<up> j))"
c67e8ed4c865 updated uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 84
diff changeset
    71
| "inv_begin3 n (l, r) = (n > 0 \<and> (l, tl r) = (Bk # Oc \<up> n, []))"
95
5317c92ff2a7 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 94
diff changeset
    72
| "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]))"
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    73
89
c67e8ed4c865 updated uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 84
diff changeset
    74
fun inv_begin :: "nat \<Rightarrow> config \<Rightarrow> bool"
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    75
  where
89
c67e8ed4c865 updated uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 84
diff changeset
    76
  "inv_begin n (s, l, r) = 
c67e8ed4c865 updated uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 84
diff changeset
    77
        (if s = 0 then inv_begin0 n (l, r) else
c67e8ed4c865 updated uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 84
diff changeset
    78
         if s = 1 then inv_begin1 n (l, r) else
c67e8ed4c865 updated uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 84
diff changeset
    79
         if s = 2 then inv_begin2 n (l, r) else
c67e8ed4c865 updated uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 84
diff changeset
    80
         if s = 3 then inv_begin3 n (l, r) else
c67e8ed4c865 updated uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 84
diff changeset
    81
         if s = 4 then inv_begin4 n (l, r) 
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    82
         else False)"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    83
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    84
lemma [elim]: "\<lbrakk>0 < i; 0 < j\<rbrakk> \<Longrightarrow> 
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    85
  \<exists>ia>0. ia + j - Suc 0 = i + j \<and> Oc # Oc \<up> i = Oc \<up> ia"
95
5317c92ff2a7 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 94
diff changeset
    86
by (rule_tac x = "Suc i" in exI, simp)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    87
89
c67e8ed4c865 updated uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 84
diff changeset
    88
lemma inv_begin_step: 
95
5317c92ff2a7 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 94
diff changeset
    89
  assumes "inv_begin x cf"
5317c92ff2a7 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 94
diff changeset
    90
  and "x > 0"
5317c92ff2a7 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 94
diff changeset
    91
  shows "inv_begin x (step0 cf tcopy_begin)"
5317c92ff2a7 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 94
diff changeset
    92
using assms
89
c67e8ed4c865 updated uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 84
diff changeset
    93
unfolding tcopy_begin_def
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    94
apply(case_tac cf)
89
c67e8ed4c865 updated uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 84
diff changeset
    95
apply(auto simp: inv_begin.simps step.simps tcopy_begin_def numeral split: if_splits)
c67e8ed4c865 updated uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 84
diff changeset
    96
apply(case_tac "hd c", auto simp: inv_begin.simps)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    97
apply(case_tac c, simp_all)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    98
done
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    99
89
c67e8ed4c865 updated uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 84
diff changeset
   100
lemma inv_begin_steps: 
95
5317c92ff2a7 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 94
diff changeset
   101
  assumes "inv_begin x cf"
5317c92ff2a7 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 94
diff changeset
   102
  and "x > 0"
5317c92ff2a7 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 94
diff changeset
   103
  shows "inv_begin x (steps0 cf tcopy_begin stp)"
5317c92ff2a7 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 94
diff changeset
   104
apply(induct stp)
5317c92ff2a7 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 94
diff changeset
   105
apply(simp add: steps.simps assms)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   106
apply(auto simp: step_red)
95
5317c92ff2a7 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 94
diff changeset
   107
apply(rule_tac inv_begin_step)
5317c92ff2a7 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 94
diff changeset
   108
apply(simp_all add: assms)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   109
done
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   110
94
aeaf1374dc67 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 93
diff changeset
   111
fun begin_state :: "config \<Rightarrow> nat"
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   112
  where
94
aeaf1374dc67 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 93
diff changeset
   113
  "begin_state (s, l, r) = (if s = 0 then 0 else 5 - s)"
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   114
94
aeaf1374dc67 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 93
diff changeset
   115
fun begin_step :: "config \<Rightarrow> nat"
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   116
  where
94
aeaf1374dc67 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 93
diff changeset
   117
  "begin_step (s, l, r) = 
81
2e9881578cb2 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 80
diff changeset
   118
        (if s = 2 then length r else
2e9881578cb2 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 80
diff changeset
   119
         if s = 3 then (if r = [] \<or> r = [Bk] then 1 else 0) else
2e9881578cb2 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 80
diff changeset
   120
         if s = 4 then length l 
2e9881578cb2 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 80
diff changeset
   121
         else 0)"
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   122
94
aeaf1374dc67 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 93
diff changeset
   123
fun begin_measure :: "config \<Rightarrow> nat \<times> nat"
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   124
  where
94
aeaf1374dc67 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 93
diff changeset
   125
  "begin_measure c = (begin_state c, begin_step c)"
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   126
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   127
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   128
definition lex_pair :: "((nat \<times> nat) \<times> nat \<times> nat) set"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   129
  where
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   130
  "lex_pair \<equiv> less_than <*lex*> less_than"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   131
94
aeaf1374dc67 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 93
diff changeset
   132
definition begin_LE :: "(config \<times> config) set"
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   133
  where
94
aeaf1374dc67 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 93
diff changeset
   134
  "begin_LE \<equiv> (inv_image lex_pair begin_measure)"
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   135
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   136
lemma [simp]: "\<lbrakk>tl r = []; r \<noteq> []; r \<noteq> [Bk]\<rbrakk> \<Longrightarrow> r = [Oc]"
81
2e9881578cb2 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 80
diff changeset
   137
by (case_tac r, auto, case_tac a, auto)
2e9881578cb2 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 80
diff changeset
   138
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   139
94
aeaf1374dc67 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 93
diff changeset
   140
lemma wf_begin_le: "wf begin_LE"
aeaf1374dc67 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 93
diff changeset
   141
by(auto intro:wf_inv_image simp:begin_LE_def lex_pair_def)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   142
94
aeaf1374dc67 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 93
diff changeset
   143
lemma begin_halt: 
95
5317c92ff2a7 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 94
diff changeset
   144
  "x > 0 \<Longrightarrow> \<exists> stp. is_final (steps0 (1, [], Oc\<up>x) tcopy_begin stp)"
94
aeaf1374dc67 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 93
diff changeset
   145
proof(rule_tac LE = begin_LE in halt_lemma) 
aeaf1374dc67 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 93
diff changeset
   146
  show "wf begin_LE" by(simp add: wf_begin_le)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   147
next
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   148
  assume h: "0 < x"
95
5317c92ff2a7 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 94
diff changeset
   149
  show "\<forall>n. \<not> is_final (steps (1, [], Oc \<up> x) (tcopy_begin, 0) n) \<longrightarrow>
5317c92ff2a7 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 94
diff changeset
   150
        (steps (1, [], Oc \<up> x) (tcopy_begin, 0) (Suc n), 
5317c92ff2a7 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 94
diff changeset
   151
            steps (1, [], Oc \<up> x) (tcopy_begin, 0) n) \<in> begin_LE"
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   152
  proof(rule_tac allI, rule_tac impI)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   153
    fix n
95
5317c92ff2a7 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 94
diff changeset
   154
    assume a: "\<not> is_final (steps (1, [], Oc \<up> x) (tcopy_begin, 0) n)"
5317c92ff2a7 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 94
diff changeset
   155
    have b: "inv_begin x (steps (1, [], Oc \<up> x) (tcopy_begin, 0) n)"
89
c67e8ed4c865 updated uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 84
diff changeset
   156
      apply(rule_tac inv_begin_steps)
c67e8ed4c865 updated uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 84
diff changeset
   157
      apply(simp_all add: inv_begin.simps h)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   158
      done 
95
5317c92ff2a7 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 94
diff changeset
   159
    obtain s l r where c: "(steps (1, [], Oc \<up> x) (tcopy_begin, 0) n) = (s, l, r)"
5317c92ff2a7 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 94
diff changeset
   160
      apply(case_tac "steps (1, [], Oc \<up> x) (tcopy_begin, 0) n", auto)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   161
      done
89
c67e8ed4c865 updated uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 84
diff changeset
   162
    moreover hence "inv_begin x (s, l, r)" 
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   163
      using c b by simp
95
5317c92ff2a7 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 94
diff changeset
   164
    ultimately show "(steps (1, [], Oc \<up> x) (tcopy_begin, 0) (Suc n), 
5317c92ff2a7 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 94
diff changeset
   165
      steps (1, [], Oc \<up> x) (tcopy_begin, 0) n) \<in> begin_LE"
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   166
      using a 
89
c67e8ed4c865 updated uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 84
diff changeset
   167
    proof(simp del: inv_begin.simps)
c67e8ed4c865 updated uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 84
diff changeset
   168
      assume "inv_begin x (s, l, r)" "0 < s"
94
aeaf1374dc67 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 93
diff changeset
   169
      thus "(step (s, l, r) (tcopy_begin, 0), s, l, r) \<in> begin_LE"
aeaf1374dc67 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 93
diff changeset
   170
        apply(auto simp: begin_LE_def lex_pair_def step.simps tcopy_begin_def numeral split: if_splits)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   171
        apply(case_tac r, auto, case_tac a, auto)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   172
        done
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   173
    qed
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   174
  qed
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   175
qed
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   176
    
94
aeaf1374dc67 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 93
diff changeset
   177
lemma begin_correct: 
91
2068654bdf54 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 89
diff changeset
   178
  "0 < x \<Longrightarrow> {inv_begin1 x} tcopy_begin {inv_begin0 x}"
71
8c7f10b3da7b updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 70
diff changeset
   179
proof(rule_tac Hoare_haltI)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   180
  fix l r
91
2068654bdf54 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 89
diff changeset
   181
  assume h: "0 < x" "inv_begin1 x (l, r)"
95
5317c92ff2a7 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 94
diff changeset
   182
  hence "\<exists> stp. is_final (steps0 (1, [], Oc \<up> x) tcopy_begin stp)"
94
aeaf1374dc67 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 93
diff changeset
   183
    by (rule_tac begin_halt)    
95
5317c92ff2a7 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 94
diff changeset
   184
  then obtain stp where "is_final (steps (1, [], Oc\<up>x) (tcopy_begin, 0) stp)" ..
5317c92ff2a7 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 94
diff changeset
   185
  moreover have "inv_begin x (steps (1, [], Oc\<up>x) (tcopy_begin, 0) stp)"
89
c67e8ed4c865 updated uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 84
diff changeset
   186
    apply(rule_tac inv_begin_steps)
c67e8ed4c865 updated uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 84
diff changeset
   187
    using h by(simp_all add: inv_begin.simps)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   188
  ultimately show
89
c67e8ed4c865 updated uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 84
diff changeset
   189
    "\<exists>n. is_final (steps (1, l, r) (tcopy_begin, 0) n) \<and> 
c67e8ed4c865 updated uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 84
diff changeset
   190
    inv_begin0 x holds_for steps (1, l, r) (tcopy_begin, 0) n"
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   191
    using h
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   192
    apply(rule_tac x = stp in exI)
95
5317c92ff2a7 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 94
diff changeset
   193
    apply(case_tac "(steps (1, [], Oc \<up> x) (tcopy_begin, 0) stp)", simp add: inv_begin.simps)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   194
    done
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   195
qed
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   196
68
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 67
diff changeset
   197
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 67
diff changeset
   198
(* tcopy_loop *)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   199
81
2e9881578cb2 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 80
diff changeset
   200
fun 
2e9881578cb2 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 80
diff changeset
   201
  inv_loop1_loop :: "nat \<Rightarrow> tape \<Rightarrow> bool" and
2e9881578cb2 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 80
diff changeset
   202
  inv_loop1_exit :: "nat \<Rightarrow> tape \<Rightarrow> bool" and
82
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   203
  inv_loop5_loop :: "nat \<Rightarrow> tape \<Rightarrow> bool" and
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   204
  inv_loop5_exit :: "nat \<Rightarrow> tape \<Rightarrow> bool" and
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   205
  inv_loop6_loop :: "nat \<Rightarrow> tape \<Rightarrow> bool" and
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   206
  inv_loop6_exit :: "nat \<Rightarrow> tape \<Rightarrow> bool"
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   207
where
84
4c8325c64dab updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 83
diff changeset
   208
  "inv_loop1_loop x (l, r) = (\<exists> i j. i + j + 1 = x \<and> (l, r) = (Oc\<up>i, Oc#Oc#Bk\<up>j @ Oc\<up>j) \<and> j > 0)"
4c8325c64dab updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 83
diff changeset
   209
| "inv_loop1_exit x (l, r) = ((l, r) = ([], Bk#Oc#Bk\<up>x @ Oc\<up>x) \<and> x > 0)"
82
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   210
| "inv_loop5_loop x (l, r) = 
84
4c8325c64dab updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 83
diff changeset
   211
     (\<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))"
82
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   212
| "inv_loop5_exit x (l, r) = 
84
4c8325c64dab updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 83
diff changeset
   213
     (\<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))"
82
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   214
| "inv_loop6_loop x (l, r) = 
84
4c8325c64dab updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 83
diff changeset
   215
     (\<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))"
82
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   216
| "inv_loop6_exit x (l, r) = 
84
4c8325c64dab updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 83
diff changeset
   217
     (\<exists> i j. i + j = x \<and> j > 0 \<and> (l, r) = (Oc\<up>i, Oc#Bk\<up>j @ Oc\<up>j))"
82
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   218
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   219
fun 
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   220
  inv_loop0 :: "nat \<Rightarrow> tape \<Rightarrow> bool" and
81
2e9881578cb2 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 80
diff changeset
   221
  inv_loop1 :: "nat \<Rightarrow> tape \<Rightarrow> bool" and
2e9881578cb2 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 80
diff changeset
   222
  inv_loop2 :: "nat \<Rightarrow> tape \<Rightarrow> bool" and
2e9881578cb2 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 80
diff changeset
   223
  inv_loop3 :: "nat \<Rightarrow> tape \<Rightarrow> bool" and
2e9881578cb2 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 80
diff changeset
   224
  inv_loop4 :: "nat \<Rightarrow> tape \<Rightarrow> bool" and
82
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   225
  inv_loop5 :: "nat \<Rightarrow> tape \<Rightarrow> bool" and
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   226
  inv_loop6 :: "nat \<Rightarrow> tape \<Rightarrow> bool"
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   227
where
84
4c8325c64dab updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 83
diff changeset
   228
  "inv_loop0 x (l, r) =  ((l, r) = ([Bk], Oc # Bk\<up>x @ Oc\<up>x) \<and> x > 0)"
81
2e9881578cb2 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 80
diff changeset
   229
| "inv_loop1 x (l, r) = (inv_loop1_loop x (l, r) \<or> inv_loop1_exit x (l, r))"
84
4c8325c64dab updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 83
diff changeset
   230
| "inv_loop2 x (l, r) = (\<exists> i j any. i + j = x \<and> x > 0 \<and> i > 0 \<and> j > 0 \<and> (l, r) = (Oc\<up>i, any#Bk\<up>j@Oc\<up>j))"
81
2e9881578cb2 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 80
diff changeset
   231
| "inv_loop3 x (l, r) = 
84
4c8325c64dab updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 83
diff changeset
   232
     (\<exists> i j k t. i + j = x \<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))"
81
2e9881578cb2 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 80
diff changeset
   233
| "inv_loop4 x (l, r) = 
84
4c8325c64dab updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 83
diff changeset
   234
     (\<exists> i j k t. i + j = x \<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))"
81
2e9881578cb2 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 80
diff changeset
   235
| "inv_loop5 x (l, r) = (inv_loop5_loop x (l, r) \<or> inv_loop5_exit x (l, r))"
82
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   236
| "inv_loop6 x (l, r) = (inv_loop6_loop x (l, r) \<or> inv_loop6_exit x (l, r))"
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   237
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   238
fun inv_loop :: "nat \<Rightarrow> config \<Rightarrow> bool"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   239
  where
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   240
  "inv_loop x (s, l, r) = 
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   241
         (if s = 0 then inv_loop0 x (l, r)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   242
          else if s = 1 then inv_loop1 x (l, r)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   243
          else if s = 2 then inv_loop2 x (l, r)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   244
          else if s = 3 then inv_loop3 x (l, r)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   245
          else if s = 4 then inv_loop4 x (l, r)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   246
          else if s = 5 then inv_loop5 x (l, r)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   247
          else if s = 6 then inv_loop6 x (l, r)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   248
          else False)"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   249
       
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   250
declare inv_loop.simps[simp del] inv_loop1.simps[simp del]
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   251
        inv_loop2.simps[simp del] inv_loop3.simps[simp del] 
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   252
        inv_loop4.simps[simp del] inv_loop5.simps[simp del] 
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   253
        inv_loop6.simps[simp del]
81
2e9881578cb2 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 80
diff changeset
   254
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   255
lemma [elim]: "Bk # list = Oc \<up> t \<Longrightarrow> RR"
81
2e9881578cb2 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 80
diff changeset
   256
by (case_tac t, auto)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   257
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   258
lemma [simp]: "inv_loop1 x (b, []) = False"
82
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   259
by (simp add: inv_loop1.simps)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   260
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   261
lemma [elim]: "\<lbrakk>0 < x; inv_loop2 x (b, [])\<rbrakk> \<Longrightarrow> inv_loop3 x (Bk # b, [])"
81
2e9881578cb2 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 80
diff changeset
   262
by (auto simp: inv_loop2.simps inv_loop3.simps)
2e9881578cb2 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 80
diff changeset
   263
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   264
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   265
lemma [elim]: "\<lbrakk>0 < x; inv_loop3 x (b, [])\<rbrakk> \<Longrightarrow> inv_loop3 x (Bk # b, [])"
81
2e9881578cb2 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 80
diff changeset
   266
by (auto simp: inv_loop3.simps)
2e9881578cb2 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 80
diff changeset
   267
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   268
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   269
lemma [elim]: "\<lbrakk>0 < x; inv_loop4 x (b, [])\<rbrakk> \<Longrightarrow> inv_loop5 x (b, [Oc])"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   270
apply(auto simp: inv_loop4.simps inv_loop5.simps)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   271
apply(rule_tac [!] x = i in exI, 
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   272
      rule_tac [!] x  = "Suc j" in exI, simp_all)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   273
done
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   274
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   275
lemma [elim]: "\<lbrakk>0 < x; inv_loop5 x ([], [])\<rbrakk> \<Longrightarrow> RR"
82
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   276
by (auto simp: inv_loop4.simps inv_loop5.simps)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   277
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   278
lemma [elim]: "\<lbrakk>0 < x; inv_loop5 x (b, []); b \<noteq> []\<rbrakk> \<Longrightarrow> RR"
82
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   279
by (auto simp: inv_loop4.simps inv_loop5.simps)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   280
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   281
lemma [elim]: "inv_loop6 x ([], []) \<Longrightarrow> RR"
82
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   282
by (auto simp: inv_loop6.simps)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   283
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   284
lemma [elim]: "inv_loop6 x (b, []) \<Longrightarrow> RR" 
82
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   285
by (auto simp: inv_loop6.simps)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   286
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   287
lemma [elim]: "\<lbrakk>0 < x; inv_loop1 x (b, Bk # list)\<rbrakk> \<Longrightarrow> b = []"
82
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   288
by (auto simp: inv_loop1.simps)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   289
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   290
lemma [elim]: "\<lbrakk>0 < x; inv_loop1 x (b, Bk # list)\<rbrakk> \<Longrightarrow> list = Oc # Bk \<up> x @ Oc \<up> x"
82
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   291
by (auto simp: inv_loop1.simps)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   292
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   293
lemma [elim]: "\<lbrakk>0 < x; inv_loop2 x (b, Bk # list)\<rbrakk> \<Longrightarrow> inv_loop3 x (Bk # b, list)"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   294
apply(auto simp: inv_loop2.simps inv_loop3.simps)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   295
apply(rule_tac [!] x = i  in exI, rule_tac [!] x = j in exI, simp_all)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   296
done
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   297
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   298
lemma [elim]: "Bk # list = Oc \<up> j \<Longrightarrow> RR"
82
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   299
by (case_tac j, simp_all)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   300
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   301
lemma [elim]: "\<lbrakk>0 < x; inv_loop3 x (b, Bk # list)\<rbrakk> \<Longrightarrow> inv_loop3 x (Bk # b, list)"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   302
apply(auto simp: inv_loop3.simps)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   303
apply(rule_tac [!] x = i in exI, 
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   304
      rule_tac [!] x = j in exI, simp_all)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   305
apply(case_tac [!] t, auto)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   306
done
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   307
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   308
lemma [elim]: "\<lbrakk>0 < x; inv_loop4 x (b, Bk # list)\<rbrakk> \<Longrightarrow> inv_loop5 x (b, Oc # list)"
82
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   309
by (auto simp: inv_loop4.simps inv_loop5.simps)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   310
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   311
lemma [elim]: "\<lbrakk>0 < x; inv_loop5 x ([], Bk # list)\<rbrakk> \<Longrightarrow> inv_loop6 x ([], Bk # Bk # list)"
82
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   312
by (auto simp: inv_loop6.simps inv_loop5.simps)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   313
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   314
lemma [simp]: "inv_loop5_loop x (b, Bk # list) = False"
82
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   315
by (auto simp: inv_loop5.simps)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   316
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   317
lemma [simp]: "inv_loop6_exit x (b, Bk # list) = False"
82
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   318
by (auto simp: inv_loop6.simps)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   319
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   320
declare inv_loop5_loop.simps[simp del]  inv_loop5_exit.simps[simp del]
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   321
       inv_loop6_loop.simps[simp del]  inv_loop6_exit.simps[simp del]
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   322
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   323
lemma [elim]:"\<lbrakk>0 < x; inv_loop5_exit x (b, Bk # list); b \<noteq> []; hd b = Bk\<rbrakk> 
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   324
          \<Longrightarrow> inv_loop6_loop x (tl b, Bk # Bk # list)"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   325
apply(simp only: inv_loop5_exit.simps inv_loop6_loop.simps )
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   326
apply(erule_tac exE)+
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   327
apply(rule_tac x = i in exI, 
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   328
      rule_tac x = j in exI,
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   329
      rule_tac x = "j - Suc (Suc 0)" in exI, 
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   330
      rule_tac x = "Suc 0" in exI, auto)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   331
apply(case_tac [!] j, simp_all)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   332
apply(case_tac [!] nat, simp_all)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   333
done
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   334
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   335
lemma [simp]: "inv_loop6_loop x (b, Oc # Bk # list) = False"
82
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   336
by (auto simp: inv_loop6_loop.simps)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   337
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   338
lemma [elim]: "\<lbrakk>x > 0; inv_loop5_exit x (b, Bk # list); b \<noteq> []; hd b = Oc\<rbrakk> \<Longrightarrow> 
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   339
  inv_loop6_exit x (tl b, Oc # Bk # list)"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   340
apply(simp only: inv_loop5_exit.simps inv_loop6_exit.simps)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   341
apply(erule_tac exE)+
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   342
apply(rule_tac x = "x - 1" in exI, rule_tac x = 1 in exI, simp)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   343
apply(case_tac j, auto)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   344
apply(case_tac [!] nat, auto)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   345
done
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   346
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   347
lemma [elim]: "\<lbrakk>0 < x; inv_loop5 x (b, Bk # list); b \<noteq> []\<rbrakk> \<Longrightarrow> inv_loop6 x (tl b, hd b # Bk # list)"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   348
apply(simp add: inv_loop5.simps inv_loop6.simps)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   349
apply(case_tac "hd b", simp_all, auto)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   350
done
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   351
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   352
lemma  [simp]: "inv_loop6 x ([], Bk # xs) = False"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   353
apply(simp add: inv_loop6.simps inv_loop6_loop.simps
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   354
                inv_loop6_exit.simps)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   355
apply(auto)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   356
done
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   357
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   358
lemma [elim]: "\<lbrakk>0 < x; inv_loop6 x ([], Bk # list)\<rbrakk> \<Longrightarrow> inv_loop6 x ([], Bk # Bk # list)"
82
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   359
by (simp)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   360
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   361
lemma [simp]: "inv_loop6_exit x (b, Bk # list) = False"
82
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   362
by (simp add: inv_loop6_exit.simps)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   363
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   364
lemma [elim]: "\<lbrakk>0 < x; inv_loop6_loop x (b, Bk # list); b \<noteq> []; hd b = Bk\<rbrakk>
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   365
              \<Longrightarrow> inv_loop6_loop x (tl b, Bk # Bk # list)"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   366
apply(simp only: inv_loop6_loop.simps)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   367
apply(erule_tac exE)+
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   368
apply(rule_tac x = i in exI, rule_tac x = j in exI, 
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   369
      rule_tac x = "k - 1" in exI, rule_tac x = "Suc t" in exI, auto)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   370
apply(case_tac [!] k, auto)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   371
done
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   372
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   373
lemma [elim]: "\<lbrakk>0 < x; inv_loop6_loop x (b, Bk # list); b \<noteq> []; hd b = Oc\<rbrakk> 
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   374
        \<Longrightarrow> inv_loop6_exit x (tl b, Oc # Bk # list)"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   375
apply(simp only: inv_loop6_loop.simps inv_loop6_exit.simps)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   376
apply(erule_tac exE)+
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   377
apply(rule_tac x = "i - 1" in exI, rule_tac x = j in exI, auto)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   378
apply(case_tac [!] k, auto)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   379
done
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   380
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   381
lemma [elim]: "\<lbrakk>0 < x; inv_loop6 x (b, Bk # list); b \<noteq> []\<rbrakk> \<Longrightarrow> inv_loop6 x (tl b, hd b # Bk # list)"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   382
apply(simp add: inv_loop6.simps)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   383
apply(case_tac "hd b", simp_all, auto)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   384
done
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   385
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   386
lemma [elim]: "\<lbrakk>0 < x; inv_loop1 x (b, Oc # list)\<rbrakk> \<Longrightarrow> inv_loop2 x (Oc # b, list)"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   387
apply(auto simp: inv_loop1.simps inv_loop2.simps)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   388
apply(rule_tac x = "Suc i" in exI, auto)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   389
done
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   390
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   391
lemma [elim]: "\<lbrakk>0 < x; inv_loop2 x (b, Oc # list)\<rbrakk> \<Longrightarrow> inv_loop2 x (b, Bk # list)"
82
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   392
by (auto simp: inv_loop2.simps)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   393
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   394
lemma [elim]: "\<lbrakk>0 < x; inv_loop3 x (b, Oc # list)\<rbrakk> \<Longrightarrow> inv_loop4 x (Oc # b, list)"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   395
apply(auto simp: inv_loop3.simps inv_loop4.simps)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   396
apply(rule_tac [!] x = i in exI, auto)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   397
apply(rule_tac [!] x = "Suc 0" in exI, rule_tac [!] x = "j - 1" in exI, auto)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   398
apply(case_tac [!] t, auto)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   399
apply(case_tac [!] j, auto)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   400
done
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   401
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   402
lemma [elim]: "\<lbrakk>0 < x; inv_loop4 x (b, Oc # list)\<rbrakk> \<Longrightarrow> inv_loop4 x (Oc # b, list)"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   403
apply(auto simp: inv_loop4.simps)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   404
apply(rule_tac [!] x = "i" in exI, auto)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   405
apply(rule_tac [!] x = "Suc k" in exI, rule_tac [!] x = "t - 1" in exI, auto)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   406
apply(case_tac [!] t, simp_all)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   407
done
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   408
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   409
lemma [simp]: "inv_loop5 x ([], list) = False"
82
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   410
by (auto simp: inv_loop5.simps inv_loop5_exit.simps inv_loop5_loop.simps)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   411
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   412
lemma [simp]: "inv_loop5_exit x (b, Oc # list) = False"
82
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   413
by (auto simp: inv_loop5_exit.simps)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   414
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   415
lemma [elim]: " \<lbrakk>inv_loop5_loop x (b, Oc # list); b \<noteq> []; hd b = Bk\<rbrakk>
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   416
  \<Longrightarrow> inv_loop5_exit x (tl b, Bk # Oc # list)"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   417
apply(simp only: inv_loop5_loop.simps inv_loop5_exit.simps)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   418
apply(erule_tac exE)+
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   419
apply(rule_tac x = i in exI, auto)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   420
apply(case_tac [!] k, auto)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   421
done
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   422
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   423
lemma [elim]: "\<lbrakk>inv_loop5_loop x (b, Oc # list); b \<noteq> []; hd b = Oc\<rbrakk> 
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   424
           \<Longrightarrow> inv_loop5_loop x (tl b, Oc # Oc # list)"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   425
apply(simp only:  inv_loop5_loop.simps)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   426
apply(erule_tac exE)+
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   427
apply(rule_tac x = i in exI, rule_tac x = j in exI)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   428
apply(rule_tac x = "k - 1" in exI, rule_tac x = "Suc t" in exI, auto)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   429
apply(case_tac [!] k, auto)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   430
done
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   431
82
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   432
lemma [elim]: "\<lbrakk>inv_loop5 x (b, Oc # list); b \<noteq> []\<rbrakk> \<Longrightarrow> inv_loop5 x (tl b, hd b # Oc # list)"
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   433
apply(simp add: inv_loop5.simps)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   434
apply(case_tac "hd b", simp_all, auto)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   435
done
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   436
82
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   437
lemma [elim]: "\<lbrakk>0 < x; inv_loop6 x ([], Oc # list)\<rbrakk> \<Longrightarrow> inv_loop1 x ([], Bk # Oc # list)"
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   438
apply(auto simp: inv_loop6.simps inv_loop1.simps 
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   439
  inv_loop6_loop.simps inv_loop6_exit.simps)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   440
done
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   441
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   442
lemma [elim]: "\<lbrakk>0 < x; inv_loop6 x (b, Oc # list); b \<noteq> []\<rbrakk> 
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   443
           \<Longrightarrow> inv_loop1 x (tl b, hd b # Oc # list)"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   444
apply(auto simp: inv_loop6.simps inv_loop1.simps 
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   445
  inv_loop6_loop.simps inv_loop6_exit.simps)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   446
done
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   447
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   448
lemma inv_loop_step: 
82
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   449
  "\<lbrakk>inv_loop x cf; x > 0\<rbrakk> \<Longrightarrow> inv_loop x (step cf (tcopy_loop, 0))"
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   450
apply(case_tac cf, case_tac c, case_tac [2] aa)
63
35fe8fe12e65 small updates
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 61
diff changeset
   451
apply(auto simp: inv_loop.simps step.simps tcopy_loop_def numeral split: if_splits)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   452
done
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   453
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   454
lemma inv_loop_steps:
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   455
  "\<lbrakk>inv_loop x cf; x > 0\<rbrakk>
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   456
  \<Longrightarrow> inv_loop x (steps cf (tcopy_loop, 0) stp)"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   457
apply(induct stp, simp add: steps.simps, simp)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   458
apply(erule_tac inv_loop_step, simp)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   459
done
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   460
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   461
fun loop_stage :: "config \<Rightarrow> nat"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   462
  where
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   463
  "loop_stage (s, l, r) = (if s = 0 then 0
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   464
                           else (Suc (length (takeWhile (\<lambda>a. a = Oc) (rev l @ r)))))"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   465
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   466
fun loop_state :: "config \<Rightarrow> nat"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   467
  where
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   468
  "loop_state (s, l, r) = (if s = 2 \<and> hd r = Oc then 0
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   469
                           else if s = 1 then 1
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   470
                           else 10 - s)"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   471
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   472
fun loop_step :: "config \<Rightarrow> nat"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   473
  where
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   474
  "loop_step (s, l, r) = (if s = 3 then length r
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   475
                          else if s = 4 then length r
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   476
                          else if s = 5 then length l 
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   477
                          else if s = 6 then length l
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   478
                          else 0)"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   479
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   480
definition lex_triple :: 
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   481
 "((nat \<times> (nat \<times> nat)) \<times> (nat \<times> (nat \<times> nat))) set"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   482
  where
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   483
  "lex_triple \<equiv> less_than <*lex*> lex_pair"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   484
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   485
lemma wf_lex_triple: "wf lex_triple"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   486
  by (auto intro:wf_lex_prod simp:lex_triple_def lex_pair_def)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   487
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   488
fun loop_measure :: "config \<Rightarrow> nat \<times> nat \<times> nat"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   489
  where
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   490
  "loop_measure c = 
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   491
   (loop_stage c, loop_state c, loop_step c)"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   492
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   493
definition loop_LE :: "(config \<times> config) set"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   494
  where
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   495
   "loop_LE \<equiv> (inv_image lex_triple loop_measure)"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   496
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   497
lemma wf_loop_le: "wf loop_LE"
82
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   498
by (auto intro:wf_inv_image simp: loop_LE_def wf_lex_triple)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   499
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   500
lemma [simp]: "inv_loop2 x ([], b) = False"
82
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   501
by (auto simp: inv_loop2.simps)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   502
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   503
lemma  [simp]: "inv_loop2 x (l', []) = False"
82
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   504
by (auto simp: inv_loop2.simps)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   505
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   506
lemma [simp]: "inv_loop3 x (b, []) = False"
82
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   507
by (auto simp: inv_loop3.simps)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   508
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   509
lemma [simp]: "inv_loop4 x ([], b) = False"
82
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   510
by (auto simp: inv_loop4.simps)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   511
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   512
lemma [elim]: 
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   513
  "\<lbrakk>inv_loop4 x (l', []); l' \<noteq> []; x > 0;
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   514
  length (takeWhile (\<lambda>a. a = Oc) (rev l' @ [Oc])) \<noteq> 
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   515
  length (takeWhile (\<lambda>a. a = Oc) (rev l'))\<rbrakk>
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   516
  \<Longrightarrow> length (takeWhile (\<lambda>a. a = Oc) (rev l' @ [Oc])) < length (takeWhile (\<lambda>a. a = Oc) (rev l'))"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   517
apply(auto simp: inv_loop4.simps)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   518
apply(case_tac [!] j, simp_all add: List.takeWhile_tail)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   519
done
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   520
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   521
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   522
lemma [elim]: 
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   523
  "\<lbrakk>inv_loop4 x (l', Bk # list); l' \<noteq> []; 0 < x;
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   524
   length (takeWhile (\<lambda>a. a = Oc) (rev l' @ Oc # list)) \<noteq> 
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   525
    length (takeWhile (\<lambda>a. a = Oc) (rev l' @ Bk # list))\<rbrakk>
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   526
    \<Longrightarrow> length (takeWhile (\<lambda>a. a = Oc) (rev l' @ Oc # list)) < 
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   527
    length (takeWhile (\<lambda>a. a = Oc) (rev l' @ Bk # list))"
82
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   528
by (auto simp: inv_loop4.simps)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   529
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   530
lemma takeWhile_replicate_append: 
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   531
  "P a \<Longrightarrow> takeWhile P (a\<up>x @ ys) = a\<up>x @ takeWhile P ys"
82
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   532
by (induct x, auto)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   533
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   534
lemma takeWhile_replicate: 
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   535
  "P a \<Longrightarrow> takeWhile P (a\<up>x) = a\<up>x"
82
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   536
by (induct x, auto)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   537
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   538
lemma [elim]: 
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   539
   "\<lbrakk>inv_loop5 x (l', Bk # list); l' \<noteq> []; 0 < x;
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   540
   length (takeWhile (\<lambda>a. a = Oc) (rev (tl l') @ hd l' # Bk # list)) \<noteq>
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   541
   length (takeWhile (\<lambda>a. a = Oc) (rev l' @ Bk # list))\<rbrakk>
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   542
   \<Longrightarrow> length (takeWhile (\<lambda>a. a = Oc) (rev (tl l') @ hd l' # Bk # list)) < 
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   543
   length (takeWhile (\<lambda>a. a = Oc) (rev l' @ Bk # list))"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   544
apply(auto simp: inv_loop5.simps inv_loop5_exit.simps)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   545
apply(case_tac [!] j, simp_all)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   546
apply(case_tac [!] "nat", simp_all)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   547
apply(case_tac  nata, simp_all add: List.takeWhile_tail)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   548
apply(simp add: takeWhile_replicate_append takeWhile_replicate)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   549
apply(case_tac  nata, simp_all add: List.takeWhile_tail)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   550
done
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   551
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   552
lemma [elim]: "\<lbrakk>inv_loop1 x (l', Oc # list)\<rbrakk> \<Longrightarrow> hd list = Oc"
82
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   553
by (auto simp: inv_loop1.simps)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   554
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   555
lemma [elim]: 
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   556
  "\<lbrakk>inv_loop6 x (l', Bk # list); l' \<noteq> []; 0 < x;
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   557
  length (takeWhile (\<lambda>a. a = Oc) (rev (tl l') @ hd l' # Bk # list)) \<noteq> 
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   558
  length (takeWhile (\<lambda>a. a = Oc) (rev l' @ Bk # list))\<rbrakk>
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   559
  \<Longrightarrow> length (takeWhile (\<lambda>a. a = Oc) (rev (tl l') @ hd l' # Bk # list)) < 
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   560
  length (takeWhile (\<lambda>a. a = Oc) (rev l' @ Bk # list))"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   561
apply(auto simp: inv_loop6.simps)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   562
apply(case_tac l', simp_all)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   563
done
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   564
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   565
lemma [elim]:
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   566
  "\<lbrakk>inv_loop2 x (l', Oc # list); l' \<noteq> []; 0 < x\<rbrakk> \<Longrightarrow> 
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   567
  length (takeWhile (\<lambda>a. a = Oc) (rev l' @ Bk # list)) <
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   568
  length (takeWhile (\<lambda>a. a = Oc) (rev l' @ Oc # list))"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   569
apply(auto simp: inv_loop2.simps)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   570
apply(simp_all add: takeWhile_tail takeWhile_replicate_append
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   571
                takeWhile_replicate)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   572
done
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   573
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   574
lemma [elim]: 
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   575
  "\<lbrakk>inv_loop5 x (l', Oc # list); l' \<noteq> []; 0 < x;
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   576
  length (takeWhile (\<lambda>a. a = Oc) (rev (tl l') @ hd l' # Oc # list)) \<noteq> 
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   577
  length (takeWhile (\<lambda>a. a = Oc) (rev l' @ Oc # list))\<rbrakk>
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   578
  \<Longrightarrow> length (takeWhile (\<lambda>a. a = Oc) (rev (tl l') @ hd l' # Oc # list)) < 
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   579
  length (takeWhile (\<lambda>a. a = Oc) (rev l' @ Oc # list))"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   580
apply(auto simp: inv_loop5.simps)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   581
apply(case_tac l', auto)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   582
done
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   583
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   584
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   585
lemma[elim]: 
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   586
  "\<lbrakk>inv_loop6 x (l', Oc # list); l' \<noteq> []; 0 < x;
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   587
  length (takeWhile (\<lambda>a. a = Oc) (rev (tl l') @ hd l' # Oc # list))
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   588
  \<noteq> length (takeWhile (\<lambda>a. a = Oc) (rev l' @ Oc # list))\<rbrakk>
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   589
  \<Longrightarrow> length (takeWhile (\<lambda>a. a = Oc) (rev (tl l') @ hd l' # Oc # list)) < 
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   590
      length (takeWhile (\<lambda>a. a = Oc) (rev l' @ Oc # list))"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   591
apply(case_tac l')
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   592
apply(auto simp: inv_loop6.simps)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   593
done
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   594
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   595
lemma loop_halt: 
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   596
  "\<lbrakk>x > 0; inv_loop x (Suc 0, l, r)\<rbrakk> \<Longrightarrow> 
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   597
      \<exists> stp. is_final (steps (Suc 0, l, r) (tcopy_loop, 0) stp)"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   598
proof(rule_tac LE = loop_LE in halt_lemma)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   599
  show "wf loop_LE" by(intro wf_loop_le)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   600
next
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   601
  assume h: "0 < x"  and g: "inv_loop x (Suc 0, l, r)"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   602
  show "\<forall>n. \<not> is_final (steps (Suc 0, l, r) (tcopy_loop, 0) n) \<longrightarrow> 
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   603
        (steps (Suc 0, l, r) (tcopy_loop, 0) (Suc n), steps (Suc 0, l, r) (tcopy_loop, 0) n) \<in> loop_LE"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   604
  proof(rule_tac allI, rule_tac impI)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   605
    fix n
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   606
    assume a: "\<not> is_final (steps (Suc 0, l, r) (tcopy_loop, 0) n)"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   607
    obtain s' l' r' where d: "(steps (Suc 0, l, r) (tcopy_loop, 0) n) = (s', l', r')"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   608
      by(case_tac "(steps (Suc 0, l, r) (tcopy_loop, 0) n)", auto)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   609
    hence "inv_loop x (s', l', r') \<and> s' \<noteq> 0"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   610
      using h g
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   611
      apply(drule_tac stp = n in inv_loop_steps, auto)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   612
      using a
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   613
      apply(simp)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   614
      done
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   615
    hence "(step(s', l', r') (tcopy_loop, 0), s', l', r') \<in> loop_LE"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   616
      using h 
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   617
      apply(case_tac r', case_tac [2] a)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   618
      apply(auto simp: inv_loop.simps step.simps tcopy_loop_def 
63
35fe8fe12e65 small updates
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 61
diff changeset
   619
                       numeral loop_LE_def lex_triple_def lex_pair_def split: if_splits)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   620
      done
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   621
    thus "(steps (Suc 0, l, r) (tcopy_loop, 0) (Suc n), 
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   622
          steps (Suc 0, l, r) (tcopy_loop, 0) n) \<in> loop_LE"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   623
      using d
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   624
      apply(simp add: step_red)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   625
      done
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   626
  qed
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   627
qed
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   628
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   629
lemma loop_correct:
54
e7d845acb0a7 changed slightly HOARE-def
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 47
diff changeset
   630
  "x > 0 \<Longrightarrow> {inv_loop1 x} tcopy_loop {inv_loop0 x}"
71
8c7f10b3da7b updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 70
diff changeset
   631
proof(rule_tac Hoare_haltI)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   632
  fix l r
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   633
  assume h: "0 < x"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   634
    "inv_loop1 x (l, r)"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   635
  hence "\<exists> stp. is_final (steps (Suc 0, l, r) (tcopy_loop, 0) stp)"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   636
    apply(rule_tac loop_halt, simp_all add: inv_loop.simps)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   637
    done
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   638
  then obtain stp where "is_final (steps (Suc 0, l, r) (tcopy_loop, 0) stp)" ..
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   639
  moreover have "inv_loop x (steps (Suc 0, l, r) (tcopy_loop, 0) stp)"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   640
    apply(rule_tac inv_loop_steps)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   641
    using h by(simp_all add: inv_loop.simps)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   642
  ultimately show
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   643
    "\<exists>n. is_final (steps (1, l, r) (tcopy_loop, 0) n) \<and> 
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   644
    inv_loop0 x holds_for steps (1, l, r) (tcopy_loop, 0) n"    
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   645
    using h
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   646
    apply(rule_tac x = stp in exI)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   647
    apply(case_tac "(steps (Suc 0, l, r) (tcopy_loop, 0) stp)", 
89
c67e8ed4c865 updated uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 84
diff changeset
   648
      simp add: inv_begin.simps inv_loop.simps)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   649
    done
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   650
qed
68
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 67
diff changeset
   651
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 67
diff changeset
   652
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 67
diff changeset
   653
(* tcopy_end *)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   654
82
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   655
fun
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   656
  inv_end5_loop :: "nat \<Rightarrow> tape \<Rightarrow> bool" and
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   657
  inv_end5_exit :: "nat \<Rightarrow> tape \<Rightarrow> bool" 
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   658
where  
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   659
  "inv_end5_loop x (l, r) = 
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   660
     (\<exists> i j. i + j = x \<and> x > 0 \<and> j > 0 \<and> l = Oc\<up>i @ [Bk] \<and> r = Oc\<up>j @ Bk # Oc\<up>x)"
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   661
| "inv_end5_exit x (l, r) = (x > 0 \<and> l = [] \<and> r = Bk # Oc\<up>x @ Bk # Oc\<up>x)"
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   662
82
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   663
fun 
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   664
  inv_end0 :: "nat \<Rightarrow> tape \<Rightarrow>  bool" and
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   665
  inv_end1 :: "nat \<Rightarrow> tape \<Rightarrow> bool" and
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   666
  inv_end2 :: "nat \<Rightarrow> tape \<Rightarrow> bool" and
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   667
  inv_end3 :: "nat \<Rightarrow> tape \<Rightarrow> bool" and
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   668
  inv_end4 :: "nat \<Rightarrow> tape \<Rightarrow> bool" and
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   669
 
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   670
  inv_end5 :: "nat \<Rightarrow> tape \<Rightarrow> bool" 
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   671
where
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   672
  "inv_end0 x (l, r) = (x > 0 \<and> l = [Bk] \<and> r = Oc\<up>x @ Bk # Oc\<up>x)"
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   673
| "inv_end1 x (l, r) = (x > 0 \<and> l = [Bk] \<and> r = Oc # Bk\<up>x @ Oc\<up>x)"
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   674
| "inv_end2 x (l, r) = (\<exists> i j. i + j = Suc x \<and> x > 0 \<and> l = Oc\<up>i @ [Bk] \<and> r = Bk\<up>j @ Oc\<up>x)"
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   675
| "inv_end3 x (l, r) =
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   676
     (\<exists> i j. x > 0 \<and> i + j = x \<and> l = Oc\<up>i @ [Bk] \<and> r = Oc # Bk\<up>j@ Oc\<up>x)"
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   677
| "inv_end4 x (l, r) = (\<exists> any. x > 0 \<and> l = Oc\<up>x @ [Bk] \<and> r = any#Oc\<up>x)"
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   678
| "inv_end5 x (l, r) = (inv_end5_loop x (l, r) \<or> inv_end5_exit x (l, r))"
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   679
82
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   680
fun 
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   681
  inv_end :: "nat \<Rightarrow> config \<Rightarrow> bool"
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   682
where
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   683
  "inv_end x (s, l, r) = (if s = 0 then inv_end0 x (l, r)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   684
                          else if s = 1 then inv_end1 x (l, r)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   685
                          else if s = 2 then inv_end2 x (l, r)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   686
                          else if s = 3 then inv_end3 x (l, r)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   687
                          else if s = 4 then inv_end4 x (l, r)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   688
                          else if s = 5 then inv_end5 x (l, r)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   689
                          else False)"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   690
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   691
declare inv_end.simps[simp del] inv_end1.simps[simp del]
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   692
        inv_end0.simps[simp del] inv_end2.simps[simp del]
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   693
        inv_end3.simps[simp del] inv_end4.simps[simp del]
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   694
        inv_end5.simps[simp del]
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   695
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   696
lemma [simp]:  "inv_end1 x (b, []) = False"
82
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   697
by (auto simp: inv_end1.simps)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   698
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   699
lemma [simp]: "inv_end2 x (b, []) = False"
82
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   700
by (auto simp: inv_end2.simps)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   701
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   702
lemma [simp]: "inv_end3 x (b, []) = False"
82
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   703
by (auto simp: inv_end3.simps)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   704
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   705
lemma [simp]: "inv_end4 x (b, []) = False"
82
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   706
by (auto simp: inv_end4.simps)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   707
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   708
lemma [simp]: "inv_end5 x (b, []) = False"
82
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   709
by (auto simp: inv_end5.simps)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   710
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   711
lemma [simp]: "inv_end1 x ([], list) = False"
82
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   712
by (auto simp: inv_end1.simps)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   713
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   714
lemma [elim]: "\<lbrakk>0 < x; inv_end1 x (b, Bk # list); b \<noteq> []\<rbrakk>
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   715
  \<Longrightarrow> inv_end0 x (tl b, hd b # Bk # list)"
82
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   716
by (auto simp: inv_end1.simps inv_end0.simps)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   717
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   718
lemma [elim]: "\<lbrakk>0 < x; inv_end2 x (b, Bk # list)\<rbrakk> 
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   719
  \<Longrightarrow> inv_end3 x (b, Oc # list)"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   720
apply(auto simp: inv_end2.simps inv_end3.simps)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   721
apply(rule_tac x = "j - 1" in exI)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   722
apply(case_tac j, simp_all)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   723
apply(case_tac x, simp_all)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   724
done
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   725
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   726
lemma [elim]: "\<lbrakk>0 < x; inv_end3 x (b, Bk # list)\<rbrakk> \<Longrightarrow> inv_end2 x (Bk # b, list)"
82
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   727
by (auto simp: inv_end2.simps inv_end3.simps)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   728
  
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   729
lemma [elim]: "\<lbrakk>0 < x; inv_end4 x ([], Bk # list)\<rbrakk> \<Longrightarrow> 
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   730
  inv_end5 x ([], Bk # Bk # list)"
82
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   731
by (auto simp: inv_end4.simps inv_end5.simps)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   732
 
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   733
lemma [elim]: "\<lbrakk>0 < x; inv_end4 x (b, Bk # list); b \<noteq> []\<rbrakk> \<Longrightarrow> 
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   734
  inv_end5 x (tl b, hd b # Bk # list)"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   735
apply(auto simp: inv_end4.simps inv_end5.simps)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   736
apply(rule_tac x = 1 in exI, simp)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   737
done
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   738
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   739
lemma [elim]: "\<lbrakk>0 < x; inv_end5 x (b, Bk # list)\<rbrakk> \<Longrightarrow> inv_end0 x (Bk # b, list)"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   740
apply(auto simp: inv_end5.simps inv_end0.simps)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   741
apply(case_tac [!] j, simp_all)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   742
done
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   743
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   744
lemma [elim]: "\<lbrakk>0 < x; inv_end1 x (b, Oc # list)\<rbrakk> \<Longrightarrow> inv_end2 x (Oc # b, list)"
82
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   745
by (auto simp: inv_end1.simps inv_end2.simps)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   746
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   747
lemma [elim]: "\<lbrakk>0 < x; inv_end2 x ([], Oc # list)\<rbrakk> \<Longrightarrow>
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   748
               inv_end4 x ([], Bk # Oc # list)"
82
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   749
by (auto simp: inv_end2.simps inv_end4.simps)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   750
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   751
lemma [elim]:  "\<lbrakk>0 < x; inv_end2 x (b, Oc # list); b \<noteq> []\<rbrakk> \<Longrightarrow>
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   752
  inv_end4 x (tl b, hd b # Oc # list)"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   753
apply(auto simp: inv_end2.simps inv_end4.simps)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   754
apply(case_tac [!] j, simp_all)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   755
done
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   756
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   757
lemma [elim]: "\<lbrakk>0 < x; inv_end3 x (b, Oc # list)\<rbrakk> \<Longrightarrow> inv_end2 x (Oc # b, list)"
82
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   758
by (auto simp: inv_end2.simps inv_end3.simps)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   759
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   760
lemma [elim]: "\<lbrakk>0 < x; inv_end4 x (b, Oc # list)\<rbrakk> \<Longrightarrow> inv_end4 x (b, Bk # list)"
82
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   761
by (auto simp: inv_end2.simps inv_end4.simps)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   762
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   763
lemma [elim]: "\<lbrakk>0 < x; inv_end5 x ([], Oc # list)\<rbrakk> \<Longrightarrow> inv_end5 x ([], Bk # Oc # list)"
82
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   764
by (auto simp: inv_end2.simps inv_end5.simps)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   765
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   766
declare inv_end5_loop.simps[simp del]
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   767
        inv_end5_exit.simps[simp del]
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   768
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   769
lemma [simp]: "inv_end5_exit x (b, Oc # list) = False"
82
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   770
by (auto simp: inv_end5_exit.simps)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   771
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   772
lemma [simp]: "inv_end5_loop x (tl b, Bk # Oc # list) = False"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   773
apply(auto simp: inv_end5_loop.simps)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   774
apply(case_tac [!] j, simp_all)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   775
done
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   776
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   777
lemma [elim]:
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   778
  "\<lbrakk>0 < x; inv_end5_loop x (b, Oc # list); b \<noteq> []; hd b = Bk\<rbrakk> \<Longrightarrow>
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   779
  inv_end5_exit x (tl b, Bk # Oc # list)"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   780
apply(auto simp: inv_end5_loop.simps inv_end5_exit.simps)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   781
apply(case_tac [!] i, simp_all)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   782
done
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   783
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   784
lemma [elim]: 
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   785
  "\<lbrakk>0 < x; inv_end5_loop x (b, Oc # list); b \<noteq> []; hd b = Oc\<rbrakk> \<Longrightarrow>
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   786
  inv_end5_loop x (tl b, Oc # Oc # list)"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   787
apply(simp only: inv_end5_loop.simps inv_end5_exit.simps)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   788
apply(erule_tac exE)+
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   789
apply(rule_tac x = "i - 1" in exI, 
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   790
      rule_tac x = "Suc j" in exI, auto)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   791
apply(case_tac [!] i, simp_all)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   792
done
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   793
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   794
lemma [elim]: "\<lbrakk>0 < x; inv_end5 x (b, Oc # list); b \<noteq> []\<rbrakk> \<Longrightarrow> 
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   795
  inv_end5 x (tl b, hd b # Oc # list)"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   796
apply(simp add: inv_end2.simps inv_end5.simps)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   797
apply(case_tac "hd b", simp_all, auto)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   798
done
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   799
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   800
lemma inv_end_step:
82
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   801
  "\<lbrakk>x > 0; inv_end x cf\<rbrakk> \<Longrightarrow> inv_end x (step cf (tcopy_end, 0))"
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   802
apply(case_tac cf, case_tac c, case_tac [2] aa)
63
35fe8fe12e65 small updates
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 61
diff changeset
   803
apply(auto simp: inv_end.simps step.simps tcopy_end_def numeral split: if_splits)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   804
done
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   805
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   806
lemma inv_end_steps:
82
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   807
  "\<lbrakk>x > 0; inv_end x cf\<rbrakk> \<Longrightarrow> inv_end x (steps cf (tcopy_end, 0) stp)"
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   808
apply(induct stp, simp add:steps.simps, simp)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   809
apply(erule_tac inv_end_step, simp)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   810
done
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   811
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   812
fun end_state :: "config \<Rightarrow> nat"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   813
  where
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   814
  "end_state (s, l, r) = 
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   815
       (if s = 0 then 0
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   816
        else if s = 1 then 5
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   817
        else if s = 2 \<or> s = 3 then 4
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   818
        else if s = 4 then 3 
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   819
        else if s = 5 then 2
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   820
        else 0)"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   821
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   822
fun end_stage :: "config \<Rightarrow> nat"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   823
  where
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   824
  "end_stage (s, l, r) = 
82
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   825
          (if s = 2 \<or> s = 3 then (length r) else 0)"
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   826
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   827
fun end_step :: "config \<Rightarrow> nat"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   828
  where
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   829
  "end_step (s, l, r) = 
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   830
         (if s = 4 then (if hd r = Oc then 1 else 0)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   831
          else if s = 5 then length l
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   832
          else if s = 2 then 1
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   833
          else if s = 3 then 0
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   834
          else 0)"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   835
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   836
fun end_measure :: "config \<Rightarrow> nat \<times> nat \<times> nat"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   837
  where
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   838
  "end_measure c = 
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   839
   (end_state c, end_stage c, end_step c)"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   840
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   841
definition end_LE :: "(config \<times> config) set"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   842
  where
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   843
   "end_LE \<equiv> (inv_image lex_triple end_measure)"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   844
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   845
lemma wf_end_le: "wf end_LE"
82
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   846
by (auto intro: wf_inv_image simp: end_LE_def wf_lex_triple)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   847
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   848
lemma [simp]: "inv_end5 x ([], Oc # list) = False"
82
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   849
by (auto simp: inv_end5.simps inv_end5_loop.simps)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   850
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   851
lemma end_halt: 
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   852
  "\<lbrakk>x > 0; inv_end x (Suc 0, l, r)\<rbrakk> \<Longrightarrow> 
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   853
      \<exists> stp. is_final (steps (Suc 0, l, r) (tcopy_end, 0) stp)"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   854
proof(rule_tac LE = end_LE in halt_lemma)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   855
  show "wf end_LE" by(intro wf_end_le)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   856
next
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   857
  assume great: "0 < x"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   858
    and inv_start: "inv_end x (Suc 0, l, r)"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   859
  show "\<forall>n. \<not> is_final (steps (Suc 0, l, r) (tcopy_end, 0) n) \<longrightarrow> 
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   860
    (steps (Suc 0, l, r) (tcopy_end, 0) (Suc n), steps (Suc 0, l, r) (tcopy_end, 0) n) \<in> end_LE"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   861
  proof(rule_tac allI, rule_tac impI)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   862
    fix n
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   863
    assume notfinal: "\<not> is_final (steps (Suc 0, l, r) (tcopy_end, 0) n)"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   864
    obtain s' l' r' where d: "steps (Suc 0, l, r) (tcopy_end, 0) n = (s', l', r')"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   865
      apply(case_tac "steps (Suc 0, l, r) (tcopy_end, 0) n", auto)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   866
      done
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   867
    hence "inv_end x (s', l', r') \<and> s' \<noteq> 0"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   868
      using great inv_start notfinal
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   869
      apply(drule_tac stp = n in inv_end_steps, auto)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   870
      done
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   871
    hence "(step (s', l', r') (tcopy_end, 0), s', l', r') \<in> end_LE"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   872
      apply(case_tac r', case_tac [2] a)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   873
      apply(auto simp: inv_end.simps step.simps tcopy_end_def 
63
35fe8fe12e65 small updates
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 61
diff changeset
   874
                       numeral end_LE_def lex_triple_def lex_pair_def split: if_splits)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   875
      done
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   876
    thus "(steps (Suc 0, l, r) (tcopy_end, 0) (Suc n), 
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   877
      steps (Suc 0, l, r) (tcopy_end, 0) n) \<in> end_LE"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   878
      using d
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   879
      by simp
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   880
  qed
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   881
qed
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   882
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   883
lemma end_correct:
54
e7d845acb0a7 changed slightly HOARE-def
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 47
diff changeset
   884
  "x > 0 \<Longrightarrow> {inv_end1 x} tcopy_end {inv_end0 x}"
71
8c7f10b3da7b updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 70
diff changeset
   885
proof(rule_tac Hoare_haltI)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   886
  fix l r
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   887
  assume h: "0 < x"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   888
    "inv_end1 x (l, r)"
93
f2bda6ba4952 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 92
diff changeset
   889
  then have "\<exists> stp. is_final (steps0 (1, l, r) tcopy_end stp)"
f2bda6ba4952 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 92
diff changeset
   890
    by (simp add: end_halt inv_end.simps)
f2bda6ba4952 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 92
diff changeset
   891
  then obtain stp where "is_final (steps0 (1, l, r) tcopy_end stp)" ..
f2bda6ba4952 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 92
diff changeset
   892
  moreover have "inv_end x (steps0 (1, l, r) tcopy_end stp)"
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   893
    apply(rule_tac inv_end_steps)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   894
    using h by(simp_all add: inv_end.simps)
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   895
  ultimately show
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   896
    "\<exists>n. is_final (steps (1, l, r) (tcopy_end, 0) n) \<and> 
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   897
    inv_end0 x holds_for steps (1, l, r) (tcopy_end, 0) n"        
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   898
    using h
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   899
    apply(rule_tac x = stp in exI)
93
f2bda6ba4952 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 92
diff changeset
   900
    apply(case_tac "(steps0 (1, l, r) tcopy_end stp)") 
f2bda6ba4952 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 92
diff changeset
   901
    apply(simp add: inv_end.simps)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   902
    done
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   903
qed
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   904
68
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 67
diff changeset
   905
(* tcopy *)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   906
89
c67e8ed4c865 updated uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 84
diff changeset
   907
lemma [intro]: "tm_wf (tcopy_begin, 0)"
c67e8ed4c865 updated uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 84
diff changeset
   908
by (auto simp: tm_wf.simps tcopy_begin_def)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   909
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   910
lemma [intro]: "tm_wf (tcopy_loop, 0)"
82
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   911
by (auto simp: tm_wf.simps tcopy_loop_def)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   912
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   913
lemma [intro]: "tm_wf (tcopy_end, 0)"
82
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
   914
by (auto simp: tm_wf.simps tcopy_end_def)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   915
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   916
lemma tcopy_correct1: 
93
f2bda6ba4952 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 92
diff changeset
   917
  assumes "0 < x"
f2bda6ba4952 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 92
diff changeset
   918
  shows "{inv_begin1 x} tcopy {inv_end0 x}"
f2bda6ba4952 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 92
diff changeset
   919
proof -
f2bda6ba4952 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 92
diff changeset
   920
  have "{inv_begin1 x} tcopy_begin {inv_begin0 x}"
94
aeaf1374dc67 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 93
diff changeset
   921
    by (metis assms begin_correct) 
93
f2bda6ba4952 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 92
diff changeset
   922
  moreover
f2bda6ba4952 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 92
diff changeset
   923
  have "{inv_loop1 x} tcopy_loop {inv_loop0 x}"
f2bda6ba4952 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 92
diff changeset
   924
    by (metis assms loop_correct) 
f2bda6ba4952 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 92
diff changeset
   925
  moreover
f2bda6ba4952 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 92
diff changeset
   926
  have "inv_begin0 x \<mapsto> inv_loop1 x"
f2bda6ba4952 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 92
diff changeset
   927
    by (auto simp: inv_begin0.simps inv_loop1.simps assert_imp_def)
f2bda6ba4952 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 92
diff changeset
   928
       (rule_tac x = "Suc 0" in exI, auto)
f2bda6ba4952 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 92
diff changeset
   929
  ultimately 
f2bda6ba4952 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 92
diff changeset
   930
  have "{inv_begin1 x} (tcopy_begin |+| tcopy_loop) {inv_loop0 x}"
f2bda6ba4952 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 92
diff changeset
   931
    by (rule_tac Hoare_plus_halt) (auto)
f2bda6ba4952 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 92
diff changeset
   932
  moreover 
f2bda6ba4952 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 92
diff changeset
   933
  have "{inv_end1 x} tcopy_end {inv_end0 x}"
f2bda6ba4952 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 92
diff changeset
   934
    by (metis assms end_correct) 
f2bda6ba4952 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 92
diff changeset
   935
  moreover 
f2bda6ba4952 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 92
diff changeset
   936
  have "inv_loop0 x \<mapsto> inv_end1 x"
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   937
    by(auto simp: inv_end1.simps inv_loop1.simps assert_imp_def)
93
f2bda6ba4952 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 92
diff changeset
   938
  ultimately 
f2bda6ba4952 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 92
diff changeset
   939
  show "{inv_begin1 x} tcopy {inv_end0 x}"
f2bda6ba4952 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 92
diff changeset
   940
    unfolding tcopy_def
f2bda6ba4952 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 92
diff changeset
   941
    by (rule_tac Hoare_plus_halt) (auto)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   942
qed
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   943
69
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 68
diff changeset
   944
abbreviation
89
c67e8ed4c865 updated uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 84
diff changeset
   945
  "pre_tcopy n \<equiv> \<lambda>tp. tp = ([]::cell list, <[n::nat]>)"
69
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 68
diff changeset
   946
abbreviation
89
c67e8ed4c865 updated uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 84
diff changeset
   947
  "post_tcopy n \<equiv> \<lambda>tp. tp= ([Bk], <[n, n::nat]>)"
69
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 68
diff changeset
   948
93
f2bda6ba4952 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 92
diff changeset
   949
lemma tcopy_correct:
69
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 68
diff changeset
   950
  shows "{pre_tcopy n} tcopy {post_tcopy n}"
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 68
diff changeset
   951
proof -
89
c67e8ed4c865 updated uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 84
diff changeset
   952
  have "{inv_begin1 (Suc n)} tcopy {inv_end0 (Suc n)}"
69
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 68
diff changeset
   953
    by (rule tcopy_correct1) (simp)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 68
diff changeset
   954
  moreover
93
f2bda6ba4952 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 92
diff changeset
   955
  have "pre_tcopy n = inv_begin1 (Suc n)" 
f2bda6ba4952 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 92
diff changeset
   956
    by (auto simp add: tape_of_nl_abv)
69
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 68
diff changeset
   957
  moreover
93
f2bda6ba4952 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 92
diff changeset
   958
  have "inv_end0 (Suc n) = post_tcopy n" 
f2bda6ba4952 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 92
diff changeset
   959
    by (auto simp add: inv_end0.simps tape_of_nl_abv)
69
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 68
diff changeset
   960
  ultimately
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 68
diff changeset
   961
  show "{pre_tcopy n} tcopy {post_tcopy n}" 
93
f2bda6ba4952 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 92
diff changeset
   962
    by simp
69
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 68
diff changeset
   963
qed
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 68
diff changeset
   964
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 68
diff changeset
   965
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 68
diff changeset
   966
section {* The {\em Dithering} Turing Machine *}
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   967
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   968
text {*
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   969
  The {\em Dithering} TM, when the input is @{text "1"}, it will loop forever, otherwise, it will
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   970
  terminate.
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   971
*}
66
4a3cd7d70ec2 tuned more
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 65
diff changeset
   972
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   973
definition dither :: "instr list"
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   974
  where
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   975
  "dither \<equiv> [(W0, 1), (R, 2), (L, 1), (L, 0)] "
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   976
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 69
diff changeset
   977
(* invariants of dither *)
94
aeaf1374dc67 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 93
diff changeset
   978
abbreviation (input)
89
c67e8ed4c865 updated uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 84
diff changeset
   979
  "dither_halt_inv \<equiv> \<lambda>tp. (\<exists>n. tp = (Bk \<up> n, <1::nat>))"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 69
diff changeset
   980
94
aeaf1374dc67 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 93
diff changeset
   981
abbreviation (input)
89
c67e8ed4c865 updated uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 84
diff changeset
   982
  "dither_unhalt_inv \<equiv> \<lambda>tp. (\<exists>n. tp = (Bk \<up> n, <0::nat>))"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 69
diff changeset
   983
80
eb589fa73fc1 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 76
diff changeset
   984
lemma dither_loops_aux: 
66
4a3cd7d70ec2 tuned more
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 65
diff changeset
   985
  "(steps0 (1, Bk \<up> m, [Oc]) dither stp = (1, Bk \<up> m, [Oc])) \<or> 
4a3cd7d70ec2 tuned more
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 65
diff changeset
   986
   (steps0 (1, Bk \<up> m, [Oc]) dither stp = (2, Oc # Bk \<up> m, []))"
4a3cd7d70ec2 tuned more
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 65
diff changeset
   987
  apply(induct stp)
89
c67e8ed4c865 updated uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 84
diff changeset
   988
  apply(auto simp: steps.simps step.simps dither_def numeral tape_of_nat_abv)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   989
  done
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   990
66
4a3cd7d70ec2 tuned more
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 65
diff changeset
   991
lemma dither_loops:
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 69
diff changeset
   992
  shows "{dither_unhalt_inv} dither \<up>" 
66
4a3cd7d70ec2 tuned more
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 65
diff changeset
   993
apply(rule Hoare_unhaltI)
80
eb589fa73fc1 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 76
diff changeset
   994
using dither_loops_aux
89
c67e8ed4c865 updated uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 84
diff changeset
   995
apply(auto simp add: numeral tape_of_nat_abv)
80
eb589fa73fc1 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 76
diff changeset
   996
by (metis Suc_neq_Zero is_final_eq)
eb589fa73fc1 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 76
diff changeset
   997
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   998
80
eb589fa73fc1 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 76
diff changeset
   999
lemma dither_halts_aux: 
91
2068654bdf54 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 89
diff changeset
  1000
  shows "steps0 (1, Bk \<up> m, [Oc, Oc]) dither 2 = (0, Bk \<up> m, [Oc, Oc])"
66
4a3cd7d70ec2 tuned more
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 65
diff changeset
  1001
unfolding dither_def
80
eb589fa73fc1 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 76
diff changeset
  1002
by (simp add: steps.simps step.simps numeral)
66
4a3cd7d70ec2 tuned more
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 65
diff changeset
  1003
4a3cd7d70ec2 tuned more
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 65
diff changeset
  1004
lemma dither_halts:
4a3cd7d70ec2 tuned more
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 65
diff changeset
  1005
  shows "{dither_halt_inv} dither {dither_halt_inv}" 
71
8c7f10b3da7b updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 70
diff changeset
  1006
apply(rule Hoare_haltI)
80
eb589fa73fc1 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 76
diff changeset
  1007
using dither_halts_aux
89
c67e8ed4c865 updated uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 84
diff changeset
  1008
apply(auto simp add: tape_of_nat_abv)
66
4a3cd7d70ec2 tuned more
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 65
diff changeset
  1009
by (metis (lifting, mono_tags) holds_for.simps is_final_eq prod.cases)
4a3cd7d70ec2 tuned more
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 65
diff changeset
  1010
4a3cd7d70ec2 tuned more
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 65
diff changeset
  1011
4a3cd7d70ec2 tuned more
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 65
diff changeset
  1012
80
eb589fa73fc1 updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 76
diff changeset
  1013
section {* The diagnal argument below shows the undecidability of Halting problem *}
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1014
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1015
text {*
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1016
  @{text "haltP tp x"} means TM @{text "tp"} terminates on input @{text "x"}
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1017
  and the final configuration is standard.
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1018
*}
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1019
89
c67e8ed4c865 updated uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 84
diff changeset
  1020
definition haltP :: "tprog0 \<Rightarrow> nat list \<Rightarrow> bool"
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1021
  where
93
f2bda6ba4952 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 92
diff changeset
  1022
  "haltP p lm \<equiv> {(\<lambda>tp. tp = ([], <lm>))} p {(\<lambda>tp. (\<exists>k n. tp = (Bk \<up> k,  <n::nat>)))}"
65
0349fa7f5595 also polished uh_h proof
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 64
diff changeset
  1023
0349fa7f5595 also polished uh_h proof
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 64
diff changeset
  1024
lemma [intro, simp]: "tm_wf0 tcopy"
82
c470f1705baa simplified uncomputable-locale
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 81
diff changeset
  1025
by (auto simp: tcopy_def)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1026
65
0349fa7f5595 also polished uh_h proof
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 64
diff changeset
  1027
lemma [intro, simp]: "tm_wf0 dither"
0349fa7f5595 also polished uh_h proof
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 64
diff changeset
  1028
by (auto simp: tm_wf.simps dither_def)
0349fa7f5595 also polished uh_h proof
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 64
diff changeset
  1029
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1030
text {*
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1031
  The following locale specifies that TM @{text "H"} can be used to solve 
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1032
  the {\em Halting Problem} and @{text "False"} is going to be derived 
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1033
  under this locale. Therefore, the undecidability of {\em Halting Problem}
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1034
  is established. 
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1035
*}
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1036
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1037
locale uncomputable = 
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1038
  -- {* The coding function of TM, interestingly, the detailed definition of this 
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1039
  funciton @{text "code"} does not affect the final result. *}
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1040
  fixes code :: "instr list \<Rightarrow> nat" 
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1041
  -- {* 
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1042
  The TM @{text "H"} is the one which is assummed being able to solve the Halting problem.
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1043
  *}
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1044
  and H :: "instr list"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 69
diff changeset
  1045
  assumes h_wf[intro]: "tm_wf0 H"
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1046
  -- {*
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1047
  The following two assumptions specifies that @{text "H"} does solve the Halting problem.
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1048
  *}
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1049
  and h_case: 
89
c67e8ed4c865 updated uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 84
diff changeset
  1050
  "\<And> M lm. haltP M lm \<Longrightarrow> {(\<lambda>tp. tp = ([Bk], <code M#lm>))} H {(\<lambda>tp. \<exists>n. tp = (Bk \<up> n, <0::nat>))}"
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1051
  and nh_case: 
89
c67e8ed4c865 updated uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 84
diff changeset
  1052
  "\<And> M lm. \<not> haltP M lm \<Longrightarrow> {(\<lambda>tp. tp = ([Bk], <code M#lm>))} H {(\<lambda>tp. \<exists>n. tp = (Bk \<up> n, <1::nat>))}"
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1053
begin
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1054
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 69
diff changeset
  1055
(* invariants for H *)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 69
diff changeset
  1056
abbreviation
89
c67e8ed4c865 updated uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 84
diff changeset
  1057
  "pre_H_inv M n \<equiv> \<lambda>tp. tp = ([Bk], <[code M, n]>)"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 69
diff changeset
  1058
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 69
diff changeset
  1059
abbreviation
89
c67e8ed4c865 updated uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 84
diff changeset
  1060
  "post_H_halt_inv \<equiv> \<lambda>tp. \<exists>n. tp = (Bk \<up> n, <1::nat>)"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 69
diff changeset
  1061
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 69
diff changeset
  1062
abbreviation
89
c67e8ed4c865 updated uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 84
diff changeset
  1063
  "post_H_unhalt_inv \<equiv> \<lambda>tp. \<exists>n. tp = (Bk \<up> n, <0::nat>)"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 69
diff changeset
  1064
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 69
diff changeset
  1065
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 69
diff changeset
  1066
lemma H_halt_inv:
89
c67e8ed4c865 updated uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 84
diff changeset
  1067
  assumes "\<not> haltP M [n]" 
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 69
diff changeset
  1068
  shows "{pre_H_inv M n} H {post_H_halt_inv}"
89
c67e8ed4c865 updated uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 84
diff changeset
  1069
using assms nh_case by auto
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 69
diff changeset
  1070
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 69
diff changeset
  1071
lemma H_unhalt_inv:
89
c67e8ed4c865 updated uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 84
diff changeset
  1072
  assumes "haltP M [n]" 
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 69
diff changeset
  1073
  shows "{pre_H_inv M n} H {post_H_unhalt_inv}"
89
c67e8ed4c865 updated uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 84
diff changeset
  1074
using assms h_case by auto
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1075
   
67
140489a4020e using some abbreviations
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 66
diff changeset
  1076
(* TM that produces the contradiction and its code *)
93
f2bda6ba4952 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 92
diff changeset
  1077
f2bda6ba4952 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 92
diff changeset
  1078
definition
67
140489a4020e using some abbreviations
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 66
diff changeset
  1079
  "tcontra \<equiv> (tcopy |+| H) |+| dither"
140489a4020e using some abbreviations
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 66
diff changeset
  1080
abbreviation
140489a4020e using some abbreviations
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 66
diff changeset
  1081
  "code_tcontra \<equiv> code tcontra"
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1082
67
140489a4020e using some abbreviations
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 66
diff changeset
  1083
(* assume tcontra does not halt on its code *)
140489a4020e using some abbreviations
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 66
diff changeset
  1084
lemma tcontra_unhalt: 
89
c67e8ed4c865 updated uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 84
diff changeset
  1085
  assumes "\<not> haltP tcontra [code tcontra]"
66
4a3cd7d70ec2 tuned more
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 65
diff changeset
  1086
  shows "False"
65
0349fa7f5595 also polished uh_h proof
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 64
diff changeset
  1087
proof -
64
5c74f6b38a63 updated h_uh proof in uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 63
diff changeset
  1088
  (* invariants *)
89
c67e8ed4c865 updated uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 84
diff changeset
  1089
  def P1 \<equiv> "\<lambda>tp. tp = ([]::cell list, <[code_tcontra]>)"
c67e8ed4c865 updated uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 84
diff changeset
  1090
  def P2 \<equiv> "\<lambda>tp. tp = ([Bk], <[code_tcontra, code_tcontra]>)"
94
aeaf1374dc67 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 93
diff changeset
  1091
  def P3 \<equiv> "\<lambda>tp. \<exists>n. tp = (Bk \<up> n, <1::nat>)"
64
5c74f6b38a63 updated h_uh proof in uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 63
diff changeset
  1092
5c74f6b38a63 updated h_uh proof in uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 63
diff changeset
  1093
  (*
5c74f6b38a63 updated h_uh proof in uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 63
diff changeset
  1094
  {P1} tcopy {P2}  {P2} H {P3} 
5c74f6b38a63 updated h_uh proof in uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 63
diff changeset
  1095
  ----------------------------
65
0349fa7f5595 also polished uh_h proof
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 64
diff changeset
  1096
     {P1} (tcopy |+| H) {P3}     {P3} dither {P3}
64
5c74f6b38a63 updated h_uh proof in uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 63
diff changeset
  1097
  ------------------------------------------------
68
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 67
diff changeset
  1098
                 {P1} tcontra {P3}
64
5c74f6b38a63 updated h_uh proof in uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 63
diff changeset
  1099
  *)
5c74f6b38a63 updated h_uh proof in uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 63
diff changeset
  1100
65
0349fa7f5595 also polished uh_h proof
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 64
diff changeset
  1101
  have H_wf: "tm_wf0 (tcopy |+| H)" by auto
64
5c74f6b38a63 updated h_uh proof in uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 63
diff changeset
  1102
5c74f6b38a63 updated h_uh proof in uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 63
diff changeset
  1103
  (* {P1} (tcopy |+| H) {P3} *)
5c74f6b38a63 updated h_uh proof in uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 63
diff changeset
  1104
  have first: "{P1} (tcopy |+| H) {P3}" 
68
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 67
diff changeset
  1105
  proof (cases rule: Hoare_plus_halt_simple)
64
5c74f6b38a63 updated h_uh proof in uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 63
diff changeset
  1106
    case A_halt (* of tcopy *)
93
f2bda6ba4952 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 92
diff changeset
  1107
    show "{P1} tcopy {P2}" unfolding P1_def P2_def 
f2bda6ba4952 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 92
diff changeset
  1108
      by (rule tcopy_correct)
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1109
  next
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 69
diff changeset
  1110
    case B_halt (* of H *)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 69
diff changeset
  1111
    show "{P2} H {P3}"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 69
diff changeset
  1112
      unfolding P2_def P3_def
89
c67e8ed4c865 updated uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 84
diff changeset
  1113
      by (rule H_halt_inv[OF assms])
65
0349fa7f5595 also polished uh_h proof
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 64
diff changeset
  1114
  qed (simp)
0349fa7f5595 also polished uh_h proof
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 64
diff changeset
  1115
0349fa7f5595 also polished uh_h proof
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 64
diff changeset
  1116
  (* {P3} dither {P3} *)
0349fa7f5595 also polished uh_h proof
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 64
diff changeset
  1117
  have second: "{P3} dither {P3}" unfolding P3_def 
0349fa7f5595 also polished uh_h proof
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 64
diff changeset
  1118
    by (rule dither_halts)
0349fa7f5595 also polished uh_h proof
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 64
diff changeset
  1119
  
0349fa7f5595 also polished uh_h proof
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 64
diff changeset
  1120
  (* {P1} tcontra {P3} *)
67
140489a4020e using some abbreviations
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 66
diff changeset
  1121
  have "{P1} tcontra {P3}" 
93
f2bda6ba4952 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 92
diff changeset
  1122
    unfolding tcontra_def
65
0349fa7f5595 also polished uh_h proof
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 64
diff changeset
  1123
    by (rule Hoare_plus_halt_simple[OF first second H_wf])
0349fa7f5595 also polished uh_h proof
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 64
diff changeset
  1124
67
140489a4020e using some abbreviations
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 66
diff changeset
  1125
  with assms show "False"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 69
diff changeset
  1126
    unfolding P1_def P3_def
65
0349fa7f5595 also polished uh_h proof
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 64
diff changeset
  1127
    unfolding haltP_def
71
8c7f10b3da7b updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 70
diff changeset
  1128
    unfolding Hoare_halt_def 
65
0349fa7f5595 also polished uh_h proof
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 64
diff changeset
  1129
    apply(auto)
84
4c8325c64dab updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 83
diff changeset
  1130
    apply(drule_tac x = n in spec)
67
140489a4020e using some abbreviations
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 66
diff changeset
  1131
    apply(case_tac "steps0 (Suc 0, [], <[code tcontra]>) tcontra n")
84
4c8325c64dab updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 83
diff changeset
  1132
    apply(auto)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 69
diff changeset
  1133
    done
65
0349fa7f5595 also polished uh_h proof
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 64
diff changeset
  1134
qed
0349fa7f5595 also polished uh_h proof
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 64
diff changeset
  1135
67
140489a4020e using some abbreviations
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 66
diff changeset
  1136
(* asumme tcontra halts on its code *)
140489a4020e using some abbreviations
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 66
diff changeset
  1137
lemma tcontra_halt: 
89
c67e8ed4c865 updated uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 84
diff changeset
  1138
  assumes "haltP tcontra [code tcontra]"
66
4a3cd7d70ec2 tuned more
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 65
diff changeset
  1139
  shows "False"
65
0349fa7f5595 also polished uh_h proof
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 64
diff changeset
  1140
proof - 
0349fa7f5595 also polished uh_h proof
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 64
diff changeset
  1141
  (* invariants *)
89
c67e8ed4c865 updated uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 84
diff changeset
  1142
  def P1 \<equiv> "\<lambda>tp. tp = ([]::cell list, <[code_tcontra]>)"
c67e8ed4c865 updated uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 84
diff changeset
  1143
  def P2 \<equiv> "\<lambda>tp. tp = ([Bk], <[code_tcontra, code_tcontra]>)"
94
aeaf1374dc67 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 93
diff changeset
  1144
  def Q3 \<equiv> "\<lambda>tp. \<exists>n. tp = (Bk \<up> n, <0::nat>)"
65
0349fa7f5595 also polished uh_h proof
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 64
diff changeset
  1145
0349fa7f5595 also polished uh_h proof
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 64
diff changeset
  1146
  (*
93
f2bda6ba4952 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 92
diff changeset
  1147
  {P1} tcopy {P2}  {P2} H {Q3} 
65
0349fa7f5595 also polished uh_h proof
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 64
diff changeset
  1148
  ----------------------------
93
f2bda6ba4952 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 92
diff changeset
  1149
     {P1} (tcopy |+| H) {Q3}     {Q3} dither loops
65
0349fa7f5595 also polished uh_h proof
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 64
diff changeset
  1150
  ------------------------------------------------
68
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 67
diff changeset
  1151
               {P1} tcontra loops
65
0349fa7f5595 also polished uh_h proof
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 64
diff changeset
  1152
  *)
0349fa7f5595 also polished uh_h proof
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 64
diff changeset
  1153
0349fa7f5595 also polished uh_h proof
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 64
diff changeset
  1154
  have H_wf: "tm_wf0 (tcopy |+| H)" by auto
0349fa7f5595 also polished uh_h proof
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 64
diff changeset
  1155
93
f2bda6ba4952 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 92
diff changeset
  1156
  (* {P1} (tcopy |+| H) {Q3} *)
f2bda6ba4952 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 92
diff changeset
  1157
  have first: "{P1} (tcopy |+| H) {Q3}" 
68
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 67
diff changeset
  1158
  proof (cases rule: Hoare_plus_halt_simple)
65
0349fa7f5595 also polished uh_h proof
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 64
diff changeset
  1159
    case A_halt (* of tcopy *)
69
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 68
diff changeset
  1160
    show "{P1} tcopy {P2}" unfolding P1_def P2_def
93
f2bda6ba4952 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 92
diff changeset
  1161
      by (rule tcopy_correct)
65
0349fa7f5595 also polished uh_h proof
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 64
diff changeset
  1162
  next
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 69
diff changeset
  1163
    case B_halt (* of H *)
93
f2bda6ba4952 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 92
diff changeset
  1164
    then show "{P2} H {Q3}"
f2bda6ba4952 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 92
diff changeset
  1165
      unfolding P2_def Q3_def
89
c67e8ed4c865 updated uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 84
diff changeset
  1166
      by (rule H_unhalt_inv[OF assms])
65
0349fa7f5595 also polished uh_h proof
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 64
diff changeset
  1167
  qed (simp)
64
5c74f6b38a63 updated h_uh proof in uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 63
diff changeset
  1168
5c74f6b38a63 updated h_uh proof in uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 63
diff changeset
  1169
  (* {P3} dither loops *)
93
f2bda6ba4952 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 92
diff changeset
  1170
  have second: "{Q3} dither \<up>" unfolding Q3_def 
64
5c74f6b38a63 updated h_uh proof in uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 63
diff changeset
  1171
    by (rule dither_loops)
5c74f6b38a63 updated h_uh proof in uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 63
diff changeset
  1172
  
5c74f6b38a63 updated h_uh proof in uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 63
diff changeset
  1173
  (* {P1} tcontra loops *)
67
140489a4020e using some abbreviations
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 66
diff changeset
  1174
  have "{P1} tcontra \<up>" 
93
f2bda6ba4952 updated paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 92
diff changeset
  1175
    unfolding tcontra_def
65
0349fa7f5595 also polished uh_h proof
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 64
diff changeset
  1176
    by (rule Hoare_plus_unhalt_simple[OF first second H_wf])
0349fa7f5595 also polished uh_h proof
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 64
diff changeset
  1177
66
4a3cd7d70ec2 tuned more
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 65
diff changeset
  1178
  with assms show "False"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 69
diff changeset
  1179
    unfolding P1_def
65
0349fa7f5595 also polished uh_h proof
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 64
diff changeset
  1180
    unfolding haltP_def
89
c67e8ed4c865 updated uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 84
diff changeset
  1181
    unfolding Hoare_halt_def Hoare_unhalt_def
c67e8ed4c865 updated uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 84
diff changeset
  1182
    by auto
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1183
qed
63
35fe8fe12e65 small updates
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 61
diff changeset
  1184
      
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1185
text {*
64
5c74f6b38a63 updated h_uh proof in uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 63
diff changeset
  1186
  @{text "False"} can finally derived.
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1187
*}
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1188
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1189
lemma false: "False"
67
140489a4020e using some abbreviations
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 66
diff changeset
  1190
using tcontra_halt tcontra_unhalt 
140489a4020e using some abbreviations
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 66
diff changeset
  1191
by auto
63
35fe8fe12e65 small updates
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 61
diff changeset
  1192
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1193
end
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1194
66
4a3cd7d70ec2 tuned more
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 65
diff changeset
  1195
declare replicate_Suc[simp del]
4a3cd7d70ec2 tuned more
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 65
diff changeset
  1196
4a3cd7d70ec2 tuned more
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 65
diff changeset
  1197
44
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1198
end
2f765afc1f7e added Jian's new version of uncomputable
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1199