1 module Turing2 where
 2   import qualified Data.Map as M
 3 
 4   -- data types and type synonems
 5   data Symbol        = Zero | One deriving (Eq, Ord, Show)
 6   data Movement      = MoveLeft | MoveRight | MoveHalt
 7   type Tape          = [Symbol]
 8   type State         = String
 9   type TransitionMap = M.Map (State, Symbol) (State, Symbol, Movement)
10 
11   -- execution: the head is always on the first element of the right tape
12   execute :: TransitionMap -> Tape -> [Symbol] -- default empty left tape, "s" state
13   execute tmap rtape = executeRec tmap [] rtape "s"
14 
15   executeRec :: TransitionMap -> Tape -> Tape -> State -> [Symbol]
16   executeRec tmap ltape rtape curState =
17     let rsym = head rtape in
18     let (nstate, wsym, move) = tmap M.! (curState, rsym) in
19       case move of
20         MoveHalt  -> (wsym : ltape) ++ (tail rtape)
21         MoveRight -> let new_ltape = wsym : ltape in
22                      let new_rtape = tail rtape in
23                         executeRec tmap new_ltape new_rtape nstate
24         MoveLeft  -> let new_ltape = take ((length ltape) - 1) ltape in
25                      let new_rtape = ((last ltape) : [wsym]) ++ take ((length rtape) - 1) rtape in
26                         executeRec tmap new_ltape new_rtape nstate
27 
28 -- test
29 
30   makeeven :: TransitionMap
31   makeeven =  M.fromList [(("s", One),  ("b", One, MoveRight)),
32                           (("b", One),  ("s", One, MoveRight)),
33                           (("s", Zero), ("s", Zero, MoveHalt)),
34                           (("b", Zero), ("b", One,  MoveHalt))]
35 
36   tape :: [Symbol]
37   tape = [One, One, One, Zero, Zero]
38 
39   -- excute makeeven tape should == [One, One, One, One, Zero]