1 module Turing where
2
3 data Symbol = Zero | One deriving Eq
4 data Movement = MoveLeft | MoveRight | MoveHalt
5 type State = String
6 type Transition = (State, Symbol, State, Symbol, Movement)
7
8 t_curstate :: Transition -> State
9 t_curstate (s, _, _, _, _) = s
10
11 t_cursym :: Transition -> Symbol
12 t_cursym (_, s, _, _, _) = s
13
14 t_nextstate :: Transition -> State
15 t_nextstate (_, _, s, _, _) = s
16
17 t_writesym :: Transition -> Symbol
18 t_writesym (_, _, _, w, _) = w
19
20 t_movement :: Transition -> Movement
21 t_movement (_, _, _, _, m) = m
22
23 showSymbol :: Symbol -> String
24 showSymbol Zero = "0"
25 showSymbol One = "1"
26
27 showMovement :: Movement -> String
28 showMovement MoveLeft = "<-"
29 showMovement MoveRight = "->"
30 showMovement MoveHalt = "H"
31
32 instance Show Symbol where show x = showSymbol x
33 instance Show Movement where show x = showMovement x
34
35 transForStateAndSymbol :: State -> Symbol -> Transition -> Bool
36 transForStateAndSymbol st sy t =
37 if ((t_curstate t == st) && (t_cursym t == sy)) then True else False
38
39 executeTuringMachine :: [Transition] -> [Symbol] -> Int -> State -> [Symbol]
40 executeTuringMachine ts ss cpuPos currentState =
41 let symbol = ss !! cpuPos in
42 let trans = head (filter (transForStateAndSymbol currentState symbol) ts) in
43 let write = [t_writesym trans] in
44 let tape = concat [take cpuPos ss, write, drop (cpuPos + 1) ss] in
45 case (t_movement trans) of
46 MoveHalt -> tape
47 MoveLeft -> executeTuringMachine ts tape (cpuPos - 1) (t_nextstate trans)
48 MoveRight -> executeTuringMachine ts tape (cpuPos + 1) (t_nextstate trans)
49
50 -- test
51
52 makeeven :: [Transition]
53 makeeven = [("s", One, "b", One, MoveRight),
54 ("b", One, "s", One, MoveRight),
55 ("s", Zero, "s", Zero, MoveHalt),
56 ("b", Zero, "b", One, MoveHalt)]
57
58 tape :: [Symbol]
59 tape = [One, One, One, Zero, Zero]
60
61 -- executeTuringMachine makeeven tape 0 "s" == [One, One, One, One, Zero]