parsers/Parsers/Brainfuck/Handrolled.hs

   1 module Parsers.Brainfuck.Handrolled where
   2
   3 import Control.Monad (Monad(..), fail)
   4 import Data.ByteString as BS
   5 import Data.Char (Char)
   6 import Data.Maybe (Maybe(..))
   7 import Data.Text as T
   8 import qualified Data.List as List
   9
  10 import Parsers.Utils
  11 import qualified Parsers.Utils.Handrolled as HR
  12 import Parsers.Brainfuck.Types
  13
  14 parser :: forall inp.
  15   CoerceEnum (HR.Token inp) Char =>
  16   HR.Inputable inp =>
  17   inp -> Maybe [Instruction]
  18 parser input = do
  19   (acc, is) <- walk input []
  20   if HR.null is
  21     then fail "remaining input"
  22     else Just acc
  23   where
  24   walk :: inp -> [Instruction] -> Maybe ([Instruction], inp)
  25   walk inp acc =
  26     case HR.uncons inp of
  27       Nothing -> Just (List.reverse acc, HR.empty)
  28       Just (i, is) ->
  29         case coerceEnum i of
  30           ']' -> Just (List.reverse acc, inp)
  31           '>' -> walk is (Forward:acc)
  32           '<' -> walk is (Backward:acc)
  33           '+' -> walk is (Increment:acc)
  34           '-' -> walk is (Decrement:acc)
  35           '.' -> walk is (Output:acc)
  36           ',' -> walk is (Input:acc)
  37           '[' -> do
  38             (body, is') <- loop is
  39             walk is' (Loop body:acc)
  40           _ -> walk is acc
  41   loop :: inp -> Maybe ([Instruction], inp)
  42   loop inp = do
  43     (body, rest) <- walk inp []
  44     case HR.uncons rest of
  45       Just (i, rest') | ']' <- coerceEnum i -> return (body, rest')
  46       _ -> fail "unclosed loop"
  47 -- Specializing is essential to keep best performances.
  48 {-# SPECIALIZE parser :: T.Text -> Maybe [Instruction] #-}
  49 {-# SPECIALIZE parser :: BS.ByteString -> Maybe [Instruction] #-}