# HG changeset patch
# User unc0rr
# Date 1332770175 -14400
# Node ID 8fadeefdd352263365a8d96e6dfab5a2406f2099
# Parent  aca4a6807ecc09195179bd1aebb1bbfad70379b2
Just some further work

diff -r aca4a6807ecc -r 8fadeefdd352 tools/PascalParser.hs
--- a/tools/PascalParser.hs	Mon Mar 26 03:58:03 2012 +0200
+++ b/tools/PascalParser.hs	Mon Mar 26 17:56:15 2012 +0400
@@ -189,7 +189,7 @@
             comments
             return ret
             else
-            return UnknownType
+            return VoidType
         optional $ try $ char ';' >> comments >> string "cdecl"
         comments
         return $ FunctionType ret vs
diff -r aca4a6807ecc -r 8fadeefdd352 tools/PascalUnitSyntaxTree.hs
--- a/tools/PascalUnitSyntaxTree.hs	Mon Mar 26 03:58:03 2012 +0200
+++ b/tools/PascalUnitSyntaxTree.hs	Mon Mar 26 17:56:15 2012 +0400
@@ -31,6 +31,7 @@
     | Set TypeDecl
     | FunctionType TypeDecl [TypeVarDeclaration]
     | DeriveType InitExpression 
+    | VoidType
     | UnknownType
     deriving Show
 data Range = Range Identifier
@@ -101,9 +102,9 @@
     | BTInt
     | BTBool
     | BTFloat
-    | BTRecord [(String, BaseType)]
+    | BTRecord
     | BTArray BaseType BaseType
-    | BTFunction
+    | BTFunction BaseType
     | BTPointerTo BaseType
     | BTSet BaseType
     | BTEnum [String]
diff -r aca4a6807ecc -r 8fadeefdd352 tools/pas2c.hs
--- a/tools/pas2c.hs	Mon Mar 26 03:58:03 2012 +0200
+++ b/tools/pas2c.hs	Mon Mar 26 17:56:15 2012 +0400
@@ -86,6 +86,7 @@
     li <- gets lastIdentifier
     nss <- gets namespaces
     st <- gets id
+    error $ show $ Map.keys nss
     return $ evalState f st{currentScope = fromMaybe [] $ Map.lookup li (namespaces st)}
 
 toCFiles :: Map.Map String [Record] -> (String, PascalUnit) -> IO ()
@@ -178,7 +179,7 @@
     case tb of 
         BTUnknown -> do
             ns <- gets currentScope
-            error $ "id2CTyped: type BTUnknown for " ++ show i ++ "\ntype: " ++ show t ++ "\nnamespace: " ++ show ns
+            error $ "id2CTyped: type BTUnknown for " ++ show i ++ "\ntype: " ++ show t ++ "\nnamespace: " -- ++ show ns
         _ -> id2C IOInsert (Identifier i tb)
 
 
@@ -197,16 +198,19 @@
     f _ = error $ "Unknown system type: " ++ show st
 resolveType (PointerTo t) = return $ BTPointerTo BTUnknown  -- can't resolveType for t here
 resolveType (RecordType tv mtvs) = do
-    tvs <- mapM f (concat $ tv : fromMaybe [] mtvs)
-    return . BTRecord . concat $ tvs
+    li <- gets lastIdentifier
+    tvs <- liftM concat $ mapM f (concat $ tv : fromMaybe [] mtvs)
+    modify (\s -> s{namespaces = Map.insert li tvs (namespaces s)})
+    return BTRecord
     where
-        f :: TypeVarDeclaration -> State RenderState [(String, BaseType)]
-        f (VarDeclaration _ (ids, td) _) = mapM (\(Identifier i _) -> liftM ((,) i) $ resolveType td) ids
+        f :: TypeVarDeclaration -> State RenderState [Record]
+        f (VarDeclaration _ (ids, td) _) = mapM (\(Identifier i _) -> liftM (\t -> (map toLower i, (i, t))) $ resolveType td) ids
 resolveType (ArrayDecl (Just _) t) = liftM (BTArray BTInt) $ resolveType t
 resolveType (ArrayDecl Nothing t) = liftM (BTArray BTInt) $ resolveType t
-resolveType (FunctionType _ _) = return BTFunction
+resolveType (FunctionType t _) = liftM BTFunction $ resolveType t
 resolveType (DeriveType _) = return BTInt
 resolveType (String _) = return BTString
+resolveType VoidType = return BTVoid
 resolveType (Sequence ids) = return $ BTEnum $ map (\(Identifier i _) -> map toLower i) ids
 resolveType (RangeType _) = return $ BTInt
 resolveType (Set t) = liftM BTSet $ resolveType t
@@ -394,17 +398,22 @@
     r1 <- ref2C ref1
     t <- gets lastType
     r2 <- case t of
-        r@(BTRecord _) -> error $ show r
-        r@(BTUnit) -> withLastIdNamespace $ ref2C ref2
+        BTRecord -> withLastIdNamespace $ ref2C ref2
+        BTUnit -> withLastIdNamespace $ ref2C ref2
         a -> error $ "dereferencing from " ++ show a ++ " - " ++ show rf
     return $ 
         r1 <> text "." <> r2
 ref2C (Dereference ref) = liftM ((parens $ text "*") <>) $ ref2C ref
 ref2C (FunCall params ref) = do
+    ps <- liftM (parens . hsep . punctuate (char ',')) $ mapM expr2C params
     r <- ref2C ref
-    ps <- mapM expr2C params
-    return $ 
-        r <> parens (hsep . punctuate (char ',') $ ps)
+    t <- gets lastType
+    case t of
+        BTFunction t -> do
+            modify (\s -> s{lastType = t})
+            return $ r <> ps
+        _ -> return $ parens r <> ps
+        
 ref2C (Address ref) = do
     r <- ref2C ref
     return $ text "&" <> parens r