[project @ 1999-11-25 10:33:20 by simonpj]

[ghc-hetmet.git] / ghc / compiler / rename / RnEnv.lhs

diff --git a/ghc/compiler/rename/RnEnv.lhs b/ghc/compiler/rename/RnEnv.lhs
index 430a367..a4fad13 100644 (file)
--- a/ghc/compiler/rename/RnEnv.lhs
+++ b/ghc/compiler/rename/RnEnv.lhs
@@ -24,11 +24,12 @@ import Name         ( Name, Provenance(..), ExportFlag(..), NamedThing(..),
                          mkLocalName, mkImportedLocalName, mkGlobalName, isSystemName,
                          nameOccName, setNameModule, nameModule,
                          pprOccName, isLocallyDefined, nameUnique, nameOccName,
+                          occNameUserString,
                          setNameProvenance, getNameProvenance, pprNameProvenance
                        )
 import NameSet
 import OccName         ( OccName,
-                         mkDFunOcc, 
+                         mkDFunOcc, occNameUserString, occNameString,
                          occNameFlavour
                        )
 import TysWiredIn      ( tupleTyCon, unboxedTupleTyCon, listTyCon )
@@ -62,7 +63,7 @@ newImportedGlobalName mod_name occ mod
     in
     case lookupFM cache key of
        Just name -> returnRn name
-       Nothing   -> setNameSupplyRn (us', inst_ns, new_cache)          `thenRn_`
+       Nothing   -> setNameSupplyRn (us', inst_ns, new_cache)  `thenRn_`
                     returnRn name
                  where
                     (us', us1) = splitUniqSupply us
@@ -89,7 +90,8 @@ newImportedBinder mod rdr_name
 -- Make an imported global name, checking first to see if it's in the cache
 mkImportedGlobalName :: ModuleName -> OccName -> RnM d Name
 mkImportedGlobalName mod_name occ
-  = newImportedGlobalName mod_name occ (mkVanillaModule mod_name)
+  = lookupModuleRn mod_name `thenRn` \ mod ->
+    newImportedGlobalName mod_name occ mod --(mkVanillaModule mod_name)
        
 mkImportedGlobalFromRdrName rdr_name
   | isQual rdr_name
@@ -167,8 +169,11 @@ Make a name for the dict fun for an instance decl
 \begin{code}
 newDFunName :: (OccName, OccName) -> SrcLoc -> RnMS Name
 newDFunName key@(cl_occ, tycon_occ) loc
-  = newInstUniq key    `thenRn` \ inst_uniq ->
-    newImplicitBinder (mkDFunOcc cl_occ tycon_occ inst_uniq) loc
+  = newInstUniq string `thenRn` \ inst_uniq ->
+    newImplicitBinder (mkDFunOcc string inst_uniq) loc
+  where
+       -- Any string that is somewhat unique will do
+    string = occNameString cl_occ ++ occNameString tycon_occ
 \end{code}
 
 \begin{code}
@@ -288,6 +293,10 @@ bindLocalsFVRn doc rdr_names enclosed_scope
     returnRn (thing, delListFromNameSet fvs names)
 
 -------------------------------------
+bindUVarRn :: SDoc -> RdrName -> (Name -> RnMS (a, FreeVars)) -> RnMS (a, FreeVars)
+bindUVarRn = bindLocalRn
+
+-------------------------------------
 extendTyVarEnvFVRn :: [HsTyVar Name] -> RnMS (a, FreeVars) -> RnMS (a, FreeVars)
        -- This tiresome function is used only in rnDecl on InstDecl
 extendTyVarEnvFVRn tyvars enclosed_scope
@@ -452,7 +461,7 @@ whether there are any instance decls in this module are ``special''.
 The name cache should have the correct provenance, though.
 
 \begin{code}
-lookupImplicitOccRn :: RdrName -> RnMS Name 
+lookupImplicitOccRn :: RdrName -> RnM d Name 
 lookupImplicitOccRn rdr_name = mkImportedGlobalFromRdrName rdr_name
 \end{code}
 
@@ -723,17 +732,16 @@ warnUnusedBinds warn_when_local names
 -------------------------
 
 warnUnusedGroup :: (Bool -> Bool) -> [Name] -> RnM d ()
-warnUnusedGroup _ []
-  = returnRn ()
-
 warnUnusedGroup emit_warning names
+  | null filtered_names         = returnRn ()
   | not (emit_warning is_local) = returnRn ()
   | otherwise
   = pushSrcLocRn def_loc       $
     addWarnRn                  $
-    sep [msg <> colon, nest 4 (fsep (punctuate comma (map ppr names)))]
+    sep [msg <> colon, nest 4 (fsep (punctuate comma (map ppr filtered_names)))]
   where
-    name1 = head names
+    filtered_names = filter reportable names
+    name1         = head filtered_names
     (is_local, def_loc, msg)
        = case getNameProvenance name1 of
                LocalDef loc _                       -> (True, loc, text "Defined but not used")
@@ -741,6 +749,12 @@ warnUnusedGroup emit_warning names
                 (True, loc, text "Imported from" <+> quotes (ppr mod) <+> 
                                                      text "but not used")
                other -> (False, getSrcLoc name1, text "Strangely defined but not used")
+
+    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 "_".
 \end{code}
 
 \begin{code}
@@ -780,4 +794,3 @@ dupNamesErr descriptor ((name,loc) : dup_things)
              $$ 
              (ptext SLIT("in") <+> descriptor))
 \end{code}
-