From b58e1155b0ec79ec6983c3e9a42880d511b7bc10 Mon Sep 17 00:00:00 2001
From: simonpj <unknown>
Date: Thu, 5 Apr 2001 11:28:53 +0000
Subject: [PATCH] [project @ 2001-04-05 11:28:53 by simonpj] Improve error
 reporting

---
 ghc/compiler/typecheck/TcSimplify.lhs |   22 +++++-----------------
 1 file changed, 5 insertions(+), 17 deletions(-)

diff --git a/ghc/compiler/typecheck/TcSimplify.lhs b/ghc/compiler/typecheck/TcSimplify.lhs
index c6317ce..bfaf629 100644
--- a/ghc/compiler/typecheck/TcSimplify.lhs
+++ b/ghc/compiler/typecheck/TcSimplify.lhs
@@ -1526,26 +1526,14 @@ addAmbigErr tidy_env tidy_dict
 
 warnDefault dicts default_ty
   = doptsTc Opt_WarnTypeDefaults  `thenTc` \ warn_flag ->
-    if warn_flag 
-	then mapNF_Tc warn groups  `thenNF_Tc_`  returnNF_Tc ()
-	else returnNF_Tc ()
-
+    tcAddSrcLoc (get_loc (head dicts)) (warnTc warn_flag warn_msg)
   where
 	-- Tidy them first
     (_, tidy_dicts) = tidyInsts dicts
-
-	-- Group the dictionaries by source location
-    groups      = equivClasses cmp tidy_dicts
-    i1 `cmp` i2 = get_loc i1 `compare` get_loc i2
-    get_loc i   = case instLoc i of { (_,loc,_) -> loc }
-
-    warn [dict] = tcAddSrcLoc (get_loc dict) $
-		  warnTc True (ptext SLIT("Defaulting") <+> quotes (pprInst dict) <+> 
-			       ptext SLIT("to type") <+> quotes (ppr default_ty))
-
-    warn dicts  = tcAddSrcLoc (get_loc (head dicts)) $
-		  warnTc True (vcat [ptext SLIT("Defaulting the following constraint(s) to type") <+> quotes (ppr default_ty),
-				     pprInstsInFull dicts])
+    get_loc i = case instLoc i of { (_,loc,_) -> loc }
+    warn_msg  = vcat [ptext SLIT("Defaulting the following constraint(s) to type") <+> 
+				quotes (ppr default_ty),
+		      pprInstsInFull tidy_dicts]
 
 -- The error message when we don't find a suitable instance
 -- is complicated by the fact that sometimes this is because
-- 
1.7.10.4