Convert function with var parameters declarations into #define + function which accepts pointers
--- a/tools/PascalUnitSyntaxTree.hs Thu Jun 28 22:45:06 2012 +0400
+++ b/tools/PascalUnitSyntaxTree.hs Fri Jun 29 00:45:13 2012 +0400
@@ -30,8 +30,9 @@
| String Integer
| Set TypeDecl
| FunctionType TypeDecl [TypeVarDeclaration]
- | DeriveType InitExpression
+ | DeriveType InitExpression
| VoidType
+ | VarParamType TypeDecl -- this is a hack
deriving Show
data Range = Range Identifier
| RangeFromTo InitExpression InitExpression
@@ -113,4 +114,5 @@
| BTEnum [String]
| BTVoid
| BTUnit
+ | BTVarParam BaseType
deriving Show
--- a/tools/pas2c.hs Thu Jun 28 22:45:06 2012 +0400
+++ b/tools/pas2c.hs Fri Jun 29 00:45:13 2012 +0400
@@ -247,11 +247,12 @@
ns <- gets currentScope
tom <- gets (Set.member n . toMangle)
cu <- gets currentUnit
- let i' = case (t, tom) of
- (BTFunction p _, True) -> cu ++ i ++ ('_' : show p)
- (BTFunction _ _, _) -> cu ++ i
- _ -> i
- modify (\s -> s{currentScope = Map.insertWith (++) n [(i', t)] (currentScope s), lastIdentifier = n})
+ let (i', t') = case (t, tom) of
+ (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})
return $ text i'
where
n = map toLower i
@@ -344,6 +345,7 @@
resolveType (Sequence ids) = return $ BTEnum $ map (\(Identifier i _) -> map toLower i) ids
resolveType (RangeType _) = return $ BTVoid
resolveType (Set t) = liftM BTSet $ resolveType t
+resolveType (VarParamType t) = liftM BTVarParam $ resolveType t
resolve :: String -> BaseType -> State RenderState BaseType
@@ -375,19 +377,40 @@
isVar (VarDeclaration v _ (_, _) _) = v
isVar _ = error $ "hasPassByReference called not on function parameters"
+toIsVarList :: [TypeVarDeclaration] -> [Bool]
+toIsVarList = concatMap isVar
+ where
+ isVar (VarDeclaration v _ (p, _) _) = replicate (length p) v
+ isVar _ = error $ "toIsVarList called not on function parameters"
+
+
+funWithVarsToDefine :: String -> [TypeVarDeclaration] -> Doc
+funWithVarsToDefine n params = text "#define" <+> text n <> parens abc <+> text (n ++ "__vars") <> parens cparams
+ where
+ abc = hcat . punctuate comma . map (char . fst) $ ps
+ cparams = hcat . punctuate comma . map (\(c, v) -> if v then char '&' <> parens (char c) else char c) $ ps
+ ps = zip ['a'..] (toIsVarList params)
+
fun2C :: Bool -> String -> TypeVarDeclaration -> State RenderState [Doc]
fun2C _ _ (FunctionDeclaration name returnType params Nothing) = do
t <- type2C returnType
t'<- gets lastType
p <- withState' id $ functionParams2C params
- n <- id2C IOInsert $ setBaseType (BTFunction (numberOfDeclarations params) t') name
- return [t empty <+> n <> parens p]
+ n <- liftM render . id2C IOInsert $ setBaseType (BTFunction (numberOfDeclarations params) t') name
+ if hasPassByReference params then
+ return [funWithVarsToDefine n params $+$ t empty <+> text (n ++ "__vars") <> parens p]
+ else
+ return [t empty <+> text n <> parens p]
-fun2C True rv (FunctionDeclaration name returnType params (Just (tvars, phrase))) = do
+
+fun2C True rv (FunctionDeclaration name@(Identifier i _) returnType params (Just (tvars, phrase))) = do
let res = docToLower $ text rv <> text "_result"
t <- type2C returnType
t'<- gets lastType
- n <- id2C IOInsert $ setBaseType (BTFunction (numberOfDeclarations params) t') name
+
+ notDeclared <- liftM isNothing . gets $ Map.lookup (map toLower i) . currentScope
+
+ n <- liftM render . id2C IOInsert $ setBaseType (BTFunction (numberOfDeclarations params) t') name
let isVoid = case returnType of
VoidType -> True
@@ -401,8 +424,8 @@
let phrasesBlock = if isVoid then ph else t empty <+> res <> semi $+$ ph $+$ text "return" <+> res <> semi
- return [
- t empty <+> n <> parens p
+ return [(if notDeclared then funWithVarsToDefine n params else empty) $+$
+ t empty <+> text (if hasPassByReference params then n ++ "__vars" else n) <> parens p
$+$
text "{"
$+$
@@ -425,6 +448,10 @@
tp <- type2C t
return [text "typedef" <+> tp i]
+tvar2C _ (VarDeclaration True _ (ids, t) Nothing) = do
+ t' <- liftM ((empty <+>) . ) $ type2C t
+ liftM (map(\i -> t' i)) $ mapM (id2CTyped (VarParamType t)) ids
+
tvar2C _ (VarDeclaration _ isConst (ids, t) mInitExpr) = do
t' <- liftM (((if isConst then text "const" else empty) <+>) . ) $ type2C t
ie <- initExpr mInitExpr