{-|
Module      : Language.Brainfuck.Eval
Description : Evaluator for the BF language
Copyright   : (c) Alejandro Cabrera, 2014
License     : BSD-3
Maintainer  : cpp.cabrera@gmail.com
Stability   : experimental
Portability : POSIX
-}
module Language.Brainfuck.Eval (
  eval
) where

import Data.Array ((//), (!))
import Data.Char (ord, chr)
import Data.List (elemIndices)
import Data.Maybe (listToMaybe)
import Data.Word (Word8)

import Language.Brainfuck.Types
import Language.Brainfuck.Parse

{-|

`eval` operates over the given tape, parses the string, and returns the state of the tape.

Potential unhandled errors:

* Out of bounds access to the tape
* Infinite loops
* Exceptions thrown by `print`
* Exceptions thrown by `putChar`

Handled errors:

* Matching jump not found for '[' and ']': terminate eval and return tape

As a result of evaluating the BF program, the following instructions
are effectful:

* ',': pauses evaluation to receive user input
* '.': prints the tape contents at DP as a Char

Here's how `eval` might be called:

>>> let tape = listArray (0,99) (replicate 100 0)
>>> eval tape "+.+."
TODO
>>> eval tape ",."
TODO

-}
eval :: Tape -> String -> IO Tape
eval storage program =
  let instructions = parse program

  in go storage instructions instructions 0 (PC 0)

  -- first set of instructions we advance over
  -- second set of instructions are maintained for jump logic
  where go :: Tape -> [Term] -> [Term] ->
              DataPointer -> ProgramCounter -> IO Tape
        go tape [] _ _ _ = return tape
        go tape (IncDP:ops) os pos pc = go tape ops os (pos+1) (next pc)
        go tape (DecDP:ops) os pos pc = go tape ops os (pos-1) (next pc)
        go tape (IncByte:ops) os pos pc =
          go (modPos tape pos (+1)) ops os pos (next pc)
        go tape (DecByte:ops) os pos pc =
          go (modPos tape pos (subtract 1)) ops os pos (next pc)
        go tape (OutByte:ops) os pos pc =
          (showAt tape pos) >> go tape ops os pos (next pc)
        go tape (InByte:ops) os pos pc = do
          c <- getChar
          let b = fromIntegral $ ord c :: Word8
          go (tape // [(pos, b)]) ops os pos (next pc)
        go tape (JumpForward:ops) os pos pc = if shouldJump Forward tape pos
          then jump tape Forward os pos pc
          else go tape ops os pos (next pc)
        go tape (JumpBackward:ops) os pos pc = if shouldJump Backward tape pos
          then jump tape Backward os pos pc
          else go tape ops os pos (next pc)

        jump tape dir os pos (PC pc) = do
          let jumpTo = findFunc dir pc (flipDir dir) os
          case jumpTo of
            Nothing -> print "jump not found" >> return tape
            (Just p) -> go tape (drop p os) os pos (PC p)

        -- jump utilities
        dirToJump Forward  = JumpForward
        dirToJump Backward = JumpBackward
        shouldJump Forward tape pos = (tape ! pos) == 0
        shouldJump Backward tape pos = (tape ! pos) /= 0
        findIx p x = listToMaybe . filter p . elemIndices x
        findIxAfter pos = findIx (>pos)
        findIxBefore pos = findIx (<pos)
        findFunc Forward = findIxAfter
        findFunc Backward = findIxBefore
        flipDir Forward = dirToJump Backward
        flipDir Backward = dirToJump Forward

        -- other evaluator utilities
        modPos arr pos f = arr // [(pos, f (arr ! pos))]
        showAt arr pos = putChar $ (chr . fromIntegral) $ (arr ! pos)
        next (PC n) = PC $ n + 1