import Control.Monad
import Control.Monad.State


data Action = L' | R' | N'
    

type Tape a = ([a], [a])


tape s = (repeat s, repeat s)

goL ((l:ls), rs) = (ls, l:rs) 
goR (ls, (r:rs)) = (r:ls, rs)




type MT a s = (Tape a, s, (a, s) -> (a, s, Action), s -> Bool)


type MT_State a s = State (MT a s) [a]



execStepLoopMT :: MT_State a s
execStepLoopMT = do (((l:ls), r), s, ttable, halt) <- get
                    let  (t', s', a') = ttable (l, s) 
                    if halt s' then return [l]
                               else do put ((case a' of L' -> goL
                                                        R' -> goR
                                                        N' -> id) (t':ls, r), s', ttable, halt)
                                    (l:) `liftM` execStepLoopMT
                                        
execMT = execState execStepLoopMT
evalMT = evalState execStepLoopMT

makeMT :: a -> s -> ((a, s) -> (a, s, Action)) -> (s -> Bool) -> MT a s
makeMT init is table h = (tape init, is, table, h)





data MT_USR_State = A | B | C | HALT

mt_usr_halt_code :: MT_USR_State -> Bool
mt_usr_halt_code a = case a of HALT -> True
                               _    -> False

mt_usr_transition_table s = case s of (0, A) -> (1, B, R')
                                      (1, A) -> (1, C, L')
                                      (0, B) -> (1, A, L')
                                      (1, B) -> (1, B, R')
                                      (0, C) -> (1, B, L')
                                      (1, C) -> (1, HALT, N')



test  = execMT $ makeMT 0 A mt_usr_transition_table mt_usr_halt_code
test' = evalMT $ makeMT 0 A mt_usr_transition_table mt_usr_halt_code