A Brainfuck interpreter in Haskell. (Note: It lacks the input ',' command). Pipe in the Brainfuck code through STDIN.

bf.hs

import Data.Char

-- Cmd is the tree containing the commands in sequence.
data Cmd = Cmd Char Cmd | Loop Cmd Cmd | Empty deriving Show
-- Brain is the main datatype that is processed throughout the program.
-- It has a strip of numbers with a pointer to point to the index on it
-- making it a Turing Machine. It also carries with it the output to be
-- piped out to standard output.
data Brain = Brain [Int] Int String deriving Show

-- Mod functions

safeMod :: Int -> Int -> Int
safeMod x n = if x >= 0 then mod x n else safeMod  (x + n) n

bytify :: Int -> Int
bytify x = safeMod x 256

stripify :: Int -> Int
stripify x = safeMod x 30000

brainChar :: Brain -> String
brainChar (Brain arr ptr out) = (show $ arr !! ptr) ++ " "


-- Functions to convert input to tree

cmdify :: String -> Cmd
cmdify [] = Empty
cmdify (x:xs) = case x of
                '[' -> getLoop xs 1
                _ -> Cmd x (cmdify xs)


getLoop :: String -> Int -> Cmd
getLoop (x:xs) n = getLoop' (x:xs) n ""
                   where
                    getLoop' (x:xs) 1 out = case x of
                                              '[' -> getLoop' xs 2 (out ++ [x])
                                              ']' -> Loop (cmdify out) (cmdify xs)
                                              _ -> getLoop' xs 1 (out ++ [x])
                    getLoop' (x:xs) n out = case x of
                                              '[' -> getLoop' xs (n+1) (out ++ [x])
                                              ']' -> getLoop' xs (n-1) (out ++ [x])
                                              _ -> getLoop' xs n (out ++ [x])


-- Functions to change state of the brain

incr :: Brain -> Brain
incr (Brain arr ptr out) = Brain (changeArr arr ptr (+1)) ptr out

decr :: Brain -> Brain
decr (Brain arr ptr out) = Brain (changeArr arr ptr (\x -> x-1)) ptr out
 
up :: Brain -> Brain
up  (Brain arr ptr out) = Brain arr (stripify (ptr + 1)) out

down :: Brain -> Brain
down  (Brain arr ptr out) = Brain arr (stripify (ptr - 1)) out


-- Processing lists and text

getOut :: Brain -> String
getOut (Brain _ _ out) = out

giveOut :: Brain -> Brain
giveOut (Brain arr ptr out) = Brain arr ptr (out ++ [chr $ arr !! ptr])

changeArr :: [Int] -> Int -> (Int -> Int) -> [Int]
changeArr arr ptr f = begin ++ [bytify $ f elem] ++ end
                    where
                      splitArr = splitAt (ptr+1) arr
                      begin = init (fst splitArr)
                      elem = last (fst splitArr)
                      end = snd splitArr


-- Functions to interpret the commands

interpret :: Cmd -> Brain -> Brain
interpret (Cmd x Empty) brain = operate brain x
interpret (Empty) brain = brain
interpret (Cmd x y) brain = interpret y (operate brain x)
interpret (Loop v w) brain = interpret w (loop v brain)

loop :: Cmd -> Brain -> Brain
loop v (Brain arr ptr out) = if arr !! ptr == 0 then (Brain arr ptr out) else loop v (interpret v (Brain arr ptr out))

operate :: Brain -> Char -> Brain
operate brain x = case x of
                    '+' -> incr brain
                    '-' -> decr brain
                    '<' -> down brain
                    '>' -> up brain
                    '.' -> giveOut brain
                    _ -> brain
main = do
      input <- getContents
      putStr $ getOut $ interpret (cmdify input) (Brain [0 | x <- [1..30000]] 0 [])