+++ /dev/null
--------------------------------------------------------------
--- Parser for WHILE from Nielson, Nielson and Hankin
--- and various other sources.
--------------------------------------------------------------
-
-module While( prettyWhileFromFile ) where
-
-import WhileAS
-import Text.ParserCombinators.Parsec
-import Text.ParserCombinators.Parsec.Expr
-import qualified Text.ParserCombinators.Parsec.Token as P
-import Text.ParserCombinators.Parsec.Language( javaStyle )
-
-
-prettyWhileFromFile 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
- }
-
---renum :: Prog -> Prog
---renum p = rn (1,p)
---rn :: (Int, Stat) -> (Int, Stat)
---rn (x,s) = case s of
--- Assign vi ae _ -> (x+1,Assign vi ae x)
--- Skip _ -> (x+1, Skip x)
--- Seq [Stat] ->
--- If be _ s1 s2 -> do{ (newx, newthen) <- rn (x+1,s1)
--- ; (newerx, newelse) <- rn (newx,s2)
--- ; return (newerx, If be x newthen newelse)
--- }
--- While be _ s -> do{ (newx, news) <- rn (x+1,s)
--- ; return (newx, While be x+1 news)
--- }
-
------------------------------------------------------------
--- A program is simply an expression.
------------------------------------------------------------
-program
- = do{ stats <- semiSep1 stat
- ; return (if length stats < 2 then head stats else Seq stats)
- }
-
-stat :: Parser Stat
-stat = choice
- [ do { reserved "skip";
- return (Skip 0)
- }
- , ifStat
- , whileStat
- , sequenceStat
- , try assignStat
- ]
-
-
-assignStat :: Parser Stat
-assignStat = do{ id <- identifier
- ; symbol ":="
- ; s <- aritExpr
- ; return (Assign id s 0)
- }
-
-ifStat :: Parser Stat
-ifStat = do{ reserved "if"
- ; cond <- boolExpr
- ; reserved "then"
- ; thenpart <- stat
- ; reserved "else"
- ; elsepart <- stat
- ; return (If cond 0 thenpart elsepart)
- }
-
-whileStat :: Parser Stat
-whileStat = do{ reserved "while"
- ; cond <- boolExpr
- ; reserved "do"
- ; body <- stat
- ; return (While cond 0 body)
- }
-
-sequenceStat :: Parser Stat
-sequenceStat = do{ stats <- parens (semiSep1 stat)
- ; return (if length stats < 2 then head stats else Seq stats)
- }
-
-boolExpr:: Parser BExp
-boolExpr = buildExpressionParser boolOperators relExpr
-
-relExpr :: Parser BExp
-relExpr = do{ arg1 <- aritExpr
- ; op <- choice [string "=", try (string "<>"), try (string "<="), string "<", try (string ">="), string ">"]
- ; arg2 <- aritExpr
- ; return (RelOp op arg1 arg2)
- }
-
-aritExpr :: Parser AExp
-aritExpr = buildExpressionParser aritOperators simpleArit
-
--- Everything mapping bools to bools
-boolOperators =
- [ [ prefix "not"]
- , [ opbb "and" AssocRight ] -- right for shortcircuit
- , [ opbb "or" AssocRight ] -- right for shortcircuit
- ]
- where
- opbb name assoc = Infix (do{ reservedOp name
- ; return (\x y -> BOp name x y)
- }) assoc
- prefix name = Prefix (do{ reservedOp name
- ; return (\x -> BUnOp name x)
- })
-
--- Everything mapping pairs of ints to ints
-aritOperators =
- [ [ op "*" AssocLeft, op "/" AssocLeft ]
- , [ op "+" AssocLeft, op "-" AssocLeft ]
- , [ op "&" AssocRight ] -- bitwise and delivering an int
- , [ op "|" AssocRight ] -- bitwise or delivering an int
- ]
- where
- op name assoc = Infix (do{ reservedOp name
- ; return (\x y -> AOp name x y)
- }) assoc
-
-
-simpleArit = choice [ intLiteral
- , parens aritExpr
- , variable
- ]
-
-simpleBool = choice [ boolLiteral
- , parens boolExpr
- ]
-
-boolLiteral = do{ reserved "false"
- ; return (BoolLit True)
- }
- <|>
- do{ reserved "true"
- ; return (BoolLit False)
- }
-
-intLiteral = do{ i <- integer; return (IntLit i) }
-variable = do{ id <- identifier
- ; return (Var id)
- }
-
-
------------------------------------------------------------
--- The lexer
------------------------------------------------------------
-lexer = P.makeTokenParser whileDef
-
-whileDef = javaStyle
- { -- Kept the Java single line comments, but officially the language has no comments
- P.reservedNames = [ "true", "false", "do", "else", "not",
- "if", "then", "while", "skip"
- -- , "begin", "proc", "is", "end", "val", "res", "malloc"
- ]
- , P.reservedOpNames= [ "and", "or", "not", "<", "<=", ">", ">=", ":=", "+", "&", "-", "/"]
- , P.opLetter = oneOf (concat (P.reservedOpNames whileDef))
- , P.caseSensitive = False
- }
-
-parens = P.parens lexer
-braces = P.braces lexer
-semiSep1 = P.semiSep1 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