[commit: ghc] master: Re-jig the reporting of names bound multiple times (2c6d11f)

[Simon Peyton Jones]

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 <simonpj at microsoft.com>
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'))