+++ /dev/null
--------------------------------------------------------------
--- Parser for Tiger from Appel's book on compilers.
--- Semantic checks have been omitted for now.
--- Scope rules and such are as a consequence not implemented.
--------------------------------------------------------------
-
-module Tiger( prettyTigerFromFile ) where
-
-import TigerAS
-import Text.ParserCombinators.Parsec
-import Text.ParserCombinators.Parsec.Expr
-import qualified Text.ParserCombinators.Parsec.Token as P
-import Text.ParserCombinators.Parsec.Language( javaStyle )
-
-
-prettyTigerFromFile fname
- = do{ input <- readFile fname
- ; putStr input
- ; case parse program fname input of
- Left err -> do{ putStr "parse error at "
- ; print err
- }
- Right x -> print x
- }
-
-{-
-main = do putStr "Parsec Tiger parser\n"
- putStr "Type filename (without suffix): "
- basename <- getLine
- tokens <- scanner False keywordstxt
- keywordsops
- specialchars
- opchars
- (basename ++ ".sl")
- Nothing
- let ((exprpp,proof), errors) = parse pRoot tokens
- putStr (if null errors then "" else "Errors:\n" ++ errors)
- putStr ("Result:\n" ++ (disp exprpp 140 ""))
- writeFile (basename ++ ".tex") (disp proof 500 "")
- putStr ("\nGenerated proof in file " ++ (basename ++ ".tex"))
--}
-
------------------------------------------------------------
--- A program is simply an expression.
------------------------------------------------------------
-program
- = do{ whiteSpace
- ; e <- expr
- ; return e
- }
-
-----------------------------------------------------------------
--- Declarations for types, identifiers and functions
-----------------------------------------------------------------
-decs
- = many dec
-
-dec
- = tydec
- <|>
- vardec
- <|>
- fundec
-
-----------------------------------------------------------------
--- Type declarations
--- int and string are predefined, but not reserved.
-----------------------------------------------------------------
-tydec :: Parser Declaration
-tydec
- = do{ reserved "type"
- ; tid <- identifier
- ; symbol "="
- ; t <- ty
- ; return (TypeDec tid t)
- }
-
-ty
- = do{ fields <- braces tyfields
- ; return (Record fields)
- }
- <|>
- do{ reserved "array"
- ; reserved "of"
- ; tid <- identifier
- ; return (Array tid)
- }
- <|>
- do{ id <- identifier
- ; return (Var id)
- }
-
-tyfields
- = commaSep field
-
-noType = "*"
-voidType = "void"
-
-field
- = do{ id <- identifier
- ; symbol ":"
- ; tid <- identifier
- ; return (TypedVar id tid)
- }
-
-----------------------------------------------------------------
--- identifier declarations
--- Lacks: 11, 12
-----------------------------------------------------------------
-vardec
- = do{ reserved "var"
- ; id <- identifier
- ; t <- option noType (try (do{ symbol ":"
- ; identifier
- }))
- ; symbol ":="
- ; e <- expr
- ; return (VarDec id t e)
- }
-
-----------------------------------------------------------------
--- Function declarations
-----------------------------------------------------------------
-fundec
- = do{ reserved "function"
- ; name <- identifier
- ; parms <- parens tyfields
- ; rettype <- option voidType (do{ symbol ":"
- ; identifier
- })
- ; symbol "="
- ; body <- expr
- ; return (FunDec name parms rettype body)
- }
-
-----------------------------------------------------------------
--- Lvalues
--- This may not be what we want. I parse lvalues as
--- a list of dot separated array indexings (where the indexing)
--- may be absent. Possibly, we'd want the . and []
-----------------------------------------------------------------
-
--- This combinator does ab* in a leftassociative way.
--- Applicable when you have a cfg rule with left recursion
--- which you might rewrite into EBNF X -> YZ*.
-lfact :: Parser a -> Parser (a -> a) -> Parser a
-lfact p q = do{ a <- p
- ; fs <- many q
- ; return (foldl (\x f -> f x) a fs)
- }
-{-
-chainl op expr = lfact expr (do { o <- op
- ; e <- expr
- ; return (`o` e)
- })
- -}
-lvalue = lfact variable (recordref <|> subscripted)
-
-recordref = do{ symbol "."
- ; id <- variable
- ; return (\x -> Dot x id)
- }
-subscripted = do{ indexexpr <- brackets expr
- ; return (\x -> Sub x indexexpr)
- }
-
-{- Alternatively (an lvalue is then a sequence of, possibly (mutli-)indexed, identifiers separated by dots)
-lvalue :: Parser Expr
-lvalue = do{ flds <- sepBy1 subscripted (symbol ".")
- ; return (if length flds < 2 then head flds else Dots flds)
- }
-subscripted :: Parser Expr
-subscripted = do{ id <- identifier
- ; indexes <- many (brackets expr)
- ; return (if null indexes then Ident id
- else Subscripted id indexes)
- }
--}
-
-----------------------------------------------------------------
--- All types of expression(s)
-----------------------------------------------------------------
-
-exprs = many expr
-
-expr :: Parser Expr
-expr = choice
- [ do{ reserved "break"
- ; return Break
- }
- , ifExpr
- , whileExpr
- , forExpr
- , letExpr
- , sequenceExpr
- , infixExpr
--- , sequenceExpr -- I am not sure about this one.
- ]
-
-recordExpr :: Parser Expr
-recordExpr = do{ tid <- identifier
- ; symbol "{"
- ; fields <- commaSep1 fieldAssign
- ; symbol "}"
- ; return (RecordVal tid fields)
- }
-
-fieldAssign :: Parser AssignField
-fieldAssign = do{ id <- identifier
- ; symbol "="
- ; e <- expr
- ; return (AssignField id e)
- }
-
-arrayExpr :: Parser Expr
-arrayExpr = do{ tid <- identifier
- ; size <- brackets expr
- ; reserved "of"
- ; initvalue <- expr
- ; return (ArrayVal tid size initvalue)
- }
-
-assignExpr :: Parser Expr
-assignExpr = do{ lv <- lvalue
- ; symbol ":="
- ; e <- expr
- ; return (Assign lv e)
- }
-
-ifExpr :: Parser Expr
-ifExpr = do{ reserved "if"
- ; cond <- expr
- ; reserved "then"
- ; thenpart <- expr
- ; elsepart <- option Skip (do{ reserved "else"; expr})
- ; return (If cond thenpart elsepart)
- }
-
-whileExpr :: Parser Expr
-whileExpr = do{ reserved "while"
- ; cond <- expr
- ; reserved "do"
- ; body <- expr
- ; return (While cond body)
- }
-
-forExpr :: Parser Expr
-forExpr = do{ reserved "for"
- ; id <- identifier
- ; symbol ":="
- ; lowerbound <- expr
- ; reserved "to"
- ; upperbound <- expr
- ; reserved "do"
- ; body <- expr
- ; return (For id lowerbound upperbound body)
- }
-
-letExpr :: Parser Expr
-letExpr = do{ reserved "let"
- ; ds <- decs
- ; reserved "in"
- ; es <- semiSep expr
- ; reserved "end"
- ; return (Let ds es)
- }
-
-sequenceExpr :: Parser Expr
-sequenceExpr = do{ exps <- parens (semiSep1 expr)
- ; return (if length exps < 2 then head exps else Seq exps)
- }
-
-infixExpr :: Parser Expr
-infixExpr = buildExpressionParser operators simpleExpr
-
-operators =
- [ [ prefix "-"]
- , [ op "*" AssocLeft, op "/" AssocLeft ]
- , [ op "+" AssocLeft, op "-" AssocLeft ]
- , [ op "=" AssocNone, op "<>" AssocNone, op "<=" AssocNone
- , op "<" AssocNone, op ">=" AssocNone, op ">" AssocNone ]
- , [ op "&" AssocRight ] -- Right for shortcircuiting
- , [ op "|" AssocRight ] -- Right for shortcircuiting
- , [ op ":=" AssocRight ]
- ]
- where
- op name assoc = Infix (do{ reservedOp name
- ; return (\x y -> Op name x y)
- }) assoc
- prefix name = Prefix (do{ reservedOp name
- ; return (\x -> UnOp name x)
- })
-
-simpleExpr = choice [ do{ reserved "nil"
- ; return Nil
- }
- , intLiteral
- , strLiteral
- , parens expr
- , try funCallExpr
- , try recordExpr
- , try arrayExpr
- , lvalue
- ]
-
-funCallExpr = do{ id <- identifier
- ; parms <- parens (commaSep expr)
- ; return (Apply id parms)
- }
-
-intLiteral = do{ i <- integer; return (IntLit i) }
-strLiteral = do{ s <- stringLiteral; return (StringLit s) }
-variable = do{ id <- identifier
- ; return (Ident id)
- }
-
-
------------------------------------------------------------
--- The lexer
------------------------------------------------------------
-lexer = P.makeTokenParser tigerDef
-
-tigerDef = javaStyle
- { -- Kept the Java single line comments, but officially the language has no comments
- P.reservedNames = [ "array", "break", "do", "else", "end", "for", "function",
- "if", "in", "let",
- "nil", "of", "then", "to", "type", "var", "while" ]
- , P.reservedOpNames= [ "<", "<=", ">", ">=", ":=", "+", "&", "-", "/"]
- , P.opLetter = oneOf (concat (P.reservedOpNames tigerDef))
- , P.caseSensitive = True
- }
-
-parens = P.parens lexer
-braces = P.braces lexer
-semiSep = P.semiSep lexer
-semiSep1 = P.semiSep1 lexer
-commaSep = P.commaSep lexer
-commaSep1 = P.commaSep1 lexer
-brackets = P.brackets lexer
-whiteSpace = P.whiteSpace lexer
-symbol = P.symbol lexer
-identifier = P.identifier lexer
-reserved = P.reserved lexer
-reservedOp = P.reservedOp lexer
-integer = P.integer lexer
-charLiteral = P.charLiteral lexer
-stringLiteral = P.stringLiteral lexer
projects / ghc-base.git / blobdiff