brain-bleep-0.1.0.1: Main.hs

import Data.Array
import Text.ParserCombinators.Parsec
import System.IO.Unsafe
import Data.Tree
import Data.Maybe
import Control.Monad
import Data.Char
import System.IO

data BrainBleepOp = 
   Program 
 | Increment 
 | Decrement
 | ShiftLeft
 | ShiftRight
 | PutChar
 | GetChar
 | DoUntilZero
 deriving (Show,Read)
 

main = do
       x <- getContents
       interpretBrainBleep x

opDefs = [('+',Increment)
       ,('-' , Decrement)
       ,(',' , GetChar)
       ,('.' , PutChar)
       ,('<' , ShiftLeft)
       ,('>' , ShiftRight)
      ]

ops = oneOf (map fst opDefs) >>= \x -> return $ Node (fromJust $ lookup x opDefs) []

doUntilZero = do
  char '['
  (Node Program x) <- myParser  
  char ']'
  return (Node DoUntilZero x)  

myParser = sepBy (many (try doUntilZero <|> try ops)) newline >>= return . Node Program . concat

exampleAst src = parse myParser "" (filter (/=' ') src)

initArray = listArray (0,30000-1) (replicate 30000 0)

interpretBrainBleep src = runAst' (0,initArray) ((\(Right x) -> x) (exampleAst src)) >> return ()

runAst' (cursor,array) l@(Node DoUntilZero xs) = 
  if (array!cursor == 0) then do
                              return (cursor,array) 
                         else do 
                              s <- foldM runAst' (cursor,array) xs 
                              runAst' s l
runAst' (cursor,array) (Node Program xs) = foldM runAst' (cursor,array) xs
runAst' (cursor,array) (Node Increment _) = do putStr "" >> return (cursor,array// [(cursor,array!cursor +1)])
runAst' (cursor,array) (Node Decrement _) = do putStr "" >> return (cursor,array// [(cursor,array!cursor -1)])
runAst' (cursor,array) (Node ShiftLeft _) = do putStr "" >> return (cursor-1,array)
runAst' (cursor,array) (Node ShiftRight _) = do putStr "" >> return (cursor+1,array)
runAst' (cursor,array) (Node GetChar _) = do getChar >>= \c -> return (cursor,array // [(cursor,ord c)])
runAst' (cursor,array) (Node PutChar _) = do putChar (chr$ array ! cursor) >> return (cursor,array)