From 45b7ef25fe0bdab56b817d17f24db0e725cc7688 Mon Sep 17 00:00:00 2001
From: Thomas Schilling <nominolo@googlemail.com>
Date: Sun, 14 Sep 2008 17:32:28 +0000
Subject: [PATCH] Make typechecker top-level functions also return messages
 instead of printing them.

---
 compiler/typecheck/TcRnDriver.lhs |   14 +++++++-------
 compiler/typecheck/TcRnMonad.lhs  |    5 ++---
 2 files changed, 9 insertions(+), 10 deletions(-)

diff --git a/compiler/typecheck/TcRnDriver.lhs b/compiler/typecheck/TcRnDriver.lhs
index d90b40b..35f48d0 100644
--- a/compiler/typecheck/TcRnDriver.lhs
+++ b/compiler/typecheck/TcRnDriver.lhs
@@ -974,7 +974,7 @@ setInteractiveContext hsc_env icxt thing_inside
 tcRnStmt :: HscEnv
 	 -> InteractiveContext
 	 -> LStmt RdrName
-	 -> IO (Maybe ([Id], LHsExpr Id))
+	 -> IO (Messages, Maybe ([Id], LHsExpr Id))
 		-- The returned [Id] is the list of new Ids bound by
                 -- this statement.  It can be used to extend the
                 -- InteractiveContext via extendInteractiveContext.
@@ -1207,7 +1207,7 @@ tcRnExpr just finds the type of an expression
 tcRnExpr :: HscEnv
 	 -> InteractiveContext
 	 -> LHsExpr RdrName
-	 -> IO (Maybe Type)
+	 -> IO (Messages, Maybe Type)
 tcRnExpr hsc_env ictxt rdr_expr
   = initTcPrintErrors hsc_env iNTERACTIVE $ 
     setInteractiveContext hsc_env ictxt $ do {
@@ -1236,7 +1236,7 @@ tcRnType just finds the kind of a type
 tcRnType :: HscEnv
 	 -> InteractiveContext
 	 -> LHsType RdrName
-	 -> IO (Maybe Kind)
+	 -> IO (Messages, Maybe Kind)
 tcRnType hsc_env ictxt rdr_type
   = initTcPrintErrors hsc_env iNTERACTIVE $ 
     setInteractiveContext hsc_env ictxt $ do {
@@ -1263,7 +1263,7 @@ tcRnType hsc_env ictxt rdr_type
 
 \begin{code}
 #ifdef GHCI
--- ASSUMES that the module is either in the HomePackageTable or is
+-- | ASSUMES that the module is either in the 'HomePackageTable' or is
 -- a package module with an interface on disk.  If neither of these is
 -- true, then the result will be an error indicating the interface
 -- could not be found.
@@ -1296,7 +1296,7 @@ tcGetModuleExports mod directlyImpMods
        ; ifaceExportNames (mi_exports iface)
        }
 
-tcRnLookupRdrName :: HscEnv -> RdrName -> IO (Maybe [Name])
+tcRnLookupRdrName :: HscEnv -> RdrName -> IO (Messages, Maybe [Name])
 tcRnLookupRdrName hsc_env rdr_name 
   = initTcPrintErrors hsc_env iNTERACTIVE $ 
     setInteractiveContext hsc_env (hsc_IC hsc_env) $ 
@@ -1331,7 +1331,7 @@ lookup_rdr_name rdr_name = do {
     return good_names
  }
 
-tcRnLookupName :: HscEnv -> Name -> IO (Maybe TyThing)
+tcRnLookupName :: HscEnv -> Name -> IO (Messages, Maybe TyThing)
 tcRnLookupName hsc_env name
   = initTcPrintErrors hsc_env iNTERACTIVE $ 
     setInteractiveContext hsc_env (hsc_IC hsc_env) $
@@ -1351,7 +1351,7 @@ tcRnLookupName' name = do
 
 tcRnGetInfo :: HscEnv
 	    -> Name
-	    -> IO (Maybe (TyThing, Fixity, [Instance]))
+	    -> IO (Messages, Maybe (TyThing, Fixity, [Instance]))
 
 -- Used to implemnent :info in GHCi
 --
diff --git a/compiler/typecheck/TcRnMonad.lhs b/compiler/typecheck/TcRnMonad.lhs
index 309ce5b..4c07a23 100644
--- a/compiler/typecheck/TcRnMonad.lhs
+++ b/compiler/typecheck/TcRnMonad.lhs
@@ -148,11 +148,10 @@ initTcPrintErrors	-- Used from the interactive loop only
        :: HscEnv
        -> Module 
        -> TcM r
-       -> IO (Maybe r)
+       -> IO (Messages, Maybe r)
 initTcPrintErrors env mod todo = do
   (msgs, res) <- initTc env HsSrcFile False mod todo
-  printErrorsAndWarnings (hsc_dflags env) msgs
-  return res
+  return (msgs, res)
 \end{code}
 
 %************************************************************************
-- 
1.7.10.4