author | unc0rr |
Fri, 30 Mar 2012 23:58:08 +0400 | |
changeset 6838 | b1a0e7a52c04 |
parent 6837 | a137733c5776 |
child 6841 | 3633928a3188 |
child 6846 | bf4c2771caf0 |
hedgewars/pas2cSystem.pas | file | annotate | diff | comparison | revisions | |
tools/pas2c.hs | file | annotate | diff | comparison | revisions |
--- a/hedgewars/pas2cSystem.pas Fri Mar 30 17:00:34 2012 +0400 +++ b/hedgewars/pas2cSystem.pas Fri Mar 30 23:58:08 2012 +0400 @@ -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 Fri Mar 30 17:00:34 2012 +0400 +++ b/tools/pas2c.hs Fri Mar 30 23:58:08 2012 +0400 @@ -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