[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 (file)
--- 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 (file)
--- 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 (file)
--- 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),