# HG changeset patch # User unc0rr # Date 1323198359 -10800 # Node ID bc6e67598ddeb4874ea047129defbf3cb329349b # Parent ac876f02eaa1bbe25be2d5f7de53233be6cf7966 Ok, State monad instead diff -r ac876f02eaa1 -r bc6e67598dde tools/pas2c.hs --- a/tools/pas2c.hs Tue Dec 06 16:16:48 2011 -0500 +++ b/tools/pas2c.hs Tue Dec 06 22:05:59 2011 +0300 @@ -3,7 +3,7 @@ import Text.PrettyPrint.HughesPJ import Data.Maybe import Data.Char -import Text.Parsec.Prim +import Text.Parsec.Prim hiding (State) import Control.Monad.State import System.IO import System.Directory @@ -12,7 +12,7 @@ import Control.Exception import System.IO.Error import qualified Data.Map as Map -import Control.Monad.Reader + import PascalParser import PascalUnitSyntaxTree @@ -65,7 +65,7 @@ system :: [(String, String)] system = [] -render2C = render . flip runReader system +render2C = render . flip evalState system usesFiles :: PascalUnit -> [String] usesFiles (Program _ (Implementation uses _) _) = uses2List uses @@ -73,7 +73,7 @@ -pascal2C :: PascalUnit -> Reader a Doc +pascal2C :: PascalUnit -> State a Doc pascal2C (Unit _ interface implementation init fin) = liftM2 ($+$) (interface2C interface) (implementation2C implementation) @@ -85,26 +85,26 @@ -interface2C :: Interface -> Reader a Doc +interface2C :: Interface -> State a Doc interface2C (Interface uses tvars) = liftM2 ($+$) (uses2C uses) (typesAndVars2C True tvars) -implementation2C :: Implementation -> Reader a Doc +implementation2C :: Implementation -> State a Doc implementation2C (Implementation uses tvars) = liftM2 ($+$) (uses2C uses) (typesAndVars2C True tvars) -typesAndVars2C :: Bool -> TypesAndVars -> Reader a Doc +typesAndVars2C :: Bool -> TypesAndVars -> State a Doc typesAndVars2C b (TypesAndVars ts) = liftM vcat $ mapM (tvar2C b) ts -uses2C :: Uses -> Reader a Doc +uses2C :: Uses -> State a Doc uses2C uses = return $ vcat . map (\i -> text $ "#include \"" ++ i ++ ".h\"") $ uses2List uses uses2List :: Uses -> [String] uses2List (Uses ids) = map (\(Identifier i _) -> i) ids -id2C :: Bool -> Identifier -> Reader a Doc -id2C isDecl (Identifier i _) = return $ text i +id2C :: Bool -> Identifier -> State a Doc +id2C True (Identifier i _) = return $ text i -tvar2C :: Bool -> TypeVarDeclaration -> Reader a Doc +tvar2C :: Bool -> TypeVarDeclaration -> State a Doc tvar2C _ (FunctionDeclaration name returnType params Nothing) = do t <- type2C returnType p <- liftM hcat $ mapM (tvar2C False) params @@ -145,7 +145,7 @@ tvar2C f (OperatorDeclaration op _ ret params body) = tvar2C f (FunctionDeclaration (Identifier ("") Unknown) ret params body) -initExpr2C :: InitExpression -> Reader a Doc +initExpr2C :: InitExpression -> State a Doc initExpr2C (InitBinOp op expr1 expr2) = do e1 <- initExpr2C expr1 e2 <- initExpr2C expr2 @@ -159,7 +159,7 @@ initExpr2C _ = return $ text "<>" -type2C :: TypeDecl -> Reader a Doc +type2C :: TypeDecl -> State a Doc type2C UnknownType = return $ text "void" type2C (String l) = return $ text $ "string" ++ show l type2C (SimpleType i) = id2C True i @@ -173,7 +173,7 @@ type2C (Set t) = return $ text "<>" type2C (FunctionType returnType params) = return $ text "<>" -phrase2C :: Phrase -> Reader a Doc +phrase2C :: Phrase -> State a Doc phrase2C (Phrases p) = do ps <- mapM phrase2C p return $ text "{" $+$ (nest 4 . vcat $ ps) $+$ text "}" @@ -206,7 +206,7 @@ return $ text "switch" <> parens e <> text "of" $+$ (nest 4 . vcat) cs where - case2C :: ([InitExpression], Phrase) -> Reader a Doc + case2C :: ([InitExpression], Phrase) -> State a Doc case2C (e, p) = do ie <- mapM initExpr2C e ph <- phrase2C p @@ -236,7 +236,7 @@ wrapPhrase p = Phrases [p] -expr2C :: Expression -> Reader a Doc +expr2C :: Expression -> State a Doc expr2C (Expression s) = return $ text s expr2C (BinOp op expr1 expr2) = do e1 <- expr2C expr1 @@ -258,7 +258,7 @@ expr2C _ = return $ text "<>" -ref2C :: Reference -> Reader a Doc +ref2C :: Reference -> State a Doc ref2C (ArrayElement exprs ref) = do r <- ref2C ref es <- mapM expr2C exprs @@ -290,7 +290,7 @@ ref2C (RefExpression expr) = expr2C expr -op2C :: String -> Reader a Doc +op2C :: String -> State a Doc op2C "or" = return $ text "|" op2C "and" = return $ text "&" op2C "not" = return $ text "!"