Felt like writing a bf interpreter. So yeah.

Brainfuck.hs

module Main (main) where

import System.Environment

data Tape a = T [a] a [a]

next :: (Enum a) => Tape a -> Tape a
next (T xs x [])     = T (x : xs) (toEnum 0) []
next (T xs x (y:ys)) = T (x : xs) y ys

prev :: (Enum a) => Tape a -> Tape a
prev (T [] y ys)     = T [] (toEnum 0) (y : ys)
prev (T (x:xs) y ys) = T xs x (y : ys)

jumpnext :: (Eq a, Enum a) => a -> a -> Int -> Tape a -> Tape a
jumpnext _ _ _ (T _ x []) | fromEnum x == 0 = error "Error: Unmatched [."
jumpnext s e 0 t@(T _ x _) | x == e = next t
jumpnext s e i t@(T _ x _)
  | x == s    = jumpnext s e (i + 1) (next t)
  | x == e    = jumpnext s e (i - 1) (next t)
  | otherwise = jumpnext s e i (next t)

jumpprev :: (Eq a, Enum a) => a -> a -> Int -> Tape a -> Tape a
jumpprev _ _ _ (T [] x _) | fromEnum x == 0 = error "Error: Unmatched ]."
jumpprev s e 0 t@(T _ x _) | x == s = next t
jumpprev s e i t@(T _ x _)
  | x == s    = jumpprev s e (i - 1) (prev t)
  | x == e    = jumpprev s e (i + 1) (prev t)
  | otherwise = jumpprev s e i (prev t)

fuck :: Tape Char -> Tape Int -> IO ()
fuck (T _ '\0' []) _ = return ()
fuck t@(T _ '>' _) d = fuck (next t) (next d)
fuck t@(T _ '<' _) d = fuck (next t) (prev d)
fuck t@(T _ '+' _) (T x y z) = fuck (next t) (T x (y + 1) z)
fuck t@(T _ '-' _) (T x y z) = fuck (next t) (T x (y - 1) z)
fuck t@(T _ ',' _) (T x _ z) = getChar >>= \y -> fuck (next t) (T x (fromEnum y) z)
fuck t@(T _ '.' _) d@(T _ n _) = putChar (toEnum n) >> fuck (next t) d
fuck t@(T _ '[' _) d@(T _ 0 _) = fuck (jumpnext '[' ']' 0 (next t)) d
fuck t@(T _ '[' _) d = fuck (next t) d
fuck t@(T _ ']' _) d@(T _ 0 _) = fuck (next t) d
fuck t@(T _ ']' _) d = fuck (jumpprev '[' ']' 0 (prev t)) d
fuck t d = fuck (next t) d

main :: IO ()
main = getArgs >>= readFile.head >>= \(x:xs) -> fuck (T [] x xs) (T [] 0 [])