1 -----------------------------------------------------------
2 -- Daan Leijen (c) 1999-2000, daan@cs.uu.nl
3 -----------------------------------------------------------
4 module MonParser ( parseMondrian
5 , parseMondrianFromFile
14 import Utils (groupLambdas)
17 import Text.ParserCombinators.Parsec
18 import Text.ParserCombinators.Parsec.Expr
19 import qualified Text.ParserCombinators.Parsec.Token as P
20 import Text.ParserCombinators.Parsec.Language (mondrianDef)
23 import qualified SimpleMondrianPrinter as Pretty
28 -----------------------------------------------------------
30 -----------------------------------------------------------
31 parseMondrianFromFile :: String -> IO (Either ParseError CompilationUnit)
32 parseMondrianFromFile fname =
33 parseFromFile compilationUnit fname
35 parseMondrian sourceName source =
36 parse compilationUnit sourceName source
42 = do{ result <- parseMondrianFromFile fname
44 Left err -> putStr ("parse error at: " ++ show err)
45 Right x -> print (Pretty.compilationUnit x)
49 -----------------------------------------------------------
51 -----------------------------------------------------------
52 compilationUnit :: Parser CompilationUnit
56 ; name <- option [""] packageName
57 ; decls <- option [] declarations
59 ; return $ Package name decls
62 -----------------------------------------------------------
64 -----------------------------------------------------------
66 braces (semiSep1 declaration)
71 <|> variableSignatureDeclaration
74 variableSignatureDeclaration =
75 do{ name <- variableName
76 ; variableDeclaration name <|> signatureDeclaration name
79 variableDeclaration name =
82 ; return $ VarDecl name expr
84 <?> "variable declaration"
89 ; star <- option [] (do{ symbol "."
93 ; return $ ImportDecl (name ++ star)
99 ; extends <- option [] (do{ reserved "extends"
103 ; decls <- option [] declarations
104 ; return $ ClassDecl name extends decls
107 signatureDeclaration name =
109 ; texpr <- typeExpression
110 ; return $ SigDecl name texpr
112 <?> "type declaration"
115 -----------------------------------------------------------
117 -----------------------------------------------------------
118 expression :: Parser Expr
128 ; name <- variableName
131 ; return $ groupLambdas (Lambda [name] expr)
136 ; decls <- declarations
139 ; return $ Let decls expr
145 ; decls <- option [] declarations
146 ; return $ New name decls
150 -----------------------------------------------------------
152 -----------------------------------------------------------
154 buildExpressionParser operators applyExpression
157 [ [ prefix "-", prefix "+" ]
158 , [ op "^" AssocRight ]
159 , [ op "*" AssocLeft, op "/" AssocLeft ]
160 , [ op "+" AssocLeft, op "-" AssocLeft ]
161 , [ op "==" AssocNone, op "/=" AssocNone, op "<" AssocNone
162 , op "<=" AssocNone, op ">" AssocNone, op ">=" AssocNone ]
163 , [ op "&&" AssocNone ]
164 , [ op "||" AssocNone ]
167 op name assoc = Infix (do{ var <- try (symbol name)
168 ; return (\x y -> App (App (Var [var]) x) y)
170 prefix name = Prefix (do{ var <- try (symbol name)
171 ; return (\x -> App (Var [var,"unary"]) x)
177 do{ exprs <- many1 simpleExpression
178 ; return (foldl1 App exprs)
183 do{ (e,es) <- chain simpleExpression operator "infix expression"
184 ; return $ if null es then e else (unChain (Chain e es))
188 simpleExpression :: Parser Expr
191 <|> parens expression
194 <?> "simple expression"
197 -----------------------------------------------------------
199 -----------------------------------------------------------
204 ; alts <- alternatives
205 ; return $ Case expr alts
209 braces (semiSep1 arm)
219 do{ reserved "default"
222 <|> do{ name <- patternName
223 ; decls <- option [] declarations
224 ; return $ Pattern name decls
229 -----------------------------------------------------------
231 -----------------------------------------------------------
235 do{ (e,es) <- chain simpleType typeOperator "type expression"
236 ; return $ if null es then e else Chain e es
238 <?> "type expression"
241 typeExpression :: Parser Expr
243 do{ exprs <- sepBy1 simpleType (symbol "->")
244 ; return (foldl1 (\x y -> App (App (Var ["->"]) x) y) exprs)
247 simpleType :: Parser Expr
249 parens typeExpression
255 -----------------------------------------------------------
257 -----------------------------------------------------------
260 -----------------------------------------------------------
261 -- Identifiers & Reserved words
262 -----------------------------------------------------------
264 do{ name <- variableName
268 patternName = qualifiedName <?> "pattern variable"
269 variableName = qualifiedName <?> "identifier"
270 className = qualifiedName <?> "class name"
271 packageName = qualifiedName <?> "package name"
274 identifier `sepBy1` (symbol "." <?> "")
277 -----------------------------------------------------------
279 -----------------------------------------------------------
281 do{ v <- intLiteral <|> chrLiteral <|> strLiteral
286 intLiteral = do{ n <- natural; return (IntLit n) }
287 chrLiteral = do{ c <- charLiteral; return (CharLit c) }
288 strLiteral = do{ s <- stringLiteral; return (StringLit s) }
292 -----------------------------------------------------------
294 -- Use qualified import to have token parsers on toplevel
295 -----------------------------------------------------------
296 mondrian = P.makeTokenParser mondrianDef
298 parens = P.parens mondrian
299 braces = P.braces mondrian
300 semiSep1 = P.semiSep1 mondrian
301 whiteSpace = P.whiteSpace mondrian
302 symbol = P.symbol mondrian
303 identifier = P.identifier mondrian
304 reserved = P.reserved mondrian
305 natural = P.natural mondrian
306 charLiteral = P.charLiteral mondrian
307 stringLiteral = P.stringLiteral mondrian