# HG changeset patch # User unc0rr # Date 1334945015 -14400 # Node ID 31def088a87041d83ee62b19f0b2aae457ba3318 # Parent 555a8d8db228b65c6e2d573b2259b5b3818fbe9d Many small improvements to pas2c diff -r 555a8d8db228 -r 31def088a870 hedgewars/pas2c.h --- 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); + diff -r 555a8d8db228 -r 31def088a870 tools/PascalBasics.hs --- 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 diff -r 555a8d8db228 -r 31def088a870 tools/PascalParser.hs --- 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) diff -r 555a8d8db228 -r 31def088a870 tools/PascalUnitSyntaxTree.hs --- 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 diff -r 555a8d8db228 -r 31def088a870 tools/pas2c.hs --- 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