Haskell brainfuck interpreter.

bf.hs

{-# LANGUAGE OverloadedStrings #-}
import Data.Array.IO
import Data.Array.Base
import Control.Applicative
import Control.Monad.Loops
import Data.Either
import Data.Attoparsec.Char8
import qualified Data.ByteString.Char8 as B
import System.Environment

type Tape = IOUArray Int Int

main = do
  program <- B.readFile =<< head <$> getArgs
  tape <- newArray (0,30000) 0 :: IO Tape
  unsafeWrite tape 0 1
  either error id (parseOnly (bf tape) program)

bf :: Tape -> Parser (IO ())
bf tape = (sequence_ <$>) . many $!
      (takeWhile1 (== '>') >>= return . next . B.length)
  <|> (takeWhile1 (== '<') >>= return . prev . B.length)
  <|> (takeWhile1 (== '+') >>= return . incr . B.length)
  <|> (takeWhile1 (== '-') >>= return . decr . B.length)
  <|> "." .*> return output
  <|> "," .*> return input
  <|> whileM_ nonzero <$> ("[" .*> bf tape <*. "]")
  <|> notChar ']' *> bf tape

 where
  next n  = exec $! \i v -> unsafeWrite tape 0 (i + n)
  prev n  = exec $! \i v -> unsafeWrite tape 0 (i - n)
  incr n  = exec $! \i v -> unsafeWrite tape i (v + n)
  decr n  = exec $! \i v -> unsafeWrite tape i (v - n)
  output  = exec $! \i v -> putChar $! toEnum v
  input   = exec $! \i v -> getChar >>= unsafeWrite tape i . fromEnum
  nonzero = exec $! \i v -> return $! v /= 0

  exec f = do
    i <- unsafeRead tape 0
    v <- unsafeRead tape i
    f i v