Prepare to handle passing by reference
authorunc0rr
Thu, 28 Jun 2012 00:30:50 +0400
changeset 7317 3534a264b27a
parent 7315 59b5b19e6604
child 7319 c4705bca9f21
Prepare to handle passing by reference
tools/PascalParser.hs
tools/PascalUnitSyntaxTree.hs
tools/pas2c.hs
--- a/tools/PascalParser.hs	Wed Jun 27 22:53:26 2012 +0400
+++ b/tools/PascalParser.hs	Thu Jun 28 00:30:50 2012 +0400
@@ -72,12 +72,15 @@
     return vs
 
 aVarDecl endsWithSemi = do
-    unless endsWithSemi $
-        optional $ choice [
-            try $ string "var"
-            , try $ string "const"
-            , try $ string "out"
-            ]
+    isVar <- liftM (== Just "var") $
+        if not endsWithSemi then
+            optionMaybe $ choice [
+                try $ string "var"
+                , try $ string "const"
+                , try $ string "out"
+                ]
+            else
+                return Nothing
     comments
     ids <- do
         i <- (commaSep1 pas) $ (try iD <?> "variable declaration")
@@ -92,7 +95,7 @@
         e <- initExpression
         comments
         return (Just e)
-    return $ VarDeclaration False (ids, t) init
+    return $ VarDeclaration isVar False (ids, t) init
 
 
 constsDecl = do
@@ -113,7 +116,7 @@
         comments
         e <- initExpression
         comments
-        return $ VarDeclaration (isNothing t) ([i], fromMaybe (DeriveType e) t) (Just e)
+        return $ VarDeclaration False (isNothing t) ([i], fromMaybe (DeriveType e) t) (Just e)
 
 typeDecl = choice [
     char '^' >> typeDecl >>= return . PointerTo
--- a/tools/PascalUnitSyntaxTree.hs	Wed Jun 27 22:53:26 2012 +0400
+++ b/tools/PascalUnitSyntaxTree.hs	Thu Jun 28 00:30:50 2012 +0400
@@ -17,7 +17,7 @@
 data TypesAndVars = TypesAndVars [TypeVarDeclaration]
     deriving Show
 data TypeVarDeclaration = TypeDeclaration Identifier TypeDecl
-    | VarDeclaration Bool ([Identifier], TypeDecl) (Maybe InitExpression)
+    | VarDeclaration Bool Bool ([Identifier], TypeDecl) (Maybe InitExpression)
     | FunctionDeclaration Identifier TypeDecl [TypeVarDeclaration] (Maybe (TypesAndVars, Phrase))
     | OperatorDeclaration String Identifier TypeDecl [TypeVarDeclaration] (Maybe (TypesAndVars, Phrase))
     deriving Show
--- a/tools/pas2c.hs	Wed Jun 27 22:53:26 2012 +0400
+++ b/tools/pas2c.hs	Thu Jun 28 00:30:50 2012 +0400
@@ -324,7 +324,7 @@
     return . BTRecord "" . concat $ tvs
     where
         f :: TypeVarDeclaration -> State RenderState [(String, BaseType)]
-        f (VarDeclaration _ (ids, td) _) = mapM (\(Identifier i _) -> liftM ((,) i) $ resolveType td) ids
+        f (VarDeclaration _ _ (ids, td) _) = mapM (\(Identifier i _) -> liftM ((,) i) $ resolveType td) ids
 resolveType (ArrayDecl (Just i) t) = do
     t' <- resolveType t
     return $ BTArray i BTInt t'
@@ -366,9 +366,15 @@
 numberOfDeclarations :: [TypeVarDeclaration] -> Int
 numberOfDeclarations = sum . map cnt
     where
-        cnt (VarDeclaration _ (ids, _) _) = length ids
+        cnt (VarDeclaration _ _ (ids, _) _) = length ids
         cnt _ = 1
 
+hasPassByReference :: [TypeVarDeclaration] -> Bool
+hasPassByReference = or . map isVar
+    where
+        isVar (VarDeclaration v _ (_, _) _) = v
+        isVar _ = error $ "hasPassByReference called not on function parameters"
+
 fun2C :: Bool -> String -> TypeVarDeclaration -> State RenderState [Doc]
 fun2C _ _ (FunctionDeclaration name returnType params Nothing) = do
     t <- type2C returnType
@@ -419,7 +425,7 @@
     tp <- type2C t
     return [text "typedef" <+> tp i]
 
-tvar2C _ (VarDeclaration isConst (ids, t) mInitExpr) = do
+tvar2C _ (VarDeclaration _ isConst (ids, t) mInitExpr) = do
     t' <- liftM (((if isConst then text "const" else empty) <+>) . ) $ type2C t
     ie <- initExpr mInitExpr
     lt <- gets lastType
@@ -462,7 +468,7 @@
 extractTypes :: [TypeVarDeclaration] -> [TypeDecl]
 extractTypes = concatMap f
     where
-        f (VarDeclaration _ (ids, t) _) = replicate (length ids) t
+        f (VarDeclaration _ _ (ids, t) _) = replicate (length ids) t
         f a = error $ "extractTypes: can't extract from " ++ show a
 
 initExpr2C, initExpr2C' :: InitExpression -> State RenderState Doc