module Parsers.Brainfuck.Handrolled where

import Control.Monad (Monad(..), fail)
import Data.ByteString as BS
import Data.Char (Char)
import Data.Maybe (Maybe(..))
import Data.Text as T
import qualified Data.List as List

import Parsers.Utils
import qualified Parsers.Utils.Handrolled as HR
import Parsers.Brainfuck.Types

parser :: forall inp.
  CoerceEnum (HR.Token inp) Char =>
  HR.Inputable inp =>
  inp -> Maybe [Instruction]
parser :: forall inp.
(CoerceEnum (Token inp) Char, Inputable inp) =>
inp -> Maybe [Instruction]
parser inp
input = do
  ([Instruction]
acc, inp
is) <- inp -> [Instruction] -> Maybe ([Instruction], inp)
walk inp
input []
  if inp -> Bool
forall inp. Inputable inp => inp -> Bool
HR.null inp
is
    then String -> Maybe [Instruction]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"remaining input"
    else [Instruction] -> Maybe [Instruction]
forall a. a -> Maybe a
Just [Instruction]
acc
  where
  walk :: inp -> [Instruction] -> Maybe ([Instruction], inp)
  walk :: inp -> [Instruction] -> Maybe ([Instruction], inp)
walk inp
inp [Instruction]
acc =
    case inp -> Maybe (Token inp, inp)
forall inp. Inputable inp => inp -> Maybe (Token inp, inp)
HR.uncons inp
inp of
      Maybe (Token inp, inp)
Nothing -> ([Instruction], inp) -> Maybe ([Instruction], inp)
forall a. a -> Maybe a
Just ([Instruction] -> [Instruction]
forall a. [a] -> [a]
List.reverse [Instruction]
acc, inp
forall inp. Inputable inp => inp
HR.empty)
      Just (Token inp
i, inp
is) ->
        case Token inp -> Char
forall a b. CoerceEnum a b => a -> b
coerceEnum Token inp
i of
          Char
']' -> ([Instruction], inp) -> Maybe ([Instruction], inp)
forall a. a -> Maybe a
Just ([Instruction] -> [Instruction]
forall a. [a] -> [a]
List.reverse [Instruction]
acc, inp
inp)
          Char
'>' -> inp -> [Instruction] -> Maybe ([Instruction], inp)
walk inp
is (Instruction
ForwardInstruction -> [Instruction] -> [Instruction]
forall a. a -> [a] -> [a]
:[Instruction]
acc)
          Char
'<' -> inp -> [Instruction] -> Maybe ([Instruction], inp)
walk inp
is (Instruction
BackwardInstruction -> [Instruction] -> [Instruction]
forall a. a -> [a] -> [a]
:[Instruction]
acc)
          Char
'+' -> inp -> [Instruction] -> Maybe ([Instruction], inp)
walk inp
is (Instruction
IncrementInstruction -> [Instruction] -> [Instruction]
forall a. a -> [a] -> [a]
:[Instruction]
acc)
          Char
'-' -> inp -> [Instruction] -> Maybe ([Instruction], inp)
walk inp
is (Instruction
DecrementInstruction -> [Instruction] -> [Instruction]
forall a. a -> [a] -> [a]
:[Instruction]
acc)
          Char
'.' -> inp -> [Instruction] -> Maybe ([Instruction], inp)
walk inp
is (Instruction
OutputInstruction -> [Instruction] -> [Instruction]
forall a. a -> [a] -> [a]
:[Instruction]
acc)
          Char
',' -> inp -> [Instruction] -> Maybe ([Instruction], inp)
walk inp
is (Instruction
InputInstruction -> [Instruction] -> [Instruction]
forall a. a -> [a] -> [a]
:[Instruction]
acc)
          Char
'[' -> do
            ([Instruction]
body, inp
is') <- inp -> Maybe ([Instruction], inp)
loop inp
is
            inp -> [Instruction] -> Maybe ([Instruction], inp)
walk inp
is' ([Instruction] -> Instruction
Loop [Instruction]
bodyInstruction -> [Instruction] -> [Instruction]
forall a. a -> [a] -> [a]
:[Instruction]
acc)
          Char
_ -> inp -> [Instruction] -> Maybe ([Instruction], inp)
walk inp
is [Instruction]
acc
  loop :: inp -> Maybe ([Instruction], inp)
  loop :: inp -> Maybe ([Instruction], inp)
loop inp
inp = do
    ([Instruction]
body, inp
rest) <- inp -> [Instruction] -> Maybe ([Instruction], inp)
walk inp
inp []
    case inp -> Maybe (Token inp, inp)
forall inp. Inputable inp => inp -> Maybe (Token inp, inp)
HR.uncons inp
rest of
      Just (Token inp
i, inp
rest') | Char
']' <- Token inp -> Char
forall a b. CoerceEnum a b => a -> b
coerceEnum Token inp
i -> ([Instruction], inp) -> Maybe ([Instruction], inp)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Instruction]
body, inp
rest')
      Maybe (Token inp, inp)
_ -> String -> Maybe ([Instruction], inp)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unclosed loop"
-- Specializing is essential to keep best performances.
{-# SPECIALIZE parser :: T.Text -> Maybe [Instruction] #-}
{-# SPECIALIZE parser :: BS.ByteString -> Maybe [Instruction] #-}