# HG changeset patch
# User unc0rr
# Date 1391719609 -14400
# Node ID b26c2772e754d143189b544a814850a412e29184
# Parent  459bc720cea19d9103eb60776b9cbda70e07cb81
Fix tons and tons of pas2c warnings (but still not all of them)

diff -r 459bc720cea1 -r b26c2772e754 tools/pas2c/Pas2C.hs
--- a/tools/pas2c/Pas2C.hs	Thu Feb 06 23:02:35 2014 +0400
+++ b/tools/pas2c/Pas2C.hs	Fri Feb 07 00:46:49 2014 +0400
@@ -7,8 +7,6 @@
 import Text.Parsec.Prim hiding (State)
 import Control.Monad.State
 import System.IO
-import System.Directory
-import Control.Monad.IO.Class
 import PascalPreprocessor
 import Control.Exception
 import System.IO.Error
@@ -53,8 +51,10 @@
         namespaces :: Map.Map String Records
     }
 
+rec2Records :: [(String, BaseType)] -> [Record]
 rec2Records = map (\(a, b) -> Record a b empty)
 
+emptyState :: Map.Map String Records -> RenderState
 emptyState = RenderState Map.empty "" BTUnknown False empty [] 0 Set.empty [] "" ""
 
 getUniq :: State RenderState Int
@@ -102,22 +102,22 @@
     renderCFiles s outputPath
     where
     printLn = liftIO . hPutStrLn stdout
-    print = liftIO . hPutStr stdout
+    print' = liftIO . hPutStr stdout
     initState = Map.empty
     f :: String -> StateT (Map.Map String PascalUnit) IO ()
     f fileName = do
         processed <- gets $ Map.member fileName
         unless processed $ do
-            print ("Preprocessing '" ++ fileName ++ ".pas'... ")
+            print' ("Preprocessing '" ++ fileName ++ ".pas'... ")
             fc' <- liftIO
                 $ tryJust (guard . isDoesNotExistError)
                 $ preprocess inputPath alternateInputPath (fileName ++ ".pas") symbols
             case fc' of
-                (Left a) -> do
+                (Left _) -> do
                     modify (Map.insert fileName (System []))
                     printLn "doesn't exist"
                 (Right fc) -> do
-                    print "ok, parsing... "
+                    print' "ok, parsing... "
                     let ptree = parse pascalUnit fileName fc
                     case ptree of
                          (Left a) -> do
@@ -159,16 +159,16 @@
 withState' f sf = do
     st <- liftM f get
     let (a, s) = runState sf st
-    modify(\st -> st{
+    modify(\st' -> st'{
         lastType = lastType s
         , uniqCounter = uniqCounter s
         , stringConsts = stringConsts s
         })
     return a
 
+withLastIdNamespace :: State RenderState Doc -> State RenderState Doc
 withLastIdNamespace f = do
     li <- gets lastIdentifier
-    nss <- gets namespaces
     withState' (\st -> st{currentScope = fromMaybe Map.empty $ Map.lookup li (namespaces st)}) f
 
 withRecordNamespace :: String -> [Record] -> State RenderState Doc -> State RenderState Doc
@@ -178,34 +178,36 @@
         f st = st{currentScope = Map.unionWith un records (currentScope st), currentUnit = ""}
         records = Map.fromList $ map (\(Record a b d) -> (map toLower a, [Record (prefix ++ a) b d])) recs
         un [a] b = a : b
+        un _ _ = error "withRecordNamespace un: pattern not matched"
 
 toCFiles :: String -> Map.Map String Records -> (String, PascalUnit) -> IO ()
 toCFiles _ _ (_, System _) = return ()
 toCFiles _ _ (_, Redo _) = return ()
-toCFiles outputPath ns p@(fn, pu) = do
-    hPutStrLn stdout $ "Rendering '" ++ fn ++ "'..."
-    toCFiles' p
+toCFiles outputPath ns pu@(fileName, _) = do
+    hPutStrLn stdout $ "Rendering '" ++ fileName ++ "'..."
+    toCFiles' pu
     where
     toCFiles' (fn, p@(Program {})) = writeFile (outputPath ++ fn ++ ".c") $ "#include \"fpcrtl.h\"\n" ++ (render2C initialState . pascal2C) p
     toCFiles' (fn, (Unit unitId@(Identifier i _) interface implementation _ _)) = do
         let (a, s) = runState (id2C IOInsert (setBaseType BTUnit unitId) >> interface2C interface True) initialState{currentUnit = map toLower i ++ "_"}
-            (a', s') = runState (id2C IOInsert (setBaseType BTUnit unitId) >> interface2C interface False) initialState{currentUnit = map toLower i ++ "_"}
+            (a', _) = runState (id2C IOInsert (setBaseType BTUnit unitId) >> interface2C interface False) initialState{currentUnit = map toLower i ++ "_"}
             enumDecl = (renderEnum2Strs (enums s) False)
             enumImpl = (renderEnum2Strs (enums s) True)
         writeFile (outputPath ++ fn ++ ".h") $ "#pragma once\n\n#include \"pas2c.h\"\n\n" ++ (render (a $+$ text "")) ++ "\n" ++ enumDecl
         writeFile (outputPath ++ fn ++ ".c") $ "#include \"fpcrtl.h\"\n\n#include \"" ++ fn ++ ".h\"\n" ++ render (a' $+$ text "") ++ (render2C s . implementation2C) implementation ++ "\n" ++ enumImpl
+    toCFiles' _ = undefined -- just pleasing compiler to not warn us
     initialState = emptyState ns
 
     render2C :: RenderState -> State RenderState Doc -> String
     render2C st p =
-        let (a, s) = runState p st in
+        let (a, _) = runState p st in
         render a
 
 renderEnum2Strs :: [(String, [String])] -> Bool -> String
-renderEnum2Strs enums implement =
-    render $ foldl ($+$) empty $ map (\en -> let d = decl (fst en) in if implement then d $+$ enum2strBlock (snd en) else d <> semi) enums
+renderEnum2Strs enums' implement =
+    render $ foldl ($+$) empty $ map (\en -> let d = decl (fst en) in if implement then d $+$ enum2strBlock (snd en) else d <> semi) enums'
     where
-    decl id = text "string255 __attribute__((overloadable)) fpcrtl_GetEnumName" <> parens (text "int dummy, const" <+> text id <+> text "enumvar")
+    decl id' = text "string255 __attribute__((overloadable)) fpcrtl_GetEnumName" <> parens (text "int dummy, const" <+> text id' <+> text "enumvar")
     enum2strBlock en =
             text "{"
             $+$
@@ -230,7 +232,7 @@
 usesFiles (Redo {}) = []
 
 pascal2C :: PascalUnit -> State RenderState Doc
-pascal2C (Unit _ interface implementation init fin) =
+pascal2C (Unit _ interface implementation _ _) =
     liftM2 ($+$) (interface2C interface True) (implementation2C implementation)
 
 pascal2C (Program _ implementation mainFunction) = do
@@ -239,6 +241,7 @@
 
     return $ impl $+$ main
 
+pascal2C _ = error "pascal2C: pattern not matched"
 
 -- the second bool indicates whether do normal interface translation or generate variable declarations
 -- that will be inserted into implementation files
@@ -249,9 +252,9 @@
     r <- renderStringConsts
     return (u $+$ r $+$ tv)
 interface2C (Interface uses tvars) False = do
-    u <- uses2C uses
+    void $ uses2C uses
     tv <- typesAndVars2C True False False tvars
-    r <- renderStringConsts
+    void $ renderStringConsts
     return tv
 
 implementation2C :: Implementation -> State RenderState Doc
@@ -265,6 +268,7 @@
 checkDuplicateFunDecls tvs =
     modify $ \s -> s{toMangle = Map.keysSet . Map.filter (> 1) . foldr ins initMap $ tvs}
     where
+        initMap :: Map.Map String Int
         initMap = Map.empty
         --initMap = Map.fromList [("reset", 2)]
         ins (FunctionDeclaration (Identifier i _) _ _ _ _ _) m = Map.insertWith (+) (map toLower i) 1 m
@@ -297,18 +301,18 @@
 uses2List (Uses ids) = map (\(Identifier i _) -> i) ids
 
 
+setLastIdValues :: Record -> RenderState -> RenderState
 setLastIdValues vv = (\s -> s{lastType = baseType vv, lastIdentifier = lcaseId vv, lastIdTypeDecl = typeDecl vv})
 
 id2C :: InsertOption -> Identifier -> State RenderState Doc
 id2C IOInsert i = id2C (IOInsertWithType empty) i
 id2C (IOInsertWithType d) (Identifier i t) = do
-    ns <- gets currentScope
     tom <- gets (Set.member n . toMangle)
     cu <- gets currentUnit
     let (i', t') = case (t, tom) of
             (BTFunction _ p _, True) -> (cu ++ i ++ ('_' : show (length p)), t)
             (BTFunction _ _ _, _) -> (cu ++ i, t)
-            (BTVarParam t', _) -> ('(' : '*' : i ++ ")" , t')
+            (BTVarParam t'', _) -> ('(' : '*' : i ++ ")" , t'')
             _ -> (i, t)
     modify (\s -> s{currentScope = Map.insertWith (++) n [Record i' t' d] (currentScope s), lastIdentifier = n})
     return $ text i'
@@ -317,7 +321,7 @@
 
 id2C IOLookup i = id2CLookup head i
 id2C IOLookupLast i = id2CLookup last i
-id2C (IOLookupFunction params) (Identifier i t) = do
+id2C (IOLookupFunction params) (Identifier i _) = do
     let i' = map toLower i
     v <- gets $ Map.lookup i' . currentScope
     lt <- gets lastType
@@ -329,7 +333,7 @@
     where
         checkParam (Record _ (BTFunction _ p _) _) = (length p) == params
         checkParam _ = False
-id2C IODeferred (Identifier i t) = do
+id2C IODeferred (Identifier i _) = do
     let i' = map toLower i
     v <- gets $ Map.lookup i' . currentScope
     if (isNothing v) then
@@ -338,7 +342,7 @@
         let vv = head $ fromJust v in modify (setLastIdValues vv) >> (return . text . lcaseId $ vv)
 
 id2CLookup :: ([Record] -> Record) -> Identifier -> State RenderState Doc
-id2CLookup f (Identifier i t) = do
+id2CLookup f (Identifier i _) = do
     let i' = map toLower i
     v <- gets $ Map.lookup i' . currentScope
     lt <- gets lastType
@@ -405,6 +409,7 @@
     where
         f :: TypeVarDeclaration -> State RenderState [(String, BaseType)]
         f (VarDeclaration _ _ (ids, td) _) = mapM (\(Identifier i _) -> liftM ((,) i) $ resolveType td) ids
+        f _ = error "resolveType f: pattern not matched"
 resolveType (ArrayDecl (Just i) t) = do
     t' <- resolveType t
     return $ BTArray i (BTInt True) t'
@@ -444,6 +449,7 @@
     error $ "Dereferencing from non-pointer type " ++ show t ++ "\n" ++ s
 
 
+functionParams2C :: [TypeVarDeclaration] -> State RenderState Doc
 functionParams2C params = liftM (hcat . punctuate comma . concat) $ mapM (tvar2C False False True True) params
 
 numberOfDeclarations :: [TypeVarDeclaration] -> Int
@@ -473,7 +479,7 @@
         ps = zip ['a'..] (toIsVarList params)
 
 fun2C :: Bool -> String -> TypeVarDeclaration -> State RenderState [Doc]
-fun2C _ _ (FunctionDeclaration name inline overload returnType params Nothing) = do
+fun2C _ _ (FunctionDeclaration name _ overload returnType params Nothing) = do
     t <- type2C returnType
     t'<- gets lastType
     bts <- typeVarDecl2BaseType params
@@ -482,7 +488,7 @@
     let decor = if overload then text "__attribute__((overloadable))" else empty
     return [t empty <+> decor <+> text n <> parens p]
 
-fun2C True rv (FunctionDeclaration name@(Identifier i bt) inline overload returnType params (Just (tvars, phrase))) = do
+fun2C True rv (FunctionDeclaration name@(Identifier i _) inline overload returnType params (Just (tvars, phrase))) = do
     let isVoid = case returnType of
             VoidType -> True
             _ -> False
@@ -492,7 +498,7 @@
     t' <- gets lastType
 
     bts <- typeVarDecl2BaseType params
-    cu <- gets currentUnit
+    --cu <- gets currentUnit
     notDeclared <- liftM isNothing . gets $ Map.lookup (map toLower i) . currentScope
 
     n <- liftM render . id2C IOInsert $ setBaseType (BTFunction hasVars bts t') name
@@ -507,7 +513,7 @@
         return (p, ph)
 
     let phrasesBlock = if isVoid then ph else t empty <+> res <> semi $+$ ph $+$ text "return" <+> res <> semi
-    let define = if hasVars then text "#ifndef" <+> text n $+$ funWithVarsToDefine n params $+$ text "#endif" else empty
+    --let define = if hasVars then text "#ifndef" <+> text n $+$ funWithVarsToDefine n params $+$ text "#endif" else empty
     let inlineDecor = if inline then case notDeclared of
                                     True -> text "static inline"
                                     False -> text "inline"
@@ -528,6 +534,7 @@
     phrase2C' (Phrases p) = liftM vcat $ mapM phrase2C p
     phrase2C' p = phrase2C p
     un [a] b = a : b
+    un _ _ = error "fun2C u: pattern not matched"
     hasVars = hasPassByReference params
 
 fun2C False _ (FunctionDeclaration (Identifier name _) _ _ _ _ _) = error $ "nested functions not allowed: " ++ name
@@ -540,13 +547,13 @@
 tvar2C b _ includeType _ f@(FunctionDeclaration (Identifier name _) _ _ _ _ _) = do
     t <- fun2C b name f
     if includeType then return t else return []
-tvar2C _ _ includeType _ td@(TypeDeclaration i' t) = do
+tvar2C _ _ includeType _ (TypeDeclaration i' t) = do
     i <- id2CTyped t i'
     tp <- type2C t
     let res = if includeType then [text "typedef" <+> tp i] else []
     case t of
         (Sequence ids) -> do
-            modify(\s -> s{enums = (render i, map (\(Identifier i _) -> i) ids) : enums s})
+            modify(\s -> s{enums = (render i, map (\(Identifier id' _) -> id') ids) : enums s})
             return res
         _ -> return res
 
@@ -567,15 +574,15 @@
              return $ if includeType then [text "enum" <> braces (i' <+> ie)] else []
          (True, BTFloat, [i], Just e) -> do
              i' <- id2CTyped t i
-             ie <- initExpr2C e
-             return $ if includeType then [text "#define" <+> i' <+> parens ie <> text "\n"] else []
+             ie' <- initExpr2C e
+             return $ if includeType then [text "#define" <+> i' <+> parens ie' <> text "\n"] else []
          (_, BTFunction{}, _, Nothing) -> liftM (map(\i -> t' i)) $ mapM (id2CTyped t) ids
          (_, BTArray r _ _, [i], _) -> do
             i' <- id2CTyped t i
             ie' <- return $ case (r, mInitExpr, ignoreInit) of
                 (RangeInfinite, Nothing, False) -> text "= NULL" -- force dynamic array to be initialized as NULL if not initialized at all
                 (_, _, _) -> ie
-            result <- liftM (map(\i -> varDeclDecision isConst includeType (t' i) ie')) $ mapM (id2CTyped t) ids
+            result <- liftM (map(\id' -> varDeclDecision isConst includeType (t' id') ie')) $ mapM (id2CTyped t) ids
             case (r, ignoreInit) of
                 (RangeInfinite, False) ->
                     -- if the array is dynamic, add dimension info to it
@@ -594,9 +601,10 @@
     varDeclDecision True True varStr expStr = varStr <+> expStr
     varDeclDecision False True varStr expStr = if externVar then varStr else varStr <+> expStr
     varDeclDecision False False varStr expStr = varStr <+> expStr
-    varDeclDecision True False varStr expStr = empty
+    varDeclDecision True False _ _ = empty
     arrayDimension a = case a of
-        ArrayDecl Nothing t -> let a = arrayDimension t in if a > 3 then error "Dynamic array with dimension > 4 is not supported." else 1 + arrayDimension t
+        ArrayDecl Nothing t' -> let a' = arrayDimension t' in 
+                                   if a' > 3 then error "Dynamic array with dimension > 4 is not supported." else 1 + a'
         ArrayDecl _ _ -> error "Mixed dynamic array and static array are not supported."
         _ -> 0
 
@@ -607,7 +615,7 @@
 
 op2CTyped :: String -> [TypeDecl] -> State RenderState Identifier
 op2CTyped op t = do
-    t' <- liftM (render . hcat . punctuate (char '_') . map (\t -> t empty)) $ mapM type2C t
+    t' <- liftM (render . hcat . punctuate (char '_') . map (\txt -> txt empty)) $ mapM type2C t
     bt <- gets lastType
     return $ Identifier (t' ++ "_op_" ++ opStr) bt
     where
@@ -645,7 +653,7 @@
     e2 <- initExpr2C' expr2
     return $ parens $ e1 <+> text (op2C op) <+> e2
 initExpr2C' (InitNumber s) = do
-                                modify(\s -> s{lastType = (BTInt True)})
+                                modify(\st -> st{lastType = (BTInt True)})
                                 return $ text s
 initExpr2C' (InitFloat s) = return $ text s
 initExpr2C' (InitHexNumber s) = return $ text "0x" <> (text . map toLower $ s)
@@ -660,7 +668,7 @@
 --    e <- initExpr2C $ InitRecord fields
 --    return $ braces $ e
 initExpr2C' r@(InitRange (Range i@(Identifier i' _))) = do
-    id2C IOLookup i
+    void $ id2C IOLookup i
     t <- gets lastType
     case t of
          BTEnum s -> return . int $ length s
@@ -672,14 +680,14 @@
 initExpr2C' (InitRange (RangeFromTo (InitChar "0") (InitChar r))) = initExpr2C $ BuiltInFunction "succ" [InitNumber r]
 initExpr2C' (InitRange a) = error $ show a --return $ text "<<range>>"
 initExpr2C' (InitSet []) = return $ text "0"
-initExpr2C' (InitSet a) = return $ text "<<set>>"
+initExpr2C' (InitSet _) = return $ text "<<set>>"
 initExpr2C' (BuiltInFunction "low" [InitReference e]) = return $
     case e of
          (Identifier "LongInt" _) -> int (-2^31)
          (Identifier "SmallInt" _) -> int (-2^15)
          _ -> error $ "BuiltInFunction 'low': " ++ show e
 initExpr2C' (BuiltInFunction "high" [e]) = do
-    initExpr2C e
+    void $ initExpr2C e
     t <- gets lastType
     case t of
          (BTArray i _ _) -> initExpr2C' $ BuiltInFunction "pred" [InitRange i]
@@ -705,7 +713,7 @@
 baseType2C s a = error $ "baseType2C: " ++ show a ++ "\n" ++ s
 
 type2C :: TypeDecl -> State RenderState (Doc -> Doc)
-type2C (SimpleType i) = liftM (\i a -> i <+> a) $ id2C IOLookup i
+type2C (SimpleType i) = liftM (\i' a -> i' <+> a) $ id2C IOLookup i
 type2C t = do
     r <- type2C' t
     rt <- resolveType t
@@ -721,11 +729,11 @@
              BTRecord _ _ -> return $ \a -> text "struct __" <> i' <+> text "*" <+> a
              BTUnknown -> return $ \a -> text "struct __" <> i' <+> text "*" <+> a
              _ -> return $ \a -> i' <+> text "*" <+> a
-    type2C' (PointerTo t) = liftM (\t a -> t (parens $ text "*" <> a)) $ type2C t
+    type2C' (PointerTo t) = liftM (\tx a -> tx (parens $ text "*" <> a)) $ type2C t
     type2C' (RecordType tvs union) = do
-        t <- withState' f $ mapM (tvar2C False False True False) tvs
+        t' <- withState' f $ mapM (tvar2C False False True False) tvs
         u <- unions
-        return $ \i -> text "struct __" <> i <+> lbrace $+$ nest 4 ((vcat . map (<> semi) . concat $ t) $$ u) $+$ rbrace <+> i
+        return $ \i -> text "struct __" <> i <+> lbrace $+$ nest 4 ((vcat . map (<> semi) . concat $ t') $$ u) $+$ rbrace <+> i
         where
             f s = s{currentUnit = ""}
             unions = case union of
@@ -733,9 +741,9 @@
                      Just a -> do
                          structs <- mapM struct2C a
                          return $ text "union" $+$ braces (nest 4 $ vcat structs) <> semi
-            struct2C tvs = do
-                t <- withState' f $ mapM (tvar2C False False True False) tvs
-                return $ text "struct" $+$ braces (nest 4 (vcat . map (<> semi) . concat $ t)) <> semi
+            struct2C stvs = do
+                txts <- withState' f $ mapM (tvar2C False False True False) stvs
+                return $ text "struct" $+$ braces (nest 4 (vcat . map (<> semi) . concat $ txts)) <> semi
     type2C' (RangeType r) = return (text "int" <+>)
     type2C' (Sequence ids) = do
         is <- mapM (id2C IOInsert . setBaseType bt) ids
@@ -768,6 +776,7 @@
         t <- gets lastType
         return (baseType2C (show r) t <+>)
     type2C' (DeriveType a) = error $ "Can't derive type from " ++ show a
+    type2C' a = error $ "type2C: unknown type " ++ show a
 
 phrase2C :: Phrase -> State RenderState Doc
 phrase2C (Phrases p) = do
@@ -775,7 +784,7 @@
     return $ text "{" $+$ (nest 4 . vcat $ ps) $+$ text "}"
 phrase2C (ProcCall f@(FunCall {}) []) = liftM (<> semi) $ ref2C f
 phrase2C (ProcCall ref []) = liftM (<> semi) $ ref2CF ref True
-phrase2C (ProcCall ref params) = error $ "ProcCall"{-do
+phrase2C (ProcCall _ _) = error $ "ProcCall"{-do
     r <- ref2C ref
     ps <- mapM expr2C params
     return $ r <> parens (hsep . punctuate (char ',') $ ps) <> semi -}
@@ -796,7 +805,7 @@
             e <- ref2C r'
             return $ r <+> text "=" <+> e <> semi
         (BTString, _) -> do
-            e <- expr2C expr
+            void $ expr2C expr
             lt <- gets lastType
             case lt of
                 -- assume pointer to char for simplicity
@@ -810,7 +819,7 @@
         (BTArray _ _ _, _) -> do
             case expr of
                 Reference er -> do
-                    exprRef <- ref2C er
+                    void $ ref2C er
                     exprT <- gets lastType
                     case exprT of
                         BTArray RangeInfinite _ _ ->
@@ -904,7 +913,7 @@
 
 expr2C :: Expression -> State RenderState Doc
 expr2C (Expression s) = return $ text s
-expr2C b@(BinOp op expr1 expr2) = do
+expr2C (BinOp op expr1 expr2) = do
     e1 <- expr2C expr1
     t1 <- gets lastType
     e2 <- expr2C expr2
@@ -1006,7 +1015,7 @@
     e' <- liftM (map toLower . render) $ expr2C e
     lt <- gets lastType
     case lt of
-         BTEnum a -> return $ int 0
+         BTEnum _-> return $ int 0
          BTInt _ -> case e' of
                   "longint" -> return $ int (-2147483648)
          BTArray {} -> return $ int 0
diff -r 459bc720cea1 -r b26c2772e754 tools/pas2c/PascalBasics.hs
--- a/tools/pas2c/PascalBasics.hs	Thu Feb 06 23:02:35 2014 +0400
+++ b/tools/pas2c/PascalBasics.hs	Fri Feb 07 00:46:49 2014 +0400
@@ -1,4 +1,4 @@
-{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleContexts, NoMonomorphismRestriction #-}
 module PascalBasics where
 
 import Text.Parsec.Combinator
@@ -7,9 +7,19 @@
 import Text.Parsec.Token
 import Text.Parsec.Language
 import Data.Char
+import Control.Monad
+import Data.Functor.Identity
 
+char' :: Char -> Parsec String u ()
+char' = void . char
+
+string' :: String -> Parsec String u ()
+string' = void . string
+
+builtin :: [String]
 builtin = ["succ", "pred", "low", "high", "ord", "inc", "dec", "exit", "break", "continue", "length"]
 
+pascalLanguageDef :: GenLanguageDef String u Identity
 pascalLanguageDef
     = emptyDef
     { commentStart   = "(*"
@@ -31,40 +41,45 @@
     , caseSensitive  = False
     }
 
-preprocessorSwitch :: Stream s m Char => ParsecT s u m String
+preprocessorSwitch :: Stream String Identity Char => Parsec String u String
 preprocessorSwitch = do
-    try $ string "{$"
+    try $ string' "{$"
     s <- manyTill (noneOf "\n") $ char '}'
     return s
 
+caseInsensitiveString :: Stream String Identity Char => String -> Parsec String u String
 caseInsensitiveString s = do
     mapM_ (\a -> satisfy (\b -> toUpper a == toUpper b)) s <?> s
     return s
 
+pas :: GenTokenParser String u Identity
 pas = patch $ makeTokenParser pascalLanguageDef
     where
     patch tp = tp {stringLiteral = stringL}
 
+comment :: Stream String Identity Char => Parsec String u String
 comment = choice [
         char '{' >> notFollowedBy (char '$') >> manyTill anyChar (try $ char '}')
         , (try $ string "(*") >> manyTill anyChar (try $ string "*)")
         , (try $ string "//") >> manyTill anyChar (try newline)
         ]
 
+comments :: Parsec String u ()
 comments = do
     spaces
     skipMany $ do
-        preprocessorSwitch <|> comment
+        void $ preprocessorSwitch <|> comment
         spaces
 
+stringL :: Parsec String u String
 stringL = do
-    (char '\'')
+    char' '\''
     s <- (many $ noneOf "'")
-    (char '\'')
+    char' '\''
     ss <- many $ do
-        (char '\'')
+        char' '\''
         s' <- (many $ noneOf "'")
-        (char '\'')
+        char' '\''
         return $ '\'' : s'
     comments
     return $ concat (s:ss)
diff -r 459bc720cea1 -r b26c2772e754 tools/pas2c/PascalParser.hs
--- a/tools/pas2c/PascalParser.hs	Thu Feb 06 23:02:35 2014 +0400
+++ b/tools/pas2c/PascalParser.hs	Fri Feb 07 00:46:49 2014 +0400
@@ -1,13 +1,11 @@
-module PascalParser where
+module PascalParser (
+    pascalUnit
+    )
+    where
 
 import Text.Parsec
-import Text.Parsec.Char
 import Text.Parsec.Token
-import Text.Parsec.Language
 import Text.Parsec.Expr
-import Text.Parsec.Prim
-import Text.Parsec.Combinator
-import Text.Parsec.String
 import Control.Monad
 import Data.Maybe
 import Data.Char
@@ -15,24 +13,28 @@
 import PascalBasics
 import PascalUnitSyntaxTree
 
+knownTypes :: [String]
 knownTypes = ["shortstring", "ansistring", "char", "byte"]
 
+pascalUnit :: Parsec String u PascalUnit
 pascalUnit = do
     comments
     u <- choice [program, unit, systemUnit, redoUnit]
     comments
     return u
 
+iD :: Parsec String u Identifier
 iD = do
     i <- identifier pas
     comments
     when (i == "not") $ unexpected "'not' used as an identifier"
     return $ Identifier i BTUnknown
 
+unit :: Parsec String u PascalUnit
 unit = do
-    string "unit" >> comments
+    string' "unit" >> comments
     name <- iD
-    semi pas
+    void $ semi pas
     comments
     int <- interface
     impl <- implementation
@@ -40,12 +42,13 @@
     return $ Unit name int impl Nothing Nothing
 
 
+reference :: Parsec String u Reference
 reference = buildExpressionParser table term <?> "reference"
     where
     term = comments >> choice [
         parens pas (liftM RefExpression expression >>= postfixes) >>= postfixes
         , try $ typeCast >>= postfixes
-        , char '@' >> liftM Address reference >>= postfixes
+        , char' '@' >> liftM Address reference >>= postfixes
         , liftM SimpleReference iD >>= postfixes
         ] <?> "simple reference"
 
@@ -55,9 +58,9 @@
     postfixes r = many postfix >>= return . foldl (flip ($)) r
     postfix = choice [
             parens pas (option [] parameters) >>= return . FunCall
-          , char '^' >> return Dereference
+          , char' '^' >> return Dereference
           , (brackets pas) (commaSep1 pas $ expression) >>= return . ArrayElement
-          , (char '.' >> notFollowedBy (char '.')) >> liftM (flip RecordField) reference
+          , (char' '.' >> notFollowedBy (char' '.')) >> liftM (flip RecordField) reference
         ]
 
     typeCast = do
@@ -66,12 +69,23 @@
         comments
         return $ TypeCast (Identifier t BTUnknown) e
 
+varsDecl1, varsDecl :: Bool -> Parsec String u [TypeVarDeclaration]
 varsDecl1 = varsParser sepEndBy1
 varsDecl = varsParser sepEndBy
+
+varsParser ::
+    (Parsec String u TypeVarDeclaration
+        -> Parsec String u String
+        -> Parsec
+            String u [TypeVarDeclaration])
+    -> Bool
+    -> Parsec
+            String u [TypeVarDeclaration]
 varsParser m endsWithSemi = do
     vs <- m (aVarDecl endsWithSemi) (semi pas)
     return vs
 
+aVarDecl :: Bool -> Parsec String u TypeVarDeclaration
 aVarDecl endsWithSemi = do
     isVar <- liftM (== Just "var") $
         if not endsWithSemi then
@@ -85,20 +99,20 @@
     comments
     ids <- do
         i <- (commaSep1 pas) $ (try iD <?> "variable declaration")
-        char ':'
+        char' ':'
         return i
     comments
     t <- typeDecl <?> "variable type declaration"
     comments
-    init <- option Nothing $ do
-        char '='
+    initialization <- option Nothing $ do
+        char' '='
         comments
         e <- initExpression
         comments
         return (Just e)
-    return $ VarDeclaration isVar False (ids, t) init
+    return $ VarDeclaration isVar False (ids, t) initialization
 
-
+constsDecl :: Parsec String u [TypeVarDeclaration]
 constsDecl = do
     vs <- many1 (try (aConstDecl >>= \i -> semi pas >> return i) >>= \i -> comments >> return i)
     comments
@@ -108,22 +122,23 @@
         comments
         i <- iD
         t <- optionMaybe $ do
-            char ':'
+            char' ':'
             comments
             t <- typeDecl
             comments
             return t
-        char '='
+        char' '='
         comments
         e <- initExpression
         comments
         return $ VarDeclaration False (isNothing t) ([i], fromMaybe (DeriveType e) t) (Just e)
 
+typeDecl :: Parsec String u TypeDecl
 typeDecl = choice [
-    char '^' >> typeDecl >>= return . PointerTo
-    , try (string "shortstring") >> return String
-    , try (string "string") >> optionMaybe (brackets pas $ integer pas) >> return String
-    , try (string "ansistring") >> optionMaybe (brackets pas $ integer pas) >> return String
+    char' '^' >> typeDecl >>= return . PointerTo
+    , try (string' "shortstring") >> return String
+    , try (string' "string") >> optionMaybe (brackets pas $ integer pas) >> return String
+    , try (string' "ansistring") >> optionMaybe (brackets pas $ integer pas) >> return String
     , arrayDecl
     , recordDecl
     , setDecl
@@ -135,16 +150,16 @@
     where
     arrayDecl = do
         try $ do
-            optional $ (try $ string "packed") >> comments
-            string "array"
+            optional $ (try $ string' "packed") >> comments
+            string' "array"
         comments
         r <- option [] $ do
-            char '['
+            char' '['
             r <- commaSep pas rangeDecl
-            char ']'
+            char' ']'
             comments
             return r
-        string "of"
+        string' "of"
         comments
         t <- typeDecl
         if null r then
@@ -153,67 +168,69 @@
             return $ foldr (\a b -> ArrayDecl (Just a) b) (ArrayDecl (Just $ head r) t) (tail r)
     recordDecl = do
         try $ do
-            optional $ (try $ string "packed") >> comments
-            string "record"
+            optional $ (try $ string' "packed") >> comments
+            string' "record"
         comments
         vs <- varsDecl True
         union <- optionMaybe $ do
-            string "case"
+            string' "case"
             comments
-            iD
+            void $ iD
             comments
-            string "of"
+            string' "of"
             comments
             many unionCase
-        string "end"
+        string' "end"
         return $ RecordType vs union
     setDecl = do
-        try $ string "set" >> space
+        try $ string' "set" >> void space
         comments
-        string "of"
+        string' "of"
         comments
         liftM Set typeDecl
     unionCase = do
-        try $ commaSep pas $ (iD >> return ()) <|> (integer pas >> return ())
-        char ':'
+        void $ try $ commaSep pas $ (void $ iD) <|> (void $ integer pas)
+        char' ':'
         comments
         u <- parens pas $ varsDecl True
-        char ';'
+        char' ';'
         comments
         return u
-    sequenceDecl = (parens pas) $ (commaSep pas) (iD >>= \i -> optional (spaces >> char '=' >> spaces >> integer pas) >> return i)
+    sequenceDecl = (parens pas) $ (commaSep pas) (iD >>= \i -> optional (spaces >> char' '=' >> spaces >> integer pas) >> return i)
     functionType = do
         fp <- try (string "function") <|> try (string "procedure")
         comments
         vs <- option [] $ parens pas $ varsDecl False
         comments
         ret <- if (fp == "function") then do
-            char ':'
+            char' ':'
             comments
             ret <- typeDecl
             comments
             return ret
             else
             return VoidType
-        optional $ try $ char ';' >> comments >> string "cdecl"
+        optional $ try $ char' ';' >> comments >> string' "cdecl"
         comments
         return $ FunctionType ret vs
 
+typesDecl :: Parsec String u [TypeVarDeclaration]
 typesDecl = many (aTypeDecl >>= \t -> comments >> return t)
     where
     aTypeDecl = do
         i <- try $ do
             i <- iD <?> "type declaration"
             comments
-            char '='
+            char' '='
             return i
         comments
         t <- typeDecl
         comments
-        semi pas
+        void $ semi pas
         comments
         return $ TypeDeclaration i t
 
+rangeDecl :: Parsec String u Range
 rangeDecl = choice [
     try $ rangeft
     , iD >>= return . Range
@@ -221,10 +238,11 @@
     where
     rangeft = do
     e1 <- initExpression
-    string ".."
+    string' ".."
     e2 <- initExpression
     return $ RangeFromTo e1 e2
 
+typeVarDeclaration :: Bool -> Parsec String u [TypeVarDeclaration]
 typeVarDeclaration isImpl = (liftM concat . many . choice) [
     varSection,
     constSection,
@@ -245,28 +263,28 @@
                     _ -> error ("checkInit:\n" ++ (show v))) v
 
     varSection = do
-        try $ string "var"
+        try $ string' "var"
         comments
         v <- varsDecl1 True <?> "variable declaration"
         comments
         return $ fixInit v
 
     constSection = do
-        try $ string "const"
+        try $ string' "const"
         comments
         c <- constsDecl <?> "const declaration"
         comments
         return $ fixInit c
 
     typeSection = do
-        try $ string "type"
+        try $ string' "type"
         comments
         t <- typesDecl <?> "type declaration"
         comments
         return t
 
     operatorDecl = do
-        try $ string "operator"
+        try $ string' "operator"
         comments
         i <- manyTill anyChar space
         comments
@@ -274,14 +292,15 @@
         comments
         rid <- iD
         comments
-        char ':'
+        char' ':'
         comments
         ret <- typeDecl
         comments
-        return ret
-        char ';'
+        -- return ret
+        -- ^^^^^^^^^^ wth was this???
+        char' ';'
         comments
-        forward <- liftM isJust $ optionMaybe (try (string "forward;") >> comments)
+        forward <- liftM isJust $ optionMaybe (try (string' "forward;") >> comments)
         inline <- liftM (any (== "inline;")) $ many functionDecorator
         b <- if isImpl && (not forward) then
                 liftM Just functionBody
@@ -297,14 +316,14 @@
         vs <- option [] $ parens pas $ varsDecl False
         comments
         ret <- if (fp == "function") then do
-            char ':'
+            char' ':'
             comments
             ret <- typeDecl
             comments
             return ret
             else
             return VoidType
-        char ';'
+        char' ';'
         comments
         forward <- liftM isJust $ optionMaybe (try (string "forward;") >> comments)
         decorators <- many functionDecorator
@@ -323,17 +342,18 @@
             , try $ string "overload;"
             , try $ string "export;"
             , try $ string "varargs;"
-            , try (string "external") >> comments >> iD >> optional (string "name" >> comments >> stringLiteral pas)>> string ";"
+            , try (string' "external") >> comments >> iD >> optional (string' "name" >> comments >> stringLiteral pas) >> string' ";" >> return "external"
             ]
         comments
         return d
 
 
+program :: Parsec String u PascalUnit
 program = do
-    string "program"
+    string' "program"
     comments
     name <- iD
-    (char ';')
+    (char' ';')
     comments
     comments
     u <- uses
@@ -342,12 +362,13 @@
     comments
     p <- phrase
     comments
-    char '.'
+    char' '.'
     comments
     return $ Program name (Implementation u (TypesAndVars tv)) p
 
+interface :: Parsec String u Interface
 interface = do
-    string "interface"
+    string' "interface"
     comments
     u <- uses
     comments
@@ -355,84 +376,88 @@
     comments
     return $ Interface u (TypesAndVars tv)
 
+implementation :: Parsec String u Implementation
 implementation = do
-    string "implementation"
+    string' "implementation"
     comments
     u <- uses
     comments
     tv <- typeVarDeclaration True
-    string "end."
+    string' "end."
     comments
     return $ Implementation u (TypesAndVars tv)
 
+expression :: Parsec String u Expression
 expression = do
     buildExpressionParser table term <?> "expression"
     where
     term = comments >> choice [
         builtInFunction expression >>= \(n, e) -> return $ BuiltInFunCall e (SimpleReference (Identifier n BTUnknown))
-        , try (parens pas $ expression >>= \e -> notFollowedBy (comments >> char '.') >> return e)
+        , try (parens pas $ expression >>= \e -> notFollowedBy (comments >> char' '.') >> return e)
         , brackets pas (commaSep pas iD) >>= return . SetExpression
-        , try $ integer pas >>= \i -> notFollowedBy (char '.') >> (return . NumberLiteral . show) i
+        , try $ integer pas >>= \i -> notFollowedBy (char' '.') >> (return . NumberLiteral . show) i
         , float pas >>= return . FloatLiteral . show
         , try $ integer pas >>= return . NumberLiteral . show
-        , try (string "_S" >> stringLiteral pas) >>= return . StringLiteral
-        , try (string "_P" >> stringLiteral pas) >>= return . PCharLiteral
+        , try (string' "_S" >> stringLiteral pas) >>= return . StringLiteral
+        , try (string' "_P" >> stringLiteral pas) >>= return . PCharLiteral
         , stringLiteral pas >>= return . strOrChar
-        , try (string "#$") >> many hexDigit >>= \c -> comments >> return (HexCharCode c)
-        , char '#' >> many digit >>= \c -> comments >> return (CharCode c)
-        , char '$' >> many hexDigit >>=  \h -> comments >> return (HexNumber h)
-        --, char '-' >> expression >>= return . PrefixOp "-"
-        , char '-' >> reference >>= return . PrefixOp "-" . Reference
-        , (try $ string "not" >> notFollowedBy comments) >> unexpected "'not'"
-        , try $ string "nil" >> return Null
+        , try (string' "#$") >> many hexDigit >>= \c -> comments >> return (HexCharCode c)
+        , char' '#' >> many digit >>= \c -> comments >> return (CharCode c)
+        , char' '$' >> many hexDigit >>=  \h -> comments >> return (HexNumber h)
+        --, char' '-' >> expression >>= return . PrefixOp "-"
+        , char' '-' >> reference >>= return . PrefixOp "-" . Reference
+        , (try $ string' "not" >> notFollowedBy comments) >> unexpected "'not'"
+        , try $ string' "nil" >> return Null
         , reference >>= return . Reference
         ] <?> "simple expression"
 
     table = [
           [  Prefix (reservedOp pas "not">> return (PrefixOp "not"))
-           , Prefix (try (char '-') >> return (PrefixOp "-"))]
+           , Prefix (try (char' '-') >> return (PrefixOp "-"))]
            ,
-          [  Infix (char '*' >> return (BinOp "*")) AssocLeft
-           , Infix (char '/' >> return (BinOp "/")) AssocLeft
-           , Infix (try (string "div") >> return (BinOp "div")) AssocLeft
-           , Infix (try (string "mod") >> return (BinOp "mod")) AssocLeft
-           , Infix (try (string "in") >> return (BinOp "in")) AssocNone
-           , Infix (try $ string "and" >> return (BinOp "and")) AssocLeft
-           , Infix (try $ string "shl" >> return (BinOp "shl")) AssocLeft
-           , Infix (try $ string "shr" >> return (BinOp "shr")) AssocLeft
+          [  Infix (char' '*' >> return (BinOp "*")) AssocLeft
+           , Infix (char' '/' >> return (BinOp "/")) AssocLeft
+           , Infix (try (string' "div") >> return (BinOp "div")) AssocLeft
+           , Infix (try (string' "mod") >> return (BinOp "mod")) AssocLeft
+           , Infix (try (string' "in") >> return (BinOp "in")) AssocNone
+           , Infix (try $ string' "and" >> return (BinOp "and")) AssocLeft
+           , Infix (try $ string' "shl" >> return (BinOp "shl")) AssocLeft
+           , Infix (try $ string' "shr" >> return (BinOp "shr")) AssocLeft
           ]
-        , [  Infix (char '+' >> return (BinOp "+")) AssocLeft
-           , Infix (char '-' >> return (BinOp "-")) AssocLeft
-           , Infix (try $ string "or" >> return (BinOp "or")) AssocLeft
-           , Infix (try $ string "xor" >> return (BinOp "xor")) AssocLeft
+        , [  Infix (char' '+' >> return (BinOp "+")) AssocLeft
+           , Infix (char' '-' >> return (BinOp "-")) AssocLeft
+           , Infix (try $ string' "or" >> return (BinOp "or")) AssocLeft
+           , Infix (try $ string' "xor" >> return (BinOp "xor")) AssocLeft
           ]
-        , [  Infix (try (string "<>") >> return (BinOp "<>")) AssocNone
-           , Infix (try (string "<=") >> return (BinOp "<=")) AssocNone
-           , Infix (try (string ">=") >> return (BinOp ">=")) AssocNone
-           , Infix (char '<' >> return (BinOp "<")) AssocNone
-           , Infix (char '>' >> return (BinOp ">")) AssocNone
+        , [  Infix (try (string' "<>") >> return (BinOp "<>")) AssocNone
+           , Infix (try (string' "<=") >> return (BinOp "<=")) AssocNone
+           , Infix (try (string' ">=") >> return (BinOp ">=")) AssocNone
+           , Infix (char' '<' >> return (BinOp "<")) AssocNone
+           , Infix (char' '>' >> return (BinOp ">")) AssocNone
           ]
-        {-, [  Infix (try $ string "shl" >> return (BinOp "shl")) AssocNone
-             , Infix (try $ string "shr" >> return (BinOp "shr")) AssocNone
+        {-, [  Infix (try $ string' "shl" >> return (BinOp "shl")) AssocNone
+             , Infix (try $ string' "shr" >> return (BinOp "shr")) AssocNone
           ]
         , [
-             Infix (try $ string "or" >> return (BinOp "or")) AssocLeft
-           , Infix (try $ string "xor" >> return (BinOp "xor")) AssocLeft
+             Infix (try $ string' "or" >> return (BinOp "or")) AssocLeft
+           , Infix (try $ string' "xor" >> return (BinOp "xor")) AssocLeft
           ]-}
         , [
-             Infix (char '=' >> return (BinOp "=")) AssocNone
+             Infix (char' '=' >> return (BinOp "=")) AssocNone
           ]
         ]
     strOrChar [a] = CharCode . show . ord $ a
     strOrChar a = StringLiteral a
 
+phrasesBlock :: Parsec String u Phrase
 phrasesBlock = do
-    try $ string "begin"
+    try $ string' "begin"
     comments
-    p <- manyTill phrase (try $ string "end" >> notFollowedBy alphaNum)
+    p <- manyTill phrase (try $ string' "end" >> notFollowedBy alphaNum)
     comments
     return $ Phrases p
 
+phrase :: Parsec String u Phrase
 phrase = do
     o <- choice [
         phrasesBlock
@@ -442,68 +467,73 @@
         , switchCase
         , withBlock
         , forCycle
-        , (try $ reference >>= \r -> string ":=" >> return r) >>= \r -> comments >> expression >>= return . Assignment r
+        , (try $ reference >>= \r -> string' ":=" >> return r) >>= \r -> comments >> expression >>= return . Assignment r
         , builtInFunction expression >>= \(n, e) -> return $ BuiltInFunctionCall e (SimpleReference (Identifier n BTUnknown))
         , procCall
-        , char ';' >> comments >> return NOP
+        , char' ';' >> comments >> return NOP
         ]
-    optional $ char ';'
+    optional $ char' ';'
     comments
     return o
 
+ifBlock :: Parsec String u Phrase
 ifBlock = do
     try $ string "if" >> notFollowedBy (alphaNum <|> char '_')
     comments
     e <- expression
     comments
-    string "then"
+    string' "then"
     comments
     o1 <- phrase
     comments
     o2 <- optionMaybe $ do
-        try $ string "else" >> space
+        try $ string' "else" >> void space
         comments
         o <- option NOP phrase
         comments
         return o
     return $ IfThenElse e o1 o2
 
+whileCycle :: Parsec String u Phrase
 whileCycle = do
-    try $ string "while"
+    try $ string' "while"
     comments
     e <- expression
     comments
-    string "do"
+    string' "do"
     comments
     o <- phrase
     return $ WhileCycle e o
 
+withBlock :: Parsec String u Phrase
 withBlock = do
-    try $ string "with" >> space
+    try $ string' "with" >> void space
     comments
     rs <- (commaSep1 pas) reference
     comments
-    string "do"
+    string' "do"
     comments
     o <- phrase
     return $ foldr WithBlock o rs
 
+repeatCycle :: Parsec String u Phrase
 repeatCycle = do
-    try $ string "repeat" >> space
+    try $ string' "repeat" >> void space
     comments
     o <- many phrase
-    string "until"
+    string' "until"
     comments
     e <- expression
     comments
     return $ RepeatCycle e o
 
+forCycle :: Parsec String u Phrase
 forCycle = do
-    try $ string "for" >> space
+    try $ string' "for" >> void space
     comments
     i <- iD
     comments
-    string ":="
+    string' ":="
     comments
     e1 <- expression
     comments
@@ -512,84 +542,90 @@
                 try $ string "to"
                 , try $ string "downto"
                 ]
-    --choice [string "to", string "downto"]
+    --choice [string' "to", string' "downto"]
     comments
     e2 <- expression
     comments
-    string "do"
+    string' "do"
     comments
     p <- phrase
     comments
     return $ ForCycle i e1 e2 p up
 
+switchCase :: Parsec String u Phrase
 switchCase = do
-    try $ string "case"
+    try $ string' "case"
     comments
     e <- expression
     comments
-    string "of"
+    string' "of"
     comments
     cs <- many1 aCase
     o2 <- optionMaybe $ do
-        try $ string "else" >> notFollowedBy alphaNum
+        try $ string' "else" >> notFollowedBy alphaNum
         comments
         o <- many phrase
         comments
         return o
-    string "end"
+    string' "end"
     comments
     return $ SwitchCase e cs o2
     where
     aCase = do
         e <- (commaSep pas) $ (liftM InitRange rangeDecl <|> initExpression)
         comments
-        char ':'
+        char' ':'
         comments
         p <- phrase
         comments
         return (e, p)
 
+procCall :: Parsec String u Phrase
 procCall = do
     r <- reference
     p <- option [] $ (parens pas) parameters
     return $ ProcCall r p
 
+parameters :: Parsec String u [Expression]
 parameters = (commaSep pas) expression <?> "parameters"
 
+functionBody :: Parsec String u (TypesAndVars, Phrase)
 functionBody = do
     tv <- typeVarDeclaration True
     comments
     p <- phrasesBlock
-    char ';'
+    char' ';'
     comments
     return (TypesAndVars tv, p)
 
+uses :: Parsec String u Uses
 uses = liftM Uses (option [] u)
     where
         u = do
-            string "uses"
+            string' "uses"
             comments
-            u <- (iD >>= \i -> comments >> return i) `sepBy1` (char ',' >> comments)
-            char ';'
+            ulist <- (iD >>= \i -> comments >> return i) `sepBy1` (char' ',' >> comments)
+            char' ';'
             comments
-            return u
+            return ulist
 
+initExpression :: Parsec String u InitExpression
 initExpression = buildExpressionParser table term <?> "initialization expression"
     where
     term = comments >> choice [
         liftM (uncurry BuiltInFunction) $ builtInFunction initExpression
         , try $ brackets pas (commaSep pas $ initExpression) >>= return . InitSet
         , try $ parens pas (commaSep pas $ initExpression) >>= \ia -> when ((notRecord $ head ia) && (null $ tail ia)) mzero >> return (InitArray ia)
-        , try $ parens pas (sepEndBy recField (char ';' >> comments)) >>= return . InitRecord
+        , try $ parens pas (sepEndBy recField (char' ';' >> comments)) >>= return . InitRecord
         , parens pas initExpression
-        , try $ integer pas >>= \i -> notFollowedBy (char '.') >> (return . InitNumber . show) i
+        , try $ integer pas >>= \i -> notFollowedBy (char' '.') >> (return . InitNumber . show) i
         , try $ float pas >>= return . InitFloat . show
         , try $ integer pas >>= return . InitNumber . show
         , stringLiteral pas >>= return . InitString
-        , char '#' >> many digit >>= \c -> comments >> return (InitChar c)
-        , char '$' >> many hexDigit >>= \h -> comments >> return (InitHexNumber h)
-        , char '@' >> initExpression >>= \c -> comments >> return (InitAddress c)
-        , try $ string "nil" >> return InitNull
+        , char' '#' >> many digit >>= \c -> comments >> return (InitChar c)
+        , char' '$' >> many hexDigit >>= \h -> comments >> return (InitHexNumber h)
+        , char' '@' >> initExpression >>= \c -> comments >> return (InitAddress c)
+        , try $ string' "nil" >> return InitNull
         , itypeCast
         , iD >>= return . InitReference
         ]
@@ -600,7 +636,7 @@
     recField = do
         i <- iD
         spaces
-        char ':'
+        char' ':'
         spaces
         e <- initExpression
         spaces
@@ -608,37 +644,37 @@
 
     table = [
           [
-             Prefix (char '-' >> return (InitPrefixOp "-"))
-            ,Prefix (try (string "not") >> return (InitPrefixOp "not"))
+             Prefix (char' '-' >> return (InitPrefixOp "-"))
+            ,Prefix (try (string' "not") >> return (InitPrefixOp "not"))
           ]
-        , [  Infix (char '*' >> return (InitBinOp "*")) AssocLeft
-           , Infix (char '/' >> return (InitBinOp "/")) AssocLeft
-           , Infix (try (string "div") >> return (InitBinOp "div")) AssocLeft
-           , Infix (try (string "mod") >> return (InitBinOp "mod")) AssocLeft
-           , Infix (try $ string "and" >> return (InitBinOp "and")) AssocLeft
-           , Infix (try $ string "shl" >> return (InitBinOp "shl")) AssocNone
-           , Infix (try $ string "shr" >> return (InitBinOp "shr")) AssocNone
+        , [  Infix (char' '*' >> return (InitBinOp "*")) AssocLeft
+           , Infix (char' '/' >> return (InitBinOp "/")) AssocLeft
+           , Infix (try (string' "div") >> return (InitBinOp "div")) AssocLeft
+           , Infix (try (string' "mod") >> return (InitBinOp "mod")) AssocLeft
+           , Infix (try $ string' "and" >> return (InitBinOp "and")) AssocLeft
+           , Infix (try $ string' "shl" >> return (InitBinOp "shl")) AssocNone
+           , Infix (try $ string' "shr" >> return (InitBinOp "shr")) AssocNone
           ]
-        , [  Infix (char '+' >> return (InitBinOp "+")) AssocLeft
-           , Infix (char '-' >> return (InitBinOp "-")) AssocLeft
-           , Infix (try $ string "or" >> return (InitBinOp "or")) AssocLeft
-           , Infix (try $ string "xor" >> return (InitBinOp "xor")) AssocLeft
+        , [  Infix (char' '+' >> return (InitBinOp "+")) AssocLeft
+           , Infix (char' '-' >> return (InitBinOp "-")) AssocLeft
+           , Infix (try $ string' "or" >> return (InitBinOp "or")) AssocLeft
+           , Infix (try $ string' "xor" >> return (InitBinOp "xor")) AssocLeft
           ]
-        , [  Infix (try (string "<>") >> return (InitBinOp "<>")) AssocNone
-           , Infix (try (string "<=") >> return (InitBinOp "<=")) AssocNone
-           , Infix (try (string ">=") >> return (InitBinOp ">=")) AssocNone
-           , Infix (char '<' >> return (InitBinOp "<")) AssocNone
-           , Infix (char '>' >> return (InitBinOp ">")) AssocNone
-           , Infix (char '=' >> return (InitBinOp "=")) AssocNone
+        , [  Infix (try (string' "<>") >> return (InitBinOp "<>")) AssocNone
+           , Infix (try (string' "<=") >> return (InitBinOp "<=")) AssocNone
+           , Infix (try (string' ">=") >> return (InitBinOp ">=")) AssocNone
+           , Infix (char' '<' >> return (InitBinOp "<")) AssocNone
+           , Infix (char' '>' >> return (InitBinOp ">")) AssocNone
+           , Infix (char' '=' >> return (InitBinOp "=")) AssocNone
           ]
-        {--, [  Infix (try $ string "and" >> return (InitBinOp "and")) AssocLeft
-           , Infix (try $ string "or" >> return (InitBinOp "or")) AssocLeft
-           , Infix (try $ string "xor" >> return (InitBinOp "xor")) AssocLeft
+        {--, [  Infix (try $ string' "and" >> return (InitBinOp "and")) AssocLeft
+           , Infix (try $ string' "or" >> return (InitBinOp "or")) AssocLeft
+           , Infix (try $ string' "xor" >> return (InitBinOp "xor")) AssocLeft
           ]
-        , [  Infix (try $ string "shl" >> return (InitBinOp "shl")) AssocNone
-           , Infix (try $ string "shr" >> return (InitBinOp "shr")) AssocNone
+        , [  Infix (try $ string' "shl" >> return (InitBinOp "shl")) AssocNone
+           , Infix (try $ string' "shr" >> return (InitBinOp "shr")) AssocNone
           ]--}
-        --, [Prefix (try (string "not") >> return (InitPrefixOp "not"))]
+        --, [Prefix (try (string' "not") >> return (InitPrefixOp "not"))]
         ]
 
     itypeCast = do
@@ -647,6 +683,7 @@
         comments
         return $ InitTypeCast (Identifier t BTUnknown) i
 
+builtInFunction :: Parsec String u a -> Parsec String u (String, [a])
 builtInFunction e = do
     name <- choice $ map (\s -> try $ caseInsensitiveString s >>= \i -> notFollowedBy alphaNum >> return i) builtin
     spaces
@@ -654,23 +691,25 @@
     spaces
     return (name, exprs)
 
+systemUnit :: Parsec String u PascalUnit
 systemUnit = do
-    string "system;"
+    string' "system;"
     comments
-    string "type"
+    string' "type"
     comments
     t <- typesDecl
-    string "var"
+    string' "var"
     v <- varsDecl True
     return $ System (t ++ v)
 
+redoUnit :: Parsec String u PascalUnit
 redoUnit = do
-    string "redo;"
+    string' "redo;"
     comments
-    string "type"
+    string' "type"
     comments
     t <- typesDecl
-    string "var"
+    string' "var"
     v <- varsDecl True
     return $ Redo (t ++ v)
 
diff -r 459bc720cea1 -r b26c2772e754 tools/pas2c/PascalPreprocessor.hs
--- a/tools/pas2c/PascalPreprocessor.hs	Thu Feb 06 23:02:35 2014 +0400
+++ b/tools/pas2c/PascalPreprocessor.hs	Fri Feb 07 00:46:49 2014 +0400
@@ -7,10 +7,16 @@
 import System.IO
 import qualified Data.Map as Map
 import Control.Exception(catch, IOException)
-import Data.Char
-import Prelude hiding (catch)
+import Prelude
+
+char' :: Char -> ParsecT String u IO ()
+char' = void . char
+
+string' :: String -> ParsecT String u IO ()
+string' = void . string
 
 -- comments are removed
+comment :: ParsecT String u IO String
 comment = choice [
         char '{' >> notFollowedBy (char '$') >> manyTill anyChar (try $ char '}') >> return ""
         , (try $ string "(*") >> manyTill anyChar (try $ string "*)") >> return ""
@@ -27,8 +33,8 @@
          (Right a) -> return a
 
     where
-    preprocessFile fn = do
-        f <- liftIO (readFile fn)
+    preprocessFile fn' = do
+        f <- liftIO (readFile fn')
         setInput f
         preprocessor
 
@@ -54,7 +60,7 @@
         return $ c:s
 
     switch = do
-        try $ string "{$"
+        try $ string' "{$"
         s <- choice [
             include
             , ifdef
@@ -67,14 +73,14 @@
         return s
 
     include = do
-        try $ string "INCLUDE"
+        try $ string' "INCLUDE"
         spaces
-        (char '"')
-        fn <- many1 $ noneOf "\"\n"
-        char '"'
+        (char' '"')
+        ifn <- many1 $ noneOf "\"\n"
+        char' '"'
         spaces
-        char '}'
-        f <- liftIO (readFile (inputPath ++ fn) `catch` (\(exc :: IOException) -> readFile (alternateInputPath ++ fn) `catch` (\(_ :: IOException) -> error ("File not found: " ++ fn))))
+        char' '}'
+        f <- liftIO (readFile (inputPath ++ ifn) `catch` (\(_ :: IOException) -> readFile (alternateInputPath ++ ifn) `catch` (\(_ :: IOException) -> error ("File not found: " ++ fn))))
         c <- getInput
         setInput $ f ++ c
         return ""
@@ -86,7 +92,7 @@
         spaces
         d <- identifier
         spaces
-        char '}'
+        char' '}'
 
         updateState $ \(m, b) ->
             (m, (f $ d `Map.member` m) : b)
@@ -94,9 +100,9 @@
         return ""
 
     if' = do
-        s <- try (string "IF" >> notFollowedBy alphaNum)
+        try (string' "IF" >> notFollowedBy alphaNum)
 
-        manyTill anyChar (char '}')
+        void $ manyTill anyChar (char' '}')
         --char '}'
 
         updateState $ \(m, b) ->
@@ -105,19 +111,19 @@
         return ""
 
     elseSwitch = do
-        try $ string "ELSE}"
+        try $ string' "ELSE}"
         updateState $ \(m, b:bs) -> (m, (not b):bs)
         return ""
     endIf = do
-        try $ string "ENDIF}"
-        updateState $ \(m, b:bs) -> (m, bs)
+        try $ string' "ENDIF}"
+        updateState $ \(m, _:bs) -> (m, bs)
         return ""
     define = do
-        try $ string "DEFINE"
+        try $ string' "DEFINE"
         spaces
         i <- identifier
         d <- ((string ":=" >> return ()) <|> spaces) >> many (noneOf "}")
-        char '}'
+        char' '}'
         updateState $ \(m, b) -> (if (and b) && (head i /= '_') then Map.insert i d m else m, b)
         return ""
     replace s = do
@@ -125,6 +131,6 @@
         return $ Map.findWithDefault s s m
 
     unknown = do
-        fn <- many1 $ noneOf "}\n"
-        char '}'
-        return $ "{$" ++ fn ++ "}"
+        un <- many1 $ noneOf "}\n"
+        char' '}'
+        return $ "{$" ++ un ++ "}"
diff -r 459bc720cea1 -r b26c2772e754 tools/pas2c/PascalUnitSyntaxTree.hs
--- a/tools/pas2c/PascalUnitSyntaxTree.hs	Thu Feb 06 23:02:35 2014 +0400
+++ b/tools/pas2c/PascalUnitSyntaxTree.hs	Fri Feb 07 00:46:49 2014 +0400
@@ -1,8 +1,5 @@
 module PascalUnitSyntaxTree where
 
-import Data.Maybe
-import Data.Char
-
 data PascalUnit =
     Program Identifier Implementation Phrase
     | Unit Identifier Interface Implementation (Maybe Initialize) (Maybe Finalize)