# HG changeset patch
# User unc0rr
# Date 1333368869 -14400
# Node ID 59da15acb2f23a7b53844535dc22c9f7c565bc05
# Parent  3633928a31884aefb752e760eced78c7bb5393e1
Finally fix the bug with pointer declarations polluting namespace with bad records

diff -r 3633928a3188 -r 59da15acb2f2 hedgewars/pas2cSystem.pas
--- a/hedgewars/pas2cSystem.pas	Mon Apr 02 00:32:17 2012 +0200
+++ b/hedgewars/pas2cSystem.pas	Mon Apr 02 16:14:29 2012 +0400
@@ -60,12 +60,12 @@
     trunc, round : function : integer;
     Abs, Sqr : function : integer;
 
-    StrPas, FormatDateTime, copy, delete, str : function : shortstring;
+    StrPas, FormatDateTime, copy, delete, str, pos : function : shortstring;
 
-    assign, rewrite, reset, flush : procedure;
+    assign, rewrite, reset, flush, BlockWrite, close : procedure;
     IOResult : function : integer;
     exit, break, halt : procedure;
-    TextFile : Handle;
+    TextFile, file : Handle;
 
     Sqrt, ArcTan2, pi, cos, sin : function : float;
 
@@ -86,6 +86,6 @@
     glcolor4ub, gl_texture_wrap_s, gltexparameteri,
     gl_texture_wrap_t, gl_texture_min_filter,
     gl_linear, gl_texture_mag_filter, glgentextures,
-    gldeletetextures : procedure;
+    gldeletetextures, glreadpixels : procedure;
 
     TThreadId : function : integer;
diff -r 3633928a3188 -r 59da15acb2f2 hedgewars/uMisc.pas
--- a/hedgewars/uMisc.pas	Mon Apr 02 00:32:17 2012 +0200
+++ b/hedgewars/uMisc.pas	Mon Apr 02 16:14:29 2012 +0400
@@ -170,7 +170,7 @@
 end;
 
 procedure initModule;
-const SDL_PIXELFORMAT_ABGR8888 = ((1 shl 31) or (6 shl 24) or (7 shl 20) or (6 shl 16) or (32 shl 8) or 4);
+const SDL_PIXELFORMAT_ABGR8888 = (1 shl 31) or (6 shl 24) or (7 shl 20) or (6 shl 16) or (32 shl 8) or 4;
 begin
     conversionFormat:= SDL_AllocFormat(SDL_PIXELFORMAT_ABGR8888);
 end;
diff -r 3633928a3188 -r 59da15acb2f2 tools/PascalUnitSyntaxTree.hs
--- a/tools/PascalUnitSyntaxTree.hs	Mon Apr 02 00:32:17 2012 +0200
+++ b/tools/PascalUnitSyntaxTree.hs	Mon Apr 02 16:14:29 2012 +0400
@@ -32,7 +32,6 @@
     | FunctionType TypeDecl [TypeVarDeclaration]
     | DeriveType InitExpression 
     | VoidType
-    | UnknownType
     deriving Show
 data Range = Range Identifier
            | RangeFromTo InitExpression InitExpression
diff -r 3633928a3188 -r 59da15acb2f2 tools/pas2c.hs
--- a/tools/pas2c.hs	Mon Apr 02 00:32:17 2012 +0200
+++ b/tools/pas2c.hs	Mon Apr 02 16:14:29 2012 +0400
@@ -76,6 +76,8 @@
 renderCFiles units = do
     let u = Map.toList units
     let nss = Map.map (toNamespace nss) units
+    hPutStrLn stderr $ "Units: " ++ (show . Map.keys . Map.filter (not . null) $ nss)
+    writeFile "pas2c.log" $ unlines . map (\t -> show (fst t) ++ "\n" ++ (unlines . map ((:) '\t' . show) . snd $ t)) . Map.toList $ nss
     mapM_ (toCFiles nss) u
     where
     toNamespace :: Map.Map String [Record] -> PascalUnit -> [Record]
@@ -158,7 +160,7 @@
     where
     injectNamespace (Identifier i _) = do
         getNS <- gets (flip Map.lookup . namespaces)
-        let f = flip (foldl (\a b -> b:a)) (fromMaybe [] (getNS i))
+        let f = flip (foldl (flip (:))) (fromMaybe [] (getNS i))
         modify (\s -> s{currentScope = f $ currentScope s})
 
 uses2List :: Uses -> [String]
@@ -167,6 +169,12 @@
 
 id2C :: InsertOption -> Identifier -> State RenderState Doc
 id2C IOInsert (Identifier i t) = do
+    ns <- gets currentScope
+{--    case t of 
+        BTUnknown -> do
+            ns <- gets currentScope
+            error $ "id2C IOInsert: type BTUnknown for " ++ show i ++ "\nnamespace: " ++ show (take 100 ns)
+        _ -> do --}
     modify (\s -> s{currentScope = (n, (i, t)) : currentScope s, lastIdentifier = n})
     return $ text i
     where
@@ -176,15 +184,13 @@
     v <- gets $ find (\(a, _) -> a == i') . currentScope
     ns <- gets currentScope
     if isNothing v then 
-        error $ "Not defined: '" ++ i' ++ "'\n" -- ++ show ns
+        error $ "Not defined: '" ++ i' ++ "'\n" ++ show (take 100 ns)
         else 
         let vv = snd $ fromJust v in modify (\s -> s{lastType = snd vv, lastIdentifier = fst vv}) >> (return . text . fst $ vv)
 id2C IODeferred (Identifier i t) = do
     let i' = map toLower i
     v <- gets $ find (\(a, _) -> a == i') . currentScope
     if (isNothing v) then
-        do
-        modify (\s -> s{currentScope = (i', (i, t)) : currentScope s})
         return $ text i
         else
         return . text . fst . snd . fromJust $ v
@@ -197,7 +203,8 @@
         BTUnknown -> do
             ns <- gets currentScope
             error $ "id2CTyped: type BTUnknown for " ++ show i ++ "\ntype: " ++ show t ++ "\nnamespace: " ++ show (take 100 ns)
-        _ -> id2C IOInsert (Identifier i tb)
+        _ -> return ()
+    id2C IOInsert (Identifier i tb)
 
 
 resolveType :: TypeDecl -> State RenderState BaseType
@@ -236,11 +243,9 @@
 resolveType (String _) = return BTString
 resolveType VoidType = return BTVoid
 resolveType (Sequence ids) = return $ BTEnum $ map (\(Identifier i _) -> map toLower i) ids
-resolveType (RangeType _) = return $ BTUnknown
+resolveType (RangeType _) = return $ BTVoid
 resolveType (Set t) = liftM BTSet $ resolveType t
---resolveType UnknownType = return BTUnknown    
-resolveType a = error $ "resolveType: " ++ show a
-    
+   
 
 fromPointer :: BaseType -> State RenderState BaseType    
 fromPointer (BTPointerTo t) = f t
@@ -252,7 +257,9 @@
                 else
                 error $ "Unknown type " ++ show t
         f t = return t
-fromPointer t = error $ "Dereferencing from non-pointer type " ++ show t
+fromPointer t = do
+    ns <- gets currentScope
+    error $ "Dereferencing from non-pointer type " ++ show t ++ "\n\n" ++ show (take 100 ns)
 
 
 tvar2C :: Bool -> TypeVarDeclaration -> State RenderState Doc
@@ -337,7 +344,7 @@
     type2C' (PointerTo (SimpleType i)) = liftM (<> text "*") $ id2C IODeferred i
     type2C' (PointerTo t) = liftM (<> text "*") $ type2C t
     type2C' (RecordType tvs union) = do
-        t <- mapM (tvar2C False) tvs
+        t <- withState' id $ mapM (tvar2C False) tvs
         return $ text "{" $+$ (nest 4 . vcat $ t) $+$ text "}"
     type2C' (RangeType r) = return $ text "<<range type>>"
     type2C' (Sequence ids) = do
@@ -389,7 +396,8 @@
             text "case" <+> parens (hsep . punctuate (char ',') $ ie) <> char ':' <> nest 4 (ph $+$ text "break;")
 phrase2C (WithBlock ref p) = do
     r <- ref2C ref 
-    ph <- phrase2C $ wrapPhrase p
+    (BTRecord rs) <- gets lastType
+    ph <- withRecordNamespace rs $ phrase2C $ wrapPhrase p
     return $ text "namespace" <> parens r $$ ph
 phrase2C (ForCycle i' e1' e2' p) = do
     i <- id2C IOLookup i'
@@ -446,9 +454,14 @@
          a -> error $ "Getting element of " ++ show a ++ "\nReference: " ++ show ae ++ "\n" ++ show (take 100 ns)
     return $ r <> (brackets . hcat) (punctuate comma es)
 ref2C (SimpleReference name) = id2C IOLookup name
-ref2C (RecordField (Dereference ref1) ref2) = do
+ref2C rf@(RecordField (Dereference ref1) ref2) = do
     r1 <- ref2C ref1 
-    r2 <- ref2C ref2
+    t <- fromPointer =<< gets lastType
+    ns <- gets currentScope
+    r2 <- case t of
+        BTRecord rs -> withRecordNamespace rs $ ref2C ref2
+        BTUnit -> withLastIdNamespace $ ref2C ref2
+        a -> error $ "dereferencing from " ++ show a ++ "\n" ++ show rf ++ "\n" ++ show (take 100 ns)
     return $ 
         r1 <> text "->" <> r2
 ref2C rf@(RecordField ref1 ref2) = do