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