never executed always true always false
1 module HelVM.HelMA.Automata.BrainFuck.Impl.Tree.Parser (
2 parseAsVectorSafe,
3 parseAsVector,
4 ) where
5
6 import HelVM.HelMA.Automata.BrainFuck.Impl.Tree.Instruction as Tree
7
8 import HelVM.HelMA.Automata.BrainFuck.Common.SimpleInstruction
9
10 import HelVM.HelMA.Automaton.API.IOTypes
11 import HelVM.HelMA.Automaton.ReadPExtra
12
13 import HelVM.HelIO.Control.Safe
14 import HelVM.HelIO.Extra hiding (runParser)
15
16 import qualified Data.Text as Text
17 import qualified Data.Vector as Vector
18
19 import Text.ParserCombinators.ReadP hiding (many)
20
21 parseAsVectorSafe :: Source -> Safe TreeInstructionVector
22 parseAsVectorSafe = parseAsVector
23
24 parseAsVector :: MonadSafe m => Source -> m TreeInstructionVector
25 parseAsVector = runParser treeInstructionsParser . filterComments
26
27 treeInstructionsParser :: ReadP TreeInstructionVector
28 treeInstructionsParser = Vector.fromList <$> many treeInstructionParser
29
30 treeInstructionParser :: ReadP TreeInstruction
31 treeInstructionParser = simpleParser <|> whileParser
32
33 whileParser :: ReadP TreeInstruction
34 whileParser = Tree.While <$> (char '[' *> treeInstructionsParser <* char ']')
35
36 simpleParser :: ReadP TreeInstruction
37 simpleParser = Simple . fromJustWithText "imposible" . charToSimpleInstruction <$> oneOf simpleInstructionChars
38
39 filterComments :: Source -> Source
40 filterComments = Text.filter isNotComment
41
42 isNotComment :: Char -> Bool
43 isNotComment c = c `elem` allInstructionChars
44
45 allInstructionChars :: String
46 allInstructionChars = "[]" <> simpleInstructionChars
47
48 simpleInstructionChars :: String
49 simpleInstructionChars = show =<< simpleInstructions