never executed always true always false
1 module HelVM.HelMA.Automata.BrainFuck.Impl.Tree.Parser
2 ( parseAsVector
3 , parseAsVectorSafe
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