-
Notifications
You must be signed in to change notification settings - Fork 1
/
Expr.hs
81 lines (66 loc) · 2.13 KB
/
Expr.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
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
-- | Parse binary expressions by recursive descent.
--
-- <expr> ::= <term> { ("+" | "-") <term> }
-- <term> ::= <factor> { ("*" | "/") <factor> }
-- <factor> ::= "(" <expr> ")" | <num>
--
-- λ :l Expr
-- [1 of 2] Compiling Main ( Expr.hs, interpreted )
-- Ok, one module loaded.
-- λ parseTest (pExpr <* eof) "7 + 42 * 9"
-- Add (Num 7) (Mul (Num 42) (Num 9))
-- λ parseTest (pExpr <* eof) "2 * 3 / 4 * 5"
-- Mul (Div (Mul (Num 2) (Num 3)) (Num 4)) (Num 5)
-- λ parseTest (pExpr <* eof) "8 * (10 - 6)"
-- Mul (Num 8) (Sub (Num 10) (Num 6))
import Data.Void
import Control.Applicative hiding (many)
import Text.Megaparsec
import Text.Megaparsec.Char
import Text.Megaparsec.Char.Lexer as L
import Data.Functor (($>))
data Expr
= Add Expr Expr -- +
| Sub Expr Expr -- -
| Mul Expr Expr -- *
| Div Expr Expr -- /
| Num Int
deriving (Show, Eq)
type Parser = Parsec Void String
spaceConsumer :: Parser ()
spaceConsumer = L.space space1 empty empty
pSymbol :: String -> Parser String
pSymbol = L.symbol spaceConsumer
pLexeme :: Parser a -> Parser a
pLexeme = L.lexeme spaceConsumer
inParens :: Parser a -> Parser a
inParens = between (pSymbol "(") (pSymbol ")")
pNum :: Parser Expr
pNum = Num <$> pLexeme L.decimal
pFactor :: Parser Expr
pFactor = inParens pExpr <|> pNum
binExprL :: Parser Expr
-> Parser (Expr -> Expr -> Expr)
-> Parser Expr
binExprL pSide pOperator = do
lhs <- pSide
rhs <- many $ flip <$> pOperator <*> pSide
pure $ foldl (\expr f -> f expr) lhs rhs
-- pTerm :: Parser Expr
-- pTerm = do
-- lhs <- pFactor
-- rhs <- many $ flip <$> pOperator <*> pFactor
-- pure $ foldl (\expr f -> f expr) lhs rhs
-- where
-- pOperator = (pSymbol "*" $> Mul) <|> (pSymbol "/" $> Div)
pTerm :: Parser Expr
pTerm = binExprL pFactor ((pSymbol "*" $> Mul) <|> (pSymbol "/" $> Div))
-- pExpr :: Parser Expr
-- pExpr = do
-- lhs <- pTerm
-- rhs <- many $ flip <$> pOperator <*> pTerm
-- pure $ foldl (\expr f -> f expr) lhs rhs
-- where
-- pOperator = (pSymbol "+" $> Add) <|> (pSymbol "-" $> Sub)
pExpr :: Parser Expr
pExpr = binExprL pTerm ((pSymbol "+" $> Add) <|> (pSymbol "-" $> Sub))