Support recurrent function calls. The code is kinda hackish and ugly, but I really spent a few hours thinking on a good solution.
authorunc0rr
Mon, 30 Apr 2012 23:35:40 +0400
changeset 6967 1224c6fb36c3
parent 6966 eda4f63bec41
child 6968 23722ba0f89a
Support recurrent function calls. The code is kinda hackish and ugly, but I really spent a few hours thinking on a good solution.
hedgewars/pas2c.h
hedgewars/pas2cSystem.pas
tools/PascalUnitSyntaxTree.hs
tools/pas2c.hs
--- a/hedgewars/pas2c.h	Mon Apr 30 20:12:43 2012 +0200
+++ b/hedgewars/pas2c.h	Mon Apr 30 23:35:40 2012 +0400
@@ -63,7 +63,7 @@
 string255 copy(string255 a, int s, int l);
 string255 delete(string255 a, int s, int l);
 
-#define STRINIT(a) {.len = sizeof(a), .str = a}
+#define STRINIT(a) {.len = sizeof(a) - 1, .str = a}
 
 typedef int file;
 extern int FileMode;
--- a/hedgewars/pas2cSystem.pas	Mon Apr 30 20:12:43 2012 +0200
+++ b/hedgewars/pas2cSystem.pas	Mon Apr 30 23:35:40 2012 +0400
@@ -65,7 +65,7 @@
     trunc, round : function : integer;
     Abs, Sqr : function : integer;
 
-    StrPas, FormatDateTime, copy, delete, str, pos, trim : function : shortstring;
+    StrPas, FormatDateTime, copy, delete, str, pos, trim, LowerCase : function : shortstring;
     Length, StrToInt : function : integer;
     SetLength, val : procedure;
     _pchar : function : PChar;
@@ -122,7 +122,7 @@
     glbegin, glend, gltexcoord2f, glvertex2d,
     gl_true, gl_false, glcolormask, gl_projection,
     gl_texture_priority, glenum, gl_clamp_to_edge,
-    gl_extensions : procedure;
+    gl_extensions, gl_bgra : procedure;
 
     TThreadId : function : integer;
     BeginThread, ThreadSwitch : procedure;
--- a/tools/PascalUnitSyntaxTree.hs	Mon Apr 30 20:12:43 2012 +0200
+++ b/tools/PascalUnitSyntaxTree.hs	Mon Apr 30 23:35:40 2012 +0400
@@ -106,6 +106,7 @@
     | BTRecord [(String, BaseType)]
     | BTArray Range BaseType BaseType
     | BTFunction BaseType
+    | BTFunctionReturn String BaseType
     | BTPointerTo BaseType
     | BTUnresolved String
     | BTSet BaseType
--- a/tools/pas2c.hs	Mon Apr 30 20:12:43 2012 +0200
+++ b/tools/pas2c.hs	Mon Apr 30 23:35:40 2012 +0400
@@ -304,16 +304,18 @@
 resolveType (Set t) = liftM BTSet $ resolveType t
    
 
-fromPointer :: String -> BaseType -> State RenderState BaseType    
-fromPointer s (BTPointerTo t) = f t
-    where
-        f (BTUnresolved s) = do
-            v <- gets $ find (\(a, _) -> a == s) . currentScope
-            if isJust v then
-                f . snd . snd . fromJust $ v
-                else
-                error $ "Unknown type " ++ show t ++ "\n" ++ s
-        f t = return t
+resolve :: String -> BaseType -> State RenderState BaseType
+resolve s (BTUnresolved t) = do
+    v <- gets $ find (\(a, _) -> a == t) . currentScope
+    if isJust v then
+        resolve s . snd . snd . fromJust $ v
+        else
+        error $ "Unknown type " ++ show t ++ "\n" ++ s
+resolve _ t = return t
+
+fromPointer :: String -> BaseType -> State RenderState BaseType
+fromPointer s (BTPointerTo t) = resolve s t
+fromPointer s (BTFunctionReturn _ (BTPointerTo t)) = resolve s t
 fromPointer s t = do
     ns <- gets currentScope
     error $ "Dereferencing from non-pointer type " ++ show t ++ "\n" ++ s ++ "\n\n" ++ show (take 100 ns)
@@ -334,7 +336,7 @@
     t <- type2C returnType
     t'<- gets lastType
     n <- id2C IOInsert $ setBaseType (BTFunction t') name
-    (p, ph) <- withState' (\st -> st{currentScope = (map toLower rv, (render res, t')) : currentScope st}) $ do
+    (p, ph) <- withState' (\st -> st{currentScope = (map toLower rv, (render res, BTFunctionReturn (render n) t')) : currentScope st}) $ do
         p <- functionParams2C params
         ph <- liftM2 ($+$) (typesAndVars2C False tvars) (phrase2C' phrase)
         return (p, ph)
@@ -672,6 +674,8 @@
     ns <- gets currentScope
     case t of
          (BTArray _ _ t') -> modify (\st -> st{lastType = t'})
+         (BTFunctionReturn _ (BTArray _ _ t')) -> modify (\st -> st{lastType = t'})
+         (BTFunctionReturn _ (BTString)) -> modify (\st -> st{lastType = BTChar})
          (BTString) -> modify (\st -> st{lastType = BTChar})
          (BTPointerTo t) -> do
                 t'' <- fromPointer (show t) =<< gets lastType
@@ -698,8 +702,9 @@
     t <- gets lastType
     ns <- gets currentScope
     r2 <- case t of
+        BTFunctionReturn s (BTRecord rs) -> withRecordNamespace "" rs $ ref2C ref2       
         BTRecord rs -> withRecordNamespace "" rs $ ref2C ref2
-        BTUnit -> withLastIdNamespace $ ref2C ref2
+        BTUnit -> withLastIdNamespace $ ref2C ref2        
         a -> error $ "dereferencing from " ++ show a ++ "\n" ++ show rf ++ "\n" ++ show (take 100 ns)
     return $ 
         r1 <> text "." <> r2
@@ -716,6 +721,10 @@
             ps <- liftM (parens . hsep . punctuate (char ',')) $ mapM expr2C params
             modify (\s -> s{lastType = t'})
             return $ r <> ps
+        BTFunctionReturn r t' -> do
+            ps <- liftM (parens . hsep . punctuate (char ',')) $ mapM expr2C params
+            modify (\s -> s{lastType = t'})
+            return $ text r <> ps
         _ -> case (ref, params) of
                   (SimpleReference i, [p]) -> ref2C $ TypeCast i p
                   _ -> error $ "ref2C FunCall erroneous type cast detected: " ++ show f ++ "\nType detected: " ++ show t