Support recurrent function calls. The code is kinda hackish and ugly, but I really spent a few hours thinking on a good solution.
--- 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