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 |
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 |