1 -------------------------------------------------------------
2 -- Parser for Tiger from Appel's book on compilers.
3 -- Semantic checks have been omitted for now.
4 -- Scope rules and such are as a consequence not implemented.
5 -------------------------------------------------------------
7 module Tiger( prettyTigerFromFile ) where
10 import Text.ParserCombinators.Parsec
11 import Text.ParserCombinators.Parsec.Expr
12 import qualified Text.ParserCombinators.Parsec.Token as P
13 import Text.ParserCombinators.Parsec.Language( javaStyle )
16 prettyTigerFromFile fname
17 = do{ input <- readFile fname
19 ; case parse program fname input of
20 Left err -> do{ putStr "parse error at "
27 main = do putStr "Parsec Tiger parser\n"
28 putStr "Type filename (without suffix): "
30 tokens <- scanner False keywordstxt
36 let ((exprpp,proof), errors) = parse pRoot tokens
37 putStr (if null errors then "" else "Errors:\n" ++ errors)
38 putStr ("Result:\n" ++ (disp exprpp 140 ""))
39 writeFile (basename ++ ".tex") (disp proof 500 "")
40 putStr ("\nGenerated proof in file " ++ (basename ++ ".tex"))
43 -----------------------------------------------------------
44 -- A program is simply an expression.
45 -----------------------------------------------------------
52 ----------------------------------------------------------------
53 -- Declarations for types, identifiers and functions
54 ----------------------------------------------------------------
65 ----------------------------------------------------------------
67 -- int and string are predefined, but not reserved.
68 ----------------------------------------------------------------
69 tydec :: Parser Declaration
75 ; return (TypeDec tid t)
79 = do{ fields <- braces tyfields
80 ; return (Record fields)
100 = do{ id <- identifier
103 ; return (TypedVar id tid)
106 ----------------------------------------------------------------
107 -- identifier declarations
109 ----------------------------------------------------------------
113 ; t <- option noType (try (do{ symbol ":"
118 ; return (VarDec id t e)
121 ----------------------------------------------------------------
122 -- Function declarations
123 ----------------------------------------------------------------
125 = do{ reserved "function"
127 ; parms <- parens tyfields
128 ; rettype <- option voidType (do{ symbol ":"
133 ; return (FunDec name parms rettype body)
136 ----------------------------------------------------------------
138 -- This may not be what we want. I parse lvalues as
139 -- a list of dot separated array indexings (where the indexing)
140 -- may be absent. Possibly, we'd want the . and []
141 ----------------------------------------------------------------
143 -- This combinator does ab* in a leftassociative way.
144 -- Applicable when you have a cfg rule with left recursion
145 -- which you might rewrite into EBNF X -> YZ*.
146 lfact :: Parser a -> Parser (a -> a) -> Parser a
147 lfact p q = do{ a <- p
149 ; return (foldl (\x f -> f x) a fs)
152 chainl op expr = lfact expr (do { o <- op
157 lvalue = lfact variable (recordref <|> subscripted)
159 recordref = do{ symbol "."
161 ; return (\x -> Dot x id)
163 subscripted = do{ indexexpr <- brackets expr
164 ; return (\x -> Sub x indexexpr)
167 {- Alternatively (an lvalue is then a sequence of, possibly (mutli-)indexed, identifiers separated by dots)
168 lvalue :: Parser Expr
169 lvalue = do{ flds <- sepBy1 subscripted (symbol ".")
170 ; return (if length flds < 2 then head flds else Dots flds)
172 subscripted :: Parser Expr
173 subscripted = do{ id <- identifier
174 ; indexes <- many (brackets expr)
175 ; return (if null indexes then Ident id
176 else Subscripted id indexes)
180 ----------------------------------------------------------------
181 -- All types of expression(s)
182 ----------------------------------------------------------------
188 [ do{ reserved "break"
197 -- , sequenceExpr -- I am not sure about this one.
200 recordExpr :: Parser Expr
201 recordExpr = do{ tid <- identifier
203 ; fields <- commaSep1 fieldAssign
205 ; return (RecordVal tid fields)
208 fieldAssign :: Parser AssignField
209 fieldAssign = do{ id <- identifier
212 ; return (AssignField id e)
215 arrayExpr :: Parser Expr
216 arrayExpr = do{ tid <- identifier
217 ; size <- brackets expr
220 ; return (ArrayVal tid size initvalue)
223 assignExpr :: Parser Expr
224 assignExpr = do{ lv <- lvalue
227 ; return (Assign lv e)
230 ifExpr :: Parser Expr
231 ifExpr = do{ reserved "if"
235 ; elsepart <- option Skip (do{ reserved "else"; expr})
236 ; return (If cond thenpart elsepart)
239 whileExpr :: Parser Expr
240 whileExpr = do{ reserved "while"
244 ; return (While cond body)
247 forExpr :: Parser Expr
248 forExpr = do{ reserved "for"
256 ; return (For id lowerbound upperbound body)
259 letExpr :: Parser Expr
260 letExpr = do{ reserved "let"
268 sequenceExpr :: Parser Expr
269 sequenceExpr = do{ exps <- parens (semiSep1 expr)
270 ; return (if length exps < 2 then head exps else Seq exps)
273 infixExpr :: Parser Expr
274 infixExpr = buildExpressionParser operators simpleExpr
278 , [ op "*" AssocLeft, op "/" AssocLeft ]
279 , [ op "+" AssocLeft, op "-" AssocLeft ]
280 , [ op "=" AssocNone, op "<>" AssocNone, op "<=" AssocNone
281 , op "<" AssocNone, op ">=" AssocNone, op ">" AssocNone ]
282 , [ op "&" AssocRight ] -- Right for shortcircuiting
283 , [ op "|" AssocRight ] -- Right for shortcircuiting
284 , [ op ":=" AssocRight ]
287 op name assoc = Infix (do{ reservedOp name
288 ; return (\x y -> Op name x y)
290 prefix name = Prefix (do{ reservedOp name
291 ; return (\x -> UnOp name x)
294 simpleExpr = choice [ do{ reserved "nil"
306 funCallExpr = do{ id <- identifier
307 ; parms <- parens (commaSep expr)
308 ; return (Apply id parms)
311 intLiteral = do{ i <- integer; return (IntLit i) }
312 strLiteral = do{ s <- stringLiteral; return (StringLit s) }
313 variable = do{ id <- identifier
318 -----------------------------------------------------------
320 -----------------------------------------------------------
321 lexer = P.makeTokenParser tigerDef
324 { -- Kept the Java single line comments, but officially the language has no comments
325 P.reservedNames = [ "array", "break", "do", "else", "end", "for", "function",
327 "nil", "of", "then", "to", "type", "var", "while" ]
328 , P.reservedOpNames= [ "<", "<=", ">", ">=", ":=", "+", "&", "-", "/"]
329 , P.opLetter = oneOf (concat (P.reservedOpNames tigerDef))
330 , P.caseSensitive = True
333 parens = P.parens lexer
334 braces = P.braces lexer
335 semiSep = P.semiSep lexer
336 semiSep1 = P.semiSep1 lexer
337 commaSep = P.commaSep lexer
338 commaSep1 = P.commaSep1 lexer
339 brackets = P.brackets lexer
340 whiteSpace = P.whiteSpace lexer
341 symbol = P.symbol lexer
342 identifier = P.identifier lexer
343 reserved = P.reserved lexer
344 reservedOp = P.reservedOp lexer
345 integer = P.integer lexer
346 charLiteral = P.charLiteral lexer
347 stringLiteral = P.stringLiteral lexer