diff -r a93cb9ca9fda -r 13262c6e5027 tools/pas2c.hs --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/tools/pas2c.hs Thu Nov 03 23:12:22 2011 +0300 @@ -0,0 +1,67 @@ +module Pas2C where + +import PascalParser +import Text.PrettyPrint.HughesPJ +import Data.Maybe + + +pascal2C :: PascalUnit -> Doc +pascal2C (Unit unitName interface implementation init fin) = implementation2C implementation + + +implementation2C :: Implementation -> Doc +implementation2C (Implementation uses tvars) = typesAndVars2C tvars + + +typesAndVars2C :: TypesAndVars -> Doc +typesAndVars2C (TypesAndVars ts) = vcat $ map tvar2C ts + + +tvar2C :: TypeVarDeclaration -> Doc +tvar2C (FunctionDeclaration (Identifier name) (Identifier returnType) Nothing) = + text $ maybeVoid returnType ++ " " ++ name ++ "();" + + +tvar2C (FunctionDeclaration (Identifier name) (Identifier returnType) (Just phrase)) = + text (maybeVoid returnType ++ " " ++ name ++ "()") + $$ + phrase2C phrase +tvar2C _ = empty + + +phrase2C :: Phrase -> Doc +phrase2C (Phrases p) = braces . nest 4 . vcat . map phrase2C $ p +phrase2C (ProcCall (Identifier name) params) = text name <> parens (hsep . punctuate (char ',') . map expr2C $ params) <> semi +phrase2C (IfThenElse (expr) phrase1 mphrase2) = text "if" <> parens (expr2C expr) $$ (braces . nest 4 . phrase2C) phrase1 <+> elsePart + where + elsePart | isNothing mphrase2 = empty + | otherwise = text "else" $$ (braces . nest 4 . phrase2C) (fromJust mphrase2) +phrase2C (Assignment (Identifier name) expr) = text name <> text " = " <> expr2C expr <> semi +phrase2C (WhileCycle expr phrase) = text "while" <> parens (expr2C expr) $$ nest 4 (phrase2C phrase) +phrase2C (SwitchCase expr cases mphrase) = text "switch" <> parens (expr2C expr) <> text "of" $$ (nest 4 . vcat . map case2C) cases + where + case2C :: (Expression, Phrase) -> Doc + case2C (e, p) = text "case" <+> parens (expr2C e) <> char ':' <> nest 4 (phrase2C p $$ text "break;") +{- + | RepeatCycle Expression Phrase + | ForCycle + | SwitchCase Expression [(Expression, Phrase)] (Maybe Phrase) + | Assignment Identifier Expression + -} +phrase2C _ = empty + + +expr2C :: Expression -> Doc +expr2C (Expression s) = text s +expr2C (FunCall (Identifier name) params) = text name <> parens (hsep . punctuate (char ',') . map expr2C $ params) +expr2C (BinOp op expr1 expr2) = (expr2C expr1) <+> op2C op <+> (expr2C expr2) +{- | FunCall Identifier [Expression] + | PrefixOp String Expression + | BinOp String Expression Expression + -} +expr2C _ = empty + +op2C = text + +maybeVoid "" = "void" +maybeVoid a = a