From: simonpj <unknown>
Date: Mon, 4 Oct 2004 09:28:08 +0000 (+0000)
Subject: [project @ 2004-10-04 09:28:00 by simonpj]
X-Git-Tag: Initial_conversion_from_CVS_complete~1534
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=ae0b2a9ed8b2130fff4f12cb8e35055b04354621;p=ghc-hetmet.git

[project @ 2004-10-04 09:28:00 by simonpj]
Better reporting of duplicate top-level defns
---

diff --git a/ghc/compiler/rename/RnEnv.lhs b/ghc/compiler/rename/RnEnv.lhs
index e0e5168..1ac5485 100644
--- a/ghc/compiler/rename/RnEnv.lhs
+++ b/ghc/compiler/rename/RnEnv.lhs
@@ -56,6 +56,7 @@ import BasicTypes	( IPName, mapIPName )
 import SrcLoc		( SrcSpan, srcSpanStart, Located(..), eqLocated, unLoc,
 			  srcLocSpan, getLoc, combineSrcSpans, srcSpanStartLine, srcSpanEndLine )
 import Outputable
+import Util		( sortLe )
 import ListSetOps	( removeDups )
 import List		( nubBy )
 import CmdLineOpts
@@ -759,5 +760,6 @@ dupNamesErr descriptor located_names
     big_loc   = foldr1 combineSrcSpans locs
     one_line  = srcSpanStartLine big_loc == srcSpanEndLine big_loc
     locations | one_line  = empty 
-	      | otherwise = ptext SLIT("Bound at:") <+> vcat (map ppr locs)
+	      | otherwise = ptext SLIT("Bound at:") <+> 
+			    vcat (map ppr (sortLe (<=) locs))
 \end{code}
diff --git a/ghc/compiler/rename/RnExpr.lhs b/ghc/compiler/rename/RnExpr.lhs
index 33b941e..f927ece 100644
--- a/ghc/compiler/rename/RnExpr.lhs
+++ b/ghc/compiler/rename/RnExpr.lhs
@@ -831,6 +831,7 @@ rnMDoStmts stmts
     in
     returnM stmts_w_fvs
   where
+
     doc = text "In a recursive mdo-expression"
 
 
diff --git a/ghc/compiler/rename/RnNames.lhs b/ghc/compiler/rename/RnNames.lhs
index 5401584..8b5013e 100644
--- a/ghc/compiler/rename/RnNames.lhs
+++ b/ghc/compiler/rename/RnNames.lhs
@@ -50,7 +50,7 @@ import RdrName		( RdrName, rdrNameOcc, setRdrNameSpace,
 import Outputable
 import Maybes		( isNothing, catMaybes, mapCatMaybes, seqMaybe )
 import SrcLoc		( noSrcLoc, Located(..), mkGeneralSrcSpan,
-			  unLoc, noLoc, srcLocSpan, SrcSpan )
+			  unLoc, noLoc, srcLocSpan, combineSrcSpans, SrcSpan )
 import BasicTypes	( DeprecTxt )
 import ListSetOps	( removeDups )
 import Util		( sortLe, notNull, isSingleton )
@@ -1002,17 +1002,15 @@ exportClashErr global_env name1 name2 ie1 ie2
 	     []	     -> pprPanic "exportClashErr" (ppr name)
 
 addDupDeclErr :: [Name] -> TcRn ()
-addDupDeclErr (n:ns)
-  = addErrAt (srcLocSpan (nameSrcLoc n)) $
-    vcat [ptext SLIT("Multiple declarations of") <+> quotes (ppr n),
-	  nest 2 (ptext SLIT("other declarations at:")),
-	  nest 4 (vcat (map ppr sorted_locs))]
+addDupDeclErr names
+  = addErrAt big_loc $
+    vcat [ptext SLIT("Multiple declarations of") <+> quotes (ppr name1),
+	  ptext SLIT("Declared at:") <+> vcat (map ppr sorted_locs)]
   where
-    sorted_locs = sortLe occ'ed_before (map nameSrcLoc ns)
-    occ'ed_before a b = case compare a b of
-			  LT -> True
-			  EQ -> True
-			  GT -> False
+    locs    = map nameSrcLoc names
+    big_loc = foldr1 combineSrcSpans (map srcLocSpan locs)
+    name1   = head names
+    sorted_locs = sortLe (<=) (sortLe (<=) locs)
 
 dupExportWarn occ_name ie1 ie2
   = hsep [quotes (ppr occ_name),