{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}
module Parsers.Brainfuck.SymanticParser.Grammar where

import Data.Char (Char)
import Data.Function ((.))
import qualified Prelude

import qualified Symantic.Parser as SP

import Parsers.Utils
import Parsers.Brainfuck.Types

-- | Use with @$$(runParser @Text grammar)@,
-- but in another Haskell module to avoid
-- GHC stage restriction on such top-level splice.
grammar :: forall tok repr.
  CoerceEnum Char tok =>
  CoerceEnum tok Char =>
  SP.Grammarable tok repr =>
  repr [Instruction]
grammar :: forall tok (repr :: * -> *).
(CoerceEnum Char tok, CoerceEnum tok Char, Grammarable tok repr) =>
repr [Instruction]
grammar = repr ()
whitespace repr () -> repr [Instruction] -> repr [Instruction]
forall (repr :: * -> *) a b.
CombApplicable repr =>
repr a -> repr b -> repr b
SP.*> repr [Instruction]
bf
  where
  whitespace :: repr ()
whitespace = repr tok -> repr ()
forall (repr :: * -> *) a.
(CombApplicable repr, CombFoldable repr) =>
repr a -> repr ()
SP.skipMany ([tok] -> repr tok
forall tok (repr :: * -> *).
(Lift tok, Eq tok, CombSatisfiable tok repr) =>
[tok] -> repr tok
SP.noneOf (forall a b. CoerceEnum a b => a -> b
coerceEnum @_ @tok (Char -> tok) -> [Char] -> [tok]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> [Char]
"<>+-,.[]"))
  lexeme :: repr a -> repr a
  lexeme :: forall a. repr a -> repr a
lexeme repr a
p = repr a
p repr a -> repr () -> repr a
forall (repr :: * -> *) a b.
CombApplicable repr =>
repr a -> repr b -> repr a
SP.<* repr ()
whitespace
  bf :: repr [Instruction]
  bf :: repr [Instruction]
bf = repr Instruction -> repr [Instruction]
forall (repr :: * -> *) a.
(CombApplicable repr, CombFoldable repr) =>
repr a -> repr [a]
SP.many (repr Instruction -> repr Instruction
forall a. repr a -> repr a
lexeme (repr tok
-> [Production tok]
-> (Production tok -> repr Instruction)
-> repr Instruction
-> repr Instruction
forall (repr :: * -> *) a b.
(CombMatchable repr, Eq a, Lift a) =>
repr a
-> [Production a] -> (Production a -> repr b) -> repr b -> repr b
SP.match (repr tok -> repr tok
forall (repr :: * -> *) a. CombLookable repr => repr a -> repr a
SP.look (forall tok (repr :: * -> *).
(Ord tok, Show tok, Typeable tok, Lift tok, NFData tok,
 CombSatisfiable tok repr) =>
repr tok
SP.item @tok))
                                 (tok -> Production tok
forall a. Lift a => a -> Production a
SP.prod (tok -> Production tok) -> (Char -> tok) -> Char -> Production tok
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> tok
forall a b. CoerceEnum a b => a -> b
coerceEnum (Char -> Production tok) -> [Char] -> [Production tok]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> [Char]
"<>+-,.[")
                                 Production tok -> repr Instruction
op repr Instruction
forall (repr :: * -> *) a. CombAlternable repr => repr a
SP.empty))
  op :: SP.Production tok -> repr Instruction
  op :: Production tok -> repr Instruction
op Production tok
prod = case tok -> Char
forall a b. CoerceEnum a b => a -> b
coerceEnum (Production tok -> tok
forall a. Production a -> a
SP.runValue Production tok
prod) of
    Char
'<' -> forall tok (repr :: * -> *).
(Ord tok, Show tok, Typeable tok, Lift tok, NFData tok,
 CombSatisfiable tok repr) =>
repr tok
SP.item @tok repr tok -> Production Instruction -> repr Instruction
forall (repr :: * -> *) a b.
CombApplicable repr =>
repr a -> Production b -> repr b
SP.$> Instruction -> Production Instruction
forall a. Lift a => a -> Production a
SP.prod Instruction
Backward
    Char
'>' -> forall tok (repr :: * -> *).
(Ord tok, Show tok, Typeable tok, Lift tok, NFData tok,
 CombSatisfiable tok repr) =>
repr tok
SP.item @tok repr tok -> Production Instruction -> repr Instruction
forall (repr :: * -> *) a b.
CombApplicable repr =>
repr a -> Production b -> repr b
SP.$> Instruction -> Production Instruction
forall a. Lift a => a -> Production a
SP.prod Instruction
Forward
    Char
'+' -> forall tok (repr :: * -> *).
(Ord tok, Show tok, Typeable tok, Lift tok, NFData tok,
 CombSatisfiable tok repr) =>
repr tok
SP.item @tok repr tok -> Production Instruction -> repr Instruction
forall (repr :: * -> *) a b.
CombApplicable repr =>
repr a -> Production b -> repr b
SP.$> Instruction -> Production Instruction
forall a. Lift a => a -> Production a
SP.prod Instruction
Increment
    Char
'-' -> forall tok (repr :: * -> *).
(Ord tok, Show tok, Typeable tok, Lift tok, NFData tok,
 CombSatisfiable tok repr) =>
repr tok
SP.item @tok repr tok -> Production Instruction -> repr Instruction
forall (repr :: * -> *) a b.
CombApplicable repr =>
repr a -> Production b -> repr b
SP.$> Instruction -> Production Instruction
forall a. Lift a => a -> Production a
SP.prod Instruction
Decrement
    Char
',' -> forall tok (repr :: * -> *).
(Ord tok, Show tok, Typeable tok, Lift tok, NFData tok,
 CombSatisfiable tok repr) =>
repr tok
SP.item @tok repr tok -> Production Instruction -> repr Instruction
forall (repr :: * -> *) a b.
CombApplicable repr =>
repr a -> Production b -> repr b
SP.$> Instruction -> Production Instruction
forall a. Lift a => a -> Production a
SP.prod Instruction
Input
    Char
'.' -> forall tok (repr :: * -> *).
(Ord tok, Show tok, Typeable tok, Lift tok, NFData tok,
 CombSatisfiable tok repr) =>
repr tok
SP.item @tok repr tok -> Production Instruction -> repr Instruction
forall (repr :: * -> *) a b.
CombApplicable repr =>
repr a -> Production b -> repr b
SP.$> Instruction -> Production Instruction
forall a. Lift a => a -> Production a
SP.prod Instruction
Output
    Char
'[' -> repr tok -> repr tok -> repr Instruction -> repr Instruction
forall (repr :: * -> *) o c a.
CombApplicable repr =>
repr o -> repr c -> repr a -> repr a
SP.between (repr tok -> repr tok
forall a. repr a -> repr a
lexeme (forall tok (repr :: * -> *).
(Ord tok, Show tok, Typeable tok, Lift tok, NFData tok,
 CombSatisfiable tok repr) =>
repr tok
SP.item @tok))
                      (tok -> repr tok
forall tok (repr :: * -> *).
(Lift tok, Show tok, Eq tok, Typeable tok, CombAlternable repr,
 CombApplicable repr, CombSatisfiable tok repr) =>
tok -> repr tok
SP.token (forall a b. CoerceEnum a b => a -> b
coerceEnum @_ @tok Char
']'))
                      ($(SP.prodCon 'Loop) Production ([Instruction] -> Instruction)
-> repr [Instruction] -> repr Instruction
forall (repr :: * -> *) a b.
CombApplicable repr =>
Production (a -> b) -> repr a -> repr b
SP.<$> repr [Instruction]
bf)
    Char
_ -> repr Instruction
forall a. HasCallStack => a
Prelude.undefined