parsers/Parsers/Brainfuck/SymanticParser/Grammar.hs

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