From 12c932dc23931224b3795736ac27c1d3750df00f Mon Sep 17 00:00:00 2001
From: simonmar <unknown>
Date: Mon, 13 Nov 2000 10:34:52 +0000
Subject: [PATCH] [project @ 2000-11-13 10:34:52 by simonmar] merge rev.
 1.46.2.3 from ghc-4-07-branch (fix line numbers in
 defaulting warnings).

---
 ghc/compiler/typecheck/TcSimplify.lhs |   35 ++++++++++++++++++++++++---------
 1 file changed, 26 insertions(+), 9 deletions(-)

diff --git a/ghc/compiler/typecheck/TcSimplify.lhs b/ghc/compiler/typecheck/TcSimplify.lhs
index d046461..7098929 100644
--- a/ghc/compiler/typecheck/TcSimplify.lhs
+++ b/ghc/compiler/typecheck/TcSimplify.lhs
@@ -1226,19 +1226,36 @@ addAmbigErr ambig_tv_fn dict
     (tidy_env, tidy_dict) = tidyInst emptyTidyEnv dict
 
 warnDefault dicts default_ty
-  = doptsTc Opt_WarnTypeDefaults  `thenTc` \ warn ->
-    if warn then warnTc True msg else returnNF_Tc ()
+  = doptsTc Opt_WarnTypeDefaults  `thenTc` \ warn_flag ->
+    if warn_flag 
+	then mapNF_Tc warn groups  `thenNF_Tc_`  returnNF_Tc ()
+	else returnNF_Tc ()
 
   where
-    msg | length dicts > 1 
-	= (ptext SLIT("Defaulting the following constraint(s) to type") <+> quotes (ppr default_ty))
-	  $$ pprInstsInFull tidy_dicts
-	| otherwise
-	= ptext SLIT("Defaulting") <+> quotes (pprInst (head tidy_dicts)) <+> 
-	  ptext SLIT("to type") <+> quotes (ppr default_ty)
-
+	-- Tidy them first
     (_, tidy_dicts) = mapAccumL tidyInst emptyTidyEnv 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])
+
+addRuleLhsErr dict
+  = addInstErrTcM (instLoc dict)
+	(tidy_env,
+	 vcat [ptext SLIT("Could not deduce") <+> quotes (pprInst tidy_dict),
+	       nest 4 (ptext SLIT("LHS of a rule must have no overloading"))])
+  where
+    (tidy_env, tidy_dict) = tidyInst emptyTidyEnv dict
+
 addTopIPErr dict
   = addInstErrTcM (instLoc dict) 
 	(tidy_env, 
-- 
1.7.10.4