Simple BF interpreter in 38 lines - check http://ideone.com/aLrtPu for online test

brainfuck.hs

{-# LANGUAGE MultiWayIf, BangPatterns #-}

import Data.Word
import Data.Char

data Tape = Tape { negatives :: [Word8], currentTape :: !Word8, positives :: [Word8] }

mkTape = Tape (repeat 0) 0 (repeat 0)
shiftLeft  (Tape (x:left) curr right) = Tape left x (curr:right)
shiftRight (Tape left curr (x:right)) = Tape (curr:left) x right
modifyTape f (Tape left curr right) = Tape left (f curr) right

newtype Stack a = Stack [a]

push x (Stack s) = Stack (x:s)
top (Stack s) = head s
pop (Stack (s:ss)) = Stack ss

evalReal program = eval 0 (Stack [0]) mkTape
  where eval !curr !loops !tape = if
          | length program == curr -> return ()
          | command == '[' -> (if
            | skip || currentTape tape == 0 -> eval (curr + 1) (push (-1) loops) tape
            | otherwise                     -> eval (curr + 1) (push curr loops) tape)
          | command == ']' -> (if
            | skip || currentTape tape == 0 -> eval (curr + 1) (pop loops) tape
            | otherwise                     -> eval (top loops + 1) loops tape)
          | skip -> nextCommand tape
          | command == '+' -> nextCommand (modifyTape (+1) tape)
          | command == '-' -> nextCommand (modifyTape (subtract 1) tape)
          | command == '>' -> nextCommand (shiftRight tape)
          | command == '<' -> nextCommand (shiftLeft tape)
          | command == '.' -> putChar (chr $ fromIntegral $ currentTape tape) >> nextCommand tape
          | command == ',' -> getChar >>= \x -> return (tape {currentTape = (fromIntegral $ ord x)}) >> nextCommand tape
          | otherwise -> nextCommand tape
          where nextCommand = eval (curr + 1) loops
                skip = top loops == (-1)
                command = program !! curr

main = evalReal "->+>+++>>+>++>+>+++>>+>++>>>+>+>+>++>+>>>>+++>+>>++>+>+++>>++>++>>+>>+>++>++>+>>>>+++>+>>>>++>++>>>>+>>++>+>+++>>>++>>++++++>>+>>++>+>>>>+++>>+++++>>+>+++>>>++>>++>>+>>++>+>+++>>>++>>+++++++++++++>>+>>++>+>+++>+>+++>>>++>>++++>>+>>++>+>>>>+++>>+++++>>>>++>>>>+>+>++>>+++>+>>>>+++>+>>>>+++>+>>>>+++>>++>++>+>+++>+>++>++>>>>>>++>+>+++>>>>>+++>>>++>+>+++>+>+>++>>>>>>++>>>+>>>++>+>>>>+++>+>>>+>>++>+>++++++++++++++++++>>>>+>+>>>+>>++>+>+++>>>++>>++++++++>>+>>++>+>>>>+++>>++++++>>>+>++>>+++>+>+>++>+>+++>>>>>+++>>>+>+>>++>+>+++>>>++>>++++++++>>+>>++>+>>>>+++>>++++>>+>+++>>>>>>++>+>+++>>+>++>>>>+>+>++>+>>>>+++>>+++>>>+[[->>+<<]<+]+++++[->+++++++++<]>.[+]>>[<<+++++++[->+++++++++<]>-.------------------->-[-<.<+>>]<[+]<+>>>]<<<[-[-[-[>>+<++++++[->+++++<]]>++++++++++++++<]>+++<]++++++[->+++++++<]>+<<<-[->>>++<<<]>[->>.<<]<<]"