thys/Abacus_Defs.thy
author Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
Mon, 07 Jan 2019 13:44:19 +0100
changeset 292 293e9c6f22e1
parent 291 93db7414931d
permissions -rw-r--r--
Added myself to the comments at the start of all files
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
292
293e9c6f22e1 Added myself to the comments at the start of all files
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 291
diff changeset
     3
   Modifications: Sebastiaan Joosten
173
b51cb9aef3ae split Mopup TM into a separate file
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 170
diff changeset
     4
*)
b51cb9aef3ae split Mopup TM into a separate file
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 170
diff changeset
     5
291
93db7414931d More naming of lemmas, cleanup of Abacus and NatBijection
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 197
diff changeset
     6
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
     7
197
0eef61c56891 added an al
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
     8
theory Abacus_Defs
0eef61c56891 added an al
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
     9
imports Abacus
47
251e192339b7 added abacus
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    10
begin
251e192339b7 added abacus
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    11
197
0eef61c56891 added an al
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
    12
abbreviation
0eef61c56891 added an al
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
    13
  "layout \<equiv> layout_of"
47
251e192339b7 added abacus
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    14
197
0eef61c56891 added an al
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
    15
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
    16
  where
291
93db7414931d More naming of lemmas, cleanup of Abacus and NatBijection
Sebastiaan Joosten <sebastiaan.joosten@uibk.ac.at>
parents: 197
diff changeset
    17
  "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
    18
197
0eef61c56891 added an al
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
    19
abbreviation
0eef61c56891 added an al
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
    20
  "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
    21
197
0eef61c56891 added an al
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
    22
abbreviation 
0eef61c56891 added an al
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
    23
  "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
    24
            (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
    25
            (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
    26
197
0eef61c56891 added an al
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
    27
abbreviation
0eef61c56891 added an al
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
    28
  "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
    29
             (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
    30
             (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
    31
             (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
    32
             (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
    33
             (R, 0), (W0, 16)]"
47
251e192339b7 added abacus
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    34
197
0eef61c56891 added an al
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
    35
abbreviation
0eef61c56891 added an al
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
    36
  "TMFindnth \<equiv> findnth"
60
c8ff97d9f8da new version of abacus
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 48
diff changeset
    37
197
0eef61c56891 added an al
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
    38
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
    39
  where
197
0eef61c56891 added an al
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
    40
  "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
    41
197
0eef61c56891 added an al
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
    42
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
    43
  where
0eef61c56891 added an al
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
    44
  "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
    45
197
0eef61c56891 added an al
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
    46
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
    47
  where
0eef61c56891 added an al
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
    48
  "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
    49
197
0eef61c56891 added an al
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
    50
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
    51
  where
197
0eef61c56891 added an al
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
    52
  "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
    53
| "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
    54
| "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
    55
197
0eef61c56891 added an al
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
    56
lemma
0eef61c56891 added an al
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
    57
  "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
    58
apply(cases i)
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 tinc_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 tdec_b_def)
0eef61c56891 added an al
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
    61
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
    62
done
c8ff97d9f8da new version of abacus
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 48
diff changeset
    63
c8ff97d9f8da new version of abacus
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 48
diff changeset
    64
197
0eef61c56891 added an al
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents: 190
diff changeset
    65
end