thys/UF.thy
author Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
Wed, 19 Dec 2018 16:10:58 +0100
changeset 288 a9003e6d0463
parent 250 745547bdc1c7
child 289 4e50ff177348
permissions -rwxr-xr-x
Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
169
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 166
diff changeset
     1
(* Title: thys/UF.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 166
diff changeset
     2
   Author: Jian Xu, Xingyuan Zhang, and Christian Urban
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 166
diff changeset
     3
*)
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 166
diff changeset
     4
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
     5
chapter {* Construction of a Universal Function *}
169
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 166
diff changeset
     6
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
     7
theory UF
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
     8
imports Rec_Def HOL.GCD Abacus
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
     9
begin
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    10
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    11
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    12
  This theory file constructs the Universal Function @{text "rec_F"}, which is the UTM defined
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    13
  in terms of recursive functions. This @{text "rec_F"} is essentially an 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    14
  interpreter of Turing Machines. Once the correctness of @{text "rec_F"} is established,
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    15
  UTM can easil be obtained by compling @{text "rec_F"} into the corresponding Turing Machine.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    16
*}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    17
169
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 166
diff changeset
    18
section {* Universal Function *}
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    19
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    20
subsection {* The construction of component functions *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    21
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    22
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    23
  The recursive function used to do arithmatic addition.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    24
*}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    25
definition rec_add :: "recf"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    26
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    27
  "rec_add \<equiv>  Pr 1 (id 1 0) (Cn 3 s [id 3 2])"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    28
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    29
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    30
  The recursive function used to do arithmatic multiplication.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    31
*}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    32
definition rec_mult :: "recf"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    33
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    34
  "rec_mult = Pr 1 z (Cn 3 rec_add [id 3 0, id 3 2])"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    35
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    36
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    37
  The recursive function used to do arithmatic precede.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    38
*}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    39
definition rec_pred :: "recf"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    40
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    41
  "rec_pred = Cn 1 (Pr 1 z (id 3 1)) [id 1 0, id 1 0]"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    42
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    43
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    44
  The recursive function used to do arithmatic subtraction.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    45
*}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    46
definition rec_minus :: "recf" 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    47
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    48
  "rec_minus = Pr 1 (id 1 0) (Cn 3 rec_pred [id 3 2])"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    49
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    50
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    51
  @{text "constn n"} is the recursive function which computes 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    52
  nature number @{text "n"}.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    53
*}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    54
fun constn :: "nat \<Rightarrow> recf"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    55
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    56
  "constn 0 = z"  |
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    57
  "constn (Suc n) = Cn 1 s [constn n]"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    58
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    59
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    60
text {*
198
d93cc4295306 tuned some files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 169
diff changeset
    61
  Sign function, which returns 1 when the input argument is greater than @{text "0"}.
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    62
*}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    63
definition rec_sg :: "recf"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    64
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    65
  "rec_sg = Cn 1 rec_minus [constn 1, 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    66
                  Cn 1 rec_minus [constn 1, id 1 0]]"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    67
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    68
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    69
  @{text "rec_less"} compares its two arguments, returns @{text "1"} if
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    70
  the first is less than the second; otherwise returns @{text "0"}.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    71
  *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    72
definition rec_less :: "recf"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    73
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    74
  "rec_less = Cn 2 rec_sg [Cn 2 rec_minus [id 2 1, id 2 0]]"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    75
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    76
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    77
  @{text "rec_not"} inverse its argument: returns @{text "1"} when the
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    78
  argument is @{text "0"}; returns @{text "0"} otherwise.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    79
  *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    80
definition rec_not :: "recf"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    81
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    82
  "rec_not = Cn 1 rec_minus [constn 1, id 1 0]"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    83
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    84
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    85
  @{text "rec_eq"} compares its two arguments: returns @{text "1"}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    86
  if they are equal; return @{text "0"} otherwise.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    87
  *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    88
definition rec_eq :: "recf"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    89
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    90
  "rec_eq = Cn 2 rec_minus [Cn 2 (constn 1) [id 2 0], 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    91
             Cn 2 rec_add [Cn 2 rec_minus [id 2 0, id 2 1], 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    92
               Cn 2 rec_minus [id 2 1, id 2 0]]]"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    93
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    94
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    95
  @{text "rec_conj"} computes the conjunction of its two arguments, 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    96
  returns @{text "1"} if both of them are non-zero; returns @{text "0"}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    97
  otherwise.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    98
  *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    99
definition rec_conj :: "recf"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   100
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   101
  "rec_conj = Cn 2 rec_sg [Cn 2 rec_mult [id 2 0, id 2 1]] "
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   102
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   103
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   104
  @{text "rec_disj"} computes the disjunction of its two arguments, 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   105
  returns @{text "0"} if both of them are zero; returns @{text "0"}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   106
  otherwise.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   107
  *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   108
definition rec_disj :: "recf"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   109
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   110
  "rec_disj = Cn 2 rec_sg [Cn 2 rec_add [id 2 0, id 2 1]]"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   111
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   112
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   113
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   114
  Computes the arity of recursive function.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   115
  *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   116
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   117
fun arity :: "recf \<Rightarrow> nat"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   118
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   119
  "arity z = 1" 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   120
| "arity s = 1"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   121
| "arity (id m n) = m"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   122
| "arity (Cn n f gs) = n"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   123
| "arity (Pr n f g) = Suc n"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   124
| "arity (Mn n f) = n"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   125
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   126
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   127
  @{text "get_fstn_args n (Suc k)"} returns
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   128
  @{text "[id n 0, id n 1, id n 2, \<dots>, id n k]"}, 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   129
  the effect of which is to take out the first @{text "Suc k"} 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   130
  arguments out of the @{text "n"} input arguments.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   131
  *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   132
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   133
fun get_fstn_args :: "nat \<Rightarrow>  nat \<Rightarrow> recf list"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   134
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   135
  "get_fstn_args n 0 = []"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   136
| "get_fstn_args n (Suc y) = get_fstn_args n y @ [id n y]"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   137
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   138
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   139
  @{text "rec_sigma f"} returns the recursive functions which 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   140
  sums up the results of @{text "f"}:
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   141
  \[
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   142
  (rec\_sigma f)(x, y) = f(x, 0) + f(x, 1) + \cdots + f(x, y)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   143
  \]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   144
*}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   145
fun rec_sigma :: "recf \<Rightarrow> recf"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   146
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   147
  "rec_sigma rf = 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   148
       (let vl = arity rf in 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   149
          Pr (vl - 1) (Cn (vl - 1) rf (get_fstn_args (vl - 1) (vl - 1) @ 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   150
                    [Cn (vl - 1) (constn 0) [id (vl - 1) 0]])) 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   151
             (Cn (Suc vl) rec_add [id (Suc vl) vl, 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   152
                    Cn (Suc vl) rf (get_fstn_args (Suc vl) (vl - 1) 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   153
                        @ [Cn (Suc vl) s [id (Suc vl) (vl - 1)]])]))"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   154
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   155
text {*
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   156
  @{text "rec_exec"} is the interpreter function for
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   157
  reursive functions. The function is defined such that 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   158
  it always returns meaningful results for primitive recursive 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   159
  functions.
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   160
  *}
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   161
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   162
declare rec_exec.simps[simp del] constn.simps[simp del]
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   163
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   164
text {*
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   165
  Correctness of @{text "rec_add"}.
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   166
  *}
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   167
lemma add_lemma: "\<And> x y. rec_exec rec_add [x, y] =  x + y"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   168
by(induct_tac y, auto simp: rec_add_def rec_exec.simps)
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   169
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   170
text {*
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   171
  Correctness of @{text "rec_mult"}.
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   172
  *}
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   173
lemma mult_lemma: "\<And> x y. rec_exec rec_mult [x, y] = x * y"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   174
by(induct_tac y, auto simp: rec_mult_def rec_exec.simps add_lemma)
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   175
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   176
text {*
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   177
  Correctness of @{text "rec_pred"}.
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   178
  *}
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   179
lemma pred_lemma: "\<And> x. rec_exec rec_pred [x] =  x - 1"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   180
by(induct_tac x, auto simp: rec_pred_def rec_exec.simps)
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   181
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   182
text {*
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   183
  Correctness of @{text "rec_minus"}.
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   184
  *}
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   185
lemma minus_lemma: "\<And> x y. rec_exec rec_minus [x, y] = x - y"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   186
by(induct_tac y, auto simp: rec_exec.simps rec_minus_def pred_lemma)
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   187
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   188
text {*
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   189
  Correctness of @{text "rec_sg"}.
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   190
  *}
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   191
lemma sg_lemma: "\<And> x. rec_exec rec_sg [x] = (if x = 0 then 0 else 1)"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   192
by(auto simp: rec_sg_def minus_lemma rec_exec.simps constn.simps)
237
06a6db387cd2 updated and small modification
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 229
diff changeset
   193
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   194
text {*
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   195
  Correctness of @{text "constn"}.
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   196
  *}
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   197
lemma constn_lemma: "rec_exec (constn n) [x] = n"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   198
by(induct n, auto simp: rec_exec.simps constn.simps)
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   199
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   200
text {*
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   201
  Correctness of @{text "rec_less"}.
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   202
  *}
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   203
lemma less_lemma: "\<And> x y. rec_exec rec_less [x, y] = 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   204
  (if x < y then 1 else 0)"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   205
by(induct_tac y, auto simp: rec_exec.simps 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   206
  rec_less_def minus_lemma sg_lemma)
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   207
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   208
text {*
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   209
  Correctness of @{text "rec_not"}.
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   210
  *}
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   211
lemma not_lemma: 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   212
  "\<And> x. rec_exec rec_not [x] = (if x = 0 then 1 else 0)"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   213
by(induct_tac x, auto simp: rec_exec.simps rec_not_def
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   214
  constn_lemma minus_lemma)
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   215
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   216
text {*
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   217
  Correctness of @{text "rec_eq"}.
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   218
  *}
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   219
lemma eq_lemma: "\<And> x y. rec_exec rec_eq [x, y] = (if x = y then 1 else 0)"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   220
by(induct_tac y, auto simp: rec_exec.simps rec_eq_def constn_lemma add_lemma minus_lemma)
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   221
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   222
text {*
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   223
  Correctness of @{text "rec_conj"}.
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   224
  *}
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   225
lemma conj_lemma: "\<And> x y. rec_exec rec_conj [x, y] = (if x = 0 \<or> y = 0 then 0 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   226
                                                       else 1)"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   227
by(induct_tac y, auto simp: rec_exec.simps sg_lemma rec_conj_def mult_lemma)
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   228
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   229
text {*
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   230
  Correctness of @{text "rec_disj"}.
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   231
  *}
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   232
lemma disj_lemma: "\<And> x y. rec_exec rec_disj [x, y] = (if x = 0 \<and> y = 0 then 0
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   233
                                                     else 1)"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   234
by(induct_tac y, auto simp: rec_disj_def sg_lemma add_lemma rec_exec.simps)
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   235
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   236
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   237
text {*
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   238
  @{text "primrec recf n"} is true iff 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   239
  @{text "recf"} is a primitive recursive function 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   240
  with arity @{text "n"}.
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   241
  *}
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   242
inductive primerec :: "recf \<Rightarrow> nat \<Rightarrow> bool"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   243
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   244
prime_z[intro]:  "primerec z (Suc 0)" |
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   245
prime_s[intro]:  "primerec s (Suc 0)" |
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   246
prime_id[intro!]: "\<lbrakk>n < m\<rbrakk> \<Longrightarrow> primerec (id m n) m" |
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   247
prime_cn[intro!]: "\<lbrakk>primerec f k; length gs = k; 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   248
  \<forall> i < length gs. primerec (gs ! i) m; m = n\<rbrakk> 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   249
  \<Longrightarrow> primerec (Cn n f gs) m" |
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   250
prime_pr[intro!]: "\<lbrakk>primerec f n; 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   251
  primerec g (Suc (Suc n)); m = Suc n\<rbrakk> 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   252
  \<Longrightarrow> primerec (Pr n f g) m" 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   253
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   254
inductive_cases prime_cn_reverse'[elim]: "primerec (Cn n f gs) n" 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   255
inductive_cases prime_mn_reverse: "primerec (Mn n f) m" 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   256
inductive_cases prime_z_reverse[elim]: "primerec z n"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   257
inductive_cases prime_s_reverse[elim]: "primerec s n"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   258
inductive_cases prime_id_reverse[elim]: "primerec (id m n) k"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   259
inductive_cases prime_cn_reverse[elim]: "primerec (Cn n f gs) m"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   260
inductive_cases prime_pr_reverse[elim]: "primerec (Pr n f g) m"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   261
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   262
declare mult_lemma[simp] add_lemma[simp] pred_lemma[simp] 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   263
        minus_lemma[simp] sg_lemma[simp] constn_lemma[simp] 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   264
        less_lemma[simp] not_lemma[simp] eq_lemma[simp]
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   265
        conj_lemma[simp] disj_lemma[simp]
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   266
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   267
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   268
  @{text "Sigma"} is the logical specification of 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   269
  the recursive function @{text "rec_sigma"}.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   270
  *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   271
function Sigma :: "(nat list \<Rightarrow> nat) \<Rightarrow> nat list \<Rightarrow> nat"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   272
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   273
  "Sigma g xs = (if last xs = 0 then g xs
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   274
                 else (Sigma g (butlast xs @ [last xs - 1]) +
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   275
                       g xs)) "
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   276
by pat_completeness auto
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   277
termination
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   278
proof
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   279
  show "wf (measure (\<lambda> (f, xs). last xs))" by auto
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   280
next
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   281
  fix g xs
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   282
  assume "last (xs::nat list) \<noteq> 0"
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   283
  thus "((g, butlast xs @ [last xs - 1]), g, xs)  
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   284
                   \<in> measure (\<lambda>(f, xs). last xs)"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   285
    by auto
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   286
qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   287
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   288
declare rec_exec.simps[simp del] get_fstn_args.simps[simp del]
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   289
        arity.simps[simp del] Sigma.simps[simp del]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   290
        rec_sigma.simps[simp del]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   291
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   292
lemma rec_pr_0_simp_rewrite: "
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   293
  rec_exec (Pr n f g) (xs @ [0]) = rec_exec f xs"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   294
by(simp add: rec_exec.simps)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   295
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   296
lemma rec_pr_0_simp_rewrite_single_param: "
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   297
  rec_exec (Pr n f g) [0] = rec_exec f []"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   298
by(simp add: rec_exec.simps)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   299
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   300
lemma rec_pr_Suc_simp_rewrite: 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   301
  "rec_exec (Pr n f g) (xs @ [Suc x]) =
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   302
                       rec_exec g (xs @ [x] @ 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   303
                        [rec_exec (Pr n f g) (xs @ [x])])"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   304
by(simp add: rec_exec.simps)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   305
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   306
lemma rec_pr_Suc_simp_rewrite_single_param: 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   307
  "rec_exec (Pr n f g) ([Suc x]) =
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   308
           rec_exec g ([x] @ [rec_exec (Pr n f g) ([x])])"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   309
by(simp add: rec_exec.simps)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   310
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   311
lemma Sigma_0_simp_rewrite_single_param:
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   312
  "Sigma f [0] = f [0]"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   313
by(simp add: Sigma.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   314
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   315
lemma Sigma_0_simp_rewrite:
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   316
  "Sigma f (xs @ [0]) = f (xs @ [0])"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   317
by(simp add: Sigma.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   318
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   319
lemma Sigma_Suc_simp_rewrite: 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   320
  "Sigma f (xs @ [Suc x]) = Sigma f (xs @ [x]) + f (xs @ [Suc x])"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   321
by(simp add: Sigma.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   322
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   323
lemma Sigma_Suc_simp_rewrite_single: 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   324
  "Sigma f ([Suc x]) = Sigma f ([x]) + f ([Suc x])"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   325
by(simp add: Sigma.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   326
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   327
lemma  [simp]: "(xs @ ys) ! (Suc (length xs)) = ys ! 1"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   328
by(simp add: nth_append)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   329
  
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   330
lemma get_fstn_args_take: "\<lbrakk>length xs = m; n \<le> m\<rbrakk> \<Longrightarrow> 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   331
  map (\<lambda> f. rec_exec f xs) (get_fstn_args m n)= take n xs"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   332
proof(induct n)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   333
  case 0 thus "?case"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   334
    by(simp add: get_fstn_args.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   335
next
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   336
  case (Suc n) thus "?case"
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   337
    by(simp add: get_fstn_args.simps rec_exec.simps 
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   338
             take_Suc_conv_app_nth)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   339
qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   340
    
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
   341
lemma arity_primerec[simp]: "primerec f n \<Longrightarrow> arity f = n"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   342
  apply(case_tac f)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   343
  apply(auto simp: arity.simps )
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   344
  apply(erule_tac prime_mn_reverse)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   345
  done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   346
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   347
lemma rec_sigma_Suc_simp_rewrite: 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   348
  "primerec f (Suc (length xs))
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   349
    \<Longrightarrow> rec_exec (rec_sigma f) (xs @ [Suc x]) = 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   350
    rec_exec (rec_sigma f) (xs @ [x]) + rec_exec f (xs @ [Suc x])"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   351
  apply(induct x)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   352
  apply(auto simp: rec_sigma.simps Let_def rec_pr_Suc_simp_rewrite
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   353
                   rec_exec.simps get_fstn_args_take)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   354
  done      
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   355
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   356
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   357
  The correctness of @{text "rec_sigma"} with respect to its specification.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   358
  *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   359
lemma sigma_lemma: 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   360
  "primerec rg (Suc (length xs))
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   361
     \<Longrightarrow> rec_exec (rec_sigma rg) (xs @ [x]) = Sigma (rec_exec rg) (xs @ [x])"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   362
apply(induct x)
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   363
apply(auto simp: rec_exec.simps rec_sigma.simps Let_def 
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   364
         get_fstn_args_take Sigma_0_simp_rewrite
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   365
         Sigma_Suc_simp_rewrite) 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   366
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   367
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   368
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   369
  @{text "rec_accum f (x1, x2, \<dots>, xn, k) = 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   370
           f(x1, x2, \<dots>, xn, 0) * 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   371
           f(x1, x2, \<dots>, xn, 1) *
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   372
               \<dots> 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   373
           f(x1, x2, \<dots>, xn, k)"}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   374
*}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   375
fun rec_accum :: "recf \<Rightarrow> recf"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   376
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   377
  "rec_accum rf = 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   378
       (let vl = arity rf in 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   379
          Pr (vl - 1) (Cn (vl - 1) rf (get_fstn_args (vl - 1) (vl - 1) @ 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   380
                     [Cn (vl - 1) (constn 0) [id (vl - 1) 0]])) 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   381
             (Cn (Suc vl) rec_mult [id (Suc vl) (vl), 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   382
                    Cn (Suc vl) rf (get_fstn_args (Suc vl) (vl - 1) 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   383
                      @ [Cn (Suc vl) s [id (Suc vl) (vl - 1)]])]))"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   384
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   385
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   386
  @{text "Accum"} is the formal specification of @{text "rec_accum"}.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   387
  *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   388
function Accum :: "(nat list \<Rightarrow> nat) \<Rightarrow> nat list \<Rightarrow> nat"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   389
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   390
  "Accum f xs = (if last xs = 0 then f xs 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   391
                     else (Accum f (butlast xs @ [last xs - 1]) *
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   392
                       f xs))"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   393
by pat_completeness auto
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   394
termination
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   395
proof
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   396
  show "wf (measure (\<lambda> (f, xs). last xs))"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   397
    by auto
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   398
next
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   399
  fix f xs
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   400
  assume "last xs \<noteq> (0::nat)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   401
  thus "((f, butlast xs @ [last xs - 1]), f, xs) \<in> 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   402
            measure (\<lambda>(f, xs). last xs)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   403
    by auto
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   404
qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   405
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   406
lemma rec_accum_Suc_simp_rewrite: 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   407
  "primerec f (Suc (length xs))
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   408
    \<Longrightarrow> rec_exec (rec_accum f) (xs @ [Suc x]) = 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   409
    rec_exec (rec_accum f) (xs @ [x]) * rec_exec f (xs @ [Suc x])"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   410
  apply(induct x)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   411
  apply(auto simp: rec_sigma.simps Let_def rec_pr_Suc_simp_rewrite
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   412
                   rec_exec.simps get_fstn_args_take)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   413
  done  
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   414
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   415
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   416
  The correctness of @{text "rec_accum"} with respect to its specification.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   417
*}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   418
lemma accum_lemma :
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   419
  "primerec rg (Suc (length xs))
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   420
     \<Longrightarrow> rec_exec (rec_accum rg) (xs @ [x]) = Accum (rec_exec rg) (xs @ [x])"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   421
apply(induct x)
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   422
apply(auto simp: rec_exec.simps rec_sigma.simps Let_def 
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   423
                     get_fstn_args_take)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   424
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   425
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   426
declare rec_accum.simps [simp del]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   427
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   428
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   429
  @{text "rec_all t f (x1, x2, \<dots>, xn)"} 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   430
  computes the charactrization function of the following FOL formula:
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   431
  @{text "(\<forall> x \<le> t(x1, x2, \<dots>, xn). (f(x1, x2, \<dots>, xn, x) > 0))"}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   432
*}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   433
fun rec_all :: "recf \<Rightarrow> recf \<Rightarrow> recf"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   434
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   435
  "rec_all rt rf = 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   436
    (let vl = arity rf in
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   437
       Cn (vl - 1) rec_sg [Cn (vl - 1) (rec_accum rf) 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   438
                 (get_fstn_args (vl - 1) (vl - 1) @ [rt])])"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   439
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   440
lemma rec_accum_ex: "primerec rf (Suc (length xs)) \<Longrightarrow>
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   441
     (rec_exec (rec_accum rf) (xs @ [x]) = 0) = 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   442
      (\<exists> t \<le> x. rec_exec rf (xs @ [t]) = 0)"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   443
apply(induct x, simp_all add: rec_accum_Suc_simp_rewrite)
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   444
apply(simp add: rec_exec.simps rec_accum.simps get_fstn_args_take, 
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   445
      auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   446
apply(rule_tac x = ta in exI, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   447
apply(case_tac "t = Suc x", simp_all)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   448
apply(rule_tac x = t in exI, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   449
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   450
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   451
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   452
  The correctness of @{text "rec_all"}.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   453
  *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   454
lemma all_lemma: 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   455
  "\<lbrakk>primerec rf (Suc (length xs));
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   456
    primerec rt (length xs)\<rbrakk>
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   457
  \<Longrightarrow> rec_exec (rec_all rt rf) xs = (if (\<forall> x \<le> (rec_exec rt xs). 0 < rec_exec rf (xs @ [x])) then 1
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   458
                                                                                              else 0)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   459
apply(auto simp: rec_all.simps)
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   460
apply(simp add: rec_exec.simps map_append get_fstn_args_take split: if_splits)
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   461
apply(drule_tac x = "rec_exec rt xs" in rec_accum_ex)
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   462
apply(case_tac "rec_exec (rec_accum rf) (xs @ [rec_exec rt xs]) = 0", simp_all)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   463
apply(erule_tac exE, erule_tac x = t in allE, simp)
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   464
apply(simp add: rec_exec.simps map_append get_fstn_args_take)
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   465
apply(drule_tac x = "rec_exec rt xs" in rec_accum_ex)
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   466
apply(case_tac "rec_exec (rec_accum rf) (xs @ [rec_exec rt xs]) = 0", simp, simp)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   467
apply(erule_tac x = x in allE, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   468
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   469
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   470
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   471
  @{text "rec_ex t f (x1, x2, \<dots>, xn)"} 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   472
  computes the charactrization function of the following FOL formula:
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   473
  @{text "(\<exists> x \<le> t(x1, x2, \<dots>, xn). (f(x1, x2, \<dots>, xn, x) > 0))"}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   474
*}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   475
fun rec_ex :: "recf \<Rightarrow> recf \<Rightarrow> recf"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   476
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   477
  "rec_ex rt rf = 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   478
       (let vl = arity rf in 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   479
         Cn (vl - 1) rec_sg [Cn (vl - 1) (rec_sigma rf) 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   480
                  (get_fstn_args (vl - 1) (vl - 1) @ [rt])])"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   481
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   482
lemma rec_sigma_ex: "primerec rf (Suc (length xs))
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   483
          \<Longrightarrow> (rec_exec (rec_sigma rf) (xs @ [x]) = 0) = 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   484
                          (\<forall> t \<le> x. rec_exec rf (xs @ [t]) = 0)"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   485
apply(induct x, simp_all add: rec_sigma_Suc_simp_rewrite)
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   486
apply(simp add: rec_exec.simps rec_sigma.simps 
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   487
                get_fstn_args_take, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   488
apply(case_tac "t = Suc x", simp_all)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   489
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   490
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   491
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   492
  The correctness of @{text "ex_lemma"}.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   493
  *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   494
lemma ex_lemma:"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   495
  \<lbrakk>primerec rf (Suc (length xs));
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   496
   primerec rt (length xs)\<rbrakk>
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   497
\<Longrightarrow> (rec_exec (rec_ex rt rf) xs =
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   498
    (if (\<exists> x \<le> (rec_exec rt xs). 0 <rec_exec rf (xs @ [x])) then 1
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   499
     else 0))"
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   500
apply(auto simp: rec_ex.simps rec_exec.simps map_append get_fstn_args_take 
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   501
            split: if_splits)
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   502
apply(drule_tac x = "rec_exec rt xs" in rec_sigma_ex, simp)
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   503
apply(drule_tac x = "rec_exec rt xs" in rec_sigma_ex, simp)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   504
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   505
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   506
text {*
199
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 198
diff changeset
   507
  Definition of @{text "Min[R]"} on page 77 of Boolos's book.
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   508
*}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   509
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   510
fun Minr :: "(nat list \<Rightarrow> bool) \<Rightarrow> nat list \<Rightarrow> nat \<Rightarrow> nat"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   511
  where "Minr Rr xs w = (let setx = {y | y. (y \<le> w) \<and> Rr (xs @ [y])} in 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   512
                        if (setx = {}) then (Suc w)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   513
                                       else (Min setx))"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   514
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   515
declare Minr.simps[simp del] rec_all.simps[simp del]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   516
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   517
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   518
  The following is a set of auxilliary lemmas about @{text "Minr"}.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   519
*}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   520
lemma Minr_range: "Minr Rr xs w \<le> w \<or> Minr Rr xs w = Suc w"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   521
apply(auto simp: Minr.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   522
apply(subgoal_tac "Min {x. x \<le> w \<and> Rr (xs @ [x])} \<le> x")
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   523
apply(erule_tac order_trans, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   524
apply(rule_tac Min_le, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   525
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   526
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
   527
lemma expand_conj_in_set: "{x. x \<le> Suc w \<and> Rr (xs @ [x])}
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   528
    = (if Rr (xs @ [Suc w]) then insert (Suc w) 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   529
                              {x. x \<le> w \<and> Rr (xs @ [x])}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   530
      else {x. x \<le> w \<and> Rr (xs @ [x])})"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   531
by(auto, case_tac "x = Suc w", auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   532
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
   533
lemma Minr_strip_Suc[simp]: "Minr Rr xs w \<le> w \<Longrightarrow> Minr Rr xs (Suc w) = Minr Rr xs w"
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
   534
by(cases "\<forall>x\<le>w. \<not> Rr (xs @ [x])",auto simp add: Minr.simps expand_conj_in_set)
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
   535
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
   536
lemma x_empty_set[simp]: "\<forall>x\<le>w. \<not> Rr (xs @ [x]) \<Longrightarrow>  
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   537
                           {x. x \<le> w \<and> Rr (xs @ [x])} = {} "
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   538
by auto
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   539
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
   540
lemma Minr_is_Suc[simp]: "\<lbrakk>Minr Rr xs w = Suc w; Rr (xs @ [Suc w])\<rbrakk> \<Longrightarrow> 
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   541
                                       Minr Rr xs (Suc w) = Suc w"
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
   542
apply(simp add: Minr.simps expand_conj_in_set)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   543
apply(case_tac "\<forall>x\<le>w. \<not> Rr (xs @ [x])", auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   544
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   545
 
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
   546
lemma Minr_is_Suc_Suc[simp]: "\<lbrakk>Minr Rr xs w = Suc w; \<not> Rr (xs @ [Suc w])\<rbrakk> \<Longrightarrow> 
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   547
                                   Minr Rr xs (Suc w) = Suc (Suc w)"
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
   548
apply(simp add: Minr.simps expand_conj_in_set)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   549
apply(case_tac "\<forall>x\<le>w. \<not> Rr (xs @ [x])", auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   550
apply(subgoal_tac "Min {x. x \<le> w \<and> Rr (xs @ [x])} \<in> 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   551
                                {x. x \<le> w \<and> Rr (xs @ [x])}", simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   552
apply(rule_tac Min_in, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   553
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   554
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   555
lemma Minr_Suc_simp: 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   556
   "Minr Rr xs (Suc w) = 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   557
      (if Minr Rr xs w \<le> w then Minr Rr xs w
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   558
       else if (Rr (xs @ [Suc w])) then (Suc w)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   559
       else Suc (Suc w))"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   560
by(insert Minr_range[of Rr xs w], auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   561
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   562
text {* 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   563
  @{text "rec_Minr"} is the recursive function 
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   564
  used to implement @{text "Minr"}:
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   565
  if @{text "Rr"} is implemented by a recursive function @{text "recf"},
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   566
  then @{text "rec_Minr recf"} is the recursive function used to 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   567
  implement @{text "Minr Rr"}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   568
 *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   569
fun rec_Minr :: "recf \<Rightarrow> recf"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   570
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   571
  "rec_Minr rf = 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   572
     (let vl = arity rf
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   573
      in let rq = rec_all (id vl (vl - 1)) (Cn (Suc vl) 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   574
              rec_not [Cn (Suc vl) rf 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   575
                    (get_fstn_args (Suc vl) (vl - 1) @
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   576
                                        [id (Suc vl) (vl)])]) 
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   577
      in  rec_sigma rq)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   578
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   579
lemma length_getpren_params[simp]: "length (get_fstn_args m n) = n"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   580
by(induct n, auto simp: get_fstn_args.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   581
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   582
lemma length_app:
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   583
  "(length (get_fstn_args (arity rf - Suc 0)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   584
                           (arity rf - Suc 0)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   585
   @ [Cn (arity rf - Suc 0) (constn 0)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   586
           [recf.id (arity rf - Suc 0) 0]]))
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   587
    = (Suc (arity rf - Suc 0))"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   588
  apply(simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   589
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   590
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   591
lemma primerec_accum: "primerec (rec_accum rf) n \<Longrightarrow> primerec rf n"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   592
apply(auto simp: rec_accum.simps Let_def)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   593
apply(erule_tac prime_pr_reverse, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   594
apply(erule_tac prime_cn_reverse, simp only: length_app)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   595
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   596
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   597
lemma primerec_all: "primerec (rec_all rt rf) n \<Longrightarrow>
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   598
                       primerec rt n \<and> primerec rf (Suc n)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   599
apply(simp add: rec_all.simps Let_def)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   600
apply(erule_tac prime_cn_reverse, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   601
apply(erule_tac prime_cn_reverse, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   602
apply(erule_tac x = n in allE, simp add: nth_append primerec_accum)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   603
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   604
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   605
lemma min_Suc_Suc[simp]: "min (Suc (Suc x)) x = x"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   606
 by auto
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   607
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   608
declare numeral_3_eq_3[simp]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   609
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
   610
lemma primerec_rec_pred_1[intro]: "primerec rec_pred (Suc 0)"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   611
apply(simp add: rec_pred_def)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   612
apply(rule_tac prime_cn, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   613
apply(case_tac i, auto intro: prime_id)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   614
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   615
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
   616
lemma primerec_rec_minus_2[intro]: "primerec rec_minus (Suc (Suc 0))"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   617
  apply(auto simp: rec_minus_def)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   618
  done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   619
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
   620
lemma primerec_constn_1[intro]: "primerec (constn n) (Suc 0)"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   621
  apply(induct n)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   622
  apply(auto simp: constn.simps intro: prime_z prime_cn prime_s)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   623
  done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   624
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
   625
lemma primerec_rec_sg_1[intro]: "primerec rec_sg (Suc 0)" 
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   626
  apply(simp add: rec_sg_def)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   627
  apply(rule_tac k = "Suc (Suc 0)" in prime_cn, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   628
  apply(case_tac i, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   629
  apply(case_tac ia, auto intro: prime_id)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   630
  done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   631
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
   632
lemma primerec_getpren[elim]: "\<lbrakk>i < n; n \<le> m\<rbrakk> \<Longrightarrow> primerec (get_fstn_args m n ! i) m"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   633
apply(induct n, auto simp: get_fstn_args.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   634
apply(case_tac "i = n", auto simp: nth_append intro: prime_id)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   635
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   636
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
   637
lemma primerec_rec_add_2[intro]: "primerec rec_add (Suc (Suc 0))"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   638
apply(simp add: rec_add_def)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   639
apply(rule_tac prime_pr, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   640
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   641
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
   642
lemma primerec_rec_mult_2[intro]:"primerec rec_mult (Suc (Suc 0))"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   643
apply(simp add: rec_mult_def )
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   644
apply(rule_tac prime_pr, auto intro: prime_z)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   645
apply(case_tac i, auto intro: prime_id)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   646
done  
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   647
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
   648
lemma primerec_ge_2_elim[elim]: "\<lbrakk>primerec rf n; n \<ge> Suc (Suc 0)\<rbrakk>   \<Longrightarrow> 
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   649
                        primerec (rec_accum rf) n"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   650
apply(auto simp: rec_accum.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   651
apply(simp add: nth_append, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   652
apply(case_tac i, auto intro: prime_id)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   653
apply(auto simp: nth_append)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   654
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   655
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   656
lemma primerec_all_iff: 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   657
  "\<lbrakk>primerec rt n; primerec rf (Suc n); n > 0\<rbrakk> \<Longrightarrow> 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   658
                                 primerec (rec_all rt rf) n"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   659
  apply(simp add: rec_all.simps, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   660
  apply(auto, simp add: nth_append, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   661
  done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   662
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
   663
lemma min_P0[simp]: "Rr (xs @ [0]) \<Longrightarrow> 
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   664
                   Min {x. x = (0::nat) \<and> Rr (xs @ [x])} = 0"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   665
by(rule_tac Min_eqI, simp, simp, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   666
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
   667
lemma primerec_rec_not_1[intro]: "primerec rec_not (Suc 0)"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   668
apply(simp add: rec_not_def)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   669
apply(rule prime_cn, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   670
apply(case_tac i, auto intro: prime_id)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   671
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   672
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   673
lemma Min_false1[simp]: "\<lbrakk>\<not> Min {uu. uu \<le> w \<and> 0 < rec_exec rf (xs @ [uu])} \<le> w;
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   674
       x \<le> w; 0 < rec_exec rf (xs @ [x])\<rbrakk>
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   675
      \<Longrightarrow>  False"
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   676
apply(subgoal_tac "finite {uu. uu \<le> w \<and> 0 < rec_exec rf (xs @ [uu])}")
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   677
apply(subgoal_tac "{uu. uu \<le> w \<and> 0 < rec_exec rf (xs @ [uu])} \<noteq> {}")
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   678
apply(simp add: Min_le_iff, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   679
apply(rule_tac x = x in exI, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   680
apply(simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   681
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   682
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   683
lemma sigma_minr_lemma: 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   684
  assumes prrf:  "primerec rf (Suc (length xs))"
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   685
  shows "UF.Sigma (rec_exec (rec_all (recf.id (Suc (length xs)) (length xs))
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   686
     (Cn (Suc (Suc (length xs))) rec_not
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   687
      [Cn (Suc (Suc (length xs))) rf (get_fstn_args (Suc (Suc (length xs))) 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   688
       (length xs) @ [recf.id (Suc (Suc (length xs))) (Suc (length xs))])])))
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   689
      (xs @ [w]) =
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   690
       Minr (\<lambda>args. 0 < rec_exec rf args) xs w"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   691
proof(induct w)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   692
  let ?rt = "(recf.id (Suc (length xs)) ((length xs)))"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   693
  let ?rf = "(Cn (Suc (Suc (length xs))) 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   694
    rec_not [Cn (Suc (Suc (length xs))) rf 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   695
    (get_fstn_args (Suc (Suc (length xs))) (length xs) @ 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   696
                [recf.id (Suc (Suc (length xs))) 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   697
    (Suc ((length xs)))])])"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   698
  let ?rq = "(rec_all ?rt ?rf)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   699
  have prrf: "primerec ?rf (Suc (length (xs @ [0]))) \<and>
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   700
        primerec ?rt (length (xs @ [0]))"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   701
    apply(auto simp: prrf nth_append)+
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   702
    done
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   703
  show "Sigma (rec_exec (rec_all ?rt ?rf)) (xs @ [0])
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   704
       = Minr (\<lambda>args. 0 < rec_exec rf args) xs 0"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   705
    apply(simp add: Sigma.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   706
    apply(simp only: prrf all_lemma,  
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   707
          auto simp: rec_exec.simps get_fstn_args_take Minr.simps)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   708
    apply(rule_tac Min_eqI, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   709
    done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   710
next
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   711
  fix w
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   712
  let ?rt = "(recf.id (Suc (length xs)) ((length xs)))"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   713
  let ?rf = "(Cn (Suc (Suc (length xs))) 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   714
    rec_not [Cn (Suc (Suc (length xs))) rf 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   715
    (get_fstn_args (Suc (Suc (length xs))) (length xs) @ 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   716
                [recf.id (Suc (Suc (length xs))) 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   717
    (Suc ((length xs)))])])"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   718
  let ?rq = "(rec_all ?rt ?rf)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   719
  assume ind:
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   720
    "Sigma (rec_exec (rec_all ?rt ?rf)) (xs @ [w]) = Minr (\<lambda>args. 0 < rec_exec rf args) xs w"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   721
  have prrf: "primerec ?rf (Suc (length (xs @ [Suc w]))) \<and>
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   722
        primerec ?rt (length (xs @ [Suc w]))"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   723
    apply(auto simp: prrf nth_append)+
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   724
    done
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   725
  show "UF.Sigma (rec_exec (rec_all ?rt ?rf))
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   726
         (xs @ [Suc w]) =
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   727
        Minr (\<lambda>args. 0 < rec_exec rf args) xs (Suc w)"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   728
    apply(auto simp: Sigma_Suc_simp_rewrite ind Minr_Suc_simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   729
    apply(simp_all only: prrf all_lemma)
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   730
    apply(auto simp: rec_exec.simps get_fstn_args_take Let_def Minr.simps split: if_splits)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   731
    apply(drule_tac Min_false1, simp, simp, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   732
    apply(case_tac "x = Suc w", simp, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   733
    apply(drule_tac Min_false1, simp, simp, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   734
    apply(drule_tac Min_false1, simp, simp, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   735
    done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   736
qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   737
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   738
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   739
  The correctness of @{text "rec_Minr"}.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   740
  *}
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   741
lemma Minr_lemma: "
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   742
  \<lbrakk>primerec rf (Suc (length xs))\<rbrakk> 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   743
     \<Longrightarrow> rec_exec (rec_Minr rf) (xs @ [w]) = 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   744
            Minr (\<lambda> args. (0 < rec_exec rf args)) xs w"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   745
proof -
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   746
  let ?rt = "(recf.id (Suc (length xs)) ((length xs)))"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   747
  let ?rf = "(Cn (Suc (Suc (length xs))) 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   748
    rec_not [Cn (Suc (Suc (length xs))) rf 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   749
    (get_fstn_args (Suc (Suc (length xs))) (length xs) @ 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   750
                [recf.id (Suc (Suc (length xs))) 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   751
    (Suc ((length xs)))])])"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   752
  let ?rq = "(rec_all ?rt ?rf)"
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   753
  assume h: "primerec rf (Suc (length xs))"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   754
  have h1: "primerec ?rq (Suc (length xs))"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   755
    apply(rule_tac primerec_all_iff)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   756
    apply(auto simp: h nth_append)+
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   757
    done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   758
  moreover have "arity rf = Suc (length xs)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   759
    using h by auto
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   760
  ultimately show "rec_exec (rec_Minr rf) (xs @ [w]) = 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   761
    Minr (\<lambda> args. (0 < rec_exec rf args)) xs w"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   762
    apply(simp add: rec_exec.simps rec_Minr.simps arity.simps Let_def 
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   763
                    sigma_lemma all_lemma)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   764
    apply(rule_tac  sigma_minr_lemma)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   765
    apply(simp add: h)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   766
    done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   767
qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   768
    
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   769
text {* 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   770
  @{text "rec_le"} is the comparasion function 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   771
  which compares its two arguments, testing whether the 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   772
  first is less or equal to the second.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   773
  *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   774
definition rec_le :: "recf"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   775
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   776
  "rec_le = Cn (Suc (Suc 0)) rec_disj [rec_less, rec_eq]"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   777
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   778
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   779
  The correctness of @{text "rec_le"}.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   780
  *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   781
lemma le_lemma: 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   782
  "\<And>x y. rec_exec rec_le [x, y] = (if (x \<le> y) then 1 else 0)"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   783
by(auto simp: rec_le_def rec_exec.simps)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   784
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   785
text {*
199
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 198
diff changeset
   786
  Definition of @{text "Max[Rr]"} on page 77 of Boolos's book.
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   787
*}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   788
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   789
fun Maxr :: "(nat list \<Rightarrow> bool) \<Rightarrow> nat list \<Rightarrow> nat \<Rightarrow> nat"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   790
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   791
  "Maxr Rr xs w = (let setx = {y. y \<le> w \<and> Rr (xs @[y])} in 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   792
                  if setx = {} then 0
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   793
                  else Max setx)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   794
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   795
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   796
  @{text "rec_maxr"} is the recursive function 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   797
  used to implementation @{text "Maxr"}.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   798
  *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   799
fun rec_maxr :: "recf \<Rightarrow> recf"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   800
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   801
  "rec_maxr rr = (let vl = arity rr in 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   802
                  let rt = id (Suc vl) (vl - 1) in
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   803
                  let rf1 = Cn (Suc (Suc vl)) rec_le 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   804
                    [id (Suc (Suc vl)) 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   805
                     ((Suc vl)), id (Suc (Suc vl)) (vl)] in
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   806
                  let rf2 = Cn (Suc (Suc vl)) rec_not 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   807
                      [Cn (Suc (Suc vl)) 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   808
                           rr (get_fstn_args (Suc (Suc vl)) 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   809
                            (vl - 1) @ 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   810
                             [id (Suc (Suc vl)) ((Suc vl))])] in
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   811
                  let rf = Cn (Suc (Suc vl)) rec_disj [rf1, rf2] in
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   812
                  let Qf = Cn (Suc vl) rec_not [rec_all rt rf]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   813
                  in Cn vl (rec_sigma Qf) (get_fstn_args vl vl @
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   814
                                                         [id vl (vl - 1)]))"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   815
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   816
declare rec_maxr.simps[simp del] Maxr.simps[simp del] 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   817
declare le_lemma[simp]
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
   818
lemma min_with_suc3[simp]: "(min (Suc (Suc (Suc (x)))) (x)) = x"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   819
by simp
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   820
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   821
declare numeral_2_eq_2[simp]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   822
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
   823
lemma primerec_rec_disj_2[intro]: "primerec rec_disj (Suc (Suc 0))"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   824
  apply(simp add: rec_disj_def, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   825
  apply(auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   826
  apply(case_tac ia, auto intro: prime_id)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   827
  done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   828
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
   829
lemma primerec_rec_less_2[intro]: "primerec rec_less (Suc (Suc 0))"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   830
  apply(simp add: rec_less_def, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   831
  apply(auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   832
  apply(case_tac ia , auto intro: prime_id)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   833
  done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   834
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
   835
lemma primerec_rec_eq_2[intro]: "primerec rec_eq (Suc (Suc 0))"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   836
  apply(simp add: rec_eq_def)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   837
  apply(rule_tac prime_cn, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   838
  apply(case_tac i, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   839
  apply(case_tac ia, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   840
  apply(case_tac [!] i, auto intro: prime_id)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   841
  done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   842
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
   843
lemma primerec_rec_le_2[intro]: "primerec rec_le (Suc (Suc 0))"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   844
  apply(simp add: rec_le_def)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   845
  apply(rule_tac prime_cn, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   846
  apply(case_tac i, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   847
  done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   848
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
   849
lemma take_butlast_list_plus_two[simp]:  
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   850
  "length ys = Suc n \<Longrightarrow> (take n ys @ [ys ! n, ys ! n]) =  
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   851
                                                  ys @ [ys ! n]"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   852
apply(simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   853
apply(subgoal_tac "\<exists> xs y. ys = xs @ [y]", auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   854
apply(rule_tac x = "butlast ys" in exI, rule_tac x = "last ys" in exI)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   855
apply(case_tac "ys = []", simp_all)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   856
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   857
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   858
lemma Maxr_Suc_simp: 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   859
  "Maxr Rr xs (Suc w) =(if Rr (xs @ [Suc w]) then Suc w
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   860
     else Maxr Rr xs w)"
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
   861
apply(auto simp: Maxr.simps expand_conj_in_set)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   862
apply(rule_tac Max_eqI, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   863
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   864
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
   865
lemma min_Suc_1[simp]: "min (Suc n) n = n" by simp
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   866
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   867
lemma Sigma_0: "\<forall> i \<le> n. (f (xs @ [i]) = 0) \<Longrightarrow> 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   868
                              Sigma f (xs @ [n]) = 0"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   869
apply(induct n, simp add: Sigma.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   870
apply(simp add: Sigma_Suc_simp_rewrite)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   871
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   872
  
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
   873
lemma Sigma_Suc[elim]: "\<forall>k<Suc w. f (xs @ [k]) = Suc 0
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   874
        \<Longrightarrow> Sigma f (xs @ [w]) = Suc w"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   875
apply(induct w)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   876
apply(simp add: Sigma.simps, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   877
apply(simp add: Sigma.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   878
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   879
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   880
lemma Sigma_max_point: "\<lbrakk>\<forall> k < ma. f (xs @ [k]) = 1;
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   881
        \<forall> k \<ge> ma. f (xs @ [k]) = 0; ma \<le> w\<rbrakk>
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   882
    \<Longrightarrow> Sigma f (xs @ [w]) = ma"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   883
apply(induct w, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   884
apply(rule_tac Sigma_0, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   885
apply(simp add: Sigma_Suc_simp_rewrite)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   886
apply(case_tac "ma = Suc w", auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   887
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   888
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   889
lemma Sigma_Max_lemma: 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   890
  assumes prrf: "primerec rf (Suc (length xs))"
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   891
  shows "UF.Sigma (rec_exec (Cn (Suc (Suc (length xs))) rec_not
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   892
  [rec_all (recf.id (Suc (Suc (length xs))) (length xs))
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   893
  (Cn (Suc (Suc (Suc (length xs)))) rec_disj
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   894
  [Cn (Suc (Suc (Suc (length xs)))) rec_le
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   895
  [recf.id (Suc (Suc (Suc (length xs)))) (Suc (Suc (length xs))), 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   896
  recf.id (Suc (Suc (Suc (length xs)))) (Suc (length xs))],
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   897
  Cn (Suc (Suc (Suc (length xs)))) rec_not
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   898
  [Cn (Suc (Suc (Suc (length xs)))) rf
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   899
  (get_fstn_args (Suc (Suc (Suc (length xs)))) (length xs) @ 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   900
  [recf.id (Suc (Suc (Suc (length xs)))) (Suc (Suc (length xs)))])]])]))
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   901
  ((xs @ [w]) @ [w]) =
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   902
       Maxr (\<lambda>args. 0 < rec_exec rf args) xs w"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   903
proof -
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   904
  let ?rt = "(recf.id (Suc (Suc (length xs))) ((length xs)))"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   905
  let ?rf1 = "Cn (Suc (Suc (Suc (length xs))))
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   906
    rec_le [recf.id (Suc (Suc (Suc (length xs)))) 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   907
    ((Suc (Suc (length xs)))), recf.id 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   908
    (Suc (Suc (Suc (length xs)))) ((Suc (length xs)))]"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   909
  let ?rf2 = "Cn (Suc (Suc (Suc (length xs)))) rf 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   910
               (get_fstn_args (Suc (Suc (Suc (length xs))))
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   911
    (length xs) @ 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   912
    [recf.id (Suc (Suc (Suc (length xs))))    
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   913
    ((Suc (Suc (length xs))))])"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   914
  let ?rf3 = "Cn (Suc (Suc (Suc (length xs)))) rec_not [?rf2]"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   915
  let ?rf = "Cn (Suc (Suc (Suc (length xs)))) rec_disj [?rf1, ?rf3]"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   916
  let ?rq = "rec_all ?rt ?rf"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   917
  let ?notrq = "Cn (Suc (Suc (length xs))) rec_not [?rq]"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   918
  show "?thesis"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   919
  proof(auto simp: Maxr.simps)
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   920
    assume h: "\<forall>x\<le>w. rec_exec rf (xs @ [x]) = 0"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   921
    have "primerec ?rf (Suc (length (xs @ [w, i]))) \<and> 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   922
          primerec ?rt (length (xs @ [w, i]))"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   923
      using prrf
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   924
      apply(auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   925
      apply(case_tac i, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   926
      apply(case_tac ia, auto simp: h nth_append)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   927
      done
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   928
    hence "Sigma (rec_exec ?notrq) ((xs@[w])@[w]) = 0"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   929
      apply(rule_tac Sigma_0)
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   930
      apply(auto simp: rec_exec.simps all_lemma
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   931
                       get_fstn_args_take nth_append h)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   932
      done
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   933
    thus "UF.Sigma (rec_exec ?notrq)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   934
      (xs @ [w, w]) = 0"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   935
      by simp
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   936
  next
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   937
    fix x
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   938
    assume h: "x \<le> w" "0 < rec_exec rf (xs @ [x])"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   939
    hence "\<exists> ma. Max {y. y \<le> w \<and> 0 < rec_exec rf (xs @ [y])} = ma"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   940
      by auto
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   941
    from this obtain ma where k1: 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   942
      "Max {y. y \<le> w \<and> 0 < rec_exec rf (xs @ [y])} = ma" ..
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   943
    hence k2: "ma \<le> w \<and> 0 < rec_exec rf (xs @ [ma])"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   944
      using h
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   945
      apply(subgoal_tac
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   946
        "Max {y. y \<le> w \<and> 0 < rec_exec rf (xs @ [y])} \<in>  {y. y \<le> w \<and> 0 < rec_exec rf (xs @ [y])}")
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   947
      apply(erule_tac CollectE, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   948
      apply(rule_tac Max_in, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   949
      done
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   950
    hence k3: "\<forall> k < ma. (rec_exec ?notrq (xs @ [w, k]) = 1)"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   951
      apply(auto simp: nth_append)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   952
      apply(subgoal_tac "primerec ?rf (Suc (length (xs @ [w, k]))) \<and> 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   953
        primerec ?rt (length (xs @ [w, k]))")
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   954
      apply(auto simp: rec_exec.simps all_lemma get_fstn_args_take nth_append)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   955
      using prrf
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   956
      apply(case_tac i, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   957
      apply(case_tac ia, auto simp: h nth_append)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   958
      done    
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   959
    have k4: "\<forall> k \<ge> ma. (rec_exec ?notrq (xs @ [w, k]) = 0)"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   960
      apply(auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   961
      apply(subgoal_tac "primerec ?rf (Suc (length (xs @ [w, k]))) \<and> 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   962
        primerec ?rt (length (xs @ [w, k]))")
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   963
      apply(auto simp: rec_exec.simps all_lemma get_fstn_args_take nth_append)
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   964
      apply(subgoal_tac "x \<le> Max {y. y \<le> w \<and> 0 < rec_exec rf (xs @ [y])}",
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   965
        simp add: k1)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   966
      apply(rule_tac Max_ge, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   967
      using prrf
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   968
      apply(case_tac i, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   969
      apply(case_tac ia, auto simp: h nth_append)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   970
      done 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   971
    from k3 k4 k1 have "Sigma (rec_exec ?notrq) ((xs @ [w]) @ [w]) = ma"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   972
      apply(rule_tac Sigma_max_point, simp, simp, simp add: k2)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   973
      done
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   974
    from k1 and this show "Sigma (rec_exec ?notrq) (xs @ [w, w]) =
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   975
      Max {y. y \<le> w \<and> 0 < rec_exec rf (xs @ [y])}"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   976
      by simp
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   977
  qed  
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   978
qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   979
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   980
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   981
  The correctness of @{text "rec_maxr"}.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   982
  *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   983
lemma Maxr_lemma:
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   984
 assumes h: "primerec rf (Suc (length xs))"
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   985
 shows   "rec_exec (rec_maxr rf) (xs @ [w]) = 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   986
            Maxr (\<lambda> args. 0 < rec_exec rf args) xs w"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   987
proof -
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   988
  from h have "arity rf = Suc (length xs)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   989
    by auto
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   990
  thus "?thesis"
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   991
  proof(simp add: rec_exec.simps rec_maxr.simps nth_append get_fstn_args_take)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   992
    let ?rt = "(recf.id (Suc (Suc (length xs))) ((length xs)))"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   993
    let ?rf1 = "Cn (Suc (Suc (Suc (length xs))))
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   994
                     rec_le [recf.id (Suc (Suc (Suc (length xs)))) 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   995
              ((Suc (Suc (length xs)))), recf.id 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   996
             (Suc (Suc (Suc (length xs)))) ((Suc (length xs)))]"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   997
    let ?rf2 = "Cn (Suc (Suc (Suc (length xs)))) rf 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   998
               (get_fstn_args (Suc (Suc (Suc (length xs))))
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   999
                (length xs) @ 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1000
                  [recf.id (Suc (Suc (Suc (length xs))))    
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1001
                           ((Suc (Suc (length xs))))])"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1002
    let ?rf3 = "Cn (Suc (Suc (Suc (length xs)))) rec_not [?rf2]"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1003
    let ?rf = "Cn (Suc (Suc (Suc (length xs)))) rec_disj [?rf1, ?rf3]"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1004
    let ?rq = "rec_all ?rt ?rf"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1005
    let ?notrq = "Cn (Suc (Suc (length xs))) rec_not [?rq]"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1006
    have prt: "primerec ?rt (Suc (Suc (length xs)))"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1007
      by(auto intro: prime_id)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1008
    have prrf: "primerec ?rf (Suc (Suc (Suc (length xs))))"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1009
      apply(auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1010
      apply(case_tac i, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1011
      apply(case_tac ia, auto intro: prime_id)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1012
      apply(simp add: h)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1013
      apply(simp add: nth_append, auto intro: prime_id)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1014
      done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1015
    from prt and prrf have prrq: "primerec ?rq 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1016
                                       (Suc (Suc (length xs)))"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1017
      by(erule_tac primerec_all_iff, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1018
    hence prnotrp: "primerec ?notrq (Suc (length ((xs @ [w]))))"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1019
      by(rule_tac prime_cn, auto)
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1020
    have g1: "rec_exec (rec_sigma ?notrq) ((xs @ [w]) @ [w]) 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1021
      = Maxr (\<lambda>args. 0 < rec_exec rf args) xs w"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1022
      using prnotrp
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1023
      using sigma_lemma
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1024
      apply(simp only: sigma_lemma)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1025
      apply(rule_tac Sigma_Max_lemma)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1026
      apply(simp add: h)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1027
      done
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1028
    thus "rec_exec (rec_sigma ?notrq)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1029
     (xs @ [w, w]) =
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1030
    Maxr (\<lambda>args. 0 < rec_exec rf args) xs w"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1031
      apply(simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1032
      done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1033
  qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1034
qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1035
      
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1036
text {* 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1037
  @{text "quo"} is the formal specification of division.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1038
 *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1039
fun quo :: "nat list \<Rightarrow> nat"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1040
  where
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1041
  "quo [x, y] = (let Rr = 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1042
                         (\<lambda> zs. ((zs ! (Suc 0) * zs ! (Suc (Suc 0))
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1043
                                 \<le> zs ! 0) \<and> zs ! Suc 0 \<noteq> (0::nat)))
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1044
                 in Maxr Rr [x, y] x)"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1045
 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1046
declare quo.simps[simp del]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1047
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1048
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1049
  The following lemmas shows more directly the menaing of @{text "quo"}:
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1050
  *}
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  1051
lemma quo_is_div: "y > 0 \<Longrightarrow> quo [x, y] = x div y"
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  1052
proof -
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  1053
  {
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1054
  fix xa ya
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1055
  assume h: "y * ya \<le> x"  "y > 0"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1056
  hence "(y * ya) div y \<le> x div y"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1057
    by(insert div_le_mono[of "y * ya" x y], simp)
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  1058
  from this and h have "ya \<le> x div y" by simp}
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  1059
  thus ?thesis by(simp add: quo.simps Maxr.simps, auto,
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  1060
      rule_tac Max_eqI, simp, auto)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1061
qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1062
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  1063
lemma quo_zero[intro]: "quo [x, 0] = 0"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1064
by(simp add: quo.simps Maxr.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1065
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1066
lemma quo_div: "quo [x, y] = x div y"  
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  1067
by(case_tac "y=0", auto elim!:quo_is_div)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1068
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1069
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1070
  @{text "rec_noteq"} is the recursive function testing whether its
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1071
  two arguments are not equal.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1072
  *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1073
definition rec_noteq:: "recf"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1074
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1075
  "rec_noteq = Cn (Suc (Suc 0)) rec_not [Cn (Suc (Suc 0)) 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1076
              rec_eq [id (Suc (Suc 0)) (0), id (Suc (Suc 0)) 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1077
                                        ((Suc 0))]]"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1078
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1079
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1080
  The correctness of @{text "rec_noteq"}.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1081
  *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1082
lemma noteq_lemma: 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1083
  "\<And> x y. rec_exec rec_noteq [x, y] = 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1084
               (if x \<noteq> y then 1 else 0)"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1085
by(simp add: rec_exec.simps rec_noteq_def)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1086
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1087
declare noteq_lemma[simp]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1088
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1089
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1090
  @{text "rec_quo"} is the recursive function used to implement @{text "quo"}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1091
  *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1092
definition rec_quo :: "recf"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1093
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1094
  "rec_quo = (let rR = Cn (Suc (Suc (Suc 0))) rec_conj
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1095
              [Cn (Suc (Suc (Suc 0))) rec_le 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1096
               [Cn (Suc (Suc (Suc 0))) rec_mult 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1097
                  [id (Suc (Suc (Suc 0))) (Suc 0), 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1098
                     id (Suc (Suc (Suc 0))) ((Suc (Suc 0)))],
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1099
                id (Suc (Suc (Suc 0))) (0)], 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1100
                Cn (Suc (Suc (Suc 0))) rec_noteq 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1101
                         [id (Suc (Suc (Suc 0))) (Suc (0)),
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1102
                Cn (Suc (Suc (Suc 0))) (constn 0) 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1103
                              [id (Suc (Suc (Suc 0))) (0)]]] 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1104
              in Cn (Suc (Suc 0)) (rec_maxr rR)) [id (Suc (Suc 0)) 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1105
                           (0),id (Suc (Suc 0)) (Suc (0)), 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1106
                                   id (Suc (Suc 0)) (0)]"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1107
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  1108
lemma primerec_rec_conj_2[intro]: "primerec rec_conj (Suc (Suc 0))"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1109
  apply(simp add: rec_conj_def)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1110
  apply(rule_tac prime_cn, auto)+
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1111
  apply(case_tac i, auto intro: prime_id)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1112
  done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1113
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  1114
lemma primerec_rec_noteq_2[intro]: "primerec rec_noteq (Suc (Suc 0))"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1115
apply(simp add: rec_noteq_def)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1116
apply(rule_tac prime_cn, auto)+
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1117
apply(case_tac i, auto intro: prime_id)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1118
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1119
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1120
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1121
lemma quo_lemma1: "rec_exec rec_quo [x, y] = quo [x, y]"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1122
proof(simp add: rec_exec.simps rec_quo_def)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1123
  let ?rR = "(Cn (Suc (Suc (Suc 0))) rec_conj
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1124
               [Cn (Suc (Suc (Suc 0))) rec_le
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1125
                   [Cn (Suc (Suc (Suc 0))) rec_mult 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1126
               [recf.id (Suc (Suc (Suc 0))) (Suc (0)), 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1127
                recf.id (Suc (Suc (Suc 0))) (Suc (Suc (0)))],
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1128
                 recf.id (Suc (Suc (Suc 0))) (0)],  
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1129
          Cn (Suc (Suc (Suc 0))) rec_noteq 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1130
                              [recf.id (Suc (Suc (Suc 0))) 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1131
             (Suc (0)), Cn (Suc (Suc (Suc 0))) (constn 0) 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1132
                      [recf.id (Suc (Suc (Suc 0))) (0)]]])"
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1133
  have "rec_exec (rec_maxr ?rR) ([x, y]@ [ x]) = Maxr (\<lambda> args. 0 < rec_exec ?rR args) [x, y] x"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1134
  proof(rule_tac Maxr_lemma, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1135
    show "primerec ?rR (Suc (Suc (Suc 0)))"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1136
      apply(auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1137
      apply(case_tac i, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1138
      apply(case_tac [!] ia, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1139
      apply(case_tac i, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1140
      done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1141
  qed
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1142
  hence g1: "rec_exec (rec_maxr ?rR) ([x, y,  x]) =
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1143
             Maxr (\<lambda> args. if rec_exec ?rR args = 0 then False
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1144
                           else True) [x, y] x" 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1145
    by simp
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1146
  have g2: "Maxr (\<lambda> args. if rec_exec ?rR args = 0 then False
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1147
                           else True) [x, y] x = quo [x, y]"
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1148
    apply(simp add: rec_exec.simps)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1149
    apply(simp add: Maxr.simps quo.simps, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1150
    done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1151
  from g1 and g2 show 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1152
    "rec_exec (rec_maxr ?rR) ([x, y,  x]) = quo [x, y]"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1153
    by simp
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1154
qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1155
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1156
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1157
  The correctness of @{text "quo"}.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1158
  *}
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1159
lemma quo_lemma2: "rec_exec rec_quo [x, y] = x div y"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1160
  using quo_lemma1[of x y] quo_div[of x y]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1161
  by simp
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1162
 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1163
text {* 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1164
  @{text "rec_mod"} is the recursive function used to implement 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1165
  the reminder function.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1166
  *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1167
definition rec_mod :: "recf"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1168
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1169
  "rec_mod = Cn (Suc (Suc 0)) rec_minus [id (Suc (Suc 0)) (0), 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1170
               Cn (Suc (Suc 0)) rec_mult [rec_quo, id (Suc (Suc 0))
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1171
                                                     (Suc (0))]]"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1172
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1173
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1174
  The correctness of @{text "rec_mod"}:
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1175
  *}
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1176
lemma mod_lemma: "\<And> x y. rec_exec rec_mod [x, y] = (x mod y)"
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  1177
  by(simp add: rec_exec.simps rec_mod_def quo_lemma2 minus_div_mult_eq_mod)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1178
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1179
text{* lemmas for embranch function*}
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1180
type_synonym ftype = "nat list \<Rightarrow> nat"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1181
type_synonym rtype = "nat list \<Rightarrow> bool"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1182
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1183
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1184
  The specifation of the mutli-way branching statement on
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1185
  page 79 of Boolos's book.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1186
  *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1187
fun Embranch :: "(ftype * rtype) list \<Rightarrow> nat list \<Rightarrow> nat"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1188
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1189
  "Embranch [] xs = 0" |
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1190
  "Embranch (gc # gcs) xs = (
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1191
                   let (g, c) = gc in 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1192
                   if c xs then g xs else Embranch gcs xs)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1193
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1194
fun rec_embranch' :: "(recf * recf) list \<Rightarrow> nat \<Rightarrow> recf"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1195
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1196
  "rec_embranch' [] vl = Cn vl z [id vl (vl - 1)]" |
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1197
  "rec_embranch' ((rg, rc) # rgcs) vl = Cn vl rec_add
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1198
                   [Cn vl rec_mult [rg, rc], rec_embranch' rgcs vl]"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1199
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1200
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1201
  @{text "rec_embrach"} is the recursive function used to implement
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1202
  @{text "Embranch"}.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1203
  *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1204
fun rec_embranch :: "(recf * recf) list \<Rightarrow> recf"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1205
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1206
  "rec_embranch ((rg, rc) # rgcs) = 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1207
         (let vl = arity rg in 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1208
          rec_embranch' ((rg, rc) # rgcs) vl)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1209
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1210
declare Embranch.simps[simp del] rec_embranch.simps[simp del]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1211
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1212
lemma embranch_all0: 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1213
  "\<lbrakk>\<forall> j < length rcs. rec_exec (rcs ! j) xs = 0;
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1214
    length rgs = length rcs;  
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1215
  rcs \<noteq> []; 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1216
  list_all (\<lambda> rf. primerec rf (length xs)) (rgs @ rcs)\<rbrakk>  \<Longrightarrow> 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1217
  rec_exec (rec_embranch (zip rgs rcs)) xs = 0"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1218
proof(induct rcs arbitrary: rgs, simp, case_tac rgs, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1219
  fix a rcs rgs aa list
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1220
  assume ind: 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1221
    "\<And>rgs. \<lbrakk>\<forall>j<length rcs. rec_exec (rcs ! j) xs = 0; 
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1222
             length rgs = length rcs; rcs \<noteq> []; 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1223
            list_all (\<lambda>rf. primerec rf (length xs)) (rgs @ rcs)\<rbrakk> \<Longrightarrow> 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1224
                      rec_exec (rec_embranch (zip rgs rcs)) xs = 0"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1225
  and h:  "\<forall>j<length (a # rcs). rec_exec ((a # rcs) ! j) xs = 0"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1226
  "length rgs = length (a # rcs)" 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1227
    "a # rcs \<noteq> []" 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1228
    "list_all (\<lambda>rf. primerec rf (length xs)) (rgs @ a # rcs)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1229
    "rgs = aa # list"
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1230
  have g: "rcs \<noteq> [] \<Longrightarrow> rec_exec (rec_embranch (zip list rcs)) xs = 0"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1231
    using h
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1232
    by(rule_tac ind, auto)
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1233
  show "rec_exec (rec_embranch (zip rgs (a # rcs))) xs = 0"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1234
  proof(case_tac "rcs = []", simp)
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1235
    show "rec_exec (rec_embranch (zip rgs [a])) xs = 0"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1236
      using h
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1237
      apply(simp add: rec_embranch.simps rec_exec.simps)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1238
      apply(erule_tac x = 0 in allE, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1239
      done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1240
  next
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1241
    assume "rcs \<noteq> []"
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1242
    hence "rec_exec (rec_embranch (zip list rcs)) xs = 0"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1243
      using g by simp
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1244
    thus "rec_exec (rec_embranch (zip rgs (a # rcs))) xs = 0"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1245
      using h
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1246
      apply(simp add: rec_embranch.simps rec_exec.simps)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1247
      apply(case_tac rcs,
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1248
        auto simp: rec_exec.simps rec_embranch.simps)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1249
      apply(case_tac list,
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1250
        auto simp: rec_exec.simps rec_embranch.simps)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1251
      done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1252
  qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1253
qed     
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1254
 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1255
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1256
lemma embranch_exec_0: "\<lbrakk>rec_exec aa xs = 0; zip rgs list \<noteq> []; 
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1257
       list_all (\<lambda> rf. primerec rf (length xs)) ([a, aa] @ rgs @ list)\<rbrakk>
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1258
       \<Longrightarrow> rec_exec (rec_embranch ((a, aa) # zip rgs list)) xs
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1259
         = rec_exec (rec_embranch (zip rgs list)) xs"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1260
apply(simp add: rec_exec.simps rec_embranch.simps)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1261
apply(case_tac "zip rgs list", simp, case_tac ab, 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1262
  simp add: rec_embranch.simps rec_exec.simps)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1263
apply(subgoal_tac "arity a = length xs", auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1264
apply(subgoal_tac "arity aaa = length xs", auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1265
apply(case_tac rgs, simp, case_tac list, simp, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1266
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1267
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1268
lemma zip_null_iff: "\<lbrakk>length xs = k; length ys = k; zip xs ys = []\<rbrakk> \<Longrightarrow> xs = [] \<and> ys = []"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1269
apply(case_tac xs, simp, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1270
apply(case_tac ys, simp, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1271
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1272
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1273
lemma zip_null_gr: "\<lbrakk>length xs = k; length ys = k; zip xs ys \<noteq> []\<rbrakk> \<Longrightarrow> 0 < k"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1274
apply(case_tac xs, simp, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1275
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1276
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1277
lemma Embranch_0:  
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1278
  "\<lbrakk>length rgs = k; length rcs = k; k > 0; 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1279
  \<forall> j < k. rec_exec (rcs ! j) xs = 0\<rbrakk> \<Longrightarrow>
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1280
  Embranch (zip (map rec_exec rgs) (map (\<lambda>r args. 0 < rec_exec r args) rcs)) xs = 0"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1281
proof(induct rgs arbitrary: rcs k, simp, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1282
  fix a rgs rcs k
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1283
  assume ind: 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1284
    "\<And>rcs k. \<lbrakk>length rgs = k; length rcs = k; 0 < k; \<forall>j<k. rec_exec (rcs ! j) xs = 0\<rbrakk> 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1285
    \<Longrightarrow> Embranch (zip (map rec_exec rgs) (map (\<lambda>r args. 0 < rec_exec r args) rcs)) xs = 0"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1286
  and h: "Suc (length rgs) = k" "length rcs = k"
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1287
    "\<forall>j<k. rec_exec (rcs ! j) xs = 0"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1288
  from h show  
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1289
    "Embranch (zip (rec_exec a # map rec_exec rgs) 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1290
           (map (\<lambda>r args. 0 < rec_exec r args) rcs)) xs = 0"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1291
    apply(case_tac rcs, simp, case_tac "rgs = []", simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1292
    apply(simp add: Embranch.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1293
    apply(erule_tac x = 0 in allE, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1294
    apply(simp add: Embranch.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1295
    apply(erule_tac x = 0 in all_dupE, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1296
    apply(rule_tac ind, simp, simp, simp, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1297
    apply(erule_tac x = "Suc j" in allE, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1298
    done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1299
qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1300
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1301
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1302
  The correctness of @{text "rec_embranch"}.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1303
  *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1304
lemma embranch_lemma:
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1305
  assumes branch_num:
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1306
  "length rgs = n" "length rcs = n" "n > 0"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1307
  and partition: 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1308
  "(\<exists> i < n. (rec_exec (rcs ! i) xs = 1 \<and> (\<forall> j < n. j \<noteq> i \<longrightarrow> 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1309
                                      rec_exec (rcs ! j) xs = 0)))"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1310
  and prime_all: "list_all (\<lambda> rf. primerec rf (length xs)) (rgs @ rcs)"
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1311
  shows "rec_exec (rec_embranch (zip rgs rcs)) xs =
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1312
                  Embranch (zip (map rec_exec rgs) 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1313
                     (map (\<lambda> r args. 0 < rec_exec r args) rcs)) xs"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1314
  using branch_num partition prime_all
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1315
proof(induct rgs arbitrary: rcs n, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1316
  fix a rgs rcs n
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1317
  assume ind: 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1318
    "\<And>rcs n. \<lbrakk>length rgs = n; length rcs = n; 0 < n;
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1319
    \<exists>i<n. rec_exec (rcs ! i) xs = 1 \<and> (\<forall>j<n. j \<noteq> i \<longrightarrow> rec_exec (rcs ! j) xs = 0);
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1320
    list_all (\<lambda>rf. primerec rf (length xs)) (rgs @ rcs)\<rbrakk>
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1321
    \<Longrightarrow> rec_exec (rec_embranch (zip rgs rcs)) xs =
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1322
    Embranch (zip (map rec_exec rgs) (map (\<lambda>r args. 0 < rec_exec r args) rcs)) xs"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1323
  and h: "length (a # rgs) = n" "length (rcs::recf list) = n" "0 < n"
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1324
         " \<exists>i<n. rec_exec (rcs ! i) xs = 1 \<and> 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1325
         (\<forall>j<n. j \<noteq> i \<longrightarrow> rec_exec (rcs ! j) xs = 0)" 
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1326
    "list_all (\<lambda>rf. primerec rf (length xs)) ((a # rgs) @ rcs)"
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1327
  from h show "rec_exec (rec_embranch (zip (a # rgs) rcs)) xs =
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1328
    Embranch (zip (map rec_exec (a # rgs)) (map (\<lambda>r args. 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1329
                0 < rec_exec r args) rcs)) xs"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1330
    apply(case_tac rcs, simp, simp)
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1331
    apply(case_tac "rec_exec aa xs = 0")
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1332
    apply(case_tac [!] "zip rgs list = []", simp)
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1333
    apply(subgoal_tac "rgs = [] \<and> list = []", simp add: Embranch.simps rec_exec.simps rec_embranch.simps)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1334
    apply(rule_tac  zip_null_iff, simp, simp, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1335
  proof -
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1336
    fix aa list
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1337
    assume g:
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1338
      "Suc (length rgs) = n" "Suc (length list) = n" 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1339
      "\<exists>i<n. rec_exec ((aa # list) ! i) xs = Suc 0 \<and> 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1340
          (\<forall>j<n. j \<noteq> i \<longrightarrow> rec_exec ((aa # list) ! j) xs = 0)"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1341
      "primerec a (length xs) \<and> 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1342
      list_all (\<lambda>rf. primerec rf (length xs)) rgs \<and>
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1343
      primerec aa (length xs) \<and> 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1344
      list_all (\<lambda>rf. primerec rf (length xs)) list"
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1345
      "rec_exec aa xs = 0" "rcs = aa # list" "zip rgs list \<noteq> []"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1346
    have "rec_exec (rec_embranch ((a, aa) # zip rgs list)) xs
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1347
        = rec_exec (rec_embranch (zip rgs list)) xs"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1348
      apply(rule embranch_exec_0, simp_all add: g)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1349
      done
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1350
    from g and this show "rec_exec (rec_embranch ((a, aa) # zip rgs list)) xs =
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1351
         Embranch ((rec_exec a, \<lambda>args. 0 < rec_exec aa args) # 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1352
           zip (map rec_exec rgs) (map (\<lambda>r args. 0 < rec_exec r args) list)) xs"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1353
      apply(simp add: Embranch.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1354
      apply(rule_tac n = "n - Suc 0" in ind)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1355
      apply(case_tac n, simp, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1356
      apply(case_tac n, simp, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1357
      apply(case_tac n, simp, simp add: zip_null_gr )
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1358
      apply(auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1359
      apply(case_tac i, simp, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1360
      apply(rule_tac x = nat in exI, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1361
      apply(rule_tac allI, erule_tac x = "Suc j" in allE, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1362
      done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1363
  next
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1364
    fix aa list
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1365
    assume g: "Suc (length rgs) = n" "Suc (length list) = n"
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1366
      "\<exists>i<n. rec_exec ((aa # list) ! i) xs = Suc 0 \<and> 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1367
      (\<forall>j<n. j \<noteq> i \<longrightarrow> rec_exec ((aa # list) ! j) xs = 0)"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1368
      "primerec a (length xs) \<and> list_all (\<lambda>rf. primerec rf (length xs)) rgs \<and>
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1369
      primerec aa (length xs) \<and> list_all (\<lambda>rf. primerec rf (length xs)) list"
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1370
    "rcs = aa # list" "rec_exec aa xs \<noteq> 0" "zip rgs list = []"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1371
    thus "rec_exec (rec_embranch ((a, aa) # zip rgs list)) xs = 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1372
        Embranch ((rec_exec a, \<lambda>args. 0 < rec_exec aa args) # 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1373
       zip (map rec_exec rgs) (map (\<lambda>r args. 0 < rec_exec r args) list)) xs"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1374
      apply(subgoal_tac "rgs = [] \<and> list = []", simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1375
      prefer 2
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1376
      apply(rule_tac zip_null_iff, simp, simp, simp)
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1377
      apply(simp add: rec_exec.simps rec_embranch.simps Embranch.simps, auto)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1378
      done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1379
  next
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1380
    fix aa list
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1381
    assume g: "Suc (length rgs) = n" "Suc (length list) = n"
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1382
      "\<exists>i<n. rec_exec ((aa # list) ! i) xs = Suc 0 \<and>  
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1383
           (\<forall>j<n. j \<noteq> i \<longrightarrow> rec_exec ((aa # list) ! j) xs = 0)"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1384
      "primerec a (length xs) \<and> list_all (\<lambda>rf. primerec rf (length xs)) rgs
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1385
      \<and> primerec aa (length xs) \<and> list_all (\<lambda>rf. primerec rf (length xs)) list"
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1386
      "rcs = aa # list" "rec_exec aa xs \<noteq> 0" "zip rgs list \<noteq> []"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1387
    have "rec_exec aa xs =  Suc 0"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1388
      using g
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1389
      apply(case_tac "rec_exec aa xs", simp, auto)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1390
      done      
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1391
    moreover have "rec_exec (rec_embranch' (zip rgs list) (length xs)) xs = 0"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1392
    proof -
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1393
      have "rec_embranch' (zip rgs list) (length xs) = rec_embranch (zip rgs list)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1394
        using g
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1395
        apply(case_tac "zip rgs list", simp, case_tac ab)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1396
        apply(simp add: rec_embranch.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1397
        apply(subgoal_tac "arity aaa = length xs", simp, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1398
        apply(case_tac rgs, simp, simp, case_tac list, simp, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1399
        done
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1400
      moreover have "rec_exec (rec_embranch (zip rgs list)) xs = 0"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1401
      proof(rule embranch_all0)
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1402
        show " \<forall>j<length list. rec_exec (list ! j) xs = 0"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1403
          using g
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1404
          apply(auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1405
          apply(case_tac i, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1406
          apply(erule_tac x = "Suc j" in allE, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1407
          apply(simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1408
          apply(erule_tac x = 0 in allE, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1409
          done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1410
      next
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1411
        show "length rgs = length list"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1412
          using g
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1413
          apply(case_tac n, simp, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1414
          done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1415
      next
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1416
        show "list \<noteq> []"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1417
          using g
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1418
          apply(case_tac list, simp, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1419
          done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1420
      next
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1421
        show "list_all (\<lambda>rf. primerec rf (length xs)) (rgs @ list)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1422
          using g
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1423
          apply auto
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1424
          done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1425
      qed
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1426
      ultimately show "rec_exec (rec_embranch' (zip rgs list) (length xs)) xs = 0"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1427
        by simp
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1428
    qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1429
    moreover have 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1430
      "Embranch (zip (map rec_exec rgs) 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1431
          (map (\<lambda>r args. 0 < rec_exec r args) list)) xs = 0"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1432
      using g
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1433
      apply(rule_tac k = "length rgs" in Embranch_0)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1434
      apply(simp, case_tac n, simp, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1435
      apply(case_tac rgs, simp, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1436
      apply(auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1437
      apply(case_tac i, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1438
      apply(erule_tac x = "Suc j" in allE, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1439
      apply(simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1440
      apply(rule_tac x = 0 in allE, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1441
      done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1442
    moreover have "arity a = length xs"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1443
      using g
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1444
      apply(auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1445
      done
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1446
    ultimately show "rec_exec (rec_embranch ((a, aa) # zip rgs list)) xs = 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1447
      Embranch ((rec_exec a, \<lambda>args. 0 < rec_exec aa args) #
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1448
           zip (map rec_exec rgs) (map (\<lambda>r args. 0 < rec_exec r args) list)) xs"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1449
      apply(simp add: rec_exec.simps rec_embranch.simps Embranch.simps)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1450
      done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1451
  qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1452
qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1453
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1454
text{* 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1455
  @{text "prime n"} means @{text "n"} is a prime number.
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1456
*}
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1457
fun Prime :: "nat \<Rightarrow> bool"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1458
  where
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1459
  "Prime x = (1 < x \<and> (\<forall> u < x. (\<forall> v < x. u * v \<noteq> x)))"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1460
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1461
declare Prime.simps [simp del]
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1462
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1463
lemma primerec_all1: 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1464
  "primerec (rec_all rt rf) n \<Longrightarrow> primerec rt n"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1465
  by (simp add: primerec_all)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1466
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1467
lemma primerec_all2: "primerec (rec_all rt rf) n \<Longrightarrow> 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1468
  primerec rf (Suc n)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1469
by(insert primerec_all[of rt rf n], simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1470
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1471
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1472
  @{text "rec_prime"} is the recursive function used to implement
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1473
  @{text "Prime"}.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1474
  *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1475
definition rec_prime :: "recf"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1476
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1477
  "rec_prime = Cn (Suc 0) rec_conj 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1478
  [Cn (Suc 0) rec_less [constn 1, id (Suc 0) (0)],
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1479
        rec_all (Cn 1 rec_minus [id 1 0, constn 1]) 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1480
       (rec_all (Cn 2 rec_minus [id 2 0, Cn 2 (constn 1) 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1481
  [id 2 0]]) (Cn 3 rec_noteq 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1482
       [Cn 3 rec_mult [id 3 1, id 3 2], id 3 0]))]"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1483
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1484
declare numeral_2_eq_2[simp del] numeral_3_eq_3[simp del]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1485
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1486
lemma exec_tmp: 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1487
  "rec_exec (rec_all (Cn 2 rec_minus [recf.id 2 0, Cn 2 (constn (Suc 0)) [recf.id 2 0]]) 
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1488
  (Cn 3 rec_noteq [Cn 3 rec_mult [recf.id 3 (Suc 0), recf.id 3 2], recf.id 3 0]))  [x, k] = 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1489
  ((if (\<forall>w\<le>rec_exec (Cn 2 rec_minus [recf.id 2 0, Cn 2 (constn (Suc 0)) [recf.id 2 0]]) ([x, k]). 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1490
  0 < rec_exec (Cn 3 rec_noteq [Cn 3 rec_mult [recf.id 3 (Suc 0), recf.id 3 2], recf.id 3 0])
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1491
  ([x, k] @ [w])) then 1 else 0))"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1492
apply(rule_tac all_lemma)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1493
apply(auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1494
apply(case_tac [!] i, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1495
apply(case_tac ia, auto simp: numeral_3_eq_3 numeral_2_eq_2)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1496
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1497
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1498
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1499
  The correctness of @{text "Prime"}.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1500
  *}
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1501
lemma prime_lemma: "rec_exec rec_prime [x] = (if Prime x then 1 else 0)"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1502
proof(simp add: rec_exec.simps rec_prime_def)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1503
  let ?rt1 = "(Cn 2 rec_minus [recf.id 2 0, 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1504
    Cn 2 (constn (Suc 0)) [recf.id 2 0]])"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1505
  let ?rf1 = "(Cn 3 rec_noteq [Cn 3 rec_mult 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1506
    [recf.id 3 (Suc 0), recf.id 3 2], recf.id 3 (0)])"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1507
  let ?rt2 = "(Cn (Suc 0) rec_minus 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1508
    [recf.id (Suc 0) 0, constn (Suc 0)])"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1509
  let ?rf2 = "rec_all ?rt1 ?rf1"
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1510
  have h1: "rec_exec (rec_all ?rt2 ?rf2) ([x]) = 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1511
        (if (\<forall>k\<le>rec_exec ?rt2 ([x]). 0 < rec_exec ?rf2 ([x] @ [k])) then 1 else 0)"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1512
  proof(rule_tac all_lemma, simp_all)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1513
    show "primerec ?rf2 (Suc (Suc 0))"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1514
      apply(rule_tac primerec_all_iff)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1515
      apply(auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1516
      apply(case_tac [!] i, auto simp: numeral_2_eq_2)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1517
      apply(case_tac ia, auto simp: numeral_3_eq_3)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1518
      done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1519
  next
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1520
    show "primerec (Cn (Suc 0) rec_minus
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1521
             [recf.id (Suc 0) 0, constn (Suc 0)]) (Suc 0)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1522
      apply(auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1523
      apply(case_tac i, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1524
      done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1525
  qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1526
  from h1 show 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1527
   "(Suc 0 < x \<longrightarrow>  (rec_exec (rec_all ?rt2 ?rf2) [x] = 0 \<longrightarrow> 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1528
    \<not> Prime x) \<and>
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1529
     (0 < rec_exec (rec_all ?rt2 ?rf2) [x] \<longrightarrow> Prime x)) \<and>
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1530
    (\<not> Suc 0 < x \<longrightarrow> \<not> Prime x \<and> (rec_exec (rec_all ?rt2 ?rf2) [x] = 0
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1531
    \<longrightarrow> \<not> Prime x))"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1532
    apply(auto simp:rec_exec.simps)
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1533
    apply(simp add: exec_tmp rec_exec.simps)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1534
  proof -
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1535
    assume "\<forall>k\<le>x - Suc 0. (0::nat) < (if \<forall>w\<le>x - Suc 0. 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1536
           0 < (if k * w \<noteq> x then 1 else (0 :: nat)) then 1 else 0)" "Suc 0 < x"
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1537
    thus "Prime x"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1538
      apply(simp add: rec_exec.simps split: if_splits)
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1539
      apply(simp add: Prime.simps, auto)
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1540
      apply(erule_tac x = u in allE, auto)
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1541
      apply(case_tac u, simp, case_tac nat, simp, simp)
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1542
      apply(case_tac v, simp, case_tac nat, simp, simp)
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1543
      done
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1544
  next
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1545
    assume "\<not> Suc 0 < x" "Prime x"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1546
    thus "False"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1547
      apply(simp add: Prime.simps)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1548
      done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1549
  next
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1550
    fix k
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1551
    assume "rec_exec (rec_all ?rt1 ?rf1)
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1552
      [x, k] = 0" "k \<le> x - Suc 0" "Prime x"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1553
    thus "False"
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1554
      apply(simp add: exec_tmp rec_exec.simps Prime.simps split: if_splits)
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1555
      done
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1556
  next
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1557
    fix k
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1558
    assume "rec_exec (rec_all ?rt1 ?rf1)
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1559
      [x, k] = 0" "k \<le> x - Suc 0" "Prime x"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1560
    thus "False"
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1561
      apply(simp add: exec_tmp rec_exec.simps Prime.simps split: if_splits)
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1562
      done
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1563
  qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1564
qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1565
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1566
definition rec_dummyfac :: "recf"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1567
  where
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1568
  "rec_dummyfac = Pr 1 (constn 1) 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1569
  (Cn 3 rec_mult [id 3 2, Cn 3 s [id 3 1]])"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1570
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1571
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1572
  The recursive function used to implment factorization.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1573
  *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1574
definition rec_fac :: "recf"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1575
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1576
  "rec_fac = Cn 1 rec_dummyfac [id 1 0, id 1 0]"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1577
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1578
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1579
  Formal specification of factorization.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1580
  *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1581
fun fac :: "nat \<Rightarrow> nat"  ("_!" [100] 99)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1582
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1583
  "fac 0 = 1" |
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1584
  "fac (Suc x) = (Suc x) * fac x"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1585
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  1586
lemma rec_exec_rec_dummyfac_0: "rec_exec rec_dummyfac [0, 0] = Suc 0"
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1587
by(simp add: rec_dummyfac_def rec_exec.simps)
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1588
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1589
lemma rec_cn_simp: "rec_exec (Cn n f gs) xs = 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1590
                (let rgs = map (\<lambda> g. rec_exec g xs) gs in
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1591
                 rec_exec f rgs)"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1592
by(simp add: rec_exec.simps)
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1593
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1594
lemma rec_id_simp: "rec_exec (id m n) xs = xs ! n" 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1595
  by(simp add: rec_exec.simps)
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1596
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1597
lemma fac_dummy: "rec_exec rec_dummyfac [x, y] = y !"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1598
apply(induct y)
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1599
apply(auto simp: rec_dummyfac_def rec_exec.simps)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1600
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1601
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1602
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1603
  The correctness of @{text "rec_fac"}.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1604
  *}
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1605
lemma fac_lemma: "rec_exec rec_fac [x] =  x!"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1606
apply(simp add: rec_fac_def rec_exec.simps fac_dummy)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1607
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1608
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1609
declare fac.simps[simp del]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1610
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1611
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1612
  @{text "Np x"} returns the first prime number after @{text "x"}.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1613
  *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1614
fun Np ::"nat \<Rightarrow> nat"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1615
  where
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1616
  "Np x = Min {y. y \<le> Suc (x!) \<and> x < y \<and> Prime y}"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1617
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1618
declare Np.simps[simp del] rec_Minr.simps[simp del]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1619
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1620
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1621
  @{text "rec_np"} is the recursive function used to implement
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1622
  @{text "Np"}.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1623
  *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1624
definition rec_np :: "recf"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1625
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1626
  "rec_np = (let Rr = Cn 2 rec_conj [Cn 2 rec_less [id 2 0, id 2 1], 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1627
  Cn 2 rec_prime [id 2 1]]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1628
             in Cn 1 (rec_Minr Rr) [id 1 0, Cn 1 s [rec_fac]])"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1629
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  1630
lemma n_le_fact[simp]: "n < Suc (n!)"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1631
apply(induct n, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1632
apply(simp add: fac.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1633
apply(case_tac n, auto simp: fac.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1634
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1635
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1636
lemma divsor_ex: 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1637
"\<lbrakk>\<not> Prime x; x > Suc 0\<rbrakk> \<Longrightarrow> (\<exists> u > Suc 0. (\<exists> v > Suc 0. u * v = x))"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1638
 by(auto simp: Prime.simps)
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1639
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1640
lemma divsor_prime_ex: "\<lbrakk>\<not> Prime x; x > Suc 0\<rbrakk> \<Longrightarrow> 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1641
  \<exists> p. Prime p \<and> p dvd x"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1642
apply(induct x rule: wf_induct[where r = "measure (\<lambda> y. y)"], simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1643
apply(drule_tac divsor_ex, simp, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1644
apply(erule_tac x = u in allE, simp)
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1645
apply(case_tac "Prime u", simp)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1646
apply(rule_tac x = u in exI, simp, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1647
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1648
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  1649
lemma fact_pos[intro]: "0 < n!"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1650
apply(induct n)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1651
apply(auto simp: fac.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1652
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1653
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1654
lemma fac_Suc: "Suc n! =  (Suc n) * (n!)" by(simp add: fac.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1655
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1656
lemma fac_dvd: "\<lbrakk>0 < q; q \<le> n\<rbrakk> \<Longrightarrow> q dvd n!"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1657
apply(induct n, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1658
apply(case_tac "q \<le> n", simp add: fac_Suc)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1659
apply(subgoal_tac "q = Suc n", simp only: fac_Suc)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1660
apply(rule_tac dvd_mult2, simp, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1661
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1662
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1663
lemma fac_dvd2: "\<lbrakk>Suc 0 < q; q dvd n!; q \<le> n\<rbrakk> \<Longrightarrow> \<not> q dvd Suc (n!)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1664
proof(auto simp: dvd_def)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1665
  fix k ka
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1666
  assume h1: "Suc 0 < q" "q \<le> n"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1667
  and h2: "Suc (q * k) = q * ka"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1668
  have "k < ka"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1669
  proof - 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1670
    have "q * k < q * ka" 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1671
      using h2 by arith
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1672
    thus "k < ka"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1673
      using h1
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1674
      by(auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1675
  qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1676
  hence "\<exists>d. d > 0 \<and>  ka = d + k"  
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1677
    by(rule_tac x = "ka - k" in exI, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1678
  from this obtain d where "d > 0 \<and> ka = d + k" ..
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1679
  from h2 and this and h1 show "False"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1680
    by(simp add: add_mult_distrib2)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1681
qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1682
    
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1683
lemma prime_ex: "\<exists> p. n < p \<and> p \<le> Suc (n!) \<and> Prime p"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1684
proof(cases "Prime (n! + 1)")
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1685
  case True thus "?thesis" 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1686
    by(rule_tac x = "Suc (n!)" in exI, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1687
next
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1688
  assume h: "\<not> Prime (n! + 1)"  
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1689
  hence "\<exists> p. Prime p \<and> p dvd (n! + 1)"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1690
    by(erule_tac divsor_prime_ex, auto)
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1691
  from this obtain q where k: "Prime q \<and> q dvd (n! + 1)" ..
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1692
  thus "?thesis"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1693
  proof(cases "q > n")
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1694
    case True thus "?thesis"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1695
      using k
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1696
      apply(rule_tac x = q in exI, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1697
      apply(rule_tac dvd_imp_le, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1698
      done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1699
  next
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1700
    case False thus "?thesis"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1701
    proof -
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1702
      assume g: "\<not> n < q"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1703
      have j: "q > Suc 0"
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1704
        using k by(case_tac q, auto simp: Prime.simps)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1705
      hence "q dvd n!"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1706
        using g 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1707
        apply(rule_tac fac_dvd, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1708
        done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1709
      hence "\<not> q dvd Suc (n!)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1710
        using g j
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1711
        by(rule_tac fac_dvd2, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1712
      thus "?thesis"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1713
        using k by simp
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1714
    qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1715
  qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1716
qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1717
  
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1718
lemma Suc_Suc_induct[elim!]: "\<lbrakk>i < Suc (Suc 0); 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1719
  primerec (ys ! 0) n; primerec (ys ! 1) n\<rbrakk> \<Longrightarrow> primerec (ys ! i) n"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1720
by(case_tac i, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1721
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  1722
lemma primerec_rec_prime_1[intro]: "primerec rec_prime (Suc 0)"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1723
apply(auto simp: rec_prime_def, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1724
apply(rule_tac primerec_all_iff, auto, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1725
apply(rule_tac primerec_all_iff, auto, auto simp:  
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1726
  numeral_2_eq_2 numeral_3_eq_3)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1727
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1728
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1729
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1730
  The correctness of @{text "rec_np"}.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1731
  *}
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1732
lemma np_lemma: "rec_exec rec_np [x] = Np x"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1733
proof(auto simp: rec_np_def rec_exec.simps Let_def fac_lemma)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1734
  let ?rr = "(Cn 2 rec_conj [Cn 2 rec_less [recf.id 2 0,
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1735
    recf.id 2 (Suc 0)], Cn 2 rec_prime [recf.id 2 (Suc 0)]])"
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1736
  let ?R = "\<lambda> zs. zs ! 0 < zs ! 1 \<and> Prime (zs ! 1)"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1737
  have g1: "rec_exec (rec_Minr ?rr) ([x] @ [Suc (x!)]) = 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1738
    Minr (\<lambda> args. 0 < rec_exec ?rr args) [x] (Suc (x!))"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1739
    by(rule_tac Minr_lemma, auto simp: rec_exec.simps
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1740
      prime_lemma, auto simp:  numeral_2_eq_2 numeral_3_eq_3)
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1741
  have g2: "Minr (\<lambda> args. 0 < rec_exec ?rr args) [x] (Suc (x!)) = Np x"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1742
    using prime_ex[of x]
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1743
    apply(auto simp: Minr.simps Np.simps rec_exec.simps)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1744
    apply(erule_tac x = p in allE, simp add: prime_lemma)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1745
    apply(simp add: prime_lemma split: if_splits)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1746
    apply(subgoal_tac
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1747
   "{uu. (Prime uu \<longrightarrow> (x < uu \<longrightarrow> uu \<le> Suc (x!)) \<and> x < uu) \<and> Prime uu}
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1748
    = {y. y \<le> Suc (x!) \<and> x < y \<and> Prime y}", auto)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1749
    done
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1750
  from g1 and g2 show "rec_exec (rec_Minr ?rr) ([x, Suc (x!)]) = Np x"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1751
    by simp
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1752
qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1753
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1754
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1755
  @{text "rec_power"} is the recursive function used to implement
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1756
  power function.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1757
  *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1758
definition rec_power :: "recf"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1759
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1760
  "rec_power = Pr 1 (constn 1) (Cn 3 rec_mult [id 3 0, id 3 2])"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1761
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1762
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1763
  The correctness of @{text "rec_power"}.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1764
  *}
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1765
lemma power_lemma: "rec_exec rec_power [x, y] = x^y"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1766
  by(induct y, auto simp: rec_exec.simps rec_power_def)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1767
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1768
text{*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1769
  @{text "Pi k"} returns the @{text "k"}-th prime number.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1770
  *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1771
fun Pi :: "nat \<Rightarrow> nat"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1772
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1773
  "Pi 0 = 2" |
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1774
  "Pi (Suc x) = Np (Pi x)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1775
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1776
definition rec_dummy_pi :: "recf"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1777
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1778
  "rec_dummy_pi = Pr 1 (constn 2) (Cn 3 rec_np [id 3 2])"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1779
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1780
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1781
  @{text "rec_pi"} is the recursive function used to implement
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1782
  @{text "Pi"}.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1783
  *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1784
definition rec_pi :: "recf"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1785
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1786
  "rec_pi = Cn 1 rec_dummy_pi [id 1 0, id 1 0]"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1787
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1788
lemma pi_dummy_lemma: "rec_exec rec_dummy_pi [x, y] = Pi y"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1789
apply(induct y)
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1790
by(auto simp: rec_exec.simps rec_dummy_pi_def Pi.simps np_lemma)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1791
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1792
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1793
  The correctness of @{text "rec_pi"}.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1794
  *}
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1795
lemma pi_lemma: "rec_exec rec_pi [x] = Pi x"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1796
apply(simp add: rec_pi_def rec_exec.simps pi_dummy_lemma)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1797
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1798
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1799
fun loR :: "nat list \<Rightarrow> bool"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1800
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1801
  "loR [x, y, u] = (x mod (y^u) = 0)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1802
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1803
declare loR.simps[simp del]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1804
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1805
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1806
  @{text "Lo"} specifies the @{text "lo"} function given on page 79 of 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1807
  Boolos's book. It is one of the two notions of integeral logarithmatic
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1808
  operation on that page. The other is @{text "lg"}.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1809
  *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1810
fun lo :: " nat \<Rightarrow> nat \<Rightarrow> nat"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1811
  where 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1812
  "lo x y  = (if x > 1 \<and> y > 1 \<and> {u. loR [x, y, u]} \<noteq> {} then Max {u. loR [x, y, u]}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1813
                                                         else 0)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1814
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1815
declare lo.simps[simp del]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1816
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  1817
lemma primerec_then_ge_0[elim]: "primerec rf n \<Longrightarrow> n > 0"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1818
apply(induct rule: primerec.induct, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1819
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1820
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1821
lemma primerec_sigma[intro!]:  
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1822
  "\<lbrakk>n > Suc 0; primerec rf n\<rbrakk> \<Longrightarrow> 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1823
  primerec (rec_sigma rf) n"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1824
apply(simp add: rec_sigma.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1825
apply(auto, auto simp: nth_append)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1826
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1827
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  1828
lemma primerec_rec_maxr[intro!]:  "\<lbrakk>primerec rf n; n > 0\<rbrakk> \<Longrightarrow> primerec (rec_maxr rf) n"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1829
apply(simp add: rec_maxr.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1830
apply(rule_tac prime_cn, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1831
apply(rule_tac primerec_all_iff, auto, auto simp: nth_append)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1832
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1833
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1834
lemma Suc_Suc_Suc_induct[elim!]: 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1835
  "\<lbrakk>i < Suc (Suc (Suc (0::nat))); primerec (ys ! 0) n;
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1836
  primerec (ys ! 1) n;  
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1837
  primerec (ys ! 2) n\<rbrakk> \<Longrightarrow> primerec (ys ! i) n"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1838
apply(case_tac i, auto, case_tac nat, simp, simp add: numeral_2_eq_2)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1839
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1840
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  1841
lemma primerec_2[intro]:
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  1842
"primerec rec_quo (Suc (Suc 0))" "primerec rec_mod (Suc (Suc 0))"
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  1843
"primerec rec_power (Suc (Suc 0))"
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  1844
  by(force simp: prime_cn prime_id rec_mod_def rec_quo_def rec_power_def prime_pr numeral)+
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1845
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1846
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1847
  @{text "rec_lo"} is the recursive function used to implement @{text "Lo"}.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1848
*}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1849
definition rec_lo :: "recf"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1850
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1851
  "rec_lo = (let rR = Cn 3 rec_eq [Cn 3 rec_mod [id 3 0, 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1852
               Cn 3 rec_power [id 3 1, id 3 2]], 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1853
                     Cn 3 (constn 0) [id 3 1]] in
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1854
             let rb =  Cn 2 (rec_maxr rR) [id 2 0, id 2 1, id 2 0] in 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1855
             let rcond = Cn 2 rec_conj [Cn 2 rec_less [Cn 2 (constn 1)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1856
                                             [id 2 0], id 2 0], 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1857
                                        Cn 2 rec_less [Cn 2 (constn 1)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1858
                                                [id 2 0], id 2 1]] in 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1859
             let rcond2 = Cn 2 rec_minus 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1860
                              [Cn 2 (constn 1) [id 2 0], rcond] 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1861
             in Cn 2 rec_add [Cn 2 rec_mult [rb, rcond], 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1862
                  Cn 2 rec_mult [Cn 2 (constn 0) [id 2 0], rcond2]])"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1863
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1864
lemma rec_lo_Maxr_lor:
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1865
  "\<lbrakk>Suc 0 < x; Suc 0 < y\<rbrakk> \<Longrightarrow>  
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1866
        rec_exec rec_lo [x, y] = Maxr loR [x, y] x"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1867
proof(auto simp: rec_exec.simps rec_lo_def Let_def 
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1868
    numeral_2_eq_2 numeral_3_eq_3)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1869
  let ?rR = "(Cn (Suc (Suc (Suc 0))) rec_eq
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1870
     [Cn (Suc (Suc (Suc 0))) rec_mod [recf.id (Suc (Suc (Suc 0))) 0,
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1871
     Cn (Suc (Suc (Suc 0))) rec_power [recf.id (Suc (Suc (Suc 0)))
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1872
     (Suc 0), recf.id (Suc (Suc (Suc 0))) (Suc (Suc 0))]],
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1873
     Cn (Suc (Suc (Suc 0))) (constn 0) [recf.id (Suc (Suc (Suc 0))) (Suc 0)]])"
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1874
  have h: "rec_exec (rec_maxr ?rR) ([x, y] @ [x]) =
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1875
    Maxr (\<lambda> args. 0 < rec_exec ?rR args) [x, y] x"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1876
    by(rule_tac Maxr_lemma, auto simp: rec_exec.simps
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1877
      mod_lemma power_lemma, auto simp: numeral_2_eq_2 numeral_3_eq_3)
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1878
  have "Maxr loR [x, y] x =  Maxr (\<lambda> args. 0 < rec_exec ?rR args) [x, y] x"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1879
    apply(simp add: rec_exec.simps mod_lemma power_lemma)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1880
    apply(simp add: Maxr.simps loR.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1881
    done
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1882
  from h and this show "rec_exec (rec_maxr ?rR) [x, y, x] = 
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1883
    Maxr loR [x, y] x"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1884
    apply(simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1885
    done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1886
qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1887
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  1888
lemma MaxloR0[simp]: "Max {ya. ya = 0 \<and> loR [0, y, ya]} = 0"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1889
apply(rule_tac Max_eqI, auto simp: loR.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1890
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1891
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  1892
lemma two_less_square[simp]: "Suc 0 < y \<Longrightarrow> Suc (Suc 0) < y * y"
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  1893
  by(induct y, auto)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1894
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1895
lemma less_mult: "\<lbrakk>x > 0; y > Suc 0\<rbrakk> \<Longrightarrow> x < y * x"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1896
apply(case_tac y, simp, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1897
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1898
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1899
lemma x_less_exp: "\<lbrakk>y > Suc 0\<rbrakk> \<Longrightarrow> x < y^x"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1900
apply(induct x, simp, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1901
apply(case_tac x, simp, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1902
apply(rule_tac y = "y* y^nat" in le_less_trans, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1903
apply(rule_tac less_mult, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1904
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1905
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1906
lemma le_mult: "y \<noteq> (0::nat) \<Longrightarrow> x \<le> x * y"  
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1907
  by(induct y, simp, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1908
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  1909
lemma uplimit_loR:
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  1910
  assumes "Suc 0 < x" "Suc 0 < y" "loR [x, y, xa]"
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  1911
  shows "xa \<le> x"
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  1912
proof -
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  1913
  have "Suc 0 < x \<Longrightarrow> Suc 0 < y \<Longrightarrow> y ^ xa dvd x \<Longrightarrow> xa \<le> x" 
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  1914
  by (meson Suc_lessD le_less_trans nat_dvd_not_less nat_le_linear x_less_exp)
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  1915
  thus ?thesis using assms by(auto simp: loR.simps)
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  1916
qed
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  1917
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  1918
lemma loR_set_strengthen[simp]: "\<lbrakk>xa \<le> x; loR [x, y, xa]; Suc 0 < x; Suc 0 < y\<rbrakk> \<Longrightarrow>
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1919
  {u. loR [x, y, u]} = {ya. ya \<le> x \<and> loR [x, y, ya]}"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1920
apply(rule_tac Collect_cong, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1921
apply(erule_tac uplimit_loR, simp, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1922
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1923
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1924
lemma Maxr_lo: "\<lbrakk>Suc 0 < x; Suc 0 < y\<rbrakk> \<Longrightarrow>
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1925
  Maxr loR [x, y] x = lo x y" 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1926
apply(simp add: Maxr.simps lo.simps, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1927
apply(erule_tac x = xa in allE, simp, simp add: uplimit_loR)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1928
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1929
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1930
lemma lo_lemma': "\<lbrakk>Suc 0 < x; Suc 0 < y\<rbrakk> \<Longrightarrow> 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1931
  rec_exec rec_lo [x, y] = lo x y"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1932
by(simp add: Maxr_lo  rec_lo_Maxr_lor)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1933
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1934
lemma lo_lemma'': "\<lbrakk>\<not> Suc 0 < x\<rbrakk> \<Longrightarrow> rec_exec rec_lo [x, y] = lo x y"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1935
apply(case_tac x, auto simp: rec_exec.simps rec_lo_def 
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1936
  Let_def lo.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1937
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1938
  
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1939
lemma lo_lemma''': "\<lbrakk>\<not> Suc 0 < y\<rbrakk> \<Longrightarrow> rec_exec rec_lo [x, y] = lo x y"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1940
apply(case_tac y, auto simp: rec_exec.simps rec_lo_def 
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1941
  Let_def lo.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1942
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1943
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1944
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1945
  The correctness of @{text "rec_lo"}:
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1946
*}
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1947
lemma lo_lemma: "rec_exec rec_lo [x, y] = lo x y" 
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1948
apply(case_tac "Suc 0 < x \<and> Suc 0 < y")
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1949
apply(auto simp: lo_lemma' lo_lemma'' lo_lemma''')
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1950
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1951
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1952
fun lgR :: "nat list \<Rightarrow> bool"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1953
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1954
  "lgR [x, y, u] = (y^u \<le> x)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1955
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1956
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1957
  @{text "lg"} specifies the @{text "lg"} function given on page 79 of 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1958
  Boolos's book. It is one of the two notions of integeral logarithmatic
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1959
  operation on that page. The other is @{text "lo"}.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1960
  *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1961
fun lg :: "nat \<Rightarrow> nat \<Rightarrow> nat"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1962
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1963
  "lg x y = (if x > 1 \<and> y > 1 \<and> {u. lgR [x, y, u]} \<noteq> {} then 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1964
                 Max {u. lgR [x, y, u]}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1965
              else 0)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1966
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1967
declare lg.simps[simp del] lgR.simps[simp del]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1968
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1969
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1970
  @{text "rec_lg"} is the recursive function used to implement @{text "lg"}.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1971
  *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1972
definition rec_lg :: "recf"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1973
  where
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1974
  "rec_lg = (let rec_lgR = Cn 3 rec_le
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1975
  [Cn 3 rec_power [id 3 1, id 3 2], id 3 0] in
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1976
  let conR1 = Cn 2 rec_conj [Cn 2 rec_less 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1977
                     [Cn 2 (constn 1) [id 2 0], id 2 0], 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1978
                            Cn 2 rec_less [Cn 2 (constn 1) 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1979
                                 [id 2 0], id 2 1]] in 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1980
  let conR2 = Cn 2 rec_not [conR1] in 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1981
        Cn 2 rec_add [Cn 2 rec_mult 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1982
              [conR1, Cn 2 (rec_maxr rec_lgR)
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1983
                       [id 2 0, id 2 1, id 2 0]], 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1984
                       Cn 2 rec_mult [conR2, Cn 2 (constn 0) 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1985
                                [id 2 0]]])"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1986
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1987
lemma lg_maxr: "\<lbrakk>Suc 0 < x; Suc 0 < y\<rbrakk> \<Longrightarrow> 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1988
                      rec_exec rec_lg [x, y] = Maxr lgR [x, y] x"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1989
proof(simp add: rec_exec.simps rec_lg_def Let_def)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1990
  assume h: "Suc 0 < x" "Suc 0 < y"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1991
  let ?rR = "(Cn 3 rec_le [Cn 3 rec_power
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1992
               [recf.id 3 (Suc 0), recf.id 3 2], recf.id 3 0])"
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1993
  have "rec_exec (rec_maxr ?rR) ([x, y] @ [x])
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1994
              = Maxr ((\<lambda> args. 0 < rec_exec ?rR args)) [x, y] x" 
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1995
  proof(rule Maxr_lemma)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1996
    show "primerec (Cn 3 rec_le [Cn 3 rec_power 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1997
              [recf.id 3 (Suc 0), recf.id 3 2], recf.id 3 0]) (Suc (length [x, y]))"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1998
      apply(auto simp: numeral_3_eq_3)+
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1999
      done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2000
  qed
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2001
  moreover have "Maxr lgR [x, y] x = Maxr ((\<lambda> args. 0 < rec_exec ?rR args)) [x, y] x"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2002
    apply(simp add: rec_exec.simps power_lemma)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2003
    apply(simp add: Maxr.simps lgR.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2004
    done 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2005
  ultimately show "rec_exec (rec_maxr ?rR) [x, y, x] = Maxr lgR [x, y] x"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2006
    by simp
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2007
qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2008
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2009
lemma lgR_ok: "\<lbrakk>Suc 0 < y; lgR [x, y, xa]\<rbrakk> \<Longrightarrow> xa \<le> x"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2010
apply(simp add: lgR.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2011
apply(subgoal_tac "y^xa > xa", simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2012
apply(erule x_less_exp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2013
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2014
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2015
lemma lgR_set_strengthen[simp]: "\<lbrakk>Suc 0 < x; Suc 0 < y; lgR [x, y, xa]\<rbrakk> \<Longrightarrow>
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2016
           {u. lgR [x, y, u]} =  {ya. ya \<le> x \<and> lgR [x, y, ya]}"
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2017
apply(rule_tac Collect_cong, auto simp:lgR_ok)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2018
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2019
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2020
lemma maxr_lg: "\<lbrakk>Suc 0 < x; Suc 0 < y\<rbrakk> \<Longrightarrow> Maxr lgR [x, y] x = lg x y"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2021
apply(simp add: lg.simps Maxr.simps, auto)
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2022
apply(erule_tac x = xa in allE, auto simp:lgR_ok)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2023
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2024
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2025
lemma lg_lemma': "\<lbrakk>Suc 0 < x; Suc 0 < y\<rbrakk> \<Longrightarrow> rec_exec rec_lg [x, y] = lg x y"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2026
apply(simp add: maxr_lg lg_maxr)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2027
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2028
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2029
lemma lg_lemma'': "\<not> Suc 0 < x \<Longrightarrow> rec_exec rec_lg [x, y] = lg x y"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2030
apply(simp add: rec_exec.simps rec_lg_def Let_def lg.simps)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2031
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2032
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2033
lemma lg_lemma''': "\<not> Suc 0 < y \<Longrightarrow> rec_exec rec_lg [x, y] = lg x y"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2034
apply(simp add: rec_exec.simps rec_lg_def Let_def lg.simps)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2035
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2036
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2037
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2038
  The correctness of @{text "rec_lg"}.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2039
  *}
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2040
lemma lg_lemma: "rec_exec rec_lg [x, y] = lg x y"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2041
apply(case_tac "Suc 0 < x \<and> Suc 0 < y", auto simp: 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2042
                            lg_lemma' lg_lemma'' lg_lemma''')
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2043
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2044
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2045
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2046
  @{text "Entry sr i"} returns the @{text "i"}-th entry of a list of natural 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2047
  numbers encoded by number @{text "sr"} using Godel's coding.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2048
  *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2049
fun Entry :: "nat \<Rightarrow> nat \<Rightarrow> nat"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2050
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2051
  "Entry sr i = lo sr (Pi (Suc i))"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2052
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2053
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2054
  @{text "rec_entry"} is the recursive function used to implement
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2055
  @{text "Entry"}.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2056
  *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2057
definition rec_entry:: "recf"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2058
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2059
  "rec_entry = Cn 2 rec_lo [id 2 0, Cn 2 rec_pi [Cn 2 s [id 2 1]]]"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2060
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2061
declare Pi.simps[simp del]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2062
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2063
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2064
  The correctness of @{text "rec_entry"}.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2065
  *}
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2066
lemma entry_lemma: "rec_exec rec_entry [str, i] = Entry str i"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2067
  by(simp add: rec_entry_def  rec_exec.simps lo_lemma pi_lemma)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2068
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2069
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2070
subsection {* The construction of F *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2071
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2072
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2073
  Using the auxilliary functions obtained in last section, 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2074
  we are going to contruct the function @{text "F"}, 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2075
  which is an interpreter of Turing Machines.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2076
  *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2077
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2078
fun listsum2 :: "nat list \<Rightarrow> nat \<Rightarrow> nat"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2079
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2080
  "listsum2 xs 0 = 0"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2081
| "listsum2 xs (Suc n) = listsum2 xs n + xs ! n"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2082
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2083
fun rec_listsum2 :: "nat \<Rightarrow> nat \<Rightarrow> recf"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2084
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2085
  "rec_listsum2 vl 0 = Cn vl z [id vl 0]"
199
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 198
diff changeset
  2086
| "rec_listsum2 vl (Suc n) = Cn vl rec_add [rec_listsum2 vl n, id vl n]"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2087
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2088
declare listsum2.simps[simp del] rec_listsum2.simps[simp del]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2089
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2090
lemma listsum2_lemma: "\<lbrakk>length xs = vl; n \<le> vl\<rbrakk> \<Longrightarrow> 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2091
      rec_exec (rec_listsum2 vl n) xs = listsum2 xs n"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2092
apply(induct n, simp_all)
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2093
apply(simp_all add: rec_exec.simps rec_listsum2.simps listsum2.simps)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2094
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2095
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2096
fun strt' :: "nat list \<Rightarrow> nat \<Rightarrow> nat"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2097
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2098
  "strt' xs 0 = 0"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2099
| "strt' xs (Suc n) = (let dbound = listsum2 xs n + n in 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2100
                       strt' xs n + (2^(xs ! n + dbound) - 2^dbound))"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2101
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2102
fun rec_strt' :: "nat \<Rightarrow> nat \<Rightarrow> recf"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2103
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2104
  "rec_strt' vl 0 = Cn vl z [id vl 0]"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2105
| "rec_strt' vl (Suc n) = (let rec_dbound =
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2106
  Cn vl rec_add [rec_listsum2 vl n, Cn vl (constn n) [id vl 0]]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2107
  in Cn vl rec_add [rec_strt' vl n, Cn vl rec_minus 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2108
  [Cn vl rec_power [Cn vl (constn 2) [id vl 0], Cn vl rec_add
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2109
  [id vl (n), rec_dbound]], 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2110
  Cn vl rec_power [Cn vl (constn 2) [id vl 0], rec_dbound]]])"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2111
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2112
declare strt'.simps[simp del] rec_strt'.simps[simp del]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2113
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2114
lemma strt'_lemma: "\<lbrakk>length xs = vl; n \<le> vl\<rbrakk> \<Longrightarrow> 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2115
  rec_exec (rec_strt' vl n) xs = strt' xs n"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2116
apply(induct n)
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2117
apply(simp_all add: rec_exec.simps rec_strt'.simps strt'.simps
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2118
  Let_def power_lemma listsum2_lemma)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2119
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2120
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2121
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2122
  @{text "strt"} corresponds to the @{text "strt"} function on page 90 of B book, but 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2123
  this definition generalises the original one to deal with multiple input arguments.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2124
  *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2125
fun strt :: "nat list \<Rightarrow> nat"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2126
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2127
  "strt xs = (let ys = map Suc xs in 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2128
              strt' ys (length ys))"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2129
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2130
fun rec_map :: "recf \<Rightarrow> nat \<Rightarrow> recf list"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2131
  where
199
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 198
diff changeset
  2132
  "rec_map rf vl = map (\<lambda> i. Cn vl rf [id vl i]) [0..<vl]"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2133
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2134
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2135
  @{text "rec_strt"} is the recursive function used to implement @{text "strt"}.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2136
  *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2137
fun rec_strt :: "nat \<Rightarrow> recf"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2138
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2139
  "rec_strt vl = Cn vl (rec_strt' vl vl) (rec_map s vl)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2140
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2141
lemma map_s_lemma: "length xs = vl \<Longrightarrow> 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2142
  map ((\<lambda>a. rec_exec a xs) \<circ> (\<lambda>i. Cn vl s [recf.id vl i]))
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2143
  [0..<vl]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2144
        = map Suc xs"
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2145
apply(induct vl arbitrary: xs, simp, auto simp: rec_exec.simps)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2146
apply(subgoal_tac "\<exists> ys y. xs = ys @ [y]", auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2147
proof -
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2148
  fix ys y
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2149
  assume ind: "\<And>xs. length xs = length (ys::nat list) \<Longrightarrow>
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2150
      map ((\<lambda>a. rec_exec a xs) \<circ> (\<lambda>i. Cn (length ys) s 
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2151
        [recf.id (length ys) (i)])) [0..<length ys] = map Suc xs"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2152
  show
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2153
    "map ((\<lambda>a. rec_exec a (ys @ [y])) \<circ> (\<lambda>i. Cn (Suc (length ys)) s 
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2154
  [recf.id (Suc (length ys)) (i)])) [0..<length ys] = map Suc ys"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2155
  proof -
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2156
    have "map ((\<lambda>a. rec_exec a ys) \<circ> (\<lambda>i. Cn (length ys) s
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2157
        [recf.id (length ys) (i)])) [0..<length ys] = map Suc ys"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2158
      apply(rule_tac ind, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2159
      done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2160
    moreover have
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2161
      "map ((\<lambda>a. rec_exec a (ys @ [y])) \<circ> (\<lambda>i. Cn (Suc (length ys)) s
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2162
           [recf.id (Suc (length ys)) (i)])) [0..<length ys]
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2163
         = map ((\<lambda>a. rec_exec a ys) \<circ> (\<lambda>i. Cn (length ys) s 
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2164
                 [recf.id (length ys) (i)])) [0..<length ys]"
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2165
      apply(rule_tac map_ext, auto simp: rec_exec.simps nth_append)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2166
      done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2167
    ultimately show "?thesis"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2168
      by simp
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2169
  qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2170
next
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2171
  fix vl xs
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2172
  assume "length xs = Suc vl"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2173
  thus "\<exists>ys y. xs = ys @ [y]"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2174
    apply(rule_tac x = "butlast xs" in exI, rule_tac x = "last xs" in exI)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2175
    apply(subgoal_tac "xs \<noteq> []", auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2176
    done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2177
qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2178
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2179
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2180
  The correctness of @{text "rec_strt"}.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2181
  *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2182
lemma strt_lemma: "length xs = vl \<Longrightarrow> 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2183
  rec_exec (rec_strt vl) xs = strt xs"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2184
apply(simp add: strt.simps rec_exec.simps strt'_lemma)
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2185
apply(subgoal_tac "(map ((\<lambda>a. rec_exec a xs) \<circ> (\<lambda>i. Cn vl s [recf.id vl (i)])) [0..<vl])
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2186
                  = map Suc xs", auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2187
apply(rule map_s_lemma, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2188
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2189
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2190
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2191
  The @{text "scan"} function on page 90 of B book.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2192
  *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2193
fun scan :: "nat \<Rightarrow> nat"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2194
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2195
  "scan r = r mod 2"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2196
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2197
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2198
  @{text "rec_scan"} is the implemention of @{text "scan"}.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2199
  *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2200
definition rec_scan :: "recf"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2201
  where "rec_scan = Cn 1 rec_mod [id 1 0, constn 2]"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2202
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2203
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2204
  The correctness of @{text "scan"}.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2205
  *}
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2206
lemma scan_lemma: "rec_exec rec_scan [r] = r mod 2"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2207
  by(simp add: rec_exec.simps rec_scan_def mod_lemma)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2208
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2209
fun newleft0 :: "nat list \<Rightarrow> nat"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2210
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2211
  "newleft0 [p, r] = p"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2212
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2213
definition rec_newleft0 :: "recf"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2214
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2215
  "rec_newleft0 = id 2 0"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2216
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2217
fun newrgt0 :: "nat list \<Rightarrow> nat"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2218
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2219
  "newrgt0 [p, r] = r - scan r"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2220
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2221
definition rec_newrgt0 :: "recf"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2222
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2223
  "rec_newrgt0 = Cn 2 rec_minus [id 2 1, Cn 2 rec_scan [id 2 1]]"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2224
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2225
(*newleft1, newrgt1: left rgt number after execute on step*)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2226
fun newleft1 :: "nat list \<Rightarrow> nat"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2227
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2228
  "newleft1 [p, r] = p"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2229
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2230
definition rec_newleft1 :: "recf"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2231
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2232
  "rec_newleft1 = id 2 0"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2233
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2234
fun newrgt1 :: "nat list \<Rightarrow> nat"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2235
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2236
  "newrgt1 [p, r] = r + 1 - scan r"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2237
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2238
definition rec_newrgt1 :: "recf"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2239
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2240
  "rec_newrgt1 = 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2241
  Cn 2 rec_minus [Cn 2 rec_add [id 2 1, Cn 2 (constn 1) [id 2 0]], 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2242
                  Cn 2 rec_scan [id 2 1]]"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2243
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2244
fun newleft2 :: "nat list \<Rightarrow> nat"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2245
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2246
  "newleft2 [p, r] = p div 2"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2247
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2248
definition rec_newleft2 :: "recf" 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2249
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2250
  "rec_newleft2 = Cn 2 rec_quo [id 2 0, Cn 2 (constn 2) [id 2 0]]"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2251
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2252
fun newrgt2 :: "nat list \<Rightarrow> nat"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2253
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2254
  "newrgt2 [p, r] = 2 * r + p mod 2"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2255
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2256
definition rec_newrgt2 :: "recf"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2257
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2258
  "rec_newrgt2 =
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2259
    Cn 2 rec_add [Cn 2 rec_mult [Cn 2 (constn 2) [id 2 0], id 2 1],                     
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2260
                 Cn 2 rec_mod [id 2 0, Cn 2 (constn 2) [id 2 0]]]"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2261
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2262
fun newleft3 :: "nat list \<Rightarrow> nat"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2263
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2264
  "newleft3 [p, r] = 2 * p + r mod 2"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2265
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2266
definition rec_newleft3 :: "recf"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2267
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2268
  "rec_newleft3 = 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2269
  Cn 2 rec_add [Cn 2 rec_mult [Cn 2 (constn 2) [id 2 0], id 2 0], 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2270
                Cn 2 rec_mod [id 2 1, Cn 2 (constn 2) [id 2 0]]]"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2271
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2272
fun newrgt3 :: "nat list \<Rightarrow> nat"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2273
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2274
  "newrgt3 [p, r] = r div 2"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2275
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2276
definition rec_newrgt3 :: "recf"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2277
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2278
  "rec_newrgt3 = Cn 2 rec_quo [id 2 1, Cn 2 (constn 2) [id 2 0]]"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2279
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2280
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2281
  The @{text "new_left"} function on page 91 of B book.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2282
  *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2283
fun newleft :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2284
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2285
  "newleft p r a = (if a = 0 \<or> a = 1 then newleft0 [p, r] 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2286
                    else if a = 2 then newleft2 [p, r]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2287
                    else if a = 3 then newleft3 [p, r]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2288
                    else p)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2289
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2290
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2291
  @{text "rec_newleft"} is the recursive function used to 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2292
  implement @{text "newleft"}.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2293
  *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2294
definition rec_newleft :: "recf" 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2295
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2296
  "rec_newleft =
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2297
  (let g0 = 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2298
      Cn 3 rec_newleft0 [id 3 0, id 3 1] in 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2299
  let g1 = Cn 3 rec_newleft2 [id 3 0, id 3 1] in 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2300
  let g2 = Cn 3 rec_newleft3 [id 3 0, id 3 1] in 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2301
  let g3 = id 3 0 in
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2302
  let r0 = Cn 3 rec_disj
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2303
          [Cn 3 rec_eq [id 3 2, Cn 3 (constn 0) [id 3 0]],
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2304
           Cn 3 rec_eq [id 3 2, Cn 3 (constn 1) [id 3 0]]] in 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2305
  let r1 = Cn 3 rec_eq [id 3 2, Cn 3 (constn 2) [id 3 0]] in 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2306
  let r2 = Cn 3 rec_eq [id 3 2, Cn 3 (constn 3) [id 3 0]] in
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2307
  let r3 = Cn 3 rec_less [Cn 3 (constn 3) [id 3 0], id 3 2] in 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2308
  let gs = [g0, g1, g2, g3] in 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2309
  let rs = [r0, r1, r2, r3] in 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2310
  rec_embranch (zip gs rs))"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2311
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2312
declare newleft.simps[simp del]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2313
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2314
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2315
lemma Suc_Suc_Suc_Suc_induct: 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2316
  "\<lbrakk>i < Suc (Suc (Suc (Suc 0))); i = 0 \<Longrightarrow>  P i;
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2317
    i = 1 \<Longrightarrow> P i; i =2 \<Longrightarrow> P i; 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2318
    i =3 \<Longrightarrow> P i\<rbrakk> \<Longrightarrow> P i"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2319
apply(case_tac i, simp, case_tac nat, simp, 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2320
      case_tac nata, simp, case_tac natb, simp, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2321
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2322
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2323
declare quo_lemma2[simp] mod_lemma[simp]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2324
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2325
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2326
  The correctness of @{text "rec_newleft"}.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2327
  *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2328
lemma newleft_lemma: 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2329
  "rec_exec rec_newleft [p, r, a] = newleft p r a"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2330
proof(simp only: rec_newleft_def Let_def)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2331
  let ?rgs = "[Cn 3 rec_newleft0 [recf.id 3 0, recf.id 3 1], Cn 3 rec_newleft2 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2332
       [recf.id 3 0, recf.id 3 1], Cn 3 rec_newleft3 [recf.id 3 0, recf.id 3 1], recf.id 3 0]"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2333
  let ?rrs = 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2334
    "[Cn 3 rec_disj [Cn 3 rec_eq [recf.id 3 2, Cn 3 (constn 0) 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2335
     [recf.id 3 0]], Cn 3 rec_eq [recf.id 3 2, Cn 3 (constn 1) [recf.id 3 0]]], 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2336
     Cn 3 rec_eq [recf.id 3 2, Cn 3 (constn 2) [recf.id 3 0]],
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2337
     Cn 3 rec_eq [recf.id 3 2, Cn 3 (constn 3) [recf.id 3 0]],
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2338
     Cn 3 rec_less [Cn 3 (constn 3) [recf.id 3 0], recf.id 3 2]]"
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2339
  have k1: "rec_exec (rec_embranch (zip ?rgs ?rrs)) [p, r, a]
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2340
                         = Embranch (zip (map rec_exec ?rgs) (map (\<lambda>r args. 0 < rec_exec r args) ?rrs)) [p, r, a]"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2341
    apply(rule_tac embranch_lemma )
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2342
    apply(auto simp: numeral_3_eq_3 numeral_2_eq_2 rec_newleft0_def 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2343
             rec_newleft1_def rec_newleft2_def rec_newleft3_def)+
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2344
    apply(case_tac "a = 0 \<or> a = 1", rule_tac x = 0 in exI)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2345
    prefer 2
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2346
    apply(case_tac "a = 2", rule_tac x = "Suc 0" in exI)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2347
    prefer 2
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2348
    apply(case_tac "a = 3", rule_tac x = "2" in exI)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2349
    prefer 2
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2350
    apply(case_tac "a > 3", rule_tac x = "3" in exI, auto)
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2351
    apply(auto simp: rec_exec.simps)
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2352
    apply(erule_tac [!] Suc_Suc_Suc_Suc_induct, auto simp: rec_exec.simps)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2353
    done
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2354
  have k2: "Embranch (zip (map rec_exec ?rgs) (map (\<lambda>r args. 0 < rec_exec r args) ?rrs)) [p, r, a] = newleft p r a"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2355
    apply(simp add: Embranch.simps)
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2356
    apply(simp add: rec_exec.simps)
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2357
    apply(auto simp: newleft.simps rec_newleft0_def rec_exec.simps
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2358
                     rec_newleft1_def rec_newleft2_def rec_newleft3_def)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2359
    done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2360
  from k1 and k2 show 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2361
   "rec_exec (rec_embranch (zip ?rgs ?rrs)) [p, r, a] = newleft p r a"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2362
    by simp
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2363
qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2364
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2365
text {* 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2366
  The @{text "newrght"} function is one similar to @{text "newleft"}, but used to 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2367
  compute the right number.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2368
  *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2369
fun newrght :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2370
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2371
  "newrght p r a  = (if a = 0 then newrgt0 [p, r]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2372
                    else if a = 1 then newrgt1 [p, r]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2373
                    else if a = 2 then newrgt2 [p, r]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2374
                    else if a = 3 then newrgt3 [p, r]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2375
                    else r)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2376
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2377
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2378
  @{text "rec_newrght"} is the recursive function used to implement 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2379
  @{text "newrgth"}.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2380
  *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2381
definition rec_newrght :: "recf" 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2382
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2383
  "rec_newrght =
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2384
  (let g0 = Cn 3 rec_newrgt0 [id 3 0, id 3 1] in 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2385
  let g1 = Cn 3 rec_newrgt1 [id 3 0, id 3 1] in 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2386
  let g2 = Cn 3 rec_newrgt2 [id 3 0, id 3 1] in 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2387
  let g3 = Cn 3 rec_newrgt3 [id 3 0, id 3 1] in
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2388
  let g4 = id 3 1 in 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2389
  let r0 = Cn 3 rec_eq [id 3 2, Cn 3 (constn 0) [id 3 0]] in 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2390
  let r1 = Cn 3 rec_eq [id 3 2, Cn 3 (constn 1) [id 3 0]] in 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2391
  let r2 = Cn 3 rec_eq [id 3 2, Cn 3 (constn 2) [id 3 0]] in
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2392
  let r3 = Cn 3 rec_eq [id 3 2, Cn 3 (constn 3) [id 3 0]] in
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2393
  let r4 = Cn 3 rec_less [Cn 3 (constn 3) [id 3 0], id 3 2] in 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2394
  let gs = [g0, g1, g2, g3, g4] in 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2395
  let rs = [r0, r1, r2, r3, r4] in 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2396
  rec_embranch (zip gs rs))"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2397
declare newrght.simps[simp del]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2398
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2399
lemma numeral_4_eq_4: "4 = Suc 3"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2400
by auto
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2401
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2402
lemma Suc_5_induct: 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2403
  "\<lbrakk>i < Suc (Suc (Suc (Suc (Suc 0)))); i = 0 \<Longrightarrow> P 0;
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2404
  i = 1 \<Longrightarrow> P 1; i = 2 \<Longrightarrow> P 2; i = 3 \<Longrightarrow> P 3; i = 4 \<Longrightarrow> P 4\<rbrakk> \<Longrightarrow> P i"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2405
apply(case_tac i, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2406
apply(case_tac nat, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2407
apply(case_tac nata, auto simp: numeral_2_eq_2)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2408
apply(case_tac nat, auto simp: numeral_3_eq_3 numeral_4_eq_4)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2409
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2410
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2411
lemma primerec_rec_scan_1[intro]: "primerec rec_scan (Suc 0)"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2412
apply(auto simp: rec_scan_def, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2413
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2414
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2415
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2416
  The correctness of @{text "rec_newrght"}.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2417
  *}
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2418
lemma newrght_lemma: "rec_exec rec_newrght [p, r, a] = newrght p r a"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2419
proof(simp only: rec_newrght_def Let_def)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2420
  let ?gs' = "[newrgt0, newrgt1, newrgt2, newrgt3, \<lambda> zs. zs ! 1]"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2421
  let ?r0 = "\<lambda> zs. zs ! 2 = 0"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2422
  let ?r1 = "\<lambda> zs. zs ! 2 = 1"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2423
  let ?r2 = "\<lambda> zs. zs ! 2 = 2"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2424
  let ?r3 = "\<lambda> zs. zs ! 2 = 3"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2425
  let ?r4 = "\<lambda> zs. zs ! 2 > 3"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2426
  let ?gs = "map (\<lambda> g. (\<lambda> zs. g [zs ! 0, zs ! 1])) ?gs'"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2427
  let ?rs = "[?r0, ?r1, ?r2, ?r3, ?r4]"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2428
  let ?rgs = 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2429
 "[Cn 3 rec_newrgt0 [recf.id 3 0, recf.id 3 1],
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2430
    Cn 3 rec_newrgt1 [recf.id 3 0, recf.id 3 1],
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2431
     Cn 3 rec_newrgt2 [recf.id 3 0, recf.id 3 1], 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2432
      Cn 3 rec_newrgt3 [recf.id 3 0, recf.id 3 1], recf.id 3 1]"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2433
  let ?rrs = 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2434
 "[Cn 3 rec_eq [recf.id 3 2, Cn 3 (constn 0) [recf.id 3 0]], Cn 3 rec_eq [recf.id 3 2, 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2435
    Cn 3 (constn 1) [recf.id 3 0]], Cn 3 rec_eq [recf.id 3 2, Cn 3 (constn 2) [recf.id 3 0]],
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2436
     Cn 3 rec_eq [recf.id 3 2, Cn 3 (constn 3) [recf.id 3 0]], 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2437
       Cn 3 rec_less [Cn 3 (constn 3) [recf.id 3 0], recf.id 3 2]]"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2438
    
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2439
  have k1: "rec_exec (rec_embranch (zip ?rgs ?rrs)) [p, r, a]
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2440
    = Embranch (zip (map rec_exec ?rgs) (map (\<lambda>r args. 0 < rec_exec r args) ?rrs)) [p, r, a]"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2441
    apply(rule_tac embranch_lemma)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2442
    apply(auto simp: numeral_3_eq_3 numeral_2_eq_2 rec_newrgt0_def 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2443
             rec_newrgt1_def rec_newrgt2_def rec_newrgt3_def)+
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2444
    apply(case_tac "a = 0", rule_tac x = 0 in exI)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2445
    prefer 2
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2446
    apply(case_tac "a = 1", rule_tac x = "Suc 0" in exI)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2447
    prefer 2
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2448
    apply(case_tac "a = 2", rule_tac x = "2" in exI)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2449
    prefer 2
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2450
    apply(case_tac "a = 3", rule_tac x = "3" in exI)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2451
    prefer 2
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2452
    apply(case_tac "a > 3", rule_tac x = "4" in exI, auto simp: rec_exec.simps)
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2453
    apply(erule_tac [!] Suc_5_induct, auto simp: rec_exec.simps)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2454
    done
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2455
  have k2: "Embranch (zip (map rec_exec ?rgs)
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2456
    (map (\<lambda>r args. 0 < rec_exec r args) ?rrs)) [p, r, a] = newrght p r a"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2457
    apply(auto simp:Embranch.simps rec_exec.simps)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2458
    apply(auto simp: newrght.simps rec_newrgt3_def rec_newrgt2_def
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2459
                     rec_newrgt1_def rec_newrgt0_def rec_exec.simps
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2460
                     scan_lemma)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2461
    done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2462
  from k1 and k2 show 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2463
    "rec_exec (rec_embranch (zip ?rgs ?rrs)) [p, r, a] =      
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2464
                                    newrght p r a" by simp
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2465
qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2466
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2467
declare Entry.simps[simp del]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2468
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2469
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2470
  The @{text "actn"} function given on page 92 of B book, which is used to 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2471
  fetch Turing Machine intructions. 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2472
  In @{text "actn m q r"}, @{text "m"} is the Godel coding of a Turing Machine,
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2473
  @{text "q"} is the current state of Turing Machine, @{text "r"} is the
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2474
  right number of Turing Machine tape.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2475
  *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2476
fun actn :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2477
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2478
  "actn m q r = (if q \<noteq> 0 then Entry m (4*(q - 1) + 2 * scan r)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2479
                 else 4)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2480
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2481
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2482
  @{text "rec_actn"} is the recursive function used to implement @{text "actn"}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2483
  *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2484
definition rec_actn :: "recf"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2485
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2486
  "rec_actn = 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2487
  Cn 3 rec_add [Cn 3 rec_mult 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2488
        [Cn 3 rec_entry [id 3 0, Cn 3 rec_add [Cn 3 rec_mult 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2489
                                 [Cn 3 (constn 4) [id 3 0], 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2490
                Cn 3 rec_minus [id 3 1, Cn 3 (constn 1) [id 3 0]]], 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2491
                   Cn 3 rec_mult [Cn 3 (constn 2) [id 3 0],
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2492
                      Cn 3 rec_scan [id 3 2]]]], 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2493
            Cn 3 rec_noteq [id 3 1, Cn 3 (constn 0) [id 3 0]]], 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2494
                             Cn 3 rec_mult [Cn 3 (constn 4) [id 3 0], 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2495
             Cn 3 rec_eq [id 3 1, Cn 3 (constn 0) [id 3 0]]]] "
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2496
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2497
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2498
  The correctness of @{text "actn"}.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2499
  *}
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2500
lemma actn_lemma: "rec_exec rec_actn [m, q, r] = actn m q r"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2501
  by(auto simp: rec_actn_def rec_exec.simps entry_lemma scan_lemma)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2502
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2503
fun newstat :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2504
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2505
  "newstat m q r = (if q \<noteq> 0 then Entry m (4*(q - 1) + 2*scan r + 1)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2506
                    else 0)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2507
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2508
definition rec_newstat :: "recf"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2509
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2510
  "rec_newstat = Cn 3 rec_add 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2511
    [Cn 3 rec_mult [Cn 3 rec_entry [id 3 0, 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2512
           Cn 3 rec_add [Cn 3 rec_mult [Cn 3 (constn 4) [id 3 0], 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2513
           Cn 3 rec_minus [id 3 1, Cn 3 (constn 1) [id 3 0]]], 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2514
           Cn 3 rec_add [Cn 3 rec_mult [Cn 3 (constn 2) [id 3 0],
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2515
           Cn 3 rec_scan [id 3 2]], Cn 3 (constn 1) [id 3 0]]]], 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2516
           Cn 3 rec_noteq [id 3 1, Cn 3 (constn 0) [id 3 0]]], 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2517
           Cn 3 rec_mult [Cn 3 (constn 0) [id 3 0], 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2518
           Cn 3 rec_eq [id 3 1, Cn 3 (constn 0) [id 3 0]]]] "
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2519
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2520
lemma newstat_lemma: "rec_exec rec_newstat [m, q, r] = newstat m q r"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2521
by(auto simp:  rec_exec.simps entry_lemma scan_lemma rec_newstat_def)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2522
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2523
declare newstat.simps[simp del] actn.simps[simp del]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2524
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2525
text{*code the configuration*}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2526
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2527
fun trpl :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2528
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2529
  "trpl p q r = (Pi 0)^p * (Pi 1)^q * (Pi 2)^r"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2530
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2531
definition rec_trpl :: "recf"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2532
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2533
  "rec_trpl = Cn 3 rec_mult [Cn 3 rec_mult 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2534
       [Cn 3 rec_power [Cn 3 (constn (Pi 0)) [id 3 0], id 3 0], 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2535
        Cn 3 rec_power [Cn 3 (constn (Pi 1)) [id 3 0], id 3 1]],
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2536
        Cn 3 rec_power [Cn 3 (constn (Pi 2)) [id 3 0], id 3 2]]"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2537
declare trpl.simps[simp del]
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2538
lemma trpl_lemma: "rec_exec rec_trpl [p, q, r] = trpl p q r"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2539
by(auto simp: rec_trpl_def rec_exec.simps power_lemma trpl.simps)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2540
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2541
text{*left, stat, rght: decode func*}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2542
fun left :: "nat \<Rightarrow> nat"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2543
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2544
  "left c = lo c (Pi 0)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2545
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2546
fun stat :: "nat \<Rightarrow> nat"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2547
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2548
  "stat c = lo c (Pi 1)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2549
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2550
fun rght :: "nat \<Rightarrow> nat"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2551
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2552
  "rght c = lo c (Pi 2)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2553
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2554
fun inpt :: "nat \<Rightarrow> nat list \<Rightarrow> nat"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2555
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2556
  "inpt m xs = trpl 0 1 (strt xs)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2557
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2558
fun newconf :: "nat \<Rightarrow> nat \<Rightarrow> nat"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2559
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2560
  "newconf m c = trpl (newleft (left c) (rght c) 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2561
                        (actn m (stat c) (rght c)))
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2562
                        (newstat m (stat c) (rght c)) 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2563
                        (newrght (left c) (rght c) 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2564
                              (actn m (stat c) (rght c)))"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2565
  
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2566
declare left.simps[simp del] stat.simps[simp del] rght.simps[simp del]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2567
        inpt.simps[simp del] newconf.simps[simp del]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2568
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2569
definition rec_left :: "recf"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2570
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2571
  "rec_left = Cn 1 rec_lo [id 1 0, constn (Pi 0)]"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2572
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2573
definition rec_right :: "recf"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2574
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2575
  "rec_right = Cn 1 rec_lo [id 1 0, constn (Pi 2)]"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2576
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2577
definition rec_stat :: "recf"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2578
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2579
  "rec_stat = Cn 1 rec_lo [id 1 0, constn (Pi 1)]"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2580
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2581
definition rec_inpt :: "nat \<Rightarrow> recf"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2582
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2583
  "rec_inpt vl = Cn vl rec_trpl 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2584
                  [Cn vl (constn 0) [id vl 0], 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2585
                   Cn vl (constn 1) [id vl 0], 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2586
                   Cn vl (rec_strt (vl - 1)) 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2587
                        (map (\<lambda> i. id vl (i)) [1..<vl])]"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2588
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2589
lemma left_lemma: "rec_exec rec_left [c] = left c"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2590
by(simp add: rec_exec.simps rec_left_def left.simps lo_lemma)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2591
      
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2592
lemma right_lemma: "rec_exec rec_right [c] = rght c"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2593
by(simp add: rec_exec.simps rec_right_def rght.simps lo_lemma)
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2594
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2595
lemma stat_lemma: "rec_exec rec_stat [c] = stat c"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2596
by(simp add: rec_exec.simps rec_stat_def stat.simps lo_lemma)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2597
 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2598
declare rec_strt.simps[simp del] strt.simps[simp del]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2599
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2600
lemma map_cons_eq: 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2601
  "(map ((\<lambda>a. rec_exec a (m # xs)) \<circ> 
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2602
    (\<lambda>i. recf.id (Suc (length xs)) (i))) 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2603
          [Suc 0..<Suc (length xs)])
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2604
        = map (\<lambda> i. xs ! (i - 1)) [Suc 0..<Suc (length xs)]"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2605
apply(rule map_ext, auto)
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2606
apply(auto simp: rec_exec.simps nth_append nth_Cons split: nat.split)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2607
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2608
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2609
lemma list_map_eq: 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2610
  "vl = length (xs::nat list) \<Longrightarrow> map (\<lambda> i. xs ! (i - 1))
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2611
                                          [Suc 0..<Suc vl] = xs"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2612
apply(induct vl arbitrary: xs, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2613
apply(subgoal_tac "\<exists> ys y. xs = ys @ [y]", auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2614
proof -
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2615
  fix ys y
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2616
  assume ind: 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2617
    "\<And>xs. length (ys::nat list) = length (xs::nat list) \<Longrightarrow>
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2618
            map (\<lambda>i. xs ! (i - Suc 0)) [Suc 0..<length xs] @
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2619
                                [xs ! (length xs - Suc 0)] = xs"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2620
  and h: "Suc 0 \<le> length (ys::nat list)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2621
  have "map (\<lambda>i. ys ! (i - Suc 0)) [Suc 0..<length ys] @ 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2622
                                   [ys ! (length ys - Suc 0)] = ys"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2623
    apply(rule_tac ind, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2624
    done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2625
  moreover have 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2626
    "map (\<lambda>i. (ys @ [y]) ! (i - Suc 0)) [Suc 0..<length ys]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2627
      = map (\<lambda>i. ys ! (i - Suc 0)) [Suc 0..<length ys]"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2628
    apply(rule map_ext)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2629
    using h
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2630
    apply(auto simp: nth_append)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2631
    done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2632
  ultimately show "map (\<lambda>i. (ys @ [y]) ! (i - Suc 0)) 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2633
        [Suc 0..<length ys] @ [(ys @ [y]) ! (length ys - Suc 0)] = ys"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2634
    apply(simp del: map_eq_conv add: nth_append, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2635
    using h
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2636
    apply(simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2637
    done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2638
next
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2639
  fix vl xs
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2640
  assume "Suc vl = length (xs::nat list)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2641
  thus "\<exists>ys y. xs = ys @ [y]"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2642
    apply(rule_tac x = "butlast xs" in exI, 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2643
          rule_tac x = "last xs" in exI)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2644
    apply(case_tac "xs \<noteq> []", auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2645
    done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2646
qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2647
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2648
lemma nonempty_listE: 
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2649
  "Suc 0 \<le> length xs \<Longrightarrow> 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2650
     (map ((\<lambda>a. rec_exec a (m # xs)) \<circ> 
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2651
         (\<lambda>i. recf.id (Suc (length xs)) (i))) 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2652
             [Suc 0..<length xs] @ [(m # xs) ! length xs]) = xs"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2653
using map_cons_eq[of m xs]
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2654
apply(simp del: map_eq_conv add: rec_exec.simps)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2655
using list_map_eq[of "length xs" xs]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2656
apply(simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2657
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2658
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2659
    
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2660
lemma inpt_lemma:
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2661
  "\<lbrakk>Suc (length xs) = vl\<rbrakk> \<Longrightarrow> 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2662
            rec_exec (rec_inpt vl) (m # xs) = inpt m xs"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2663
apply(auto simp: rec_exec.simps rec_inpt_def 
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2664
                 trpl_lemma inpt.simps strt_lemma)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2665
apply(subgoal_tac
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2666
  "(map ((\<lambda>a. rec_exec a (m # xs)) \<circ> 
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2667
          (\<lambda>i. recf.id (Suc (length xs)) (i))) 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2668
            [Suc 0..<length xs] @ [(m # xs) ! length xs]) = xs", simp)
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2669
apply(auto elim:nonempty_listE, case_tac xs, auto)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2670
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2671
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2672
definition rec_newconf:: "recf"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2673
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2674
  "rec_newconf = 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2675
    Cn 2 rec_trpl 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2676
        [Cn 2 rec_newleft [Cn 2 rec_left [id 2 1], 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2677
                           Cn 2 rec_right [id 2 1], 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2678
                           Cn 2 rec_actn [id 2 0, 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2679
                                          Cn 2 rec_stat [id 2 1], 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2680
                           Cn 2 rec_right [id 2 1]]],
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2681
          Cn 2 rec_newstat [id 2 0, 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2682
                            Cn 2 rec_stat [id 2 1], 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2683
                            Cn 2 rec_right [id 2 1]],
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2684
           Cn 2 rec_newrght [Cn 2 rec_left [id 2 1], 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2685
                             Cn 2 rec_right [id 2 1], 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2686
                             Cn 2 rec_actn [id 2 0, 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2687
                                   Cn 2 rec_stat [id 2 1], 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2688
                             Cn 2 rec_right [id 2 1]]]]"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2689
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2690
lemma newconf_lemma: "rec_exec rec_newconf [m ,c] = newconf m c"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2691
by(auto simp: rec_newconf_def rec_exec.simps 
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2692
              trpl_lemma newleft_lemma left_lemma
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2693
              right_lemma stat_lemma newrght_lemma actn_lemma 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2694
               newstat_lemma stat_lemma newconf.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2695
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2696
declare newconf_lemma[simp]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2697
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2698
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2699
  @{text "conf m r k"} computes the TM configuration after @{text "k"} steps of execution
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2700
  of TM coded as @{text "m"} starting from the initial configuration where the left number equals @{text "0"}, 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2701
  right number equals @{text "r"}. 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2702
  *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2703
fun conf :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2704
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2705
  "conf m r 0 = trpl 0 (Suc 0) r"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2706
| "conf m r (Suc t) = newconf m (conf m r t)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2707
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2708
declare conf.simps[simp del]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2709
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2710
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2711
  @{text "conf"} is implemented by the following recursive function @{text "rec_conf"}.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2712
  *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2713
definition rec_conf :: "recf"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2714
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2715
  "rec_conf = Pr 2 (Cn 2 rec_trpl [Cn 2 (constn 0) [id 2 0], Cn 2 (constn (Suc 0)) [id 2 0], id 2 1])
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2716
                  (Cn 4 rec_newconf [id 4 0, id 4 3])"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2717
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2718
lemma conf_step: 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2719
  "rec_exec rec_conf [m, r, Suc t] =
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2720
         rec_exec rec_newconf [m, rec_exec rec_conf [m, r, t]]"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2721
proof -
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2722
  have "rec_exec rec_conf ([m, r] @ [Suc t]) = 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2723
          rec_exec rec_newconf [m, rec_exec rec_conf [m, r, t]]"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2724
    by(simp only: rec_conf_def rec_pr_Suc_simp_rewrite,
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2725
        simp add: rec_exec.simps)
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2726
  thus "rec_exec rec_conf [m, r, Suc t] =
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2727
                rec_exec rec_newconf [m, rec_exec rec_conf [m, r, t]]"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2728
    by simp
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2729
qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2730
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2731
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2732
  The correctness of @{text "rec_conf"}.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2733
  *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2734
lemma conf_lemma: 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2735
  "rec_exec rec_conf [m, r, t] = conf m r t"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2736
apply(induct t)
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2737
apply(simp add: rec_conf_def rec_exec.simps conf.simps inpt_lemma trpl_lemma)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2738
apply(simp add: conf_step conf.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2739
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2740
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2741
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2742
  @{text "NSTD c"} returns true if the configureation coded by @{text "c"} is no a stardard
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2743
  final configuration.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2744
  *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2745
fun NSTD :: "nat \<Rightarrow> bool"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2746
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2747
  "NSTD c = (stat c \<noteq> 0 \<or> left c \<noteq> 0 \<or> 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2748
             rght c \<noteq> 2^(lg (rght c + 1) 2) - 1 \<or> rght c = 0)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2749
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2750
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2751
  @{text "rec_NSTD"} is the recursive function implementing @{text "NSTD"}.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2752
  *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2753
definition rec_NSTD :: "recf"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2754
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2755
  "rec_NSTD =
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2756
     Cn 1 rec_disj [
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2757
          Cn 1 rec_disj [
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2758
             Cn 1 rec_disj 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2759
                [Cn 1 rec_noteq [rec_stat, constn 0], 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2760
                 Cn 1 rec_noteq [rec_left, constn 0]] , 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2761
              Cn 1 rec_noteq [rec_right,  
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2762
                              Cn 1 rec_minus [Cn 1 rec_power 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2763
                                 [constn 2, Cn 1 rec_lg 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2764
                                    [Cn 1 rec_add        
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2765
                                     [rec_right, constn 1], 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2766
                                            constn 2]], constn 1]]],
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2767
               Cn 1 rec_eq [rec_right, constn 0]]"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2768
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2769
lemma NSTD_lemma1: "rec_exec rec_NSTD [c] = Suc 0 \<or>
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2770
                   rec_exec rec_NSTD [c] = 0"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2771
by(simp add: rec_exec.simps rec_NSTD_def)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2772
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2773
declare NSTD.simps[simp del]
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2774
lemma NSTD_lemma2': "(rec_exec rec_NSTD [c] = Suc 0) \<Longrightarrow> NSTD c"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2775
apply(simp add: rec_exec.simps rec_NSTD_def stat_lemma left_lemma 
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2776
                lg_lemma right_lemma power_lemma NSTD.simps eq_lemma)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2777
apply(auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2778
apply(case_tac "0 < left c", simp, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2779
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2780
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2781
lemma NSTD_lemma2'': 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2782
  "NSTD c \<Longrightarrow> (rec_exec rec_NSTD [c] = Suc 0)"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2783
apply(simp add: rec_exec.simps rec_NSTD_def stat_lemma 
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2784
         left_lemma lg_lemma right_lemma power_lemma NSTD.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2785
apply(auto split: if_splits)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2786
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2787
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2788
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2789
  The correctness of @{text "NSTD"}.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2790
  *}
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2791
lemma NSTD_lemma2: "(rec_exec rec_NSTD [c] = Suc 0) = NSTD c"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2792
using NSTD_lemma1
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2793
apply(auto intro: NSTD_lemma2' NSTD_lemma2'')
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2794
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2795
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2796
fun nstd :: "nat \<Rightarrow> nat"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2797
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2798
  "nstd c = (if NSTD c then 1 else 0)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2799
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2800
lemma nstd_lemma: "rec_exec rec_NSTD [c] = nstd c"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2801
using NSTD_lemma1
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2802
apply(simp add: NSTD_lemma2, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2803
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2804
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2805
text{* 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2806
  @{text "nonstep m r t"} means afer @{text "t"} steps of execution, the TM coded by @{text "m"}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2807
  is not at a stardard final configuration.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2808
  *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2809
fun nonstop :: "nat \<Rightarrow> nat  \<Rightarrow> nat \<Rightarrow> nat"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2810
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2811
  "nonstop m r t = nstd (conf m r t)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2812
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2813
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2814
  @{text "rec_nonstop"} is the recursive function implementing @{text "nonstop"}.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2815
  *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2816
definition rec_nonstop :: "recf"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2817
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2818
  "rec_nonstop = Cn 3 rec_NSTD [rec_conf]"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2819
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2820
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2821
  The correctness of @{text "rec_nonstop"}.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2822
  *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2823
lemma nonstop_lemma: 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2824
  "rec_exec rec_nonstop [m, r, t] = nonstop m r t"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2825
apply(simp add: rec_exec.simps rec_nonstop_def nstd_lemma conf_lemma)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2826
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2827
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2828
text{*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2829
  @{text "rec_halt"} is the recursive function calculating the steps a TM needs to execute before
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2830
  to reach a stardard final configuration. This recursive function is the only one
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2831
  using @{text "Mn"} combinator. So it is the only non-primitive recursive function 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2832
  needs to be used in the construction of the universal function @{text "F"}.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2833
  *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2834
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2835
definition rec_halt :: "recf"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2836
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2837
  "rec_halt = Mn (Suc (Suc 0)) (rec_nonstop)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2838
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2839
declare nonstop.simps[simp del]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2840
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2841
lemma primerec_not0: "primerec f n \<Longrightarrow> n > 0"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2842
by(induct f n rule: primerec.induct, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2843
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2844
lemma primerec_not0E[elim]: "primerec f 0 \<Longrightarrow> RR"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2845
apply(drule_tac primerec_not0, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2846
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2847
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2848
lemma length_butlast[simp]: "length xs = Suc n \<Longrightarrow> length (butlast xs) = n"
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2849
apply(subgoal_tac "\<exists> y ys. xs = ys @ [y]",force)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2850
apply(rule_tac x = "last xs" in exI)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2851
apply(rule_tac x = "butlast xs" in exI)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2852
apply(case_tac "xs = []", auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2853
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2854
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2855
text {*
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2856
  The lemma relates the interpreter of primitive functions with
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2857
  the calculation relation of general recursive functions. 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2858
  *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2859
        
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2860
declare numeral_2_eq_2[simp] numeral_3_eq_3[simp]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2861
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2862
lemma primerec_rec_right_1[intro]: "primerec rec_right (Suc 0)"
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2863
  by(auto simp: rec_right_def rec_lo_def Let_def;force)
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2864
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2865
lemma primerec_rec_pi_helper:
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2866
  "\<forall>i<Suc (Suc 0). primerec ([recf.id (Suc 0) 0, recf.id (Suc 0) 0] ! i) (Suc 0)"
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2867
  by fastforce
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2868
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2869
lemmas primerec_rec_pi_helpers =
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2870
  primerec_rec_pi_helper primerec_constn_1 primerec_rec_sg_1 primerec_rec_not_1 primerec_rec_conj_2
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2871
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2872
lemma primrec_dummyfac:
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2873
  "\<forall>i<Suc (Suc 0).
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2874
       primerec
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2875
        ([recf.id (Suc 0) 0,
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2876
          Cn (Suc 0) s
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2877
           [Cn (Suc 0) rec_dummyfac
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2878
             [recf.id (Suc 0) 0, recf.id (Suc 0) 0]]] !
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2879
         i)
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2880
        (Suc 0)"
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2881
  by(auto simp: rec_dummyfac_def;force)
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2882
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2883
lemma primerec_rec_pi_1[intro]:  "primerec rec_pi (Suc 0)"
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2884
  apply(simp add: rec_pi_def rec_dummy_pi_def 
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2885
                  rec_np_def rec_fac_def rec_prime_def
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2886
                  rec_Minr.simps Let_def get_fstn_args.simps
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2887
                  arity.simps
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2888
                  rec_all.simps rec_sigma.simps rec_accum.simps)
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2889
  apply(tactic {* resolve_tac @{context} [@{thm prime_cn},  @{thm prime_pr}] 1*}
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2890
       ;(simp add:primerec_rec_pi_helpers primrec_dummyfac)?)+
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2891
  by fastforce+
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2892
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2893
lemma primerec_rec_trpl[intro]: "primerec rec_trpl (Suc (Suc (Suc 0)))"
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2894
apply(simp add: rec_trpl_def)
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2895
apply(tactic {* resolve_tac @{context} [@{thm prime_cn}, 
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2896
    @{thm prime_id}, @{thm prime_pr}] 1*}, auto+)+
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2897
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2898
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2899
lemma primerec_rec_listsum2[intro!]: "\<lbrakk>0 < vl; n \<le> vl\<rbrakk> \<Longrightarrow> primerec (rec_listsum2 vl n) vl"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2900
apply(induct n)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2901
apply(simp_all add: rec_strt'.simps Let_def rec_listsum2.simps)
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2902
apply(tactic {* resolve_tac @{context} [@{thm prime_cn}, 
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2903
    @{thm prime_id}, @{thm prime_pr}] 1*}, auto+)+
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2904
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2905
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2906
lemma primerec_rec_strt': "\<lbrakk>0 < vl; n \<le> vl\<rbrakk> \<Longrightarrow> primerec (rec_strt' vl n) vl"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2907
apply(induct n)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2908
apply(simp_all add: rec_strt'.simps Let_def)
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2909
apply(tactic {* resolve_tac @{context} [@{thm prime_cn}, 
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2910
    @{thm prime_id}, @{thm prime_pr}] 1*}, auto+)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2911
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2912
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2913
lemma primerec_rec_strt: "vl > 0 \<Longrightarrow> primerec (rec_strt vl) vl"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2914
apply(simp add: rec_strt.simps rec_strt'.simps)
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2915
by(tactic {* resolve_tac @{context} [@{thm prime_cn}, 
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2916
    @{thm prime_id}, @{thm prime_pr}] 1*}; force elim:primerec_rec_strt')
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2917
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2918
lemma primerec_map_vl: 
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2919
  "i < vl \<Longrightarrow> primerec ((map (\<lambda>i. recf.id (Suc vl) (i)) 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2920
        [Suc 0..<vl] @ [recf.id (Suc vl) (vl)]) ! i) (Suc vl)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2921
apply(induct i, auto simp: nth_append)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2922
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2923
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2924
lemma primerec_recs[intro]:
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2925
  "primerec rec_newleft0 (Suc (Suc 0))"
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2926
  "primerec rec_newleft1 (Suc (Suc 0))"
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2927
"primerec rec_newleft2 (Suc (Suc 0))"
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2928
"primerec rec_newleft3 ((Suc (Suc 0)))"
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2929
"primerec rec_newleft (Suc (Suc (Suc 0)))"
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2930
"primerec rec_left (Suc 0)"
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2931
"primerec rec_actn (Suc (Suc (Suc 0)))"
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2932
"primerec rec_stat (Suc 0)"
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2933
"primerec rec_newstat (Suc (Suc (Suc 0)))"
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2934
apply(simp_all add: rec_newleft_def rec_embranch.simps rec_left_def rec_lo_def rec_entry_def
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2935
                rec_actn_def Let_def arity.simps rec_newleft0_def rec_stat_def rec_newstat_def
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2936
                rec_newleft1_def rec_newleft2_def rec_newleft3_def)
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2937
apply(tactic {* resolve_tac @{context} [@{thm prime_cn}, 
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2938
    @{thm prime_id}, @{thm prime_pr}] 1*};force)+
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2939
  done
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2940
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2941
lemma primerec_rec_newrght[intro]: "primerec rec_newrght (Suc (Suc (Suc 0)))"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2942
apply(simp add: rec_newrght_def rec_embranch.simps
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2943
                Let_def arity.simps rec_newrgt0_def 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2944
                rec_newrgt1_def rec_newrgt2_def rec_newrgt3_def)
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2945
apply(tactic {* resolve_tac @{context} [@{thm prime_cn}, 
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2946
    @{thm prime_id}, @{thm prime_pr}] 1*};force)+
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2947
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2948
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2949
lemma primerec_rec_newconf[intro]: "primerec rec_newconf (Suc (Suc 0))"
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2950
apply(simp add: rec_newconf_def)
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2951
by(tactic {* resolve_tac @{context} [@{thm prime_cn}, 
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2952
    @{thm prime_id}, @{thm prime_pr}] 1*};force)
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2953
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2954
lemma primerec_rec_inpt[intro]: "0 < vl \<Longrightarrow> primerec (rec_inpt (Suc vl)) (Suc vl)"
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2955
apply(simp add: rec_inpt_def)
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2956
apply(tactic {* resolve_tac @{context} [@{thm prime_cn}, 
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2957
    @{thm prime_id}, @{thm prime_pr}] 1*}; fastforce elim:primerec_rec_strt primerec_map_vl)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2958
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2959
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2960
lemma primerec_rec_conf[intro]: "primerec rec_conf (Suc (Suc (Suc 0)))"
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2961
apply(simp add: rec_conf_def)
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2962
by(tactic {* resolve_tac @{context} [@{thm prime_cn}, 
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2963
    @{thm prime_id}, @{thm prime_pr}] 1*};force simp: numeral)
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2964
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2965
lemma primerec_recs2[intro]:
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2966
  "primerec rec_lg (Suc (Suc 0))"
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2967
  "primerec rec_nonstop (Suc (Suc (Suc 0)))"
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2968
apply(simp_all add: rec_lg_def rec_nonstop_def rec_NSTD_def rec_stat_def
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2969
     rec_lo_def Let_def rec_left_def rec_right_def rec_newconf_def
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2970
     rec_newstat_def)
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2971
by(tactic {* resolve_tac @{context} [@{thm prime_cn}, 
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  2972
    @{thm prime_id}, @{thm prime_pr}] 1*};fastforce)+
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2973
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2974
lemma primerec_terminate: 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2975
  "\<lbrakk>primerec f x; length xs = x\<rbrakk> \<Longrightarrow> terminate f xs"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 199
diff changeset
  2976
proof(induct arbitrary: xs rule: primerec.induct)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 199
diff changeset
  2977
  fix xs
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2978
  assume "length (xs::nat list) = Suc 0"  thus "terminate z xs"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 199
diff changeset
  2979
    by(case_tac xs, auto intro: termi_z)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 199
diff changeset
  2980
next
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 199
diff changeset
  2981
  fix xs
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2982
  assume "length (xs::nat list) = Suc 0" thus "terminate s xs"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 199
diff changeset
  2983
    by(case_tac xs, auto intro: termi_s)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 199
diff changeset
  2984
next
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 199
diff changeset
  2985
  fix n m xs
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2986
  assume "n < m" "length (xs::nat list) = m"  thus "terminate (id m n) xs"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 199
diff changeset
  2987
    by(erule_tac termi_id, simp)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 199
diff changeset
  2988
next
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 199
diff changeset
  2989
  fix f k gs m n xs
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2990
  assume ind: "\<forall>i<length gs. primerec (gs ! i) m \<and> (\<forall>x. length x = m \<longrightarrow> terminate (gs ! i) x)"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2991
  and ind2: "\<And> xs. length xs = k \<Longrightarrow> terminate f xs"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 199
diff changeset
  2992
  and h: "primerec f k"  "length gs = k" "m = n" "length (xs::nat list) = m"
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2993
  have "terminate f (map (\<lambda>g. rec_exec g xs) gs)"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2994
    using ind2[of "(map (\<lambda>g. rec_exec g xs) gs)"] h
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 199
diff changeset
  2995
    by simp
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2996
  moreover have "\<forall>g\<in>set gs. terminate g xs"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 199
diff changeset
  2997
    using ind h
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 199
diff changeset
  2998
    by(auto simp: set_conv_nth)
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2999
  ultimately show "terminate (Cn n f gs) xs"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 199
diff changeset
  3000
    using h
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 199
diff changeset
  3001
    by(rule_tac termi_cn, auto)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 199
diff changeset
  3002
next
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 199
diff changeset
  3003
  fix f n g m xs
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  3004
  assume ind1: "\<And>xs. length xs = n \<Longrightarrow> terminate f xs"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  3005
  and ind2: "\<And>xs. length xs = Suc (Suc n) \<Longrightarrow> terminate g xs"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 199
diff changeset
  3006
  and h: "primerec f n" " primerec g (Suc (Suc n))" " m = Suc n" "length (xs::nat list) = m"
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  3007
  have "\<forall>y<last xs. terminate g (butlast xs @ [y, rec_exec (Pr n f g) (butlast xs @ [y])])"
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  3008
    using h ind2 by(auto)
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  3009
  moreover have "terminate f (butlast xs)"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 199
diff changeset
  3010
    using ind1[of "butlast xs"] h
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 199
diff changeset
  3011
    by simp
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 199
diff changeset
  3012
 moreover have "length (butlast xs) = n"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 199
diff changeset
  3013
   using h by simp
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  3014
 ultimately have "terminate (Pr n f g) (butlast xs @ [last xs])"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 199
diff changeset
  3015
   by(rule_tac termi_pr, simp_all)
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  3016
 thus "terminate (Pr n f g) xs"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 199
diff changeset
  3017
   using h
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 199
diff changeset
  3018
   by(case_tac "xs = []", auto)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 199
diff changeset
  3019
qed
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3020
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3021
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3022
  The following lemma gives the correctness of @{text "rec_halt"}.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3023
  It says: if @{text "rec_halt"} calculates that the TM coded by @{text "m"}
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  3024
  will reach a standard final configuration after @{text "t"} steps of execution, then it is indeed so.
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3025
  *}
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 199
diff changeset
  3026
 
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3027
text {*F: universal machine*}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3028
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3029
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3030
  @{text "valu r"} extracts computing result out of the right number @{text "r"}.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3031
  *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3032
fun valu :: "nat \<Rightarrow> nat"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3033
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3034
  "valu r = (lg (r + 1) 2) - 1"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3035
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3036
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3037
  @{text "rec_valu"} is the recursive function implementing @{text "valu"}.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3038
*}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3039
definition rec_valu :: "recf"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3040
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3041
  "rec_valu = Cn 1 rec_minus [Cn 1 rec_lg [s, constn 2], constn 1]"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3042
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3043
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3044
  The correctness of @{text "rec_valu"}.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3045
*}
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  3046
lemma value_lemma: "rec_exec rec_valu [r] = valu r"
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  3047
  by(simp add: rec_exec.simps rec_valu_def lg_lemma)
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  3048
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  3049
lemma primerec_rec_valu_1[intro]: "primerec rec_valu (Suc 0)"
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  3050
  unfolding rec_valu_def
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  3051
  apply(rule prime_cn[of _ "Suc (Suc 0)"])
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  3052
  by auto auto
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3053
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3054
declare valu.simps[simp del]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3055
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3056
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3057
  The definition of the universal function @{text "rec_F"}.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3058
  *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3059
definition rec_F :: "recf"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3060
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3061
  "rec_F = Cn (Suc (Suc 0)) rec_valu [Cn (Suc (Suc 0)) rec_right [Cn (Suc (Suc 0))
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  3062
 rec_conf ([id (Suc (Suc 0)) 0, id (Suc (Suc 0)) (Suc 0), rec_halt])]]"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3063
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  3064
lemma get_fstn_args_nth[simp]: 
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3065
  "k < n \<Longrightarrow> (get_fstn_args m n ! k) = id m (k)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3066
apply(induct n, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3067
apply(case_tac "k = n", simp_all add: get_fstn_args.simps 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3068
                                      nth_append)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3069
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3070
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  3071
lemma get_fstn_args_is_id[simp]: 
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 199
diff changeset
  3072
  "\<lbrakk>ys \<noteq> [];
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 199
diff changeset
  3073
  k < length ys\<rbrakk> \<Longrightarrow>
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3074
  (get_fstn_args (length ys) (length ys) ! k) = 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3075
                                  id (length ys) (k)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3076
by(erule_tac get_fstn_args_nth)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3077
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  3078
lemma terminate_halt_lemma: 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  3079
  "\<lbrakk>rec_exec rec_nonstop ([m, r] @ [t]) = 0; 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  3080
     \<forall>i<t. 0 < rec_exec rec_nonstop ([m, r] @ [i])\<rbrakk> \<Longrightarrow> terminate rec_halt [m, r]"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 199
diff changeset
  3081
apply(simp add: rec_halt_def)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 199
diff changeset
  3082
apply(rule_tac termi_mn, auto)
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  3083
apply(rule_tac [!] primerec_terminate, auto)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3084
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3085
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3086
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3087
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3088
  The correctness of @{text "rec_F"}, halt case.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3089
  *}
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 199
diff changeset
  3090
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  3091
lemma F_lemma: "rec_exec rec_halt [m, r] = t \<Longrightarrow> rec_exec rec_F [m, r] = (valu (rght (conf m r t)))"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  3092
by(simp add: rec_F_def rec_exec.simps value_lemma right_lemma conf_lemma halt_lemma)
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  3093
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  3094
lemma terminate_F_lemma: "terminate rec_halt [m, r] \<Longrightarrow> terminate rec_F [m, r]"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3095
apply(simp add: rec_F_def)
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 199
diff changeset
  3096
apply(rule_tac termi_cn, auto)
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  3097
apply(rule_tac primerec_terminate, auto)
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 199
diff changeset
  3098
apply(rule_tac termi_cn, auto)
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  3099
apply(rule_tac primerec_terminate, auto)
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 199
diff changeset
  3100
apply(rule_tac termi_cn, auto)
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  3101
apply(rule_tac primerec_terminate, auto)
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 199
diff changeset
  3102
apply(rule_tac [!] termi_id, auto)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3103
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3104
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3105
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3106
  The correctness of @{text "rec_F"}, nonhalt case.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3107
  *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3108
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3109
subsection {* Coding function of TMs *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3110
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3111
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3112
  The purpose of this section is to get the coding function of Turing Machine, which is 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3113
  going to be named @{text "code"}.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3114
  *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3115
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3116
fun bl2nat :: "cell list \<Rightarrow> nat \<Rightarrow> nat"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3117
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3118
  "bl2nat [] n = 0"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3119
| "bl2nat (Bk#bl) n = bl2nat bl (Suc n)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3120
| "bl2nat (Oc#bl) n = 2^n + bl2nat bl (Suc n)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3121
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3122
fun bl2wc :: "cell list \<Rightarrow> nat"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3123
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3124
  "bl2wc xs = bl2nat xs 0"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3125
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3126
fun trpl_code :: "config \<Rightarrow> nat"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3127
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3128
  "trpl_code (st, l, r) = trpl (bl2wc l) st (bl2wc r)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3129
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3130
declare bl2nat.simps[simp del] bl2wc.simps[simp del]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3131
        trpl_code.simps[simp del]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3132
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3133
fun action_map :: "action \<Rightarrow> nat"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3134
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3135
  "action_map W0 = 0"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3136
| "action_map W1 = 1"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3137
| "action_map L = 2"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3138
| "action_map R = 3"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3139
| "action_map Nop = 4"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3140
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3141
fun action_map_iff :: "nat \<Rightarrow> action"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3142
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3143
  "action_map_iff (0::nat) = W0"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3144
| "action_map_iff (Suc 0) = W1"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3145
| "action_map_iff (Suc (Suc 0)) = L"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3146
| "action_map_iff (Suc (Suc (Suc 0))) = R"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3147
| "action_map_iff n = Nop"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3148
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3149
fun block_map :: "cell \<Rightarrow> nat"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3150
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3151
  "block_map Bk = 0"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3152
| "block_map Oc = 1"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3153
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3154
fun godel_code' :: "nat list \<Rightarrow> nat \<Rightarrow> nat"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3155
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3156
  "godel_code' [] n = 1"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3157
| "godel_code' (x#xs) n = (Pi n)^x * godel_code' xs (Suc n) "
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3158
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3159
fun godel_code :: "nat list \<Rightarrow> nat"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3160
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3161
  "godel_code xs = (let lh = length xs in 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3162
                   2^lh * (godel_code' xs (Suc 0)))"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3163
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3164
fun modify_tprog :: "instr list \<Rightarrow> nat list"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3165
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3166
  "modify_tprog [] =  []"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3167
| "modify_tprog ((ac, ns)#nl) = action_map ac # ns # modify_tprog nl"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3168
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3169
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3170
  @{text "code tp"} gives the Godel coding of TM program @{text "tp"}.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3171
  *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3172
fun code :: "instr list \<Rightarrow> nat"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3173
  where 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3174
  "code tp = (let nl = modify_tprog tp in 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3175
              godel_code nl)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3176
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3177
subsection {* Relating interperter functions to the execution of TMs *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3178
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  3179
lemma bl2wc_0[simp]: "bl2wc [] = 0" by(simp add: bl2wc.simps bl2nat.simps)
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  3180
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  3181
lemma fetch_action_map_4[simp]: "\<lbrakk>fetch tp 0 b = (nact, ns)\<rbrakk> \<Longrightarrow> action_map nact = 4"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3182
apply(simp add: fetch.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3183
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3184
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3185
lemma Pi_gr_1[simp]: "Pi n > Suc 0"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3186
proof(induct n, auto simp: Pi.simps Np.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3187
  fix n
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  3188
  let ?setx = "{y. y \<le> Suc (Pi n!) \<and> Pi n < y \<and> Prime y}"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3189
  have "finite ?setx" by auto
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3190
  moreover have "?setx \<noteq> {}"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3191
    using prime_ex[of "Pi n"]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3192
    apply(auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3193
    done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3194
  ultimately show "Suc 0 < Min ?setx"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3195
    apply(simp add: Min_gr_iff)
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  3196
    apply(auto simp: Prime.simps)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3197
    done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3198
qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3199
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3200
lemma Pi_not_0[simp]: "Pi n > 0"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3201
using Pi_gr_1[of n]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3202
by arith
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3203
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3204
declare godel_code.simps[simp del]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3205
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  3206
lemma godel_code'_nonzero[simp]: "0 < godel_code' nl n"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3207
apply(induct nl arbitrary: n)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3208
apply(auto simp: godel_code'.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3209
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3210
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3211
lemma godel_code_great: "godel_code nl > 0"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3212
apply(simp add: godel_code.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3213
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3214
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3215
lemma godel_code_eq_1: "(godel_code nl = 1) = (nl = [])"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3216
apply(auto simp: godel_code.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3217
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3218
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  3219
lemma godel_code_1_iff[elim]: 
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3220
  "\<lbrakk>i < length nl; \<not> Suc 0 < godel_code nl\<rbrakk> \<Longrightarrow> nl ! i = 0"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3221
using godel_code_great[of nl] godel_code_eq_1[of nl]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3222
apply(simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3223
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3224
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  3225
lemma prime_coprime: "\<lbrakk>Prime x; Prime y; x\<noteq>y\<rbrakk> \<Longrightarrow> coprime x y"
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  3226
proof (simp only: Prime.simps coprime_def, auto simp: dvd_def,
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  3227
      rule_tac classical, simp)
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  3228
  fix d k ka
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  3229
  assume case_ka: "\<forall>u<d * ka. \<forall>v<d * ka. u * v \<noteq> d * ka" 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  3230
    and case_k: "\<forall>u<d * k. \<forall>v<d * k. u * v \<noteq> d * k"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  3231
    and h: "(0::nat) < d" "d \<noteq> Suc 0" "Suc 0 < d * ka" 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  3232
           "ka \<noteq> k" "Suc 0 < d * k"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  3233
  from h have "k > Suc 0 \<or> ka >Suc 0"
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  3234
    by (cases ka;cases k;force+)
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  3235
  from this show "False"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  3236
  proof(erule_tac disjE)
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  3237
    assume  "(Suc 0::nat) < k"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  3238
    hence "k < d*k \<and> d < d*k"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  3239
      using h
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  3240
      by(auto)
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  3241
    thus "?thesis"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  3242
      using case_k
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  3243
      apply(erule_tac x = d in allE)
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  3244
      apply(simp)
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  3245
      apply(erule_tac x = k in allE)
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  3246
      apply(simp)
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  3247
      done
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  3248
  next
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  3249
    assume "(Suc 0::nat) < ka"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  3250
    hence "ka < d * ka \<and> d < d*ka"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  3251
      using h by auto
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  3252
    thus "?thesis"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  3253
      using case_ka
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  3254
      apply(erule_tac x = d in allE)
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  3255
      apply(simp)
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  3256
      apply(erule_tac x = ka in allE)
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  3257
      apply(simp)
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  3258
      done
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  3259
  qed
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  3260
qed
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  3261
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3262
lemma Pi_inc: "Pi (Suc i) > Pi i"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3263
proof(simp add: Pi.simps Np.simps)
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  3264
  let ?setx = "{y. y \<le> Suc (Pi i!) \<and> Pi i < y \<and> Prime y}"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3265
  have "finite ?setx" by simp
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3266
  moreover have "?setx \<noteq> {}"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3267
    using prime_ex[of "Pi i"]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3268
    apply(auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3269
    done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3270
  ultimately show "Pi i < Min ?setx"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3271
    apply(simp add: Min_gr_iff)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3272
    done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3273
qed    
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3274
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3275
lemma Pi_inc_gr: "i < j \<Longrightarrow> Pi i < Pi j"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3276
proof(induct j, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3277
  fix j
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3278
  assume ind: "i < j \<Longrightarrow> Pi i < Pi j"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3279
  and h: "i < Suc j"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3280
  from h show "Pi i < Pi (Suc j)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3281
  proof(cases "i < j")
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3282
    case True thus "?thesis"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3283
    proof -
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3284
      assume "i < j"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3285
      hence "Pi i < Pi j" by(erule_tac ind)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3286
      moreover have "Pi j < Pi (Suc j)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3287
        apply(simp add: Pi_inc)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3288
        done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3289
      ultimately show "?thesis"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3290
        by simp
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3291
    qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3292
  next
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3293
    assume "i < Suc j" "\<not> i < j"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3294
    hence "i = j"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3295
      by arith
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3296
    thus "Pi i < Pi (Suc j)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3297
      apply(simp add: Pi_inc)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3298
      done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3299
  qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3300
qed      
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3301
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3302
lemma Pi_notEq: "i \<noteq> j \<Longrightarrow> Pi i \<noteq> Pi j"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3303
apply(case_tac "i < j")
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3304
using Pi_inc_gr[of i j]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3305
apply(simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3306
using Pi_inc_gr[of j i]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3307
apply(simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3308
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3309
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  3310
lemma prime_2[intro]: "Prime (Suc (Suc 0))"
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  3311
apply(auto simp: Prime.simps)
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  3312
apply(case_tac u, simp, case_tac nat, simp, simp)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3313
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3314
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  3315
lemma Prime_Pi[intro]: "Prime (Pi n)"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3316
proof(induct n, auto simp: Pi.simps Np.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3317
  fix n
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  3318
  let ?setx = "{y. y \<le> Suc (Pi n!) \<and> Pi n < y \<and> Prime y}"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  3319
  show "Prime (Min ?setx)"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3320
  proof -
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3321
    have "finite ?setx" by simp
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3322
    moreover have "?setx \<noteq> {}" 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3323
      using prime_ex[of "Pi n"]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3324
      apply(simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3325
      done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3326
    ultimately show "?thesis"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3327
      apply(drule_tac Min_in, simp, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3328
      done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3329
  qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3330
qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3331
    
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3332
lemma Pi_coprime: "i \<noteq> j \<Longrightarrow> coprime (Pi i) (Pi j)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3333
using Prime_Pi[of i]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3334
using Prime_Pi[of j]
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  3335
apply(rule_tac prime_coprime, simp_all add: Pi_notEq)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3336
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3337
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3338
lemma Pi_power_coprime: "i \<noteq> j \<Longrightarrow> coprime ((Pi i)^m) ((Pi j)^n)"
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  3339
  unfolding coprime_power_right_iff coprime_power_left_iff using Pi_coprime by auto
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3340
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3341
lemma coprime_dvd_mult_nat2: "\<lbrakk>coprime (k::nat) n; k dvd n * m\<rbrakk> \<Longrightarrow> k dvd m"
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  3342
  unfolding coprime_dvd_mult_right_iff.
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3343
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3344
declare godel_code'.simps[simp del]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3345
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3346
lemma godel_code'_butlast_last_id' :
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3347
  "godel_code' (ys @ [y]) (Suc j) = godel_code' ys (Suc j) * 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3348
                                Pi (Suc (length ys + j)) ^ y"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3349
proof(induct ys arbitrary: j, simp_all add: godel_code'.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3350
qed  
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3351
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3352
lemma godel_code'_butlast_last_id: 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3353
"xs \<noteq> [] \<Longrightarrow> godel_code' xs (Suc j) = 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3354
  godel_code' (butlast xs) (Suc j) * Pi (length xs + j)^(last xs)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3355
apply(subgoal_tac "\<exists> ys y. xs = ys @ [y]")
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3356
apply(erule_tac exE, erule_tac exE, simp add: 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3357
                            godel_code'_butlast_last_id')
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3358
apply(rule_tac x = "butlast xs" in exI)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3359
apply(rule_tac x = "last xs" in exI, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3360
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3361
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3362
lemma godel_code'_not0: "godel_code' xs n \<noteq> 0"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3363
apply(induct xs, auto simp: godel_code'.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3364
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3365
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3366
lemma godel_code_append_cons: 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3367
  "length xs = i \<Longrightarrow> godel_code' (xs@y#ys) (Suc 0)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3368
    = godel_code' xs (Suc 0) * Pi (Suc i)^y * godel_code' ys (i + 2)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3369
proof(induct "length xs" arbitrary: i y ys xs, simp add: godel_code'.simps,simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3370
  fix x xs i y ys
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3371
  assume ind: 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3372
    "\<And>xs i y ys. \<lbrakk>x = i; length xs = i\<rbrakk> \<Longrightarrow> 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3373
       godel_code' (xs @ y # ys) (Suc 0) 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3374
     = godel_code' xs (Suc 0) * Pi (Suc i) ^ y * 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3375
                             godel_code' ys (Suc (Suc i))"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3376
  and h: "Suc x = i" 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3377
         "length (xs::nat list) = i"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3378
  have 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3379
    "godel_code' (butlast xs @ last xs # ((y::nat)#ys)) (Suc 0) = 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3380
        godel_code' (butlast xs) (Suc 0) * Pi (Suc (i - 1))^(last xs) 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3381
              * godel_code' (y#ys) (Suc (Suc (i - 1)))"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3382
    apply(rule_tac ind)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3383
    using h
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3384
    by(auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3385
  moreover have 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3386
    "godel_code' xs (Suc 0)= godel_code' (butlast xs) (Suc 0) *
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3387
                                                  Pi (i)^(last xs)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3388
    using godel_code'_butlast_last_id[of xs] h
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3389
    apply(case_tac "xs = []", simp, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3390
    done 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3391
  moreover have "butlast xs @ last xs # y # ys = xs @ y # ys"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3392
    using h
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3393
    apply(case_tac xs, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3394
    done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3395
  ultimately show 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3396
    "godel_code' (xs @ y # ys) (Suc 0) =
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3397
               godel_code' xs (Suc 0) * Pi (Suc i) ^ y *
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3398
                    godel_code' ys (Suc (Suc i))"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3399
    using h
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3400
    apply(simp add: godel_code'_not0 Pi_not_0)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3401
    apply(simp add: godel_code'.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3402
    done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3403
qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3404
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3405
lemma Pi_coprime_pre: 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3406
  "length ps \<le> i \<Longrightarrow> coprime (Pi (Suc i)) (godel_code' ps (Suc 0))"
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  3407
proof(induct "length ps" arbitrary: ps)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3408
  fix x ps
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3409
  assume ind: 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3410
    "\<And>ps. \<lbrakk>x = length ps; length ps \<le> i\<rbrakk> \<Longrightarrow>
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3411
                  coprime (Pi (Suc i)) (godel_code' ps (Suc 0))"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3412
  and h: "Suc x = length ps"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3413
          "length (ps::nat list) \<le> i"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3414
  have g: "coprime (Pi (Suc i)) (godel_code' (butlast ps) (Suc 0))"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3415
    apply(rule_tac ind)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3416
    using h by auto
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3417
  have k: "godel_code' ps (Suc 0) = 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3418
         godel_code' (butlast ps) (Suc 0) * Pi (length ps)^(last ps)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3419
    using godel_code'_butlast_last_id[of ps 0] h 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3420
    by(case_tac ps, simp, simp)
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  3421
  from g have "coprime (Pi (Suc i)) (Pi (length ps) ^ last ps)"
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  3422
    unfolding coprime_power_right_iff using Pi_coprime h(2) by auto
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  3423
   with g have 
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3424
    "coprime (Pi (Suc i)) (godel_code' (butlast ps) (Suc 0) *
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3425
                                        Pi (length ps)^(last ps)) "
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  3426
    unfolding coprime_mult_right_iff coprime_power_right_iff by auto
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  3427
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3428
  from this and k show "coprime (Pi (Suc i)) (godel_code' ps (Suc 0))"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3429
    by simp
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  3430
qed (auto simp add: godel_code'.simps)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3431
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3432
lemma Pi_coprime_suf: "i < j \<Longrightarrow> coprime (Pi i) (godel_code' ps j)"
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  3433
proof(induct "length ps" arbitrary: ps)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3434
  fix x ps
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3435
  assume ind: 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3436
    "\<And>ps. \<lbrakk>x = length ps; i < j\<rbrakk> \<Longrightarrow> 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3437
                    coprime (Pi i) (godel_code' ps j)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3438
  and h: "Suc x = length (ps::nat list)" "i < j"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3439
  have g: "coprime (Pi i) (godel_code' (butlast ps) j)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3440
    apply(rule ind) using h by auto
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3441
  have k: "(godel_code' ps j) = godel_code' (butlast ps) j *
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3442
                                 Pi (length ps + j - 1)^last ps"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3443
    using h godel_code'_butlast_last_id[of ps "j - 1"]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3444
    apply(case_tac "ps = []", simp, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3445
    done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3446
  from g have
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3447
    "coprime (Pi i) (godel_code' (butlast ps) j * 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3448
                          Pi (length ps + j - 1)^last ps)"
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  3449
    using Pi_power_coprime[of i "length ps + j - 1" 1 "last ps"] h
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  3450
    by(auto)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3451
  from k and this show "coprime (Pi i) (godel_code' ps j)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3452
    by auto
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  3453
qed (simp add: godel_code'.simps)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3454
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3455
lemma godel_finite: 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3456
  "finite {u. Pi (Suc i) ^ u dvd godel_code' nl (Suc 0)}"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3457
proof(rule_tac n = "godel_code' nl (Suc 0)" in 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3458
                          bounded_nat_set_is_finite, auto, 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3459
      case_tac "ia < godel_code' nl (Suc 0)", auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3460
  fix ia 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3461
  assume g1: "Pi (Suc i) ^ ia dvd godel_code' nl (Suc 0)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3462
    and g2: "\<not> ia < godel_code' nl (Suc 0)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3463
  from g1 have "Pi (Suc i)^ia \<le> godel_code' nl (Suc 0)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3464
    apply(erule_tac dvd_imp_le)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3465
    using  godel_code'_not0[of nl "Suc 0"] by simp
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3466
  moreover have "ia < Pi (Suc i)^ia"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3467
    apply(rule x_less_exp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3468
    using Pi_gr_1 by auto
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3469
  ultimately show "False"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3470
    using g2
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3471
    by(auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3472
qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3473
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3474
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3475
lemma godel_code_in: 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3476
  "i < length nl \<Longrightarrow>  nl ! i  \<in> {u. Pi (Suc i) ^ u dvd
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3477
                                     godel_code' nl (Suc 0)}"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3478
proof -
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3479
 assume h: "i<length nl"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3480
  hence "godel_code' (take i nl@(nl!i)#drop (Suc i) nl) (Suc 0)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3481
           = godel_code' (take i nl) (Suc 0) *  Pi (Suc i)^(nl!i) *
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3482
                               godel_code' (drop (Suc i) nl) (i + 2)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3483
    by(rule_tac godel_code_append_cons, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3484
  moreover from h have "take i nl @ (nl ! i) # drop (Suc i) nl = nl"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3485
    using upd_conv_take_nth_drop[of i nl "nl ! i"]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3486
    apply(simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3487
    done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3488
  ultimately  show 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3489
    "nl ! i \<in> {u. Pi (Suc i) ^ u dvd godel_code' nl (Suc 0)}"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3490
    by(simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3491
qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3492
     
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3493
lemma godel_code'_get_nth:
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3494
  "i < length nl \<Longrightarrow> Max {u. Pi (Suc i) ^ u dvd 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3495
                          godel_code' nl (Suc 0)} = nl ! i"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3496
proof(rule_tac Max_eqI)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3497
  let ?gc = "godel_code' nl (Suc 0)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3498
  assume h: "i < length nl" thus "finite {u. Pi (Suc i) ^ u dvd ?gc}"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3499
    by (simp add: godel_finite)  
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3500
next
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3501
  fix y
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3502
  let ?suf ="godel_code' (drop (Suc i) nl) (i + 2)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3503
  let ?pref = "godel_code' (take i nl) (Suc 0)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3504
  assume h: "i < length nl" 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3505
            "y \<in> {u. Pi (Suc i) ^ u dvd godel_code' nl (Suc 0)}"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3506
  moreover hence
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3507
    "godel_code' (take i nl@(nl!i)#drop (Suc i) nl) (Suc 0)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3508
    = ?pref * Pi (Suc i)^(nl!i) * ?suf"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3509
    by(rule_tac godel_code_append_cons, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3510
  moreover from h have "take i nl @ (nl!i) # drop (Suc i) nl = nl"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3511
    using upd_conv_take_nth_drop[of i nl "nl!i"]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3512
    by simp
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3513
  ultimately show "y\<le>nl!i"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3514
  proof(simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3515
    let ?suf' = "godel_code' (drop (Suc i) nl) (Suc (Suc i))"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3516
    assume mult_dvd: 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3517
      "Pi (Suc i) ^ y dvd ?pref *  Pi (Suc i) ^ nl ! i * ?suf'"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3518
    hence "Pi (Suc i) ^ y dvd ?pref * Pi (Suc i) ^ nl ! i"
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  3519
    proof -
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  3520
      have "coprime (Pi (Suc i)^y) ?suf'" by (simp add: Pi_coprime_suf)
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  3521
      thus ?thesis using coprime_dvd_mult_left_iff mult_dvd by blast
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3522
    qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3523
    hence "Pi (Suc i) ^ y dvd Pi (Suc i) ^ nl ! i"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3524
    proof(rule_tac coprime_dvd_mult_nat2)
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  3525
      have "coprime (Pi (Suc i)^y) (?pref^Suc 0)" using Pi_coprime_pre by simp
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  3526
      thus "coprime (Pi (Suc i) ^ y) ?pref" by simp
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3527
    qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3528
    hence "Pi (Suc i) ^ y \<le>  Pi (Suc i) ^ nl ! i "
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3529
      apply(rule_tac dvd_imp_le, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3530
      done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3531
    thus "y \<le> nl ! i"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3532
      apply(rule_tac power_le_imp_le_exp, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3533
      done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3534
  qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3535
next
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3536
  assume h: "i<length nl"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3537
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3538
  thus "nl ! i \<in> {u. Pi (Suc i) ^ u dvd godel_code' nl (Suc 0)}"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3539
    by(rule_tac godel_code_in, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3540
qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3541
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  3542
lemma godel_code'_set[simp]: 
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3543
  "{u. Pi (Suc i) ^ u dvd (Suc (Suc 0)) ^ length nl * 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3544
                                     godel_code' nl (Suc 0)} = 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3545
    {u. Pi (Suc i) ^ u dvd  godel_code' nl (Suc 0)}"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3546
apply(rule_tac Collect_cong, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3547
apply(rule_tac n = " (Suc (Suc 0)) ^ length nl" in 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3548
                                 coprime_dvd_mult_nat2)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3549
proof -
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  3550
  have "Pi 0 = (2::nat)" by(simp add: Pi.simps)
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  3551
  show "coprime (Pi (Suc i) ^ u) ((Suc (Suc 0)) ^ length nl)" for u
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  3552
    using Pi_coprime Pi.simps(1) by force
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3553
qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3554
  
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3555
lemma godel_code_get_nth: 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3556
  "i < length nl \<Longrightarrow> 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3557
           Max {u. Pi (Suc i) ^ u dvd godel_code nl} = nl ! i"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3558
by(simp add: godel_code.simps godel_code'_get_nth)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3559
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3560
lemma mod_dvd_simp: "(x mod y = (0::nat)) = (y dvd x)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3561
by(simp add: dvd_def, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3562
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3563
lemma dvd_power_le: "\<lbrakk>a > Suc 0; a ^ y dvd a ^ l\<rbrakk> \<Longrightarrow> y \<le> l"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3564
apply(case_tac "y \<le> l", simp, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3565
apply(subgoal_tac "\<exists> d. y = l + d", auto simp: power_add)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3566
apply(rule_tac x = "y - l" in exI, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3567
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3568
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3569
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  3570
lemma Pi_nonzeroE[elim]: "Pi n = 0 \<Longrightarrow> RR"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3571
  using Pi_not_0[of n] by simp
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3572
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  3573
lemma Pi_not_oneE[elim]: "Pi n = Suc 0 \<Longrightarrow> RR"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3574
  using Pi_gr_1[of n] by simp
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3575
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3576
lemma finite_power_dvd:
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3577
  "\<lbrakk>(a::nat) > Suc 0; y \<noteq> 0\<rbrakk> \<Longrightarrow> finite {u. a^u dvd y}"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3578
apply(auto simp: dvd_def)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3579
apply(rule_tac n = y in bounded_nat_set_is_finite, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3580
apply(case_tac k, simp,simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3581
apply(rule_tac trans_less_add1)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3582
apply(erule_tac x_less_exp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3583
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3584
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3585
lemma conf_decode1: "\<lbrakk>m \<noteq> n; m \<noteq> k; k \<noteq> n\<rbrakk> \<Longrightarrow> 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3586
  Max {u. Pi m ^ u dvd Pi m ^ l * Pi n ^ st * Pi k ^ r} = l"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3587
proof -
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3588
  let ?setx = "{u. Pi m ^ u dvd Pi m ^ l * Pi n ^ st * Pi k ^ r}"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3589
  assume g: "m \<noteq> n" "m \<noteq> k" "k \<noteq> n"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3590
  show "Max ?setx = l"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3591
  proof(rule_tac Max_eqI)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3592
    show "finite ?setx"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3593
      apply(rule_tac finite_power_dvd, auto simp: Pi_gr_1)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3594
      done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3595
  next
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3596
    fix y
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3597
    assume h: "y \<in> ?setx"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3598
    have "Pi m ^ y dvd Pi m ^ l"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3599
    proof -
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3600
      have "Pi m ^ y dvd Pi m ^ l * Pi n ^ st"
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  3601
        using h g Pi_power_coprime
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  3602
        by (simp add: coprime_dvd_mult_left_iff)
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  3603
      thus "Pi m^y dvd Pi m^l" using g Pi_power_coprime coprime_dvd_mult_left_iff by blast
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3604
    qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3605
    thus "y \<le> (l::nat)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3606
      apply(rule_tac a = "Pi m" in power_le_imp_le_exp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3607
      apply(simp_all add: Pi_gr_1)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3608
      apply(rule_tac dvd_power_le, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3609
      done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3610
  next
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3611
    show "l \<in> ?setx" by simp
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3612
  qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3613
qed  
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3614
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3615
lemma conf_decode2: 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3616
  "\<lbrakk>m \<noteq> n; m \<noteq> k; n \<noteq> k; 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3617
  \<not> Suc 0 < Pi m ^ l * Pi n ^ st * Pi k ^ r\<rbrakk> \<Longrightarrow> l = 0"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3618
apply(case_tac "Pi m ^ l * Pi n ^ st * Pi k ^ r", auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3619
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3620
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  3621
lemma left_trpl_fst[simp]: "left (trpl l st r) = l"
250
745547bdc1c7 added lemmas about a pairing function
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 248
diff changeset
  3622
apply(simp add: left.simps trpl.simps lo.simps loR.simps mod_dvd_simp)
745547bdc1c7 added lemmas about a pairing function
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 248
diff changeset
  3623
apply(auto simp: conf_decode1)
745547bdc1c7 added lemmas about a pairing function
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 248
diff changeset
  3624
apply(case_tac "Pi 0 ^ l * Pi (Suc 0) ^ st * Pi (Suc (Suc 0)) ^ r")
745547bdc1c7 added lemmas about a pairing function
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 248
diff changeset
  3625
apply(auto)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3626
apply(erule_tac x = l in allE, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3627
done   
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3628
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  3629
lemma stat_trpl_snd[simp]: "stat (trpl l st r) = st"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3630
apply(simp add: stat.simps trpl.simps lo.simps 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3631
                loR.simps mod_dvd_simp, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3632
apply(subgoal_tac "Pi 0 ^ l * Pi (Suc 0) ^ st * Pi (Suc (Suc 0)) ^ r
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3633
               = Pi (Suc 0)^st * Pi 0 ^ l *  Pi (Suc (Suc 0)) ^ r")
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3634
apply(simp (no_asm_simp) add: conf_decode1, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3635
apply(case_tac "Pi 0 ^ l * Pi (Suc 0) ^ st * 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3636
                                  Pi (Suc (Suc 0)) ^ r", auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3637
apply(erule_tac x = st in allE, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3638
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3639
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  3640
lemma rght_trpl_trd[simp]: "rght (trpl l st r) = r"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3641
apply(simp add: rght.simps trpl.simps lo.simps 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3642
                loR.simps mod_dvd_simp, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3643
apply(subgoal_tac "Pi 0 ^ l * Pi (Suc 0) ^ st * Pi (Suc (Suc 0)) ^ r
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3644
               = Pi (Suc (Suc 0))^r * Pi 0 ^ l *  Pi (Suc 0) ^ st")
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3645
apply(simp (no_asm_simp) add: conf_decode1, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3646
apply(case_tac "Pi 0 ^ l * Pi (Suc 0) ^ st * Pi (Suc (Suc 0)) ^ r",
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3647
       auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3648
apply(erule_tac x = r in allE, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3649
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3650
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3651
lemma max_lor:
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3652
  "i < length nl \<Longrightarrow> Max {u. loR [godel_code nl, Pi (Suc i), u]} 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3653
                   = nl ! i"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3654
apply(simp add: loR.simps godel_code_get_nth mod_dvd_simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3655
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3656
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3657
lemma godel_decode: 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3658
  "i < length nl \<Longrightarrow> Entry (godel_code nl) i = nl ! i"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3659
apply(auto simp: Entry.simps lo.simps max_lor)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3660
apply(erule_tac x = "nl!i" in allE)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3661
using max_lor[of i nl] godel_finite[of i nl]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3662
apply(simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3663
apply(drule_tac Max_in, auto simp: loR.simps 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3664
                   godel_code.simps mod_dvd_simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3665
using godel_code_in[of i nl]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3666
apply(simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3667
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3668
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3669
lemma Four_Suc: "4 = Suc (Suc (Suc (Suc 0)))"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3670
by auto
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3671
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3672
declare numeral_2_eq_2[simp del]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3673
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3674
lemma modify_tprog_fetch_even: 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3675
  "\<lbrakk>st \<le> length tp div 2; st > 0\<rbrakk> \<Longrightarrow>
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3676
  modify_tprog tp ! (4 * (st - Suc 0) ) = 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3677
  action_map (fst (tp ! (2 * (st - Suc 0))))"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3678
proof(induct st arbitrary: tp, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3679
  fix tp st
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3680
  assume ind: 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3681
    "\<And>tp. \<lbrakk>st \<le> length tp div 2; 0 < st\<rbrakk> \<Longrightarrow> 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3682
     modify_tprog tp ! (4 * (st - Suc 0)) =
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3683
               action_map (fst ((tp::instr list) ! (2 * (st - Suc 0))))"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3684
  and h: "Suc st \<le> length (tp::instr list) div 2" "0 < Suc st"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3685
  thus "modify_tprog tp ! (4 * (Suc st - Suc 0)) = 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3686
          action_map (fst (tp ! (2 * (Suc st - Suc 0))))"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3687
  proof(cases "st = 0")
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3688
    case True thus "?thesis"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3689
      using h
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3690
      apply(auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3691
      apply(cases tp, simp, case_tac a, simp add: modify_tprog.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3692
      done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3693
  next
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3694
    case False
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3695
    assume g: "st \<noteq> 0"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3696
    hence "\<exists> aa ab ba bb tp'. tp = (aa, ab) # (ba, bb) # tp'"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3697
      using h
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3698
      apply(case_tac tp, simp, case_tac list, simp, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3699
      done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3700
    from this obtain aa ab ba bb tp' where g1: 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3701
      "tp = (aa, ab) # (ba, bb) # tp'" by blast
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3702
    hence g2: 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3703
      "modify_tprog tp' ! (4 * (st - Suc 0)) = 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3704
      action_map (fst ((tp'::instr list) ! (2 * (st - Suc 0))))"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3705
      apply(rule_tac ind)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3706
      using h g by auto
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3707
    thus "?thesis"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3708
      using g1 g
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3709
      apply(case_tac st, simp, simp add: Four_Suc)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3710
      done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3711
  qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3712
qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3713
      
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3714
lemma modify_tprog_fetch_odd: 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3715
  "\<lbrakk>st \<le> length tp div 2; st > 0\<rbrakk> \<Longrightarrow> 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3716
       modify_tprog tp ! (Suc (Suc (4 * (st - Suc 0)))) = 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3717
       action_map (fst (tp ! (Suc (2 * (st - Suc 0)))))"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3718
proof(induct st arbitrary: tp, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3719
  fix tp st
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3720
  assume ind: 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3721
    "\<And>tp. \<lbrakk>st \<le> length tp div 2; 0 < st\<rbrakk> \<Longrightarrow>  
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3722
       modify_tprog tp ! Suc (Suc (4 * (st - Suc 0))) = 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3723
          action_map (fst (tp ! Suc (2 * (st - Suc 0))))"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3724
  and h: "Suc st \<le> length (tp::instr list) div 2" "0 < Suc st"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3725
  thus "modify_tprog tp ! Suc (Suc (4 * (Suc st - Suc 0))) 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3726
     = action_map (fst (tp ! Suc (2 * (Suc st - Suc 0))))"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3727
  proof(cases "st = 0")
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3728
    case True thus "?thesis"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3729
      using h
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3730
      apply(auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3731
      apply(cases tp, simp, case_tac a, simp add: modify_tprog.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3732
      apply(case_tac list, simp, case_tac ab,
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3733
             simp add: modify_tprog.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3734
      done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3735
  next
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3736
    case False
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3737
    assume g: "st \<noteq> 0"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3738
    hence "\<exists> aa ab ba bb tp'. tp = (aa, ab) # (ba, bb) # tp'"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3739
      using h
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3740
      apply(case_tac tp, simp, case_tac list, simp, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3741
      done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3742
    from this obtain aa ab ba bb tp' where g1: 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3743
      "tp = (aa, ab) # (ba, bb) # tp'" by blast
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3744
    hence g2: "modify_tprog tp' ! Suc (Suc (4 * (st  - Suc 0))) = 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3745
          action_map (fst (tp' ! Suc (2 * (st - Suc 0))))"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3746
      apply(rule_tac ind)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3747
      using h g by auto
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3748
    thus "?thesis"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3749
      using g1 g
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3750
      apply(case_tac st, simp, simp add: Four_Suc)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3751
      done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3752
  qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3753
qed    
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3754
         
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3755
lemma modify_tprog_fetch_action:
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3756
  "\<lbrakk>st \<le> length tp div 2; st > 0; b = 1 \<or> b = 0\<rbrakk> \<Longrightarrow> 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3757
      modify_tprog tp ! (4 * (st - Suc 0) + 2* b) =
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3758
      action_map (fst (tp ! ((2 * (st - Suc 0)) + b)))"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3759
apply(erule_tac disjE, auto elim: modify_tprog_fetch_odd
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3760
                                   modify_tprog_fetch_even)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3761
done 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3762
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3763
lemma length_modify: "length (modify_tprog tp) = 2 * length tp"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3764
apply(induct tp, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3765
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3766
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3767
declare fetch.simps[simp del]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3768
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3769
lemma fetch_action_eq: 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3770
  "\<lbrakk>block_map b = scan r; fetch tp st b = (nact, ns);
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3771
   st \<le> length tp div 2\<rbrakk> \<Longrightarrow> actn (code tp) st r = action_map nact"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3772
proof(simp add: actn.simps, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3773
  let ?i = "4 * (st - Suc 0) + 2 * (r mod 2)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3774
  assume h: "block_map b = r mod 2" "fetch tp st b = (nact, ns)" 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3775
            "st \<le> length tp div 2" "0 < st"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3776
  have "?i < length (modify_tprog tp)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3777
  proof -
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3778
    have "length (modify_tprog tp) = 2 * length tp"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3779
      by(simp add: length_modify)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3780
    thus "?thesis"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3781
      using h
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3782
      by(auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3783
  qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3784
  hence 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3785
    "Entry (godel_code (modify_tprog tp))?i = 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3786
                                   (modify_tprog tp) ! ?i"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3787
    by(erule_tac godel_decode)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3788
   moreover have 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3789
    "modify_tprog tp ! ?i = 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3790
            action_map (fst (tp ! (2 * (st - Suc 0) + r mod 2)))"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3791
    apply(rule_tac  modify_tprog_fetch_action)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3792
    using h
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3793
    by(auto)    
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3794
  moreover have "(fst (tp ! (2 * (st - Suc 0) + r mod 2))) = nact"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3795
    using h
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3796
    apply(case_tac st, simp_all add: fetch.simps nth_of.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3797
    apply(case_tac b, auto simp: block_map.simps nth_of.simps fetch.simps 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3798
                    split: if_splits)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3799
    apply(case_tac "r mod 2", simp, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3800
    done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3801
  ultimately show 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3802
    "Entry (godel_code (modify_tprog tp))
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3803
                      (4 * (st - Suc 0) + 2 * (r mod 2))
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3804
           = action_map nact" 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3805
    by simp
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3806
qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3807
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  3808
lemma fetch_zero_zero[simp]: "fetch tp 0 b = (nact, ns) \<Longrightarrow> ns = 0"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3809
by(simp add: fetch.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3810
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3811
lemma Five_Suc: "5 = Suc 4" by simp
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3812
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3813
lemma modify_tprog_fetch_state:
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3814
  "\<lbrakk>st \<le> length tp div 2; st > 0; b = 1 \<or> b = 0\<rbrakk> \<Longrightarrow> 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3815
     modify_tprog tp ! Suc (4 * (st - Suc 0) + 2 * b) =
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3816
  (snd (tp ! (2 * (st - Suc 0) + b)))"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3817
proof(induct st arbitrary: tp, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3818
  fix st tp
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3819
  assume ind: 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3820
    "\<And>tp. \<lbrakk>st \<le> length tp div 2; 0 < st; b = 1 \<or> b = 0\<rbrakk> \<Longrightarrow> 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3821
    modify_tprog tp ! Suc (4 * (st - Suc 0) + 2 * b) =
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3822
                             snd (tp ! (2 * (st - Suc 0) + b))"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3823
  and h:
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3824
    "Suc st \<le> length (tp::instr list) div 2" 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3825
    "0 < Suc st" 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3826
    "b = 1 \<or> b = 0"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3827
  show "modify_tprog tp ! Suc (4 * (Suc st - Suc 0) + 2 * b) =
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3828
                             snd (tp ! (2 * (Suc st - Suc 0) + b))"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3829
  proof(cases "st = 0")
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3830
    case True
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3831
    thus "?thesis"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3832
      using h
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3833
      apply(cases tp, simp, case_tac a, simp add: modify_tprog.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3834
      apply(case_tac list, simp, case_tac ab, 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3835
                         simp add: modify_tprog.simps, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3836
      done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3837
  next
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3838
    case False
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3839
    assume g: "st \<noteq> 0"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3840
    hence "\<exists> aa ab ba bb tp'. tp = (aa, ab) # (ba, bb) # tp'"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3841
      using h
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3842
      apply(case_tac tp, simp, case_tac list, simp, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3843
      done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3844
    from this obtain aa ab ba bb tp' where g1:
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3845
      "tp = (aa, ab) # (ba, bb) # tp'" by blast
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3846
    hence g2: 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3847
      "modify_tprog tp' ! Suc (4 * (st - Suc 0) + 2 * b) =
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3848
                              snd (tp' ! (2 * (st - Suc 0) + b))"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3849
      apply(rule_tac ind)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3850
      using h g by auto
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3851
    thus "?thesis"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3852
      using g1 g
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3853
      apply(case_tac st, simp, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3854
      done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3855
  qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3856
qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3857
  
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3858
lemma fetch_state_eq:
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3859
  "\<lbrakk>block_map b = scan r; 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3860
  fetch tp st b = (nact, ns);
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3861
  st \<le> length tp div 2\<rbrakk> \<Longrightarrow> newstat (code tp) st r = ns"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3862
proof(simp add: newstat.simps, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3863
  let ?i = "Suc (4 * (st - Suc 0) + 2 * (r mod 2))"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3864
  assume h: "block_map b = r mod 2" "fetch tp st b =
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3865
             (nact, ns)" "st \<le> length tp div 2" "0 < st"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3866
  have "?i < length (modify_tprog tp)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3867
  proof -
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3868
    have "length (modify_tprog tp) = 2 * length tp"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3869
      apply(simp add: length_modify)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3870
      done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3871
    thus "?thesis"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3872
      using h
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3873
      by(auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3874
  qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3875
  hence "Entry (godel_code (modify_tprog tp)) (?i) = 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3876
                                  (modify_tprog tp) ! ?i"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3877
    by(erule_tac godel_decode)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3878
   moreover have 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3879
    "modify_tprog tp ! ?i =  
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3880
               (snd (tp ! (2 * (st - Suc 0) + r mod 2)))"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3881
    apply(rule_tac  modify_tprog_fetch_state)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3882
    using h
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3883
    by(auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3884
  moreover have "(snd (tp ! (2 * (st - Suc 0) + r mod 2))) = ns"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3885
    using h
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3886
    apply(case_tac st, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3887
    apply(case_tac b, auto simp: block_map.simps nth_of.simps
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3888
                                 fetch.simps
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3889
                                 split: if_splits)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3890
    apply(subgoal_tac "(2 * (Suc nat - r mod 2) + r mod 2) = 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3891
                       (2 * nat + r mod 2)", simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3892
    by (metis diff_Suc_Suc minus_nat.diff_0)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3893
  ultimately show "Entry (godel_code (modify_tprog tp)) (?i)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3894
           = ns" 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3895
    by simp
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3896
qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3897
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3898
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  3899
lemma tpl_eqI[intro!]: 
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3900
  "\<lbrakk>a = a'; b = b'; c = c'\<rbrakk> \<Longrightarrow> trpl a b c = trpl a' b' c'"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3901
by simp
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3902
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  3903
lemma bl2wc_Bk[simp]: "bl2wc [Bk] = 0"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3904
by(simp add: bl2wc.simps bl2nat.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3905
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3906
lemma bl2nat_double: "bl2nat xs (Suc n) = 2 * bl2nat xs n"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3907
proof(induct xs arbitrary: n)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3908
  case Nil thus "?case"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3909
    by(simp add: bl2nat.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3910
next
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3911
  case (Cons x xs) thus "?case"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3912
  proof -
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3913
    assume ind: "\<And>n. bl2nat xs (Suc n) = 2 * bl2nat xs n "
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3914
    show "bl2nat (x # xs) (Suc n) = 2 * bl2nat (x # xs) n"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3915
    proof(cases x)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3916
      case Bk thus "?thesis"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3917
        apply(simp add: bl2nat.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3918
        using ind[of "Suc n"] by simp
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3919
    next
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3920
      case Oc thus "?thesis"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3921
        apply(simp add: bl2nat.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3922
        using ind[of "Suc n"] by simp
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3923
    qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3924
  qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3925
qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3926
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3927
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  3928
lemma bl2wc_simps[simp]:
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3929
  "bl2wc (Oc # tl c) = Suc (bl2wc c) - bl2wc c mod 2 "
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  3930
  "bl2wc (Bk # c) = 2*bl2wc (c)"
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  3931
  "2 * bl2wc (tl c) = bl2wc c - bl2wc c mod 2 "
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  3932
  "bl2wc [Oc] = Suc 0"
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  3933
  "c \<noteq> [] \<Longrightarrow> bl2wc (tl c) = bl2wc c div 2"
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  3934
  "c \<noteq> [] \<Longrightarrow> bl2wc [hd c] = bl2wc c mod 2"
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  3935
  "c \<noteq> [] \<Longrightarrow> bl2wc (hd c # d) = 2 * bl2wc d + bl2wc c mod 2"
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  3936
  "2 * (bl2wc c div 2) = bl2wc c - bl2wc c mod 2"
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  3937
  "bl2wc (Oc # list) mod 2 = Suc 0" 
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  3938
  by(cases c;cases "hd c";force simp: bl2wc.simps bl2nat.simps bl2nat_double)+
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3939
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3940
declare code.simps[simp del]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3941
declare nth_of.simps[simp del]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3942
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3943
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3944
  The lemma relates the one step execution of TMs with the interpreter function @{text "rec_newconf"}.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3945
  *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3946
lemma rec_t_eq_step: 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3947
  "(\<lambda> (s, l, r). s \<le> length tp div 2) c \<Longrightarrow>
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3948
  trpl_code (step0 c tp) = 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  3949
  rec_exec rec_newconf [code tp, trpl_code c]"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3950
  apply(cases c, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3951
proof(case_tac "fetch tp a (read ca)",
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3952
    simp add: newconf.simps trpl_code.simps step.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3953
  fix a b ca aa ba
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3954
  assume h: "(a::nat) \<le> length tp div 2" 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3955
    "fetch tp a (read ca) = (aa, ba)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3956
  moreover hence "actn (code tp) a (bl2wc ca) = action_map aa"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3957
    apply(rule_tac b = "read ca" 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3958
          in fetch_action_eq, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3959
    apply(case_tac "hd ca", auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3960
    apply(case_tac [!] ca, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3961
    done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3962
  moreover from h have "(newstat (code tp) a (bl2wc ca)) = ba"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3963
    apply(rule_tac b = "read ca" 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3964
          in fetch_state_eq, auto split: list.splits)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3965
    apply(case_tac "hd ca", auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3966
    apply(case_tac [!] ca, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3967
    done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3968
  ultimately show 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3969
    "trpl_code (ba, update aa (b, ca)) =
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3970
          trpl (newleft (bl2wc b) (bl2wc ca) (actn (code tp) a (bl2wc ca))) 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3971
    (newstat (code tp) a (bl2wc ca)) (newrght (bl2wc b) (bl2wc ca) (actn (code tp) a (bl2wc ca)))"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3972
    apply(case_tac aa)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3973
    apply(auto simp: trpl_code.simps 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3974
         newleft.simps newrght.simps split: action.splits)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3975
    done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3976
qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3977
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  3978
lemma bl2nat_simps[simp]: "bl2nat (Oc # Oc\<up>x) 0 = (2 * 2 ^ x - Suc 0)"
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  3979
  "bl2nat (Bk\<up>x) n = 0"
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  3980
 by(induct x;force simp: bl2nat.simps bl2nat_double exp_ind)+
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  3981
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  3982
lemma bl2nat_exp_zero[simp]: "bl2nat (Oc\<up>y) 0 = 2^y - Suc 0"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3983
apply(induct y, auto simp: bl2nat.simps bl2nat_double)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3984
apply(case_tac "(2::nat)^y", auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3985
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3986
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3987
lemma bl2nat_cons_bk: "bl2nat (ks @ [Bk]) 0 = bl2nat ks 0"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3988
apply(induct ks, auto simp: bl2nat.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3989
apply(case_tac a, auto simp: bl2nat.simps bl2nat_double)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3990
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3991
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3992
lemma bl2nat_cons_oc:
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3993
  "bl2nat (ks @ [Oc]) 0 =  bl2nat ks 0 + 2 ^ length ks"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3994
apply(induct ks, auto simp: bl2nat.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3995
apply(case_tac a, auto simp: bl2nat.simps bl2nat_double)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3996
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3997
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3998
lemma bl2nat_append: 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  3999
  "bl2nat (xs @ ys) 0 = bl2nat xs 0 + bl2nat ys (length xs) "
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4000
proof(induct "length xs" arbitrary: xs ys, simp add: bl2nat.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4001
  fix x xs ys
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4002
  assume ind: 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4003
    "\<And>xs ys. x = length xs \<Longrightarrow> 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4004
             bl2nat (xs @ ys) 0 = bl2nat xs 0 + bl2nat ys (length xs)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4005
  and h: "Suc x = length (xs::cell list)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4006
  have "\<exists> ks k. xs = ks @ [k]" 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4007
    apply(rule_tac x = "butlast xs" in exI,
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4008
      rule_tac x = "last xs" in exI)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4009
    using h
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4010
    apply(case_tac xs, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4011
    done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4012
  from this obtain ks k where "xs = ks @ [k]" by blast
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4013
  moreover hence 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4014
    "bl2nat (ks @ (k # ys)) 0 = bl2nat ks 0 +
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4015
                               bl2nat (k # ys) (length ks)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4016
    apply(rule_tac ind) using h by simp
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4017
  ultimately show "bl2nat (xs @ ys) 0 = 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4018
                  bl2nat xs 0 + bl2nat ys (length xs)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4019
    apply(case_tac k, simp_all add: bl2nat.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4020
    apply(simp_all only: bl2nat_cons_bk bl2nat_cons_oc)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4021
    done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4022
qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4023
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4024
lemma bl2nat_exp:  "n \<noteq> 0 \<Longrightarrow> bl2nat bl n = 2^n * bl2nat bl 0"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4025
apply(induct bl)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4026
apply(auto simp: bl2nat.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4027
apply(case_tac a, auto simp: bl2nat.simps bl2nat_double)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4028
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4029
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4030
lemma nat_minus_eq: "\<lbrakk>a = b; c = d\<rbrakk> \<Longrightarrow> a - c = b - d"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4031
by auto
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4032
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4033
lemma tape_of_nat_list_butlast_last:
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4034
  "ys \<noteq> [] \<Longrightarrow> <ys @ [y]> = <ys> @ Bk # Oc\<up>Suc y"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4035
apply(induct ys, simp, simp)
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  4036
apply(case_tac "ys = []", simp add: tape_of_list_def tape_of_nat_def)
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  4037
apply(simp add: tape_of_nl_cons tape_of_nat_def)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4038
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4039
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4040
lemma listsum2_append:
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4041
  "\<lbrakk>n \<le> length xs\<rbrakk> \<Longrightarrow> listsum2 (xs @ ys) n = listsum2 xs n"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4042
apply(induct n)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4043
apply(auto simp: listsum2.simps nth_append)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4044
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4045
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4046
lemma strt'_append:  
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4047
  "\<lbrakk>n \<le> length xs\<rbrakk> \<Longrightarrow> strt' xs n = strt' (xs @ ys) n"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4048
proof(induct n arbitrary: xs ys)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4049
  fix xs ys
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4050
  show "strt' xs 0 = strt' (xs @ ys) 0" by(simp add: strt'.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4051
next
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4052
  fix n xs ys
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4053
  assume ind: 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4054
    "\<And> xs ys. n \<le> length xs \<Longrightarrow> strt' xs n = strt' (xs @ ys) n"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4055
    and h: "Suc n \<le> length (xs::nat list)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4056
  show "strt' xs (Suc n) = strt' (xs @ ys) (Suc n)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4057
    using ind[of xs ys] h
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4058
    apply(simp add: strt'.simps nth_append listsum2_append)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4059
    done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4060
qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4061
    
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4062
lemma length_listsum2_eq: 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4063
  "\<lbrakk>length (ys::nat list) = k\<rbrakk>
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4064
       \<Longrightarrow> length (<ys>) = listsum2 (map Suc ys) k + k - 1"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4065
apply(induct k arbitrary: ys, simp_all add: listsum2.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4066
apply(subgoal_tac "\<exists> xs x. ys = xs @ [x]", auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4067
proof -
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4068
  fix xs x
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4069
  assume ind: "\<And>ys. length ys = length xs \<Longrightarrow> length (<ys>) 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4070
    = listsum2 (map Suc ys) (length xs) + 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4071
      length (xs::nat list) - Suc 0"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4072
  have "length (<xs>) 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4073
    = listsum2 (map Suc xs) (length xs) + length xs - Suc 0"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4074
    apply(rule_tac ind, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4075
    done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4076
  thus "length (<xs @ [x]>) =
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4077
    Suc (listsum2 (map Suc xs @ [Suc x]) (length xs) + x + length xs)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4078
    apply(case_tac "xs = []")
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  4079
    apply(simp add: tape_of_list_def listsum2.simps 
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  4080
      tape_of_nat_list.simps tape_of_nat_def)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4081
    apply(simp add: tape_of_nat_list_butlast_last)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4082
    using listsum2_append[of "length xs" "map Suc xs" "[Suc x]"]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4083
    apply(simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4084
    done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4085
next
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4086
  fix k ys
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4087
  assume "length ys = Suc k" 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4088
  thus "\<exists>xs x. ys = xs @ [x]"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4089
    apply(rule_tac x = "butlast ys" in exI, 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4090
          rule_tac x = "last ys" in exI)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4091
    apply(case_tac ys, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4092
    done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4093
qed  
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4094
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4095
lemma tape_of_nat_list_length: 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4096
      "length (<(ys::nat list)>) = 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4097
              listsum2 (map Suc ys) (length ys) + length ys - 1"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4098
  using length_listsum2_eq[of ys "length ys"]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4099
  apply(simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4100
  done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4101
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  4102
lemma trpl_code_simp[simp]:
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4103
 "trpl_code (steps0 (Suc 0, Bk\<up>l, <lm>) tp 0) = 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  4104
    rec_exec rec_conf [code tp, bl2wc (<lm>), 0]"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  4105
apply(simp add: steps.simps rec_exec.simps conf_lemma  conf.simps 
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4106
                inpt.simps trpl_code.simps bl2wc.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4107
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4108
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4109
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4110
  The following lemma relates the multi-step interpreter function @{text "rec_conf"}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4111
  with the multi-step execution of TMs.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4112
  *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4113
lemma state_in_range_step
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4114
  : "\<lbrakk>a \<le> length A div 2; step0 (a, b, c) A = (st, l, r); tm_wf (A,0)\<rbrakk>
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4115
  \<Longrightarrow> st \<le> length A div 2"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4116
apply(simp add: step.simps fetch.simps tm_wf.simps 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4117
  split: if_splits list.splits)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4118
apply(case_tac [!] a, auto simp: list_all_length 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4119
  fetch.simps nth_of.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4120
apply(erule_tac x = "A ! (2*nat) " in ballE, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4121
apply(case_tac "hd c", auto simp: fetch.simps nth_of.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4122
apply(erule_tac x = "A !(2 * nat)" in ballE, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4123
apply(erule_tac x = "A !Suc (2 * nat)" in ballE, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4124
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4125
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4126
lemma state_in_range: "\<lbrakk>steps0 (Suc 0, tp) A stp = (st, l, r); tm_wf (A, 0)\<rbrakk>
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4127
  \<Longrightarrow> st \<le> length A div 2"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4128
proof(induct stp arbitrary: st l r)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4129
  case 0 thus "?case" by(auto simp: tm_wf.simps steps.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4130
next
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4131
  fix stp st l r
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4132
  assume ind: "\<And>st l r. \<lbrakk>steps0 (Suc 0, tp) A stp = (st, l, r); tm_wf (A, 0)\<rbrakk> \<Longrightarrow> st \<le> length A div 2"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4133
  and h1: "steps0 (Suc 0, tp) A (Suc stp) = (st, l, r)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4134
  and h2: "tm_wf (A,0::nat)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4135
  from h1 h2 show "st \<le> length A div 2"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4136
  proof(simp add: step_red, cases "(steps0 (Suc 0, tp) A stp)", simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4137
    fix a b c 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4138
    assume h3: "step0 (a, b, c) A = (st, l, r)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4139
    and h4: "steps0 (Suc 0, tp) A stp = (a, b, c)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4140
    have "a \<le> length A div 2"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4141
      using h2 h4
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4142
      by(rule_tac l = b and r = c in ind, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4143
    thus "?thesis"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4144
      using h3 h2
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4145
      apply(erule_tac state_in_range_step, simp_all)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4146
      done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4147
  qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4148
qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4149
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4150
lemma rec_t_eq_steps:
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4151
  "tm_wf (tp,0) \<Longrightarrow>
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4152
  trpl_code (steps0 (Suc 0, Bk\<up>l, <lm>) tp stp) = 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  4153
  rec_exec rec_conf [code tp, bl2wc (<lm>), stp]"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4154
proof(induct stp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4155
  case 0 thus "?case" by(simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4156
next
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4157
  case (Suc n) thus "?case"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4158
  proof -
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4159
    assume ind: 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4160
      "tm_wf (tp,0) \<Longrightarrow> trpl_code (steps0 (Suc 0, Bk\<up> l, <lm>) tp n) 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  4161
      = rec_exec rec_conf [code tp, bl2wc (<lm>), n]"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4162
      and h: "tm_wf (tp, 0)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4163
    show 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4164
      "trpl_code (steps0 (Suc 0, Bk\<up> l, <lm>) tp (Suc n)) =
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  4165
      rec_exec rec_conf [code tp, bl2wc (<lm>), Suc n]"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4166
    proof(case_tac "steps0 (Suc 0, Bk\<up> l, <lm>) tp  n", 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4167
        simp only: step_red conf_lemma conf.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4168
      fix a b c
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4169
      assume g: "steps0 (Suc 0, Bk\<up> l, <lm>) tp n = (a, b, c) "
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4170
      hence "conf (code tp) (bl2wc (<lm>)) n= trpl_code (a, b, c)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4171
        using ind h
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4172
        apply(simp add: conf_lemma)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4173
        done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4174
      moreover hence 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4175
        "trpl_code (step0 (a, b, c) tp) = 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  4176
        rec_exec rec_newconf [code tp, trpl_code (a, b, c)]"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4177
        apply(rule_tac rec_t_eq_step)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4178
        using h g
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4179
        apply(simp add: state_in_range)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4180
        done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4181
      ultimately show 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4182
        "trpl_code (step0 (a, b, c) tp) =
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4183
            newconf (code tp) (conf (code tp) (bl2wc (<lm>)) n)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4184
        by(simp add: newconf_lemma)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4185
    qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4186
  qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4187
qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4188
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  4189
lemma bl2wc_Bk_0[simp]: "bl2wc (Bk\<up> m) = 0"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4190
apply(induct m)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4191
apply(simp, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4192
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4193
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  4194
lemma bl2wc_Oc_then_Bk[simp]: "bl2wc (Oc\<up> rs@Bk\<up> n) = bl2wc (Oc\<up> rs)"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4195
apply(induct rs, simp, 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4196
  simp add: bl2wc.simps bl2nat.simps bl2nat_double)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4197
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4198
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4199
lemma lg_power: "x > Suc 0 \<Longrightarrow> lg (x ^ rs) x = rs"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4200
proof(simp add: lg.simps, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4201
  fix xa
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4202
  assume h: "Suc 0 < x"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4203
  show "Max {ya. ya \<le> x ^ rs \<and> lgR [x ^ rs, x, ya]} = rs"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4204
    apply(rule_tac Max_eqI, simp_all add: lgR.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4205
    apply(simp add: h)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4206
    using x_less_exp[of x rs] h
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4207
    apply(simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4208
    done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4209
next
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4210
  assume "\<not> Suc 0 < x ^ rs" "Suc 0 < x" 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4211
  thus "rs = 0"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4212
    apply(case_tac "x ^ rs", simp, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4213
    done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4214
next
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4215
  assume "Suc 0 < x" "\<forall>xa. \<not> lgR [x ^ rs, x, xa]"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4216
  thus "rs = 0"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4217
    apply(simp only:lgR.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4218
    apply(erule_tac x = rs in allE, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4219
    done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4220
qed    
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4221
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4222
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4223
  The following lemma relates execution of TMs with 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4224
  the multi-step interpreter function @{text "rec_nonstop"}. Note,
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4225
  @{text "rec_nonstop"} is constructed using @{text "rec_conf"}.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4226
  *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4227
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4228
declare tm_wf.simps[simp del]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4229
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4230
lemma nonstop_t_eq: 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4231
  "\<lbrakk>steps0 (Suc 0, Bk\<up>l, <lm>) tp stp = (0, Bk\<up> m, Oc\<up> rs @ Bk\<up> n); 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4232
   tm_wf (tp, 0); 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4233
  rs > 0\<rbrakk> 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  4234
  \<Longrightarrow> rec_exec rec_nonstop [code tp, bl2wc (<lm>), stp] = 0"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4235
proof(simp add: nonstop_lemma nonstop.simps nstd.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4236
  assume h: "steps0 (Suc 0, Bk\<up>l, <lm>) tp stp = (0, Bk\<up> m, Oc\<up> rs @ Bk\<up> n)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4237
  and tc_t: "tm_wf (tp, 0)" "rs > 0"
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  4238
  have g: "rec_exec rec_conf [code tp,  bl2wc (<lm>), stp] =
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4239
                                        trpl_code (0, Bk\<up> m, Oc\<up> rs@Bk\<up> n)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4240
    using rec_t_eq_steps[of tp l lm stp] tc_t h
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4241
    by(simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4242
  thus "\<not> NSTD (conf (code tp) (bl2wc (<lm>)) stp)" 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4243
  proof(auto simp: NSTD.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4244
    show "stat (conf (code tp) (bl2wc (<lm>)) stp) = 0"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4245
      using g
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4246
      by(auto simp: conf_lemma trpl_code.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4247
  next
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4248
    show "left (conf (code tp) (bl2wc (<lm>)) stp) = 0"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4249
      using g
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4250
      by(simp add: conf_lemma trpl_code.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4251
  next
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4252
    show "rght (conf (code tp) (bl2wc (<lm>)) stp) = 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4253
           2 ^ lg (Suc (rght (conf (code tp) (bl2wc (<lm>)) stp))) 2 - Suc 0"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4254
    using g h
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4255
    proof(simp add: conf_lemma trpl_code.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4256
      have "2 ^ lg (Suc (bl2wc (Oc\<up> rs))) 2 = Suc (bl2wc (Oc\<up> rs))"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4257
        apply(simp add: bl2wc.simps lg_power)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4258
        done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4259
      thus "bl2wc (Oc\<up> rs) = 2 ^ lg (Suc (bl2wc (Oc\<up> rs))) 2 - Suc 0"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4260
        apply(simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4261
        done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4262
    qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4263
  next
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4264
    show "0 < rght (conf (code tp) (bl2wc (<lm>)) stp)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4265
      using g h tc_t
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4266
      apply(simp add: conf_lemma trpl_code.simps bl2wc.simps
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4267
                      bl2nat.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4268
      apply(case_tac rs, simp, simp add: bl2nat.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4269
      done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4270
  qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4271
qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4272
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  4273
lemma actn_0_is_4[simp]: "actn m 0 r = 4"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4274
by(simp add: actn.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4275
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  4276
lemma newstat_0_0[simp]: "newstat m 0 r = 0"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4277
by(simp add: newstat.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4278
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4279
declare step_red[simp del]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4280
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4281
lemma halt_least_step: 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4282
  "\<lbrakk>steps0 (Suc 0, Bk\<up>l, <lm>) tp stp = 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4283
       (0, Bk\<up> m, Oc\<up>rs @ Bk\<up>n); 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4284
    tm_wf (tp, 0); 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4285
    0<rs\<rbrakk> \<Longrightarrow>
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4286
    \<exists> stp. (nonstop (code tp) (bl2wc (<lm>)) stp = 0 \<and>
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4287
       (\<forall> stp'. nonstop (code tp) (bl2wc (<lm>)) stp' = 0 \<longrightarrow> stp \<le> stp'))"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4288
proof(induct stp, simp add: steps.simps, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4289
  fix stp
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4290
  assume ind: 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4291
    "steps0 (Suc 0, Bk\<up> l, <lm>) tp stp = (0, Bk\<up> m, Oc\<up> rs @ Bk\<up> n) \<Longrightarrow> 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4292
    \<exists>stp. nonstop (code tp) (bl2wc (<lm>)) stp = 0 \<and> 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4293
          (\<forall>stp'. nonstop (code tp) (bl2wc (<lm>)) stp' = 0 \<longrightarrow> stp \<le> stp')"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4294
  and h: 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4295
    "steps0 (Suc 0, Bk\<up> l, <lm>) tp (Suc stp) = (0, Bk\<up> m, Oc\<up> rs @ Bk\<up> n)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4296
    "tm_wf (tp, 0::nat)" 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4297
    "0 < rs"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4298
  from h show 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4299
    "\<exists>stp. nonstop (code tp) (bl2wc (<lm>)) stp = 0 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4300
    \<and> (\<forall>stp'. nonstop (code tp) (bl2wc (<lm>)) stp' = 0 \<longrightarrow> stp \<le> stp')"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4301
  proof(simp add: step_red, 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4302
      case_tac "steps0 (Suc 0, Bk\<up> l, <lm>) tp stp", simp, 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4303
       case_tac a, simp add: step_0)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4304
    assume "steps0 (Suc 0, Bk\<up> l, <lm>) tp stp = (0, Bk\<up> m, Oc\<up> rs @ Bk\<up> n)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4305
    thus "\<exists>stp. nonstop (code tp) (bl2wc (<lm>)) stp = 0 \<and> 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4306
      (\<forall>stp'. nonstop (code tp) (bl2wc (<lm>)) stp' = 0 \<longrightarrow> stp \<le> stp')"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4307
      apply(erule_tac ind)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4308
      done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4309
  next
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4310
    fix a b c nat
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4311
    assume "steps0 (Suc 0, Bk\<up> l, <lm>) tp stp = (a, b, c)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4312
      "a = Suc nat"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4313
    thus "\<exists>stp. nonstop (code tp) (bl2wc (<lm>)) stp = 0 \<and> 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4314
      (\<forall>stp'. nonstop (code tp) (bl2wc (<lm>)) stp' = 0 \<longrightarrow> stp \<le> stp')"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4315
      using h
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4316
      apply(rule_tac x = "Suc stp" in exI, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4317
      apply(drule_tac  nonstop_t_eq, simp_all add: nonstop_lemma)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4318
    proof -
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4319
      fix stp'
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4320
      assume g:"steps0 (Suc 0, Bk\<up> l, <lm>) tp stp = (Suc nat, b, c)" 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4321
        "nonstop (code tp) (bl2wc (<lm>)) stp' = 0"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4322
      thus  "Suc stp \<le> stp'"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4323
      proof(case_tac "Suc stp \<le> stp'", simp, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4324
        assume "\<not> Suc stp \<le> stp'"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4325
        hence "stp' \<le> stp" by simp
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4326
        hence "\<not> is_final (steps0 (Suc 0, Bk\<up> l, <lm>) tp stp')"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4327
          using g
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4328
          apply(case_tac "steps0 (Suc 0, Bk\<up> l, <lm>) tp stp'",auto, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4329
          apply(subgoal_tac "\<exists> n. stp = stp' + n", auto simp: steps_add steps_0)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4330
          apply(case_tac a, simp_all add: steps.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4331
          apply(rule_tac x = "stp - stp'"  in exI, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4332
          done         
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4333
        hence "nonstop (code tp) (bl2wc (<lm>)) stp' = 1"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4334
        proof(case_tac "steps0 (Suc 0, Bk\<up> l, <lm>) tp stp'",
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4335
            simp add: nonstop.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4336
          fix a b c
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4337
          assume k: 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4338
            "0 < a" "steps0 (Suc 0, Bk\<up> l, <lm>) tp stp' = (a, b, c)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4339
          thus " NSTD (conf (code tp) (bl2wc (<lm>)) stp')"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4340
            using rec_t_eq_steps[of tp l lm stp'] h
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4341
          proof(simp add: conf_lemma) 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4342
            assume "trpl_code (a, b, c) = conf (code tp) (bl2wc (<lm>)) stp'"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4343
            moreover have "NSTD (trpl_code (a, b, c))"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4344
              using k
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4345
              apply(auto simp: trpl_code.simps NSTD.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4346
              done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4347
            ultimately show "NSTD (conf (code tp) (bl2wc (<lm>)) stp')" by simp
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4348
          qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4349
        qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4350
        thus "False" using g by simp
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4351
      qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4352
    qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4353
  qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4354
qed    
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4355
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4356
lemma conf_trpl_ex: "\<exists> p q r. conf m (bl2wc (<lm>)) stp = trpl p q r"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4357
apply(induct stp, auto simp: conf.simps inpt.simps trpl.simps 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4358
  newconf.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4359
apply(rule_tac x = 0 in exI, rule_tac x = 1 in exI, 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4360
  rule_tac x = "bl2wc (<lm>)" in exI)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4361
apply(simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4362
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4363
  
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4364
lemma nonstop_rgt_ex: 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4365
  "nonstop m (bl2wc (<lm>)) stpa = 0 \<Longrightarrow> \<exists> r. conf m (bl2wc (<lm>)) stpa = trpl 0 0 r"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4366
apply(auto simp: nonstop.simps NSTD.simps split: if_splits)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4367
using conf_trpl_ex[of m lm stpa]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4368
apply(auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4369
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4370
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  4371
lemma max_divisors: "x > Suc 0 \<Longrightarrow> Max {u. x ^ u dvd x ^ r} = r"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4372
proof(rule_tac Max_eqI)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4373
  assume "x > Suc 0"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4374
  thus "finite {u. x ^ u dvd x ^ r}"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4375
    apply(rule_tac finite_power_dvd, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4376
    done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4377
next
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4378
  fix y 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4379
  assume "Suc 0 < x" "y \<in> {u. x ^ u dvd x ^ r}"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4380
  thus "y \<le> r"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4381
    apply(case_tac "y\<le> r", simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4382
    apply(subgoal_tac "\<exists> d. y = r + d")
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4383
    apply(auto simp: power_add)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4384
    apply(rule_tac x = "y - r" in exI, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4385
    done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4386
next
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4387
  show "r \<in> {u. x ^ u dvd x ^ r}" by simp
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4388
qed  
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4389
288
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  4390
lemma lo_power:
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  4391
  assumes "x > Suc 0" shows "lo (x ^ r) x = r"
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  4392
proof -
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  4393
  have "\<not> Suc 0 < x ^ r \<Longrightarrow> r = 0" using assms
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  4394
    by (metis Suc_lessD Suc_lessI nat_power_eq_Suc_0_iff zero_less_power)
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  4395
  moreover have "\<forall>xa. \<not> x ^ xa dvd x ^ r \<Longrightarrow> r = 0"
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  4396
    using dvd_refl assms by(cases "x^r";blast)
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  4397
  ultimately show ?thesis using assms
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  4398
    by(auto simp: lo.simps loR.simps mod_dvd_simp elim:max_divisors)
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 250
diff changeset
  4399
qed
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4400
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4401
lemma lo_rgt: "lo (trpl 0 0 r) (Pi 2) = r"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4402
apply(simp add: trpl.simps lo_power)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4403
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4404
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4405
lemma conf_keep: 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4406
  "conf m lm stp = trpl 0 0 r  \<Longrightarrow>
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4407
  conf m lm (stp + n) = trpl 0 0 r"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4408
apply(induct n)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4409
apply(auto simp: conf.simps  newconf.simps newleft.simps 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4410
  newrght.simps rght.simps lo_rgt)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4411
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4412
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4413
lemma halt_state_keep_steps_add:
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4414
  "\<lbrakk>nonstop m (bl2wc (<lm>)) stpa = 0\<rbrakk> \<Longrightarrow> 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4415
  conf m (bl2wc (<lm>)) stpa = conf m (bl2wc (<lm>)) (stpa + n)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4416
apply(drule_tac nonstop_rgt_ex, auto simp: conf_keep)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4417
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4418
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4419
lemma halt_state_keep: 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4420
  "\<lbrakk>nonstop m (bl2wc (<lm>)) stpa = 0; nonstop m (bl2wc (<lm>)) stpb = 0\<rbrakk> \<Longrightarrow>
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4421
  conf m (bl2wc (<lm>)) stpa = conf m (bl2wc (<lm>)) stpb"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4422
apply(case_tac "stpa > stpb")
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4423
using halt_state_keep_steps_add[of m lm stpb "stpa - stpb"] 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4424
apply simp
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4425
using halt_state_keep_steps_add[of m lm stpa "stpb - stpa"]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4426
apply(simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4427
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4428
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4429
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4430
  The correntess of @{text "rec_F"} which relates the interpreter function @{text "rec_F"} with the
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4431
  execution of of TMs.
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4432
  *}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4433
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  4434
lemma terminate_halt: 
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 199
diff changeset
  4435
  "\<lbrakk>steps0 (Suc 0, Bk\<up>l, <lm>) tp stp = (0, Bk\<up>m, Oc\<up>rs@Bk\<up>n); 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  4436
    tm_wf (tp,0); 0<rs\<rbrakk> \<Longrightarrow> terminate rec_halt [code tp, (bl2wc (<lm>))]"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 199
diff changeset
  4437
apply(frule_tac halt_least_step, auto)
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  4438
thm terminate_halt_lemma
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  4439
apply(rule_tac t = stpa in terminate_halt_lemma)
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 199
diff changeset
  4440
apply(simp_all add: nonstop_lemma, auto)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 199
diff changeset
  4441
done
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 199
diff changeset
  4442
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  4443
lemma terminate_F: 
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 199
diff changeset
  4444
  "\<lbrakk>steps0 (Suc 0, Bk\<up>l, <lm>) tp stp = (0, Bk\<up>m, Oc\<up>rs@Bk\<up>n); 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  4445
    tm_wf (tp,0); 0<rs\<rbrakk> \<Longrightarrow> terminate rec_F [code tp, (bl2wc (<lm>))]"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  4446
apply(drule_tac terminate_halt, simp_all)
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  4447
apply(erule_tac terminate_F_lemma)
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 199
diff changeset
  4448
done
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 199
diff changeset
  4449
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4450
lemma F_correct: 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4451
  "\<lbrakk>steps0 (Suc 0, Bk\<up>l, <lm>) tp stp = (0, Bk\<up>m, Oc\<up>rs@Bk\<up>n); 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4452
    tm_wf (tp,0); 0<rs\<rbrakk>
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  4453
   \<Longrightarrow> rec_exec rec_F [code tp, (bl2wc (<lm>))] = (rs - Suc 0)"
250
745547bdc1c7 added lemmas about a pairing function
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 248
diff changeset
  4454
thm halt_least_step nonstop_t_eq nonstop_lemma rec_t_eq_steps conf_lemma
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4455
apply(frule_tac halt_least_step, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4456
apply(frule_tac  nonstop_t_eq, auto simp: nonstop_lemma)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4457
using rec_t_eq_steps[of tp l lm stp]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4458
apply(simp add: conf_lemma)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4459
proof -
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4460
  fix stpa
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4461
  assume h: 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4462
    "nonstop (code tp) (bl2wc (<lm>)) stpa = 0" 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4463
    "\<forall>stp'. nonstop (code tp) (bl2wc (<lm>)) stp' = 0 \<longrightarrow> stpa \<le> stp'" 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4464
    "nonstop (code tp) (bl2wc (<lm>)) stp = 0" 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4465
    "trpl_code (0, Bk\<up> m, Oc\<up> rs @ Bk\<up> n) = conf (code tp) (bl2wc (<lm>)) stp"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4466
    "steps0 (Suc 0, Bk\<up> l, <lm>) tp stp = (0, Bk\<up> m, Oc\<up> rs @ Bk\<up> n)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4467
  hence g1: "conf (code tp) (bl2wc (<lm>)) stpa = trpl_code (0, Bk\<up> m, Oc\<up> rs @ Bk\<up>n)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4468
    using halt_state_keep[of "code tp" lm stpa stp]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4469
    by(simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4470
  moreover have g2:
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  4471
    "rec_exec rec_halt [code tp, (bl2wc (<lm>))] = stpa"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4472
    using h
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  4473
    by(auto simp: rec_exec.simps rec_halt_def nonstop_lemma intro!: Least_equality)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4474
  show  
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  4475
    "rec_exec rec_F [code tp, (bl2wc (<lm>))] = (rs - Suc 0)"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4476
  proof -
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4477
    have 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4478
      "valu (rght (conf (code tp) (bl2wc (<lm>)) stpa)) = rs - Suc 0" 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4479
      using g1 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4480
      apply(simp add: valu.simps trpl_code.simps 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4481
        bl2wc.simps  bl2nat_append lg_power)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4482
      done
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 199
diff changeset
  4483
    thus "?thesis" 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  4484
      by(simp add: rec_exec.simps F_lemma g2)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4485
  qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4486
qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4487
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  4488
end