diff -r 7c6f9b6672dc -r 11c578d30bd3 tools/PascalParser.hs --- a/tools/PascalParser.hs Sun Nov 27 19:34:08 2011 +0300 +++ b/tools/PascalParser.hs Sun Nov 27 23:13:22 2011 +0300 @@ -16,6 +16,7 @@ data PascalUnit = Program Identifier Implementation Phrase | Unit Identifier Interface Implementation (Maybe Initialize) (Maybe Finalize) + | System deriving Show data Interface = Interface Uses TypesAndVars deriving Show @@ -57,7 +58,7 @@ | ForCycle Identifier Expression Expression Phrase | WithBlock Reference Phrase | Phrases [Phrase] - | SwitchCase Expression [([InitExpression], Phrase)] (Maybe Phrase) + | SwitchCase Expression [([InitExpression], Phrase)] (Maybe [Phrase]) | Assignment Reference Expression | NOP deriving Show @@ -78,11 +79,12 @@ deriving Show data Reference = ArrayElement [Expression] Reference | FunCall [Expression] Reference - | TypeCast Identifier Reference + | TypeCast Identifier Expression | SimpleReference Identifier | Dereference Reference | RecordField Reference Reference | Address Reference + | RefExpression Expression deriving Show data InitExpression = InitBinOp String InitExpression InitExpression | InitPrefixOp String InitExpression @@ -95,11 +97,14 @@ | InitString String | InitChar String | BuiltInFunction String [InitExpression] - | InitSet [Identifier] + | InitSet [InitExpression] + | InitAddress InitExpression | InitNull + | InitRange Range + | InitTypeCast Identifier InitExpression deriving Show -knownTypes = ["shortstring"] +knownTypes = ["shortstring", "char", "byte"] pascalUnit = do comments @@ -126,14 +131,13 @@ reference = buildExpressionParser table term "reference" where term = comments >> choice [ - parens pas (reference >>= postfixes) >>= postfixes - , typeCast >>= postfixes + parens pas (liftM RefExpression expression >>= postfixes) >>= postfixes + , try $ typeCast >>= postfixes , char '@' >> liftM Address reference >>= postfixes , liftM SimpleReference iD >>= postfixes ] "simple reference" table = [ - [Infix (try (char '.' >> notFollowedBy (char '.')) >> return RecordField) AssocLeft] ] postfixes r = many postfix >>= return . foldl (flip ($)) r @@ -141,13 +145,14 @@ parens pas (option [] parameters) >>= return . FunCall , char '^' >> return Dereference , (brackets pas) (commaSep1 pas $ expression) >>= return . ArrayElement + , (char '.' >> notFollowedBy (char '.')) >> liftM RecordField reference ] typeCast = do t <- choice $ map (\s -> try $ caseInsensitiveString s >>= \i -> notFollowedBy alphaNum >> return i) knownTypes - r <- parens pas reference + e <- parens pas expression comments - return $ TypeCast (Identifier t) r + return $ TypeCast (Identifier t) e varsDecl1 = varsParser sepEndBy1 @@ -293,6 +298,7 @@ semi pas comments return $ TypeDeclaration i t + rangeDecl = choice [ try $ rangeft @@ -303,7 +309,7 @@ e1 <- initExpression string ".." e2 <- initExpression - return $ RangeFromTo e1 e2 + return $ RangeFromTo e1 e2 typeVarDeclaration isImpl = (liftM concat . many . choice) [ varSection, @@ -385,8 +391,10 @@ functionDecorator = choice [ try $ string "inline;" - , try $ string "cdecl;" + , try $ caseInsensitiveString "cdecl;" , try $ string "overload;" + , try $ string "export;" + , try $ string "varargs;" , try (string "external") >> comments >> iD >> optional (string "name" >> comments >> stringLiteral pas)>> string ";" ] >> comments @@ -431,7 +439,7 @@ where term = comments >> choice [ builtInFunction expression >>= \(n, e) -> return $ BuiltInFunCall e (SimpleReference (Identifier n)) - , parens pas $ expression + , try (parens pas $ expression >>= \e -> notFollowedBy (comments >> char '.') >> return e) , brackets pas (commaSep pas iD) >>= return . SetExpression , try $ natural pas >>= \i -> notFollowedBy (char '.') >> (return . NumberLiteral . show) i , float pas >>= return . FloatLiteral . show @@ -490,6 +498,7 @@ , forCycle , (try $ reference >>= \r -> string ":=" >> return r) >>= \r -> expression >>= return . Assignment r , procCall + , char ';' >> comments >> return NOP ] optional $ char ';' comments @@ -572,7 +581,7 @@ o2 <- optionMaybe $ do try $ string "else" >> notFollowedBy alphaNum comments - o <- phrase + o <- many phrase comments return o string "end" @@ -580,7 +589,7 @@ return $ SwitchCase e cs o2 where aCase = do - e <- (commaSep pas) initExpression + e <- (commaSep pas) $ (liftM InitRange rangeDecl <|> initExpression) comments char ':' comments @@ -617,16 +626,18 @@ where term = comments >> choice [ liftM (uncurry BuiltInFunction) $ builtInFunction initExpression - , try $ brackets pas (commaSep pas $ iD) >>= return . InitSet + , try $ brackets pas (commaSep pas $ initExpression) >>= return . InitSet , try $ parens pas (commaSep pas $ initExpression) >>= return . InitArray - , parens pas (semiSep pas $ recField) >>= return . InitRecord + , parens pas (sepEndBy recField (char ';' >> comments)) >>= return . InitRecord , try $ integer pas >>= \i -> notFollowedBy (char '.') >> (return . InitNumber . show) i , try $ float pas >>= return . InitFloat . show , try $ integer pas >>= return . InitNumber . show , stringLiteral pas >>= return . InitString , char '#' >> many digit >>= \c -> comments >> return (InitChar c) , char '$' >> many hexDigit >>= \h -> comments >> return (InitHexNumber h) + , char '@' >> initExpression >>= \c -> comments >> return (InitAddress c) , try $ string "nil" >> return InitNull + , itypeCast , iD >>= return . InitReference ] @@ -666,6 +677,12 @@ , [Prefix (try (string "not") >> return (InitPrefixOp "not"))] ] + itypeCast = do + t <- choice $ map (\s -> try $ caseInsensitiveString s >>= \i -> notFollowedBy alphaNum >> return i) knownTypes + i <- parens pas initExpression + comments + return $ InitTypeCast (Identifier t) i + builtInFunction e = do name <- choice $ map (\s -> try $ caseInsensitiveString s >>= \i -> notFollowedBy alphaNum >> return i) builtin spaces