module BFLike2
  (run, eval) where

import Data.Char

type BFState = ([Char], [Int], Int, (Bool, [Char]))

while :: BFState -> BFState
run   :: BFState -> Char -> BFState
eval  :: [Char] -> [Char]

while (value, state, ptr, rc) =
      if state' !! ptr' < 1
        then (value', state', ptr', (False, []))
        else while (value', state', ptr', rc)
      where (value', state', ptr', rc') =
              foldl run (value, state, ptr, (False, [])) (snd rc)

run (value, state, ptr, rc) inst =
    if fst rc
      then case inst of
            ']' -> while (value, state, ptr, (False, snd rc))
            _   -> (value, state, ptr, (True, (snd rc) ++ [inst]))
      else case inst of
            '+' -> (value, (take ptr state) ++
                           [(state !! ptr) + 1] ++
                           (drop (ptr + 1) state), ptr, rc)
            '-' -> (value, (take ptr state) ++
                           [(state !! ptr) - 1] ++
                           (drop (ptr + 1) state), ptr, rc)
            '>' -> (value, if length state == ptr + 1
                             then state ++ [0]
                             else state, ptr + 1, rc)
            '<' -> (value, state, ptr - 1, rc)
            '.' -> (value ++ [chr $ state !! ptr], state, ptr, rc)
            '[' -> (value, state, ptr, (True, []))
            _   -> (value, state, ptr, rc)

eval l = value where (value, _, _, _) =
                       foldl run ([], [0], 0, (False, [])) l