Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master
http://hackage.haskell.org/trac/ghc/changeset/2c6d11fa17ff5cab7d62e6dbea3fc9e501fce7f3 >--------------------------------------------------------------- commit 2c6d11fa17ff5cab7d62e6dbea3fc9e501fce7f3 Author: Simon Peyton Jones <[email protected]> Date: Tue Aug 21 14:35:12 2012 +0100 Re-jig the reporting of names bound multiple times Fixes Trac #7164 >--------------------------------------------------------------- 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 624f94b..3ff3bbb 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 343df00..d8d8816 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 478e45f..d73ebe4 100644 --- a/compiler/rename/RnEnv.lhs +++ b/compiler/rename/RnEnv.lhs @@ -1597,11 +1597,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 6901e62..4ce5702 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')) _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
