thys/Turing2.thy
author Christian Urban <christian dot urban at kcl dot ac dot uk>
Tue, 21 May 2013 13:49:31 +0100
changeset 257 df6e8cb22995
permissions -rwxr-xr-x
more about the UF
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
257
df6e8cb22995 more about the UF
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
     1
(* Title: thys/Turing.thy
df6e8cb22995 more about the UF
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
     2
   Author: Jian Xu, Xingyuan Zhang, and Christian Urban
df6e8cb22995 more about the UF
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
     3
*)
df6e8cb22995 more about the UF
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
     4
df6e8cb22995 more about the UF
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
     5
header {* Turing Machines *}
df6e8cb22995 more about the UF
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
     6
df6e8cb22995 more about the UF
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
     7
theory Turing2
df6e8cb22995 more about the UF
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
     8
imports Main
df6e8cb22995 more about the UF
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
     9
begin
df6e8cb22995 more about the UF
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    10
df6e8cb22995 more about the UF
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    11
section {* Basic definitions of Turing machine *}
df6e8cb22995 more about the UF
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    12
df6e8cb22995 more about the UF
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    13
datatype action = W0 | W1 | L | R | Nop
df6e8cb22995 more about the UF
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    14
df6e8cb22995 more about the UF
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    15
datatype cell = Bk | Oc
df6e8cb22995 more about the UF
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    16
df6e8cb22995 more about the UF
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    17
type_synonym tape = "cell list \<times> cell list"
df6e8cb22995 more about the UF
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    18
df6e8cb22995 more about the UF
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    19
type_synonym state = nat
df6e8cb22995 more about the UF
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    20
df6e8cb22995 more about the UF
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    21
type_synonym instr = "action \<times> state"
df6e8cb22995 more about the UF
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    22
df6e8cb22995 more about the UF
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    23
type_synonym tprog = "(instr \<times> instr) list"
df6e8cb22995 more about the UF
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    24
df6e8cb22995 more about the UF
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    25
type_synonym config = "state \<times> tape"
df6e8cb22995 more about the UF
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    26
df6e8cb22995 more about the UF
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    27
fun nth_of where
df6e8cb22995 more about the UF
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    28
  "nth_of xs i = (if i \<ge> length xs then None else Some (xs ! i))"
df6e8cb22995 more about the UF
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    29
df6e8cb22995 more about the UF
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    30
fun 
df6e8cb22995 more about the UF
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    31
  fetch :: "tprog \<Rightarrow> state \<Rightarrow> cell \<Rightarrow> instr"
df6e8cb22995 more about the UF
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    32
where
df6e8cb22995 more about the UF
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    33
  "fetch p 0 b = (Nop, 0)"
df6e8cb22995 more about the UF
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    34
| "fetch p (Suc s) b = 
df6e8cb22995 more about the UF
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    35
     (case nth_of p s of
df6e8cb22995 more about the UF
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    36
        Some i \<Rightarrow> (case b of Bk \<Rightarrow> fst i | Oc \<Rightarrow> snd i)
df6e8cb22995 more about the UF
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    37
      | None \<Rightarrow> (Nop, 0))"
df6e8cb22995 more about the UF
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    38
df6e8cb22995 more about the UF
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    39
fun 
df6e8cb22995 more about the UF
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    40
  update :: "action \<Rightarrow> tape \<Rightarrow> tape"
df6e8cb22995 more about the UF
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    41
where 
df6e8cb22995 more about the UF
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    42
  "update W0 (l, r) = (l, Bk # (tl r))" 
df6e8cb22995 more about the UF
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    43
| "update W1 (l, r) = (l, Oc # (tl r))"
df6e8cb22995 more about the UF
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    44
| "update L  (l, r) = (if l = [] then ([], Bk # r) else (tl l, (hd l) # r))" 
df6e8cb22995 more about the UF
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    45
| "update R  (l, r) = (if r = [] then (Bk # l, []) else ((hd r) # l, tl r))" 
df6e8cb22995 more about the UF
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    46
| "update Nop (l, r) = (l, r)"
df6e8cb22995 more about the UF
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    47
df6e8cb22995 more about the UF
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    48
abbreviation 
df6e8cb22995 more about the UF
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    49
  "read r == if (r = []) then Bk else hd r"
df6e8cb22995 more about the UF
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    50
df6e8cb22995 more about the UF
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    51
fun step :: "config \<Rightarrow> tprog \<Rightarrow> config"
df6e8cb22995 more about the UF
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    52
  where 
df6e8cb22995 more about the UF
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    53
  "step (s, l, r) p = 
df6e8cb22995 more about the UF
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    54
     (let (a, s') = fetch p s (read r) in (s', update a (l, r)))"
df6e8cb22995 more about the UF
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    55
df6e8cb22995 more about the UF
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    56
fun steps :: "config \<Rightarrow> tprog \<Rightarrow> nat \<Rightarrow> config"
df6e8cb22995 more about the UF
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    57
  where
df6e8cb22995 more about the UF
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    58
  "steps c p 0 = c" |
df6e8cb22995 more about the UF
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    59
  "steps c p (Suc n) = steps (step c p) p n"
df6e8cb22995 more about the UF
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    60
df6e8cb22995 more about the UF
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    61
(* well-formedness of Turing machine programs *)
df6e8cb22995 more about the UF
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    62
df6e8cb22995 more about the UF
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    63
fun 
df6e8cb22995 more about the UF
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    64
  tm_wf :: "tprog \<Rightarrow> bool"
df6e8cb22995 more about the UF
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    65
where
df6e8cb22995 more about the UF
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    66
  "tm_wf p = (length p \<ge> 1 \<and> (\<forall>((_, s1), (_, s2)) \<in> set p. s1 \<le> length p \<and> s2 \<le> length p))"
df6e8cb22995 more about the UF
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    67
df6e8cb22995 more about the UF
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    68
end
df6e8cb22995 more about the UF
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    69