From 46f02d59813499ba2aa44e7831e0b69ec6d8f25d Mon Sep 17 00:00:00 2001
From: "simonpj@microsoft.com" <unknown>
Date: Thu, 28 May 2009 15:23:59 +0000
Subject: [PATCH] Fix Trac #3262: suppress name-shadow warning for _names

Adopt Max's suggestion for name shadowing, by suppressing shadowing
warnings for variables starting with "_".  A tiny bit of refactoring
along the way.
---
 compiler/basicTypes/NameSet.lhs   |    2 +-
 compiler/basicTypes/OccName.lhs   |   15 +++++++--------
 compiler/rename/RnEnv.lhs         |    4 +++-
 compiler/typecheck/TcInstDcls.lhs |    2 +-
 docs/users_guide/using.xml        |    5 +++++
 5 files changed, 17 insertions(+), 11 deletions(-)

diff --git a/compiler/basicTypes/NameSet.lhs b/compiler/basicTypes/NameSet.lhs
index 7eb5da5..46bcee7 100644
--- a/compiler/basicTypes/NameSet.lhs
+++ b/compiler/basicTypes/NameSet.lhs
@@ -189,7 +189,7 @@ findUses dus uses
 	= rhs_uses `unionNameSets` uses
     get (Just defs, rhs_uses) uses
 	| defs `intersectsNameSet` uses 	-- Used
-	|| not (all (reportIfUnused . nameOccName) (nameSetToList defs))
+	|| any (startsWithUnderscore . nameOccName) (nameSetToList defs)
 		-- At least one starts with an "_", 
 		-- so treat the group as used
 	= rhs_uses `unionNameSets` uses
diff --git a/compiler/basicTypes/OccName.lhs b/compiler/basicTypes/OccName.lhs
index c2aae5d..10cf91e 100644
--- a/compiler/basicTypes/OccName.lhs
+++ b/compiler/basicTypes/OccName.lhs
@@ -65,7 +65,7 @@ module OccName (
 	occNameFS, occNameString, occNameSpace, 
 
 	isVarOcc, isTvOcc, isTcOcc, isDataOcc, isDataSymOcc, isSymOcc, isValOcc,
-	parenSymOcc, reportIfUnused, 
+	parenSymOcc, startsWithUnderscore, 
 	
 	isTcClsNameSpace, isTvNameSpace, isDataConNameSpace, isVarNameSpace, isValNameSpace,
 
@@ -463,13 +463,12 @@ parenSymOcc occ doc | isSymOcc occ = parens doc
 
 
 \begin{code}
-reportIfUnused :: OccName -> Bool
--- ^ Haskell 98 encourages compilers to suppress warnings about
--- unused names in a pattern if they start with @_@: this implements
--- that test
-reportIfUnused occ = case occNameString occ of
-			('_' : _) -> False
-			_other    -> True
+startsWithUnderscore :: OccName -> Bool
+-- ^ Haskell 98 encourages compilers to suppress warnings about unsed
+-- names in a pattern if they start with @_@: this implements that test
+startsWithUnderscore occ = case occNameString occ of
+			     ('_' : _) -> True
+			     _other    -> False
 \end{code}
 
 
diff --git a/compiler/rename/RnEnv.lhs b/compiler/rename/RnEnv.lhs
index 56f18ab..b4dafd3 100644
--- a/compiler/rename/RnEnv.lhs
+++ b/compiler/rename/RnEnv.lhs
@@ -904,6 +904,8 @@ checkShadowedNames doc_str (global_env,local_env) loc_rdr_names
 	; mappM_ check_shadow loc_rdr_names }
   where
     check_shadow (loc, occ)
+        | startsWithUnderscore occ = return ()	-- Do not report shadowing for "_x"
+	  		       	     	    	-- See Trac #3262
 	| Just n <- mb_local = complain [ptext (sLit "bound at") <+> ppr (nameSrcLoc n)]
 	| otherwise = do { gres' <- filterM is_shadowed_gre gres
 			 ; complain (map pprNameProvenance gres') }
@@ -1007,7 +1009,7 @@ warnUnusedBinds names  = mappM_ warnUnusedName (filter reportable names)
 	| isWiredInName name = False	-- Don't report unused wired-in names
 					-- Otherwise we get a zillion warnings
 					-- from Data.Tuple
-	| otherwise = reportIfUnused (nameOccName name)
+	| otherwise = not (startsWithUnderscore (nameOccName name))
 
 -------------------------
 
diff --git a/compiler/typecheck/TcInstDcls.lhs b/compiler/typecheck/TcInstDcls.lhs
index 2435395..cf03e71 100644
--- a/compiler/typecheck/TcInstDcls.lhs
+++ b/compiler/typecheck/TcInstDcls.lhs
@@ -860,7 +860,7 @@ tcInstanceMethod loc clas tyvars dfun_dicts theta inst_tys
 	    (Nothing, NoDefMeth) -> do		-- No default method in the class
 			{ warn <- doptM Opt_WarnMissingMethods		
                         ; warnTc (warn  -- Warn only if -fwarn-missing-methods
-				  && reportIfUnused (getOccName sel_id))
+				  && not (startsWithUnderscore (getOccName sel_id)))
 					-- Don't warn about _foo methods
 			         omitted_meth_warn
 			; return (error_rhs, emptyBag) }
diff --git a/docs/users_guide/using.xml b/docs/users_guide/using.xml
index 8b87620..fad30ac 100644
--- a/docs/users_guide/using.xml
+++ b/docs/users_guide/using.xml
@@ -1175,6 +1175,11 @@ f foo = foo { x = 6 }
           typographical errors that turn into hard-to-find bugs, e.g.,
           in the inadvertent capture of what would be a recursive call in
           <literal>f = ... let f = id in ... f ...</literal>.</para>
+          <para>The warning is suppressed for names beginning with an underscore.  For example
+          <programlisting>
+             f x = do { _ignore &lt;- this; _ignore &lt;- that; return (the other) }
+          </programlisting>
+         </para>
 	</listitem>
       </varlistentry>
 
-- 
1.7.10.4