-
Notifications
You must be signed in to change notification settings - Fork 0
/
parser.hs
65 lines (53 loc) · 1.64 KB
/
parser.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
module Parser
( parse
, ParseTree(..)
) where
import Data.Char
import Parserlib
import Tokenizer
{----------------------------------}
data ParseTree = AddNode ParseTree ParseTree
| PrgrmNode [ParseTree]
| AssignNode String ParseTree
| IdentNode String
| SubNode ParseTree ParseTree
| MultNode ParseTree ParseTree
| DivNode ParseTree ParseTree
| NegNode ParseTree
| NumNode Int
| EndNode
deriving (Show, Eq)
type TokParser = Parser Token ParseTree
{-
Prgrm <- Expr ';' | Expr ';' Prgrm
Expr <- Term (('+' | '-') term)* | Ident '=' Expr
Term <- Factor (('*' | '/') Factor)*
Factor <- Int | '(' Expr ')' | '(' '-' Factor ')' | Ident
-}
parse :: [Token] -> ParseTree
parse = (\(Just (_, x)) -> x) . runParser prgrm
--
prgrm :: TokParser
prgrm = PrgrmNode <$> many (expr <* itemP TokEnd)
expr :: TokParser
expr = assignP <|> chainl1 term (addP <|> subP)
where
addP = AddNode <$ itemP (TokOp Add)
subP = SubNode <$ itemP (TokOp Sub)
assignP :: Parser Token ParseTree
assignP =
(\x _ y -> AssignNode x y) <$> fieldP getTokIdent <*> itemP TokAssign <*> expr
term :: TokParser
term = chainl1 factor (multP <|> divP)
where
multP = MultNode <$ itemP (TokOp Mult)
divP = DivNode <$ itemP (TokOp Div)
factor :: TokParser
factor = intP <|> parExprP <|> negP <|> identP
where
intP = NumNode <$> fieldP getTokInt
parExprP = itemP TokLParen *> expr <* itemP TokRParen
identP = IdentNode <$> fieldP getTokIdent
negP =
NegNode
<$> (itemP TokLParen *> itemP (TokOp Sub) *> factor <* itemP TokRParen)