/
ParsecParser.hs
87 lines (69 loc) · 1.9 KB
/
ParsecParser.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
82
83
84
85
86
87
module Simple4.ParsecParser where
import Simple4.Syntax
import Data.Functor
import Control.Monad
import Control.Monad.Error
import Text.ParserCombinators.Parsec
import qualified Text.ParserCombinators.Parsec.Token as PT
import Text.ParserCombinators.Parsec.Language(emptyDef)
langDef = emptyDef {
PT.reservedNames = ["let", "in", "new", "None",
"if","then","else"]}
lexer = PT.makeTokenParser langDef
identifier = PT.identifier lexer
integer = PT.integer lexer
symbol = PT.symbol lexer
parens = PT.parens lexer
reserved = PT.reserved lexer
kw = reserved
runParser :: String -> String -> Either ParseError Defs
runParser info input = parse pProg info input
pProg :: Parser Defs
pProg = pDefs
pDefs :: Parser Defs
pDefs = pDef `sepBy1` pOptionalSemi
pOptionalSemi :: Parser ()
pOptionalSemi = optional $ symbol ";"
pDef :: Parser Def
pDef = (try pFullDef) <|> ((\e -> ("_",e)) <$> pExp)
pFullDef =do
v <- identifier
foo <- symbol "="
e <- pExp
return $ (v, e)
pExp, pTerm, pF :: Parser Exp
pExp = pIf <|> pNew <|> pLet <|> pArith
pIf = do
kw "if"
e1 <- pExp
kw "then"
e2 <- pExp
kw "else"
e3 <- pExp
return $ EIf e1 e2 e3
pLet :: Parser Exp
pLet = do
kw "let"
ds <- pDefs
kw "in"
e <- pExp
return $ ELets ds e
pNew = ENew <$> (kw "new" >> pExp)
pArith :: Parser Exp
pArith = pTerm `chainl1` pAdd
pAdd = symbol "+" >> return EAdd
pTerm = pF
pF = EInt <$> integer <|> pIdExp <|> parens pExp
<|> EDeref <$> (EVar <$> (symbol "*" >> identifier))
<|> pRec <|> (kw "None" >> return ENone)
pRec = symbol "{" >> symbol "}" >> return ERecEmpty
{- I = id I'
I' = "." id I'' | eps
I'' = "=" E | eps
-}
pIdExp = identifier >>= pIdExp'
pIdExp' :: Name -> Parser Exp
pIdExp' n = (symbol "." >> identifier >>= pIdExp'' n )
<|> (return $ EVar n)
pIdExp'' n n2 = (symbol "=" >> (ESet n n2 <$> pExp))
<|> (return $ EGet n n2)