diff -r 8b3575750cd2 -r 514138949c76 tools/PascalParser.hs --- a/tools/PascalParser.hs Tue Jul 10 11:08:35 2012 +0200 +++ b/tools/PascalParser.hs Tue Jul 10 11:09:38 2012 +0200 @@ -14,7 +14,7 @@ import PascalBasics import PascalUnitSyntaxTree - + knownTypes = ["shortstring", "ansistring", "char", "byte"] pascalUnit = do @@ -27,7 +27,7 @@ i <- liftM (flip Identifier BTUnknown) (identifier pas) comments return i - + unit = do string "unit" >> comments name <- iD @@ -38,7 +38,7 @@ comments return $ Unit name int impl Nothing Nothing - + reference = buildExpressionParser table term "reference" where term = comments >> choice [ @@ -48,9 +48,9 @@ , liftM SimpleReference iD >>= postfixes ] "simple reference" - table = [ + table = [ ] - + postfixes r = many postfix >>= return . foldl (flip ($)) r postfix = choice [ parens pas (option [] parameters) >>= return . FunCall @@ -64,21 +64,23 @@ e <- parens pas expression comments return $ TypeCast (Identifier t BTUnknown) e - - -varsDecl1 = varsParser sepEndBy1 + +varsDecl1 = varsParser sepEndBy1 varsDecl = varsParser sepEndBy varsParser m endsWithSemi = do vs <- m (aVarDecl endsWithSemi) (semi pas) return vs aVarDecl endsWithSemi = do - unless endsWithSemi $ - optional $ choice [ - try $ string "var" - , try $ string "const" - , try $ string "out" - ] + isVar <- liftM (== Just "var") $ + if not endsWithSemi then + optionMaybe $ choice [ + try $ string "var" + , try $ string "const" + , try $ string "out" + ] + else + return Nothing comments ids <- do i <- (commaSep1 pas) $ (try iD "variable declaration") @@ -93,7 +95,7 @@ e <- initExpression comments return (Just e) - return $ VarDeclaration False (ids, t) init + return $ VarDeclaration isVar False (ids, t) init constsDecl = do @@ -114,8 +116,8 @@ comments e <- initExpression comments - return $ VarDeclaration (isNothing t) ([i], fromMaybe (DeriveType e) t) (Just e) - + return $ VarDeclaration False (isNothing t) ([i], fromMaybe (DeriveType e) t) (Just e) + typeDecl = choice [ char '^' >> typeDecl >>= return . PointerTo , try (string "shortstring") >> return (String 255) @@ -211,7 +213,6 @@ comments return $ TypeDeclaration i t - rangeDecl = choice [ try $ rangeft , iD >>= return . Range @@ -221,8 +222,8 @@ e1 <- initExpression string ".." e2 <- initExpression - return $ RangeFromTo e1 e2 - + return $ RangeFromTo e1 e2 + typeVarDeclaration isImpl = (liftM concat . many . choice) [ varSection, constSection, @@ -251,7 +252,7 @@ t <- typesDecl "type declaration" comments return t - + operatorDecl = do try $ string "operator" comments @@ -276,7 +277,7 @@ return Nothing return $ [OperatorDeclaration i rid ret vs b] - + funcDecl = do fp <- try (string "function") <|> try (string "procedure") comments @@ -300,7 +301,7 @@ else return Nothing return $ [FunctionDeclaration i ret vs b] - + functionDecorator = choice [ try $ string "inline;" , try $ caseInsensitiveString "cdecl;" @@ -309,8 +310,8 @@ , try $ string "varargs;" , try (string "external") >> comments >> iD >> optional (string "name" >> comments >> stringLiteral pas)>> string ";" ] >> comments - - + + program = do string "program" comments @@ -396,15 +397,15 @@ ] ] strOrChar [a] = CharCode . show . ord $ a - strOrChar a = StringLiteral a - + strOrChar a = StringLiteral a + phrasesBlock = do try $ string "begin" comments p <- manyTill phrase (try $ string "end" >> notFollowedBy alphaNum) comments return $ Phrases p - + phrase = do o <- choice [ phrasesBlock @@ -459,7 +460,7 @@ comments o <- phrase return $ foldr WithBlock o rs - + repeatCycle = do try $ string "repeat" >> space comments @@ -488,7 +489,7 @@ p <- phrase comments return $ ForCycle i e1 e2 p - + switchCase = do try $ string "case" comments @@ -515,14 +516,14 @@ p <- phrase comments return (e, p) - + procCall = do r <- reference p <- option [] $ (parens pas) parameters return $ ProcCall r p parameters = (commaSep pas) expression "parameters" - + functionBody = do tv <- typeVarDeclaration True comments @@ -559,7 +560,7 @@ , itypeCast , iD >>= return . InitReference ] - + recField = do i <- iD spaces @@ -569,7 +570,7 @@ spaces return (i ,e) - table = [ + table = [ [ Prefix (char '-' >> return (InitPrefixOp "-")) ] @@ -603,7 +604,7 @@ i <- parens pas initExpression comments return $ InitTypeCast (Identifier t BTUnknown) i - + builtInFunction e = do name <- choice $ map (\s -> try $ caseInsensitiveString s >>= \i -> notFollowedBy alphaNum >> return i) builtin spaces