Merge
authorMedo <smaxein@googlemail.com>
Sun, 01 Apr 2012 04:37:55 +0200
changeset 6846 bf4c2771caf0
parent 6844 69fb04c8a841 (current diff)
parent 6838 b1a0e7a52c04 (diff)
child 6848 ec371186361b
Merge
--- a/hedgewars/pas2cSystem.pas	Sun Apr 01 04:27:46 2012 +0200
+++ b/hedgewars/pas2cSystem.pas	Sun Apr 01 04:37:55 2012 +0200
@@ -13,15 +13,18 @@
     QWord = integer;
     GLInt = integer;
     GLUInt = integer;
+    gl_unsigned_byte = integer;
 
     pointer = pointer;
     PChar = pointer;
 
     float = float;
+    single = float;
     double = float;
     real = float;
     extended = float;
     GLFloat = float;
+    gl_float = float;
 
     boolean = boolean;
     LongBool = boolean;
@@ -29,6 +32,7 @@
     string = string;
     shortstring = string;
     ansistring = string;
+    widechar = string;
 
     char = char;
     
@@ -39,15 +43,49 @@
     
     Handle = integer;
     stderr = Handle;
+
 var 
     false, true: boolean;
-    write, writeLn, read, readLn, inc, dec: procedure;
+    write, writeLn, read, readLn: procedure;
     StrLen, ord, Succ, Pred : function : integer;
-    Low, High : function : integer;
+    inc, dec, Low, High, Lo, Hi : function : integer;
+    odd, even : function : boolean;
+
     Now : function : integer;
     Length : function : integer;
+    SetLength, val : procedure;
+
+    new, dispose, FillChar, Move : procedure;
+
+    trunc, round : function : integer;
     Abs, Sqr : function : integer;
+
     StrPas, FormatDateTime, copy, delete, str : function : shortstring;
-    exit, flush : procedure;
-    Sqrt : function : float;
+
+    assign, rewrite, reset, flush : procedure;
+    IOResult : function : integer;
+    exit, break, halt : procedure;
     TextFile : Handle;
+
+    Sqrt, ArcTan2, pi, cos, sin : function : float;
+
+    TypeInfo, GetEnumName : function : shortstring;
+
+    UTF8ToUnicode, WrapText: function : shortstring;
+
+    sizeof : function : integer;
+
+    GetMem : function : pointer;
+    FreeMem : procedure;
+    
+    gl_texture_2d, glbindtexture, gltexparameterf, gl_rgba, 
+    glteximage2d, glvertexpointer, gltexcoordpointer,
+    gl_triangle_fan, gldrawarrays, glpushmatrix, glpopmatrix,
+    gltranslatef, glscalef, glrotatef, gldisable, glenable,
+    gl_line_smooth, gllinewidth, gl_lines, gl_line_loop,
+    glcolor4ub, gl_texture_wrap_s, gltexparameteri,
+    gl_texture_wrap_t, gl_texture_min_filter,
+    gl_linear, gl_texture_mag_filter, glgentextures,
+    gldeletetextures : procedure;
+
+    TThreadId : function : integer;
--- a/tools/pas2c.hs	Sun Apr 01 04:27:46 2012 +0200
+++ b/tools/pas2c.hs	Sun Apr 01 04:37:55 2012 +0200
@@ -258,7 +258,7 @@
 tvar2C :: Bool -> TypeVarDeclaration -> State RenderState Doc
 tvar2C _ (FunctionDeclaration name returnType params Nothing) = do
     t <- type2C returnType 
-    p <- liftM hcat $ mapM (tvar2C False) params
+    p <- withState' id $ liftM hcat $ mapM (tvar2C False) params
     n <- id2C IOInsert name
     return $ t <+> n <> parens p <> text ";"
     
@@ -325,22 +325,28 @@
 
 
 type2C :: TypeDecl -> State RenderState Doc
-type2C VoidType = return $ text "void"
-type2C (String l) = return $ text $ "string" ++ show l
 type2C (SimpleType i) = id2C IOLookup i
-type2C (PointerTo (SimpleType i)) = liftM (<> text "*") $ id2C IODeferred i
-type2C (PointerTo t) = liftM (<> text "*") $ type2C t
-type2C (RecordType tvs union) = do
-    t <- mapM (tvar2C False) tvs
-    return $ text "{" $+$ (nest 4 . vcat $ t) $+$ text "}"
-type2C (RangeType r) = return $ text "<<range type>>"
-type2C (Sequence ids) = do
-    mapM_ (id2C IOInsert) ids
-    return $ text "<<sequence type>>"
-type2C (ArrayDecl r t) = return $ text "<<array type>>"
-type2C (Set t) = return $ text "<<set>>"
-type2C (FunctionType returnType params) = return $ text "<<function>>"
-type2C (DeriveType _) = return $ text "<<type derived from constant literal>>"
+type2C t = do
+    r <- type2C' t
+    rt <- resolveType t
+    modify (\st -> st{lastType = rt})
+    return r
+    where
+    type2C' VoidType = return $ text "void"
+    type2C' (String l) = return $ text $ "string" ++ show l
+    type2C' (PointerTo (SimpleType i)) = liftM (<> text "*") $ id2C IODeferred i
+    type2C' (PointerTo t) = liftM (<> text "*") $ type2C t
+    type2C' (RecordType tvs union) = do
+        t <- mapM (tvar2C False) tvs
+        return $ text "{" $+$ (nest 4 . vcat $ t) $+$ text "}"
+    type2C' (RangeType r) = return $ text "<<range type>>"
+    type2C' (Sequence ids) = do
+        mapM_ (id2C IOInsert) ids
+        return $ text "<<sequence type>>"
+    type2C' (ArrayDecl r t) = return $ text "<<array type>>"
+    type2C' (Set t) = return $ text "<<set>>"
+    type2C' (FunctionType returnType params) = return $ text "<<function>>"
+    type2C' (DeriveType _) = return $ text "<<type derived from constant literal>>"
 
 phrase2C :: Phrase -> State RenderState Doc
 phrase2C (Phrases p) = do
@@ -432,10 +438,12 @@
     es <- mapM expr2C exprs
     r <- ref2C ref 
     t <- gets lastType
+    ns <- gets currentScope
     case t of
+         (BTArray _ (BTArray _ t')) -> modify (\st -> st{lastType = t'})
          (BTArray _ t') -> modify (\st -> st{lastType = t'})
          (BTString) -> modify (\st -> st{lastType = BTChar})
-         a -> error $ show a ++ "\n" ++ show ae
+         a -> error $ "Getting element of " ++ show a ++ "\nReference: " ++ show ae ++ "\n" ++ show (take 100 ns)
     return $ r <> (brackets . hcat) (punctuate comma es)
 ref2C (SimpleReference name) = id2C IOLookup name
 ref2C (RecordField (Dereference ref1) ref2) = do