Many small improvements to pas2c
authorunc0rr
Fri, 20 Apr 2012 22:03:35 +0400
changeset 6895 31def088a870
parent 6894 555a8d8db228
child 6896 23b38e530967
Many small improvements to pas2c
hedgewars/pas2c.h
tools/PascalBasics.hs
tools/PascalParser.hs
tools/PascalUnitSyntaxTree.hs
tools/pas2c.hs
--- a/hedgewars/pas2c.h	Fri Apr 20 01:50:47 2012 +0400
+++ b/hedgewars/pas2c.h	Fri Apr 20 22:03:35 2012 +0400
@@ -39,10 +39,17 @@
 typedef Integer * PInteger;
 
 #define new(a) __new(a, sizeof(*(a)))
-void __new(pointer p);
+void __new(pointer p, int size);
+
+#define dispose(a) __dispose(a, sizeof(*(a)))
+void __dispose(pointer p, int size);
 
 #define FillChar(a, b, c) __FillChar(&(a), b, c)
 
 void __FillChar(pointer p, int size, char fill);
 string255 _strconcat(string255 a, string255 b);
 
+int Length(string255 a);
+string255 copy(string255 a, int s, int l);
+string255 delete(string255 a, int s, int l);
+
--- a/tools/PascalBasics.hs	Fri Apr 20 01:50:47 2012 +0400
+++ b/tools/PascalBasics.hs	Fri Apr 20 22:03:35 2012 +0400
@@ -8,7 +8,7 @@
 import Text.Parsec.Language
 import Data.Char
 
-builtin = ["succ", "pred", "low", "high", "ord"]
+builtin = ["succ", "pred", "low", "high", "ord", "inc", "dec", "exit"]
     
 pascalLanguageDef
     = emptyDef
--- a/tools/PascalParser.hs	Fri Apr 20 01:50:47 2012 +0400
+++ b/tools/PascalParser.hs	Fri Apr 20 22:03:35 2012 +0400
@@ -408,6 +408,7 @@
         , withBlock
         , forCycle
         , (try $ reference >>= \r -> string ":=" >> return r) >>= \r -> expression >>= return . Assignment r
+        , builtInFunction expression >>= \(n, e) -> return $ BuiltInFunctionCall e (SimpleReference (Identifier n BTUnknown))
         , procCall
         , char ';' >> comments >> return NOP
         ]
@@ -597,7 +598,7 @@
 builtInFunction e = do
     name <- choice $ map (\s -> try $ caseInsensitiveString s >>= \i -> notFollowedBy alphaNum >> return i) builtin
     spaces
-    exprs <- parens pas $ commaSep1 pas $ e
+    exprs <- option [] $ parens pas $ commaSep1 pas $ e
     spaces
     return (name, exprs)
 
--- a/tools/PascalUnitSyntaxTree.hs	Fri Apr 20 01:50:47 2012 +0400
+++ b/tools/PascalUnitSyntaxTree.hs	Fri Apr 20 22:03:35 2012 +0400
@@ -52,6 +52,7 @@
         | Phrases [Phrase]
         | SwitchCase Expression [([InitExpression], Phrase)] (Maybe [Phrase])
         | Assignment Reference Expression
+        | BuiltInFunctionCall [Expression] Reference
         | NOP
     deriving Show
 data Expression = Expression String
--- a/tools/pas2c.hs	Fri Apr 20 01:50:47 2012 +0400
+++ b/tools/pas2c.hs	Fri Apr 20 22:03:35 2012 +0400
@@ -424,12 +424,12 @@
     where
     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 (SimpleType i)) = liftM (\i a -> text "struct __" <> i <+> text "*" <+> a) $ id2C IODeferred i
     type2C' (PointerTo t) = liftM (\t a -> t (parens $ text "*" <> a)) $ type2C t
     type2C' (RecordType tvs union) = do
         t <- withState' id $ mapM (tvar2C False) tvs
         u <- unions
-        return $ \i -> text "struct" <+> lbrace $+$ nest 4 ((vcat . map (<> semi) . concat $ t) $$ u) $+$ rbrace <+> i
+        return $ \i -> text "struct __" <> i <+> lbrace $+$ nest 4 ((vcat . map (<> semi) . concat $ t) $$ u) $+$ rbrace <+> i
         where
             unions = case union of
                      Nothing -> return empty
@@ -497,7 +497,7 @@
     cs <- mapM case2C cases
     d <- dflt
     return $ 
-        text "switch" <> parens e <> text "of" $+$ braces (nest 4 . vcat $ cs ++ d)
+        text "switch" <> parens e $+$ braces (nest 4 . vcat $ cs ++ d)
     where
     case2C :: ([InitExpression], Phrase) -> State RenderState Doc
     case2C (e, p) = do
@@ -533,6 +533,13 @@
     return $ text "do" <+> p <+> text "while" <> parens (text "!" <> parens e)
 phrase2C NOP = return $ text ";"
 
+phrase2C (BuiltInFunctionCall [] (SimpleReference (Identifier "exit" BTUnknown))) = return $ text "return" <> semi
+phrase2C (BuiltInFunctionCall [e] (SimpleReference (Identifier "exit" BTUnknown))) = liftM (\e -> text "return" <> e <> semi) $ expr2C e
+phrase2C (BuiltInFunctionCall [e] (SimpleReference (Identifier "dec" BTUnknown))) = liftM (\e -> text "--" <> e <> semi) $ expr2C e
+phrase2C (BuiltInFunctionCall [e1, e2] (SimpleReference (Identifier "dec" BTUnknown))) = liftM2 (\a b -> a <> text " -= " <> b <> semi) (expr2C e1) (expr2C e2)
+phrase2C (BuiltInFunctionCall [e] (SimpleReference (Identifier "inc" BTUnknown))) = liftM (\e -> text "++" <> e <> semi) $ expr2C e
+phrase2C (BuiltInFunctionCall [e1, e2] (SimpleReference (Identifier "inc" BTUnknown))) = liftM2 (\a b -> a <+> text "+=" <+> b <> semi) (expr2C e1) (expr2C e2)
+phrase2C a = error $ "phrase2C: " ++ show a
 
 wrapPhrase p@(Phrases _) = p
 wrapPhrase p = Phrases [p]
@@ -547,9 +554,9 @@
         ("+", BTString) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strconcat" (BTFunction BTString))
         ("==", BTString) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strcompare" (BTFunction BTBool))
         ("!=", BTString) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strncompare" (BTFunction BTBool))
-        ("&", BTBool) -> return $ parens $ e1 <+> text "&&" <+> e2
-        ("|", BTBool) -> return $ parens $ e1 <+> text "||" <+> e2
-        (o, _) -> return $ parens $ e1 <+> text o <+> e2
+        ("&", BTBool) -> return $ parens e1 <+> text "&&" <+> parens e2
+        ("|", BTBool) -> return $ parens e1 <+> text "||" <+> parens e2
+        (o, _) -> return $ parens e1 <+> text o <+> parens e2
 expr2C (NumberLiteral s) = return $ text s
 expr2C (FloatLiteral s) = return $ text s
 expr2C (HexNumber s) = return $ text "0x" <> (text . map toLower $ s)
@@ -558,14 +565,16 @@
 expr2C (Reference ref) = ref2C ref
 expr2C (PrefixOp op expr) = liftM (text (op2C op) <>) (expr2C expr)
 expr2C Null = return $ text "NULL"
+expr2C (CharCode a) = return $ quotes $ text "\\x" <> text (showHex (read a) "")
+expr2C (HexCharCode a) = return $ quotes $ text "\\x" <> text (map toLower a)
+expr2C (SetExpression ids) = mapM (id2C IOLookup) ids >>= return . parens . hcat . punctuate (text " | ")
+expr2C b@(BuiltInFunCall [e] (SimpleReference (Identifier "ord" _))) = liftM parens $ expr2C e
+expr2C (BuiltInFunCall [e] (SimpleReference (Identifier "succ" _))) = liftM (<> text " + 1") $ expr2C e
 expr2C (BuiltInFunCall params ref) = do
     r <- ref2C ref 
     ps <- mapM expr2C params
     return $ 
         r <> parens (hsep . punctuate (char ',') $ ps)
-expr2C (CharCode a) = return $ quotes $ text "\\x" <> text (showHex (read a) "")
-expr2C (HexCharCode a) = return $ quotes $ text "\\x" <> text (map toLower a)
-expr2C (SetExpression ids) = mapM (id2C IOLookup) ids >>= return . parens . hcat . punctuate (text " | ")
 expr2C a = error $ "Don't know how to render " ++ show a
 
 
@@ -577,8 +586,8 @@
 ref2C (RecordField ref1 (FunCall params ref2)) = ref2C $ FunCall params (RecordField ref1 ref2)
 ref2C (ArrayElement (a:b:xs) ref) = ref2C $ ArrayElement (b:xs) (ArrayElement [a] ref)
 -- conversion routines
-ref2C ae@(ArrayElement exprs ref) = do
-    es <- mapM expr2C exprs
+ref2C ae@(ArrayElement [expr] ref) = do
+    e <- expr2C expr
     r <- ref2C ref 
     t <- gets lastType
     ns <- gets currentScope
@@ -591,7 +600,9 @@
                      BTChar -> modify (\st -> st{lastType = BTChar})
                      a -> error $ "Getting element of " ++ show a ++ "\nReference: " ++ show ae ++ "\n" ++ show (take 100 ns)
          a -> error $ "Getting element of " ++ show a ++ "\nReference: " ++ show ae ++ "\n" ++ show (take 100 ns)
-    return $ r <> (brackets . hcat) (punctuate comma es)
+    case t of
+         BTString ->  return $ r <> text ".s" <> brackets e
+         _ -> return $ r <> brackets e
 ref2C (SimpleReference name) = id2C IOLookup name
 ref2C rf@(RecordField (Dereference ref1) ref2) = do
     r1 <- ref2C ref1