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