tools/pas2c.hs
changeset 6967 1224c6fb36c3
parent 6965 5718ec36900c
child 6979 cd28fe36170a
--- 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