Handrolled.hs

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 input = do
  (acc, is) <- walk input []
  if HR.null is
    then fail "remaining input"
    else Just acc
  where
  walk :: inp -> [Instruction] -> Maybe ([Instruction], inp)
  walk inp acc =
    case HR.uncons inp of
      Nothing -> Just (List.reverse acc, HR.empty)
      Just (i, is) ->
        case coerceEnum i of
          ']' -> Just (List.reverse acc, inp)
          '>' -> walk is (Forward:acc)
          '<' -> walk is (Backward:acc)
          '+' -> walk is (Increment:acc)
          '-' -> walk is (Decrement:acc)
          '.' -> walk is (Output:acc)
          ',' -> walk is (Input:acc)
          '[' -> do
            (body, is') <- loop is
            walk is' (Loop body:acc)
          _ -> walk is acc
  loop :: inp -> Maybe ([Instruction], inp)
  loop inp = do
    (body, rest) <- walk inp []
    case HR.uncons rest of
      Just (i, rest') | ']' <- coerceEnum i -> return (body, rest')
      _ -> fail "unclosed loop"
-- Specializing is essential to keep best performances.
{-# SPECIALIZE parser :: T.Text -> Maybe [Instruction] #-}
{-# SPECIALIZE parser :: BS.ByteString -> Maybe [Instruction] #-}