gistfile1.hs

module Main where

  import Data.Array
  import Data.Char
  import Debug.Trace
  import System.IO
  
  type Memory = Array Int Int
  
  changeMemory :: Memory -> Int -> Int -> Memory
  changeMemory mem ptr amt = mem // [(ptr, (mem ! ptr) + amt)]
  
  outputByteAt :: Memory -> Int -> IO ()
  outputByteAt mem ptr = print (mem ! ptr)
  
  prompt :: IO Char
  prompt = do
    putStr ">>> "
    hFlush stdout
    getChar
    
  findRightBracket :: Int -> String -> Int
  -- TODO: put some error checking all up in this bitch
  findRightBracket start str = 
    case (str !! start) of
      ']' -> start
      otherwise -> findRightBracket (start + 1) str
      
  findLeftBracket :: Int -> String -> Int
  findLeftBracket start str = 
    case (str !! start) of
      '[' -> start
      otherwise -> findRightBracket (start - 1) str
  
  
  getInput :: Memory -> Int -> IO Memory
  getInput mem ptr = do
    input <- prompt
    return $ mem // [(ptr, (ord input))]
  
  loop :: String -> Int -> Int -> Memory -> IO ()
  loop str instPtr dataPtr mem = 
    if (length str <= instPtr) 
      then return () -- Run out of input, exit
      else do
        let char = str !! instPtr
        let next = instPtr + 1
        let byte = (mem ! dataPtr)
        let recurse = loop str next dataPtr mem
        print mem
        case char of 
          -- +  increment value at data pointer
          '+' -> loop str next dataPtr (changeMemory mem dataPtr 1)
          -- -  decrement value at data pointer
          '-' -> loop str next dataPtr (changeMemory mem dataPtr (-1))
          -- >  increment data pointer
          '>' -> loop str next (dataPtr + 1) mem
          -- <  decrement data pointer
          '<' -> loop str next (dataPtr - 1) mem
          -- .  output value at data pointer
          '.' -> print byte >> loop str next dataPtr mem
          -- ,  get input from console and store it to data pointer
          ',' -> (getInput mem dataPtr) >>= loop str next dataPtr
          -- [  jump to the matching right bracket if the data pointer is nonzero
          '[' -> if (byte /= 0) then loop str (findLeftBracket next str) dataPtr mem else recurse
          -- ]  jump to the matching left bracket if the data pointer is nonzero
          ']' -> if (byte /= 0) then loop str (findRightBracket (instPtr - 1) str) dataPtr mem else recurse
          --    ignore all other input
          otherwise -> recurse
  
  main :: IO ()
  main = loop ">+++++++>++++++++++>+++>+<<<<-" 0 0 (array (0, 9) [(i, 0) | i <- [0..9]])