[project @ 2004-10-04 09:11:09 by simonpj]

Improve error locations for binding conflicts

diff --git a/ghc/compiler/rename/RnEnv.lhs b/ghc/compiler/rename/RnEnv.lhs
index 821f6a9..e0e5168 100644 (file)
--- a/ghc/compiler/rename/RnEnv.lhs
+++ b/ghc/compiler/rename/RnEnv.lhs
@@ -54,7 +54,7 @@ import PrelNames      ( mkUnboundName, rOOT_MAIN_Name, iNTERACTIVE, consDataConKey, h
 import UniqSupply
 import BasicTypes      ( IPName, mapIPName )
 import SrcLoc          ( SrcSpan, srcSpanStart, Located(..), eqLocated, unLoc,
-                         srcLocSpan )
+                         srcLocSpan, getLoc, combineSrcSpans, srcSpanStartLine, srcSpanEndLine )
 import Outputable
 import ListSetOps      ( removeDups )
 import List            ( nubBy )
@@ -747,9 +747,17 @@ badOrigBinding name
   = ptext SLIT("Illegal binding of built-in syntax:") <+> ppr (rdrNameOcc name)
        -- The rdrNameOcc is because we don't want to print Prelude.(,)
 
-dupNamesErr descriptor (L loc name : dup_things)
-  = setSrcSpan loc $
-    addErr ((ptext SLIT("Conflicting definitions for") <+> quotes (ppr name))
-             $$ 
-             descriptor)
+dupNamesErr :: SDoc -> [Located RdrName] -> RnM ()
+dupNamesErr descriptor located_names
+  = setSrcSpan big_loc $
+    addErr (vcat [ptext SLIT("Conflicting definitions for") <+> quotes (ppr name1),
+                 locations,
+                 descriptor])
+  where
+    L _ name1 = head located_names
+    locs      = map getLoc 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)
 \end{code}

diff --git a/ghc/compiler/rename/RnExpr.lhs b/ghc/compiler/rename/RnExpr.lhs
index 9329f6a..33b941e 100644 (file)
--- a/ghc/compiler/rename/RnExpr.lhs
+++ b/ghc/compiler/rename/RnExpr.lhs
@@ -831,7 +831,7 @@ rnMDoStmts stmts
     in
     returnM stmts_w_fvs
   where
-    doc = text "In a mdo-expression"
+    doc = text "In a recursive mdo-expression"
 
 
 ----------------------------------------------------