blob: fda36624e91e82eb6c5e82ddbb9a5f92a1551c49 (
plain)
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
|
module Parser where
import Control.Monad (void)
import Data.Char (isSpace)
import Data.Functor.Identity (Identity)
import Text.Parsec
import Text.Parsec.Expr
import Debug.Trace
import Expr
type Parser = Parsec String ()
pLexemeSuffix :: Parser ()
pLexemeSuffix = eof <|> lookAhead (void (oneOf "()")) <|> void (many1 space)
lexeme :: String -> Parser ()
lexeme s = try $ string s >> pLexemeSuffix
operators :: OperatorTable String () Identity Expr
operators =
[[Prefix (symPrefix "+")]
,[Infix (symInfix "*") AssocLeft]
,[Infix (symInfix "+") AssocLeft
,Infix (symInfix "-") AssocLeft]
,[Infix (symInfix ":≤") AssocNone]]
where
symInfix :: String -> Parser (Expr -> Expr -> Expr)
symInfix name = do
lexeme name
return (einfix name)
symPrefix :: String -> Parser (Expr -> Expr)
symPrefix name = do
lexeme name
return (EPrefix name)
pAtom :: Parser Expr
pAtom = do
e <- pAtom'
traceM ("pAtom: " ++ show e)
return e
pAtom' :: Parser Expr
pAtom' = choice
[do _ <- char '('
_ <- many space
e <- pExpr
lexeme ")"
return e
,do s <- many1 digit
pLexemeSuffix
return (ELitInt (read s))
,do s <- many1 (satisfy (\c -> not (isSpace c) && c `notElem` "(){}"))
pLexemeSuffix
return (EVar s)]
pExpr :: Parser Expr
pExpr = buildExpressionParser operators pAtom
parseExpr :: Parser Expr
parseExpr = do
_ <- many space
e <- pExpr
eof
return e
|
