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

[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
--- 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
--- 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"
 
 
 ----------------------------------------------------