bf.hs

import System.Environment
import System.IO
import Data.Bits

run :: String -> String -> String

run source input = run' ([], source) ([], (repeat 0)) input

run' :: (String, String) -- a zipper for instructions
     -> ([Int], [Int])   -- a zipper for memory
     -> String -- input
     -> String -- output

run' (_, []) (_, _) _ = [] -- end of the instructions

run' (iprevs, '>':insts) (mprevs, mem:mems) input = run' ('>':iprevs, insts) (mem:mprevs, mems) input

run' (iprevs, '<':insts) (mem:mprevs, mems) input = run' ('<':iprevs, insts) (mprevs, mem:mems) input

run' (iprevs, '+':insts) (mprevs, mem:mems) input = run' ('+':iprevs, insts) (mprevs, ((mem + 1) .&. 0xFF):mems) input

run' (iprevs, '-':insts) (mprevs, mem:mems) input = run' ('-':iprevs, insts) (mprevs, ((mem - 1) .&. 0xFF):mems) input

run' (iprevs, '.':insts) (mprevs, mem:mems) input = (toEnum mem):(run' ('.':iprevs, insts) (mprevs, mem:mems) input)

run' (iprevs, ',':insts) (mprevs, _:mems) (c:input) = run' (',':iprevs, insts) (mprevs, (fromEnum c):mems) input

run' (iprevs, '[':insts) (mprevs, mem:mems) input
  | mem == 0 = run' (corresp ('[':iprevs, insts)) (mprevs, mem:mems) input
  | otherwise = run' ('[':iprevs, insts) (mprevs, mem:mems) input

run' (iprevs, ']':insts) (mprevs, mem:mems) input
  | mem == 0 = run' (']':iprevs, insts) (mprevs, mem:mems) input
  | otherwise = run' (rcorresp (iprevs, ']':insts)) (mprevs, mem:mems) input

run' (iprevs, inst:insts) (mprevs, mems) input = run' (inst:iprevs, insts) (mprevs, mems) input

corresp :: (String, String) -> (String, String)
rcorresp :: (String, String) -> (String, String)

corresp zipped = corresp' '[' ']' zipped 0
rcorresp (prevs, nexts) = let (rprevs, rnexts) = corresp' ']' '[' (nexts, prevs) 0 in (rnexts, rprevs)

corresp' beg end (prevs, x:xs) counted
  | x == end = if counted > 0 then corresp' beg end (x:prevs, xs) (counted - 1) else (x:prevs, xs)
  | x == beg = corresp' beg end (x:prevs, xs) (counted + 1)
  | otherwise = corresp' beg end (x:prevs, xs) counted


main = do
  args <- getArgs
  if (null args) then
    putStrLn "usage: bf program.bf"
  else do
    h <- openFile (head args) ReadMode
    contents <- hGetContents h
    interact (run contents)
    hClose h