# HG changeset patch
# User unc0rr
# Date 1328469883 -14400
# Node ID a447993f2ad710e7baba55dda124cb9e6adb2d09
# Parent  2d8c5815292f1dd64efaba79b72c26815ba814e1
Further work on propagating types. Now it hopefully works fully, just need to annotate namespace with types first.

diff -r 2d8c5815292f -r a447993f2ad7 hedgewars/uLand.pas
--- a/hedgewars/uLand.pas	Sun Feb 05 15:55:15 2012 +0100
+++ b/hedgewars/uLand.pas	Sun Feb 05 23:24:43 2012 +0400
@@ -30,7 +30,7 @@
 
 implementation
 uses uConsole, uStore, uRandom, uLandObjects, uIO, uLandTexture, sysutils,
-     uVariables, uUtils, uCommands, Adler32, uDebug, uLandPainted, uTextures,
+     uVariables, uUtils, uCommands, adler32, uDebug, uLandPainted, uTextures,
      uLandGenMaze, uLandOutline;
 
 
diff -r 2d8c5815292f -r a447993f2ad7 tools/PascalParser.hs
--- a/tools/PascalParser.hs	Sun Feb 05 15:55:15 2012 +0100
+++ b/tools/PascalParser.hs	Sun Feb 05 23:24:43 2012 +0400
@@ -113,7 +113,7 @@
         comments
         e <- initExpression
         comments
-        return $ VarDeclaration False ([i], fromMaybe UnknownType t) (Just e)
+        return $ VarDeclaration False ([i], fromMaybe (DeriveType e) t) (Just e)
         
 typeDecl = choice [
     char '^' >> typeDecl >>= return . PointerTo
diff -r 2d8c5815292f -r a447993f2ad7 tools/PascalUnitSyntaxTree.hs
--- a/tools/PascalUnitSyntaxTree.hs	Sun Feb 05 15:55:15 2012 +0100
+++ b/tools/PascalUnitSyntaxTree.hs	Sun Feb 05 23:24:43 2012 +0400
@@ -1,7 +1,7 @@
 module PascalUnitSyntaxTree where
 
---import Data.Traversable
 import Data.Maybe
+import Data.Char
 
 data PascalUnit =
     Program Identifier Implementation Phrase
@@ -30,6 +30,7 @@
     | String Integer
     | Set TypeDecl
     | FunctionType TypeDecl [TypeVarDeclaration]
+    | DeriveType InitExpression 
     | UnknownType
     deriving Show
 data Range = Range Identifier
@@ -108,17 +109,19 @@
     deriving Show
     
 
+{--
 type2BaseType :: TypeDecl -> BaseType
-type2BaseType (SimpleType (Identifier s _)) = f s
+type2BaseType st@(SimpleType (Identifier s _)) = f (map toLower s)
     where
     f "longint" = BTInt
     f "integer" = BTInt
     f "word" = BTInt
     f "pointer" = BTPointerTo BTVoid
-    f _ = BTUnknown
+    f _ = error $ show st
 type2BaseType (Sequence ids) = BTEnum $ map (\(Identifier i _) -> i) ids
 type2BaseType (RecordType tv mtvs) = BTRecord $ concatMap f (concat $ tv : fromMaybe [] mtvs)
     where
     f (VarDeclaration _ (ids, td) _) = map (\(Identifier i _) -> (i, type2BaseType td)) ids
-type2BaseType _ = BTUnknown  
-    
\ No newline at end of file
+type2BaseType (PointerTo t) = BTPointerTo $ type2BaseType t
+type2BaseType a = error $ show a
+--}
diff -r 2d8c5815292f -r a447993f2ad7 tools/pas2c.hs
--- a/tools/pas2c.hs	Sun Feb 05 15:55:15 2012 +0100
+++ b/tools/pas2c.hs	Sun Feb 05 23:24:43 2012 +0400
@@ -75,9 +75,9 @@
     extractTVs (Unit _ (Interface _ (TypesAndVars tv)) _ _ _) = tv
     
     tv2id :: TypeVarDeclaration -> [Record]
-    tv2id (TypeDeclaration i t@(Sequence ids)) = map (\(Identifier i _) -> fi i (type2BaseType t)) $ i : ids
-    tv2id (TypeDeclaration (Identifier i _) t) = [(map toLower i, (i, type2BaseType t))]
-    tv2id (VarDeclaration _ (ids, t) _) = map (\(Identifier i _) -> fi i (type2BaseType t)) ids
+    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))
@@ -157,8 +157,35 @@
         return . text . fst . snd . fromJust $ v
 
 id2CTyped :: BaseType -> Identifier -> State RenderState Doc
-id2CTyped BTUnknown i = error $ show i
+id2CTyped BTUnknown i = do
+    ns <- gets currentScope
+    error $ show i ++ "\n" ++ show ns
 id2CTyped bt (Identifier i _) = id2C True (Identifier i bt)
+
+
+resolveType :: TypeDecl -> State RenderState BaseType
+resolveType st@(SimpleType (Identifier i _)) = do
+    let i' = map toLower i
+    v <- gets $ find (\(a, _) -> a == i') . currentScope
+    if isJust v then return . snd . snd $ fromJust v else return $ f i'
+    where
+    f "integer" = BTInt
+    f "pointer" = BTPointerTo BTVoid
+    f _ = error $ show st
+resolveType (PointerTo t) = liftM BTPointerTo $ resolveType t
+resolveType (RecordType tv mtvs) = do
+    tvs <- mapM f (concat $ tv : fromMaybe [] mtvs)
+    return . BTRecord . concat $ tvs
+    where
+        f :: TypeVarDeclaration -> State RenderState [(String, BaseType)]
+        f (VarDeclaration _ (ids, td) _) = mapM (\(Identifier i _) -> liftM ((,) i) $ 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 (DeriveType _) = return BTInt
+--resolveType UnknownType = return BTUnknown    
+resolveType a = error $ "resolveType: " ++ show a
+    
     
 tvar2C :: Bool -> TypeVarDeclaration -> State RenderState Doc
 tvar2C _ (FunctionDeclaration name returnType params Nothing) = do
@@ -188,12 +215,14 @@
 
 tvar2C _ td@(TypeDeclaration i' t) = do
     tp <- type2C t
-    i <- id2CTyped (type2BaseType t) i'
+    tb <- resolveType t
+    i <- id2CTyped tb i'
     return $ text "type" <+> i <+> tp <> text ";"
     
 tvar2C _ (VarDeclaration isConst (ids, t) mInitExpr) = do
     t' <- type2C t
-    i <- mapM (id2CTyped (type2BaseType t)) ids
+    tb <- resolveType t
+    i <- mapM (id2CTyped tb) ids
     ie <- initExpr mInitExpr
     return $ if isConst then text "const" else empty
         <+> t'
@@ -238,6 +267,7 @@
 type2C (ArrayDecl r t) = return $ text "<<array type>>"
 type2C (Set t) = return $ text "<<set>>"
 type2C (FunctionType returnType params) = return $ text "<<function>>"
+type2C (DeriveType _) = return $ text "<<type derived from constant literal>>"
 
 phrase2C :: Phrase -> State RenderState Doc
 phrase2C (Phrases p) = do