# HG changeset patch # User unc0rr # Date 1344359913 -14400 # Node ID 39866eb9e4a61e53f751331f4bbcf5379d7face9 # Parent 1841d5cf899f1e6b11e8b1bd925bbd53c76b738c Keep inlining diff -r 1841d5cf899f -r 39866eb9e4a6 tools/PascalParser.hs --- a/tools/PascalParser.hs Mon Aug 06 23:30:58 2012 +0400 +++ b/tools/PascalParser.hs Tue Aug 07 21:18:33 2012 +0400 @@ -270,12 +270,12 @@ char ';' comments forward <- liftM isJust $ optionMaybe (try (string "forward;") >> comments) - many functionDecorator + inline <- liftM (any (== "inline;")) $ many functionDecorator b <- if isImpl && (not forward) then liftM Just functionBody else return Nothing - return $ [OperatorDeclaration i rid ret vs b] + return $ [OperatorDeclaration i rid inline ret vs b] funcDecl = do @@ -295,21 +295,24 @@ char ';' comments forward <- liftM isJust $ optionMaybe (try (string "forward;") >> comments) - many functionDecorator + inline <- liftM (any (== "inline;")) $ many functionDecorator b <- if isImpl && (not forward) then liftM Just functionBody else return Nothing - return $ [FunctionDeclaration i ret vs b] + return $ [FunctionDeclaration i inline ret vs b] - functionDecorator = choice [ - try $ string "inline;" - , 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 + functionDecorator = do + d <- choice [ + try $ string "inline;" + , 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 + return d program = do diff -r 1841d5cf899f -r 39866eb9e4a6 tools/PascalUnitSyntaxTree.hs --- a/tools/PascalUnitSyntaxTree.hs Mon Aug 06 23:30:58 2012 +0400 +++ b/tools/PascalUnitSyntaxTree.hs Tue Aug 07 21:18:33 2012 +0400 @@ -19,8 +19,8 @@ deriving Show data TypeVarDeclaration = TypeDeclaration Identifier TypeDecl | VarDeclaration Bool Bool ([Identifier], TypeDecl) (Maybe InitExpression) - | FunctionDeclaration Identifier TypeDecl [TypeVarDeclaration] (Maybe (TypesAndVars, Phrase)) - | OperatorDeclaration String Identifier TypeDecl [TypeVarDeclaration] (Maybe (TypesAndVars, Phrase)) + | FunctionDeclaration Identifier Bool TypeDecl [TypeVarDeclaration] (Maybe (TypesAndVars, Phrase)) + | OperatorDeclaration String Identifier Bool TypeDecl [TypeVarDeclaration] (Maybe (TypesAndVars, Phrase)) deriving Show data TypeDecl = SimpleType Identifier | RangeType Range diff -r 1841d5cf899f -r 39866eb9e4a6 tools/pas2c.hs --- a/tools/pas2c.hs Mon Aug 06 23:30:58 2012 +0400 +++ b/tools/pas2c.hs Tue Aug 07 21:18:33 2012 +0400 @@ -210,7 +210,7 @@ pascal2C (Program _ implementation mainFunction) = do impl <- implementation2C implementation - [main] <- tvar2C True False True True (FunctionDeclaration (Identifier "main" BTInt) (SimpleType $ Identifier "int" BTInt) [VarDeclaration False False ([Identifier "argc" BTInt], SimpleType (Identifier "Integer" BTInt)) Nothing, VarDeclaration False False ([Identifier "argv" BTUnknown], SimpleType (Identifier "PPChar" BTUnknown)) Nothing] (Just (TypesAndVars [], mainFunction))) + [main] <- tvar2C True False True True (FunctionDeclaration (Identifier "main" BTInt) False (SimpleType $ Identifier "int" BTInt) [VarDeclaration False False ([Identifier "argc" BTInt], SimpleType (Identifier "Integer" BTInt)) Nothing, VarDeclaration False False ([Identifier "argv" BTUnknown], SimpleType (Identifier "PPChar" BTUnknown)) Nothing] (Just (TypesAndVars [], mainFunction))) return $ impl $+$ main @@ -241,7 +241,7 @@ where initMap = Map.empty --initMap = Map.fromList [("reset", 2)] - ins (FunctionDeclaration (Identifier i _) _ _ _) m = Map.insertWith (+) (map toLower i) 1 m + ins (FunctionDeclaration (Identifier i _) _ _ _ _) m = Map.insertWith (+) (map toLower i) 1 m ins _ m = m -- the second bool indicates whether declare variable as extern or not @@ -429,20 +429,21 @@ ps = zip ['a'..] (toIsVarList params) fun2C :: Bool -> String -> TypeVarDeclaration -> State RenderState [Doc] -fun2C _ _ (FunctionDeclaration name returnType params Nothing) = do +fun2C _ _ (FunctionDeclaration name inline returnType params Nothing) = do t <- type2C returnType t'<- gets lastType p <- withState' id $ functionParams2C params n <- liftM render . id2C IOInsert $ setBaseType (BTFunction hasVars (numberOfDeclarations params) t') name + let decor = if inline then text "inline" else empty if hasVars then - return [funWithVarsToDefine n params $+$ t empty <+> text (n ++ "__vars") <> parens p] + return [funWithVarsToDefine n params $+$ decor <+> t empty <+> text (n ++ "__vars") <> parens p] else - return [t empty <+> text n <> parens p] + return [decor <+> t empty <+> text n <> parens p] where hasVars = hasPassByReference params -fun2C True rv (FunctionDeclaration name@(Identifier i _) returnType params (Just (tvars, phrase))) = do +fun2C True rv (FunctionDeclaration name@(Identifier i _) inline returnType params (Just (tvars, phrase))) = do let res = docToLower $ text rv <> text "_result" t <- type2C returnType t'<- gets lastType @@ -463,11 +464,12 @@ let phrasesBlock = if isVoid then ph else t empty <+> res <> semi $+$ ph $+$ text "return" <+> res <> semi let define = if hasVars then text "#ifndef" <+> text n $+$ funWithVarsToDefine n params $+$ text "#endif" else empty + let decor = if inline then text "inline" else empty return [ define $+$ --(if notDeclared && hasVars then funWithVarsToDefine n params else empty) $+$ - t empty <+> text (if hasVars then n ++ "__vars" else n) <> parens p + decor <+> t empty <+> text (if hasVars then n ++ "__vars" else n) <> parens p $+$ text "{" $+$ @@ -480,14 +482,14 @@ un [a] b = a : b hasVars = hasPassByReference params -fun2C False _ (FunctionDeclaration (Identifier name _) _ _ _) = error $ "nested functions not allowed: " ++ name +fun2C False _ (FunctionDeclaration (Identifier name _) _ _ _ _) = error $ "nested functions not allowed: " ++ name fun2C _ tv _ = error $ "fun2C: I don't render " ++ show tv -- the second bool indicates whether declare variable as extern or not -- the third bool indicates whether include types or not -- the fourth bool indicates whether ignore initialization or not (basically for dynamic arrays since we cannot do initialization in function params) tvar2C :: Bool -> Bool -> Bool -> Bool -> TypeVarDeclaration -> State RenderState [Doc] -tvar2C b _ includeType _ f@(FunctionDeclaration (Identifier name _) _ _ _) = do +tvar2C b _ includeType _ f@(FunctionDeclaration (Identifier name _) _ _ _ _) = do t <- fun2C b name f if includeType then return t else return [] tvar2C _ _ includeType _ td@(TypeDeclaration i' t) = do @@ -545,9 +547,9 @@ ArrayDecl _ _ -> error "Mixed dynamic array and static array are not supported." _ -> 0 -tvar2C f _ _ _ (OperatorDeclaration op (Identifier i _) ret params body) = do +tvar2C f _ _ _ (OperatorDeclaration op (Identifier i _) inline ret params body) = do r <- op2CTyped op (extractTypes params) - fun2C f i (FunctionDeclaration r ret params body) + fun2C f i (FunctionDeclaration r inline ret params body) op2CTyped :: String -> [TypeDecl] -> State RenderState Identifier