1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
|
implementation module TuringMachines
import StdEnv
import StdMaybe
import IterableClass
instance toString Direction
where
toString Left = "Left"
toString Right = "Right"
instance toString (TuringMachineMove a) | toString a
where
toString Halt = "Halt"
toString (Step i Nothing dir) = "Step in q" +++ toString i +++ "; write B; move " +++ toString dir
toString (Step i (Just a) dir) = "Step in q" +++ toString i +++ "; write " +++ toString a +++ "; move " +++ toString dir
instance toString TuringMachineTermination
where
toString Running = "Running"
toString Normal = "Normally terminated"
toString Abnormal = "Abnormally terminated"
instance toString (Tape a) | toString a
where
toString [] = ""
toString [Nothing:tape] = "B" +++ toString tape
toString [Just a:tape] = toString a +++ toString tape
instance toString (TuringMachineState a) | toString a
where
toString st=:{state,tapeHead,tape,running}
= toString (take tapeHead tape) +++
"[q" +++ toString state +++ "]" +++
toString (drop tapeHead tape) +++
" (" +++ toString running +++ ")"
instance == Direction
where
(==) Left Left = True
(==) Right Right = True
(==) _ _ = False
instance == (TuringMachineMove a) | == a
where
(==) Halt Halt = True
(==) (Step i a dir) (Step i2 a2 dir2) = i == i2 && a == a2 && dir == dir2
(==) _ _ = False
instance == TuringMachineTermination
where
(==) Running Running = True
(==) Normal Normal = True
(==) Abnormal Abnormal = True
(==) _ _ = False
instance step (TuringMachineState a) | == a
where
step st=:{machine,state,tapeHead,tape,running}
| running <> Running = st
# tape = if (length tape < tapeHead + 1) (tape ++ [Nothing]) tape
# move = machine.transition state (tape!!tapeHead)
| move == Halt = {st & running = Normal}
# (Step state write dir) = move
# tape = updateAt tapeHead write tape
# tapeHead = if (dir == Left) (-) (+) tapeHead 1
| tapeHead < 0 = {st & running = Abnormal}
= {st & state=state, tapeHead=tapeHead, tape=tape}
initTuringMachine :: (TuringMachine a) (Tape a) -> TuringMachineState a | Eq a
initTuringMachine def tape
| invalid tape = abort "Invalid symbols on input"
| otherwise = {machine=def, state=0, tapeHead=0, tape=[Nothing:tape]++[Nothing], running=Running}
where
invalid [] = False
invalid [Nothing:tape] = invalid tape
invalid [Just c:tape] = not (isMember c def.inputs) || invalid tape
run :: (TuringMachineState a) -> TuringMachineState a | == a
run m
# m = step m
| m.running == Running = run m
| otherwise = m
|
