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