diff -r d8f62c805619 -r 734fed7aefd3 tools/pas2c.hs --- a/tools/pas2c.hs Sun Nov 13 18:23:05 2011 +0100 +++ b/tools/pas2c.hs Sun Nov 13 13:46:26 2011 +0300 @@ -4,8 +4,16 @@ import Text.PrettyPrint.HughesPJ import Data.Maybe import Data.Char +import Text.Parsec.String +pas2C :: String -> IO String +pas2C fileName = do + ptree <- parseFromFile pascalUnit fileName + case ptree of + (Left a) -> return (show a) + (Right a) -> (return . render . pascal2C) a + pascal2C :: PascalUnit -> Doc pascal2C (Unit unitName interface implementation init fin) = implementation2C implementation @@ -21,17 +29,38 @@ tvar2C :: TypeVarDeclaration -> Doc tvar2C (FunctionDeclaration (Identifier name) returnType Nothing) = type2C returnType <+> text (name ++ "();") - - tvar2C (FunctionDeclaration (Identifier name) returnType (Just phrase)) = type2C returnType <+> text (name ++ "()") $$ phrase2C phrase -tvar2C _ = empty +tvar2C (TypeDeclaration (Identifier i) t) = text "type" <+> text i <+> type2C t <> text ";" +tvar2C (VarDeclaration isConst (ids, t) mInitExpr) = + if isConst then text "const" else empty + <+> + type2C t + <+> + (hsep . punctuate (char ',') . map (\(Identifier i) -> text i) $ ids) + <+> + initExpr mInitExpr + <> + text ";" + where + initExpr Nothing = empty + initExpr (Just e) = text "=" <+> initExpr2C e + +initExpr2C :: InitExpression -> Doc +initExpr2C _ = text "<>" type2C :: TypeDecl -> Doc type2C UnknownType = text "void" -type2C _ = text "<>" +type2C String = text "string" +type2C (SimpleType (Identifier i)) = text i +type2C (PointerTo t) = type2C t <> text "*" +type2C (RecordType tvs) = text "{" $+$ (nest 4 . vcat . map tvar2C $ tvs) $+$ text "}" +type2C (RangeType r) = text "<>" +type2C (Sequence ids) = text "<>" +type2C (ArrayDecl r t) = text "<>" + phrase2C :: Phrase -> Doc phrase2C (Phrases p) = text "{" $+$ (nest 4 . vcat . map phrase2C $ p) $+$ text "}" @@ -46,15 +75,18 @@ where case2C :: (Expression, Phrase) -> Doc case2C (e, p) = text "case" <+> parens (expr2C e) <> char ':' <> nest 4 (phrase2C p $+$ text "break;") -{- - | RepeatCycle Expression Phrase - | ForCycle - -} -phrase2C _ = empty +phrase2C (WithBlock ref p) = text "namespace" <> parens (ref2C ref) $$ (phrase2C $ wrapPhrase p) +phrase2C (ForCycle (Identifier i) e1 e2 p) = + text "for" <> (parens . hsep . punctuate (char ';') $ [text i <+> text "=" <+> expr2C e1, text i <+> text "<=" <+> expr2C e2, text "++" <> text i]) + $$ + phrase2C (wrapPhrase p) +phrase2C (RepeatCycle e p) = text "do" <+> phrase2C (Phrases p) <+> text "while" <> parens (text "!" <> parens (expr2C e)) + wrapPhrase p@(Phrases _) = p wrapPhrase p = Phrases [p] + expr2C :: Expression -> Doc expr2C (Expression s) = text s expr2C (BinOp op expr1 expr2) = parens $ (expr2C expr1) <+> op2C op <+> (expr2C expr2) @@ -79,6 +111,7 @@ ref2C (FunCall params ref) = ref2C ref <> parens (hsep . punctuate (char ',') . map expr2C $ params) ref2C (Address ref) = text "&" <> ref2C ref + op2C "or" = text "|" op2C "and" = text "&" op2C "not" = text "!"