From f1bacb987c0c36c0a14a87060b29bf851728fbfe Mon Sep 17 00:00:00 2001
From: sof <unknown>
Date: Thu, 4 Sep 1997 19:54:32 +0000
Subject: [PATCH] [project @ 1997-09-04 19:54:32 by sof] Tidied up error
 reporting code

---
 ghc/compiler/typecheck/TcModule.lhs |   38 ++++++++++++++++++++++++++---------
 1 file changed, 28 insertions(+), 10 deletions(-)

diff --git a/ghc/compiler/typecheck/TcModule.lhs b/ghc/compiler/typecheck/TcModule.lhs
index 19e561a..97c53c5 100644
--- a/ghc/compiler/typecheck/TcModule.lhs
+++ b/ghc/compiler/typecheck/TcModule.lhs
@@ -15,11 +15,12 @@ module TcModule (
 
 IMP_Ubiq(){-uitous-}
 
+import CmdLineOpts	( opt_D_dump_tc, opt_D_dump_deriv )
 import HsSyn		( HsDecl(..), HsModule(..), HsBinds(..), HsExpr, MonoBinds(..),
 			  TyDecl, SpecDataSig, ClassDecl, InstDecl, IfaceSig,
 			  SpecInstSig, DefaultDecl, Sig, Fake, InPat,
 			  SYN_IE(RecFlag), nonRecursive,  GRHSsAndBinds, Match,
- 			  FixityDecl, IE, ImportDecl
+ 			  FixityDecl, IE, ImportDecl, OutPat
 			)
 import RnHsSyn		( SYN_IE(RenamedHsModule), RenamedFixityDecl(..) )
 import TcHsSyn		( SYN_IE(TypecheckedHsBinds), SYN_IE(TypecheckedHsExpr),
@@ -49,9 +50,11 @@ import TcKind		( TcKind )
 
 import RnMonad		( RnNameSupply(..) )
 import Bag		( listToBag )
-import ErrUtils		( SYN_IE(Warning), SYN_IE(Error) )
+import ErrUtils		( SYN_IE(Warning), SYN_IE(Error), 
+			  pprBagOfErrors, dumpIfSet, ghcExit
+			)
 import Id		( idType, GenId, SYN_IE(IdEnv), nullIdEnv )
-import Maybes		( catMaybes, MaybeErr )
+import Maybes		( catMaybes, MaybeErr(..) )
 import Name		( Name, isLocallyDefined, pprModule )
 import Pretty
 import TyCon		( TyCon, isSynTyCon )
@@ -72,7 +75,7 @@ import Bag		( Bag, isEmptyBag )
 
 import FiniteMap	( emptyFM, FiniteMap )
 
-import Outputable	( Outputable(..), PprStyle )
+import Outputable	( Outputable(..), PprStyle, printErrs, pprDumpStyle, pprErrorsStyle )
 
 tycon_specs = emptyFM
 \end{code}
@@ -107,14 +110,29 @@ typecheckModule
 	:: UniqSupply
 	-> RnNameSupply
 	-> RenamedHsModule
-	-> MaybeErr
-	    (TcResults, 		-- if all goes well...
-	     Bag Warning)	      	-- (we can still get warnings)
-	    (Bag Error,		      	-- if we had errors...
-	     Bag Warning)
+	-> IO (Maybe TcResults)
 
 typecheckModule us rn_name_supply mod
-  = initTc us (tcModule rn_name_supply mod)
+  = case initTc us (tcModule rn_name_supply mod) of
+	Failed (errs, warns) ->
+	  print_errs warns	>>
+	  print_errs errs	>>
+	  return Nothing
+
+	Succeeded (results@(binds, _, _, _, _, dump_deriv), warns) -> 
+	  print_errs warns			>>
+
+	  dumpIfSet opt_D_dump_tc "Typechecked"
+		(ppr pprDumpStyle binds)	  	>>
+
+	  dumpIfSet opt_D_dump_deriv "Derived instances"
+		(dump_deriv pprDumpStyle)		>>
+
+	  return (Just results)
+
+print_errs errs
+  | isEmptyBag errs = return ()
+  | otherwise       = printErrs (pprBagOfErrors pprErrorsStyle errs)
 \end{code}
 
 The internal monster:
-- 
1.7.10.4