Re-jig the reporting of names bound multiple times
authorSimon Peyton Jones <simonpj@microsoft.com>
Tue, 21 Aug 2012 13:35:12 +0000 (14:35 +0100)
committerSimon Peyton Jones <simonpj@microsoft.com>
Tue, 21 Aug 2012 13:35:12 +0000 (14:35 +0100)
Fixes Trac #7164

compiler/basicTypes/RdrName.lhs
compiler/main/HscTypes.lhs
compiler/rename/RnEnv.lhs
compiler/rename/RnNames.lhs

index 624f94b..3ff3bbb 100644 (file)
@@ -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]
index 343df00..d8d8816 100644 (file)
@@ -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
index 478e45f..d73ebe4 100644 (file)
@@ -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]
index 6901e62..4ce5702 100644 (file)
@@ -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'))