diff -r f8248bcba8f1 -r 013deb83086b tools/pas2c.hs --- 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