# HG changeset patch
# User unc0rr
# Date 1334091898 -14400
# Node ID 0af34406b83dba7c379403f46ee07eebf77a755b
# Parent  b899393c84502f198b88b591039aa7e4c63e85c9
Improve rendering of function types, arrays, and more

diff -r b899393c8450 -r 0af34406b83d hedgewars/pas2c.h
--- a/hedgewars/pas2c.h	Mon Apr 09 23:20:42 2012 +0200
+++ b/hedgewars/pas2c.h	Wed Apr 11 01:04:58 2012 +0400
@@ -1,5 +1,7 @@
 #pragma once
 
+#include <stdbool.h>
+
 typedef char string255[];
 
 typedef int SmallInt;
@@ -7,7 +9,16 @@
 typedef int LongInt;
 typedef int LongWord;
 typedef int Byte;
-typedef Byte * PByte;
+typedef int Integer;
+
+typedef float extended;
+typedef float real;
+
+typedef bool boolean;
 
 typedef void * pointer;
+typedef Byte * PByte;
+typedef char * PChar;
+typedef LongInt * PLongInt;
+typedef Integer * PInteger;
 
diff -r b899393c8450 -r 0af34406b83d tools/pas2c.hs
--- a/tools/pas2c.hs	Mon Apr 09 23:20:42 2012 +0200
+++ b/tools/pas2c.hs	Wed Apr 11 01:04:58 2012 +0400
@@ -119,12 +119,12 @@
     toCFiles' (fn, p@(Program {})) = writeFile (fn ++ ".c") $ (render2C initialState . pascal2C) p
     toCFiles' (fn, (Unit unitId interface implementation _ _)) = do
         let (a, s) = runState (id2C IOInsert (setBaseType BTUnit unitId) >> interface2C interface) initialState
-        writeFile (fn ++ ".h") $ "#pragma once\n\n" ++ (render a)
+        writeFile (fn ++ ".h") $ "#pragma once\n\n" ++ (render (a $+$ text ""))
         writeFile (fn ++ ".c") $ "#include \"pas2c.h\"\n#include \"" ++ fn ++ ".h\"\n" ++ (render2C s . implementation2C) implementation
     initialState = emptyState ns
 
     render2C :: RenderState -> State RenderState Doc -> String
-    render2C a = render . flip evalState a
+    render2C a = render . ($+$ text "") . flip evalState a
 
 usesFiles :: PascalUnit -> [String]
 usesFiles (Program _ (Implementation uses _) _) = "pas2cSystem" : uses2List uses
@@ -138,7 +138,7 @@
     
 pascal2C (Program _ implementation mainFunction) = do
     impl <- implementation2C implementation
-    main <- tvar2C True 
+    [main] <- tvar2C True 
         (FunctionDeclaration (Identifier "main" BTInt) (SimpleType $ Identifier "int" BTInt) [] (Just (TypesAndVars [], mainFunction)))
     return $ impl $+$ main
 
@@ -152,7 +152,7 @@
 
 
 typesAndVars2C :: Bool -> TypesAndVars -> State RenderState Doc
-typesAndVars2C b (TypesAndVars ts) = liftM vcat $ mapM (tvar2C b) ts
+typesAndVars2C b (TypesAndVars ts) = liftM (vcat . map (<> semi) . concat) $ mapM (tvar2C b) ts
 
 setBaseType :: BaseType -> Identifier -> Identifier
 setBaseType bt (Identifier i _) = Identifier i bt
@@ -267,35 +267,37 @@
     ns <- gets currentScope
     error $ "Dereferencing from non-pointer type " ++ show t ++ "\n" ++ s ++ "\n\n" ++ show (take 100 ns)
 
+    
+functionParams2C params = liftM (hcat . punctuate comma . concat) $ mapM (tvar2C False) params
 
-tvar2C :: Bool -> TypeVarDeclaration -> State RenderState Doc
+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
+    p <- withState' id $ functionParams2C params
     n <- id2C IOInsert $ setBaseType (BTFunction t') name
-    return $ t <+> n <> parens p <> text ";"
+    return [t empty <+> n <> parens p]
     
 tvar2C True (FunctionDeclaration name returnType params (Just (tvars, phrase))) = do
     t <- type2C returnType
     t'<- gets lastType
     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
+        p <- functionParams2C params
         ph <- liftM2 ($+$) (typesAndVars2C False tvars) (phrase2C' phrase)
         return (p, ph)
     let res = docToLower $ n <> text "_result"
     let phrasesBlock = case returnType of
             VoidType -> ph
-            _ -> t <+> res <> semi $+$ ph $+$ text "return" <+> res <> semi
-    return $ 
-        t <+> n <> parens p
+            _ -> t empty <+> res <> semi $+$ ph $+$ text "return" <+> res <> semi
+    return [ 
+        t empty <+> n <> parens p
         $+$
         text "{" 
         $+$ 
         nest 4 phrasesBlock
         $+$
-        text "}"
+        text "}"]
     where
     phrase2C' (Phrases p) = liftM vcat $ mapM phrase2C p
     phrase2C' p = phrase2C p
@@ -305,17 +307,12 @@
 tvar2C _ td@(TypeDeclaration i' t) = do
     i <- id2CTyped t i'
     tp <- type2C t
-    return $ text "typedef" <+> tp <+> i <> semi
+    return [text "typedef" <+> tp i]
     
 tvar2C _ (VarDeclaration isConst (ids, t) mInitExpr) = do
-    t' <- type2C t
-    i <- mapM (id2CTyped t) ids
+    t' <- liftM (((if isConst then text "const" else empty) <+>) . ) $ type2C t
     ie <- initExpr mInitExpr
-    return $ (if isConst then text "const" else empty)
-        <+> t'
-        <+> (hsep . punctuate (char ',') $ i)
-        <+> ie
-        <> text ";"
+    liftM (map(\i -> t' i <+> ie)) $ mapM (id2CTyped t) ids
     where
     initExpr Nothing = return $ empty
     initExpr (Just e) = liftM (text "=" <+>) (initExpr2C e)
@@ -345,6 +342,7 @@
 initExpr2C (InitArray [value]) = initExpr2C value
 initExpr2C (InitArray values) = liftM (braces . vcat . punctuate comma) $ mapM initExpr2C values
 initExpr2C (InitRange (Range i)) = id2C IOLookup i
+initExpr2C (InitRange (RangeFromTo (InitNumber "0") (InitNumber a))) = return . text $ show (read a + 1)
 initExpr2C (InitRange a) = return $ text "<<range>>"
 initExpr2C (InitSet []) = return $ text "0"
 initExpr2C (InitSet a) = return $ text "<<set>>"
@@ -358,38 +356,47 @@
     
 range2C a = liftM (flip (:) []) $ initExpr2C a
 
-type2C :: TypeDecl -> State RenderState Doc
-type2C (SimpleType i) = id2C IOLookup i
+type2C :: TypeDecl -> State RenderState (Doc -> Doc)
+type2C (SimpleType i) = liftM (\i a -> i <+> a) $ id2C IOLookup i
 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 (\i -> text "struct" <+> i <+> text "*") $ id2C IODeferred i
-    type2C' (PointerTo t) = liftM (<> text "*") $ type2C t
+    type2C' VoidType = return (text "void" <+>)
+    type2C' (String l) = return (text ("string" ++ show l) <+>)
+    type2C' (PointerTo (SimpleType i)) = liftM (\i a -> text "struct" <+> i <+> text "*" <+> a) $ id2C IODeferred i
+    type2C' (PointerTo t) = liftM (\t a -> t (text "*" <> a)) $ type2C t
     type2C' (RecordType tvs union) = do
         t <- withState' id $ mapM (tvar2C False) tvs
-        return $ text "struct" <+> lbrace $+$ (nest 4 . vcat $ t) $+$ rbrace
-    type2C' (RangeType r) = return $ text "<<range type>>"
+        return $ \i -> text "struct" <+> lbrace $+$ (nest 4 . vcat . map (<> semi) . concat $ t) $+$ rbrace <+> i
+    type2C' (RangeType r) = return (text "<<range type>>" <+>)
     type2C' (Sequence ids) = do
-        mapM_ (id2C IOInsert) ids
-        return $ text "<<sequence type>>"
-    type2C' (ArrayDecl r t) = do
+        is <- mapM (id2C IOInsert . setBaseType bt) ids
+        return (text "enum" <+> (braces . vcat . punctuate comma . map (\(a, b) -> a <+> equals <+> text "0x" <> text (showHex b "")) $ zip is (iterate (*2) 1)) <+>)
+        where
+            bt = BTEnum $ map (\(Identifier i _) -> map toLower i) ids
+    type2C' (ArrayDecl Nothing t) = do
+        t' <- type2C t
+        return $ \i -> t' i <> brackets empty
+    type2C' (ArrayDecl (Just r) t) = do
         t' <- type2C t
-        return $ t' <> brackets (text "<<range>>")
-    type2C' (Set t) = return $ text "<<set>>"
-    type2C' (FunctionType returnType params) = return $ text "<<function>>"
-    type2C' (DeriveType (InitBinOp {})) = return $ text "int"
+        r' <- initExpr2C (InitRange r)
+        return $ \i -> t' i <> brackets r'
+    type2C' (Set t) = return (text "<<set>>" <+>)
+    type2C' (FunctionType returnType params) = do
+        t <- type2C returnType
+        p <- withState' id $ functionParams2C params
+        return (\i -> t empty <+> i <> parens p)
+    type2C' (DeriveType (InitBinOp {})) = return (text "int" <+>)
     type2C' (DeriveType (InitPrefixOp _ i)) = type2C' (DeriveType i)
-    type2C' (DeriveType (InitNumber _)) = return $ text "int"
-    type2C' (DeriveType (InitHexNumber _)) = return $ text "int"
-    type2C' (DeriveType (InitFloat _)) = return $ text "float"
-    type2C' (DeriveType (BuiltInFunction {})) = return $ text "int"
-    type2C' (DeriveType (InitString {})) = return $ text "string255"
-    type2C' (DeriveType (InitReference {})) = return $ text "<<some type>>"
+    type2C' (DeriveType (InitNumber _)) = return (text "int" <+>)
+    type2C' (DeriveType (InitHexNumber _)) = return (text "int" <+>)
+    type2C' (DeriveType (InitFloat _)) = return (text "float" <+>)
+    type2C' (DeriveType (BuiltInFunction {})) = return (text "int" <+>)
+    type2C' (DeriveType (InitString {})) = return (text "string255" <+>)
+    type2C' (DeriveType (InitReference {})) = return (text "<<some type>>" <+>)
     type2C' (DeriveType a) = error $ "Can't derive type from " ++ show a
 
 phrase2C :: Phrase -> State RenderState Doc