From 87511d1ca0f4be6df208287c2a6c84aa85f45b70 Mon Sep 17 00:00:00 2001
From: Simon Peyton Jones <simonpj@microsoft.com>
Date: Tue, 21 Aug 2012 14:35:12 +0100
Subject: [PATCH] Re-jig the reporting of names bound multiple times
Fixes Trac #7164
MERGED from commit 2c6d11fa17ff5cab7d62e6dbea3fc9e501fce7f3
---
compiler/basicTypes/RdrName.lhs | 21 ++++++++++-----------
compiler/main/HscTypes.lhs | 3 ++-
compiler/rename/RnEnv.lhs | 7 +++++--
compiler/rename/RnNames.lhs | 5 +++--
4 files changed, 20 insertions(+), 16 deletions(-)
diff --git a/compiler/basicTypes/RdrName.lhs b/compiler/basicTypes/RdrName.lhs
index 624f94b88613..3ff3bbb82f8d 100644
--- a/compiler/basicTypes/RdrName.lhs
+++ b/compiler/basicTypes/RdrName.lhs
@@ -585,26 +585,25 @@ mkGlobalRdrEnv gres
(nameOccName (gre_name gre))
gre
-findLocalDupsRdrEnv :: GlobalRdrEnv -> [OccName] -> (GlobalRdrEnv, [[Name]])
+findLocalDupsRdrEnv :: GlobalRdrEnv -> [OccName] -> [[Name]]
-- ^ For each 'OccName', see if there are multiple local definitions
--- for it. If so, remove all but one (to suppress subsequent error messages)
+-- for it; return a list of all such
-- and return a list of the duplicate bindings
findLocalDupsRdrEnv rdr_env occs
= go rdr_env [] occs
where
- go rdr_env dups [] = (rdr_env, dups)
+ go _ dups [] = dups
go rdr_env dups (occ:occs)
= case filter isLocalGRE gres of
- [] -> WARN( True, ppr occ <+> ppr rdr_env )
- go rdr_env dups occs -- Weird! No binding for occ
- [_] -> go rdr_env dups occs -- The common case
- dup_gres -> go (extendOccEnv rdr_env occ (head dup_gres : nonlocal_gres))
- (map gre_name dup_gres : dups)
- occs
+ [] -> go rdr_env dups occs
+ [_] -> go rdr_env dups occs -- The common case
+ dup_gres -> go rdr_env' (map gre_name dup_gres : dups) occs
where
gres = lookupOccEnv rdr_env occ `orElse` []
- nonlocal_gres = filterOut isLocalGRE gres
-
+ rdr_env' = delFromOccEnv rdr_env occ
+ -- The delFromOccEnv avoids repeating the same
+ -- complaint twice, when occs itself has a duplicate
+ -- which is a common case
insertGRE :: GlobalRdrElt -> [GlobalRdrElt] -> [GlobalRdrElt]
insertGRE new_g [] = [new_g]
diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs
index 343df00540b5..793740e96e63 100644
--- a/compiler/main/HscTypes.lhs
+++ b/compiler/main/HscTypes.lhs
@@ -1116,7 +1116,8 @@ mkPrintUnqualified dflags env = (qual_name, qual_mod)
then NameNotInScope1
else NameNotInScope2
- | otherwise = panic "mkPrintUnqualified"
+ | otherwise = NameNotInScope1 -- Can happen if 'f' is bound twice in the module
+ -- Eg f = True; g = 0; f = False
where
mod = nameModule name
occ = nameOccName name
diff --git a/compiler/rename/RnEnv.lhs b/compiler/rename/RnEnv.lhs
index 9c930740b438..b4efdf0df863 100644
--- a/compiler/rename/RnEnv.lhs
+++ b/compiler/rename/RnEnv.lhs
@@ -1608,11 +1608,14 @@ addUnusedWarning name span msg
\begin{code}
addNameClashErrRn :: RdrName -> [GlobalRdrElt] -> RnM ()
-addNameClashErrRn rdr_name names
+addNameClashErrRn rdr_name gres
+ | all isLocalGRE gres -- If there are two or more *local* defns, we'll have reported
+ = return () -- that already, and we don't want an error cascade
+ | otherwise
= addErr (vcat [ptext (sLit "Ambiguous occurrence") <+> quotes (ppr rdr_name),
ptext (sLit "It could refer to") <+> vcat (msg1 : msgs)])
where
- (np1:nps) = names
+ (np1:nps) = gres
msg1 = ptext (sLit "either") <+> mk_ref np1
msgs = [ptext (sLit " or") <+> mk_ref np | np <- nps]
mk_ref gre = sep [quotes (ppr (gre_name gre)) <> comma, pprNameProvenance gre]
diff --git a/compiler/rename/RnNames.lhs b/compiler/rename/RnNames.lhs
index 535faaf5466c..0a20f59061f3 100644
--- a/compiler/rename/RnNames.lhs
+++ b/compiler/rename/RnNames.lhs
@@ -414,10 +414,11 @@ extendGlobalRdrEnvRn avails new_fixities
rdr_env3 = foldl extendGlobalRdrEnv rdr_env2 gres
fix_env' = foldl extend_fix_env fix_env gres
- (rdr_env', dups) = findLocalDupsRdrEnv rdr_env3 new_occs
+ dups = findLocalDupsRdrEnv rdr_env3 new_occs
- gbl_env' = gbl_env { tcg_rdr_env = rdr_env', tcg_fix_env = fix_env' }
+ gbl_env' = gbl_env { tcg_rdr_env = rdr_env3, tcg_fix_env = fix_env' }
+ ; traceRn (text "extendGlobalRdrEnvRn dups" <+> (ppr dups))
; mapM_ addDupDeclErr dups
; traceRn (text "extendGlobalRdrEnvRn" <+> (ppr new_fixities $$ ppr fix_env $$ ppr fix_env'))
--
GitLab