thys/Recursive.thy
author Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
Wed, 19 Dec 2018 16:10:58 +0100
changeset 288 a9003e6d0463
parent 285 447b433b67fa
child 290 6e1c03614d36
permissions -rw-r--r--
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:
163
67063c5365e1 changed theory names to uppercase
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 131
diff changeset
     1
theory Recursive
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
     2
imports Abacus Rec_Def Abacus_Hoare
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
     3
begin
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
     4
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
     5
fun addition :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> abc_prog"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
     6
  where
166
99a180fd4194 removed some dead code
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 163
diff changeset
     7
  "addition m n p = [Dec m 4, Inc n, Inc p, Goto 0, Dec p 7, Inc m, Goto 4]"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
     8
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
     9
fun mv_box :: "nat \<Rightarrow> nat \<Rightarrow> abc_prog"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    10
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    11
  "mv_box m n = [Dec m 3, Inc n, Goto 0]"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    12
166
99a180fd4194 removed some dead code
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 163
diff changeset
    13
text {* The compilation of @{text "z"}-operator. *}
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    14
definition rec_ci_z :: "abc_inst list"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    15
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    16
  "rec_ci_z \<equiv> [Goto 1]"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    17
166
99a180fd4194 removed some dead code
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 163
diff changeset
    18
text {* The compilation of @{text "s"}-operator. *}
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    19
definition rec_ci_s :: "abc_inst list"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    20
  where
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
    21
  "rec_ci_s \<equiv> (addition 0 1 2 [+] [Inc 1])"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    22
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    23
166
99a180fd4194 removed some dead code
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 163
diff changeset
    24
text {* The compilation of @{text "id i j"}-operator *}
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    25
fun rec_ci_id :: "nat \<Rightarrow> nat \<Rightarrow> abc_inst list"
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_ci_id i j = addition j i (i + 1)"
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
fun mv_boxes :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> abc_inst list"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    30
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    31
  "mv_boxes ab bb 0 = []" |
166
99a180fd4194 removed some dead code
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 163
diff changeset
    32
  "mv_boxes ab bb (Suc n) = mv_boxes ab bb n [+] mv_box (ab + n) (bb + n)"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    33
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    34
fun empty_boxes :: "nat \<Rightarrow> abc_inst list"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    35
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    36
  "empty_boxes 0 = []" |
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    37
  "empty_boxes (Suc n) = empty_boxes n [+] [Dec n 2, Goto 0]"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    38
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
    39
fun cn_merge_gs ::
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
    40
  "(abc_inst list \<times> nat \<times> nat) list \<Rightarrow> nat \<Rightarrow> abc_inst list"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    41
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    42
  "cn_merge_gs [] p = []" |
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    43
  "cn_merge_gs (g # gs) p = 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    44
      (let (gprog, gpara, gn) = g in 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    45
         gprog [+] mv_box gpara p [+] cn_merge_gs gs (Suc p))"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    46
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    47
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    48
text {*
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    49
  The compiler of recursive functions, where @{text "rec_ci recf"} return 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    50
  @{text "(ap, arity, fp)"}, where @{text "ap"} is the Abacus program, @{text "arity"} is the 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    51
  arity of the recursive function @{text "recf"}, 
166
99a180fd4194 removed some dead code
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 163
diff changeset
    52
  @{text "fp"} is the amount of memory which is going to be
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    53
  used by @{text "ap"} for its execution. 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    54
*}
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    55
203
514809bb7ce4 simplified slightly rec_compilation function
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
    56
fun rec_ci :: "recf \<Rightarrow> abc_inst list \<times> nat \<times> nat"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    57
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    58
  "rec_ci z = (rec_ci_z, 1, 2)" |
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    59
  "rec_ci s = (rec_ci_s, 1, 3)" |
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    60
  "rec_ci (id m n) = (rec_ci_id m n, m, m + 2)" |
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    61
  "rec_ci (Cn n f gs) = 
203
514809bb7ce4 simplified slightly rec_compilation function
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
    62
      (let cied_gs = map (\<lambda> g. rec_ci g) gs in
514809bb7ce4 simplified slightly rec_compilation function
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
    63
       let (fprog, fpara, fn) = rec_ci f in 
514809bb7ce4 simplified slightly rec_compilation function
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
    64
       let pstr = Max (set (Suc n # fn # (map (\<lambda> (aprog, p, n). n) cied_gs))) in
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    65
       let qstr = pstr + Suc (length gs) in 
203
514809bb7ce4 simplified slightly rec_compilation function
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
    66
       (cn_merge_gs cied_gs pstr [+] mv_boxes 0 qstr n [+] 
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    67
          mv_boxes pstr 0 (length gs) [+] fprog [+] 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    68
            mv_box fpara pstr [+] empty_boxes (length gs) [+] 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    69
             mv_box pstr n [+] mv_boxes qstr 0 n, n,  qstr + n))" |
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    70
  "rec_ci (Pr n f g) = 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    71
         (let (fprog, fpara, fn) = rec_ci f in 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    72
          let (gprog, gpara, gn) = rec_ci g in 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    73
          let p = Max (set ([n + 3, fn, gn])) in 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    74
          let e = length gprog + 7 in 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    75
           (mv_box n p [+] fprog [+] mv_box n (Suc n) [+] 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    76
               (([Dec p e] [+] gprog [+] 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    77
                 [Inc n, Dec (Suc n) 3, Goto 1]) @
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    78
                     [Dec (Suc (Suc n)) 0, Inc (Suc n), Goto (length gprog + 4)]),
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    79
             Suc n, p + 1))" |
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    80
  "rec_ci (Mn n f) =
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    81
         (let (fprog, fpara, fn) = rec_ci f in 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    82
          let len = length (fprog) in 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    83
            (fprog @ [Dec (Suc n) (len + 5), Dec (Suc n) (len + 3),
166
99a180fd4194 removed some dead code
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 163
diff changeset
    84
             Goto (len + 1), Inc n, Goto 0], n, max (Suc n) fn))"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    85
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    86
declare rec_ci.simps [simp del] rec_ci_s_def[simp del] 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    87
        rec_ci_z_def[simp del] rec_ci_id.simps[simp del]
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
    88
        mv_boxes.simps[simp del] 
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    89
        mv_box.simps[simp del] addition.simps[simp del]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    90
  
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    91
declare abc_steps_l.simps[simp del] abc_fetch.simps[simp del] 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    92
        abc_step_l.simps[simp del] 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    93
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
    94
inductive_cases terminate_pr_reverse: "terminate (Pr n f g) xs"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
    95
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
    96
inductive_cases terminate_z_reverse[elim!]: "terminate z xs"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
    97
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
    98
inductive_cases terminate_s_reverse[elim!]: "terminate s xs"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
    99
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   100
inductive_cases terminate_id_reverse[elim!]: "terminate (id m n) xs"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   101
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   102
inductive_cases terminate_cn_reverse[elim!]: "terminate (Cn n f gs) xs"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   103
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   104
inductive_cases terminate_mn_reverse[elim!]:"terminate (Mn n f) xs"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   105
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   106
fun addition_inv :: "nat \<times> nat list \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow>     
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   107
                     nat list \<Rightarrow> bool"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   108
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   109
  "addition_inv (as, lm') m n p lm = 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   110
        (let sn = lm ! n in
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   111
         let sm = lm ! m in
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   112
         lm ! p = 0 \<and>
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   113
             (if as = 0 then \<exists> x. x \<le> lm ! m \<and> lm' = lm[m := x,
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   114
                                    n := (sn + sm - x), p := (sm - x)]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   115
             else if as = 1 then \<exists> x. x < lm ! m \<and> lm' = lm[m := x,
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   116
                            n := (sn + sm - x - 1), p := (sm - x - 1)]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   117
             else if as = 2 then \<exists> x. x < lm ! m \<and> lm' = lm[m := x, 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   118
                               n := (sn + sm - x), p := (sm - x - 1)]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   119
             else if as = 3 then \<exists> x. x < lm ! m \<and> lm' = lm[m := x,
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   120
                                   n := (sn + sm - x), p := (sm - x)]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   121
             else if as = 4 then \<exists> x. x \<le> lm ! m \<and> lm' = lm[m := x,
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   122
                                       n := (sn + sm), p := (sm - x)] 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   123
             else if as = 5 then \<exists> x. x < lm ! m \<and> lm' = lm[m := x, 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   124
                                  n := (sn + sm), p := (sm - x - 1)] 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   125
             else if as = 6 then \<exists> x. x < lm ! m \<and> lm' =
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   126
                     lm[m := Suc x, n := (sn + sm), p := (sm - x - 1)]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   127
             else if as = 7 then lm' = lm[m := sm, n := (sn + sm)]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   128
             else False))"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   129
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   130
fun addition_stage1 :: "nat \<times> nat list \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   131
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   132
  "addition_stage1 (as, lm) m p = 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   133
          (if as = 0 \<or> as = 1 \<or> as = 2 \<or> as = 3 then 2 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   134
           else if as = 4 \<or> as = 5 \<or> as = 6 then 1
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   135
           else 0)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   136
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   137
fun addition_stage2 :: "nat \<times> nat list \<Rightarrow> nat \<Rightarrow>  nat \<Rightarrow> nat"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   138
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   139
  "addition_stage2 (as, lm) m p = 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   140
              (if 0 \<le> as \<and> as \<le> 3 then lm ! m
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   141
               else if 4 \<le> as \<and> as \<le> 6 then lm ! p
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   142
               else 0)"
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
fun addition_stage3 :: "nat \<times> nat list \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   145
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   146
  "addition_stage3 (as, lm) m p = 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   147
             (if as = 1 then 4  
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   148
              else if as = 2 then 3 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   149
              else if as = 3 then 2
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   150
              else if as = 0 then 1 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   151
              else if as = 5 then 2
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   152
              else if as = 6 then 1 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   153
              else if as = 4 then 0 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   154
              else 0)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   155
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   156
fun addition_measure :: "((nat \<times> nat list) \<times> nat \<times> nat) \<Rightarrow> 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   157
                                                 (nat \<times> nat \<times> nat)"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   158
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   159
  "addition_measure ((as, lm), m, p) =
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   160
     (addition_stage1 (as, lm) m p, 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   161
      addition_stage2 (as, lm) m p,
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   162
      addition_stage3 (as, lm) m p)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   163
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   164
definition addition_LE :: "(((nat \<times> nat list) \<times> nat \<times> nat) \<times> 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   165
                          ((nat \<times> nat list) \<times> nat \<times> nat)) set"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   166
  where "addition_LE \<equiv> (inv_image lex_triple addition_measure)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   167
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: 285
diff changeset
   168
lemma wf_additon_LE[simp]: "wf addition_LE"
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 285
diff changeset
   169
  by(auto simp: addition_LE_def lex_triple_def lex_pair_def)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   170
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   171
declare addition_inv.simps[simp del]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   172
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   173
lemma addition_inv_init: 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   174
  "\<lbrakk>m \<noteq> n; max m n < p; length lm > p; lm ! p = 0\<rbrakk> \<Longrightarrow>
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   175
                                   addition_inv (0, lm) m n p lm"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   176
apply(simp add: addition_inv.simps Let_def)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   177
apply(rule_tac x = "lm ! m" in exI, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   178
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   179
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: 285
diff changeset
   180
lemma abs_fetch_0[simp]: "abc_fetch 0 (addition m n p) = Some (Dec m 4)"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   181
by(simp add: abc_fetch.simps addition.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   182
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: 285
diff changeset
   183
lemma abs_fetch_1[simp]: "abc_fetch (Suc 0) (addition m n p) = Some (Inc n)"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   184
by(simp add: abc_fetch.simps addition.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   185
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: 285
diff changeset
   186
lemma abs_fetch_2[simp]: "abc_fetch 2 (addition m n p) = Some (Inc p)"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   187
by(simp add: abc_fetch.simps addition.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   188
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: 285
diff changeset
   189
lemma abs_fetch_3[simp]: "abc_fetch 3 (addition m n p) = Some (Goto 0)"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   190
by(simp add: abc_fetch.simps addition.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   191
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: 285
diff changeset
   192
lemma abs_fetch_4[simp]: "abc_fetch 4 (addition m n p) = Some (Dec p 7)"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   193
by(simp add: abc_fetch.simps addition.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   194
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: 285
diff changeset
   195
lemma abs_fetch_5[simp]: "abc_fetch 5 (addition m n p) = Some (Inc m)"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   196
by(simp add: abc_fetch.simps addition.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   197
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: 285
diff changeset
   198
lemma abs_fetch_6[simp]: "abc_fetch 6 (addition m n p) = Some (Goto 4)"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   199
by(simp add: abc_fetch.simps addition.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   200
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: 285
diff changeset
   201
lemma exists_small_list_elem1[simp]:
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   202
  "\<lbrakk>m \<noteq> n; p < length lm; lm ! p = 0; m < p; n < p; x \<le> lm ! m; 0 < x\<rbrakk>
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   203
 \<Longrightarrow> \<exists>xa<lm ! m. lm[m := x, n := lm ! n + lm ! m - x, 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   204
                    p := lm ! m - x, m := x - Suc 0] =
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   205
                 lm[m := xa, n := lm ! n + lm ! m - Suc xa,
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   206
                    p := lm ! m - Suc xa]"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   207
apply(case_tac x, simp, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   208
apply(rule_tac x = nat in exI, simp add: list_update_swap 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   209
                                         list_update_overwrite)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   210
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   211
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: 285
diff changeset
   212
lemma exists_small_list_elem2[simp]:
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   213
  "\<lbrakk>m \<noteq> n; p < length lm; lm ! p = 0; m < p; n < p; x < lm ! m\<rbrakk>
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   214
   \<Longrightarrow> \<exists>xa<lm ! m. lm[m := x, n := lm ! n + lm ! m - Suc x,
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   215
                      p := lm ! m - Suc x, n := lm ! n + lm ! m - x]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   216
                 = lm[m := xa, n := lm ! n + lm ! m - xa, 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   217
                      p := lm ! m - Suc xa]"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   218
apply(rule_tac x = x in exI, 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   219
      simp add: list_update_swap list_update_overwrite)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   220
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   221
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: 285
diff changeset
   222
lemma exists_small_list_elem3[simp]: 
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   223
  "\<lbrakk>m \<noteq> n; p < length lm; lm ! p = 0; m < p; n < p; x < lm ! m\<rbrakk>
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   224
   \<Longrightarrow> \<exists>xa<lm ! m. lm[m := x, n := lm ! n + lm ! m - x, 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   225
                          p := lm ! m - Suc x, p := lm ! m - x]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   226
                 = lm[m := xa, n := lm ! n + lm ! m - xa, 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   227
                          p := lm ! m - xa]"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   228
apply(rule_tac x = x in exI, simp add: list_update_overwrite)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   229
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   230
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: 285
diff changeset
   231
lemma exists_small_list_elem4[simp]: 
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   232
  "\<lbrakk>m \<noteq> n; p < length lm; lm ! p = (0::nat); m < p; n < p; x < lm ! m\<rbrakk>
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   233
  \<Longrightarrow> \<exists>xa\<le>lm ! m. lm[m := x, n := lm ! n + lm ! m - x,
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   234
                                   p := lm ! m - x] = 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   235
                  lm[m := xa, n := lm ! n + lm ! m - xa, 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   236
                                   p := lm ! m - xa]"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   237
apply(rule_tac x = x in exI, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   238
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   239
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: 285
diff changeset
   240
lemma exists_small_list_elem5[simp]: 
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   241
  "\<lbrakk>m \<noteq> n; p < length lm; lm ! p = 0; m < p; n < p;
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   242
    x \<le> lm ! m; lm ! m \<noteq> x\<rbrakk>
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   243
  \<Longrightarrow> \<exists>xa<lm ! m. lm[m := x, n := lm ! n + lm ! m, 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   244
                       p := lm ! m - x, p := lm ! m - Suc x] 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   245
               = lm[m := xa, n := lm ! n + lm ! m, 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   246
                       p := lm ! m - Suc xa]"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   247
apply(rule_tac x = x in exI, simp add: list_update_overwrite)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   248
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   249
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: 285
diff changeset
   250
lemma exists_small_list_elem6[simp]:
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   251
  "\<lbrakk>m \<noteq> n; p < length lm; lm ! p = 0; m < p; n < p; x < lm ! m\<rbrakk>
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   252
  \<Longrightarrow> \<exists>xa<lm ! m. lm[m := x, n := lm ! n + lm ! m,
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   253
                             p := lm ! m - Suc x, m := Suc x]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   254
                = lm[m := Suc xa, n := lm ! n + lm ! m, 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   255
                             p := lm ! m - Suc xa]"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   256
apply(rule_tac x = x in exI, 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   257
     simp add: list_update_swap list_update_overwrite)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   258
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   259
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: 285
diff changeset
   260
lemma exists_small_list_elem7[simp]: 
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   261
  "\<lbrakk>m \<noteq> n; p < length lm; lm ! p = 0; m < p; n < p; x < lm ! m\<rbrakk>
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   262
  \<Longrightarrow> \<exists>xa\<le>lm ! m. lm[m := Suc x, n := lm ! n + lm ! m, 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   263
                             p := lm ! m - Suc x] 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   264
               = lm[m := xa, n := lm ! n + lm ! m, p := lm ! m - xa]"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   265
apply(rule_tac x = "Suc x" in exI, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   266
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   267
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   268
lemma abc_steps_zero: "abc_steps_l asm ap 0 = asm"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   269
apply(case_tac asm, simp add: abc_steps_l.simps)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   270
done
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   271
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   272
declare Let_def[simp]
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   273
lemma addition_halt_lemma: 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   274
  "\<lbrakk>m \<noteq> n; max m n < p; length lm > p; lm ! p = 0\<rbrakk> \<Longrightarrow>
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   275
  \<forall>na. \<not> (\<lambda>(as, lm') (m, p). as = 7) 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   276
        (abc_steps_l (0, lm) (addition m n p) na) (m, p) \<and> 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   277
  addition_inv (abc_steps_l (0, lm) (addition m n p) na) m n p lm 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   278
\<longrightarrow> addition_inv (abc_steps_l (0, lm) (addition m n p) 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   279
                                 (Suc na)) m n p lm 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   280
  \<and> ((abc_steps_l (0, lm) (addition m n p) (Suc na), m, p), 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   281
     abc_steps_l (0, lm) (addition m n p) na, m, p) \<in> addition_LE"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   282
apply(rule allI, rule impI, simp add: abc_step_red2)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   283
apply(case_tac "(abc_steps_l (0, lm) (addition m n p) na)", simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   284
apply(auto split:if_splits simp add: addition_inv.simps
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   285
                                 abc_steps_zero)
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   286
apply(simp_all add: addition.simps abc_steps_l.simps)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   287
apply(auto simp add: addition_LE_def lex_triple_def lex_pair_def 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   288
                     abc_step_l.simps addition_inv.simps 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   289
                     abc_lm_v.simps abc_lm_s.simps nth_append
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   290
                split: if_splits)
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   291
apply(rule_tac [!] x = x in exI, simp_all add: list_update_overwrite Suc_diff_Suc)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   292
by (metis list_update_overwrite list_update_swap nat_neq_iff)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   293
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   294
lemma  addition_correct': 
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   295
  "\<lbrakk>m \<noteq> n; max m n < p; length lm > p; lm ! p = 0\<rbrakk> \<Longrightarrow> 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   296
  \<exists> stp. (\<lambda> (as, lm'). as = 7 \<and> addition_inv (as, lm') m n p lm) 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   297
                        (abc_steps_l (0, lm) (addition m n p) stp)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   298
apply(insert halt_lemma2[of addition_LE
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   299
  "\<lambda> ((as, lm'), m, p). addition_inv (as, lm') m n p lm"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   300
  "\<lambda> stp. (abc_steps_l (0, lm) (addition m n p) stp, m, p)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   301
  "\<lambda> ((as, lm'), m, p). as = 7"], 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   302
  simp add: abc_steps_zero addition_inv_init)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   303
apply(drule_tac addition_halt_lemma, simp, simp, simp,
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   304
      simp, erule_tac exE)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   305
apply(rule_tac x = na in exI, 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   306
      case_tac "(abc_steps_l (0, lm) (addition m n p) na)", auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   307
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   308
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   309
lemma length_addition[simp]: "length (addition a b c) = 7"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   310
by(auto simp: addition.simps)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   311
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   312
lemma addition_correct:
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: 285
diff changeset
   313
  assumes "m \<noteq> n" "max m n < p" "length lm > p" "lm ! p = 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: 285
diff changeset
   314
  shows "{\<lambda> a. a = lm} (addition m n p) {\<lambda> nl. addition_inv (7, nl) m n p lm}"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   315
using assms
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   316
proof(rule_tac abc_Hoare_haltI, simp)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   317
  fix lma
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   318
  assume "m \<noteq> n" "m < p \<and> n < p" "p < length lm" "lm ! p = 0"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   319
  then have "\<exists> stp. (\<lambda> (as, lm'). as = 7 \<and> addition_inv (as, lm') m n p lm) 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   320
                        (abc_steps_l (0, lm) (addition m n p) stp)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   321
    by(rule_tac addition_correct', auto simp: addition_inv.simps)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   322
  thus "\<exists>na. abc_final (abc_steps_l (0, lm) (addition m n p) na) (addition m n p) \<and>
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   323
                  (\<lambda>nl. addition_inv (7, nl) m n p lm) abc_holds_for abc_steps_l (0, lm) (addition m n p) na"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   324
    apply(erule_tac exE)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   325
    apply(rule_tac x = stp in exI)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   326
    apply(auto)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   327
    done
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   328
qed
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   329
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   330
lemma compile_s_correct':
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   331
  "{\<lambda>nl. nl = n # 0 \<up> 2 @ anything} addition 0 (Suc 0) 2 [+] [Inc (Suc 0)] {\<lambda>nl. nl = n # Suc n # 0 # anything}"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   332
proof(rule_tac abc_Hoare_plus_halt)
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   333
  show "{\<lambda>nl. nl = n # 0 \<up> 2 @ anything} addition 0 (Suc 0) 2 {\<lambda> nl. addition_inv (7, nl) 0 (Suc 0) 2 (n # 0 \<up> 2 @ anything)}"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   334
    by(rule_tac addition_correct, auto simp: numeral_2_eq_2)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   335
next
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   336
  show "{\<lambda>nl. addition_inv (7, nl) 0 (Suc 0) 2 (n # 0 \<up> 2 @ anything)} [Inc (Suc 0)] {\<lambda>nl. nl = n # Suc n # 0 # anything}"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   337
    by(rule_tac abc_Hoare_haltI, rule_tac x = 1 in exI, auto simp: addition_inv.simps 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   338
      abc_steps_l.simps abc_step_l.simps abc_fetch.simps numeral_2_eq_2 abc_lm_s.simps abc_lm_v.simps)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   339
qed
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   340
  
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   341
declare rec_exec.simps[simp del]
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   342
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   343
lemma abc_comp_commute: "(A [+] B) [+] C = A [+] (B [+] C)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   344
apply(auto simp: abc_comp.simps abc_shift.simps)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   345
apply(case_tac x, auto)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   346
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   347
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   348
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   349
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   350
lemma compile_z_correct: 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   351
  "\<lbrakk>rec_ci z = (ap, arity, fp); rec_exec z [n] = r\<rbrakk> \<Longrightarrow> 
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   352
  {\<lambda>nl. nl = n # 0 \<up> (fp - arity) @ anything} ap {\<lambda>nl. nl = n # r # 0 \<up> (fp - Suc arity) @ anything}"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   353
apply(rule_tac abc_Hoare_haltI)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   354
apply(rule_tac x = 1 in exI)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   355
apply(auto simp: abc_steps_l.simps rec_ci.simps rec_ci_z_def 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   356
                 numeral_2_eq_2 abc_fetch.simps abc_step_l.simps rec_exec.simps)
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   357
done
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   358
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   359
lemma compile_s_correct: 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   360
  "\<lbrakk>rec_ci s = (ap, arity, fp); rec_exec s [n] = r\<rbrakk> \<Longrightarrow> 
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   361
  {\<lambda>nl. nl = n # 0 \<up> (fp - arity) @ anything} ap {\<lambda>nl. nl = n # r # 0 \<up> (fp - Suc arity) @ anything}"
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   362
apply(auto simp: rec_ci.simps rec_ci_s_def compile_s_correct' rec_exec.simps)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   363
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   364
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   365
lemma compile_id_correct':
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   366
  assumes "n < length args" 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   367
  shows "{\<lambda>nl. nl = args @ 0 \<up> 2 @ anything} addition n (length args) (Suc (length args))
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   368
  {\<lambda>nl. nl = args @ rec_exec (recf.id (length args) n) args # 0 # anything}"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   369
proof -
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   370
  have "{\<lambda>nl. nl = args @ 0 \<up> 2 @ anything} addition n (length args) (Suc (length args))
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   371
  {\<lambda>nl. addition_inv (7, nl) n (length args) (Suc (length args)) (args @ 0 \<up> 2 @ anything)}"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   372
    using assms
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   373
    by(rule_tac addition_correct, auto simp: numeral_2_eq_2 nth_append)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   374
  thus "?thesis"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   375
    using assms
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   376
    by(simp add: addition_inv.simps rec_exec.simps 
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   377
      nth_append numeral_2_eq_2 list_update_append)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   378
qed
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   379
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   380
lemma compile_id_correct: 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   381
  "\<lbrakk>n < m; length xs = m; rec_ci (recf.id m n) = (ap, arity, fp); rec_exec (recf.id m n) xs = r\<rbrakk>
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   382
       \<Longrightarrow> {\<lambda>nl. nl = xs @ 0 \<up> (fp - arity) @ anything} ap {\<lambda>nl. nl = xs @ r # 0 \<up> (fp - Suc arity) @ anything}"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   383
apply(auto simp: rec_ci.simps rec_ci_id.simps compile_id_correct')
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   384
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   385
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   386
lemma cn_merge_gs_tl_app: 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   387
  "cn_merge_gs (gs @ [g]) pstr = 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   388
        cn_merge_gs gs pstr [+] cn_merge_gs [g] (pstr + length gs)"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   389
apply(induct gs arbitrary: pstr, simp add: cn_merge_gs.simps, auto)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   390
apply(simp add: abc_comp_commute)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   391
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   392
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   393
lemma footprint_ge: 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   394
  "rec_ci a = (p, arity, fp) \<Longrightarrow> arity < fp"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   395
apply(induct a)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   396
apply(auto simp: rec_ci.simps)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   397
apply(case_tac "rec_ci a", simp)
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   398
apply(case_tac "rec_ci a1", case_tac "rec_ci a2", auto)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   399
apply(case_tac "rec_ci a", auto)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   400
done
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   401
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   402
lemma param_pattern: 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   403
  "\<lbrakk>terminate f xs; rec_ci f = (p, arity, fp)\<rbrakk> \<Longrightarrow> length xs = arity"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   404
apply(induct arbitrary: p arity fp rule: terminate.induct)
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   405
apply(auto simp: rec_ci.simps)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   406
apply(case_tac "rec_ci f", simp)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   407
apply(case_tac "rec_ci f", case_tac "rec_ci g", simp)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   408
apply(case_tac "rec_ci f", case_tac "rec_ci gs", simp)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   409
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   410
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   411
lemma replicate_merge_anywhere: 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   412
  "x\<up>a @ x\<up>b @ ys = x\<up>(a+b) @ ys"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   413
by(simp add:replicate_add)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   414
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   415
fun mv_box_inv :: "nat \<times> nat list \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat list \<Rightarrow> bool"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   416
  where
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   417
  "mv_box_inv (as, lm) m n initlm = 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   418
         (let plus = initlm ! m + initlm ! n in
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   419
           length initlm > max m n \<and> m \<noteq> n \<and> 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   420
              (if as = 0 then \<exists> k l. lm = initlm[m := k, n := l] \<and> 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   421
                    k + l = plus \<and> k \<le> initlm ! m 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   422
              else if as = 1 then \<exists> k l. lm = initlm[m := k, n := l]
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   423
                             \<and> k + l + 1 = plus \<and> k < initlm ! m 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   424
              else if as = 2 then \<exists> k l. lm = initlm[m := k, n := l] 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   425
                              \<and> k + l = plus \<and> k \<le> initlm ! m
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   426
              else if as = 3 then lm = initlm[m := 0, n := plus]
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   427
              else False))"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   428
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   429
fun mv_box_stage1 :: "nat \<times> nat list \<Rightarrow> nat \<Rightarrow> nat"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   430
  where
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   431
  "mv_box_stage1 (as, lm) m  = 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   432
            (if as = 3 then 0 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   433
             else 1)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   434
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   435
fun mv_box_stage2 :: "nat \<times> nat list \<Rightarrow> nat \<Rightarrow> nat"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   436
  where
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   437
  "mv_box_stage2 (as, lm) m = (lm ! m)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   438
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   439
fun mv_box_stage3 :: "nat \<times> nat list \<Rightarrow> nat \<Rightarrow> nat"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   440
  where
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   441
  "mv_box_stage3 (as, lm) m = (if as = 1 then 3 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   442
                                else if as = 2 then 2
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   443
                                else if as = 0 then 1 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   444
                                else 0)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   445
 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   446
fun mv_box_measure :: "((nat \<times> nat list) \<times> nat) \<Rightarrow> (nat \<times> nat \<times> nat)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   447
  where
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   448
  "mv_box_measure ((as, lm), m) = 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   449
     (mv_box_stage1 (as, lm) m, mv_box_stage2 (as, lm) m,
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   450
      mv_box_stage3 (as, lm) m)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   451
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   452
definition lex_pair :: "((nat \<times> nat) \<times> nat \<times> nat) set"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   453
  where
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   454
  "lex_pair = less_than <*lex*> less_than"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   455
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   456
definition lex_triple :: 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   457
 "((nat \<times> (nat \<times> nat)) \<times> (nat \<times> (nat \<times> nat))) set"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   458
  where
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   459
  "lex_triple \<equiv> less_than <*lex*> lex_pair"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   460
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   461
definition mv_box_LE :: 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   462
 "(((nat \<times> nat list) \<times> nat) \<times> ((nat \<times> nat list) \<times> nat)) set"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   463
  where 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   464
  "mv_box_LE \<equiv> (inv_image lex_triple mv_box_measure)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   465
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   466
lemma wf_lex_triple: "wf lex_triple"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   467
  by (auto intro:wf_lex_prod simp:lex_triple_def lex_pair_def)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   468
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   469
lemma wf_mv_box_le[intro]: "wf mv_box_LE"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   470
by(auto intro:wf_inv_image wf_lex_triple simp: mv_box_LE_def)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   471
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   472
declare mv_box_inv.simps[simp del]
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   473
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   474
lemma mv_box_inv_init:  
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   475
"\<lbrakk>m < length initlm; n < length initlm; m \<noteq> n\<rbrakk> \<Longrightarrow> 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   476
  mv_box_inv (0, initlm) m n initlm"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   477
apply(simp add: abc_steps_l.simps mv_box_inv.simps)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   478
apply(rule_tac x = "initlm ! m" in exI, 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   479
      rule_tac x = "initlm ! n" in exI, simp)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   480
done
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   481
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: 285
diff changeset
   482
lemma abc_fetch_0[simp]: "abc_fetch 0 (mv_box m n) = Some (Dec m 3)"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   483
apply(simp add: mv_box.simps abc_fetch.simps)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   484
done
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   485
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: 285
diff changeset
   486
lemma abc_fetch_1[simp]: "abc_fetch (Suc 0) (mv_box m n) =
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   487
               Some (Inc n)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   488
apply(simp add: mv_box.simps abc_fetch.simps)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   489
done
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   490
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: 285
diff changeset
   491
lemma abc_fetch_2[simp]: "abc_fetch 2 (mv_box m n) = Some (Goto 0)"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   492
apply(simp add: mv_box.simps abc_fetch.simps)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   493
done
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   494
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: 285
diff changeset
   495
lemma abc_fetch_3[simp]: "abc_fetch 3 (mv_box m n) = None"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   496
apply(simp add: mv_box.simps abc_fetch.simps)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   497
done
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   498
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   499
lemma replicate_Suc_iff_anywhere: "x # x\<up>b @ ys = x\<up>(Suc b) @ ys"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   500
by simp
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   501
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: 285
diff changeset
   502
lemma exists_smaller_in_list0[simp]: 
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   503
  "\<lbrakk>m \<noteq> n; m < length initlm; n < length initlm;
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   504
    k + l = initlm ! m + initlm ! n; k \<le> initlm ! m; 0 < k\<rbrakk>
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   505
 \<Longrightarrow> \<exists>ka la. initlm[m := k, n := l, m := k - Suc 0] = 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   506
     initlm[m := ka, n := la] \<and>
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   507
     Suc (ka + la) = initlm ! m + initlm ! n \<and> 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   508
     ka < initlm ! m"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   509
apply(rule_tac x = "k - Suc 0" in exI, rule_tac x = l in exI, 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   510
      simp, auto)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   511
apply(subgoal_tac 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   512
      "initlm[m := k, n := l, m := k - Suc 0] = 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   513
       initlm[n := l, m := k, m := k - Suc 0]")
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   514
apply(simp add: list_update_overwrite )
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   515
apply(simp add: list_update_swap)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   516
apply(simp add: list_update_swap)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   517
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   518
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: 285
diff changeset
   519
lemma exists_smaller_in_list1[simp]:
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   520
  "\<lbrakk>m \<noteq> n; m < length initlm; n < length initlm; 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   521
    Suc (k + l) = initlm ! m + initlm ! n;
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   522
    k < initlm ! m\<rbrakk>
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   523
    \<Longrightarrow> \<exists>ka la. initlm[m := k, n := l, n := Suc l] = 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   524
                initlm[m := ka, n := la] \<and> 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   525
                ka + la = initlm ! m + initlm ! n \<and> 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   526
                ka \<le> initlm ! m"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   527
apply(rule_tac x = k in exI, rule_tac x = "Suc l" in exI, auto)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   528
done
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   529
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: 285
diff changeset
   530
lemma abc_steps_prop[simp]: 
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   531
  "\<lbrakk>length initlm > max m n; m \<noteq> n\<rbrakk> \<Longrightarrow> 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   532
   \<forall>na. \<not> (\<lambda>(as, lm) m. as = 3) 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   533
    (abc_steps_l (0, initlm) (mv_box m n) na) m \<and> 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   534
  mv_box_inv (abc_steps_l (0, initlm) 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   535
           (mv_box m n) na) m n initlm \<longrightarrow>
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   536
  mv_box_inv (abc_steps_l (0, initlm) 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   537
           (mv_box m n) (Suc na)) m n initlm \<and>
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   538
  ((abc_steps_l (0, initlm) (mv_box m n) (Suc na), m),
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   539
   abc_steps_l (0, initlm) (mv_box m n) na, m) \<in> mv_box_LE"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   540
apply(rule allI, rule impI, simp add: abc_step_red2)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   541
apply(case_tac "(abc_steps_l (0, initlm) (mv_box m n) na)",
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   542
      simp)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   543
apply(auto split:if_splits simp add:abc_steps_l.simps mv_box_inv.simps)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   544
apply(auto simp add: mv_box_LE_def lex_triple_def lex_pair_def 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   545
                     abc_step_l.simps abc_steps_l.simps
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   546
                     mv_box_inv.simps abc_lm_v.simps abc_lm_s.simps
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   547
                split: if_splits )
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   548
apply(rule_tac x = k in exI, rule_tac x = "Suc l" in exI, simp)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   549
done
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   550
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   551
lemma mv_box_inv_halt: 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   552
  "\<lbrakk>length initlm > max m n; m \<noteq> n\<rbrakk> \<Longrightarrow> 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   553
  \<exists> stp. (\<lambda> (as, lm). as = 3 \<and> 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   554
  mv_box_inv (as, lm) m n initlm) 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   555
             (abc_steps_l (0::nat, initlm) (mv_box m n) stp)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   556
apply(insert halt_lemma2[of mv_box_LE
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   557
    "\<lambda> ((as, lm), m). mv_box_inv (as, lm) m n initlm"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   558
    "\<lambda> stp. (abc_steps_l (0, initlm) (mv_box m n) stp, m)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   559
    "\<lambda> ((as, lm), m). as = (3::nat)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   560
    ])
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   561
apply(insert wf_mv_box_le)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   562
apply(simp add: mv_box_inv_init abc_steps_zero)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   563
apply(erule_tac exE)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   564
apply(rule_tac x = na in exI)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   565
apply(case_tac "(abc_steps_l (0, initlm) (mv_box m n) na)",
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   566
      simp, auto)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   567
done
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   568
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   569
lemma mv_box_halt_cond:
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   570
  "\<lbrakk>m \<noteq> n; mv_box_inv (a, b) m n lm; a = 3\<rbrakk> \<Longrightarrow> 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   571
  b = lm[n := lm ! m + lm ! n, m := 0]"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   572
apply(simp add: mv_box_inv.simps, auto)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   573
apply(simp add: list_update_swap)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   574
done
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   575
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   576
lemma mv_box_correct':
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   577
  "\<lbrakk>length lm > max m n; m \<noteq> n\<rbrakk> \<Longrightarrow> 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   578
  \<exists> stp. abc_steps_l (0::nat, lm) (mv_box m n) stp
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   579
  = (3, (lm[n := (lm ! m + lm ! n)])[m := 0::nat])"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   580
apply(drule mv_box_inv_halt, simp, erule_tac exE)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   581
apply(rule_tac x = stp in exI)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   582
apply(case_tac "abc_steps_l (0, lm) (mv_box m n) stp",
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   583
      simp)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   584
apply(erule_tac mv_box_halt_cond, auto)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   585
done
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   586
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   587
lemma length_mvbox[simp]: "length (mv_box m n) = 3"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   588
by(simp add: mv_box.simps)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   589
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   590
lemma mv_box_correct: 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   591
  "\<lbrakk>length lm > max m n; m\<noteq>n\<rbrakk> 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   592
  \<Longrightarrow> {\<lambda> nl. nl = lm} mv_box m n {\<lambda> nl. nl = lm[n := (lm ! m + lm ! n), m:=0]}"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   593
apply(drule_tac mv_box_correct', simp)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   594
apply(auto simp: abc_Hoare_halt_def)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   595
apply(rule_tac x = stp in exI, simp)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   596
done
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   597
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   598
declare list_update.simps(2)[simp del]
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   599
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: 285
diff changeset
   600
lemma zero_case_rec_exec[simp]:
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   601
  "\<lbrakk>length xs < gf; gf \<le> ft; n < length gs\<rbrakk>
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   602
  \<Longrightarrow> (rec_exec (gs ! n) xs # 0 \<up> (ft - Suc (length xs)) @ map (\<lambda>i. rec_exec i xs) (take n gs) @ 0 \<up> (length gs - n) @ 0 # 0 \<up> length xs @ anything)
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   603
  [ft + n - length xs := rec_exec (gs ! n) xs, 0 := 0] =
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   604
  0 \<up> (ft - length xs) @ map (\<lambda>i. rec_exec i xs) (take n gs) @ rec_exec (gs ! n) xs # 0 \<up> (length gs - Suc n) @ 0 # 0 \<up> length xs @ anything"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   605
using list_update_append[of "rec_exec (gs ! n) xs # 0 \<up> (ft - Suc (length xs)) @ map (\<lambda>i. rec_exec i xs) (take n gs)"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   606
                             "0 \<up> (length gs - n) @ 0 # 0 \<up> length xs @ anything" "ft + n - length xs" "rec_exec (gs ! n) xs"]
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   607
apply(auto)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   608
apply(case_tac "length gs - n", simp, simp add: list_update.simps replicate_Suc_iff_anywhere Suc_diff_Suc del: replicate_Suc)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   609
apply(simp add: list_update.simps)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   610
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   611
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   612
lemma compile_cn_gs_correct':
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   613
  assumes
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   614
  g_cond: "\<forall>g\<in>set (take n gs). terminate g xs \<and>
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   615
  (\<forall>x xa xb. rec_ci g = (x, xa, xb) \<longrightarrow> (\<forall>xc. {\<lambda>nl. nl = xs @ 0 \<up> (xb - xa) @ xc} x {\<lambda>nl. nl = xs @ rec_exec g xs # 0 \<up> (xb - Suc xa) @ xc}))"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   616
  and ft: "ft = max (Suc (length xs)) (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs)))"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   617
  shows 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   618
  "{\<lambda>nl. nl = xs @ 0 # 0 \<up> (ft + length gs) @ anything}
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   619
    cn_merge_gs (map rec_ci (take n gs)) ft
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   620
  {\<lambda>nl. nl = xs @ 0 \<up> (ft - length xs) @
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   621
                    map (\<lambda>i. rec_exec i xs) (take n gs) @ 0\<up>(length gs - n) @ 0 \<up> Suc (length xs) @ anything}"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   622
  using g_cond
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   623
proof(induct n)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   624
  case 0
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   625
  have "ft > length xs"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   626
    using ft
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   627
    by simp
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   628
  thus "?case"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   629
    apply(rule_tac abc_Hoare_haltI)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   630
    apply(rule_tac x = 0 in exI, simp add: abc_steps_l.simps replicate_add[THEN sym] 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   631
      replicate_Suc[THEN sym] del: replicate_Suc)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   632
    done
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   633
next
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   634
  case (Suc n)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   635
  have ind': "\<forall>g\<in>set (take n gs).
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   636
     terminate g xs \<and> (\<forall>x xa xb. rec_ci g = (x, xa, xb) \<longrightarrow> 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   637
    (\<forall>xc. {\<lambda>nl. nl = xs @ 0 \<up> (xb - xa) @ xc} x {\<lambda>nl. nl = xs @ rec_exec g xs # 0 \<up> (xb - Suc xa) @ xc})) \<Longrightarrow>
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   638
    {\<lambda>nl. nl = xs @ 0 # 0 \<up> (ft + length gs) @ anything} cn_merge_gs (map rec_ci (take n gs)) ft 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   639
    {\<lambda>nl. nl = xs @ 0 \<up> (ft - length xs) @ map (\<lambda>i. rec_exec i xs) (take n gs) @ 0 \<up> (length gs - n) @ 0 \<up> Suc (length xs) @ anything}"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   640
    by fact
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   641
  have g_newcond: "\<forall>g\<in>set (take (Suc n) gs).
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   642
     terminate g xs \<and> (\<forall>x xa xb. rec_ci g = (x, xa, xb) \<longrightarrow> (\<forall>xc. {\<lambda>nl. nl = xs @ 0 \<up> (xb - xa) @ xc} x {\<lambda>nl. nl = xs @ rec_exec g xs # 0 \<up> (xb - Suc xa) @ xc}))"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   643
    by fact
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   644
  from g_newcond have ind:
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   645
    "{\<lambda>nl. nl = xs @ 0 # 0 \<up> (ft + length gs) @ anything} cn_merge_gs (map rec_ci (take n gs)) ft 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   646
    {\<lambda>nl. nl = xs @ 0 \<up> (ft - length xs) @ map (\<lambda>i. rec_exec i xs) (take n gs) @ 0 \<up> (length gs - n) @ 0 \<up> Suc (length xs) @ anything}"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   647
    apply(rule_tac ind', rule_tac ballI, erule_tac x = g in ballE, simp_all add: take_Suc)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   648
    by(case_tac "n < length gs", simp add:take_Suc_conv_app_nth, simp)    
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   649
  show "?case"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   650
  proof(cases "n < length gs")
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   651
    case True
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   652
    have h: "n < length gs" by fact
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   653
    thus "?thesis"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   654
    proof(simp add: take_Suc_conv_app_nth cn_merge_gs_tl_app)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   655
      obtain gp ga gf where a: "rec_ci (gs!n) = (gp, ga, gf)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   656
        by (metis prod_cases3)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   657
      moreover have "min (length gs) n = n"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   658
        using h by simp
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   659
      moreover have 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   660
        "{\<lambda>nl. nl = xs @ 0 # 0 \<up> (ft + length gs) @ anything}
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   661
        cn_merge_gs (map rec_ci (take n gs)) ft [+] (gp [+] mv_box ga (ft + n))
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   662
        {\<lambda>nl. nl = xs @ 0 \<up> (ft - length xs) @ map (\<lambda>i. rec_exec i xs) (take n gs) @ 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   663
        rec_exec (gs ! n) xs # 0 \<up> (length gs - Suc n) @ 0 # 0 \<up> length xs @ anything}"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   664
      proof(rule_tac abc_Hoare_plus_halt)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   665
        show "{\<lambda>nl. nl = xs @ 0 # 0 \<up> (ft + length gs) @ anything} cn_merge_gs (map rec_ci (take n gs)) ft
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   666
          {\<lambda>nl. nl = xs @ 0 \<up> (ft - length xs) @ map (\<lambda>i. rec_exec i xs) (take n gs) @ 0 \<up> (length gs - n) @ 0 \<up> Suc (length xs) @ anything}"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   667
          using ind by simp
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   668
      next
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   669
        have x: "gs!n \<in> set (take (Suc n) gs)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   670
          using h
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   671
          by(simp add: take_Suc_conv_app_nth)
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   672
        have b: "terminate (gs!n) xs"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   673
          using a g_newcond h x
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   674
          by(erule_tac x = "gs!n" in ballE, simp_all)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   675
        hence c: "length xs = ga"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   676
          using a param_pattern by metis  
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   677
        have d: "gf > ga" using footprint_ge a 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: 285
diff changeset
   678
        have e: "ft \<ge> gf"
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 285
diff changeset
   679
          using ft a h Max_ge image_eqI
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 285
diff changeset
   680
          by(simp, rule_tac max.coboundedI2, rule_tac Max_ge, simp, 
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   681
            rule_tac insertI2,  
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   682
            rule_tac f = "(\<lambda>(aprog, p, n). n)" and x = "rec_ci (gs!n)" in image_eqI, simp, 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   683
            rule_tac x = "gs!n" in image_eqI, simp, simp)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   684
        show "{\<lambda>nl. nl = xs @ 0 \<up> (ft - length xs) @ 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   685
          map (\<lambda>i. rec_exec i xs) (take n gs) @ 0 \<up> (length gs - n) @ 0 \<up> Suc (length xs) @ anything} gp [+] mv_box ga (ft + n)
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   686
          {\<lambda>nl. nl = xs @ 0 \<up> (ft - length xs) @ map (\<lambda>i. rec_exec i xs) 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   687
          (take n gs) @ rec_exec (gs ! n) xs # 0 \<up> (length gs - Suc n) @ 0 # 0 \<up> length xs @ anything}"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   688
        proof(rule_tac abc_Hoare_plus_halt)
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   689
          show "{\<lambda>nl. nl = xs @ 0 \<up> (ft - length xs) @ map (\<lambda>i. rec_exec i xs) (take n gs) @ 0 \<up> (length gs - n) @ 0 \<up> Suc (length xs) @ anything} gp 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   690
                {\<lambda>nl. nl = xs @ (rec_exec (gs!n) xs) # 0 \<up> (ft - Suc (length xs)) @ map (\<lambda>i. rec_exec i xs) 
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   691
                              (take n gs) @  0 \<up> (length gs - n) @ 0 # 0 \<up> length xs @ anything}"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   692
          proof -
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   693
            have 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   694
              "({\<lambda>nl. nl = xs @ 0 \<up> (gf - ga) @ 0\<up>(ft - gf)@map (\<lambda>i. rec_exec i xs) (take n gs) @ 0 \<up> (length gs - n) @ 0 \<up> Suc (length xs) @ anything} 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   695
            gp {\<lambda>nl. nl = xs @ (rec_exec (gs!n) xs) # 0 \<up> (gf - Suc ga) @ 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   696
              0\<up>(ft - gf)@map (\<lambda>i. rec_exec i xs) (take n gs) @ 0 \<up> (length gs - n) @ 0 \<up> Suc (length xs) @ anything})"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   697
              using a g_newcond h x
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   698
              apply(erule_tac x = "gs!n" in ballE)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   699
              apply(simp, simp)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   700
              done            
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   701
            thus "?thesis"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   702
              using a b c d e
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   703
              by(simp add: replicate_merge_anywhere)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   704
          qed
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   705
        next
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   706
          show 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   707
            "{\<lambda>nl. nl = xs @ rec_exec (gs ! n) xs #
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   708
            0 \<up> (ft - Suc (length xs)) @ map (\<lambda>i. rec_exec i xs) (take n gs) @ 0 \<up> (length gs - n) @ 0 # 0 \<up> length xs @ anything}
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   709
            mv_box ga (ft + n)
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   710
            {\<lambda>nl. nl = xs @ 0 \<up> (ft - length xs) @ map (\<lambda>i. rec_exec i xs) (take n gs) @
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   711
            rec_exec (gs ! n) xs # 0 \<up> (length gs - Suc n) @ 0 # 0 \<up> length xs @ anything}"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   712
          proof -
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   713
            have "{\<lambda>nl. nl = xs @ rec_exec (gs ! n) xs # 0 \<up> (ft - Suc (length xs)) @
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   714
              map (\<lambda>i. rec_exec i xs) (take n gs) @ 0 \<up> (length gs - n) @ 0 # 0 \<up> length xs @ anything}
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   715
              mv_box ga (ft + n) {\<lambda>nl. nl = (xs @ rec_exec (gs ! n) xs # 0 \<up> (ft - Suc (length xs)) @
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   716
              map (\<lambda>i. rec_exec i xs) (take n gs) @ 0 \<up> (length gs - n) @ 0 # 0 \<up> length xs @ anything)
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   717
              [ft + n := (xs @ rec_exec (gs ! n) xs # 0 \<up> (ft - Suc (length xs)) @ map (\<lambda>i. rec_exec i xs) (take n gs) @ 
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   718
              0 \<up> (length gs - n) @ 0 # 0 \<up> length xs @ anything) ! ga +
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   719
              (xs @ rec_exec (gs ! n) xs # 0 \<up> (ft - Suc (length xs)) @ 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   720
              map (\<lambda>i. rec_exec i xs) (take n gs) @ 0 \<up> (length gs - n) @ 0 # 0 \<up> length xs @ anything) !
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   721
                      (ft + n),  ga := 0]}"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   722
              using a c d e h
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   723
              apply(rule_tac mv_box_correct)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   724
              apply(simp, arith, arith)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   725
              done
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   726
            moreover have "(xs @ rec_exec (gs ! n) xs # 0 \<up> (ft - Suc (length xs)) @
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   727
              map (\<lambda>i. rec_exec i xs) (take n gs) @ 0 \<up> (length gs - n) @ 0 # 0 \<up> length xs @ anything)
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   728
              [ft + n := (xs @ rec_exec (gs ! n) xs # 0 \<up> (ft - Suc (length xs)) @ map (\<lambda>i. rec_exec i xs) (take n gs) @ 
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   729
              0 \<up> (length gs - n) @ 0 # 0 \<up> length xs @ anything) ! ga +
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   730
              (xs @ rec_exec (gs ! n) xs # 0 \<up> (ft - Suc (length xs)) @ 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   731
              map (\<lambda>i. rec_exec i xs) (take n gs) @ 0 \<up> (length gs - n) @ 0 # 0 \<up> length xs @ anything) !
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   732
                      (ft + n),  ga := 0]= 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   733
              xs @ 0 \<up> (ft - length xs) @ map (\<lambda>i. rec_exec i xs) (take n gs) @ rec_exec (gs ! n) xs # 0 \<up> (length gs - Suc n) @ 0 # 0 \<up> length xs @ anything"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   734
              using a c d e h
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   735
              by(simp add: list_update_append nth_append length_replicate split: if_splits del: list_update.simps(2), auto)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   736
            ultimately show "?thesis"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   737
              by(simp)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   738
          qed
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   739
        qed  
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   740
      qed
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   741
      ultimately show 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   742
        "{\<lambda>nl. nl = xs @ 0 # 0 \<up> (ft + length gs) @ anything}
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   743
        cn_merge_gs (map rec_ci (take n gs)) ft [+] (case rec_ci (gs ! n) of (gprog, gpara, gn) \<Rightarrow>
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   744
        gprog [+] mv_box gpara (ft + min (length gs) n))
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   745
        {\<lambda>nl. nl = xs @ 0 \<up> (ft - length xs) @ map (\<lambda>i. rec_exec i xs) (take n gs) @ rec_exec (gs ! n) xs # 0 \<up> (length gs - Suc n) @ 0 # 0 \<up> length xs @ anything}"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   746
        by simp
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   747
    qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   748
  next
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   749
    case False
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   750
    have h: "\<not> n < length gs" by fact
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   751
    hence ind': 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   752
      "{\<lambda>nl. nl = xs @ 0 # 0 \<up> (ft + length gs) @ anything} cn_merge_gs (map rec_ci gs) ft
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   753
        {\<lambda>nl. nl = xs @ 0 \<up> (ft - length xs) @ map (\<lambda>i. rec_exec i xs) gs @ 0 \<up> Suc (length xs) @ anything}"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   754
      using ind
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   755
      by simp
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   756
    thus "?thesis"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   757
      using h
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   758
      by(simp)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   759
  qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   760
qed
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   761
    
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   762
lemma compile_cn_gs_correct:
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   763
  assumes
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   764
  g_cond: "\<forall>g\<in>set gs. terminate g xs \<and>
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   765
  (\<forall>x xa xb. rec_ci g = (x, xa, xb) \<longrightarrow> (\<forall>xc. {\<lambda>nl. nl = xs @ 0 \<up> (xb - xa) @ xc} x {\<lambda>nl. nl = xs @ rec_exec g xs # 0 \<up> (xb - Suc xa) @ xc}))"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   766
  and ft: "ft = max (Suc (length xs)) (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs)))"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   767
  shows 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   768
  "{\<lambda>nl. nl = xs @ 0 # 0 \<up> (ft + length gs) @ anything}
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   769
    cn_merge_gs (map rec_ci gs) ft
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   770
  {\<lambda>nl. nl = xs @ 0 \<up> (ft - length xs) @
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   771
                    map (\<lambda>i. rec_exec i xs) gs @ 0 \<up> Suc (length xs) @ anything}"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   772
using assms
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   773
using compile_cn_gs_correct'[of "length gs" gs xs ft ffp anything ]
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   774
apply(auto)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   775
done
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   776
  
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   777
lemma length_mvboxes[simp]: "length (mv_boxes aa ba n) = 3*n"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   778
by(induct n, auto simp: mv_boxes.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   779
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   780
lemma exp_suc: "a\<up>Suc b = a\<up>b @ [a]"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   781
by(simp add: exp_ind del: replicate.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   782
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: 285
diff changeset
   783
lemma last_0[simp]: 
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   784
  "\<lbrakk>Suc n \<le> ba - aa;  length lm2 = Suc n;
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   785
    length lm3 = ba - Suc (aa + n)\<rbrakk>
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   786
  \<Longrightarrow> (last lm2 # lm3 @ butlast lm2 @ 0 # lm4) ! (ba - aa) = (0::nat)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   787
proof -
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   788
  assume h: "Suc n \<le> ba - aa"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   789
  and g: "length lm2 = Suc n" "length lm3 = ba - Suc (aa + n)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   790
  from h and g have k: "ba - aa = Suc (length lm3 + n)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   791
    by arith
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   792
  from  k show 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   793
    "(last lm2 # lm3 @ butlast lm2 @ 0 # lm4) ! (ba - aa) = 0"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   794
    apply(simp, insert g)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   795
    apply(simp add: nth_append)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   796
    done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   797
qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   798
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: 285
diff changeset
   799
lemma butlast_last[simp]: "length lm1 = aa \<Longrightarrow>
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   800
      (lm1 @ 0\<up>n @ last lm2 # lm3 @ butlast lm2 @ 0 # lm4) ! (aa + n) = last lm2"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   801
apply(simp add: nth_append)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   802
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   803
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: 285
diff changeset
   804
lemma arith_as_simp[simp]: "\<lbrakk>Suc n \<le> ba - aa; aa < ba\<rbrakk> \<Longrightarrow> 
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   805
                    (ba < Suc (aa + (ba - Suc (aa + n) + n))) = False"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   806
apply arith
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   807
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   808
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: 285
diff changeset
   809
lemma butlast_elem[simp]: "\<lbrakk>Suc n \<le> ba - aa; aa < ba; length lm1 = aa; 
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   810
       length lm2 = Suc n; length lm3 = ba - Suc (aa + n)\<rbrakk>
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   811
     \<Longrightarrow> (lm1 @ 0\<up>n @ last lm2 # lm3 @ butlast lm2 @ 0 # lm4) ! (ba + n) = 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: 285
diff changeset
   812
using nth_append[of "lm1 @ (0::'a)\<up>n @ last lm2 # lm3 @ butlast lm2" 
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 285
diff changeset
   813
                     "(0::'a) # lm4" "ba + n"]
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   814
apply(simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   815
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   816
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: 285
diff changeset
   817
lemma update_butlast_eq0[simp]: 
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   818
 "\<lbrakk>Suc n \<le> ba - aa; aa < ba; length lm1 = aa; length lm2 = Suc n;
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   819
                 length lm3 = ba - Suc (aa + n)\<rbrakk>
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   820
  \<Longrightarrow> (lm1 @ 0\<up>n @ last lm2 # lm3 @ butlast lm2 @ (0::nat) # lm4)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   821
  [ba + n := last lm2, aa + n := 0] = 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   822
  lm1 @ 0 # 0\<up>n @ lm3 @ lm2 @ lm4"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   823
using list_update_append[of "lm1 @ 0\<up>n @ last lm2 # lm3 @ butlast lm2" "0 # lm4" 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   824
                            "ba + n" "last lm2"]
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: 285
diff changeset
   825
apply(simp add: list_update_append list_update.simps(2-) replicate_Suc_iff_anywhere exp_suc
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 285
diff changeset
   826
           del: replicate_Suc)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   827
apply(case_tac lm2, simp, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   828
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   829
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: 285
diff changeset
   830
lemma update_butlast_eq1[simp]:
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   831
  "\<lbrakk>Suc (length lm1 + n) \<le> ba; length lm2 = Suc n; length lm3 = ba - Suc (length lm1 + n); 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   832
  \<not> ba - Suc (length lm1) < ba - Suc (length lm1 + n); \<not> ba + n - length lm1 < n\<rbrakk>
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   833
    \<Longrightarrow> (0::nat) \<up> n @ (last lm2 # lm3 @ butlast lm2 @ 0 # lm4)[ba - length lm1 := last lm2, 0 := 0] =
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   834
  0 # 0 \<up> n @ lm3 @ lm2 @ lm4"
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: 285
diff changeset
   835
apply(subgoal_tac "ba - length lm1 = Suc n + length lm3", simp add: list_update.simps(2-) list_update_append)
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   836
apply(simp add: replicate_Suc_iff_anywhere exp_suc del: replicate_Suc)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   837
apply(case_tac lm2, simp, simp)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   838
apply(auto)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   839
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   840
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   841
lemma mv_boxes_correct: 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   842
  "\<lbrakk>aa + n \<le> ba; ba > aa; length lm1 = aa; length lm2 = n; length lm3 = ba - aa - n\<rbrakk>
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   843
 \<Longrightarrow> {\<lambda> nl. nl = lm1 @ lm2 @ lm3 @ 0\<up>n @ lm4} (mv_boxes aa ba n) 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   844
     {\<lambda> nl. nl = lm1 @ 0\<up>n @ lm3 @ lm2 @ lm4}"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   845
proof(induct n arbitrary: lm2 lm3 lm4)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   846
  case 0
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   847
  thus "?case"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   848
    by(simp add: mv_boxes.simps abc_Hoare_halt_def, rule_tac  x = 0 in exI, simp add: abc_steps_l.simps)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   849
next
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   850
  case (Suc n)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   851
  have ind: 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   852
    "\<And>lm2 lm3 lm4.
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   853
    \<lbrakk>aa + n \<le> ba; aa < ba; length lm1 = aa; length lm2 = n; length lm3 = ba - aa - n\<rbrakk>
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   854
    \<Longrightarrow> {\<lambda>nl. nl = lm1 @ lm2 @ lm3 @ 0 \<up> n @ lm4} mv_boxes aa ba n {\<lambda>nl. nl = lm1 @ 0 \<up> n @ lm3 @ lm2 @ lm4}"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   855
    by fact
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   856
  have h1: "aa + Suc n \<le> ba"  by fact
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   857
  have h2: "aa < ba" by fact
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   858
  have h3: "length lm1 = aa" by fact
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   859
  have h4: "length lm2 = Suc n" by fact 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   860
  have h5: "length lm3 = ba - aa - Suc n" by fact
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   861
  have "{\<lambda>nl. nl = lm1 @ lm2 @ lm3 @ 0 \<up> Suc n @ lm4} mv_boxes aa ba n [+] mv_box (aa + n) (ba + n)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   862
    {\<lambda>nl. nl = lm1 @ 0 \<up> Suc n @ lm3 @ lm2 @ lm4}"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   863
  proof(rule_tac abc_Hoare_plus_halt)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   864
    have "{\<lambda>nl. nl = lm1 @ butlast lm2 @ (last lm2 # lm3) @ 0 \<up> n @ (0 # lm4)} mv_boxes aa ba n
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   865
          {\<lambda> nl. nl = lm1 @ 0\<up>n @ (last lm2 # lm3) @ butlast lm2 @ (0 # lm4)}"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   866
      using h1 h2 h3 h4 h5
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   867
      by(rule_tac ind, simp_all)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   868
    moreover have " lm1 @ butlast lm2 @ (last lm2 # lm3) @ 0 \<up> n @ (0 # lm4)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   869
                  = lm1 @ lm2 @ lm3 @ 0 \<up> Suc n @ lm4"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   870
      using h4
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   871
      by(simp add: replicate_Suc[THEN sym] exp_suc del: replicate_Suc, 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   872
            case_tac lm2, simp_all)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   873
    ultimately show "{\<lambda>nl. nl = lm1 @ lm2 @ lm3 @ 0 \<up> Suc n @ lm4} mv_boxes aa ba n
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   874
          {\<lambda> nl. nl = lm1 @ 0\<up>n @ last lm2 # lm3 @ butlast lm2 @ 0 # lm4}"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   875
      by (metis append_Cons)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   876
  next
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   877
    let ?lm = "lm1 @ 0 \<up> n @ last lm2 # lm3 @ butlast lm2 @ 0 # lm4"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   878
    have "{\<lambda>nl. nl = ?lm} mv_box (aa + n) (ba + n)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   879
          {\<lambda> nl. nl = ?lm[(ba + n) := ?lm!(aa+n) + ?lm!(ba+n), (aa+n):=0]}"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   880
      using h1 h2 h3 h4  h5
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   881
      by(rule_tac mv_box_correct, simp_all)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   882
    moreover have "?lm[(ba + n) := ?lm!(aa+n) + ?lm!(ba+n), (aa+n):=0]
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   883
                 =  lm1 @ 0 \<up> Suc n @ lm3 @ lm2 @ lm4"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   884
      using h1 h2 h3 h4 h5
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   885
      by(auto simp: nth_append list_update_append split: if_splits)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   886
    ultimately show "{\<lambda>nl. nl = lm1 @ 0 \<up> n @ last lm2 # lm3 @ butlast lm2 @ 0 # lm4} mv_box (aa + n) (ba + n)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   887
          {\<lambda>nl. nl = lm1 @ 0 \<up> Suc n @ lm3 @ lm2 @ lm4}"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   888
     by simp
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   889
 qed
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   890
 thus "?case"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   891
   by(simp add: mv_boxes.simps)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   892
qed
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   893
    
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: 285
diff changeset
   894
lemma update_butlast_eq2[simp]:
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   895
  "\<lbrakk>Suc n \<le> aa - length lm1; length lm1 < aa; 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   896
  length lm2 = aa - Suc (length lm1 + n); 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   897
  length lm3 = Suc n; 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   898
  \<not> aa - Suc (length lm1) < aa - Suc (length lm1 + n);
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   899
  \<not> aa + n - length lm1 < n\<rbrakk>
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   900
  \<Longrightarrow> butlast lm3 @ ((0::nat) # lm2 @ 0 \<up> n @ last lm3 # lm4)[0 := last lm3, aa - length lm1 := 0] = lm3 @ lm2 @ 0 # 0 \<up> n @ lm4"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   901
  apply(subgoal_tac "aa - length lm1 = length lm2 + Suc n")
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   902
  apply(simp add: list_update.simps list_update_append)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   903
  apply(simp add: replicate_Suc[THEN sym] exp_suc del: replicate_Suc)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   904
  apply(case_tac lm3, simp, simp)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   905
  apply(auto)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   906
  done
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   907
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   908
lemma mv_boxes_correct2:
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   909
  "\<lbrakk>n \<le> aa - ba; 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   910
    ba < aa; 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   911
    length (lm1::nat list) = ba;
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   912
    length (lm2::nat list) = aa - ba - n; 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   913
    length (lm3::nat list) = n\<rbrakk>
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   914
  \<Longrightarrow>{\<lambda> nl. nl = lm1 @ 0\<up>n @ lm2 @ lm3 @ lm4}
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   915
                (mv_boxes aa ba n) 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   916
     {\<lambda> nl. nl = lm1 @ lm3 @ lm2 @ 0\<up>n @ lm4}"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   917
proof(induct n arbitrary: lm2 lm3 lm4)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   918
  case 0
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   919
  thus "?case"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   920
    by(simp add: mv_boxes.simps abc_Hoare_halt_def, rule_tac  x = 0 in exI, simp add: abc_steps_l.simps)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   921
next
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   922
  case (Suc n)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   923
  have ind:
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   924
    "\<And>lm2 lm3 lm4.
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   925
    \<lbrakk>n \<le> aa - ba; ba < aa; length lm1 = ba; length lm2 = aa - ba - n; length lm3 = n\<rbrakk>
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   926
    \<Longrightarrow> {\<lambda>nl. nl = lm1 @ 0 \<up> n @ lm2 @ lm3 @ lm4} mv_boxes aa ba n {\<lambda>nl. nl = lm1 @ lm3 @ lm2 @ 0 \<up> n @ lm4}"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   927
    by fact
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   928
  have h1: "Suc n \<le> aa - ba" by fact
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   929
  have h2: "ba < aa" by fact
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   930
  have h3: "length lm1 = ba" by fact 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   931
  have h4: "length lm2 = aa - ba - Suc n" by fact
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   932
  have h5: "length lm3 = Suc n" by fact
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   933
  have "{\<lambda>nl. nl = lm1 @ 0 \<up> Suc n @ lm2 @ lm3 @ lm4}  mv_boxes aa ba n [+] mv_box (aa + n) (ba + n) 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   934
    {\<lambda>nl. nl = lm1 @ lm3 @ lm2 @ 0 \<up> Suc n @ lm4}"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   935
  proof(rule_tac abc_Hoare_plus_halt)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   936
    have "{\<lambda> nl. nl = lm1 @ 0 \<up> n @ (0 # lm2) @ (butlast lm3) @ (last lm3 # lm4)} mv_boxes aa ba n
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   937
           {\<lambda> nl. nl = lm1 @ butlast lm3 @ (0 # lm2) @ 0\<up>n @ (last lm3 # lm4)}"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   938
      using h1 h2 h3 h4 h5
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   939
      by(rule_tac ind, simp_all)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   940
    moreover have "lm1 @ 0 \<up> n @ (0 # lm2) @ (butlast lm3) @ (last lm3 # lm4) 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   941
                   = lm1 @ 0 \<up> Suc n @ lm2 @ lm3 @ lm4"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   942
      using h5
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   943
     by(simp add: replicate_Suc_iff_anywhere exp_suc 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   944
        del: replicate_Suc, case_tac lm3, simp_all)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   945
   ultimately show "{\<lambda>nl. nl = lm1 @ 0 \<up> Suc n @ lm2 @ lm3 @ lm4} mv_boxes aa ba n
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   946
     {\<lambda> nl. nl = lm1 @ butlast lm3 @ (0 # lm2) @ 0\<up>n @ (last lm3 # lm4)}"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   947
     by metis
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   948
 next
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   949
   thm mv_box_correct
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   950
   let ?lm = "lm1 @ butlast lm3 @ (0 # lm2) @ 0 \<up> n @ last lm3 # lm4"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   951
   have "{\<lambda>nl. nl = ?lm} mv_box (aa + n) (ba + n)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   952
         {\<lambda>nl. nl = ?lm[ba+n := ?lm!(aa+n)+?lm!(ba+n), (aa+n):=0]}"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   953
     using h1 h2 h3 h4 h5
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   954
     by(rule_tac mv_box_correct, simp_all)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   955
   moreover have "?lm[ba+n := ?lm!(aa+n)+?lm!(ba+n), (aa+n):=0]
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   956
               = lm1 @ lm3 @ lm2 @ 0 \<up> Suc n @ lm4"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   957
     using h1 h2 h3 h4 h5
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   958
     by(auto simp: nth_append list_update_append split: if_splits)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   959
   ultimately show "{\<lambda>nl. nl = lm1 @ butlast lm3 @ (0 # lm2) @ 0 \<up> n @ last lm3 # lm4} mv_box (aa + n) (ba + n)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   960
     {\<lambda>nl. nl = lm1 @ lm3 @ lm2 @ 0 \<up> Suc n @ lm4}"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   961
     by simp
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   962
 qed
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   963
 thus "?case"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   964
   by(simp add: mv_boxes.simps)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   965
qed    
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   966
     
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   967
lemma save_paras: 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   968
  "{\<lambda>nl. nl = xs @ 0 \<up> (max (Suc (length xs)) (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs))) - length xs) @
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   969
  map (\<lambda>i. rec_exec i xs) gs @ 0 \<up> Suc (length xs) @ anything}
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   970
  mv_boxes 0 (Suc (max (Suc (length xs)) (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs))) + length gs)) (length xs)
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   971
  {\<lambda>nl. nl = 0 \<up> max (Suc (length xs)) (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs))) @ map (\<lambda>i. rec_exec i xs) gs @ 0 # xs @ anything}"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   972
proof -
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   973
  let ?ft = "max (Suc (length xs)) (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs)))"
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   974
  have "{\<lambda>nl. nl = [] @ xs @ (0\<up>(?ft - length xs) @  map (\<lambda>i. rec_exec i xs) gs @ [0]) @ 
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   975
          0 \<up> (length xs) @ anything} mv_boxes 0 (Suc ?ft + length gs) (length xs) 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   976
        {\<lambda>nl. nl = [] @ 0 \<up> (length xs) @ (0\<up>(?ft - length xs) @  map (\<lambda>i. rec_exec i xs) gs @ [0]) @ xs @ anything}"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   977
    by(rule_tac mv_boxes_correct, auto)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   978
  thus "?thesis"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   979
    by(simp add: replicate_merge_anywhere)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   980
qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   981
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: 285
diff changeset
   982
lemma length_le_max_insert_rec_ci[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: 285
diff changeset
   983
  "length gs \<le> ffp \<Longrightarrow> length gs \<le> max x1 (Max (insert ffp (x2 ` x3 ` set gs)))"
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 285
diff changeset
   984
 apply(rule_tac max.coboundedI2)
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   985
 apply(simp add: Max_ge_iff)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   986
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   987
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   988
lemma restore_new_paras:
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   989
  "ffp \<ge> length gs 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   990
 \<Longrightarrow> {\<lambda>nl. nl = 0 \<up> max (Suc (length xs)) (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs))) @ map (\<lambda>i. rec_exec i xs) gs @ 0 # xs @ anything}
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   991
    mv_boxes (max (Suc (length xs)) (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs)))) 0 (length gs)
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   992
  {\<lambda>nl. nl = map (\<lambda>i. rec_exec i xs) gs @ 0 \<up> max (Suc (length xs)) (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs))) @ 0 # xs @ anything}"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   993
proof -
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   994
  let ?ft = "max (Suc (length xs)) (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs)))"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   995
  assume j: "ffp \<ge> length gs"
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   996
  hence "{\<lambda> nl. nl = [] @ 0\<up>length gs @ 0\<up>(?ft - length gs) @  map (\<lambda>i. rec_exec i xs) gs @ ((0 # xs) @ anything)}
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   997
       mv_boxes ?ft 0 (length gs)
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
   998
        {\<lambda> nl. nl = [] @ map (\<lambda>i. rec_exec i xs) gs @ 0\<up>(?ft - length gs) @ 0\<up>length gs @ ((0 # xs) @ anything)}"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
   999
    by(rule_tac mv_boxes_correct2, auto)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1000
  moreover have "?ft \<ge> length gs"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1001
    using j
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1002
    by(auto)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1003
  ultimately show "?thesis"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1004
    using j
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1005
    by(simp add: replicate_merge_anywhere le_add_diff_inverse)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1006
qed
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1007
   
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: 285
diff changeset
  1008
lemma le_max_insert[intro]: "ffp \<le> max x0 (Max (insert ffp (x1 ` x2 ` set gs)))"
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 285
diff changeset
  1009
  by (rule max.coboundedI2) auto
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1010
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1011
declare max_less_iff_conj[simp del]
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1012
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1013
lemma save_rs:
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1014
  "\<lbrakk>far = length gs;
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1015
  ffp \<le> max (Suc (length xs)) (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs)));
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1016
  far < ffp\<rbrakk>
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1017
\<Longrightarrow>  {\<lambda>nl. nl = map (\<lambda>i. rec_exec i xs) gs @
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1018
  rec_exec (Cn (length xs) f gs) xs # 0 \<up> max (Suc (length xs))
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1019
  (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs))) @ xs @ anything}
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1020
    mv_box far (max (Suc (length xs)) (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs))))
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1021
    {\<lambda>nl. nl = map (\<lambda>i. rec_exec i xs) gs @
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1022
               0 \<up> (max (Suc (length xs)) (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs))) - length gs) @
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1023
               rec_exec (Cn (length xs) f gs) xs # 0 \<up> length gs @ xs @ anything}"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1024
proof -
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1025
  let ?ft = "max (Suc (length xs)) (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs)))"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1026
  thm mv_box_correct
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1027
  let ?lm= " map (\<lambda>i. rec_exec i xs) gs @ rec_exec (Cn (length xs) f gs) xs # 0 \<up> ?ft @ xs @ anything"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1028
  assume h: "far = length gs" "ffp \<le> ?ft" "far < ffp"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1029
  hence "{\<lambda> nl. nl = ?lm} mv_box far ?ft {\<lambda> nl. nl = ?lm[?ft := ?lm!far + ?lm!?ft, far := 0]}"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1030
    apply(rule_tac mv_box_correct)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1031
    by(case_tac "rec_ci a", auto)  
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1032
  moreover have "?lm[?ft := ?lm!far + ?lm!?ft, far := 0]
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1033
    = map (\<lambda>i. rec_exec i xs) gs @
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1034
    0 \<up> (?ft - length gs) @
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1035
    rec_exec (Cn (length xs) f gs) xs # 0 \<up> length gs @ xs @ anything"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1036
    using h
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1037
    apply(simp add: nth_append)
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1038
    using list_update_length[of "map (\<lambda>i. rec_exec i xs) gs @ rec_exec (Cn (length xs) f gs) xs #
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1039
       0 \<up> (?ft - Suc (length gs))" 0 "0 \<up> length gs @ xs @ anything" "rec_exec (Cn (length xs) f gs) xs"]
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1040
    apply(simp add: replicate_merge_anywhere replicate_Suc_iff_anywhere del: replicate_Suc)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1041
    by(simp add: list_update_append list_update.simps replicate_Suc_iff_anywhere del: replicate_Suc)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1042
  ultimately show "?thesis"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1043
    by(simp)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1044
qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1045
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: 285
diff changeset
  1046
lemma length_empty_boxes[simp]: "length (empty_boxes n) = 2*n"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1047
apply(induct n, simp, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1048
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1049
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1050
lemma empty_one_box_correct:
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1051
  "{\<lambda>nl. nl = 0 \<up> n @ x # lm} [Dec n 2, Goto 0] {\<lambda>nl. nl = 0 # 0 \<up> n @ lm}"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1052
proof(induct x)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1053
  case 0
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1054
  thus "?case"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1055
    by(simp add: abc_Hoare_halt_def, 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1056
          rule_tac x = 1 in exI, simp add: abc_steps_l.simps 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1057
          abc_step_l.simps abc_fetch.simps abc_lm_v.simps nth_append abc_lm_s.simps
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1058
          replicate_Suc[THEN sym] exp_suc del: replicate_Suc)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1059
next
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1060
  case (Suc x)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1061
  have "{\<lambda>nl. nl = 0 \<up> n @ x # lm} [Dec n 2, Goto 0] {\<lambda>nl. nl = 0 # 0 \<up> n @ lm}"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1062
    by fact
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1063
  then obtain stp where "abc_steps_l (0, 0 \<up> n @ x # lm) [Dec n 2, Goto 0] stp
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1064
                      = (Suc (Suc 0), 0 # 0 \<up> n @ lm)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1065
    apply(auto simp: abc_Hoare_halt_def)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1066
    by(case_tac "abc_steps_l (0, 0 \<up> n @ x # lm) [Dec n 2, Goto 0] na", simp)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1067
  moreover have "abc_steps_l (0, 0\<up>n @ Suc x # lm) [Dec n 2, Goto 0] (Suc (Suc 0)) 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1068
        = (0,  0 \<up> n @ x # lm)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1069
    by(auto simp: abc_steps_l.simps abc_step_l.simps abc_fetch.simps abc_lm_v.simps
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1070
      nth_append abc_lm_s.simps list_update.simps list_update_append)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1071
  ultimately have "abc_steps_l (0, 0\<up>n @ Suc x # lm) [Dec n 2, Goto 0] (Suc (Suc 0) + stp) 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1072
                = (Suc (Suc 0), 0 # 0\<up>n @ lm)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1073
    by(simp only: abc_steps_add)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1074
  thus "?case"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1075
    apply(simp add: abc_Hoare_halt_def)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1076
    apply(rule_tac x = "Suc (Suc stp)" in exI, simp)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1077
    done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1078
qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1079
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1080
lemma empty_boxes_correct: 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1081
  "length lm \<ge> n \<Longrightarrow>
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1082
  {\<lambda> nl. nl = lm} empty_boxes n {\<lambda> nl. nl = 0\<up>n @ drop n lm}"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1083
proof(induct n)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1084
  case 0
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1085
  thus "?case"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1086
    by(simp add: empty_boxes.simps abc_Hoare_halt_def, 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1087
          rule_tac x = 0 in exI, simp add: abc_steps_l.simps)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1088
next
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1089
  case (Suc n)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1090
  have ind: "n \<le> length lm \<Longrightarrow> {\<lambda>nl. nl = lm} empty_boxes n {\<lambda>nl. nl = 0 \<up> n @ drop n lm}" by fact
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1091
  have h: "Suc n \<le> length lm" by fact
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1092
  have "{\<lambda>nl. nl = lm} empty_boxes n [+] [Dec n 2, Goto 0] {\<lambda>nl. nl = 0 # 0 \<up> n @ drop (Suc n) lm}"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1093
  proof(rule_tac abc_Hoare_plus_halt)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1094
    show "{\<lambda>nl. nl = lm} empty_boxes n {\<lambda>nl. nl = 0 \<up> n @ drop n lm}"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1095
      using h
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1096
      by(rule_tac ind, simp)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1097
  next
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1098
    show "{\<lambda>nl. nl = 0 \<up> n @ drop n lm} [Dec n 2, Goto 0] {\<lambda>nl. nl = 0 # 0 \<up> n @ drop (Suc n) lm}"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1099
      using empty_one_box_correct[of n "lm ! n" "drop (Suc n) lm"]
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1100
      using h
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: 285
diff changeset
  1101
      by(simp add: Cons_nth_drop_Suc)
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1102
  qed
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1103
  thus "?case"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1104
    by(simp add: empty_boxes.simps)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1105
qed
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1106
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: 285
diff changeset
  1107
lemma insert_dominated[simp]: "length gs \<le> ffp \<Longrightarrow>
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 285
diff changeset
  1108
    length gs + (max xs (Max (insert ffp (x1 ` x2 ` set gs))) - length gs) =
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 285
diff changeset
  1109
    max xs (Max (insert ffp (x1 ` x2 ` set gs)))"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1110
apply(rule_tac le_add_diff_inverse)
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: 285
diff changeset
  1111
apply(rule_tac max.coboundedI2)
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1112
apply(simp add: Max_ge_iff)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1113
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1114
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1115
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1116
lemma clean_paras: 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1117
  "ffp \<ge> length gs \<Longrightarrow>
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1118
  {\<lambda>nl. nl = map (\<lambda>i. rec_exec i xs) gs @
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1119
  0 \<up> (max (Suc (length xs)) (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs))) - length gs) @
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1120
  rec_exec (Cn (length xs) f gs) xs # 0 \<up> length gs @ xs @ anything}
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1121
  empty_boxes (length gs)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1122
  {\<lambda>nl. nl = 0 \<up> max (Suc (length xs)) (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs))) @ 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1123
  rec_exec (Cn (length xs) f gs) xs # 0 \<up> length gs @ xs @ anything}"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1124
proof-
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1125
  let ?ft = "max (Suc (length xs)) (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs)))"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1126
  assume h: "length gs \<le> ffp"
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1127
  let ?lm = "map (\<lambda>i. rec_exec i xs) gs @ 0 \<up> (?ft - length gs) @
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1128
    rec_exec (Cn (length xs) f gs) xs # 0 \<up> length gs @ xs @ anything"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1129
  have "{\<lambda> nl. nl = ?lm} empty_boxes (length gs) {\<lambda> nl. nl = 0\<up>length gs @ drop (length gs) ?lm}"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1130
    by(rule_tac empty_boxes_correct, simp)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1131
  moreover have "0\<up>length gs @ drop (length gs) ?lm 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1132
           =  0 \<up> ?ft @  rec_exec (Cn (length xs) f gs) xs # 0 \<up> length gs @ xs @ anything"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1133
    using h
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1134
    by(simp add: replicate_merge_anywhere)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1135
  ultimately show "?thesis"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1136
    by metis
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1137
qed
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1138
 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1139
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1140
lemma restore_rs:
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1141
  "{\<lambda>nl. nl = 0 \<up> max (Suc (length xs)) (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs))) @ 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1142
  rec_exec (Cn (length xs) f gs) xs # 0 \<up> length gs @ xs @ anything}
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1143
  mv_box (max (Suc (length xs)) (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs)))) (length xs)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1144
  {\<lambda>nl. nl = 0 \<up> length xs @
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1145
  rec_exec (Cn (length xs) f gs) xs #
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1146
  0 \<up> (max (Suc (length xs)) (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs))) - (length xs)) @
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1147
  0 \<up> length gs @ xs @ anything}"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1148
proof -
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1149
  let ?ft = "max (Suc (length xs)) (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs)))"
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1150
  let ?lm = "0\<up>(length xs) @  0\<up>(?ft - (length xs)) @ rec_exec (Cn (length xs) f gs) xs # 0 \<up> length gs @ xs @ anything"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1151
  thm mv_box_correct
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1152
  have "{\<lambda> nl. nl = ?lm} mv_box ?ft (length xs) {\<lambda> nl. nl = ?lm[length xs := ?lm!?ft + ?lm!(length xs), ?ft := 0]}"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1153
    by(rule_tac mv_box_correct, simp, simp)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1154
  moreover have "?lm[length xs := ?lm!?ft + ?lm!(length xs), ?ft := 0]
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1155
               =  0 \<up> length xs @ rec_exec (Cn (length xs) f gs) xs # 0 \<up> (?ft - (length xs)) @ 0 \<up> length gs @ xs @ anything"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1156
    apply(auto simp: list_update_append nth_append)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1157
    apply(case_tac ?ft, simp_all add: Suc_diff_le list_update.simps)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1158
    apply(simp add: exp_suc replicate_Suc[THEN sym] del: replicate_Suc)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1159
    done
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1160
  ultimately show "?thesis"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1161
    by(simp add: replicate_merge_anywhere)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1162
qed
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1163
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1164
lemma restore_orgin_paras:
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1165
  "{\<lambda>nl. nl = 0 \<up> length xs @
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1166
  rec_exec (Cn (length xs) f gs) xs #
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1167
  0 \<up> (max (Suc (length xs)) (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs))) - length xs) @ 0 \<up> length gs @ xs @ anything}
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1168
  mv_boxes (Suc (max (Suc (length xs)) (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs))) + length gs)) 0 (length xs)
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1169
  {\<lambda>nl. nl = xs @ rec_exec (Cn (length xs) f gs) xs # 0 \<up> 
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1170
  (max (Suc (length xs)) (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs))) + length gs) @ anything}"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1171
proof -
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1172
  let ?ft = "max (Suc (length xs)) (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs)))"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1173
  thm mv_boxes_correct2
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1174
  have "{\<lambda> nl. nl = [] @ 0\<up>(length xs) @ (rec_exec (Cn (length xs) f gs) xs # 0 \<up> (?ft - length xs) @ 0 \<up> length gs) @ xs @ anything}
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1175
        mv_boxes (Suc ?ft + length gs) 0 (length xs)
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1176
        {\<lambda> nl. nl = [] @ xs @ (rec_exec (Cn (length xs) f gs) xs # 0 \<up> (?ft - length xs) @ 0 \<up> length gs) @ 0\<up>length xs @ anything}"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1177
    by(rule_tac mv_boxes_correct2, auto)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1178
  thus "?thesis"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1179
    by(simp add: replicate_merge_anywhere)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1180
qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1181
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1182
lemma compile_cn_correct':
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1183
  assumes f_ind: 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1184
  "\<And> anything r. rec_exec f (map (\<lambda>g. rec_exec g xs) gs) = rec_exec (Cn (length xs) f gs) xs \<Longrightarrow>
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1185
  {\<lambda>nl. nl = map (\<lambda>g. rec_exec g xs) gs @ 0 \<up> (ffp - far) @ anything} fap
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1186
                {\<lambda>nl. nl = map (\<lambda>g. rec_exec g xs) gs @ rec_exec (Cn (length xs) f gs) xs # 0 \<up> (ffp - Suc far) @ anything}"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1187
  and compile: "rec_ci f = (fap, far, ffp)"
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1188
  and term_f: "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
  1189
  and g_cond: "\<forall>g\<in>set gs. terminate g xs \<and>
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1190
  (\<forall>x xa xb. rec_ci g = (x, xa, xb) \<longrightarrow> 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1191
  (\<forall>xc. {\<lambda>nl. nl = xs @ 0 \<up> (xb - xa) @ xc} x {\<lambda>nl. nl = xs @ rec_exec g xs # 0 \<up> (xb - Suc xa) @ xc}))"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1192
  shows 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1193
  "{\<lambda>nl. nl = xs @ 0 # 0 \<up> (max (Suc (length xs)) (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs))) + length gs) @ anything}
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1194
  cn_merge_gs (map rec_ci gs) (max (Suc (length xs)) (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs)))) [+]
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1195
  (mv_boxes 0 (Suc (max (Suc (length xs)) (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs))) + length gs)) (length xs) [+]
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1196
  (mv_boxes (max (Suc (length xs)) (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs)))) 0 (length gs) [+]
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1197
  (fap [+] (mv_box far (max (Suc (length xs)) (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs)))) [+]
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1198
  (empty_boxes (length gs) [+]
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1199
  (mv_box (max (Suc (length xs)) (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs)))) (length xs) [+]
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1200
  mv_boxes (Suc (max (Suc (length xs)) (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs))) + length gs)) 0 (length xs)))))))
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1201
  {\<lambda>nl. nl = xs @ rec_exec (Cn (length xs) f gs) xs # 
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1202
0 \<up> (max (Suc (length xs)) (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs))) + length gs) @ anything}"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1203
proof -
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1204
  let ?ft = "max (Suc (length xs)) (Max (insert ffp ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs)))"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1205
  let ?A = "cn_merge_gs (map rec_ci gs) ?ft"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1206
  let ?B = "mv_boxes 0 (Suc (?ft+length gs)) (length xs)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1207
  let ?C = "mv_boxes ?ft 0 (length gs)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1208
  let ?D = fap
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1209
  let ?E = "mv_box far ?ft"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1210
  let ?F = "empty_boxes (length gs)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1211
  let ?G = "mv_box ?ft (length xs)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1212
  let ?H = "mv_boxes (Suc (?ft + length gs)) 0 (length xs)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1213
  let ?P1 = "\<lambda>nl. nl = xs @ 0 # 0 \<up> (?ft + length gs) @ anything"
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1214
  let ?S = "\<lambda>nl. nl = xs @ rec_exec (Cn (length xs) f gs) xs # 0 \<up> (?ft + length gs) @ anything"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1215
  let ?Q1 = "\<lambda> nl. nl = xs @ 0\<up>(?ft - length xs) @ map (\<lambda> i. rec_exec i xs) gs @ 0\<up>(Suc (length xs)) @ anything"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1216
  show "{?P1} (?A [+] (?B [+] (?C [+] (?D [+] (?E [+] (?F [+] (?G [+] ?H))))))) {?S}"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1217
  proof(rule_tac abc_Hoare_plus_halt)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1218
    show "{?P1} ?A {?Q1}"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1219
      using g_cond
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1220
      by(rule_tac compile_cn_gs_correct, auto)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1221
  next
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1222
    let ?Q2 = "\<lambda>nl. nl = 0 \<up> ?ft @
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1223
                    map (\<lambda>i. rec_exec i xs) gs @ 0 # xs @ anything"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1224
    show "{?Q1} (?B [+] (?C [+] (?D [+] (?E [+] (?F [+] (?G [+] ?H)))))) {?S}"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1225
    proof(rule_tac abc_Hoare_plus_halt)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1226
      show "{?Q1} ?B {?Q2}"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1227
        by(rule_tac save_paras)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1228
    next
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1229
      let ?Q3 = "\<lambda> nl. nl = map (\<lambda>i. rec_exec i xs) gs @ 0\<up>?ft @ 0 # xs @ anything" 
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1230
      show "{?Q2} (?C [+] (?D [+] (?E [+] (?F [+] (?G [+] ?H))))) {?S}"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1231
      proof(rule_tac abc_Hoare_plus_halt)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1232
        have "ffp \<ge> length gs"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1233
          using compile term_f
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1234
          apply(subgoal_tac "length gs = far")
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1235
          apply(drule_tac footprint_ge, simp)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1236
          by(drule_tac param_pattern, auto)          
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1237
        thus "{?Q2} ?C {?Q3}"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1238
          by(erule_tac restore_new_paras)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1239
      next
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1240
        let ?Q4 = "\<lambda> nl. nl = map (\<lambda>i. rec_exec i xs) gs @ rec_exec (Cn (length xs) f gs) xs # 0\<up>?ft @ xs @ anything"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1241
        have a: "far = length gs"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1242
          using compile term_f
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1243
          by(drule_tac param_pattern, auto)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1244
        have b:"?ft \<ge> ffp"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1245
          by auto
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1246
        have c: "ffp > far"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1247
          using compile
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1248
          by(erule_tac footprint_ge)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1249
        show "{?Q3} (?D [+] (?E [+] (?F [+] (?G [+] ?H)))) {?S}"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1250
        proof(rule_tac abc_Hoare_plus_halt)
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1251
          have "{\<lambda>nl. nl = map (\<lambda>g. rec_exec g xs) gs @ 0 \<up> (ffp - far) @ 0\<up>(?ft - ffp + far) @ 0 # xs @ anything} fap
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1252
            {\<lambda>nl. nl = map (\<lambda>g. rec_exec g xs) gs @ rec_exec (Cn (length xs) f gs) xs # 
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1253
            0 \<up> (ffp - Suc far) @ 0\<up>(?ft - ffp + far) @ 0 # xs @ anything}"
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1254
            by(rule_tac f_ind, simp add: rec_exec.simps)
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1255
          thus "{?Q3} fap {?Q4}"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1256
            using a b c
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1257
            by(simp add: replicate_merge_anywhere,
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1258
               case_tac "?ft", simp_all add: exp_suc del: replicate_Suc)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1259
        next
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1260
          let ?Q5 = "\<lambda>nl. nl = map (\<lambda>i. rec_exec i xs) gs @
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1261
               0\<up>(?ft - length gs) @ rec_exec (Cn (length xs) f gs) xs # 0\<up>(length gs)@ xs @ anything"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1262
          show "{?Q4} (?E [+] (?F [+] (?G [+] ?H))) {?S}"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1263
          proof(rule_tac abc_Hoare_plus_halt)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1264
            from a b c show "{?Q4} ?E {?Q5}"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1265
              by(erule_tac save_rs, simp_all)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1266
          next
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1267
            let ?Q6 = "\<lambda>nl. nl = 0\<up>?ft @ rec_exec (Cn (length xs) f gs) xs # 0\<up>(length gs)@ xs @ anything"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1268
            show "{?Q5} (?F [+] (?G [+] ?H)) {?S}"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1269
            proof(rule_tac abc_Hoare_plus_halt)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1270
              have "length gs \<le> ffp" using a b c
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1271
                by simp
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1272
              thus "{?Q5} ?F {?Q6}"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1273
                by(erule_tac clean_paras)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1274
            next
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1275
              let ?Q7 = "\<lambda>nl. nl = 0\<up>length xs @ rec_exec (Cn (length xs) f gs) xs # 0\<up>(?ft - (length xs)) @ 0\<up>(length gs)@ xs @ anything"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1276
              show "{?Q6} (?G [+] ?H) {?S}"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1277
              proof(rule_tac abc_Hoare_plus_halt)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1278
                show "{?Q6} ?G {?Q7}"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1279
                  by(rule_tac restore_rs)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1280
              next
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1281
                show "{?Q7} ?H {?S}"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1282
                  by(rule_tac restore_orgin_paras)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1283
              qed
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1284
            qed
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1285
          qed
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1286
        qed        
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1287
      qed
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1288
    qed
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1289
  qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1290
qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1291
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1292
lemma compile_cn_correct:
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1293
  assumes termi_f: "terminate f (map (\<lambda>g. rec_exec g xs) gs)"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1294
  and f_ind: "\<And>ap arity fp anything.
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1295
  rec_ci f = (ap, arity, fp)
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1296
  \<Longrightarrow> {\<lambda>nl. nl = map (\<lambda>g. rec_exec g xs) gs @ 0 \<up> (fp - arity) @ anything} ap
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1297
  {\<lambda>nl. nl = map (\<lambda>g. rec_exec g xs) gs @ rec_exec f (map (\<lambda>g. rec_exec g xs) gs) # 0 \<up> (fp - Suc arity) @ anything}"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1298
  and g_cond: 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1299
  "\<forall>g\<in>set gs. terminate g xs \<and>
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1300
  (\<forall>x xa xb. rec_ci g = (x, xa, xb) \<longrightarrow>   (\<forall>xc. {\<lambda>nl. nl = xs @ 0 \<up> (xb - xa) @ xc} x {\<lambda>nl. nl = xs @ rec_exec g xs # 0 \<up> (xb - Suc xa) @ xc}))"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1301
  and compile: "rec_ci (Cn n f gs) = (ap, arity, fp)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1302
  and len: "length xs = n"
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1303
  shows "{\<lambda>nl. nl = xs @ 0 \<up> (fp - arity) @ anything} ap {\<lambda>nl. nl = xs @ rec_exec (Cn n f gs) xs # 0 \<up> (fp - Suc arity) @ anything}"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1304
proof(case_tac "rec_ci f")
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1305
  fix fap far ffp
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1306
  assume h: "rec_ci f = (fap, far, ffp)"
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1307
  then have f_newind: "\<And> anything .{\<lambda>nl. nl = map (\<lambda>g. rec_exec g xs) gs @ 0 \<up> (ffp - far) @ anything} fap
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1308
    {\<lambda>nl. nl = map (\<lambda>g. rec_exec g xs) gs @ rec_exec f (map (\<lambda>g. rec_exec g xs) gs) # 0 \<up> (ffp - Suc far) @ anything}"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1309
    by(rule_tac f_ind, simp_all)
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1310
  thus "{\<lambda>nl. nl = xs @ 0 \<up> (fp - arity) @ anything} ap {\<lambda>nl. nl = xs @ rec_exec (Cn n f gs) xs # 0 \<up> (fp - Suc arity) @ anything}"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1311
    using compile len h termi_f g_cond
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1312
    apply(auto simp: rec_ci.simps abc_comp_commute)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1313
    apply(rule_tac compile_cn_correct', simp_all)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1314
    done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1315
qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1316
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: 285
diff changeset
  1317
lemma mv_box_correct_simp[simp]: 
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1318
  "\<lbrakk>length xs = n; ft = max (n+3) (max fft gft)\<rbrakk> 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1319
 \<Longrightarrow> {\<lambda>nl. nl = xs @ 0 # 0 \<up> (ft - n) @ anything} mv_box n ft 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1320
       {\<lambda>nl. nl = xs @ 0 # 0 \<up> (ft - n) @ anything}"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1321
using mv_box_correct[of n ft "xs @ 0 # 0 \<up> (ft - n) @ anything"]
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1322
by(auto)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1323
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: 285
diff changeset
  1324
lemma length_under_max[simp]: "length xs < max (length xs + 3) fft"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1325
by auto
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1326
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1327
lemma save_init_rs: 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1328
  "\<lbrakk>length xs = n; ft = max (n+3) (max fft gft)\<rbrakk> 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1329
     \<Longrightarrow>  {\<lambda>nl. nl = xs @ rec_exec f xs # 0 \<up> (ft - n) @ anything} mv_box n (Suc n) 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1330
       {\<lambda>nl. nl = xs @ 0 # rec_exec f xs # 0 \<up> (ft - Suc n) @ anything}"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1331
using mv_box_correct[of n "Suc n" "xs @ rec_exec f xs # 0 \<up> (ft - n) @ anything"]
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1332
apply(auto simp: list_update_append list_update.simps nth_append split: if_splits)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1333
apply(case_tac "(max (length xs + 3) (max fft gft))", simp_all add: list_update.simps Suc_diff_le)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1334
done
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1335
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: 285
diff changeset
  1336
lemma less_then_max_plus2[simp]: "n + (2::nat) < max (n + 3) x"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1337
by auto
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1338
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: 285
diff changeset
  1339
lemma less_then_max_plus3[simp]: "n < max (n + (3::nat)) x"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1340
by auto
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1341
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: 285
diff changeset
  1342
lemma mv_box_max_plus_3_correct[simp]:
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1343
  "length xs = n \<Longrightarrow> 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1344
  {\<lambda>nl. nl = xs @ x # 0 \<up> (max (n + (3::nat)) (max fft gft) - n) @ anything} mv_box n (max (n + 3) (max fft gft))
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1345
  {\<lambda>nl. nl = xs @ 0 \<up> (max (n + 3) (max fft gft) - n) @ x # anything}"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1346
proof -
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1347
  assume h: "length xs = n"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1348
  let ?ft = "max (n+3) (max fft gft)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1349
  let ?lm = "xs @ x # 0\<up>(?ft - Suc n) @ 0 # anything"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1350
  have g: "?ft > n + 2"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1351
    by simp
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1352
  thm mv_box_correct
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1353
  have a: "{\<lambda> nl. nl = ?lm} mv_box n ?ft {\<lambda> nl. nl = ?lm[?ft := ?lm!n + ?lm!?ft, n := 0]}"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1354
    using h
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1355
    by(rule_tac mv_box_correct, auto)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1356
  have b:"?lm = xs @ x # 0 \<up> (max (n + 3) (max fft gft) - n) @ anything"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1357
    by(case_tac ?ft, simp_all add: Suc_diff_le exp_suc del: replicate_Suc)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1358
  have c: "?lm[?ft := ?lm!n + ?lm!?ft, n := 0] = xs @ 0 \<up> (max (n + 3) (max fft gft) - n) @ x # anything"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1359
    using h g
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1360
    apply(auto simp: nth_append list_update_append split: if_splits)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1361
    using list_update_append[of "x # 0 \<up> (max (length xs + 3) (max fft gft) - Suc (length xs))" "0 # anything"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1362
                                 "max (length xs + 3) (max fft gft) - length xs" "x"]
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1363
    apply(auto simp: if_splits)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1364
    apply(simp add: list_update.simps replicate_Suc[THEN sym] del: replicate_Suc)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1365
    done
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1366
  from a c show "?thesis"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1367
    using h
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1368
    apply(simp)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1369
    using b
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1370
    by simp
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1371
qed
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1372
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: 285
diff changeset
  1373
lemma max_less_suc_suc[simp]: "max n (Suc n) < Suc (Suc (max (n + 3) x + anything - Suc 0))"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1374
by arith    
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1375
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: 285
diff changeset
  1376
lemma suc_less_plus_3[simp]: "Suc n < max (n + 3) x"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1377
by arith
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1378
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: 285
diff changeset
  1379
lemma mv_box_ok_suc_simp[simp]:
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1380
  "length xs = n
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1381
 \<Longrightarrow> {\<lambda>nl. nl = xs @ rec_exec f xs # 0 \<up> (max (n + 3) (max fft gft) - Suc n) @ x # anything} mv_box n (Suc n)
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1382
    {\<lambda>nl. nl = xs @ 0 # rec_exec f xs # 0 \<up> (max (n + 3) (max fft gft) - Suc (Suc n)) @ x # anything}"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1383
using mv_box_correct[of n "Suc n" "xs @ rec_exec f xs # 0 \<up> (max (n + 3) (max fft gft) - Suc n) @ x # anything"]
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1384
apply(simp add: nth_append list_update_append list_update.simps)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1385
apply(case_tac "max (n + 3) (max fft gft)", simp_all)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1386
apply(case_tac nat, simp_all add: Suc_diff_le list_update.simps)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1387
done
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1388
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1389
lemma abc_append_frist_steps_eq_pre: 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1390
  assumes notfinal: "abc_notfinal (abc_steps_l (0, lm)  A n) A"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1391
  and notnull: "A \<noteq> []"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1392
  shows "abc_steps_l (0, lm) (A @ B) n = abc_steps_l (0, lm) A n"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1393
using notfinal
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1394
proof(induct n)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1395
  case 0
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1396
  thus "?case"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1397
    by(simp add: abc_steps_l.simps)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1398
next
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1399
  case (Suc n)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1400
  have ind: "abc_notfinal (abc_steps_l (0, lm) A n) A \<Longrightarrow> abc_steps_l (0, lm) (A @ B) n = abc_steps_l (0, lm) A n"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1401
    by fact
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1402
  have h: "abc_notfinal (abc_steps_l (0, lm) A (Suc n)) A" by fact
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1403
  then have a: "abc_notfinal (abc_steps_l (0, lm) A n) A"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1404
    by(simp add: notfinal_Suc)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1405
  then have b: "abc_steps_l (0, lm) (A @ B) n = abc_steps_l (0, lm) A n"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1406
    using ind by simp
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1407
  obtain s lm' where c: "abc_steps_l (0, lm) A n = (s, lm')"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1408
    by (metis prod.exhaust)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1409
  then have d: "s < length A \<and> abc_steps_l (0, lm) (A @ B) n = (s, lm')" 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1410
    using a b by simp
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1411
  thus "?case"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1412
    using c
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1413
    by(simp add: abc_step_red2 abc_fetch.simps abc_step_l.simps nth_append)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1414
qed
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1415
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1416
lemma abc_append_first_step_eq_pre: 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1417
  "st < length A
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1418
 \<Longrightarrow> abc_step_l (st, lm) (abc_fetch st (A @ B)) = 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1419
    abc_step_l (st, lm) (abc_fetch st A)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1420
by(simp add: abc_step_l.simps abc_fetch.simps nth_append)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1421
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1422
lemma abc_append_frist_steps_halt_eq': 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1423
  assumes final: "abc_steps_l (0, lm) A n = (length A, lm')"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1424
    and notnull: "A \<noteq> []"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1425
  shows "\<exists> n'. abc_steps_l (0, lm) (A @ B) n' = (length A, lm')"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1426
proof -
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1427
  have "\<exists> n'. abc_notfinal (abc_steps_l (0, lm) A n') A \<and> 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1428
    abc_final (abc_steps_l (0, lm) A (Suc n')) A"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1429
    using assms
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1430
    by(rule_tac n = n in abc_before_final, simp_all)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1431
  then obtain na where a:
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1432
    "abc_notfinal (abc_steps_l (0, lm) A na) A \<and> 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1433
            abc_final (abc_steps_l (0, lm) A (Suc na)) A" ..
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1434
  obtain sa lma where b: "abc_steps_l (0, lm) A na = (sa, lma)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1435
    by (metis prod.exhaust)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1436
  then have c: "abc_steps_l (0, lm) (A @ B) na = (sa, lma)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1437
    using a abc_append_frist_steps_eq_pre[of lm A na B] assms 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1438
    by simp
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1439
  have d: "sa < length A" using b a by simp
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1440
  then have e: "abc_step_l (sa, lma) (abc_fetch sa (A @ B)) = 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1441
    abc_step_l (sa, lma) (abc_fetch sa A)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1442
    by(rule_tac abc_append_first_step_eq_pre)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1443
  from a have "abc_steps_l (0, lm) A (Suc na) = (length A, lm')"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1444
    using final equal_when_halt
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1445
    by(case_tac "abc_steps_l (0, lm) A (Suc na)" , simp)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1446
  then have "abc_steps_l (0, lm) (A @ B) (Suc na) = (length A, lm')"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1447
    using a b c e
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1448
    by(simp add: abc_step_red2)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1449
  thus "?thesis"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1450
    by blast
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1451
qed
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1452
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1453
lemma abc_append_frist_steps_halt_eq: 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1454
  assumes final: "abc_steps_l (0, lm) A n = (length A, lm')"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1455
  shows "\<exists> n'. abc_steps_l (0, lm) (A @ B) n' = (length A, lm')"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1456
using final
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1457
apply(case_tac "A = []")
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1458
apply(rule_tac x = 0 in exI, simp add: abc_steps_l.simps abc_exec_null)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1459
apply(rule_tac abc_append_frist_steps_halt_eq', simp_all)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1460
done
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1461
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: 285
diff changeset
  1462
lemma suc_suc_max_simp[simp]: "Suc (Suc (max (xs + 3) fft - Suc (Suc ( xs))))
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 285
diff changeset
  1463
           = max ( xs + 3) fft - ( xs)"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1464
by arith
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1465
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: 285
diff changeset
  1466
lemma contract_dec_ft_length_plus_7[simp]: "\<lbrakk>ft = max (n + 3) (max fft gft); length xs = n\<rbrakk> \<Longrightarrow>
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1467
     {\<lambda>nl. nl = xs @ (x - Suc y) # rec_exec (Pr n f g) (xs @ [x - Suc y]) # 0 \<up> (ft - Suc (Suc n)) @ Suc y # anything}
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1468
     [Dec ft (length gap + 7)] 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1469
     {\<lambda>nl. nl = xs @ (x - Suc y) # rec_exec (Pr n f g) (xs @ [x - Suc y]) # 0 \<up> (ft - Suc (Suc n)) @ y # anything}"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1470
apply(simp add: abc_Hoare_halt_def)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1471
apply(rule_tac x = 1 in exI)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1472
apply(auto simp: abc_steps_l.simps abc_step_l.simps abc_fetch.simps nth_append abc_lm_v.simps abc_lm_s.simps list_update_append)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1473
using list_update_length
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1474
[of "(x - Suc y) # rec_exec (Pr (length xs) f g) (xs @ [x - Suc y]) #
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1475
          0 \<up> (max (length xs + 3) (max fft gft) - Suc (Suc (length xs)))" "Suc y" anything y]
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1476
apply(simp)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1477
done
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1478
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1479
lemma adjust_paras': 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1480
  "length xs = n \<Longrightarrow> {\<lambda>nl. nl = xs @ x # y # anything}  [Inc n] [+] [Dec (Suc n) 2, Goto 0]
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1481
       {\<lambda>nl. nl = xs @ Suc x # 0 # anything}"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1482
proof(rule_tac abc_Hoare_plus_halt)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1483
  assume "length xs = n"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1484
  thus "{\<lambda>nl. nl = xs @ x # y # anything} [Inc n] {\<lambda> nl. nl = xs @ Suc x # y # anything}"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1485
    apply(simp add: abc_Hoare_halt_def)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1486
    apply(rule_tac x = 1 in exI, simp add: abc_steps_l.simps abc_step_l.simps abc_fetch.simps abc_comp.simps
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1487
                                           abc_lm_v.simps abc_lm_s.simps nth_append list_update_append list_update.simps)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1488
    done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1489
next
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1490
  assume h: "length xs = n"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1491
  thus "{\<lambda>nl. nl = xs @ Suc x # y # anything} [Dec (Suc n) 2, Goto 0] {\<lambda>nl. nl = xs @ Suc x # 0 # anything}"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1492
  proof(induct y)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1493
    case 0
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1494
    thus "?case"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1495
      apply(simp add: abc_Hoare_halt_def)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1496
      apply(rule_tac x = 1 in exI, simp add: abc_steps_l.simps abc_step_l.simps abc_fetch.simps abc_comp.simps
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1497
                                           abc_lm_v.simps abc_lm_s.simps nth_append list_update_append list_update.simps)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1498
      done
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1499
  next
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1500
    case (Suc y)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1501
    have "length xs = n \<Longrightarrow> 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1502
      {\<lambda>nl. nl = xs @ Suc x # y # anything} [Dec (Suc n) 2, Goto 0] {\<lambda>nl. nl = xs @ Suc x # 0 # anything}" by fact
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1503
    then obtain stp where 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1504
      "abc_steps_l (0, xs @ Suc x # y # anything) [Dec (Suc n) 2, Goto 0] stp = (2, xs @ Suc x # 0 # anything)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1505
      using h
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: 285
diff changeset
  1506
      apply(auto simp: abc_Hoare_halt_def numeral_2_eq_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: 285
diff changeset
  1507
      by (metis (mono_tags, lifting) abc_final.simps abc_holds_for.elims(2) length_Cons list.size(3))
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1508
    moreover have "abc_steps_l (0, xs @ Suc x # Suc y # anything) [Dec (Suc n) 2, Goto 0] 2 = 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1509
                 (0, xs @ Suc x # y # anything)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1510
      using h
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1511
      by(simp add: abc_steps_l.simps numeral_2_eq_2 abc_step_l.simps abc_fetch.simps
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1512
        abc_lm_v.simps abc_lm_s.simps nth_append list_update_append list_update.simps)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1513
    ultimately show "?case"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1514
      apply(simp add: abc_Hoare_halt_def)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1515
      by(rule_tac x = "2 + stp" in exI, simp only: abc_steps_add, simp)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1516
  qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1517
qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1518
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1519
lemma adjust_paras: 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1520
  "length xs = n \<Longrightarrow> {\<lambda>nl. nl = xs @ x # y # anything}  [Inc n, Dec (Suc n) 3, Goto (Suc 0)]
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1521
       {\<lambda>nl. nl = xs @ Suc x # 0 # anything}"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1522
using adjust_paras'[of xs n x y anything]
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1523
by(simp add: abc_comp.simps abc_shift.simps numeral_2_eq_2 numeral_3_eq_3)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1524
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: 285
diff changeset
  1525
lemma rec_ci_SucSuc_n[simp]: "\<lbrakk>rec_ci g = (gap, gar, gft); \<forall>y<x. terminate g (xs @ [y, rec_exec (Pr n f g) (xs @ [y])]);
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1526
        length xs = n; Suc y\<le>x\<rbrakk> \<Longrightarrow> gar = Suc (Suc n)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1527
  apply(erule_tac x = y in allE, simp)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1528
  apply(drule_tac param_pattern, auto)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1529
  done
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1530
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1531
lemma loop_back':  
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1532
  assumes h: "length A = length gap + 4" "length xs = n"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1533
  and le: "y \<ge> x"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1534
  shows "\<exists> stp. abc_steps_l (length A, xs @ m # (y - x) # x # anything) (A @ [Dec (Suc (Suc n)) 0, Inc (Suc n), Goto (length gap + 4)]) stp
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1535
     = (length A, xs @ m # y # 0 # anything)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1536
  using le
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1537
proof(induct x)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1538
  case 0
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1539
  thus "?case"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1540
    using h
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1541
    by(rule_tac x = 0 in exI,
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1542
    auto simp: abc_steps_l.simps abc_step_l.simps abc_fetch.simps nth_append abc_lm_s.simps abc_lm_v.simps)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1543
next
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1544
  case (Suc x)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1545
  have "x \<le> y \<Longrightarrow> \<exists>stp. abc_steps_l (length A, xs @ m # (y - x) # x # anything) (A @ [Dec (Suc (Suc n)) 0, Inc (Suc n), Goto (length gap + 4)]) stp =
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1546
              (length A, xs @ m # y # 0 # anything)" by fact
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1547
  moreover have "Suc x \<le> y" by fact
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1548
  moreover then have "\<exists> stp. abc_steps_l (length A, xs @ m # (y - Suc x) # Suc x # anything) (A @ [Dec (Suc (Suc n)) 0, Inc (Suc n), Goto (length gap + 4)]) stp
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1549
                = (length A, xs @ m # (y - x) # x # anything)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1550
    using h
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1551
    apply(rule_tac x = 3 in exI)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1552
    by(simp add: abc_steps_l.simps numeral_3_eq_3 abc_step_l.simps abc_fetch.simps nth_append abc_lm_v.simps abc_lm_s.simps
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1553
                    list_update_append list_update.simps)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1554
  ultimately show "?case"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1555
    apply(auto)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1556
    apply(rule_tac x = "stpa + stp" in exI)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1557
    by(simp add: abc_steps_add)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1558
qed
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1559
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1560
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1561
lemma loop_back:  
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1562
  assumes h: "length A = length gap + 4" "length xs = n"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1563
  shows "\<exists> stp. abc_steps_l (length A, xs @ m # 0 # x # anything) (A @ [Dec (Suc (Suc n)) 0, Inc (Suc n), Goto (length gap + 4)]) stp
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1564
     = (0, xs @ m # x # 0 # anything)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1565
using loop_back'[of A gap xs n x x m anything] assms
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1566
apply(auto)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1567
apply(rule_tac x = "stp + 1" in exI)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1568
apply(simp only: abc_steps_add, simp)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1569
apply(simp add: abc_steps_l.simps abc_step_l.simps abc_fetch.simps nth_append abc_lm_v.simps abc_lm_s.simps)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1570
done
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1571
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1572
lemma rec_exec_pr_0_simps: "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
  1573
 by(simp add: rec_exec.simps)
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1574
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1575
lemma rec_exec_pr_Suc_simps: "rec_exec (Pr n f g) (xs @ [Suc y])
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1576
          = rec_exec g (xs @ [y, rec_exec (Pr n f g) (xs @ [y])])"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1577
apply(induct y)
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1578
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
  1579
apply(simp add: rec_exec.simps)
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1580
done
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1581
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: 285
diff changeset
  1582
lemma suc_max_simp[simp]: "Suc (max (n + 3) fft - Suc (Suc (Suc n))) = max (n + 3) fft - Suc (Suc n)"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1583
by arith
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1584
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1585
lemma pr_loop:
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1586
  assumes code: "code = ([Dec (max (n + 3) (max fft gft)) (length gap + 7)] [+] (gap [+] [Inc n, Dec (Suc n) 3, Goto (Suc 0)])) @
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1587
    [Dec (Suc (Suc n)) 0, Inc (Suc n), Goto (length gap + 4)]"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1588
  and len: "length xs = n"
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1589
  and g_ind: "\<forall> y<x. (\<forall>anything. {\<lambda>nl. nl = xs @ y # rec_exec (Pr n f g) (xs @ [y]) # 0 \<up> (gft - gar) @ anything} gap
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1590
  {\<lambda>nl. nl = xs @ y # rec_exec (Pr n f g) (xs @ [y]) # rec_exec g (xs @ [y, rec_exec (Pr n f g) (xs @ [y])]) # 0 \<up> (gft - Suc gar) @ anything})"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1591
  and compile_g: "rec_ci g = (gap, gar, gft)"
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1592
  and termi_g: "\<forall> y<x. terminate g (xs @ [y, rec_exec (Pr n f g) (xs @ [y])])"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1593
  and ft: "ft = max (n + 3) (max fft gft)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1594
  and less: "Suc y \<le> x"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1595
  shows 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1596
  "\<exists>stp. abc_steps_l (0, xs @ (x - Suc y) # rec_exec (Pr n f g) (xs @ [x - Suc y]) # 0 \<up> (ft - Suc (Suc n)) @ Suc y # anything)
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1597
  code stp = (0, xs @ (x - y) # rec_exec (Pr n f g) (xs @ [x - y]) # 0 \<up> (ft - Suc (Suc n)) @ y # anything)"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1598
proof -
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1599
  let ?A = "[Dec  ft (length gap + 7)]"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1600
  let ?B = "gap"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1601
  let ?C = "[Inc n, Dec (Suc n) 3, Goto (Suc 0)]"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1602
  let ?D = "[Dec (Suc (Suc n)) 0, Inc (Suc n), Goto (length gap + 4)]"
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1603
  have "\<exists> stp. abc_steps_l (0, xs @ (x - Suc y) # rec_exec (Pr n f g) (xs @ [x - Suc y]) # 0 \<up> (ft - Suc (Suc n)) @ Suc y # anything)
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1604
            ((?A [+] (?B [+] ?C)) @ ?D) stp = (length (?A [+] (?B [+] ?C)), 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1605
          xs @ (x - y) # 0 # rec_exec g (xs @ [x - Suc y, rec_exec (Pr n f g) (xs @ [x - Suc y])])
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1606
                  # 0 \<up> (ft - Suc (Suc (Suc n))) @ y # anything)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1607
  proof -
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1608
    have "\<exists> stp. abc_steps_l (0, xs @ (x - Suc y) # rec_exec (Pr n f g) (xs @ [x - Suc y]) # 0 \<up> (ft - Suc (Suc n)) @ Suc y # anything)
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1609
      ((?A [+] (?B [+] ?C))) stp = (length (?A [+] (?B [+] ?C)),  xs @ (x - y) # 0 # 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1610
      rec_exec g (xs @ [x - Suc y, rec_exec (Pr n f g) (xs @ [x - Suc y])]) # 0 \<up> (ft - Suc (Suc (Suc n))) @ y # anything)"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1611
    proof -
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1612
      have "{\<lambda> nl. nl = xs @ (x - Suc y) # rec_exec (Pr n f g) (xs @ [x - Suc y]) # 0 \<up> (ft - Suc (Suc n)) @ Suc y # anything}
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1613
        (?A [+] (?B [+] ?C)) 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1614
        {\<lambda> nl. nl = xs @ (x - y) # 0 # 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1615
        rec_exec g (xs @ [x - Suc y, rec_exec (Pr n f g) (xs @ [x - Suc y])]) # 0 \<up> (ft - Suc (Suc (Suc n))) @ y # anything}"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1616
      proof(rule_tac abc_Hoare_plus_halt)
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1617
        show "{\<lambda>nl. nl = xs @ (x - Suc y) # rec_exec (Pr n f g) (xs @ [x - Suc y]) # 0 \<up> (ft - Suc (Suc n)) @ Suc y # anything}
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1618
          [Dec ft (length gap + 7)] 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1619
          {\<lambda>nl. nl = xs @ (x - Suc y) # rec_exec (Pr n f g) (xs @ [x - Suc y]) # 0 \<up> (ft - Suc (Suc n)) @ y # anything}"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1620
          using ft len
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1621
          by(simp)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1622
      next
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1623
        show 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1624
          "{\<lambda>nl. nl = xs @ (x - Suc y) # rec_exec (Pr n f g) (xs @ [x - Suc y]) # 0 \<up> (ft - Suc (Suc n)) @ y # anything} 
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1625
          ?B [+] ?C
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1626
          {\<lambda>nl. nl = xs @ (x - y) # 0 # rec_exec g (xs @ [x - Suc y, rec_exec (Pr n f g) (xs @ [x - Suc y])]) # 0 \<up> (ft - Suc (Suc (Suc n))) @ y # anything}"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1627
        proof(rule_tac abc_Hoare_plus_halt)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1628
          have a: "gar = Suc (Suc n)" 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1629
            using compile_g termi_g len less
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1630
            by simp
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1631
          have b: "gft > gar"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1632
            using compile_g
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1633
            by(erule_tac footprint_ge)
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1634
          show "{\<lambda>nl. nl = xs @ (x - Suc y) # rec_exec (Pr n f g) (xs @ [x - Suc y]) # 0 \<up> (ft - Suc (Suc n)) @ y # anything} gap 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1635
                {\<lambda>nl. nl = xs @ (x - Suc y) # rec_exec (Pr n f g) (xs @ [x - Suc y]) # 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1636
                      rec_exec g (xs @ [x - Suc y, rec_exec (Pr n f g) (xs @ [x - Suc y])]) # 0 \<up> (ft - Suc (Suc (Suc n))) @ y # anything}"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1637
          proof -
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1638
            have 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1639
              "{\<lambda>nl. nl = xs @ (x - Suc y) # rec_exec (Pr n f g) (xs @ [x - Suc y]) # 0 \<up> (gft - gar) @ 0\<up>(ft - gft) @ y # anything} gap
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1640
              {\<lambda>nl. nl = xs @ (x - Suc y) # rec_exec (Pr n f g) (xs @ [x - Suc y]) # 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1641
              rec_exec g (xs @ [(x - Suc y), rec_exec (Pr n f g) (xs @ [x - Suc y])]) # 0 \<up> (gft - Suc gar) @ 0\<up>(ft - gft) @ y # anything}"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1642
              using g_ind less by simp
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1643
            thus "?thesis"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1644
              using a b ft
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1645
              by(simp add: replicate_merge_anywhere numeral_3_eq_3)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1646
          qed
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1647
        next
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1648
          show "{\<lambda>nl. nl = xs @ (x - Suc y) #
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1649
                    rec_exec (Pr n f g) (xs @ [x - Suc y]) #
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1650
            rec_exec g (xs @ [x - Suc y, rec_exec (Pr n f g) (xs @ [x - Suc y])]) # 0 \<up> (ft - Suc (Suc (Suc n))) @ y # anything}
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1651
            [Inc n, Dec (Suc n) 3, Goto (Suc 0)]
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1652
            {\<lambda>nl. nl = xs @ (x - y) # 0 # rec_exec g (xs @ [x - Suc y, rec_exec (Pr n f g) 
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1653
                    (xs @ [x - Suc y])]) # 0 \<up> (ft - Suc (Suc (Suc n))) @ y # anything}"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1654
            using len less
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1655
            using adjust_paras[of xs n "x - Suc y" " rec_exec (Pr n f g) (xs @ [x - Suc y])"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1656
              " rec_exec g (xs @ [x - Suc y, rec_exec (Pr n f g) (xs @ [x - Suc y])]) # 
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1657
              0 \<up> (ft - Suc (Suc (Suc n))) @ y # anything"]
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1658
            by(simp add: Suc_diff_Suc)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1659
        qed
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1660
      qed
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1661
      thus "?thesis"
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1662
        by(simp add: abc_Hoare_halt_def, auto, rule_tac x = na in exI, case_tac "abc_steps_l (0, xs @ (x - Suc y) # rec_exec (Pr n f g) (xs @ [x - Suc y]) # 
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1663
          0 \<up> (ft - Suc (Suc n)) @ Suc y # anything)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1664
             ([Dec ft (length gap + 7)] [+] (gap [+] [Inc n, Dec (Suc n) 3, Goto (Suc 0)])) na", simp)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1665
    qed
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1666
    then obtain stpa where "abc_steps_l (0, xs @ (x - Suc y) # rec_exec (Pr n f g) (xs @ [x - Suc y]) # 0 \<up> (ft - Suc (Suc n)) @ Suc y # anything)
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1667
            ((?A [+] (?B [+] ?C))) stpa = (length (?A [+] (?B [+] ?C)), 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1668
          xs @ (x - y) # 0 # rec_exec g (xs @ [x - Suc y, rec_exec (Pr n f g) (xs @ [x - Suc y])])
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1669
                  # 0 \<up> (ft - Suc (Suc (Suc n))) @ y # anything)" ..
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1670
    thus "?thesis"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1671
      by(erule_tac abc_append_frist_steps_halt_eq)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1672
  qed
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1673
  moreover have 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1674
    "\<exists> stp. abc_steps_l (length (?A [+] (?B [+] ?C)),
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1675
    xs @ (x - y) # 0 # rec_exec g (xs @ [x - Suc y, rec_exec (Pr n f g) (xs @ [x - Suc y])]) # 0 \<up> (ft - Suc (Suc (Suc n))) @ y # anything)
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1676
    ((?A [+] (?B [+] ?C)) @ ?D) stp  = (0, xs @ (x - y) # rec_exec g (xs @ [x - Suc y, rec_exec (Pr n f g) (xs @ [x - Suc y])]) # 
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1677
    0 # 0 \<up> (ft - Suc (Suc (Suc n))) @ y # anything)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1678
    using len
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1679
    by(rule_tac loop_back, simp_all)
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1680
  moreover have "rec_exec g (xs @ [x - Suc y, rec_exec (Pr n f g) (xs @ [x - Suc y])]) = rec_exec (Pr n f g) (xs @ [x - y])"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1681
    using less
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1682
    thm rec_exec.simps
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1683
    apply(case_tac "x - y", simp_all add: rec_exec_pr_Suc_simps)
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1684
    by(subgoal_tac "nat = x - Suc y", simp, arith)    
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1685
  ultimately show "?thesis"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1686
    using code ft
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1687
    by(auto, rule_tac x = "stp + stpa" in exI, simp add: abc_steps_add replicate_Suc_iff_anywhere del: replicate_Suc)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1688
qed
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1689
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: 285
diff changeset
  1690
lemma abc_lm_s_simp0[simp]: 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1691
  "length xs = n \<Longrightarrow> abc_lm_s (xs @ x # rec_exec (Pr n f g) (xs @ [x]) # 0 \<up> (max (n + 3) 
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1692
  (max fft gft) - Suc (Suc n)) @ 0 # anything) (max (n + 3) (max fft gft)) 0 =
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1693
    xs @ x # rec_exec (Pr n f g) (xs @ [x]) # 0 \<up> (max (n + 3) (max fft gft) - Suc n) @ anything"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1694
apply(simp add: abc_lm_s.simps)
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1695
using list_update_length[of "xs @ x # rec_exec (Pr n f g) (xs @ [x]) # 0 \<up> (max (n + 3) (max fft gft) - Suc (Suc n))"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1696
                        0 anything 0]
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1697
apply(auto simp: Suc_diff_Suc)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1698
apply(simp add: exp_suc[THEN sym] Suc_diff_Suc  del: replicate_Suc)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1699
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1700
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: 285
diff changeset
  1701
lemma index_at_zero_elem[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: 285
diff changeset
  1702
  "(xs @ x # re # 0 \<up> (max (length xs + 3)
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1703
  (max fft gft) - Suc (Suc (length xs))) @ 0 # anything) !
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1704
    max (length xs + 3) (max fft gft) = 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: 285
diff changeset
  1705
using nth_append_length[of "xs @ x # re #
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1706
  0 \<up> (max (length xs + 3) (max fft gft) - Suc (Suc (length xs)))" 0  anything]
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1707
by(simp)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1708
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1709
lemma pr_loop_correct:
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1710
  assumes less: "y \<le> x" 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1711
  and len: "length xs = n"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1712
  and compile_g: "rec_ci g = (gap, gar, gft)"
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1713
  and termi_g: "\<forall> y<x. terminate g (xs @ [y, rec_exec (Pr n f g) (xs @ [y])])"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1714
  and g_ind: "\<forall> y<x. (\<forall>anything. {\<lambda>nl. nl = xs @ y # rec_exec (Pr n f g) (xs @ [y]) # 0 \<up> (gft - gar) @ anything} gap
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1715
  {\<lambda>nl. nl = xs @ y # rec_exec (Pr n f g) (xs @ [y]) # rec_exec g (xs @ [y, rec_exec (Pr n f g) (xs @ [y])]) # 0 \<up> (gft - Suc gar) @ anything})"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1716
  shows "{\<lambda>nl. nl = xs @ (x - y) # rec_exec (Pr n f g) (xs @ [x - y]) # 0 \<up> (max (n + 3) (max fft gft) - Suc (Suc n)) @ y # anything}
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1717
   ([Dec (max (n + 3) (max fft gft)) (length gap + 7)] [+] (gap [+] [Inc n, Dec (Suc n) 3, Goto (Suc 0)])) @ [Dec (Suc (Suc n)) 0, Inc (Suc n), Goto (length gap + 4)]
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1718
   {\<lambda>nl. nl = xs @ x # rec_exec (Pr n f g) (xs @ [x]) # 0 \<up> (max (n + 3) (max fft gft) - Suc n) @ anything}" 
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1719
  using less
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1720
proof(induct y)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1721
  case 0
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1722
  thus "?case"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1723
    using len
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1724
    apply(simp add: abc_Hoare_halt_def)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1725
    apply(rule_tac x = 1 in exI)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1726
    by(auto simp: abc_steps_l.simps abc_step_l.simps abc_fetch.simps 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1727
      nth_append abc_comp.simps abc_shift.simps, simp add: abc_lm_v.simps)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1728
next
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1729
  case (Suc y)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1730
  let ?ft = "max (n + 3) (max fft gft)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1731
  let ?C = "[Dec (max (n + 3) (max fft gft)) (length gap + 7)] [+] (gap [+] 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1732
    [Inc n, Dec (Suc n) 3, Goto (Suc 0)]) @ [Dec (Suc (Suc n)) 0, Inc (Suc n), Goto (length gap + 4)]"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1733
  have ind: "y \<le> x \<Longrightarrow>
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1734
         {\<lambda>nl. nl = xs @ (x - y) # rec_exec (Pr n f g) (xs @ [x - y]) # 0 \<up> (?ft - Suc (Suc n)) @ y # anything}
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1735
         ?C {\<lambda>nl. nl = xs @ x # rec_exec (Pr n f g) (xs @ [x]) # 0 \<up> (?ft - Suc n) @ anything}" by fact 
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1736
  have less: "Suc y \<le> x" by fact
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1737
  have stp1: 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1738
    "\<exists> stp. abc_steps_l (0, xs @ (x - Suc y) # rec_exec (Pr n f g) (xs @ [x - Suc y]) # 0 \<up> (?ft - Suc (Suc n)) @ Suc y # anything)
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1739
    ?C stp  = (0, xs @ (x - y) # rec_exec (Pr n f g) (xs @ [x - y]) # 0 \<up> (?ft - Suc (Suc n)) @ y # anything)"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1740
    using assms less
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1741
    by(rule_tac  pr_loop, auto)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1742
  then obtain stp1 where a:
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1743
    "abc_steps_l (0, xs @ (x - Suc y) # rec_exec (Pr n f g) (xs @ [x - Suc y]) # 0 \<up> (?ft - Suc (Suc n)) @ Suc y # anything)
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1744
   ?C stp1 = (0, xs @ (x - y) # rec_exec (Pr n f g) (xs @ [x - y]) # 0 \<up> (?ft - Suc (Suc n)) @ y # anything)" ..
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1745
  moreover have 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1746
    "\<exists> stp. abc_steps_l (0, xs @ (x - y) # rec_exec (Pr n f g) (xs @ [x - y]) # 0 \<up> (?ft - Suc (Suc n)) @ y # anything)
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1747
    ?C stp = (length ?C, xs @ x # rec_exec (Pr n f g) (xs @ [x]) # 0 \<up> (?ft - Suc n) @ anything)"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1748
    using ind less
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1749
    by(auto simp: abc_Hoare_halt_def, case_tac "abc_steps_l (0, xs @ (x - y) # rec_exec (Pr n f g) 
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1750
      (xs @ [x - y]) # 0 \<up> (?ft - Suc (Suc n)) @ y # anything) ?C na", rule_tac x = na in exI, simp)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1751
  then obtain stp2 where b:
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1752
    "abc_steps_l (0, xs @ (x - y) # rec_exec (Pr n f g) (xs @ [x - y]) # 0 \<up> (?ft - Suc (Suc n)) @ y # anything)
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1753
    ?C stp2 = (length ?C, xs @ x # rec_exec (Pr n f g) (xs @ [x]) # 0 \<up> (?ft - Suc n) @ anything)" ..
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1754
  from a b show "?case"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1755
    by(simp add: abc_Hoare_halt_def, rule_tac x = "stp1 + stp2" in exI, simp add: abc_steps_add)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1756
qed
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1757
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1758
lemma compile_pr_correct':
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1759
  assumes termi_g: "\<forall> y<x. terminate g (xs @ [y, rec_exec (Pr n f g) (xs @ [y])])"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1760
  and g_ind: 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1761
  "\<forall> y<x. (\<forall>anything. {\<lambda>nl. nl = xs @ y # rec_exec (Pr n f g) (xs @ [y]) # 0 \<up> (gft - gar) @ anything} gap
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1762
  {\<lambda>nl. nl = xs @ y # rec_exec (Pr n f g) (xs @ [y]) # rec_exec g (xs @ [y, rec_exec (Pr n f g) (xs @ [y])]) # 0 \<up> (gft - Suc gar) @ anything})"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1763
  and termi_f: "terminate f xs"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1764
  and f_ind: "\<And> anything. {\<lambda>nl. nl = xs @ 0 \<up> (fft - far) @ anything} fap {\<lambda>nl. nl = xs @ rec_exec f xs # 0 \<up> (fft - Suc far) @ anything}"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1765
  and len: "length xs = n"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1766
  and compile1: "rec_ci f = (fap, far, fft)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1767
  and compile2: "rec_ci g = (gap, gar, gft)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1768
  shows 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1769
  "{\<lambda>nl. nl = xs @ x # 0 \<up> (max (n + 3) (max fft gft) - n) @ anything}
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1770
  mv_box n (max (n + 3) (max fft gft)) [+]
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1771
  (fap [+] (mv_box n (Suc n) [+]
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1772
  ([Dec (max (n + 3) (max fft gft)) (length gap + 7)] [+] (gap [+] [Inc n, Dec (Suc n) 3, Goto (Suc 0)]) @
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1773
  [Dec (Suc (Suc n)) 0, Inc (Suc n), Goto (length gap + 4)])))
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1774
  {\<lambda>nl. nl = xs @ x # rec_exec (Pr n f g) (xs @ [x]) # 0 \<up> (max (n + 3) (max fft gft) - Suc n) @ anything}"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1775
proof -
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1776
  let ?ft = "max (n+3) (max fft gft)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1777
  let ?A = "mv_box n ?ft"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1778
  let ?B = "fap"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1779
  let ?C = "mv_box n (Suc n)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1780
  let ?D = "[Dec ?ft (length gap + 7)]"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1781
  let ?E = "gap [+] [Inc n, Dec (Suc n) 3, Goto (Suc 0)]"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1782
  let ?F = "[Dec (Suc (Suc n)) 0, Inc (Suc n), Goto (length gap + 4)]"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1783
  let ?P = "\<lambda>nl. nl = xs @ x # 0 \<up> (?ft - n) @ anything"
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1784
  let ?S = "\<lambda>nl. nl = xs @ x # rec_exec (Pr n f g) (xs @ [x]) # 0 \<up> (?ft - Suc n) @ anything"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1785
  let ?Q1 = "\<lambda>nl. nl = xs @ 0 \<up> (?ft - n) @  x # anything"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1786
  show "{?P} (?A [+] (?B [+] (?C [+] (?D [+] ?E @ ?F)))) {?S}"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1787
  proof(rule_tac abc_Hoare_plus_halt)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1788
    show "{?P} ?A {?Q1}"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1789
      using len by simp
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1790
  next
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1791
    let ?Q2 = "\<lambda>nl. nl = xs @ rec_exec f xs # 0 \<up> (?ft - Suc n) @  x # anything"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1792
    have a: "?ft \<ge> fft"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1793
      by arith
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1794
    have b: "far = n"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1795
      using compile1 termi_f len
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1796
      by(drule_tac param_pattern, auto)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1797
    have c: "fft > far"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1798
      using compile1
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1799
      by(simp add: footprint_ge)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1800
    show "{?Q1} (?B [+] (?C [+] (?D [+] ?E @ ?F))) {?S}"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1801
    proof(rule_tac abc_Hoare_plus_halt)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1802
      have "{\<lambda>nl. nl = xs @ 0 \<up> (fft - far) @ 0\<up>(?ft - fft) @ x # anything} fap 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1803
            {\<lambda>nl. nl = xs @ rec_exec f xs # 0 \<up> (fft - Suc far) @ 0\<up>(?ft - fft) @ x # anything}"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1804
        by(rule_tac f_ind)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1805
      moreover have "fft - far + ?ft - fft = ?ft - far"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1806
        using a b c by arith
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1807
      moreover have "fft - Suc n + ?ft - fft = ?ft - Suc n"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1808
        using a b c by arith
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1809
      ultimately show "{?Q1} ?B {?Q2}"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1810
        using b
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1811
        by(simp add: replicate_merge_anywhere)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1812
    next
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1813
      let ?Q3 = "\<lambda> nl. nl = xs @ 0 # rec_exec f xs # 0\<up>(?ft - Suc (Suc n)) @ x # anything"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1814
      show "{?Q2} (?C [+] (?D [+] ?E @ ?F)) {?S}"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1815
      proof(rule_tac abc_Hoare_plus_halt)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1816
        show "{?Q2} (?C) {?Q3}"
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1817
          using mv_box_correct[of n "Suc n" "xs @ rec_exec f xs # 0 \<up> (max (n + 3) (max fft gft) - Suc n) @ x # anything"]
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1818
          using len
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1819
          by(auto)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1820
      next
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1821
        show "{?Q3} (?D [+] ?E @ ?F) {?S}"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1822
          using pr_loop_correct[of x x xs n g  gap gar gft f fft anything] assms
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1823
          by(simp add: rec_exec_pr_0_simps)
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1824
      qed
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1825
    qed
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1826
  qed
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1827
qed 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1828
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1829
lemma compile_pr_correct:
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1830
  assumes g_ind: "\<forall>y<x. terminate g (xs @ [y, rec_exec (Pr n f g) (xs @ [y])]) \<and>
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1831
  (\<forall>x xa xb. rec_ci g = (x, xa, xb) \<longrightarrow>
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1832
  (\<forall>xc. {\<lambda>nl. nl = xs @ y # rec_exec (Pr n f g) (xs @ [y]) # 0 \<up> (xb - xa) @ xc} x
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1833
  {\<lambda>nl. nl = xs @ y # rec_exec (Pr n f g) (xs @ [y]) # rec_exec g (xs @ [y, rec_exec (Pr n f g) (xs @ [y])]) # 0 \<up> (xb - Suc xa) @ xc}))"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1834
  and termi_f: "terminate f xs"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1835
  and f_ind:
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1836
  "\<And>ap arity fp anything.
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1837
  rec_ci f = (ap, arity, fp) \<Longrightarrow> {\<lambda>nl. nl = xs @ 0 \<up> (fp - arity) @ anything} ap {\<lambda>nl. nl = xs @ rec_exec f xs # 0 \<up> (fp - Suc arity) @ anything}"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1838
  and len: "length xs = n"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1839
  and compile: "rec_ci (Pr n f g) = (ap, arity, fp)"
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1840
  shows "{\<lambda>nl. nl = xs @ x # 0 \<up> (fp - arity) @ anything} ap {\<lambda>nl. nl = xs @ x # rec_exec (Pr n f g) (xs @ [x]) # 0 \<up> (fp - Suc arity) @ anything}"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1841
proof(case_tac "rec_ci f", case_tac "rec_ci g")
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1842
  fix fap far fft gap gar gft
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1843
  assume h: "rec_ci f = (fap, far, fft)" "rec_ci g = (gap, gar, gft)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1844
  have g: 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1845
    "\<forall>y<x. (terminate g (xs @ [y, rec_exec (Pr n f g) (xs @ [y])]) \<and>
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1846
     (\<forall>anything. {\<lambda>nl. nl = xs @ y # rec_exec (Pr n f g) (xs @ [y]) # 0 \<up> (gft - gar) @ anything} gap
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1847
    {\<lambda>nl. nl = xs @ y # rec_exec (Pr n f g) (xs @ [y]) # rec_exec g (xs @ [y, rec_exec (Pr n f g) (xs @ [y])]) # 0 \<up> (gft - Suc gar) @ anything}))"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1848
    using g_ind h
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1849
    by(auto)
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1850
  hence termi_g: "\<forall> y<x. terminate g (xs @ [y, rec_exec (Pr n f g) (xs @ [y])])"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1851
    by simp
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1852
  from g have g_newind: 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1853
    "\<forall> y<x. (\<forall>anything. {\<lambda>nl. nl = xs @ y # rec_exec (Pr n f g) (xs @ [y]) # 0 \<up> (gft - gar) @ anything} gap
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1854
    {\<lambda>nl. nl = xs @ y # rec_exec (Pr n f g) (xs @ [y]) # rec_exec g (xs @ [y, rec_exec (Pr n f g) (xs @ [y])]) # 0 \<up> (gft - Suc gar) @ anything})"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1855
    by auto
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1856
  have f_newind: "\<And> anything. {\<lambda>nl. nl = xs @ 0 \<up> (fft - far) @ anything} fap {\<lambda>nl. nl = xs @ rec_exec f xs # 0 \<up> (fft - Suc far) @ anything}"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1857
    using h
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1858
    by(rule_tac f_ind, simp)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1859
  show "?thesis"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1860
    using termi_f termi_g h compile
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1861
    apply(simp add: rec_ci.simps abc_comp_commute, auto)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1862
    using g_newind f_newind len
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1863
    by(rule_tac compile_pr_correct', simp_all)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1864
qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  1865
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1866
fun mn_ind_inv ::
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1867
  "nat \<times> nat list \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat list \<Rightarrow> nat list \<Rightarrow> bool"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1868
  where
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1869
  "mn_ind_inv (as, lm') ss x rsx suf_lm lm = 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1870
           (if as = ss then lm' = lm @ x # rsx # suf_lm
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1871
            else if as = ss + 1 then 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1872
                 \<exists>y. (lm' = lm @ x # y # suf_lm) \<and> y \<le> rsx
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1873
            else if as = ss + 2 then 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1874
                 \<exists>y. (lm' = lm @ x # y # suf_lm) \<and> y \<le> rsx
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1875
            else if as = ss + 3 then lm' = lm @ x # 0 # suf_lm
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1876
            else if as = ss + 4 then lm' = lm @ Suc x # 0 # suf_lm
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1877
            else if as = 0 then lm' = lm @ Suc x # 0 # suf_lm
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1878
            else False
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1879
)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1880
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1881
fun mn_stage1 :: "nat \<times> nat list \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1882
  where
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1883
  "mn_stage1 (as, lm) ss n = 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1884
            (if as = 0 then 0 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1885
             else if as = ss + 4 then 1
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1886
             else if as = ss + 3 then 2
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1887
             else if as = ss + 2 \<or> as = ss + 1 then 3
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1888
             else if as = ss then 4
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1889
             else 0
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1890
)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1891
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1892
fun mn_stage2 :: "nat \<times> nat list \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1893
  where
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1894
  "mn_stage2 (as, lm) ss n = 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1895
            (if as = ss + 1 \<or> as = ss + 2 then (lm ! (Suc n))
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1896
             else 0)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1897
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1898
fun mn_stage3 :: "nat \<times> nat list \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1899
  where
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1900
  "mn_stage3 (as, lm) ss n = (if as = ss + 2 then 1 else 0)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1901
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1902
 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1903
fun mn_measure :: "((nat \<times> nat list) \<times> nat \<times> nat) \<Rightarrow>
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1904
                                                (nat \<times> nat \<times> nat)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1905
  where
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1906
  "mn_measure ((as, lm), ss, n) = 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1907
     (mn_stage1 (as, lm) ss n, mn_stage2 (as, lm) ss n,
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1908
                                       mn_stage3 (as, lm) ss n)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1909
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1910
definition mn_LE :: "(((nat \<times> nat list) \<times> nat \<times> nat) \<times>
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1911
                     ((nat \<times> nat list) \<times> nat \<times> nat)) set"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1912
  where "mn_LE \<equiv> (inv_image lex_triple mn_measure)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1913
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1914
lemma wf_mn_le[intro]: "wf mn_LE"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1915
by(auto intro:wf_inv_image wf_lex_triple simp: mn_LE_def)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1916
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1917
declare mn_ind_inv.simps[simp del]
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1918
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: 285
diff changeset
  1919
lemma put_in_tape_small_enough0[simp]: 
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1920
  "0 < rsx \<Longrightarrow> 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1921
 \<exists>y. (xs @ x # rsx # anything)[Suc (length xs) := rsx - Suc 0] = xs @ x # y # anything \<and> y \<le> rsx"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1922
apply(rule_tac x = "rsx - 1" in exI)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1923
apply(simp add: list_update_append list_update.simps)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1924
done
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1925
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: 285
diff changeset
  1926
lemma put_in_tape_small_enough1[simp]: 
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1927
  "\<lbrakk>y \<le> rsx; 0 < y\<rbrakk>
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1928
            \<Longrightarrow> \<exists>ya. (xs @ x # y # anything)[Suc (length xs) := y - Suc 0] = xs @ x # ya # anything \<and> ya \<le> rsx"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1929
apply(rule_tac x = "y - 1" in exI)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1930
apply(simp add: list_update_append list_update.simps)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1931
done
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1932
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1933
lemma abc_comp_null[simp]: "(A [+] B = []) = (A = [] \<and> B = [])"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1934
by(auto simp: abc_comp.simps abc_shift.simps)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1935
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1936
lemma rec_ci_not_null[simp]: "(rec_ci f \<noteq> ([], a, b))"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1937
apply(case_tac f, auto simp: rec_ci_z_def rec_ci_s_def rec_ci.simps addition.simps rec_ci_id.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: 285
diff changeset
  1938
apply(case_tac "rec_ci x42", auto simp: mv_box.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: 285
diff changeset
  1939
apply(case_tac "rec_ci x52", case_tac "rec_ci x53", 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: 285
diff changeset
  1940
apply(case_tac "rec_ci x62", simp)
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1941
done
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1942
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1943
lemma mn_correct:
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1944
  assumes compile: "rec_ci rf = (fap, far, fft)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1945
  and ge: "0 < rsx"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1946
  and len: "length xs = arity"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1947
  and B: "B = [Dec (Suc arity) (length fap + 5), Dec (Suc arity) (length fap + 3), Goto (Suc (length fap)), Inc arity, Goto 0]"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1948
  and f: "f = (\<lambda> stp. (abc_steps_l (length fap, xs @ x # rsx # anything) (fap @ B) stp, (length fap), arity)) "
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1949
  and P: "P =(\<lambda> ((as, lm), ss, arity). as = 0)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1950
  and Q: "Q = (\<lambda> ((as, lm), ss, arity). mn_ind_inv (as, lm) (length fap) x rsx anything xs)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1951
  shows "\<exists> stp. P (f stp) \<and> Q (f stp)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1952
proof(rule_tac halt_lemma2)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1953
  show "wf mn_LE"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1954
    using wf_mn_le by simp
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1955
next
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1956
  show "Q (f 0)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1957
    by(auto simp: Q f abc_steps_l.simps mn_ind_inv.simps)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1958
next
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1959
  have "fap \<noteq> []"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1960
    using compile by auto
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1961
  thus "\<not> P (f 0)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1962
    by(auto simp: f P abc_steps_l.simps)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1963
next
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1964
  have "fap \<noteq> []"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1965
    using compile by auto
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1966
  then have "\<And> stp. \<lbrakk>\<not> P (f stp); Q (f stp)\<rbrakk> \<Longrightarrow> Q (f (Suc stp)) \<and> (f (Suc stp), f stp) \<in> mn_LE"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1967
    using ge len
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1968
    apply(case_tac "(abc_steps_l (length fap, xs @ x # rsx # anything) (fap @ B) stp)")
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1969
    apply(simp add: abc_step_red2  B f P Q)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1970
    apply(auto split:if_splits simp add:abc_steps_l.simps  mn_ind_inv.simps abc_steps_zero B abc_fetch.simps nth_append)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1971
    by(auto simp: mn_LE_def lex_triple_def lex_pair_def 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1972
               abc_step_l.simps abc_steps_l.simps mn_ind_inv.simps
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1973
               abc_lm_v.simps abc_lm_s.simps nth_append abc_fetch.simps
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1974
                split: if_splits)    
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1975
  thus "\<forall>stp. \<not> P (f stp) \<and> Q (f stp) \<longrightarrow> Q (f (Suc stp)) \<and> (f (Suc stp), f stp) \<in> mn_LE"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1976
    by(auto)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1977
qed
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1978
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1979
lemma abc_Hoare_haltE:
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1980
  "{\<lambda> nl. nl = lm1} p {\<lambda> nl. nl = lm2}
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1981
    \<Longrightarrow> \<exists> stp. abc_steps_l (0, lm1) p stp = (length p, lm2)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1982
apply(auto simp: abc_Hoare_halt_def)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1983
apply(rule_tac x = n in exI)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1984
apply(case_tac "abc_steps_l (0, lm1) p n", auto)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1985
done
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1986
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1987
lemma mn_loop:
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1988
  assumes B:  "B = [Dec (Suc arity) (length fap + 5), Dec (Suc arity) (length fap + 3), Goto (Suc (length fap)), Inc arity, Goto 0]"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1989
  and ft: "ft = max (Suc arity) fft"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1990
  and len: "length xs = arity"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1991
  and far: "far = Suc arity"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1992
  and ind: " (\<forall>xc. ({\<lambda>nl. nl = xs @ x # 0 \<up> (fft - far) @ xc} fap
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1993
    {\<lambda>nl. nl = xs @ x # rec_exec f (xs @ [x]) # 0 \<up> (fft - Suc far) @ xc}))"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  1994
  and exec_less: "rec_exec f (xs @ [x]) > 0"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1995
  and compile: "rec_ci f = (fap, far, fft)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1996
  shows "\<exists> stp > 0. abc_steps_l (0, xs @ x # 0 \<up> (ft - Suc arity) @ anything) (fap @ B) stp =
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1997
    (0, xs @ Suc x # 0 \<up> (ft - Suc arity) @ anything)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1998
proof -
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  1999
  have "\<exists> stp. abc_steps_l (0, xs @ x # 0 \<up> (ft - Suc arity) @ anything) (fap @ B) stp =
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2000
    (length fap, xs @ x # rec_exec f (xs @ [x]) # 0 \<up> (ft - Suc (Suc arity)) @ anything)"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2001
  proof -
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2002
    have "\<exists> stp. abc_steps_l (0, xs @ x # 0 \<up> (ft - Suc arity) @ anything) fap stp =
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2003
      (length fap, xs @ x # rec_exec f (xs @ [x]) # 0 \<up> (ft - Suc (Suc arity)) @ anything)"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2004
    proof -
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2005
      have "{\<lambda>nl. nl = xs @ x # 0 \<up> (fft - far) @ 0\<up>(ft - fft) @ anything} fap 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2006
            {\<lambda>nl. nl = xs @ x # rec_exec f (xs @ [x]) # 0 \<up> (fft - Suc far) @ 0\<up>(ft - fft) @ anything}"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2007
        using ind by simp
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2008
      moreover have "fft > far"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2009
        using compile
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2010
        by(erule_tac footprint_ge)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2011
      ultimately show "?thesis"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2012
        using ft far
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2013
        apply(drule_tac abc_Hoare_haltE)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2014
        by(simp add: replicate_merge_anywhere max_absorb2)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2015
    qed
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2016
    then obtain stp where "abc_steps_l (0, xs @ x # 0 \<up> (ft - Suc arity) @ anything) fap stp =
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2017
      (length fap, xs @ x # rec_exec f (xs @ [x]) # 0 \<up> (ft - Suc (Suc arity)) @ anything)" ..
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2018
    thus "?thesis"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2019
      by(erule_tac abc_append_frist_steps_halt_eq)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2020
  qed
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2021
  moreover have 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2022
    "\<exists> stp > 0. abc_steps_l (length fap, xs @ x # rec_exec f (xs @ [x]) # 0 \<up> (ft - Suc (Suc arity)) @ anything) (fap @ B) stp =
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2023
    (0, xs @ Suc x # 0 # 0 \<up> (ft - Suc (Suc arity)) @ anything)"
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2024
    using mn_correct[of f fap far fft "rec_exec f (xs @ [x])" xs arity B
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2025
      "(\<lambda>stp. (abc_steps_l (length fap, xs @ x # rec_exec f (xs @ [x]) # 0 \<up> (ft - Suc (Suc arity)) @ anything) (fap @ B) stp, length fap, arity))"     
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2026
      x "0 \<up> (ft - Suc (Suc arity)) @ anything" "(\<lambda>((as, lm), ss, arity). as = 0)" 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2027
      "(\<lambda>((as, lm), ss, aritya). mn_ind_inv (as, lm) (length fap) x (rec_exec f (xs @ [x])) (0 \<up> (ft - Suc (Suc arity)) @ anything) xs) "]  
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2028
      B compile  exec_less len
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2029
    apply(subgoal_tac "fap \<noteq> []", auto)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2030
    apply(rule_tac x = stp in exI, auto simp: mn_ind_inv.simps)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2031
    by(case_tac "stp = 0", simp_all add: abc_steps_l.simps)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2032
  moreover have "fft > far"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2033
    using compile
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2034
    by(erule_tac footprint_ge)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2035
  ultimately show "?thesis"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2036
    using ft far
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2037
    apply(auto)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2038
    by(rule_tac x = "stp + stpa" in exI, 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2039
      simp add: abc_steps_add replicate_Suc[THEN sym] diff_Suc_Suc del: replicate_Suc)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2040
qed
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2041
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2042
lemma mn_loop_correct': 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2043
  assumes B:  "B = [Dec (Suc arity) (length fap + 5), Dec (Suc arity) (length fap + 3), Goto (Suc (length fap)), Inc arity, Goto 0]"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2044
  and ft: "ft = max (Suc arity) fft"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2045
  and len: "length xs = arity"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2046
  and ind_all: "\<forall>i\<le>x. (\<forall>xc. ({\<lambda>nl. nl = xs @ i # 0 \<up> (fft - far) @ xc} fap
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2047
    {\<lambda>nl. nl = xs @ i # rec_exec f (xs @ [i]) # 0 \<up> (fft - Suc far) @ xc}))"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2048
  and exec_ge: "\<forall> i\<le>x. rec_exec f (xs @ [i]) > 0"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2049
  and compile: "rec_ci f = (fap, far, fft)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2050
  and far: "far = Suc arity"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2051
  shows "\<exists> stp > x. abc_steps_l (0, xs @ 0 # 0 \<up> (ft - Suc arity) @ anything) (fap @ B) stp = 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2052
               (0, xs @ Suc x # 0 \<up> (ft - Suc arity) @ anything)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2053
using ind_all exec_ge
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2054
proof(induct x)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2055
  case 0
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2056
  thus "?case"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2057
    using assms
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2058
    by(rule_tac mn_loop, simp_all)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2059
next
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2060
  case (Suc x)
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2061
  have ind': "\<lbrakk>\<forall>i\<le>x. \<forall>xc. {\<lambda>nl. nl = xs @ i # 0 \<up> (fft - far) @ xc} fap {\<lambda>nl. nl = xs @ i # rec_exec f (xs @ [i]) # 0 \<up> (fft - Suc far) @ xc};
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2062
               \<forall>i\<le>x. 0 < rec_exec f (xs @ [i])\<rbrakk> \<Longrightarrow> 
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2063
            \<exists>stp > x. abc_steps_l (0, xs @ 0 # 0 \<up> (ft - Suc arity) @ anything) (fap @ B) stp = (0, xs @ Suc x # 0 \<up> (ft - Suc arity) @ anything)" by fact
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2064
  have exec_ge: "\<forall>i\<le>Suc x. 0 < rec_exec f (xs @ [i])" by fact
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2065
  have ind_all: "\<forall>i\<le>Suc x. \<forall>xc. {\<lambda>nl. nl = xs @ i # 0 \<up> (fft - far) @ xc} fap 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2066
    {\<lambda>nl. nl = xs @ i # rec_exec f (xs @ [i]) # 0 \<up> (fft - Suc far) @ xc}" by fact
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2067
  have ind: "\<exists>stp > x. abc_steps_l (0, xs @ 0 # 0 \<up> (ft - Suc arity) @ anything) (fap @ B) stp =
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2068
    (0, xs @ Suc x # 0 \<up> (ft - Suc arity) @ anything)" using ind' exec_ge ind_all by simp
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2069
  have stp: "\<exists> stp > 0. abc_steps_l (0, xs @ Suc x # 0 \<up> (ft - Suc arity) @ anything) (fap @ B) stp =
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2070
    (0, xs @ Suc (Suc x) # 0 \<up> (ft - Suc arity) @ anything)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2071
    using ind_all exec_ge B ft len far compile
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2072
    by(rule_tac mn_loop, simp_all)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2073
  from ind stp show "?case"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2074
    apply(auto)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2075
    by(rule_tac x = "stp + stpa" in exI, simp add: abc_steps_add)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2076
qed
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2077
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2078
lemma mn_loop_correct: 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2079
  assumes B:  "B = [Dec (Suc arity) (length fap + 5), Dec (Suc arity) (length fap + 3), Goto (Suc (length fap)), Inc arity, Goto 0]"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2080
  and ft: "ft = max (Suc arity) fft"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2081
  and len: "length xs = arity"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2082
  and ind_all: "\<forall>i\<le>x. (\<forall>xc. ({\<lambda>nl. nl = xs @ i # 0 \<up> (fft - far) @ xc} fap
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2083
    {\<lambda>nl. nl = xs @ i # rec_exec f (xs @ [i]) # 0 \<up> (fft - Suc far) @ xc}))"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2084
  and exec_ge: "\<forall> i\<le>x. rec_exec f (xs @ [i]) > 0"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2085
  and compile: "rec_ci f = (fap, far, fft)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2086
  and far: "far = Suc arity"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2087
  shows "\<exists> stp. abc_steps_l (0, xs @ 0 # 0 \<up> (ft - Suc arity) @ anything) (fap @ B) stp = 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2088
               (0, xs @ Suc x # 0 \<up> (ft - Suc arity) @ anything)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2089
proof -
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2090
  have "\<exists>stp>x. abc_steps_l (0, xs @ 0 # 0 \<up> (ft - Suc arity) @ anything) (fap @ B) stp = (0, xs @ Suc x # 0 \<up> (ft - Suc arity) @ anything)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2091
    using assms
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2092
    by(rule_tac mn_loop_correct', simp_all)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2093
  thus "?thesis"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2094
    by(auto)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2095
qed
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2096
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2097
lemma compile_mn_correct': 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2098
  assumes B:  "B = [Dec (Suc arity) (length fap + 5), Dec (Suc arity) (length fap + 3), Goto (Suc (length fap)), Inc arity, Goto 0]"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2099
  and ft: "ft = max (Suc arity) fft"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2100
  and len: "length xs = arity"
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2101
  and termi_f: "terminate f (xs @ [r])"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2102
  and f_ind: "\<And>anything. {\<lambda>nl. nl = xs @ r # 0 \<up> (fft - far) @ anything} fap 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2103
        {\<lambda>nl. nl = xs @ r # 0 # 0 \<up> (fft - Suc far) @ anything}"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2104
  and ind_all: "\<forall>i < r. (\<forall>xc. ({\<lambda>nl. nl = xs @ i # 0 \<up> (fft - far) @ xc} fap
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2105
    {\<lambda>nl. nl = xs @ i # rec_exec f (xs @ [i]) # 0 \<up> (fft - Suc far) @ xc}))"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2106
  and exec_less: "\<forall> i<r. rec_exec f (xs @ [i]) > 0"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2107
  and exec: "rec_exec f (xs @ [r]) = 0"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2108
  and compile: "rec_ci f = (fap, far, fft)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2109
  shows "{\<lambda>nl. nl = xs @ 0 \<up> (max (Suc arity) fft - arity) @ anything}
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2110
    fap @ B
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2111
    {\<lambda>nl. nl = xs @ rec_exec (Mn arity f) xs # 0 \<up> (max (Suc arity) fft - Suc arity) @ anything}"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2112
proof -
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2113
  have a: "far = Suc arity"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2114
    using len compile termi_f
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2115
    by(drule_tac param_pattern, auto)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2116
  have b: "fft > far"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2117
    using compile
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2118
    by(erule_tac footprint_ge)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2119
  have "\<exists> stp. abc_steps_l (0, xs @ 0 # 0 \<up> (ft - Suc arity) @ anything) (fap @ B) stp = 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2120
    (0, xs @ r # 0 \<up> (ft - Suc arity) @ anything)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2121
    using assms a
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2122
    apply(case_tac r, rule_tac x = 0 in exI, simp add: abc_steps_l.simps, simp)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2123
    by(rule_tac mn_loop_correct, auto)  
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2124
  moreover have 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2125
    "\<exists> stp. abc_steps_l (0, xs @ r # 0 \<up> (ft - Suc arity) @ anything) (fap @ B) stp = 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2126
    (length fap, xs @ r # rec_exec f (xs @ [r]) # 0 \<up> (ft - Suc (Suc arity)) @ anything)"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2127
  proof -
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2128
    have "\<exists> stp. abc_steps_l (0, xs @ r # 0 \<up> (ft - Suc arity) @ anything) fap stp =
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2129
      (length fap, xs @ r # rec_exec f (xs @ [r]) # 0 \<up> (ft - Suc (Suc arity)) @ anything)"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2130
    proof -
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2131
      have "{\<lambda>nl. nl = xs @ r # 0 \<up> (fft - far) @ 0\<up>(ft - fft) @ anything} fap 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2132
            {\<lambda>nl. nl = xs @ r # rec_exec f (xs @ [r]) # 0 \<up> (fft - Suc far) @ 0\<up>(ft - fft) @ anything}"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2133
        using f_ind exec by simp
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2134
      thus "?thesis"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2135
        using ft a b
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2136
        apply(drule_tac abc_Hoare_haltE)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2137
        by(simp add: replicate_merge_anywhere max_absorb2)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2138
    qed
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2139
    then obtain stp where "abc_steps_l (0, xs @ r # 0 \<up> (ft - Suc arity) @ anything) fap stp =
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2140
      (length fap, xs @ r # rec_exec f (xs @ [r]) # 0 \<up> (ft - Suc (Suc arity)) @ anything)" ..
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2141
    thus "?thesis"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2142
      by(erule_tac abc_append_frist_steps_halt_eq)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2143
  qed
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2144
  moreover have 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2145
    "\<exists> stp. abc_steps_l (length fap, xs @ r # rec_exec f (xs @ [r]) # 0 \<up> (ft - Suc (Suc arity)) @ anything) (fap @ B) stp = 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2146
             (length fap + 5, xs @ r # rec_exec f (xs @ [r]) # 0 \<up> (ft - Suc (Suc arity)) @ anything)"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2147
    using ft a b len B exec
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2148
    apply(rule_tac x = 1 in exI, auto)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2149
    by(auto simp: abc_steps_l.simps B abc_step_l.simps 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2150
      abc_fetch.simps nth_append max_absorb2 abc_lm_v.simps abc_lm_s.simps)
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2151
  moreover have "rec_exec (Mn (length xs) f) xs = r"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2152
    using exec exec_less
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2153
    apply(auto simp: rec_exec.simps Least_def)
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2154
    thm the_equality
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2155
    apply(rule_tac the_equality, auto)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2156
    apply(metis exec_less less_not_refl3 linorder_not_less)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2157
    by (metis le_neq_implies_less less_not_refl3)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2158
  ultimately show "?thesis"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2159
    using ft a b len B exec
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2160
    apply(auto simp: abc_Hoare_halt_def)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2161
    apply(rule_tac x = "stp + stpa + stpb"  in exI)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2162
    by(simp add: abc_steps_add replicate_Suc_iff_anywhere max_absorb2 Suc_diff_Suc del: replicate_Suc)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2163
qed
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2164
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2165
lemma compile_mn_correct:
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2166
  assumes len: "length xs = n"
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2167
  and termi_f: "terminate f (xs @ [r])"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2168
  and f_ind: "\<And>ap arity fp anything. rec_ci f = (ap, arity, fp) \<Longrightarrow> 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2169
  {\<lambda>nl. nl = xs @ r # 0 \<up> (fp - arity) @ anything} ap {\<lambda>nl. nl = xs @ r # 0 # 0 \<up> (fp - Suc arity) @ anything}"
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2170
  and exec: "rec_exec f (xs @ [r]) = 0"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2171
  and ind_all: 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2172
  "\<forall>i<r. terminate f (xs @ [i]) \<and>
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2173
  (\<forall>x xa xb. rec_ci f = (x, xa, xb) \<longrightarrow> 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2174
  (\<forall>xc. {\<lambda>nl. nl = xs @ i # 0 \<up> (xb - xa) @ xc} x {\<lambda>nl. nl = xs @ i # rec_exec f (xs @ [i]) # 0 \<up> (xb - Suc xa) @ xc})) \<and>
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2175
  0 < rec_exec f (xs @ [i])"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2176
  and compile: "rec_ci (Mn n f) = (ap, arity, fp)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2177
  shows "{\<lambda>nl. nl = xs @ 0 \<up> (fp - arity) @ anything} ap 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2178
  {\<lambda>nl. nl = xs @ rec_exec (Mn n f) xs # 0 \<up> (fp - Suc arity) @ anything}"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2179
proof(case_tac "rec_ci f")
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2180
  fix fap far fft
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2181
  assume h: "rec_ci f = (fap, far, fft)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2182
  hence f_newind: 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2183
    "\<And>anything. {\<lambda>nl. nl = xs @ r # 0 \<up> (fft - far) @ anything} fap 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2184
        {\<lambda>nl. nl = xs @ r # 0 # 0 \<up> (fft - Suc far) @ anything}"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2185
    by(rule_tac f_ind, simp)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2186
  have newind_all: 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2187
    "\<forall>i < r. (\<forall>xc. ({\<lambda>nl. nl = xs @ i # 0 \<up> (fft - far) @ xc} fap
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2188
    {\<lambda>nl. nl = xs @ i # rec_exec f (xs @ [i]) # 0 \<up> (fft - Suc far) @ xc}))"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2189
    using ind_all h
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2190
    by(auto)
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2191
  have all_less: "\<forall> i<r. rec_exec f (xs @ [i]) > 0"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2192
    using ind_all by auto
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2193
  show "?thesis"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2194
    using h compile f_newind newind_all all_less len termi_f exec
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2195
    apply(auto simp: rec_ci.simps)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2196
    by(rule_tac compile_mn_correct', auto)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2197
qed
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2198
    
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2199
lemma recursive_compile_correct:
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2200
   "\<lbrakk>terminate recf args; rec_ci recf = (ap, arity, fp)\<rbrakk>
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2201
  \<Longrightarrow> {\<lambda> nl. nl = args @ 0\<up>(fp - arity) @ anything} ap 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2202
         {\<lambda> nl. nl = args@ rec_exec recf args # 0\<up>(fp - Suc arity) @ anything}"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2203
apply(induct arbitrary: ap arity fp anything r rule: terminate.induct)
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2204
apply(simp_all add: compile_s_correct compile_z_correct compile_id_correct 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2205
                    compile_cn_correct compile_pr_correct compile_mn_correct)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2206
done
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2207
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2208
definition dummy_abc :: "nat \<Rightarrow> abc_inst list"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2209
where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2210
"dummy_abc k = [Inc k, Dec k 0, Goto 3]"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2211
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2212
definition abc_list_crsp:: "nat list \<Rightarrow> nat list \<Rightarrow> bool"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2213
  where
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2214
  "abc_list_crsp xs ys = (\<exists> n. xs = ys @ 0\<up>n \<or> ys = xs @ 0\<up>n)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2215
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2216
lemma abc_list_crsp_simp1[intro]: "abc_list_crsp (lm @ 0\<up>m) lm"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2217
by(auto simp: abc_list_crsp_def)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2218
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2219
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2220
lemma abc_list_crsp_lm_v: 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2221
  "abc_list_crsp lma lmb \<Longrightarrow> abc_lm_v lma n = abc_lm_v lmb n"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2222
by(auto simp: abc_list_crsp_def abc_lm_v.simps 
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2223
                 nth_append)
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2224
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2225
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2226
lemma abc_list_crsp_elim: 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2227
  "\<lbrakk>abc_list_crsp lma lmb; \<exists> n. lma = lmb @ 0\<up>n \<or> lmb = lma @ 0\<up>n \<Longrightarrow> P \<rbrakk> \<Longrightarrow> P"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2228
by(auto simp: abc_list_crsp_def)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2229
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: 285
diff changeset
  2230
lemma abc_list_crsp_simp[simp]: 
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2231
  "\<lbrakk>abc_list_crsp lma lmb; m < length lma; m < length lmb\<rbrakk> \<Longrightarrow>
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2232
          abc_list_crsp (lma[m := n]) (lmb[m := n])"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2233
by(auto simp: abc_list_crsp_def list_update_append)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2234
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: 285
diff changeset
  2235
lemma abc_list_crsp_simp2[simp]: 
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2236
  "\<lbrakk>abc_list_crsp lma lmb; m < length lma; \<not> m < length lmb\<rbrakk> \<Longrightarrow> 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2237
  abc_list_crsp (lma[m := n]) (lmb @ 0 \<up> (m - length lmb) @ [n])"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2238
apply(auto simp: abc_list_crsp_def list_update_append)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2239
apply(rule_tac x = "na + length lmb - Suc m" in exI)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2240
apply(rule_tac disjI1)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2241
apply(simp add: upd_conv_take_nth_drop min_absorb1)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2242
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2243
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: 285
diff changeset
  2244
lemma abc_list_crsp_simp3[simp]:
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2245
  "\<lbrakk>abc_list_crsp lma lmb; \<not> m < length lma; m < length lmb\<rbrakk> \<Longrightarrow> 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2246
  abc_list_crsp (lma @ 0 \<up> (m - length lma) @ [n]) (lmb[m := n])"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2247
apply(auto simp: abc_list_crsp_def list_update_append)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2248
apply(rule_tac x = "na + length lma - Suc m" in exI)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2249
apply(rule_tac disjI2)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2250
apply(simp add: upd_conv_take_nth_drop min_absorb1)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2251
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2252
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: 285
diff changeset
  2253
lemma abc_list_crsp_simp4[simp]: "\<lbrakk>abc_list_crsp lma lmb; \<not> m < length lma; \<not> m < length lmb\<rbrakk> \<Longrightarrow> 
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2254
  abc_list_crsp (lma @ 0 \<up> (m - length lma) @ [n]) (lmb @ 0 \<up> (m - length lmb) @ [n])"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2255
  by(auto simp: abc_list_crsp_def list_update_append replicate_merge_anywhere)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2256
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2257
lemma abc_list_crsp_lm_s: 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2258
  "abc_list_crsp lma lmb \<Longrightarrow> 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2259
      abc_list_crsp (abc_lm_s lma m n) (abc_lm_s lmb m n)"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2260
by(auto simp: abc_lm_s.simps)
70
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
lemma abc_list_crsp_step: 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2263
  "\<lbrakk>abc_list_crsp lma lmb; abc_step_l (aa, lma) i = (a, lma'); 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2264
    abc_step_l (aa, lmb) i = (a', lmb')\<rbrakk>
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2265
    \<Longrightarrow> a' = a \<and> abc_list_crsp lma' lmb'"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2266
apply(case_tac i, auto simp: abc_step_l.simps 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2267
       abc_list_crsp_lm_s abc_list_crsp_lm_v Let_def 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2268
                       split: abc_inst.splits if_splits)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2269
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2270
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2271
lemma abc_list_crsp_steps: 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2272
  "\<lbrakk>abc_steps_l (0, lm @ 0\<up>m) aprog stp = (a, lm'); aprog \<noteq> []\<rbrakk> 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2273
      \<Longrightarrow> \<exists> lma. abc_steps_l (0, lm) aprog stp = (a, lma) \<and> 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2274
                                          abc_list_crsp lm' lma"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2275
apply(induct stp arbitrary: a lm', simp add: abc_steps_l.simps, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2276
apply(case_tac "abc_steps_l (0, lm @ 0\<up>m) aprog stp", 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2277
      simp add: abc_step_red)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2278
proof -
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2279
  fix stp a lm' aa b
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2280
  assume ind:
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2281
    "\<And>a lm'. aa = a \<and> b = lm' \<Longrightarrow> 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2282
     \<exists>lma. abc_steps_l (0, lm) aprog stp = (a, lma) \<and>
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2283
                                          abc_list_crsp lm' lma"
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: 285
diff changeset
  2284
    and h: "abc_step_l (aa, b) (abc_fetch aa aprog) = (a, lm')" 
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2285
           "abc_steps_l (0, lm @ 0\<up>m) aprog stp = (aa, b)" 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2286
           "aprog \<noteq> []"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2287
  have "\<exists>lma. abc_steps_l (0, lm) aprog stp = (aa, lma) \<and> 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2288
              abc_list_crsp b lma"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2289
    apply(rule_tac ind, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2290
    done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2291
  from this obtain lma where g2: 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2292
    "abc_steps_l (0, lm) aprog stp = (aa, lma) \<and> 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2293
     abc_list_crsp b lma"   ..
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2294
  hence g3: "abc_steps_l (0, lm) aprog (Suc stp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2295
          = abc_step_l (aa, lma) (abc_fetch aa aprog)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2296
    apply(rule_tac abc_step_red, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2297
    done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2298
  show "\<exists>lma. abc_steps_l (0, lm) aprog (Suc stp) = (a, lma) \<and> abc_list_crsp lm' lma"
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: 285
diff changeset
  2299
    using g2 g3 h
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2300
    apply(auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2301
    apply(case_tac "abc_step_l (aa, b) (abc_fetch aa aprog)",
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2302
          case_tac "abc_step_l (aa, lma) (abc_fetch aa aprog)", simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2303
    apply(rule_tac abc_list_crsp_step, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2304
    done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2305
qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2306
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2307
lemma list_crsp_simp2: "abc_list_crsp (lm1 @ 0\<up>n) lm2 \<Longrightarrow> abc_list_crsp lm1 lm2"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2308
proof(induct n)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2309
  case 0
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2310
  thus "?case"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2311
    by(auto simp: abc_list_crsp_def)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2312
next
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2313
  case (Suc n)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2314
  have ind: "abc_list_crsp (lm1 @ 0 \<up> n) lm2 \<Longrightarrow> abc_list_crsp lm1 lm2" by fact
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2315
  have h: "abc_list_crsp (lm1 @ 0 \<up> Suc n) lm2" by fact
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2316
  then have "abc_list_crsp (lm1 @ 0 \<up> n) lm2"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2317
    apply(auto simp: exp_suc abc_list_crsp_def del: replicate_Suc)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2318
    apply(case_tac n, simp_all add: exp_suc replicate_Suc[THEN sym] del: replicate_Suc, auto)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2319
    apply(rule_tac x = 1 in exI, simp)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2320
    by(rule_tac x = "Suc n" in exI, simp,  simp add: exp_suc replicate_Suc[THEN sym] del: replicate_Suc)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2321
  thus "?case"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2322
    using ind
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2323
    by auto
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2324
qed
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2325
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2326
lemma recursive_compile_correct_norm': 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2327
  "\<lbrakk>rec_ci f = (ap, arity, ft);  
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2328
    terminate f args\<rbrakk>
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2329
  \<Longrightarrow> \<exists> stp rl. (abc_steps_l (0, args) ap stp) = (length ap, rl) \<and> abc_list_crsp (args @ [rec_exec f args]) rl"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2330
  using recursive_compile_correct[of f args ap arity ft "[]"]
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2331
apply(auto simp: abc_Hoare_halt_def)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2332
apply(rule_tac x = n in exI)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2333
apply(case_tac "abc_steps_l (0, args @ 0 \<up> (ft - arity)) ap n", auto)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2334
apply(drule_tac abc_list_crsp_steps, auto)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2335
apply(rule_tac list_crsp_simp2, auto)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2336
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2337
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: 285
diff changeset
  2338
lemma find_exponent_rec_exec[simp]:
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2339
  assumes a: "args @ [rec_exec f args] = lm @ 0 \<up> n"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2340
  and b: "length args < length lm"
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2341
  shows "\<exists>m. lm = args @ rec_exec f args # 0 \<up> m"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2342
using assms
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2343
apply(case_tac n, simp)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2344
apply(rule_tac x = 0 in exI, simp)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2345
apply(drule_tac length_equal, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2346
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2347
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: 285
diff changeset
  2348
lemma find_exponent_complex[simp]: 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2349
"\<lbrakk>args @ [rec_exec f args] = lm @ 0 \<up> n; \<not> length args < length lm\<rbrakk>
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2350
  \<Longrightarrow> \<exists>m. (lm @ 0 \<up> (length args - length lm) @ [Suc 0])[length args := 0] =
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2351
  args @ rec_exec f args # 0 \<up> m"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2352
apply(case_tac n, simp_all add: exp_suc list_update_append list_update.simps del: replicate_Suc)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2353
apply(subgoal_tac "length args = Suc (length lm)", simp)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2354
apply(rule_tac x = "Suc (Suc 0)" in exI, simp)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2355
apply(drule_tac length_equal, simp, auto)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2356
done
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2357
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2358
lemma compile_append_dummy_correct: 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2359
  assumes compile: "rec_ci f = (ap, ary, fp)"
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2360
  and termi: "terminate f args"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2361
  shows "{\<lambda> nl. nl = args} (ap [+] dummy_abc (length args)) {\<lambda> nl. (\<exists> m. nl = args @ rec_exec f args # 0\<up>m)}"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2362
proof(rule_tac abc_Hoare_plus_halt)
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2363
  show "{\<lambda>nl. nl = args} ap {\<lambda> nl. abc_list_crsp (args @ [rec_exec f args]) nl}"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2364
    using compile termi recursive_compile_correct_norm'[of f ap ary fp args]
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2365
    apply(auto simp: abc_Hoare_halt_def)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2366
    by(rule_tac x = stp in exI, simp)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2367
next
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2368
  show "{abc_list_crsp (args @ [rec_exec f args])} dummy_abc (length args) 
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2369
    {\<lambda>nl. \<exists>m. nl = args @ rec_exec f args # 0 \<up> m}"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2370
    apply(auto simp: dummy_abc_def abc_Hoare_halt_def)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2371
    apply(rule_tac x = 3 in exI)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2372
    by(auto simp: abc_steps_l.simps abc_list_crsp_def abc_step_l.simps numeral_3_eq_3 abc_fetch.simps
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2373
                     abc_lm_v.simps nth_append abc_lm_s.simps)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2374
qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2375
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2376
lemma cn_merge_gs_split: 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2377
  "\<lbrakk>i < length gs; rec_ci (gs!i) = (ga, gb, gc)\<rbrakk> \<Longrightarrow> 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2378
  cn_merge_gs (map rec_ci gs) p =  cn_merge_gs (map rec_ci (take i gs)) p [+] (ga [+] 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2379
       mv_box gb (p + i)) [+]  cn_merge_gs (map rec_ci (drop (Suc i) gs)) (p + Suc i)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2380
apply(induct i arbitrary: gs p, case_tac gs, simp, simp)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2381
apply(case_tac gs, simp, case_tac "rec_ci a", 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2382
       simp add: abc_comp_commute[THEN sym])
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2383
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2384
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2385
lemma cn_unhalt_case:
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2386
  assumes compile1: "rec_ci (Cn n f gs) = (ap, ar, ft) \<and> length args = ar"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2387
  and g: "i < length gs"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2388
  and compile2: "rec_ci (gs!i) = (gap, gar, gft) \<and> gar = length args"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2389
  and g_unhalt: "\<And> anything. {\<lambda> nl. nl = args @ 0\<up>(gft - gar) @ anything} gap \<up>"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2390
  and g_ind: "\<And> apj arj ftj j anything. \<lbrakk>j < i; rec_ci (gs!j) = (apj, arj, ftj)\<rbrakk> 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2391
  \<Longrightarrow> {\<lambda> nl. nl = args @ 0\<up>(ftj - arj) @ anything} apj {\<lambda> nl. nl = args @ rec_exec (gs!j) args # 0\<up>(ftj - Suc arj) @ anything}"
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2392
  and all_termi: "\<forall> j<i. terminate (gs!j) args"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2393
  shows "{\<lambda> nl. nl = args @ 0\<up>(ft - ar) @ anything} ap \<up>"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2394
using compile1
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2395
apply(case_tac "rec_ci f", auto simp: rec_ci.simps abc_comp_commute)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2396
proof(rule_tac abc_Hoare_plus_unhalt1)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2397
  fix fap far fft
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2398
  let ?ft = "max (Suc (length args)) (Max (insert fft ((\<lambda>(aprog, p, n). n) ` rec_ci ` set gs)))"
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2399
  let ?Q = "\<lambda>nl. nl = args @ 0\<up> (?ft - length args) @ map (\<lambda>i. rec_exec i args) (take i gs) @ 
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2400
    0\<up>(length gs - i) @ 0\<up> Suc (length args) @ anything"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2401
  have "cn_merge_gs (map rec_ci gs) ?ft = 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2402
    cn_merge_gs (map rec_ci (take i gs)) ?ft [+] (gap [+] 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2403
    mv_box gar (?ft + i)) [+]  cn_merge_gs (map rec_ci (drop (Suc i) gs)) (?ft + Suc i)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2404
    using g compile2 cn_merge_gs_split by simp
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2405
  thus "{\<lambda>nl. nl = args @ 0 # 0 \<up> (?ft + length gs) @ anything} (cn_merge_gs (map rec_ci gs) ?ft) \<up>"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2406
  proof(simp, rule_tac abc_Hoare_plus_unhalt1, rule_tac abc_Hoare_plus_unhalt2, 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2407
              rule_tac abc_Hoare_plus_unhalt1)
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2408
    let ?Q_tmp = "\<lambda>nl. nl = args @ 0\<up> (gft - gar) @ 0\<up>(?ft - (length args) - (gft -gar)) @ map (\<lambda>i. rec_exec i args) (take i gs) @ 
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2409
      0\<up>(length gs - i) @ 0\<up> Suc (length args) @ anything"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2410
    have a: "{?Q_tmp} gap \<up>"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2411
      using g_unhalt[of "0 \<up> (?ft - (length args) - (gft - gar)) @
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2412
        map (\<lambda>i. rec_exec i args) (take i gs) @ 0 \<up> (length gs - i) @ 0 \<up> Suc (length args) @ anything"]
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2413
      by simp
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2414
    moreover have "?ft \<ge> gft"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2415
      using g compile2
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: 285
diff changeset
  2416
      apply(rule_tac max.coboundedI2, rule_tac Max_ge, simp, rule_tac insertI2)
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2417
      apply(rule_tac  x = "rec_ci (gs ! i)" in image_eqI, simp)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2418
      by(rule_tac x = "gs!i"  in image_eqI, simp, simp)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2419
    then have b:"?Q_tmp = ?Q"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2420
      using compile2
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2421
      apply(rule_tac arg_cong)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2422
      by(simp add: replicate_merge_anywhere)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2423
    thus "{?Q} gap \<up>"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2424
      using a by simp
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2425
  next
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2426
    show "{\<lambda>nl. nl = args @ 0 # 0 \<up> (?ft + length gs) @ anything} 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2427
      cn_merge_gs (map rec_ci (take i gs)) ?ft
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2428
       {\<lambda>nl. nl = args @ 0 \<up> (?ft - length args) @
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2429
      map (\<lambda>i. rec_exec i args) (take i gs) @ 0 \<up> (length gs - i) @ 0 \<up> Suc (length args) @ anything}"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2430
      using all_termi
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2431
      apply(rule_tac compile_cn_gs_correct', auto simp: set_conv_nth)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2432
      by(drule_tac apj = x and arj = xa and  ftj = xb and j = ia and anything = xc in g_ind, auto)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2433
  qed
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2434
qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2435
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2436
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2437
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2438
lemma mn_unhalt_case':
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2439
  assumes compile: "rec_ci f = (a, b, c)"
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2440
  and all_termi: "\<forall>i. terminate f (args @ [i]) \<and> 0 < rec_exec f (args @ [i])"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2441
  and B: "B = [Dec (Suc (length args)) (length a + 5), Dec (Suc (length args)) (length a + 3), 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2442
  Goto (Suc (length a)), Inc (length args), Goto 0]"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2443
  shows "{\<lambda>nl. nl = args @ 0 \<up> (max (Suc (length args)) c - length args) @ anything}
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2444
  a @ B \<up>"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2445
proof(rule_tac abc_Hoare_unhaltI, auto)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2446
  fix n
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2447
  have a:  "b = Suc (length args)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2448
    using all_termi compile
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2449
    apply(erule_tac x = 0 in allE)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2450
    by(auto, drule_tac param_pattern,auto)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2451
  moreover have b: "c > b"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2452
    using compile by(elim footprint_ge)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2453
  ultimately have c: "max (Suc (length args)) c = c" by arith
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2454
  have "\<exists> stp > n. abc_steps_l (0, args @ 0 # 0\<up>(c - Suc (length args)) @ anything) (a @ B) stp
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2455
         = (0, args @ Suc n # 0\<up>(c - Suc (length args)) @ anything)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2456
    using assms a b c
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2457
  proof(rule_tac mn_loop_correct', auto)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2458
    fix i xc
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2459
    show "{\<lambda>nl. nl = args @ i # 0 \<up> (c - Suc (length args)) @ xc} a 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2460
      {\<lambda>nl. nl = args @ i # rec_exec f (args @ [i]) # 0 \<up> (c - Suc (Suc (length args))) @ xc}"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2461
      using all_termi recursive_compile_correct[of f "args @ [i]" a b c xc] compile a
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2462
      by(simp)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2463
  qed
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2464
  then obtain stp where d: "stp > n \<and> abc_steps_l (0, args @ 0 # 0\<up>(c - Suc (length args)) @ anything) (a @ B) stp
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2465
         = (0, args @ Suc n # 0\<up>(c - Suc (length args)) @ anything)" ..
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2466
  then obtain d where e: "stp = n + Suc d"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2467
    by (metis add_Suc_right less_iff_Suc_add)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2468
  obtain s nl where f: "abc_steps_l (0, args @ 0 # 0\<up>(c - Suc (length args)) @ anything) (a @ B) n = (s, nl)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2469
    by (metis prod.exhaust)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2470
  have g: "s < length (a @ B)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2471
    using d e f
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2472
    apply(rule_tac classical, simp only: abc_steps_add)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2473
    by(simp add: halt_steps2 leI)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2474
  from f g show "abc_notfinal (abc_steps_l (0, args @ 0 \<up> 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2475
    (max (Suc (length args)) c - length args) @ anything) (a @ B) n) (a @ B)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2476
    using c b a
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2477
    by(simp add: replicate_Suc_iff_anywhere Suc_diff_Suc del: replicate_Suc)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2478
qed
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2479
    
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2480
lemma mn_unhalt_case: 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2481
  assumes compile: "rec_ci (Mn n f) = (ap, ar, ft) \<and> length args = ar"
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2482
  and all_term: "\<forall> i. terminate f (args @ [i]) \<and> rec_exec f (args @ [i]) > 0"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2483
  shows "{\<lambda> nl. nl = args @ 0\<up>(ft - ar) @ anything} ap \<up> "
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2484
  using assms
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2485
apply(case_tac "rec_ci f", auto simp: rec_ci.simps abc_comp_commute)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2486
by(rule_tac mn_unhalt_case', simp_all)
129
c3832c4963c4 updated recursive
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 126
diff changeset
  2487
c3832c4963c4 updated recursive
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 126
diff changeset
  2488
fun tm_of_rec :: "recf \<Rightarrow> instr list"
c3832c4963c4 updated recursive
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 126
diff changeset
  2489
where "tm_of_rec recf = (let (ap, k, fp) = rec_ci recf in
c3832c4963c4 updated recursive
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 126
diff changeset
  2490
                         let tp = tm_of (ap [+] dummy_abc k) in 
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2491
                           tp @ (shift (mopup k) (length tp div 2)))"
129
c3832c4963c4 updated recursive
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 126
diff changeset
  2492
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2493
lemma recursive_compile_to_tm_correct1: 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2494
  assumes  compile: "rec_ci recf = (ap, ary, fp)"
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2495
  and termi: " terminate recf args"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2496
  and tp: "tp = tm_of (ap [+] dummy_abc (length args))"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2497
  shows "\<exists> stp m l. steps0 (Suc 0, Bk # Bk # ires, <args> @ Bk\<up>rn)
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2498
  (tp @ shift (mopup (length args)) (length tp div 2)) stp = (0, Bk\<up>m @ Bk # Bk # ires, Oc\<up>Suc (rec_exec recf args) @ Bk\<up>l)"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2499
proof -
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2500
  have "{\<lambda>nl. nl = args} ap [+] dummy_abc (length args) {\<lambda>nl. \<exists>m. nl = args @ rec_exec recf args # 0 \<up> m}"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2501
    using compile termi compile
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2502
    by(rule_tac compile_append_dummy_correct, auto)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2503
  then obtain stp m where h: "abc_steps_l (0, args) (ap [+] dummy_abc (length args)) stp = 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2504
    (length (ap [+] dummy_abc (length args)), args @ rec_exec recf args # 0\<up>m) "
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2505
    apply(simp add: abc_Hoare_halt_def, auto)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2506
    by(case_tac "abc_steps_l (0, args) (ap [+] dummy_abc (length args)) n", auto)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2507
  thus "?thesis"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2508
    using assms tp
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2509
    by(rule_tac  lm = args and stp = stp and am = "args @ rec_exec recf args # 0 \<up> m"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2510
      in compile_correct_halt, auto simp: crsp.simps start_of.simps length_abc_comp abc_lm_v.simps)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2511
qed
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2512
126
0b302c0b449a updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 70
diff changeset
  2513
lemma recursive_compile_to_tm_correct2: 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2514
  assumes termi: " terminate recf args"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2515
  shows "\<exists> stp m l. steps0 (Suc 0, [Bk, Bk], <args>) (tm_of_rec recf) stp = 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2516
                     (0, Bk\<up>Suc (Suc m), Oc\<up>Suc (rec_exec recf args) @ Bk\<up>l)"
230
49dcc0b9b0b3 adapted paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 229
diff changeset
  2517
proof(case_tac "rec_ci recf", simp add: tm_of_rec.simps)
49dcc0b9b0b3 adapted paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 229
diff changeset
  2518
  fix ap ar fp
49dcc0b9b0b3 adapted paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 229
diff changeset
  2519
  assume "rec_ci recf = (ap, ar, fp)"
49dcc0b9b0b3 adapted paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 229
diff changeset
  2520
  thus "\<exists>stp m l. steps0 (Suc 0, [Bk, Bk], <args>) 
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: 285
diff changeset
  2521
    (tm_of (ap [+] dummy_abc ar) @ shift (mopup ar) (sum_list (layout_of (ap [+] dummy_abc ar)))) stp =
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2522
    (0, Bk # Bk # Bk \<up> m, Oc # Oc \<up> rec_exec recf args @ Bk \<up> l)"
230
49dcc0b9b0b3 adapted paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 229
diff changeset
  2523
    using recursive_compile_to_tm_correct1[of recf ap ar fp args "tm_of (ap [+] dummy_abc (length args))" "[]" 0]
49dcc0b9b0b3 adapted paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 229
diff changeset
  2524
      assms param_pattern[of recf args ap ar fp]
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: 285
diff changeset
  2525
    by(simp add: replicate_Suc[THEN sym] replicate_Suc_iff_anywhere del: replicate_Suc, 
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 285
diff changeset
  2526
       simp add: exp_suc del: replicate_Suc)
230
49dcc0b9b0b3 adapted paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 229
diff changeset
  2527
qed
126
0b302c0b449a updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 70
diff changeset
  2528
129
c3832c4963c4 updated recursive
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 126
diff changeset
  2529
lemma recursive_compile_to_tm_correct3: 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2530
  assumes termi: "terminate recf args"
230
49dcc0b9b0b3 adapted paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 229
diff changeset
  2531
  shows "{\<lambda> tp. tp =([Bk, Bk], <args>)} (tm_of_rec recf) 
248
aea02b5a58d2 repaired old files
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 240
diff changeset
  2532
         {\<lambda> tp. \<exists> k l. tp = (Bk\<up> k, <rec_exec recf args> @ Bk \<up> l)}"
230
49dcc0b9b0b3 adapted paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 229
diff changeset
  2533
using recursive_compile_to_tm_correct2[OF assms]
49dcc0b9b0b3 adapted paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 229
diff changeset
  2534
apply(auto simp add: Hoare_halt_def)
49dcc0b9b0b3 adapted paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 229
diff changeset
  2535
apply(rule_tac x = stp in exI)
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: 285
diff changeset
  2536
apply(auto simp add: tape_of_nat_def)
230
49dcc0b9b0b3 adapted paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 229
diff changeset
  2537
apply(rule_tac x = "Suc (Suc m)" in exI)
49dcc0b9b0b3 adapted paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 229
diff changeset
  2538
apply(simp)
49dcc0b9b0b3 adapted paper
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 229
diff changeset
  2539
done 
129
c3832c4963c4 updated recursive
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 126
diff changeset
  2540
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: 285
diff changeset
  2541
lemma list_all_suc_many[simp]:
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2542
  "list_all (\<lambda>(acn, s). s \<le> Suc (Suc (Suc (Suc (Suc (Suc (2 * n))))))) xs \<Longrightarrow>
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2543
  list_all (\<lambda>(acn, s). s \<le> Suc (Suc (Suc (Suc (Suc (Suc (Suc (Suc (2 * n))))))))) xs"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2544
apply(induct xs, simp, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2545
apply(case_tac a, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2546
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2547
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2548
lemma shift_append: "shift (xs @ ys) n = shift xs n @ shift ys n"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2549
apply(simp add: shift.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2550
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2551
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: 285
diff changeset
  2552
lemma length_shift_mopup[simp]: "length (shift (mopup n) ss) = 4 * n + 12"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2553
apply(auto simp: mopup.simps shift_append mopup_b_def)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2554
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2555
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2556
lemma length_tm_even[intro]: "length (tm_of ap) mod 2 = 0"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2557
apply(simp add: tm_of.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2558
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2559
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: 285
diff changeset
  2560
lemma tms_of_at_index[simp]: "k < length ap \<Longrightarrow> tms_of ap ! k  = 
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2561
 ci (layout_of ap) (start_of (layout_of ap) k) (ap ! k)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2562
apply(simp add: tms_of.simps tpairs_of.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2563
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2564
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2565
lemma start_of_suc_inc:
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2566
  "\<lbrakk>k < length ap; ap ! k = Inc n\<rbrakk> \<Longrightarrow> start_of (layout_of ap) (Suc k) =
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2567
                        start_of (layout_of ap) k + 2 * n + 9"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2568
apply(rule_tac start_of_Suc1, auto simp: abc_fetch.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2569
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2570
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2571
lemma start_of_suc_dec:
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2572
  "\<lbrakk>k < length ap; ap ! k = (Dec n e)\<rbrakk> \<Longrightarrow> start_of (layout_of ap) (Suc k) =
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2573
                        start_of (layout_of ap) k + 2 * n + 16"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2574
apply(rule_tac start_of_Suc2, auto simp: abc_fetch.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2575
done
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
lemma inc_state_all_le:
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2578
  "\<lbrakk>k < length ap; ap ! k = Inc n; 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2579
       (a, b) \<in> set (shift (shift tinc_b (2 * n)) 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2580
                            (start_of (layout_of ap) k - Suc 0))\<rbrakk>
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2581
       \<Longrightarrow> b \<le> start_of (layout_of ap) (length ap)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2582
apply(subgoal_tac "b \<le> start_of (layout_of ap) (Suc k)")
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2583
apply(subgoal_tac "start_of (layout_of ap) (Suc k) \<le> start_of (layout_of ap) (length ap) ")
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2584
apply(arith)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2585
apply(case_tac "Suc k = length ap", simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2586
apply(rule_tac start_of_less, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2587
apply(auto simp: tinc_b_def shift.simps start_of_suc_inc length_of.simps startof_not0)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2588
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2589
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2590
lemma findnth_le[elim]: 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2591
  "(a, b) \<in> set (shift (findnth n) (start_of (layout_of ap) k - Suc 0))
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2592
  \<Longrightarrow> b \<le> Suc (start_of (layout_of ap) k + 2 * n)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2593
apply(induct n, simp add: findnth.simps shift.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2594
apply(simp add: findnth.simps shift_append, auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2595
apply(auto simp: shift.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2596
done
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
lemma findnth_state_all_le1:
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2599
  "\<lbrakk>k < length ap; ap ! k = Inc n;
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2600
  (a, b) \<in> 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2601
  set (shift (findnth n) (start_of (layout_of ap) k - Suc 0))\<rbrakk> 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2602
  \<Longrightarrow> b \<le> start_of (layout_of ap) (length ap)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2603
apply(subgoal_tac "b \<le> start_of (layout_of ap) (Suc k)")
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2604
apply(subgoal_tac "start_of (layout_of ap) (Suc k) \<le> start_of (layout_of ap) (length ap) ")
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2605
apply(arith)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2606
apply(case_tac "Suc k = length ap", simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2607
apply(rule_tac start_of_less, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2608
apply(subgoal_tac "b \<le> start_of (layout_of ap) k + 2*n + 1 \<and> 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2609
     start_of (layout_of ap) k + 2*n + 1 \<le>  start_of (layout_of ap) (Suc k)", auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2610
apply(auto simp: tinc_b_def shift.simps length_of.simps startof_not0 start_of_suc_inc)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2611
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2612
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2613
lemma start_of_eq: "length ap < as \<Longrightarrow> start_of (layout_of ap) as = start_of (layout_of ap) (length ap)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2614
apply(induct as, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2615
apply(case_tac "length ap < as", simp add: start_of.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2616
apply(subgoal_tac "as = length ap")
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2617
apply(simp add: start_of.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2618
apply arith
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2619
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2620
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2621
lemma start_of_all_le: "start_of (layout_of ap) as \<le> start_of (layout_of ap) (length ap)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2622
apply(subgoal_tac "as > length ap \<or> as = length ap \<or> as < length ap", 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2623
      auto simp: start_of_eq start_of_less)
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
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2626
lemma findnth_state_all_le2: 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2627
  "\<lbrakk>k < length ap; 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2628
  ap ! k = Dec n e;
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2629
  (a, b) \<in> set (shift (findnth n) (start_of (layout_of ap) k - Suc 0))\<rbrakk>
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2630
  \<Longrightarrow> b \<le> start_of (layout_of ap) (length ap)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2631
apply(subgoal_tac "b \<le> start_of (layout_of ap) k + 2*n + 1 \<and> 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2632
     start_of (layout_of ap) k + 2*n + 1 \<le>  start_of (layout_of ap) (Suc k) \<and>
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2633
      start_of (layout_of ap) (Suc k) \<le> start_of (layout_of ap) (length ap)", auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2634
apply(subgoal_tac "start_of (layout_of ap) (Suc k) = 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2635
  start_of  (layout_of ap)  k + 2*n + 16", simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2636
apply(simp add: start_of_suc_dec)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2637
apply(rule_tac start_of_all_le)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2638
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2639
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2640
lemma dec_state_all_le[simp]:
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2641
  "\<lbrakk>k < length ap; ap ! k = Dec n e; 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2642
  (a, b) \<in> set (shift (shift tdec_b (2 * n))
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2643
  (start_of (layout_of ap) k - Suc 0))\<rbrakk>
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2644
       \<Longrightarrow> b \<le> start_of (layout_of ap) (length ap)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2645
apply(subgoal_tac "2*n + start_of (layout_of ap) k + 16 \<le> start_of (layout_of ap) (length ap) \<and> start_of (layout_of ap) k > 0")
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2646
prefer 2
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2647
apply(subgoal_tac "start_of (layout_of ap) (Suc k) = start_of (layout_of ap) k + 2*n + 16
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2648
                 \<and> start_of (layout_of ap) (Suc k) \<le> start_of (layout_of ap) (length ap)")
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2649
apply(simp add: startof_not0, rule_tac conjI)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2650
apply(simp add: start_of_suc_dec)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2651
apply(rule_tac start_of_all_le)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2652
apply(auto simp: tdec_b_def shift.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2653
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2654
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2655
lemma tms_any_less: 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2656
  "\<lbrakk>k < length ap; (a, b) \<in> set (tms_of ap ! k)\<rbrakk> \<Longrightarrow> 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2657
  b \<le> start_of (layout_of ap) (length ap)"
190
f1ecb4a68a54 renamed sete definition to adjust and old special case of adjust to adjust0
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 172
diff changeset
  2658
apply(case_tac "ap!k", auto simp: tms_of.simps tpairs_of.simps ci.simps shift_append adjust.simps)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2659
apply(erule_tac findnth_state_all_le1, simp_all)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2660
apply(erule_tac inc_state_all_le, simp_all)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2661
apply(erule_tac findnth_state_all_le2, simp_all)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2662
apply(rule_tac start_of_all_le)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2663
apply(rule_tac start_of_all_le)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2664
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2665
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2666
lemma concat_in: "i < length (concat xs) \<Longrightarrow> 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2667
  \<exists>k < length xs. concat xs ! i \<in> set (xs ! k)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2668
apply(induct xs rule: rev_induct, simp, simp)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2669
apply(case_tac "i < length (concat xs)", simp)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2670
apply(erule_tac exE, rule_tac x = k in exI)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2671
apply(simp add: nth_append)
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2672
apply(rule_tac x = "length xs" in exI, simp)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2673
apply(simp add: nth_append)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2674
done 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2675
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: 285
diff changeset
  2676
lemma length_tms_of[simp]: "length (tms_of ap) = length ap"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2677
apply(simp add: tms_of.simps tpairs_of.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2678
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2679
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2680
declare length_concat[simp]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2681
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2682
lemma in_tms: "i < length (tm_of ap) \<Longrightarrow> \<exists> k < length ap. (tm_of ap ! i) \<in> set (tms_of ap ! k)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2683
apply(simp only: tm_of.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2684
using concat_in[of i "tms_of ap"]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2685
apply(auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2686
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2687
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2688
lemma all_le_start_of: "list_all (\<lambda>(acn, s). 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2689
  s \<le> start_of (layout_of ap) (length ap)) (tm_of ap)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2690
apply(simp only: list_all_length)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2691
apply(rule_tac allI, rule_tac impI)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2692
apply(drule_tac in_tms, auto elim: tms_any_less)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2693
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2694
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2695
lemma length_ci: 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2696
"\<lbrakk>k < length ap; length (ci ly y (ap ! k)) = 2 * qa\<rbrakk>
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2697
      \<Longrightarrow> layout_of ap ! k = qa"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2698
apply(case_tac "ap ! k")
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2699
apply(auto simp: layout_of.simps ci.simps 
190
f1ecb4a68a54 renamed sete definition to adjust and old special case of adjust to adjust0
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 172
diff changeset
  2700
  length_of.simps tinc_b_def tdec_b_def length_findnth adjust.simps)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2701
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2702
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: 285
diff changeset
  2703
lemma ci_even[intro]: "length (ci ly y i) mod 2 = 0"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2704
apply(case_tac i, auto simp: ci.simps length_findnth
190
f1ecb4a68a54 renamed sete definition to adjust and old special case of adjust to adjust0
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 172
diff changeset
  2705
  tinc_b_def adjust.simps tdec_b_def)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2706
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2707
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: 285
diff changeset
  2708
lemma sum_list_ci_even[intro]: "sum_list (map (length \<circ> (\<lambda>(x, y). ci ly x y)) zs) mod 2 = 0"
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2709
apply(induct zs rule: rev_induct, simp)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2710
apply(case_tac x, simp)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2711
apply(subgoal_tac "length (ci ly a b) mod 2 = 0")
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2712
apply(auto)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2713
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2714
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2715
lemma zip_pre:
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2716
  "(length ys) \<le> length ap \<Longrightarrow>
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2717
  zip ys ap = zip ys (take (length ys) (ap::'a list))"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2718
proof(induct ys arbitrary: ap, simp, case_tac ap, simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2719
  fix a ys ap aa list
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2720
  assume ind: "\<And>(ap::'a list). length ys \<le> length ap \<Longrightarrow> 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2721
    zip ys ap = zip ys (take (length ys) ap)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2722
  and h: "length (a # ys) \<le> length ap" "(ap::'a list) = aa # (list::'a list)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2723
  from h show "zip (a # ys) ap = zip (a # ys) (take (length (a # ys)) ap)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2724
    using ind[of list]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2725
    apply(simp)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2726
    done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2727
qed
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2728
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2729
lemma length_start_of_tm: "start_of (layout_of ap) (length ap) = Suc (length (tm_of ap)  div 2)"
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2730
using tpa_states[of "tm_of ap"  "length ap" ap]
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2731
apply(simp add: tm_of.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2732
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2733
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: 285
diff changeset
  2734
lemma list_all_add_6E[elim]: "list_all (\<lambda>(acn, s). s \<le> Suc q) xs
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2735
        \<Longrightarrow> list_all (\<lambda>(acn, s). s \<le> q + (2 * n + 6)) 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: 285
diff changeset
  2736
by(auto simp: list_all_length)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2737
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: 285
diff changeset
  2738
lemma mopup_b_12[simp]: "length mopup_b = 12"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2739
apply(simp add: mopup_b_def)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2740
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2741
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2742
lemma mp_up_all_le: "list_all  (\<lambda>(acn, s). s \<le> q + (2 * n + 6)) 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2743
  [(R, Suc (Suc (2 * n + q))), (R, Suc (2 * n + q)), 
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2744
  (L, 5 + 2 * n + q), (W0, Suc (Suc (Suc (2 * n + q)))), (R, 4 + 2 * n + q),
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2745
  (W0, Suc (Suc (Suc (2 * n + q)))), (R, Suc (Suc (2 * n + q))),
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2746
  (W0, Suc (Suc (Suc (2 * n + q)))), (L, 5 + 2 * n + q),
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2747
  (L, 6 + 2 * n + q), (R, 0),  (L, 6 + 2 * n + q)]"
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: 285
diff changeset
  2748
by(auto)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2749
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: 285
diff changeset
  2750
lemma mopup_le6[simp]: "(a, b) \<in> set (mopup_a n) \<Longrightarrow> b \<le> 2 * n + 6"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2751
apply(induct n, auto simp: mopup_a.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2752
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2753
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: 285
diff changeset
  2754
lemma shift_le2[simp]: "(a, b) \<in> set (shift (mopup n) 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: 285
diff changeset
  2755
  \<Longrightarrow> b \<le> (2 * x + length (mopup n)) div 2"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2756
apply(auto simp: mopup.simps shift_append shift.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: 285
diff changeset
  2757
apply(auto simp: mopup_b_def)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2758
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2759
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: 285
diff changeset
  2760
lemma mopup_ge2[intro]: " 2 \<le> x + length (mopup n)"
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2761
apply(simp add: mopup.simps)
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2762
done
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2763
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: 285
diff changeset
  2764
lemma mopup_even[intro]: " (2 * x + length (mopup n)) mod 2 = 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: 285
diff changeset
  2765
by(auto simp: mopup.simps)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2766
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: 285
diff changeset
  2767
lemma mopup_div_2[simp]: "b \<le> Suc x
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2768
          \<Longrightarrow> b \<le> (2 * x + length (mopup n)) div 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: 285
diff changeset
  2769
by(auto simp: mopup.simps)
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2770
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: 285
diff changeset
  2771
lemma wf_tm_from_abacus: assumes "tp = tm_of ap"
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 285
diff changeset
  2772
  shows "tm_wf0 (tp @ shift (mopup n) (length tp 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: 285
diff changeset
  2773
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: 285
diff changeset
  2774
  have "is_even (length (mopup n))" for n using tm_wf.simps by 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: 285
diff changeset
  2775
  moreover have "(aa, ba) \<in> set (mopup n) \<Longrightarrow> ba \<le> length (mopup n) div 2" for aa ba
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 285
diff changeset
  2776
    by (metis (no_types, lifting) add_cancel_left_right case_prodD tm_wf.simps wf_mopup)
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 285
diff changeset
  2777
  moreover have "(\<forall>x\<in>set (tm_of ap). case x of (acn, s) \<Rightarrow> s \<le> Suc (sum_list (layout_of ap))) \<Longrightarrow>
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 285
diff changeset
  2778
           (a, b) \<in> set (tm_of ap) \<Longrightarrow> b \<le> sum_list (layout_of ap) + length (mopup n) 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: 285
diff changeset
  2779
    for a b 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: 285
diff changeset
  2780
    by (metis (no_types, lifting) add_Suc add_cancel_left_right case_prodD div_mult_mod_eq le_SucE mult_2_right not_numeral_le_zero tm_wf.simps trans_le_add1 wf_mopup)
a9003e6d0463 Up to date for Isabelle 2018. Gave names to simp rules in UF and UTM
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 285
diff changeset
  2781
  ultimately show ?thesis unfolding 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: 285
diff changeset
  2782
    using length_start_of_tm[of ap] all_le_start_of[of ap] tm_wf.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: 285
diff changeset
  2783
  by(auto simp: List.list_all_iff shift.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: 285
diff changeset
  2784
qed
70
2363eb91d9fd updated
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
  2785
229
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2786
lemma wf_tm_from_recf:
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2787
  assumes compile: "tp = tm_of_rec recf"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2788
  shows "tm_wf0 tp"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2789
proof -
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2790
  obtain a b c where "rec_ci recf = (a, b, c)"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2791
    by (metis prod_cases3)
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2792
  thus "?thesis"
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2793
    using compile
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2794
    using wf_tm_from_abacus[of "tm_of (a [+] dummy_abc b)" "(a [+] dummy_abc b)" b]
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2795
    by simp
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2796
qed
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2797
 
d8e6f0798e23 much simplified version of Recursive.thy
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 204
diff changeset
  2798
end