--- 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