diff -r 0e50456d652c -r 520a16a14747 tools/pas2c.hs --- a/tools/pas2c.hs Sat Jun 30 00:34:51 2012 +0400 +++ b/tools/pas2c.hs Sat Jun 30 01:09:31 2012 +0400 @@ -248,8 +248,8 @@ tom <- gets (Set.member n . toMangle) cu <- gets currentUnit let (i', t') = case (t, tom) of - (BTFunction p _, True) -> (cu ++ i ++ ('_' : show p), t) - (BTFunction _ _, _) -> (cu ++ i, t) + (BTFunction _ p _, True) -> (cu ++ i ++ ('_' : show p), t) + (BTFunction _ _ _, _) -> (cu ++ i, t) (BTVarParam t', _) -> ('(' : '*' : i ++ ")" , t') _ -> (i, t) modify (\s -> s{currentScope = Map.insertWith (++) n [(i', t')] (currentScope s), lastIdentifier = n}) @@ -268,7 +268,7 @@ let vv = fromMaybe (head $ fromJust v) . find checkParam $ fromJust v in modify (\s -> s{lastType = snd vv, lastIdentifier = fst vv}) >> (return . text . fst $ vv) where - checkParam (_, BTFunction p _) = p == params + checkParam (_, BTFunction _ p _) = p == params checkParam _ = False id2C IODeferred (Identifier i t) = do let i' = map toLower i @@ -330,7 +330,7 @@ t' <- resolveType t return $ BTArray i BTInt t' resolveType (ArrayDecl Nothing t) = liftM (BTArray RangeInfinite BTInt) $ resolveType t -resolveType (FunctionType t a) = liftM (BTFunction (length a)) $ resolveType t +resolveType (FunctionType t a) = liftM (BTFunction False (length a)) $ resolveType t resolveType (DeriveType (InitHexNumber _)) = return BTInt resolveType (DeriveType (InitNumber _)) = return BTInt resolveType (DeriveType (InitFloat _)) = return BTFloat @@ -396,11 +396,13 @@ t <- type2C returnType t'<- gets lastType p <- withState' id $ functionParams2C params - n <- liftM render . id2C IOInsert $ setBaseType (BTFunction (numberOfDeclarations params) t') name - if hasPassByReference params then + n <- liftM render . id2C IOInsert $ setBaseType (BTFunction hasVars (numberOfDeclarations params) t') name + if hasVars then return [funWithVarsToDefine n params $+$ t empty <+> text (n ++ "__vars") <> parens p] else return [t empty <+> text n <> parens p] + where + hasVars = hasPassByReference params fun2C True rv (FunctionDeclaration name@(Identifier i _) returnType params (Just (tvars, phrase))) = do @@ -410,7 +412,7 @@ notDeclared <- liftM isNothing . gets $ Map.lookup (map toLower i) . currentScope - n <- liftM render . id2C IOInsert $ setBaseType (BTFunction (numberOfDeclarations params) t') name + n <- liftM render . id2C IOInsert $ setBaseType (BTFunction hasVars (numberOfDeclarations params) t') name let isVoid = case returnType of VoidType -> True @@ -424,8 +426,8 @@ let phrasesBlock = if isVoid then ph else t empty <+> res <> semi $+$ ph $+$ text "return" <+> res <> semi - return [(if notDeclared && hasPassByReference params then funWithVarsToDefine n params else empty) $+$ - t empty <+> text (if hasPassByReference params then n ++ "__vars" else n) <> parens p + return [(if notDeclared && hasVars then funWithVarsToDefine n params else empty) $+$ + t empty <+> text (if hasVars then n ++ "__vars" else n) <> parens p $+$ text "{" $+$ @@ -436,6 +438,7 @@ phrase2C' (Phrases p) = liftM vcat $ mapM phrase2C p phrase2C' p = phrase2C p un [a] b = a : b + hasVars = hasPassByReference params fun2C False _ (FunctionDeclaration (Identifier name _) _ _ _) = error $ "nested functions not allowed: " ++ name fun2C _ tv _ = error $ "fun2C: I don't render " ++ show tv @@ -502,7 +505,12 @@ initExpr2C (InitArray values) = liftM (braces . vcat . punctuate comma) $ mapM initExpr2C values initExpr2C a = initExpr2C' a initExpr2C' InitNull = return $ text "NULL" -initExpr2C' (InitAddress expr) = liftM ((<>) (text "&")) (initExpr2C' expr) +initExpr2C' (InitAddress expr) = do + ie <- initExpr2C' expr + lt <- gets lastType + case lt of + BTFunction True _ _ -> return $ text "&" <> ie <> text "__vars" + _ -> return $ text "&" <> ie initExpr2C' (InitPrefixOp op expr) = liftM (text (op2C op) <>) (initExpr2C' expr) initExpr2C' (InitBinOp op expr1 expr2) = do e1 <- initExpr2C' expr1 @@ -749,13 +757,13 @@ e2 <- expr2C expr2 t2 <- gets lastType case (op2C op, t1, t2) of - ("+", 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)) + ("+", BTString, BTString) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strconcat" (BTFunction False 2 BTString)) + ("+", BTString, BTChar) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strappend" (BTFunction False 2 BTString)) + ("+", BTChar, BTString) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strprepend" (BTFunction False 2 BTString)) + ("+", BTChar, BTChar) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_chrconcat" (BTFunction False 2 BTString)) + ("==", BTString, BTChar) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strcomparec" (BTFunction False 2 BTBool)) + ("==", BTString, BTString) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strcompare" (BTFunction False 2 BTBool)) + ("!=", BTString, _) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strncompare" (BTFunction False 2 BTBool)) ("&", BTBool, _) -> return $ parens e1 <+> text "&&" <+> parens e2 ("|", BTBool, _) -> return $ parens e1 <+> text "||" <+> parens e2 (_, BTRecord t1 _, BTRecord t2 _) -> do @@ -841,7 +849,7 @@ t <- gets lastType ps <- mapM expr2C params case t of - BTFunction _ t' -> do + BTFunction _ _ t' -> do modify (\s -> s{lastType = t'}) _ -> error $ "BuiltInFunCall lastType: " ++ show t return $ @@ -853,7 +861,7 @@ i <- id2C IOLookup name t <- gets lastType case t of - BTFunction _ rt -> do + BTFunction _ _ rt -> do modify(\s -> s{lastType = rt}) return $ i <> parens empty _ -> return $ i @@ -861,7 +869,7 @@ i <- ref2C r t <- gets lastType case t of - BTFunction _ rt -> do + BTFunction _ _ rt -> do modify(\s -> s{lastType = rt}) return $ i <> parens empty _ -> return $ i @@ -921,7 +929,7 @@ r <- fref2C ref t <- gets lastType case t of - BTFunction _ t' -> do + BTFunction _ _ t' -> do ps <- liftM (parens . hsep . punctuate (char ',')) $ mapM expr2C params modify (\s -> s{lastType = t'}) return $ r <> ps @@ -934,7 +942,10 @@ ref2C (Address ref) = do r <- ref2C ref - return $ text "&" <> parens r + lt <- gets lastType + case lt of + BTFunction True _ _ -> return $ text "&" <> parens (r <> text "__vars") + _ -> return $ text "&" <> parens r ref2C (TypeCast t'@(Identifier i _) expr) = do lt <- expr2C expr >> gets lastType case (map toLower i, lt) of