Move a bit further
authorunc0rr
Wed, 08 Feb 2012 15:49:55 +0400
changeset 6653 d45b6dbd2ad6
parent 6652 b043665dea3d
child 6654 120e95c10532
child 6655 1edd500b2471
Move a bit further
hedgewars/pas2cSystem.pas
tools/PascalUnitSyntaxTree.hs
tools/pas2c.hs
--- a/hedgewars/pas2cSystem.pas	Tue Feb 07 22:39:36 2012 -0500
+++ b/hedgewars/pas2cSystem.pas	Wed Feb 08 15:49:55 2012 +0400
@@ -10,6 +10,9 @@
     Byte = integer;
     SmallInt = integer;
     ShortInt = integer;
+    QWord = integer;
+    GLInt = integer;
+    GLUInt = integer;
 
     pointer = pointer;
     PChar = pointer;
@@ -17,6 +20,8 @@
     float = float;
     double = float;
     real = float;
+    extended = float;
+    GLFloat = float;
 
     boolean = boolean;
     LongBool = boolean;
--- a/tools/PascalUnitSyntaxTree.hs	Tue Feb 07 22:39:36 2012 -0500
+++ b/tools/PascalUnitSyntaxTree.hs	Wed Feb 08 15:49:55 2012 +0400
@@ -105,7 +105,7 @@
     | BTArray BaseType BaseType
     | BTFunction
     | BTPointerTo BaseType
-    | BTSet
+    | BTSet BaseType
     | BTEnum [String]
     | BTVoid
     deriving Show
--- a/tools/pas2c.hs	Tue Feb 07 22:39:36 2012 -0500
+++ b/tools/pas2c.hs	Wed Feb 08 15:49:55 2012 +0400
@@ -148,11 +148,14 @@
         else 
         return . text . fst . snd . fromJust $ v
 
-id2CTyped :: BaseType -> Identifier -> State RenderState Doc
-id2CTyped BTUnknown i = do
+id2CTyped :: TypeDecl -> Identifier -> State RenderState Doc
+id2CTyped t (Identifier i _) = do
+    tb <- resolveType t
+    id2C True (Identifier i tb)
+{--id2CTyped BTUnknown i = do
     ns <- gets currentScope
     error $ "id2CTyped: type BTUnknown for " ++ show i ++ "\n" ++ show ns
-id2CTyped bt (Identifier i _) = id2C True (Identifier i bt)
+id2CTyped bt (Identifier i _) = id2C True (Identifier i bt)--}
 
 
 resolveType :: TypeDecl -> State RenderState BaseType
@@ -168,7 +171,7 @@
     f "char" = BTChar
     f "string" = BTString
     f _ = error $ "Unknown system type: " ++ show st
-resolveType (PointerTo t) = liftM BTPointerTo $ resolveType t
+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
@@ -180,6 +183,9 @@
 resolveType (FunctionType _ _) = return BTFunction
 resolveType (DeriveType _) = return BTInt
 resolveType (String _) = return BTString
+resolveType (Sequence ids) = return $ BTEnum $ map (\(Identifier i _) -> map toLower i) ids
+resolveType (RangeType _) = return $ BTInt
+resolveType (Set t) = liftM BTSet $ resolveType t
 --resolveType UnknownType = return BTUnknown    
 resolveType a = error $ "resolveType: " ++ show a
     
@@ -211,15 +217,13 @@
 tvar2C False (FunctionDeclaration (Identifier name _) _ _ _) = error $ "nested functions not allowed: " ++ name
 
 tvar2C _ td@(TypeDeclaration i' t) = do
-    tb <- resolveType t
-    i <- id2CTyped tb i'
+    i <- id2CTyped t i'
     tp <- type2C t
     return $ text "type" <+> i <+> tp <> text ";"
     
 tvar2C _ (VarDeclaration isConst (ids, t) mInitExpr) = do
     t' <- type2C t
-    tb <- resolveType t
-    i <- mapM (id2CTyped tb) ids
+    i <- mapM (id2CTyped t) ids
     ie <- initExpr mInitExpr
     return $ if isConst then text "const" else empty
         <+> t'