Commit ae0b2a9e authored by simonpj's avatar simonpj
Browse files

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

Better reporting of duplicate top-level defns
parent 864388a3
...@@ -56,6 +56,7 @@ import BasicTypes ( IPName, mapIPName ) ...@@ -56,6 +56,7 @@ import BasicTypes ( IPName, mapIPName )
import SrcLoc ( SrcSpan, srcSpanStart, Located(..), eqLocated, unLoc, import SrcLoc ( SrcSpan, srcSpanStart, Located(..), eqLocated, unLoc,
srcLocSpan, getLoc, combineSrcSpans, srcSpanStartLine, srcSpanEndLine ) srcLocSpan, getLoc, combineSrcSpans, srcSpanStartLine, srcSpanEndLine )
import Outputable import Outputable
import Util ( sortLe )
import ListSetOps ( removeDups ) import ListSetOps ( removeDups )
import List ( nubBy ) import List ( nubBy )
import CmdLineOpts import CmdLineOpts
...@@ -759,5 +760,6 @@ dupNamesErr descriptor located_names ...@@ -759,5 +760,6 @@ dupNamesErr descriptor located_names
big_loc = foldr1 combineSrcSpans locs big_loc = foldr1 combineSrcSpans locs
one_line = srcSpanStartLine big_loc == srcSpanEndLine big_loc one_line = srcSpanStartLine big_loc == srcSpanEndLine big_loc
locations | one_line = empty 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} \end{code}
...@@ -831,6 +831,7 @@ rnMDoStmts stmts ...@@ -831,6 +831,7 @@ rnMDoStmts stmts
in in
returnM stmts_w_fvs returnM stmts_w_fvs
where where
doc = text "In a recursive mdo-expression" doc = text "In a recursive mdo-expression"
......
...@@ -50,7 +50,7 @@ import RdrName ( RdrName, rdrNameOcc, setRdrNameSpace, ...@@ -50,7 +50,7 @@ import RdrName ( RdrName, rdrNameOcc, setRdrNameSpace,
import Outputable import Outputable
import Maybes ( isNothing, catMaybes, mapCatMaybes, seqMaybe ) import Maybes ( isNothing, catMaybes, mapCatMaybes, seqMaybe )
import SrcLoc ( noSrcLoc, Located(..), mkGeneralSrcSpan, import SrcLoc ( noSrcLoc, Located(..), mkGeneralSrcSpan,
unLoc, noLoc, srcLocSpan, SrcSpan ) unLoc, noLoc, srcLocSpan, combineSrcSpans, SrcSpan )
import BasicTypes ( DeprecTxt ) import BasicTypes ( DeprecTxt )
import ListSetOps ( removeDups ) import ListSetOps ( removeDups )
import Util ( sortLe, notNull, isSingleton ) import Util ( sortLe, notNull, isSingleton )
...@@ -1002,17 +1002,15 @@ exportClashErr global_env name1 name2 ie1 ie2 ...@@ -1002,17 +1002,15 @@ exportClashErr global_env name1 name2 ie1 ie2
[] -> pprPanic "exportClashErr" (ppr name) [] -> pprPanic "exportClashErr" (ppr name)
addDupDeclErr :: [Name] -> TcRn () addDupDeclErr :: [Name] -> TcRn ()
addDupDeclErr (n:ns) addDupDeclErr names
= addErrAt (srcLocSpan (nameSrcLoc n)) $ = addErrAt big_loc $
vcat [ptext SLIT("Multiple declarations of") <+> quotes (ppr n), vcat [ptext SLIT("Multiple declarations of") <+> quotes (ppr name1),
nest 2 (ptext SLIT("other declarations at:")), ptext SLIT("Declared at:") <+> vcat (map ppr sorted_locs)]
nest 4 (vcat (map ppr sorted_locs))]
where where
sorted_locs = sortLe occ'ed_before (map nameSrcLoc ns) locs = map nameSrcLoc names
occ'ed_before a b = case compare a b of big_loc = foldr1 combineSrcSpans (map srcLocSpan locs)
LT -> True name1 = head names
EQ -> True sorted_locs = sortLe (<=) (sortLe (<=) locs)
GT -> False
dupExportWarn occ_name ie1 ie2 dupExportWarn occ_name ie1 ie2
= hsep [quotes (ppr occ_name), = hsep [quotes (ppr occ_name),
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment