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