hedgewars: comparison tools/pas2c.hs

equal deleted inserted replaced

-:c021699c33dc
+:7d4e5ce73b98
 addStringConst :: String -> State RenderState Doc
 addStringConst str = do
 i <- getUniq
 let sn = "__str" ++ show i
-modify (\s -> s{stringConsts = (sn, str) : stringConsts s})
+modify (\s -> s{lastType = BTString, stringConsts = (sn, str) : stringConsts s})
 return $ text sn
 escapeStr :: String -> String
 escapeStr = foldr escapeChar []
 writeFile (fn ++ ".h") $ "#pragma once\n\n#include \"pas2c.h\"\n\n" ++ (render (a $+$ text ""))
 writeFile (fn ++ ".c") $ "#include \"" ++ fn ++ ".h\"\n" ++ (render2C s . implementation2C) implementation
 initialState = emptyState ns
 render2C :: RenderState -> State RenderState Doc -> String
-render2C a = render . ($+$ text "") . flip evalState a
+render2C a = render . ($+$ empty) . flip evalState a
 usesFiles :: PascalUnit -> [String]
 usesFiles (Program _ (Implementation uses _) _) = "pas2cSystem" : uses2List uses
 usesFiles (Unit _ (Interface uses1 _) (Implementation uses2 _) _ _) = "pas2cSystem" : uses2List uses1 ++ uses2List uses2
 usesFiles (System {}) = []
 $$
 ph
 phrase2C (RepeatCycle e' p') = do
 e <- expr2C e'
 p <- phrase2C (Phrases p')
-return $ text "do" <+> p <+> text "while" <> parens (text "!" <> parens e)
+return $ text "do" <+> p <+> text "while" <> parens (text "!" <> parens e) <> semi
 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
 expr2C (Expression s) = return $ text s
 expr2C (BinOp op expr1 expr2) = do
 e1 <- expr2C expr1
 t1 <- gets lastType
 e2 <- expr2C expr2
-case (op2C op, t1) of
+t2 <- gets lastType
-("+", BTString) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strconcat" (BTFunction BTString))
+case (op2C op, t1, t2) of
-("==", BTString) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strcompare" (BTFunction BTBool))
+("+", BTString, BTString) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strconcat" (BTFunction BTString))
-("!=", BTString) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strncompare" (BTFunction BTBool))
+("+", BTString, BTChar) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strappend" (BTFunction BTString))
-("&", BTBool) -> return $ parens e1 <+> text "&&" <+> parens e2
+("+", BTChar, BTString) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strprepend" (BTFunction BTString))
-("|", BTBool) -> return $ parens e1 <+> text "||" <+> parens e2
+("==", BTString, _) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strcompare" (BTFunction BTBool))
-(o, _) -> return $ parens e1 <+> text o <+> parens e2
+("!=", BTString, _) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strncompare" (BTFunction BTBool))
+("&", 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)
-expr2C (StringLiteral [a]) = return . quotes $ text [a]
+expr2C (StringLiteral [a]) = do
+modify(\s -> s{lastType = BTChar})
+return . quotes $ text [a]
 expr2C (StringLiteral s) = addStringConst s
-expr2C (Reference ref) = ref2C ref
+expr2C (Reference ref) = ref2CF 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 (CharCode a) = do
+modify(\s -> s{lastType = BTChar})
+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 "ord" _))) = liftM parens $ expr2C e
 expr2C (BuiltInFunCall [e] (SimpleReference (Identifier "succ" _))) = liftM (<> text " + 1") $ expr2C e
+expr2C (BuiltInFunCall [e] (SimpleReference (Identifier "pred" _))) = liftM (<> text " - 1") $ expr2C e
 expr2C (BuiltInFunCall params ref) = do
 r <- ref2C ref
+t <- gets lastType
 ps <- mapM expr2C params
+case t of
+BTFunction t' -> do
+modify (\s -> s{lastType = t'})
+_ -> error $ "BuiltInFunCall lastType: " ++ show t
 return $
 r <> parens (hsep . punctuate (char ',') $ ps)
 expr2C a = error $ "Don't know how to render " ++ show a
+ref2CF :: Reference -> State RenderState Doc
+ref2CF (SimpleReference name) = do
+i <- id2C IOLookup name
+t <- gets lastType
+case t of
+BTFunction _ -> return $ i <> parens empty
+_ -> return $ i
+ref2CF r = ref2C r
 ref2C :: Reference -> State RenderState Doc
 -- rewrite into proper form
 ref2C (RecordField ref1 (ArrayElement exprs ref2)) = ref2C $ ArrayElement exprs (RecordField ref1 ref2)
 ref2C (RecordField ref1 (Dereference ref2)) = ref2C $ Dereference (RecordField ref1 ref2)
 ref2C d@(Dereference ref) = do
 r <- ref2C ref
 t <- fromPointer (show d) =<< gets lastType
 modify (\st -> st{lastType = t})
 return $ (parens $ text "*" <> r)
-ref2C (FunCall params ref) = do
+ref2C f@(FunCall params ref) = do
-ps <- liftM (parens . hsep . punctuate (char ',')) $ mapM expr2C params
 r <- ref2C ref
 t <- gets lastType
 case t of
-BTFunction t -> do
+BTFunction t' -> do
-modify (\s -> s{lastType = t})
+ps <- liftM (parens . hsep . punctuate (char ',')) $ mapM expr2C params
+modify (\s -> s{lastType = t'})
 return $ r <> ps
-_ -> return $ parens r <> ps
+_ -> case (ref, params) of
+(SimpleReference i, [p]) -> ref2C $ TypeCast i p
+_ -> error $ "ref2C FunCall erroneous type cast detected: " ++ show f ++ "\nType detected: " ++ show t
 ref2C (Address ref) = do
 r <- ref2C ref
 return $ text "&" <> parens r
-ref2C (TypeCast t' expr) = do
+ref2C (TypeCast t'@(Identifier i _) expr) = do
-t <- id2C IOLookup t'
+case map toLower i of
-e <- expr2C expr
+"pchar" -> ref2C $ FunCall [expr] (SimpleReference (Identifier "_pchar" $ BTPointerTo BTChar))
-return $ parens t <> e
+a -> do
+e <- expr2C expr
+t <- id2C IOLookup t'
+return $ parens t <> e
 ref2C (RefExpression expr) = expr2C expr
 op2C :: String -> String
 op2C "or" = "|"

changeset 6902	7d4e5ce73b98
parent 6896	23b38e530967
child 6921	e6033fe39b7f