--- 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'