--- 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 ("<op " ++ op ++ ">") 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 "<<expression>>"
-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 "<<set>>"
type2C (FunctionType returnType params) = return $ text "<<function>>"
-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 "<<expression>>"
-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 "!"