Better deriving, some fixes
authorunc0rr
Thu, 29 Mar 2012 01:01:29 +0400
changeset 6835 00b2fd32305d
parent 6834 2af81d3b176d
child 6836 42382794b73f
Better deriving, some fixes
hedgewars/pas2cSystem.pas
tools/pas2c.hs
--- a/hedgewars/pas2cSystem.pas	Wed Mar 28 23:53:45 2012 +0400
+++ b/hedgewars/pas2cSystem.pas	Thu Mar 29 01:01:29 2012 +0400
@@ -46,5 +46,5 @@
     Low, High : function : integer;
     Now : function : integer;
     Length : function : integer;
-    StrPas, FormatDateTime : function : shortstring;
+    StrPas, FormatDateTime, copy, delete : function : shortstring;
     exit : procedure;
--- a/tools/pas2c.hs	Wed Mar 28 23:53:45 2012 +0400
+++ b/tools/pas2c.hs	Thu Mar 29 01:01:29 2012 +0400
@@ -185,10 +185,11 @@
 id2CTyped :: TypeDecl -> Identifier -> State RenderState Doc
 id2CTyped t (Identifier i _) = do
     tb <- resolveType t
+    ns <- gets currentScope
     case tb of 
         BTUnknown -> do
             ns <- gets currentScope
-            error $ "id2CTyped: type BTUnknown for " ++ show i ++ "\ntype: " ++ show t ++ "\nnamespace: " -- ++ show ns
+            error $ "id2CTyped: type BTUnknown for " ++ show i ++ "\ntype: " ++ show t ++ "\nnamespace: " ++ show (take 100 ns)
         _ -> id2C IOInsert (Identifier i tb)
 
 
@@ -216,11 +217,19 @@
 resolveType (ArrayDecl (Just _) t) = liftM (BTArray BTInt) $ resolveType t
 resolveType (ArrayDecl Nothing t) = liftM (BTArray BTInt) $ resolveType t
 resolveType (FunctionType t _) = liftM BTFunction $ resolveType t
-resolveType (DeriveType _) = return BTInt
+resolveType (DeriveType (InitHexNumber _)) = return BTInt
+resolveType (DeriveType (InitNumber _)) = return BTInt
+resolveType (DeriveType (InitFloat _)) = return BTFloat
+resolveType (DeriveType (InitString _)) = return BTString
+resolveType (DeriveType (InitBinOp {})) = return BTInt
+resolveType (DeriveType (InitPrefixOp {})) = return BTInt
+resolveType (DeriveType (BuiltInFunction{})) = return BTInt
+resolveType (DeriveType (InitReference (Identifier{}))) = return BTBool -- TODO: derive from actual type
+resolveType (DeriveType _) = return BTUnknown
 resolveType (String _) = return BTString
 resolveType VoidType = return BTVoid
 resolveType (Sequence ids) = return $ BTEnum $ map (\(Identifier i _) -> map toLower i) ids
-resolveType (RangeType _) = return $ BTInt
+resolveType (RangeType _) = return $ BTUnknown
 resolveType (Set t) = liftM BTSet $ resolveType t
 --resolveType UnknownType = return BTUnknown    
 resolveType a = error $ "resolveType: " ++ show a
@@ -408,12 +417,12 @@
 
 ref2C :: Reference -> State RenderState Doc
 ref2C ae@(ArrayElement exprs ref) = do
+    es <- mapM expr2C exprs
     r <- ref2C ref 
     t <- gets lastType
     case t of
          (BTArray _ t') -> modify (\st -> st{lastType = t'})
          a -> error $ show a ++ "\n" ++ show ae
-    es <- mapM expr2C exprs
     return $ r <> (brackets . hcat) (punctuate comma es)
 ref2C (SimpleReference name) = id2C IOLookup name
 ref2C (RecordField (Dereference ref1) ref2) = do
@@ -424,10 +433,11 @@
 ref2C rf@(RecordField ref1 ref2) = do
     r1 <- ref2C ref1
     t <- gets lastType
+    ns <- gets currentScope
     r2 <- case t of
         BTRecord rs -> withRecordNamespace rs $ ref2C ref2
         BTUnit -> withLastIdNamespace $ ref2C ref2
-        a -> error $ "dereferencing from " ++ show a ++ " - " ++ show rf
+        a -> error $ "dereferencing from " ++ show a ++ "\n" ++ show rf ++ "\n" ++ show (take 100 ns)
     return $ 
         r1 <> text "." <> r2
 ref2C (Dereference ref) = do