Brainfuck

gistfile1.hs

import System.Environment
import Control.Monad.State
import Data.Char (ord, chr)

data BFState = BFState [Int] Int [Int]

type BFT a = StateT BFState IO a

sanitise [] = []
sanitise (x:xs)
    | x == '\n' || x == ' ' || x == '\t' = sanitise xs
    | otherwise                          = x : sanitise xs

next :: BFT ()
next = do
    (BFState xs y ys) <- get
    put (BFState (xs ++ [y]) (head ys) (tail' ys))

prev :: BFT ()
prev = do
    (BFState xs y ys) <- get
    put (BFState (init xs) (last xs) (y : ys))

apply :: (Int -> Int) -> BFT ()
apply f = do
    (BFState xs y ys) <- get
    put (BFState xs (f y) ys)

inc :: BFT ()
inc = apply (+1)

dec :: BFT ()
dec = apply (\x -> x - 1)

inb :: BFT Int
inb = do
    c <- lift getChar
    return (ord c)

out :: BFT ()
out = do
    (BFState _ y _) <- get
    lift (putStr [chr y])

execute :: String -> BFT ()
execute []      = return ()
execute ('>':xs) = next >> execute xs
execute ('<':xs) = prev >> execute xs
execute ('+':xs) = inc  >> execute xs
execute ('-':xs) = dec  >> execute xs
execute ('.':xs) = out  >> execute xs
execute (',':xs) = inb  >> execute xs
execute ('[':xs) = executeBracket xs >> execute xs
execute (']':xs) = return ()

tail' [] = []
tail' (x:xs) = xs

executeBracket xs = do
    (BFState _ y _) <- get
    if y == 0 
        then execute (tail' $ dropWhile (/= ']') xs)
        else execute xs >> executeBracket xs

main = do
    args <- getArgs
    conts <- readFile (args !! 0)
    runStateT (execute $ sanitise conts) (BFState [] 0 (replicate 9999 0))