Convert function with var parameters declarations into #define + function which accepts pointers
authorunc0rr
Fri, 29 Jun 2012 00:45:13 +0400
changeset 7323 8490a4f439a5
parent 7321 57bd4f201401
child 7325 a68eca3ad1fe
Convert function with var parameters declarations into #define + function which accepts pointers
tools/PascalUnitSyntaxTree.hs
tools/pas2c.hs
--- 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