brainfuckinrekt2.0.hs

import Control.Monad
import Data.Char
import Data.Maybe
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map

data State = State { code :: [Char], codeIndex :: Int
                   , memory :: [Int], memIndex :: Int
                   , input :: [Char], brackets :: Map Int Int }

main = do
    fstLine <- getLine
    secLine <- getLine
    rawCodeFile <- replicateM (read $ last $ words fstLine) getLine
    let codeStr = filter (`elem` "><+-.,[]") (unlines rawCodeFile)
    putStrLn $ executeProgramString codeStr (init secLine) 
        
executeProgramString program input = exceuteProgram 100000 $ State program 0 (repeat 0) 0 input Map.empty

exceuteProgram steps state
      | codeIndex state == length (code state) = ""
      | steps == 0   = "\nPROCESS TIME OUT. KILLED!!!"
      | token == '>' = (execPrAdvCode $ changeMemL   1  state)
      | token == '<' = (execPrAdvCode $ changeMemL (-1) state)
      | token == '+' = (execPrAdvCode $ addMem   1  state)
      | token == '-' = (execPrAdvCode $ addMem (-1) state)
      | token == ',' = (execPrAdvCode $ readInput $ changeMem (ord $ head $ input state) state)
      | token == '.' = (chr currMemC) : (execPrAdvCode $ state)
      | token == '[' && currMemC == 0 = excProg $ rotateToBr 1 state
      | token == '['                  = execPrAdvCode state
      | token == ']' && currMemC == 0 = execPrAdvCode state
      | token == ']'                  = excProg $ rotateToBr (-1) state
      | otherwise = "ERROR: UNEXPECTED TOKEN IN INPUT"
        where token = code state !! codeIndex state
              excProg = exceuteProgram $ steps - 1
              execPrAdvCode state = excProg $ state {codeIndex = 1 + codeIndex state}
              readInput state = state {input = tail $ input state}
              currMemC = memory state !! memIndex state
              addMem n = changeMem (currMemC + n)
              changeMem n state = state {memory = replaceAtIndex (memIndex state) (n `mod` 256) (memory state)}
              changeMemL n state = state {memIndex = n + memIndex state}
              replaceAtIndex n item ls = a ++ (item:b) where (a, (_:b)) = splitAt n ls

rotateToBr :: Int -> State -> State
rotateToBr dir state
    | isJust memoBr = state { codeIndex = fromJust memoBr }
    | otherwise     = state { codeIndex = search, brackets = bracketsLst }
       where bracketsLst = Map.insert search index $ Map.insert index search (brackets state)
             index = codeIndex state
             memoBr = Map.lookup index $ brackets state
             search = searchR (code state) index 0 dir
             searchR code ind depth dir
                   | currDepth == 0 = ind
                   | otherwise = searchR code (ind+dir) currDepth dir
                     where currDepth
                             | code !! ind == '[' = depth+1
                             | code !! ind == ']' = depth-1
                             | otherwise = depth