Fix a bug with type declaration trying to resolve type being declared
authorunc0rr
Tue, 07 Feb 2012 22:18:44 +0400
changeset 6649 7f78e8a6db69
parent 6648 025473a2c420
child 6650 56a0b7bf6c15
Fix a bug with type declaration trying to resolve type being declared
hedgewars/pas2cSystem.pas
tools/PascalUnitSyntaxTree.hs
tools/pas2c.hs
--- a/hedgewars/pas2cSystem.pas	Tue Feb 07 18:56:49 2012 +0100
+++ b/hedgewars/pas2cSystem.pas	Tue Feb 07 22:18:44 2012 +0400
@@ -14,9 +14,9 @@
     pointer = pointer;
     PChar = pointer;
 
+    float = float;
     double = float;
     real = float;
-    float = float;
 
     boolean = boolean;
     LongBool = boolean;
--- a/tools/PascalUnitSyntaxTree.hs	Tue Feb 07 18:56:49 2012 +0100
+++ b/tools/PascalUnitSyntaxTree.hs	Tue Feb 07 22:18:44 2012 +0400
@@ -100,6 +100,7 @@
     | BTString
     | BTInt
     | BTBool
+    | BTFloat
     | BTRecord [(String, BaseType)]
     | BTArray BaseType BaseType
     | BTFunction
@@ -108,21 +109,3 @@
     | BTEnum [String]
     | BTVoid
     deriving Show
-    
-
-{--
-type2BaseType :: TypeDecl -> BaseType
-type2BaseType st@(SimpleType (Identifier s _)) = f (map toLower s)
-    where
-    f "longint" = BTInt
-    f "integer" = BTInt
-    f "word" = BTInt
-    f "pointer" = BTPointerTo BTVoid
-    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 (PointerTo t) = BTPointerTo $ type2BaseType t
-type2BaseType a = error $ show a
---}
--- a/tools/pas2c.hs	Tue Feb 07 18:56:49 2012 +0100
+++ b/tools/pas2c.hs	Tue Feb 07 22:18:44 2012 +0400
@@ -78,7 +78,6 @@
 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
@@ -152,7 +151,7 @@
 id2CTyped :: BaseType -> Identifier -> State RenderState Doc
 id2CTyped BTUnknown i = do
     ns <- gets currentScope
-    error $ show i ++ "\n" ++ show ns
+    error $ "id2CTyped: type BTUnknown for " ++ show i ++ "\n" ++ show ns
 id2CTyped bt (Identifier i _) = id2C True (Identifier i bt)
 
 
@@ -165,6 +164,9 @@
     f "integer" = BTInt
     f "pointer" = BTPointerTo BTVoid
     f "boolean" = BTBool
+    f "float" = BTFloat
+    f "char" = BTChar
+    f "string" = BTString
     f _ = error $ "Unknown system type: " ++ show st
 resolveType (PointerTo t) = liftM BTPointerTo $ resolveType t
 resolveType (RecordType tv mtvs) = do
@@ -209,10 +211,9 @@
 tvar2C False (FunctionDeclaration (Identifier name _) _ _ _) = error $ "nested functions not allowed: " ++ name
 
 tvar2C _ td@(TypeDeclaration i' t) = do
+    tb <- resolveType t
+    i <- id2CTyped tb i'
     tp <- type2C t
-    tb <- resolveType t
-    error $ show (td, tb)
-    i <- id2CTyped tb i'
     return $ text "type" <+> i <+> tp <> text ";"
     
 tvar2C _ (VarDeclaration isConst (ids, t) mInitExpr) = do