tools/pas2c.hs
changeset 7186 013deb83086b
parent 7151 ec15d9e1a7e3
child 7265 3f96073156e1
--- a/tools/pas2c.hs	Mon May 28 10:38:27 2012 +0200
+++ b/tools/pas2c.hs	Tue Jun 05 22:17:06 2012 +0200
@@ -39,10 +39,11 @@
         uniqCounter :: Int,
         toMangle :: Set.Set String,
         currentUnit :: String,
+        currentFunctionResult :: String,
         namespaces :: Map.Map String Records
     }
     
-emptyState = RenderState Map.empty "" BTUnknown [] 0 Set.empty ""
+emptyState = RenderState Map.empty "" BTUnknown [] 0 Set.empty "" ""
 
 getUniq :: State RenderState Int
 getUniq = do
@@ -334,7 +335,7 @@
 resolveType (DeriveType (InitFloat _)) = return BTFloat
 resolveType (DeriveType (InitString _)) = return BTString
 resolveType (DeriveType (InitBinOp {})) = return BTInt
-resolveType (DeriveType (InitPrefixOp {})) = return BTInt
+resolveType (DeriveType (InitPrefixOp _ e)) = initExpr2C e >> gets lastType
 resolveType (DeriveType (BuiltInFunction{})) = return BTInt
 resolveType (DeriveType (InitReference (Identifier{}))) = return BTBool -- TODO: derive from actual type
 resolveType (DeriveType _) = return BTUnknown
@@ -381,13 +382,19 @@
     t <- type2C returnType
     t'<- gets lastType
     n <- id2C IOInsert $ setBaseType (BTFunction (numberOfDeclarations params) t') name
-    (p, ph) <- withState' (\st -> st{currentScope = Map.insertWith un (map toLower rv) [(render res, t')] $ currentScope st}) $ do
+    
+    let isVoid = case returnType of
+            VoidType -> True
+            _ -> False
+            
+    (p, ph) <- withState' (\st -> st{currentScope = Map.insertWith un (map toLower rv) [(render res, t')] $ currentScope st
+            , currentFunctionResult = if isVoid then [] else render res}) $ do
         p <- functionParams2C params
         ph <- liftM2 ($+$) (typesAndVars2C False tvars) (phrase2C' phrase)
         return (p, ph)
-    let phrasesBlock = case returnType of
-            VoidType -> ph
-            _ -> t empty <+> res <> semi $+$ ph $+$ text "return" <+> res <> semi
+        
+    let phrasesBlock = if isVoid then ph else t empty <+> res <> semi $+$ ph $+$ text "return" <+> res <> semi
+    
     return [ 
         t empty <+> n <> parens p
         $+$
@@ -615,7 +622,19 @@
         (BTFunction {}, (Reference r')) -> do
             e <- ref2C r'
             return $ r <+> text "=" <+> e <> semi
-        (BTArray (Range _) _ _, _) -> phrase2C $ 
+        (BTString, _) -> do
+            e <- expr2C expr
+            lt <- gets lastType
+            case lt of
+                -- assume pointer to char for simplicity
+                BTPointerTo _ -> do
+                    e <- expr2C $ Reference $ FunCall [Reference $ RefExpression expr] (SimpleReference (Identifier "pchar2str" BTUnknown))
+                    return $ r <+> text "=" <+> e <> semi
+                BTString -> do
+                    e <- expr2C expr
+                    return $ r <+> text "=" <+> e <> semi
+                _ -> error $ "Assignment to string from " ++ show lt
+        (BTArray _ _ _, _) -> phrase2C $ 
             ProcCall (FunCall
                 [
                 Reference $ Address ref
@@ -671,7 +690,12 @@
     return $ text "do" <+> p <+> text "while" <> parens (text "!" <> parens e) <> semi
 phrase2C NOP = return $ text ";"
 
-phrase2C (BuiltInFunctionCall [] (SimpleReference (Identifier "exit" BTUnknown))) = return $ text "return" <> semi
+phrase2C (BuiltInFunctionCall [] (SimpleReference (Identifier "exit" BTUnknown))) = do
+    f <- gets currentFunctionResult
+    if null f then
+        return $ text "return" <> semi
+        else
+        return $ text "return" <+> text f <> semi
 phrase2C (BuiltInFunctionCall [] (SimpleReference (Identifier "break" BTUnknown))) = return $ text "break" <> semi
 phrase2C (BuiltInFunctionCall [] (SimpleReference (Identifier "continue" BTUnknown))) = return $ text "continue" <> semi
 phrase2C (BuiltInFunctionCall [e] (SimpleReference (Identifier "exit" BTUnknown))) = liftM (\e -> text "return" <+> e <> semi) $ expr2C e
@@ -695,6 +719,7 @@
         ("+", BTString, BTString) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strconcat" (BTFunction 2 BTString))
         ("+", BTString, BTChar) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strappend" (BTFunction 2 BTString))
         ("+", BTChar, BTString) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strprepend" (BTFunction 2 BTString))
+        ("+", BTChar, BTChar) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_chrconcat" (BTFunction 2 BTString))
         ("==", BTString, BTChar) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strcomparec" (BTFunction 2 BTBool))
         ("==", BTString, BTString) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strcompare" (BTFunction 2 BTBool))
         ("!=", BTString, _) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strncompare" (BTFunction 2 BTBool))
@@ -878,9 +903,11 @@
     r <- ref2C ref
     return $ text "&" <> parens r
 ref2C (TypeCast t'@(Identifier i _) expr) = do
-    case map toLower i of
-        "pchar" -> ref2C $ FunCall [expr] (SimpleReference (Identifier "_pchar" $ BTPointerTo BTChar))
-        a -> do
+    lt <- expr2C expr >> gets lastType
+    case (map toLower i, lt) of
+        ("pchar", BTString) -> ref2C $ FunCall [expr] (SimpleReference (Identifier "_pchar" $ BTPointerTo BTChar))
+        ("shortstring", BTPointerTo _) -> ref2C $ FunCall [expr] (SimpleReference (Identifier "pchar2str" $ BTString))
+        (a, _) -> do
             e <- expr2C expr
             t <- id2C IOLookup t'    
             return . parens $ parens t <> e