Some days ago, I was challenged to make a smaller version of my Turing machine simulator in Haskell, which I did:

hdTl [] = (Nothing, [])
hdTl (x:xs) = (Just x, xs)

trans f (s, (l, c, r)) =
  either (\ s' -> let (h, t) = hdTl l in (s', (t, h, c':r)))
         (\ s' -> let (h, t) = hdTl r in (s', (c':l, h, t))) m
  where (c', m) = f c s

run f s = takeWhile ((`notElem` s) . fst) . iterate (trans f)

This version is a bit more limited, featuring only automatically generated output for machine runs, but otherwise works similarly.

You can run a machine as follows:

-- | Duplicate all "ones" on the band
d 0 (Just '1') = ('1', Right 0)
d 0 Nothing    = ('!', Left 1)
d 1 (Just '1') = ('!', Right 2)
d 1 Nothing    = ('!', Right 4)
d 2 (Just '1') = ('1', Right 2)
d 2 (Just '!') = ('1', Left 3)
d 2 Nothing    = ('1', Left 3)
d 3 (Just '1') = ('1', Left 3)
d 3 (Just '!') = ('1', Left 1)

main = mapM print $ run d [4] (0, ([], Just '1', "11"))

In the last line, the [4] means that state 4 is the only accepting state. The initial state of the band is “” (empty) to the left, a ‘1’ under the tape head and “11” to the right of the tape head. The output of the program is below:1

(0,("",Just '1',"11"))
(0,("1",Just '1',"1"))
(0,("11",Just '1',""))
(0,("111",Nothing,""))
(1,("11",Just '1',"!"))
(2,("!11",Just '!',""))
(3,("11",Just '!',"1"))
(1,("1",Just '1',"11"))
(2,("!1",Just '1',"1"))
(2,("1!1",Just '1',""))
(2,("11!1",Nothing,""))
(3,("1!1",Just '1',"1"))
(3,("!1",Just '1',"11"))
(3,("1",Just '!',"111"))
(1,("",Just '1',"1111"))
(2,("!",Just '1',"111"))
(2,("1!",Just '1',"11"))
(2,("11!",Just '1',"1"))
(2,("111!",Just '1',""))
(2,("1111!",Nothing,""))
(3,("111!",Just '1',"1"))
(3,("11!",Just '1',"11"))
(3,("1!",Just '1',"111"))
(3,("!",Just '1',"1111"))
(3,("",Just '!',"11111"))
(1,("",Nothing,"111111"))

  1. Note that the tape to the left of the tape head looks reversed, as it is “seen” from the tape head. ↩