# HG changeset patch
# User unc0rr
# Date 1328555865 -14400
# Node ID c2fa29fe2a58ba399ee3bf593a8be57f04358779
# Parent  2dc43ce68721fffb8f4d5318df6dfdfd5fd131b8
Some progress, still can't find the source of bad behavior

diff -r 2dc43ce68721 -r c2fa29fe2a58 hedgewars/pas2cSystem.pas
--- a/hedgewars/pas2cSystem.pas	Sun Feb 05 22:22:46 2012 -0500
+++ b/hedgewars/pas2cSystem.pas	Mon Feb 06 23:17:45 2012 +0400
@@ -1,12 +1,12 @@
 system;
 
 type 
+    Integer = integer;
     LongInt = integer;
     LongWord = integer;
     Cardinal = integer;
     PtrInt = integer;
     Word = integer;
-    Integer = integer;
     Byte = integer;
     SmallInt = integer;
     ShortInt = integer;
diff -r 2dc43ce68721 -r c2fa29fe2a58 tools/PascalUnitSyntaxTree.hs
--- a/tools/PascalUnitSyntaxTree.hs	Sun Feb 05 22:22:46 2012 -0500
+++ b/tools/PascalUnitSyntaxTree.hs	Mon Feb 06 23:17:45 2012 +0400
@@ -99,6 +99,7 @@
     | BTChar
     | BTString
     | BTInt
+    | BTBool
     | BTRecord [(String, BaseType)]
     | BTArray BaseType BaseType
     | BTFunction
diff -r 2dc43ce68721 -r c2fa29fe2a58 tools/pas2c.hs
--- a/tools/pas2c.hs	Sun Feb 05 22:22:46 2012 -0500
+++ b/tools/pas2c.hs	Mon Feb 06 23:17:45 2012 +0400
@@ -64,28 +64,21 @@
 renderCFiles :: Map.Map String PascalUnit -> IO ()
 renderCFiles units = do
     let u = Map.toList units
-    let ns = Map.map toNamespace units
-    mapM_ (toCFiles ns) u
+    let nss = Map.map (toNamespace nss) units
+    mapM_ (toCFiles nss) u
     where
-    toNamespace :: PascalUnit -> [Record]
-    toNamespace = concatMap tv2id . extractTVs
-    
-    extractTVs (System tv) = tv
-    extractTVs (Program {}) = []
-    extractTVs (Unit _ (Interface _ (TypesAndVars tv)) _ _ _) = tv
-    
-    tv2id :: TypeVarDeclaration -> [Record]
-    tv2id (TypeDeclaration i t@(Sequence ids)) = map (\(Identifier i _) -> fi i BTUnknown) $ i : ids
-    tv2id (TypeDeclaration (Identifier i _) t) = [(map toLower i, (i, BTUnknown))]
-    tv2id (VarDeclaration _ (ids, t) _) = map (\(Identifier i _) -> fi i BTUnknown) ids
-    tv2id (FunctionDeclaration (Identifier i _) _ _ _) = [fi i BTUnknown]
-    tv2id (OperatorDeclaration i _ _ _ _) = [fi i BTUnknown]
-    fi i t = (map toLower i, (i, t))
-    
+    toNamespace :: Map.Map String [Record] -> PascalUnit -> [Record]
+    toNamespace nss (System tvs) = 
+        currentScope $ execState (mapM_ (tvar2C True) tvs) (RenderState [] BTUnknown nss)
+    toNamespace _ (Program {}) = []
+    toNamespace nss (Unit _ interface _ _ _) = 
+        currentScope $ execState (interface2C interface) (RenderState [] BTUnknown nss)
+
    
 toCFiles :: Map.Map String [Record] -> (String, PascalUnit) -> IO ()
 toCFiles _ (_, System _) = return ()
 toCFiles ns p@(fn, pu) = do
+    hPutStrLn stdout $ show $ Map.lookup "pas2cSystem" ns
     hPutStrLn stderr $ "Rendering '" ++ fn ++ "'..."
     toCFiles' p
     where
@@ -149,10 +142,10 @@
 id2C False (Identifier i t) = do
     let i' = map toLower i
     v <- gets $ find (\(a, _) -> a == i') . currentScope
-    --ns <- gets currentScope
+    ns <- gets currentScope
     modify (\s -> s{lastType = t})
     if isNothing v then 
-        error $ "Not defined: '" ++ i' ++ "'"-- ++ show ns
+        error $ "Not defined: '" ++ i' ++ "'\n" ++ show ns
         else 
         return . text . fst . snd . fromJust $ v
 
@@ -171,7 +164,8 @@
     where
     f "integer" = BTInt
     f "pointer" = BTPointerTo BTVoid
-    f _ = error $ show st
+    f "boolean" = BTBool
+    f _ = error $ "Unknown system type: " ++ show st
 resolveType (PointerTo t) = liftM BTPointerTo $ resolveType t
 resolveType (RecordType tv mtvs) = do
     tvs <- mapM f (concat $ tv : fromMaybe [] mtvs)
@@ -183,6 +177,7 @@
 resolveType (ArrayDecl Nothing t) = liftM (BTArray BTInt) $ resolveType t
 resolveType (FunctionType _ _) = return BTFunction
 resolveType (DeriveType _) = return BTInt
+resolveType (String _) = return BTString
 --resolveType UnknownType = return BTUnknown    
 resolveType a = error $ "resolveType: " ++ show a
     
@@ -216,6 +211,7 @@
 tvar2C _ td@(TypeDeclaration i' t) = do
     tp <- type2C t
     tb <- resolveType t
+    error $ show (td, tb)
     i <- id2CTyped tb i'
     return $ text "type" <+> i <+> tp <> text ";"