--- a/tools/pas2c.hs	Fri Dec 02 15:03:27 2011 +0400
+++ b/tools/pas2c.hs	Mon Dec 05 17:56:49 2011 +0400
@@ -12,6 +12,7 @@
 import Control.Exception
 import System.IO.Error
 import qualified Data.Map as Map
+import Control.Monad.Reader
 
 import PascalParser
 import PascalUnitSyntaxTree
@@ -56,63 +57,74 @@
     hPutStrLn stderr $ "Rendering '" ++ fn ++ "'..."
     toCFiles' p
     where
-    toCFiles' (fn, p@(Program {})) = writeFile (fn ++ ".c") $ (render . pascal2C) p
+    toCFiles' (fn, p@(Program {})) = writeFile (fn ++ ".c") $ (render2C . pascal2C) p
     toCFiles' (fn, (Unit _ interface implementation _ _)) = do
-        writeFile (fn ++ ".h") $ (render . interface2C) interface
-        writeFile (fn ++ ".c") $ (render . implementation2C) implementation
-                            
+        writeFile (fn ++ ".h") $ "#pragma once\n" ++ (render2C . interface2C $ interface)
+        writeFile (fn ++ ".c") $ (render2C . implementation2C) implementation
+
+system :: [(String, String)]
+system = []
+        
+render2C = render . flip runReader system
+
 usesFiles :: PascalUnit -> [String]
 usesFiles (Program _ (Implementation uses _) _) = uses2List uses
 usesFiles (Unit _ (Interface uses1 _) (Implementation uses2 _) _ _) = uses2List uses1 ++ uses2List uses2
 
 
 
-pascal2C :: PascalUnit -> Doc
-pascal2C (Unit _ interface implementation init fin) = 
-    interface2C interface
-    $+$ 
-    implementation2C implementation
-pascal2C (Program _ implementation mainFunction) =
-    implementation2C implementation
-    $+$
-    tvar2C True (FunctionDeclaration (Identifier "main" BTInt) (SimpleType $ Identifier "int" BTInt) [] (Just (TypesAndVars [], mainFunction)))
+pascal2C :: PascalUnit -> Reader a Doc
+pascal2C (Unit _ interface implementation init fin) =
+    liftM2 ($+$) (interface2C interface) (implementation2C implementation)
+    
+pascal2C (Program _ implementation mainFunction) = do
+    impl <- implementation2C implementation
+    main <- tvar2C True 
+        (FunctionDeclaration (Identifier "main" BTInt) (SimpleType $ Identifier "int" BTInt) [] (Just (TypesAndVars [], mainFunction)))
+    return $ impl $+$ main
+
     
     
-interface2C :: Interface -> Doc
-interface2C (Interface uses tvars) = uses2C uses $+$ typesAndVars2C True tvars
+interface2C :: Interface -> Reader a Doc
+interface2C (Interface uses tvars) = liftM2 ($+$) (uses2C uses) (typesAndVars2C True tvars)
 
-implementation2C :: Implementation -> Doc
-implementation2C (Implementation uses tvars) = uses2C uses $+$ typesAndVars2C True tvars
+implementation2C :: Implementation -> Reader a Doc
+implementation2C (Implementation uses tvars) = liftM2 ($+$) (uses2C uses) (typesAndVars2C True tvars)
 
 
-typesAndVars2C :: Bool -> TypesAndVars -> Doc
-typesAndVars2C b (TypesAndVars ts) = vcat $ map (tvar2C b) ts
+typesAndVars2C :: Bool -> TypesAndVars -> Reader a Doc
+typesAndVars2C b (TypesAndVars ts) = liftM vcat $ mapM (tvar2C b) ts
 
-uses2C :: Uses -> Doc
-uses2C uses = vcat $ map (\i -> text $ "#include \"" ++ i ++ ".h\"") $ uses2List uses
+uses2C :: Uses -> Reader 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
 
-tvar2C :: Bool -> TypeVarDeclaration -> Doc
-tvar2C _ (FunctionDeclaration (Identifier name _) returnType params Nothing) = 
-    type2C returnType <+> text name <> parens (hcat $ map (tvar2C False) params) <> text ";"
-tvar2C True (FunctionDeclaration (Identifier name _) returnType params (Just (tvars, phrase))) = 
-    type2C returnType <+> text name <> parens (hcat $ map (tvar2C False) params)
-    $+$
-    text "{" 
-    $+$ nest 4 (
-        typesAndVars2C False tvars
+tvar2C :: Bool -> TypeVarDeclaration -> Reader a Doc
+tvar2C _ (FunctionDeclaration (Identifier name _) returnType params Nothing) = do
+    t <- type2C returnType 
+    p <- liftM hcat $ mapM (tvar2C False) params
+    return $ t <+> text name <> parens p <> text ";"
+tvar2C True (FunctionDeclaration (Identifier name _) returnType params (Just (tvars, phrase))) = do
+    t <- type2C returnType 
+    p <- liftM hcat $ mapM (tvar2C False) params
+    ph <- liftM2 ($+$) (typesAndVars2C False tvars) (phrase2C' phrase)
+    return $ 
+        t <+> text name <> parens p
         $+$
-        phrase2C' phrase
-        )
-    $+$
-    text "}"
+        text "{" 
+        $+$ 
+        nest 4 ph
+        $+$
+        text "}"
     where
-    phrase2C' (Phrases p) = vcat $ map phrase2C p
+    phrase2C' (Phrases p) = liftM vcat $ mapM phrase2C p
     phrase2C' p = phrase2C p
 tvar2C False (FunctionDeclaration (Identifier name _) _ _ _) = error $ "nested functions not allowed: " ++ name
-tvar2C _ (TypeDeclaration (Identifier i _) t) = text "type" <+> text i <+> type2C t <> text ";"
+tvar2C _ (TypeDeclaration (Identifier i _) t) = do
+    tp <- type2C t
+    return $ text "type" <+> text i <+> tp <> text ";"
 tvar2C _ (VarDeclaration isConst (ids, t) mInitExpr) = 
     if isConst then text "const" else empty
     <+>
@@ -129,7 +141,7 @@
 tvar2C f (OperatorDeclaration op _ ret params body) = 
     tvar2C f (FunctionDeclaration (Identifier ("<op " ++ op ++ ">") Unknown) ret params body)
 
-initExpr2C :: InitExpression -> Doc
+initExpr2C :: InitExpression -> Reader a Doc
 initExpr2C (InitBinOp op expr1 expr2) = parens $ (initExpr2C expr1) <+> op2C op <+> (initExpr2C expr2)
 initExpr2C (InitNumber s) = text s
 initExpr2C (InitFloat s) = text s
@@ -140,7 +152,7 @@
 
 initExpr2C _ = text "<<expression>>"
 
-type2C :: TypeDecl -> Doc
+type2C :: TypeDecl -> Reader a Doc
 type2C UnknownType = text "void"
 type2C (String l) = text $ "string" ++ show l
 type2C (SimpleType (Identifier i _)) = text i
@@ -152,7 +164,7 @@
 type2C (Set t) = text "<<set>>"
 type2C (FunctionType returnType params) = text "<<function>>"
 
-phrase2C :: Phrase -> Doc
+phrase2C :: Phrase -> Reader a Doc
 phrase2C (Phrases p) = text "{" $+$ (nest 4 . vcat . map phrase2C $ p) $+$ text "}"
 phrase2C (ProcCall f@(FunCall {}) []) = ref2C f <> semi
 phrase2C (ProcCall ref params) = ref2C ref <> parens (hsep . punctuate (char ',') . map expr2C $ params) <> semi
@@ -179,7 +191,7 @@
 wrapPhrase p = Phrases [p]
 
 
-expr2C :: Expression -> Doc
+expr2C :: Expression -> Reader a Doc
 expr2C (Expression s) = text s
 expr2C (BinOp op expr1 expr2) = parens $ (expr2C expr1) <+> op2C op <+> (expr2C expr2)
 expr2C (NumberLiteral s) = text s
@@ -193,7 +205,7 @@
 expr2C _ = text "<<expression>>"
 
 
-ref2C :: Reference -> Doc
+ref2C :: Reference -> Reader a Doc
 ref2C (ArrayElement exprs ref) = ref2C ref <> (brackets . hcat) (punctuate comma $ map expr2C exprs)
 ref2C (SimpleReference (Identifier name _)) = text name
 ref2C (RecordField (Dereference ref1) ref2) = ref2C ref1 <> text "->" <> ref2C ref2