JackCompiler/expression.hs at master · bcecil2/JackCompiler · GitHub

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
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
module Expression where

import TokenParser
import Lexer
import Control.Monad
import Control.Applicative


isKeywordConst :: Token -> Bool
isKeywordConst t = t `elem` [(Keyword "true")
		    ,(Keyword "false")
		    ,(Keyword "null")
		    ,(Keyword "this")]

isBinOp :: Token -> Bool
isBinOp t = t `elem` [   (Symbol "+")
			,(Symbol "-")
			,(Symbol "*")
			,(Symbol "/")
			,(Symbol "&")
			,(Symbol "|")
			,(Symbol "<")
			,(Symbol ">")
			,(Symbol "<")
			,(Symbol "=")]


isUnOp :: Token -> Bool
isUnOp t = t `elem` [Symbol "-", Symbol "~"]

parseKeywordConst :: Parser ParseTree
parseKeywordConst = Lit <$> sat isKeywordConst

parseBinOp :: Parser ParseTree
parseBinOp = Lit <$> sat isBinOp

parseUOp :: Parser ParseTree
parseUOp = Lit <$> sat isUnOp


parseSimpleTerm :: Parser ParseTree
parseSimpleTerm = parseInt <|>
                  parseString <|>
		  parseKeywordConst <|>
		  parseName

parseArrayTerm :: Parser ParseTree
parseArrayTerm = do
                   s <- parseName
		   openB <- parseLit (Symbol "[")
		   expr <- parseExpr
		   closeb <- parseLit (Symbol "]")
		   return Node {name = "", children = [s,openB,expr,closeb]}

parseUOpTerm :: Parser ParseTree
parseUOpTerm = do
                 uOp <- parseUOp
		 t <- parseTerm
		 return Node {name = "", children = [uOp,t]}


parseSCall :: Parser ParseTree
parseSCall = do
                 sName <- parseName
		 oP <- parseLit (Symbol "(")
		 exprL <- parseExprList
                 cP <- parseLit (Symbol ")")
                 return Node {name ="", children = [sName,oP,exprL,cP]}

parseCCall :: Parser ParseTree
parseCCall = do
               name <- parseName
	       dot <- parseLit (Symbol ".")
	       sName <- parseName
	       oP <- parseLit (Symbol "(")
	       exprL <- parseExprList
               cP <- parseLit (Symbol ")")
               return Node {name ="", children = [name,dot,sName,oP,exprL,cP]}


parseSubroutineCall :: Parser ParseTree
parseSubroutineCall = parseSCall <|> parseCCall

parseExprTerm :: Parser ParseTree
parseExprTerm = do
		  oP <- parseLit (Symbol "(")
	          expr <- parseExpr
                  cP <- parseLit (Symbol ")")
		  return  Node {name = "", children = [oP,expr,cP]}

parseTerm :: Parser ParseTree
parseTerm = do
            e <- parseArrayTerm <|> parseSubroutineCall <|> parseSimpleTerm <|> parseExprTerm <|> parseUOpTerm
	    return Node {name = "term", children = [e]}

parseExprList :: Parser ParseTree
parseExprList = eList <|> pure (Node "expressionList" [])
             where eList = do
	                     expr <- parseExpr
			     exprs <- many0 (parseLit (Symbol ",") `mplus` parseExpr)
			     return Node {name = "expressionList", children = [expr, Node {name = "", children = exprs}]}

parseExpr :: Parser ParseTree
parseExpr = do
               t <- parseTerm
               ts <- many0 (parseBinOp `mplus` parseTerm)
	       return Node {name = "expression", children = [t, Node{name = "", children = ts}]}