Finish the toughest part of the converter. Now it knows types of everything, so could correctly recognize bitwise operators and type convertions.
authorunc0rr
Wed, 04 Apr 2012 18:00:46 +0400
changeset 6855 807156c01475
parent 6854 873929cbd54b
child 6856 a5b0afb60862
Finish the toughest part of the converter. Now it knows types of everything, so could correctly recognize bitwise operators and type convertions.
hedgewars/pas2cSystem.pas
tools/pas2c.hs
--- a/hedgewars/pas2cSystem.pas	Wed Apr 04 15:05:14 2012 +0400
+++ b/hedgewars/pas2cSystem.pas	Wed Apr 04 18:00:46 2012 +0400
@@ -14,6 +14,7 @@
     GLInt = integer;
     GLUInt = integer;
     gl_unsigned_byte = integer;
+    Int = integer;
 
     pointer = pointer;
     PChar = pointer;
@@ -46,7 +47,9 @@
 
 var 
     false, true: boolean;
+    
     write, writeLn, read, readLn: procedure;
+    
     StrLen, ord, Succ, Pred : function : integer;
     inc, dec, Low, High, Lo, Hi : function : integer;
     odd, even : function : boolean;
@@ -60,19 +63,21 @@
     trunc, round : function : integer;
     Abs, Sqr : function : integer;
 
-    StrPas, FormatDateTime, copy, delete, str, pos : function : shortstring;
+    StrPas, FormatDateTime, copy, delete, str, pos, trim : function : shortstring;
 
-    assign, rewrite, reset, flush, BlockWrite, close : procedure;
+    assign, rewrite, reset, flush, BlockWrite, BlockRead, close : procedure;
     IOResult : function : integer;
     exit, break, halt, continue : procedure;
     TextFile, file : Handle;
     FileMode : integer;
-    eof : function : boolean;
+    FileExists, DirectoryExists, eof : function : boolean;
+    ExtractFileName : function : string;
+    exitcode : integer;
     
     ParamCount : function : integer;
     ParamStr : function : string;
 
-    Sqrt, ArcTan2, pi, cos, sin : function : float;
+    sqrt, arctan2, pi, cos, sin, power : function : float;
 
     TypeInfo, GetEnumName : function : shortstring;
 
@@ -91,13 +96,30 @@
     glcolor4ub, gl_texture_wrap_s, gltexparameteri,
     gl_texture_wrap_t, gl_texture_min_filter,
     gl_linear, gl_texture_mag_filter, glgentextures,
-    gldeletetextures, glreadpixels : procedure;
+    gldeletetextures, glreadpixels, glclearcolor,
+    gl_line_strip, gldeleterenderbuffersext,
+    gldeleteframebuffersext, glext_loadextension,
+    gl_max_texture_size, glgetintegerv, gl_renderer,
+    glgetstring, gl_vendor, gl_version, glgenframebuffersext,
+    glbindframebufferext, glgenrenderbuffersext,
+    glbindrenderbufferext, glrenderbufferstorageext,
+    glframebufferrenderbufferext, glframebuffertexture2dext,
+    gl_framebuffer_ext, gl_depth_component, 
+    gl_depth_attachment_ext, gl_renderbuffer_ext, gl_rgba8,
+    gl_color_attachment0_ext, gl_modelview, gl_blend,
+    gl_src_alpha, gl_one_minus_src_alpha,  
+    gl_perspective_correction_hint, gl_fastest,
+    gl_dither, gl_vertex_array, gl_texture_coord_array,
+    glviewport, glloadidentity, glmatrixmode, glhint,
+    glblendfunc, glenableclientstate, gl_color_buffer_bit,
+    glclear : procedure;
 
     TThreadId : function : integer;
     BeginThread, ThreadSwitch : procedure;
     InterlockedIncrement, InterlockedDecrement : procedure;
     
     random : function : integer;
+    randomize : procedure;
     
     Assigned : function : boolean;
     
--- a/tools/pas2c.hs	Wed Apr 04 15:05:14 2012 +0400
+++ b/tools/pas2c.hs	Wed Apr 04 18:00:46 2012 +0400
@@ -251,32 +251,33 @@
 resolveType (Set t) = liftM BTSet $ resolveType t
    
 
-fromPointer :: BaseType -> State RenderState BaseType    
-fromPointer (BTPointerTo t) = f t
+fromPointer :: String -> BaseType -> State RenderState BaseType    
+fromPointer s (BTPointerTo t) = f t
     where
         f (BTUnresolved s) = do
             v <- gets $ find (\(a, _) -> a == s) . currentScope
             if isJust v then
                 f . snd . snd . fromJust $ v
                 else
-                error $ "Unknown type " ++ show t
+                error $ "Unknown type " ++ show t ++ "\n" ++ s
         f t = return t
-fromPointer t = do
+fromPointer s t = do
     ns <- gets currentScope
-    error $ "Dereferencing from non-pointer type " ++ show t ++ "\n\n" ++ show (take 100 ns)
+    error $ "Dereferencing from non-pointer type " ++ show t ++ "\n" ++ s ++ "\n\n" ++ show (take 100 ns)
 
 
 tvar2C :: Bool -> TypeVarDeclaration -> State RenderState Doc
 tvar2C _ (FunctionDeclaration name returnType params Nothing) = do
     t <- type2C returnType 
+    t'<- gets lastType
     p <- withState' id $ liftM hcat $ mapM (tvar2C False) params
-    n <- id2C IOInsert name
+    n <- id2C IOInsert $ setBaseType (BTFunction t') name
     return $ t <+> n <> parens p <> text ";"
     
-tvar2C True (FunctionDeclaration (Identifier i _) returnType params (Just (tvars, phrase))) = do
+tvar2C True (FunctionDeclaration name returnType params (Just (tvars, phrase))) = do
     t <- type2C returnType
     t'<- gets lastType
-    n <- id2C IOInsert (Identifier i (BTFunction t'))
+    n <- id2C IOInsert $ setBaseType (BTFunction t') name
     (p, ph) <- withState' (\st -> st{currentScope = (lastIdentifier st, (lastIdentifier st ++ "_result", t')) : currentScope st}) $ do
         p <- liftM hcat $ mapM (tvar2C False) params
         ph <- liftM2 ($+$) (typesAndVars2C False tvars) (phrase2C' phrase)
@@ -455,6 +456,7 @@
 ref2C r@(RecordField ref1 (ArrayElement exprs ref2)) = ref2C $ ArrayElement exprs (RecordField ref1 ref2)
 ref2C r@(RecordField ref1 (Dereference ref2)) = ref2C $ Dereference (RecordField ref1 ref2)
 ref2C r@(RecordField ref1 (RecordField ref2 ref3)) = ref2C $ RecordField (RecordField ref1 ref2) ref3
+ref2C r@(RecordField ref1 (FunCall params ref2)) = ref2C $ FunCall params (RecordField ref1 ref2)
 -- conversion routines
 ref2C ae@(ArrayElement exprs ref) = do
     es <- mapM expr2C exprs
@@ -473,7 +475,7 @@
 ref2C (SimpleReference name) = id2C IOLookup name
 ref2C rf@(RecordField (Dereference ref1) ref2) = do
     r1 <- ref2C ref1 
-    t <- fromPointer =<< gets lastType
+    t <- fromPointer (show ref1) =<< gets lastType
     ns <- gets currentScope
     r2 <- case t of
         BTRecord rs -> withRecordNamespace rs $ ref2C ref2
@@ -491,9 +493,9 @@
         a -> error $ "dereferencing from " ++ show a ++ "\n" ++ show rf ++ "\n" ++ show (take 100 ns)
     return $ 
         r1 <> text "." <> r2
-ref2C (Dereference ref) = do
+ref2C d@(Dereference ref) = do
     r <- ref2C ref
-    t <- fromPointer =<< gets lastType
+    t <- fromPointer (show d) =<< gets lastType
     modify (\st -> st{lastType = t})
     return $ (parens $ text "*") <> r
 ref2C (FunCall params ref) = do