parsers/Parsers/Brainfuck/SymanticParser/Grammar.hs

   1 {-# LANGUAGE AllowAmbiguousTypes #-}
   2 {-# LANGUAGE DataKinds #-}
   3 {-# LANGUAGE ScopedTypeVariables #-}
   4 {-# LANGUAGE TemplateHaskell #-}
   5 {-# LANGUAGE TypeApplications #-}
   6 {-# LANGUAGE ViewPatterns #-}
   7 module Parsers.Brainfuck.SymanticParser.Grammar where
   8
   9 import Data.Char (Char)
  10 import Data.Function ((.))
  11 import qualified Prelude
  12
  13 import qualified Symantic.Parser as SP
  14
  15 import Parsers.Utils
  16 import Parsers.Brainfuck.Types
  17
  18 -- | Use with @$$(runParser @Text grammar)@,
  19 -- but in another Haskell module to avoid
  20 -- GHC stage restriction on such top-level splice.
  21 grammar :: forall tok repr.
  22   CoerceEnum Char tok =>
  23   CoerceEnum tok Char =>
  24   SP.Grammarable tok repr =>
  25   repr [Instruction]
  26 grammar = whitespace SP.*> bf
  27   where
  28   whitespace = SP.skipMany (SP.noneOf (coerceEnum @_ @tok Prelude.<$> "<>+-,.[]"))
  29   lexeme :: repr a -> repr a
  30   lexeme p = p SP.<* whitespace
  31   bf :: repr [Instruction]
  32   bf = SP.many (lexeme (SP.match (SP.look (SP.item @tok))
  33                                  (SP.prod . coerceEnum Prelude.<$> "<>+-,.[")
  34                                  op SP.empty))
  35   op :: SP.Production '[] tok -> repr Instruction
  36   op prod = case coerceEnum (SP.runValue prod) of
  37     '<' -> SP.item @tok SP.$> SP.prod Backward
  38     '>' -> SP.item @tok SP.$> SP.prod Forward
  39     '+' -> SP.item @tok SP.$> SP.prod Increment
  40     '-' -> SP.item @tok SP.$> SP.prod Decrement
  41     ',' -> SP.item @tok SP.$> SP.prod Input
  42     '.' -> SP.item @tok SP.$> SP.prod Output
  43     '[' -> SP.between (lexeme (SP.item @tok))
  44                       (SP.token (coerceEnum @_ @tok ']'))
  45                       ($(SP.prodCon 'Loop) SP.<$> bf)
  46     _ -> Prelude.undefined