brainfuck.hs

import System.Environment
import Data.Char

execute :: String -> String -> Int -> Int -> IO ()
execute instructionArray dataArray instructionPointer dataPointer
  | (instructionPointer < 0 || dataPointer < 0) = fail "Negative index !"
  | (instructionPointer >= length instructionArray) = return ()
  | otherwise = case (instructionArray !! instructionPointer) of
    '>' -> execute instructionArray dataArray (instructionPointer+1) (dataPointer+1)
    '<' -> execute instructionArray dataArray (instructionPointer+1) (dataPointer-1)
    '+' -> execute instructionArray (before ++ [(chr.(+1).ord) char] ++ after) (instructionPointer+1) dataPointer
    '-' -> execute instructionArray (before ++ [(chr.(\n -> n-1).ord) char] ++ after) (instructionPointer+1) dataPointer
    '.' -> do
      putChar char
      execute instructionArray dataArray (instructionPointer+1) dataPointer
    ',' -> do
      newChar <- getChar
      execute instructionArray (before ++ [newChar] ++ after) (instructionPointer+1) dataPointer
    '[' -> do
      if (char=='\0') then
        execute instructionArray dataArray (nextBracket instructionArray instructionPointer) dataPointer
      else
        execute instructionArray dataArray (instructionPointer+1) dataPointer
      where
        nextBracket instructionArray instructionPointer =
          if (instructionArray !! instructionPointer == ']' || instructionPointer >= length instructionArray) then
            instructionPointer
          else nextBracket instructionArray (instructionPointer+1)
    ']' -> do
      if (char/='\0') then
        execute instructionArray dataArray (previousBracket instructionArray instructionPointer) dataPointer
      else
        execute instructionArray dataArray (instructionPointer+1) dataPointer
      where
        previousBracket instructionArray instructionPointer =
          if (instructionArray !! instructionPointer == '[' || instructionPointer < 0) then
            instructionPointer
          else previousBracket instructionArray (instructionPointer-1)

    where
      before = take dataPointer dataArray
      char = dataArray !! dataPointer
      after = drop (dataPointer+1) dataArray

main = do
  content <- (fmap head getArgs >>= readFile)
  let instructions = filter (`elem` "+-<>,.[]") content;
  execute instructions (repeat '\0') 0 0