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
  13 import Symantic.Univariant.Trans
  14 import qualified Symantic.Parser as SP
  15
  16 import Parsers.Utils
  17 import Parsers.Brainfuck.Types
  18
  19 -- | Use with @$$(runParser @Text grammar)@,
  20 -- but in another Haskell module to avoid
  21 -- GHC stage restriction on such top-level splice.
  22 grammar :: forall tok repr.
  23   CoerceEnum Char tok =>
  24   CoerceEnum tok Char =>
  25   SP.Grammarable tok repr =>
  26   repr [Instruction]
  27 grammar = whitespace SP.*> bf
  28   where
  29   whitespace = SP.skipMany (SP.noneOf (coerceEnum @_ @tok Prelude.<$> "<>+-,.[]"))
  30   lexeme :: repr a -> repr a
  31   lexeme p = p SP.<* whitespace
  32   bf :: repr [Instruction]
  33   bf = SP.many (lexeme (SP.match (SP.look (SP.item @tok))
  34                                (SP.prod . coerceEnum Prelude.<$> "<>+-,.[")
  35                                op SP.empty))
  36   op :: SP.Production tok -> repr Instruction
  37   op prod = case coerceEnum (SP.runValue prod) of
  38     '<' -> SP.item @tok SP.$> SP.prod Backward
  39     '>' -> SP.item @tok SP.$> SP.prod Forward
  40     '+' -> SP.item @tok SP.$> SP.prod Increment
  41     '-' -> SP.item @tok SP.$> SP.prod Decrement
  42     ',' -> SP.item @tok SP.$> SP.prod Input
  43     '.' -> SP.item @tok SP.$> SP.prod Output
  44     '[' -> SP.between (lexeme (SP.item @tok))
  45                       (SP.token (coerceEnum @_ @tok ']'))
  46                       (SP.production Loop [||Loop||] SP.<$> bf)
  47     _ -> Prelude.undefined
  48
  49 reproGrammar :: forall tok repr.
  50   CoerceEnum Char tok =>
  51   CoerceEnum tok Char =>
  52   SP.Grammarable tok repr =>
  53   repr [tok]
  54 reproGrammar = SP.many (SP.item @tok)