thys/Abacus_Defs.thy
author Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
Fri, 21 Dec 2018 15:30:24 +0100
changeset 291 93db7414931d
parent 197 0eef61c56891
child 292 293e9c6f22e1
permissions -rw-r--r--
More naming of lemmas, cleanup of Abacus and NatBijection
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
173
b51cb9aef3ae split Mopup TM into a separate file
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 170
diff changeset
     1
(* Title: thys/Abacus.thy
b51cb9aef3ae split Mopup TM into a separate file
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 170
diff changeset
     2
   Author: Jian Xu, Xingyuan Zhang, and Christian Urban
b51cb9aef3ae split Mopup TM into a separate file
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 170
diff changeset
     3
*)
b51cb9aef3ae split Mopup TM into a separate file
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 170
diff changeset
     4
291
93db7414931d More naming of lemmas, cleanup of Abacus and NatBijection
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 197
diff changeset
     5
chapter {* Alternative Definitions for Translating Abacus Machines to TMs *}
173
b51cb9aef3ae split Mopup TM into a separate file
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 170
diff changeset
     6
197
0eef61c56891 added an al
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
     7
theory Abacus_Defs
0eef61c56891 added an al
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
     8
imports Abacus
47
251e192339b7 added abacus
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
     9
begin
251e192339b7 added abacus
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    10
197
0eef61c56891 added an al
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
    11
abbreviation
0eef61c56891 added an al
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
    12
  "layout \<equiv> layout_of"
47
251e192339b7 added abacus
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    13
197
0eef61c56891 added an al
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
    14
fun address :: "abc_prog \<Rightarrow> nat \<Rightarrow> nat"
47
251e192339b7 added abacus
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    15
  where
291
93db7414931d More naming of lemmas, cleanup of Abacus and NatBijection
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 197
diff changeset
    16
  "address p x = (Suc (sum_list (take x (layout p)))) "
60
c8ff97d9f8da new version of abacus
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 48
diff changeset
    17
197
0eef61c56891 added an al
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
    18
abbreviation
0eef61c56891 added an al
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
    19
  "TMGoto \<equiv> [(Nop, 1), (Nop, 1)]"
60
c8ff97d9f8da new version of abacus
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 48
diff changeset
    20
197
0eef61c56891 added an al
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
    21
abbreviation 
0eef61c56891 added an al
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
    22
  "TMInc \<equiv> [(W1, 1), (R, 2), (W1, 3), (R, 2), (W1, 3), (R, 4), 
0eef61c56891 added an al
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
    23
            (L, 7), (W0, 5), (R, 6), (W0, 5), (W1, 3), (R, 6),
0eef61c56891 added an al
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
    24
            (L, 8), (L, 7), (R, 9), (L, 7), (R, 10), (W0, 9)]"
60
c8ff97d9f8da new version of abacus
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 48
diff changeset
    25
197
0eef61c56891 added an al
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
    26
abbreviation
0eef61c56891 added an al
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
    27
  "TMDec \<equiv> [(W1, 1), (R, 2), (L, 14), (R, 3), (L, 4), (R, 3),
0eef61c56891 added an al
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
    28
             (R, 5), (W0, 4), (R, 6), (W0, 5), (L, 7), (L, 8),
0eef61c56891 added an al
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
    29
             (L, 11), (W0, 7), (W1, 8), (R, 9), (L, 10), (R, 9),
0eef61c56891 added an al
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
    30
             (R, 5), (W0, 10), (L, 12), (L, 11), (R, 13), (L, 11),
0eef61c56891 added an al
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
    31
             (R, 17), (W0, 13), (L, 15), (L, 14), (R, 16), (L, 14),
0eef61c56891 added an al
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
    32
             (R, 0), (W0, 16)]"
47
251e192339b7 added abacus
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    33
197
0eef61c56891 added an al
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
    34
abbreviation
0eef61c56891 added an al
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
    35
  "TMFindnth \<equiv> findnth"
60
c8ff97d9f8da new version of abacus
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 48
diff changeset
    36
197
0eef61c56891 added an al
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
    37
fun compile_goto :: "nat \<Rightarrow> instr list" 
60
c8ff97d9f8da new version of abacus
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 48
diff changeset
    38
  where
197
0eef61c56891 added an al
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
    39
  "compile_goto s = shift TMGoto (s - 1)"
60
c8ff97d9f8da new version of abacus
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 48
diff changeset
    40
197
0eef61c56891 added an al
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
    41
fun compile_inc :: "nat \<Rightarrow> nat \<Rightarrow> instr list"
0eef61c56891 added an al
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
    42
  where
0eef61c56891 added an al
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
    43
  "compile_inc s n = (shift (TMFindnth n) (s - 1)) @ (shift (shift TMInc (2 * n)) (s - 1))"
60
c8ff97d9f8da new version of abacus
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 48
diff changeset
    44
197
0eef61c56891 added an al
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
    45
fun compile_dec :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> instr list"
0eef61c56891 added an al
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
    46
  where
0eef61c56891 added an al
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
    47
  "compile_dec s n e = (shift (TMFindnth n) (s - 1)) @ (adjust (shift (shift TMDec (2 * n)) (s - 1)) e)"
60
c8ff97d9f8da new version of abacus
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 48
diff changeset
    48
197
0eef61c56891 added an al
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
    49
fun compile :: "abc_prog \<Rightarrow> nat \<Rightarrow> abc_inst \<Rightarrow> instr list"
60
c8ff97d9f8da new version of abacus
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 48
diff changeset
    50
  where
197
0eef61c56891 added an al
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
    51
  "compile ap s (Inc n) = compile_inc s n"
0eef61c56891 added an al
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
    52
| "compile ap s (Dec n e) = compile_dec s n (address ap e)"
0eef61c56891 added an al
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
    53
| "compile ap s (Goto e) = compile_goto (address ap e)"
60
c8ff97d9f8da new version of abacus
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 48
diff changeset
    54
197
0eef61c56891 added an al
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
    55
lemma
0eef61c56891 added an al
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
    56
  "compile ap s i = ci (layout ap) s i"
0eef61c56891 added an al
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
    57
apply(cases i)
0eef61c56891 added an al
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
    58
apply(simp add: ci.simps shift.simps start_of.simps tinc_b_def)
0eef61c56891 added an al
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
    59
apply(simp add: ci.simps shift.simps start_of.simps tdec_b_def)
0eef61c56891 added an al
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
    60
apply(simp add: ci.simps shift.simps start_of.simps)
60
c8ff97d9f8da new version of abacus
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 48
diff changeset
    61
done
c8ff97d9f8da new version of abacus
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 48
diff changeset
    62
c8ff97d9f8da new version of abacus
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 48
diff changeset
    63
197
0eef61c56891 added an al
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
    64
end