[project @ 2003-01-23 14:54:35 by simonpj]

Suppress "No explicit method or default decl given for m"
	if the method name starts with an underscore

	This in response to a suggestion by George Russel

diff --git a/ghc/compiler/basicTypes/OccName.lhs b/ghc/compiler/basicTypes/OccName.lhs
index dfcc6d2..e52a090 100644 (file)
--- a/ghc/compiler/basicTypes/OccName.lhs
+++ b/ghc/compiler/basicTypes/OccName.lhs
@@ -23,6 +23,7 @@ module OccName (
        mkGenOcc1, mkGenOcc2, mkLocalOcc,
        
        isTvOcc, isTcOcc, isDataOcc, isDataSymOcc, isSymOcc, isValOcc,
+       reportIfUnused,
 
        occNameFS, occNameString, occNameUserString, occNameSpace, occNameFlavour, 
        setOccNameSpace,
@@ -257,6 +258,17 @@ isSymOcc (OccName VarName s)  = isLexSym (decodeFS s)
 \end{code}
 
 
+\begin{code}
+reportIfUnused :: OccName -> Bool
+  -- Haskell 98 encourages compilers to suppress warnings about
+  -- unused names in a pattern if they start with "_".
+reportIfUnused occ = case occNameUserString occ of
+                       ('_' : _) -> False
+                       zz_other  -> True
+\end{code}
+
+
+
 %************************************************************************
 %*                                                                     *
 \subsection{Making system names}

diff --git a/ghc/compiler/rename/RnEnv.lhs b/ghc/compiler/rename/RnEnv.lhs
index 4d9e057..f6ee366 100644 (file)
--- a/ghc/compiler/rename/RnEnv.lhs
+++ b/ghc/compiler/rename/RnEnv.lhs
@@ -29,11 +29,12 @@ import HscTypes             ( Provenance(..), pprNameProvenance, hasBetterProv,
                          lookupFixity
                        )
 import TcRnMonad
-import Name            ( Name, getName, getSrcLoc, nameIsLocalOrFrom, isWiredInName,
-                         mkInternalName, mkExternalName, mkIPName, nameSrcLoc,
-                         nameOccName, setNameSrcLoc, nameModule        )
+import Name            ( Name, getName, nameIsLocalOrFrom, 
+                         isWiredInName, mkInternalName, mkExternalName, mkIPName, 
+                         nameSrcLoc, nameOccName, setNameSrcLoc, nameModule    )
 import NameSet
-import OccName         ( OccName, tcName, isDataOcc, occNameUserString, occNameFlavour )
+import OccName         ( OccName, tcName, isDataOcc, occNameUserString, occNameFlavour,
+                         reportIfUnused )
 import Module          ( Module, ModuleName, moduleName, mkHomeModule,
                          lookupModuleEnv, lookupModuleEnvByName, extendModuleEnv_C )
 import PrelNames       ( mkUnboundName, intTyConName, 
@@ -994,12 +995,8 @@ warnUnusedBinds names
    groups = equivClasses cmp (filter reportable names)
    (_,prov1) `cmp` (_,prov2) = prov1 `compare` prov2
  
+   reportable (name,_) = reportIfUnused (nameOccName name)
 
-   reportable (name,_) = case occNameUserString (nameOccName name) of
-                               ('_' : _) -> False
-                               zz_other  -> True
-       -- Haskell 98 encourages compilers to suppress warnings about
-       -- unused names in a pattern if they start with "_".
 
 -------------------------
 
@@ -1010,7 +1007,7 @@ warnUnusedGroup names
     sep [msg <> colon, nest 4 (fsep (punctuate comma (map (ppr.fst) names)))]
   where
     (name1, prov1) = head names
-    loc1          = getSrcLoc name1
+    loc1          = nameSrcLoc name1
     (def_loc, msg) = case prov1 of
                        LocalDef                           -> (loc1, unused_msg)
                        NonLocalDef (UserImport mod loc _) -> (loc,  imp_from mod)

diff --git a/ghc/compiler/typecheck/TcClassDcl.lhs b/ghc/compiler/typecheck/TcClassDcl.lhs
index c37ff49..86d3bba 100644 (file)
--- a/ghc/compiler/typecheck/TcClassDcl.lhs
+++ b/ghc/compiler/typecheck/TcClassDcl.lhs
@@ -50,7 +50,8 @@ import Id             ( Id, idType, idName, setIdLocalExported, setInlinePragma )
 import Name            ( Name, NamedThing(..) )
 import NameEnv         ( NameEnv, lookupNameEnv, emptyNameEnv, unitNameEnv, plusNameEnv )
 import NameSet         ( emptyNameSet, unitNameSet )
-import OccName         ( mkClassTyConOcc, mkClassDataConOcc, mkWorkerOcc, mkSuperDictSelOcc )
+import OccName         ( mkClassTyConOcc, mkClassDataConOcc, mkWorkerOcc, 
+                         mkSuperDictSelOcc, reportIfUnused )
 import Outputable
 import Var             ( TyVar )
 import CmdLineOpts
@@ -549,7 +550,9 @@ mkDefMethRhs origin clas inst_tys sel_id loc NoDefMeth
   =    -- No default method
        -- Warn only if -fwarn-missing-methods
     doptM Opt_WarnMissingMethods               `thenM` \ warn -> 
-    warnTc (isInstDecl origin && warn)
+    warnTc (isInstDecl origin
+          && warn
+          && reportIfUnused (getOccName sel_id))
           (omittedMethodWarn sel_id)           `thenM_`
     returnM error_rhs
   where