[project @ 2001-10-22 16:08:10 by simonmar]

-fwarn-name-shadowing should check the global env as well as the local
env for names that could be shadowed (the docs don't say anything
about it applying to local names only).

diff --git a/ghc/compiler/rename/RnEnv.lhs b/ghc/compiler/rename/RnEnv.lhs
index d3f7510..82ac8c1 100644 (file)
--- a/ghc/compiler/rename/RnEnv.lhs
+++ b/ghc/compiler/rename/RnEnv.lhs
@@ -56,6 +56,8 @@ import List           ( nub )
 import UniqFM          ( lookupWithDefaultUFM )
 import CmdLineOpts
 import FastString      ( FastString )
+
+import Maybe           ( isJust )
 \end{code}
 
 %*********************************************************
@@ -481,31 +483,36 @@ bindLocatedLocalsRn :: SDoc       -- Documentation string for error message
                    -> RnMS a
 bindLocatedLocalsRn doc_str rdr_names_w_loc enclosed_scope
   = getModeRn                          `thenRn` \ mode ->
-    getLocalNameEnv                    `thenRn` \ name_env ->
+    getLocalNameEnv                    `thenRn` \ local_env ->
+    getGlobalNameEnv                   `thenRn` \ global_env ->
 
        -- Check for duplicate names
     checkDupOrQualNames doc_str rdr_names_w_loc        `thenRn_`
 
        -- Warn about shadowing, but only in source modules
+    let
+      check_shadow (rdr_name,loc)
+       | isJust local || isJust global
+       = pushSrcLocRn loc $ addWarnRn (shadowedNameWarn rdr_name)
+        | otherwise 
+       = returnRn ()
+       where
+         local  = lookupRdrEnv local_env rdr_name
+         global = lookupRdrEnv global_env rdr_name
+    in
+
     (case mode of
        SourceMode -> ifOptRn Opt_WarnNameShadowing     $
-                     mapRn_ (check_shadow name_env) rdr_names_w_loc
+                     mapRn_ check_shadow rdr_names_w_loc
        other      -> returnRn ()
     )                                  `thenRn_`
-       
+
     newLocalsRn rdr_names_w_loc                `thenRn` \ names ->
     let
-       new_local_env = addListToRdrEnv name_env (map fst rdr_names_w_loc `zip` names)
+       new_local_env = addListToRdrEnv local_env (map fst rdr_names_w_loc `zip` names)
     in
     setLocalNameEnv new_local_env (enclosed_scope names)
 
-  where
-    check_shadow name_env (rdr_name,loc)
-       = case lookupRdrEnv name_env rdr_name of
-               Nothing   -> returnRn ()
-               Just name -> pushSrcLocRn loc $
-                            addWarnRn (shadowedNameWarn rdr_name)
-
 bindCoreLocalRn :: RdrName -> (Name -> RnMS a) -> RnMS a
   -- A specialised variant when renaming stuff from interface
   -- files (of which there is a lot)