# HG changeset patch # User unc0rr # Date 1333112434 -14400 # Node ID a137733c5776c2fac057f1e0a24fc52ae13f83a0 # Parent 42382794b73f84ac5586960a56139ceba42347e1 Much better types handling, work correctly with functions diff -r 42382794b73f -r a137733c5776 hedgewars/pas2cSystem.pas --- a/hedgewars/pas2cSystem.pas Thu Mar 29 17:27:01 2012 +0400 +++ b/hedgewars/pas2cSystem.pas Fri Mar 30 17:00:34 2012 +0400 @@ -46,5 +46,8 @@ Low, High : function : integer; Now : function : integer; Length : function : integer; - StrPas, FormatDateTime, copy, delete : function : shortstring; - exit : procedure; + Abs, Sqr : function : integer; + StrPas, FormatDateTime, copy, delete, str : function : shortstring; + exit, flush : procedure; + Sqrt : function : float; + TextFile : Handle; diff -r 42382794b73f -r a137733c5776 tools/pas2c.hs --- a/tools/pas2c.hs Thu Mar 29 17:27:01 2012 +0400 +++ b/tools/pas2c.hs Fri Mar 30 17:00:34 2012 +0400 @@ -32,6 +32,8 @@ namespaces :: Map.Map String [Record] } +emptyState = RenderState [] "" BTUnknown + docToLower :: Doc -> Doc docToLower = text . map toLower . render @@ -78,16 +80,16 @@ where toNamespace :: Map.Map String [Record] -> PascalUnit -> [Record] toNamespace nss (System tvs) = - currentScope $ execState (mapM_ (tvar2C True) tvs) (RenderState [] "" BTUnknown nss) + currentScope $ execState (mapM_ (tvar2C True) tvs) (emptyState nss) toNamespace _ (Program {}) = [] toNamespace nss (Unit _ interface _ _ _) = - currentScope $ execState (interface2C interface) (RenderState [] "" BTUnknown nss) + currentScope $ execState (interface2C interface) (emptyState nss) withState' :: (a -> a) -> State a b -> State a b withState' f s = do - st <- gets id - return $ evalState s (f st) + st <- liftM f get + return $ evalState s st withLastIdNamespace :: State RenderState Doc -> State RenderState Doc withLastIdNamespace f = do @@ -112,7 +114,7 @@ let (a, s) = runState (interface2C interface) initialState writeFile (fn ++ ".h") $ "#pragma once\n" ++ (render a) writeFile (fn ++ ".c") $ (render2C s . implementation2C) implementation - initialState = RenderState [] "" BTUnknown ns + initialState = emptyState ns render2C :: RenderState -> State RenderState Doc -> String render2C a = render . flip evalState a @@ -165,8 +167,10 @@ id2C :: InsertOption -> Identifier -> State RenderState Doc id2C IOInsert (Identifier i t) = do - modify (\s -> s{currentScope = (map toLower i, (i, t)) : currentScope s}) + modify (\s -> s{currentScope = (n, (i, t)) : currentScope s, lastIdentifier = n}) return $ text i + where + n = map toLower i id2C IOLookup (Identifier i t) = do let i' = map toLower i v <- gets $ find (\(a, _) -> a == i') . currentScope @@ -258,13 +262,14 @@ n <- id2C IOInsert name return $ t <+> n <> parens p <> text ";" -tvar2C True (FunctionDeclaration name returnType params (Just (tvars, phrase))) = do +tvar2C True (FunctionDeclaration (Identifier i _) returnType params (Just (tvars, phrase))) = do t <- type2C returnType - (p, ph) <- withState' id $ do + t'<- gets lastType + n <- id2C IOInsert (Identifier i (BTFunction t')) + (p, ph) <- withState' (\st -> st{currentScope = (lastIdentifier st, (lastIdentifier st ++ "_result", t')) : currentScope st}) $ do p <- liftM hcat $ mapM (tvar2C False) params ph <- liftM2 ($+$) (typesAndVars2C False tvars) (phrase2C' phrase) return (p, ph) - n <- id2C IOInsert name let res = docToLower $ n <> text "_result" let phrasesBlock = case returnType of VoidType -> ph @@ -301,8 +306,8 @@ initExpr Nothing = return $ empty initExpr (Just e) = liftM (text "=" <+>) (initExpr2C e) -tvar2C f (OperatorDeclaration op _ ret params body) = - tvar2C f (FunctionDeclaration (Identifier ("") BTUnknown) ret params body) +tvar2C f (OperatorDeclaration op i ret params body) = + tvar2C f (FunctionDeclaration i ret params body) initExpr2C :: InitExpression -> State RenderState Doc