diff -r 3cb15ca5319f -r 4b9a59116535 tools/PascalParser.hs --- a/tools/PascalParser.hs Tue Nov 22 02:08:42 2011 +0100 +++ b/tools/PascalParser.hs Tue Nov 22 19:34:15 2011 +0300 @@ -1,16 +1,18 @@ module PascalParser where -import Text.Parsec.Expr +import Text.Parsec import Text.Parsec.Char import Text.Parsec.Token import Text.Parsec.Language +import Text.Parsec.Expr import Text.Parsec.Prim import Text.Parsec.Combinator import Text.Parsec.String import Control.Monad -import Data.Char import Data.Maybe +import PascalBasics + data PascalUnit = Program Identifier Implementation | Unit Identifier Interface Implementation (Maybe Initialize) (Maybe Finalize) @@ -90,66 +92,12 @@ | InitNull deriving Show -builtin = ["succ", "pred", "low", "high"] - -pascalLanguageDef - = emptyDef - { commentStart = "(*" - , commentEnd = "*)" - , commentLine = "//" - , nestedComments = False - , identStart = letter <|> oneOf "_" - , identLetter = alphaNum <|> oneOf "_." - , reservedNames = [ - "begin", "end", "program", "unit", "interface" - , "implementation", "and", "or", "xor", "shl" - , "shr", "while", "do", "repeat", "until", "case", "of" - , "type", "var", "const", "out", "array", "packed" - , "procedure", "function", "with", "for", "to" - , "downto", "div", "mod", "record", "set", "nil" - , "string", "shortstring" - ] ++ builtin - , reservedOpNames= [] - , caseSensitive = False - } - -caseInsensitiveString s = do - mapM_ (\a -> satisfy (\b -> toUpper a == toUpper b)) s s - return s - -pas = patch $ makeTokenParser pascalLanguageDef - where - patch tp = tp {stringLiteral = sl} - sl = do - (char '\'') - s <- (many $ noneOf "'") - (char '\'') - ss <- many $ do - (char '\'') - s' <- (many $ noneOf "'") - (char '\'') - return $ '\'' : s' - comments - return $ concat (s:ss) - -comments = do - spaces - skipMany $ do - comment - spaces - pascalUnit = do comments u <- choice [program, unit] comments return u -comment = choice [ - char '{' >> manyTill anyChar (try $ char '}') - , (try $ string "(*") >> manyTill anyChar (try $ string "*)") - , (try $ string "//") >> manyTill anyChar (try newline) - ] - iD = do i <- liftM Identifier (identifier pas) comments @@ -389,12 +337,13 @@ term = comments >> choice [ builtInFunction expression >>= \(n, e) -> return $ BuiltInFunCall e (SimpleReference (Identifier n)) , parens pas $ expression - , try $ integer pas >>= \i -> notFollowedBy (char '.') >> (return . NumberLiteral . show) i + , try $ natural pas >>= \i -> notFollowedBy (char '.') >> (return . NumberLiteral . show) i , try $ float pas >>= return . FloatLiteral . show - , try $ integer pas >>= return . NumberLiteral . show + , try $ natural pas >>= return . NumberLiteral . show , stringLiteral pas >>= return . StringLiteral , char '#' >> many digit >>= return . CharCode , char '$' >> many hexDigit >>= return . HexNumber + , char '-' >> expression >>= return . PrefixOp "-" , try $ string "nil" >> return Null , reference >>= return . Reference ] "simple expression" @@ -407,7 +356,6 @@ ] , [ Infix (char '+' >> return (BinOp "+")) AssocLeft , Infix (char '-' >> return (BinOp "-")) AssocLeft - , Prefix (char '-' >> return (PrefixOp "-")) ] , [ Infix (try (string "<>") >> return (BinOp "<>")) AssocNone , Infix (try (string "<=") >> return (BinOp "<=")) AssocNone @@ -626,3 +574,4 @@ exprs <- parens pas $ commaSep1 pas $ e spaces return (name, exprs) + \ No newline at end of file