[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).

1 files changed, 18 insertions, 11 deletions

diff --git a/ghc/compiler/rename/RnEnv.lhs b/ghc/compiler/rename/RnEnv.lhs
index d3f75108a4..82ac8c1d04 100644
--- 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)