[project @ 2003-06-24 07:58:18 by simonpj]
[ghc-hetmet.git] / ghc / compiler / rename / RnEnv.lhs
index 4c91b1b..68b09c6 100644 (file)
@@ -12,8 +12,7 @@ import {-# SOURCE #-} RnHiFiles( loadInterface )
 
 import FlattenInfo      ( namesNeededForFlattening )
 import HsSyn
-import RnHsSyn         ( RenamedFixitySig )
-import RdrHsSyn                ( RdrNameHsType, extractHsTyRdrTyVars )
+import RdrHsSyn                ( RdrNameHsType, RdrNameFixitySig, extractHsTyRdrTyVars )
 import RdrName         ( RdrName, rdrNameModule, rdrNameOcc, isQual, isUnqual, isOrig,
                          mkRdrUnqual, mkRdrQual, setRdrNameSpace, rdrNameOcc,
                          lookupRdrEnv, rdrEnvToList, elemRdrEnv, 
@@ -24,29 +23,33 @@ import HsTypes              ( hsTyVarName, replaceTyVarName )
 import HscTypes                ( Provenance(..), pprNameProvenance, hasBetterProv,
                          ImportReason(..), GlobalRdrEnv, GlobalRdrElt(..), 
                          GenAvailInfo(..), AvailInfo, Avails, 
-                         ModIface(..), NameCache(..),
+                         ModIface(..), NameCache(..), OrigNameCache,
                          Deprecations(..), lookupDeprec, isLocalGRE,
                          extendLocalRdrEnv, availName, availNames,
                          lookupFixity
                        )
 import TcRnMonad
-import Name            ( Name, getName, getSrcLoc, nameIsLocalOrFrom, isWiredInName,
-                         mkInternalName, mkExternalName, mkIPName, 
-                         nameOccName, setNameModuleAndLoc, nameModule  )
+import Name            ( Name, getName, nameIsLocalOrFrom, 
+                         isWiredInName, mkInternalName, mkExternalName, mkIPName, 
+                         nameSrcLoc, nameOccName, setNameSrcLoc, nameModule    )
 import NameSet
-import OccName         ( OccName, tcName, isDataOcc, occNameUserString, occNameFlavour )
-import Module          ( Module, ModuleName, moduleName, mkVanillaModule )
-import PrelNames       ( mkUnboundName, intTyConName, qTyConName,
+import OccName         ( OccName, tcName, isDataOcc, occNameFlavour, reportIfUnused )
+import Module          ( Module, ModuleName, moduleName, mkHomeModule,
+                         lookupModuleEnv, lookupModuleEnvByName, extendModuleEnv_C )
+import PrelNames       ( mkUnboundName, intTyConName, 
                          boolTyConName, funTyConName,
                          unpackCStringName, unpackCStringFoldrName, unpackCStringUtf8Name,
                          eqStringName, printName, 
-                         bindIOName, returnIOName, failIOName, thenIOName,
-                         templateHaskellNames
+                         bindIOName, returnIOName, failIOName, thenIOName
                        )
+#ifdef GHCI    
+import DsMeta          ( templateHaskellNames, qTyConName )
+#endif
 import TysWiredIn      ( unitTyCon )   -- A little odd
+import Finder          ( findModule )
 import FiniteMap
 import UniqSupply
-import SrcLoc          ( SrcLoc, noSrcLoc )
+import SrcLoc          ( SrcLoc, importedSrcLoc )
 import Outputable
 import ListSetOps      ( removeDups, equivClasses )
 import BasicTypes      ( mapIPName, FixitySig(..) )
@@ -63,101 +66,96 @@ import FastString  ( FastString )
 
 \begin{code}
 newTopBinder :: Module -> RdrName -> SrcLoc -> TcRn m Name
-       -- newTopBinder puts into the cache the binder with the
-       -- module information set correctly.  When the decl is later renamed,
-       -- the binding site will thereby get the correct module.
-       -- There maybe occurrences that don't have the correct Module, but
-       -- by the typechecker will propagate the binding definition to all 
-       -- the occurrences, so that doesn't matter
-
 newTopBinder mod rdr_name loc
   | Just name <- isExact_maybe rdr_name
   = returnM name
 
   | otherwise
+  = ASSERT( not (isOrig rdr_name) || rdrNameModule rdr_name == moduleName mod )
+       -- When reading External Core we get Orig names as binders, 
+       -- but they should agree with the module gotten from the monad
+    newGlobalName mod (rdrNameOcc rdr_name) loc
+
+newGlobalName :: Module -> OccName -> SrcLoc -> TcRn m Name
+newGlobalName mod occ loc
   =    -- First check the cache
     getNameCache               `thenM` \ name_supply -> 
-    let 
-       occ = rdrNameOcc rdr_name
-       key = (moduleName mod, occ)
-       cache = nsNames name_supply
-    in
-    case lookupFM cache key of
-
-       -- A hit in the cache!  We are at the binding site of the name, and
-       -- this is the moment when we know all about 
-       --      a) the Name's host Module (in particular, which
-       --         package it comes from)
-       --      b) its defining SrcLoc
-       -- So we update this info
-
-       Just name 
-         | isWiredInName name -> returnM name
-               -- Don't mess with wired-in names.  Apart from anything
-               -- else, their wired-in-ness is in the SrcLoca
-         | otherwise 
-         -> let 
-               new_name  = setNameModuleAndLoc name mod loc
-               new_cache = addToFM cache key new_name
-            in
-            setNameCache (name_supply {nsNames = new_cache})   `thenM_`
-            returnM new_name
+    case lookupOrigNameCache (nsNames name_supply) mod occ of
+
+       -- A hit in the cache!  We are at the binding site of the name.
+       -- This is the moment when we know the defining SrcLoc
+       -- of the Name, so we set the SrcLoc of the name we return.
+       --
+       -- Main reason: then (bogus) multiple bindings of the same Name
+       --              get different SrcLocs can can be reported as such.
+       --
+       -- Possible other reason: it might be in the cache because we
+       --      encountered an occurrence before the binding site for an
+       --      implicitly-imported Name.  Perhaps the current SrcLoc is
+       --      better... but not really: it'll still just say 'imported'
+       --
+       -- IMPORTANT: Don't mess with wired-in names.  
+       --            Their wired-in-ness is in the SrcLoc
+
+       Just name | isWiredInName name -> returnM name
+                 | otherwise          -> returnM (setNameSrcLoc name loc)
                     
        -- Miss in the cache!
        -- Build a completely new Name, and put it in the cache
-       -- Even for locally-defined names we use implicitImportProvenance; 
-       -- updateProvenances will set it to rights
-       Nothing -> addNewName name_supply key mod occ loc
-
-newGlobalName :: ModuleName -> OccName -> TcRn m Name
-  -- Used for *occurrences*.  We make a place-holder Name, really just
-  -- to agree on its unique, which gets overwritten when we read in
-  -- the binding occurence later (newTopBinder)
-  -- The place-holder Name doesn't have the right SrcLoc, and its
-  -- Module won't have the right Package either.
-  --
-  -- (We have to pass a ModuleName, not a Module, because we may be
-  -- simply looking at an occurrence M.x in an interface file.)
-  --
-  -- This means that a renamed program may have incorrect info
-  -- on implicitly-imported occurrences, but the correct info on the 
-  -- *binding* declaration. It's the type checker that propagates the 
-  -- correct information to all the occurrences.
-  -- Since implicitly-imported names never occur in error messages,
-  -- it doesn't matter that we get the correct info in place till later,
-  -- (but since it affects DLL-ery it does matter that we get it right
-  --  in the end).
-newGlobalName mod_name occ
-  = getNameCache               `thenM` \ name_supply ->
-    let
-       key = (mod_name, occ)
-       cache = nsNames name_supply
-    in
-    case lookupFM cache key of
-       Just name -> -- traceRn (text "newGlobalName: hit" <+> ppr name) `thenM_`
-                    returnM name
-
-       Nothing   -> -- traceRn (text "newGlobalName: new" <+> ppr name)  `thenM_`
-                    addNewName name_supply key (mkVanillaModule mod_name) occ noSrcLoc
+       Nothing -> addNewName name_supply mod occ loc
 
 -- Look up a "system name" in the name cache.
 -- This is done by the type checker... 
--- For *source* declarations, this will put the thing into the name cache
--- For *interface* declarations, RnHiFiles.getSysBinders will already have
--- put it into the cache.
 lookupSysName :: Name                  -- Base name
              -> (OccName -> OccName)   -- Occurrence name modifier
              -> TcRn m Name            -- System name
 lookupSysName base_name mk_sys_occ
+  = newGlobalName (nameModule base_name)
+                 (mk_sys_occ (nameOccName base_name))
+                 (nameSrcLoc base_name)    
+
+
+newGlobalNameFromRdrName rdr_name              -- Qualified original name
+ = newGlobalName2 (rdrNameModule rdr_name) (rdrNameOcc rdr_name)
+
+newGlobalName2 :: ModuleName -> OccName -> TcRn m Name
+  -- This one starts with a ModuleName, not a Module, because 
+  -- we may be simply looking at an occurrence M.x in an interface file.
+  --
+  -- Used for *occurrences*.  Even if we get a miss in the
+  -- original-name cache, we make a new External Name.
+  -- We get its Module either from the OrigNameCache, or (if this
+  -- is the first Name from that module) from the Finder
+  --
+  -- In the case of a miss, we have to make up the SrcLoc, but that's
+  -- OK: it must be an implicitly-imported Name, and that never occurs
+  -- in an error message.
+
+newGlobalName2 mod_name occ
   = getNameCache               `thenM` \ name_supply ->
     let
-       mod = nameModule base_name
-       occ = mk_sys_occ (nameOccName base_name)
-       key = (moduleName mod, occ)
+       new_name mod = addNewName name_supply mod occ importedSrcLoc
     in
-    case lookupFM (nsNames name_supply) key of
-       Just name -> returnM name
-       Nothing   -> addNewName name_supply key mod occ noSrcLoc
+    case lookupModuleEnvByName (nsNames name_supply) mod_name of
+      Just (mod, occ_env) ->   
+       -- There are some names from this module already
+       -- Next, look up in the OccNameEnv
+       case lookupFM occ_env occ of
+            Just name -> returnM name
+            Nothing   -> new_name mod
+
+      Nothing   ->     -- No names from this module yet
+       ioToTcRn (findModule mod_name)          `thenM` \ mb_loc ->
+       case mb_loc of
+           Right (mod, _) -> new_name mod
+           Left files     -> 
+               getDOpts `thenM` \ dflags ->
+               addErr (noIfaceErr dflags mod_name False files) `thenM_`
+                       -- Things have really gone wrong at this point,
+                       -- so having the wrong package info in the 
+                       -- Module is the least of our worries.
+               new_name (mkHomeModule mod_name)
+
 
 newIPName rdr_name_ip
   = getNameCache               `thenM` \ name_supply ->
@@ -178,20 +176,42 @@ newIPName rdr_name_ip
     where 
        key = rdr_name_ip       -- Ensures that ?x and %x get distinct Names
 
-addNewName :: NameCache -> (ModuleName,OccName) 
-          -> Module -> OccName -> SrcLoc -> TcRn m Name
--- Internal function: extend the name cache, dump it back into
---                   the monad, and return the new name
--- (internal, hence the rather redundant interface)
-addNewName name_supply key mod occ loc
+-- A local helper function
+addNewName name_supply mod occ loc
   = setNameCache new_name_supply       `thenM_`
     returnM name
   where
-     (us', us1) = splitUniqSupply (nsUniqs name_supply)
-     uniq      = uniqFromSupply us1
-     name       = mkExternalName uniq mod occ loc
-     new_cache  = addToFM (nsNames name_supply) key name
+    (new_name_supply, name) = newExternalName name_supply mod occ loc
+
+
+newExternalName :: NameCache -> Module -> OccName -> SrcLoc 
+                 -> (NameCache,Name)
+-- Allocate a new unique, manufacture a new External Name,
+-- put it in the cache, and return the two
+newExternalName name_supply mod occ loc
+  = (new_name_supply, name)
+  where
+     (us', us1)      = splitUniqSupply (nsUniqs name_supply)
+     uniq           = uniqFromSupply us1
+     name            = mkExternalName uniq mod occ loc
+     new_cache       = extend_name_cache (nsNames name_supply) mod occ name
      new_name_supply = name_supply {nsUniqs = us', nsNames = new_cache}
+
+lookupOrigNameCache :: OrigNameCache -> Module -> OccName -> Maybe Name
+lookupOrigNameCache nc mod occ
+  = case lookupModuleEnv nc mod of
+       Nothing           -> Nothing
+       Just (_, occ_env) -> lookupFM occ_env occ
+
+extendOrigNameCache :: OrigNameCache -> Name -> OrigNameCache
+extendOrigNameCache nc name 
+  = extend_name_cache nc (nameModule name) (nameOccName name) name
+
+extend_name_cache :: OrigNameCache -> Module -> OccName -> Name -> OrigNameCache
+extend_name_cache nc mod occ name
+  = extendModuleEnv_C combine nc mod (mod, unitFM occ name)
+  where
+    combine (mod, occ_env) _ = (mod, addToFM occ_env occ name)
 \end{code}
 
 %*********************************************************
@@ -216,19 +236,12 @@ lookupTopBndrRn rdr_name
 -- A separate function (importsFromLocalDecls) reports duplicate top level
 -- decls, so here it's safe just to choose an arbitrary one.
 
-       -- There should never be a qualified name in a binding position 
-       -- The parser could check this, but doesn't (yet)
-  | isQual rdr_name
-  = getSrcLocM                                                 `thenM` \ loc ->
-    qualNameErr (text "In its declaration") (rdr_name,loc)     `thenM_`
-    returnM (mkUnboundName rdr_name)
-
-  | otherwise
-  = ASSERT( not (isOrig rdr_name) )
-       -- Original names are used only for occurrences, 
-       -- not binding sites
+-- There should never be a qualified name in a binding position in Haskell,
+-- but there can be if we have read in an external-Core file.
+-- The Haskell parser checks for the illegal qualified name in Haskell 
+-- source files, so we don't need to do so here.
 
-    getModeRn                  `thenM` \ mode ->
+  = getModeRn                  `thenM` \ mode ->
     case mode of
        InterfaceMode mod -> 
            getSrcLocM          `thenM` \ loc ->
@@ -304,8 +317,9 @@ lookupInstDeclBndr cls_name rdr_name
     getGblEnv                          `thenM` \ gbl_env ->
     let
        avail_env = imp_env (tcg_imports gbl_env)
+        occ       = rdrNameOcc rdr_name
     in
-    case lookupAvailEnv avail_env cls_name of
+    case lookupAvailEnv_maybe avail_env cls_name of
        Nothing -> 
            -- If the class itself isn't in scope, then cls_name will
            -- be unboundName, and there'll already be an error for
@@ -321,19 +335,14 @@ lookupInstDeclBndr cls_name rdr_name
 
        other               -> pprPanic "lookupInstDeclBndr" (ppr cls_name)
 
-  | isQual rdr_name    -- Should never have a qualified name in a binding position
-  = getSrcLocM                                                 `thenM` \ loc ->
-    qualNameErr (text "In an instance method") (rdr_name,loc)  `thenM_`
-    returnM (mkUnboundName rdr_name)
-       
+
   | otherwise          -- Occurs in derived instances, where we just
                        -- refer directly to the right method, and avail_env
                        -- isn't available
   = ASSERT2( not (isQual rdr_name), ppr rdr_name )
+         -- NB: qualified names are rejected by the parser
     lookupOrigName rdr_name
 
-  where
-    occ = rdrNameOcc rdr_name
 
 lookupSysBndr :: RdrName -> RnM Name
 -- Used for the 'system binders' in a data type or class declaration
@@ -415,8 +424,7 @@ lookupSrcName_maybe rdr_name
   = returnM (Just name)
 
   | isOrig rdr_name                    -- An original name
-  = newGlobalName (rdrNameModule rdr_name) 
-                 (rdrNameOcc rdr_name) `thenM` \ name ->
+  = newGlobalNameFromRdrName rdr_name  `thenM` \ name ->
     returnM (Just name)
 
   | otherwise
@@ -442,7 +450,7 @@ lookupIfaceName :: Module -> RdrName -> TcRn m Name
        -- unqualified names for locally-defined things, such as
        -- constructors of a data type.
 lookupIfaceName mod rdr_name
-  | isUnqual rdr_name = newGlobalName (moduleName mod) (rdrNameOcc rdr_name)
+  | isUnqual rdr_name = newGlobalName mod (rdrNameOcc rdr_name) importedSrcLoc
   | otherwise        = lookupOrigName rdr_name
 
 lookupOrigName :: RdrName -> TcRn m Name
@@ -455,7 +463,7 @@ lookupOrigName rdr_name
 
   | otherwise  -- Usually Orig, but can be a Qual when 
                -- we are reading a .hi-boot file
-  = newGlobalName (rdrNameModule rdr_name) (rdrNameOcc rdr_name)
+  = newGlobalNameFromRdrName rdr_name
 
 
 dataTcOccs :: RdrName -> [RdrName]
@@ -483,15 +491,19 @@ unboundName rdr_name = addErr (unknownNameErr rdr_name)   `thenM_`
 
 \begin{code}
 --------------------------------
-bindLocalFixities :: [RenamedFixitySig] -> RnM a -> RnM a
+bindLocalFixities :: [RdrNameFixitySig] -> RnM a -> RnM a
 -- Used for nested fixity decls
 -- No need to worry about type constructors here,
 -- Should check for duplicates but we don't
 bindLocalFixities fixes thing_inside
   | null fixes = thing_inside
-  | otherwise  = extendFixityEnv new_bit thing_inside
+  | otherwise  = mappM rn_sig fixes    `thenM` \ new_bit ->
+                extendFixityEnv new_bit thing_inside
   where
-    new_bit = [(n,s) | s@(FixitySig n _ _) <- fixes]
+    rn_sig (FixitySig v fix src_loc)
+       = addSrcLoc src_loc $
+         lookupSigOccRn v              `thenM` \ new_v ->
+         returnM (new_v, FixitySig new_v fix src_loc)
 \end{code}
 
 --------------------------------
@@ -561,27 +573,39 @@ implicitModuleFVs source_fvs
     namesNeededForFlattening           `plusFV`
     ubiquitousNames
 
+
+thProxyName :: NameSet
+mkTemplateHaskellFVs :: NameSet -> NameSet
        -- This is a bit of a hack.  When we see the Template-Haskell construct
        --      [| expr |]
        -- we are going to need lots of the ``smart constructors'' defined in
        -- the main Template Haskell data type module.  Rather than treat them
        -- all as free vars at every occurrence site, we just make the Q type
        -- consructor a free var.... and then use that here to haul in the others
-mkTemplateHaskellFVs source_fvs
+
 #ifdef GHCI
-       -- Only if Template Haskell is enabled
+---------------        Template Haskell enabled --------------
+thProxyName = unitFV qTyConName
+
+mkTemplateHaskellFVs source_fvs
   | qTyConName `elemNameSet` source_fvs = templateHaskellNames
-#endif
   | otherwise                          = emptyFVs
 
+#else
+---------------        Template Haskell disabled --------------
+
+thProxyName                    = emptyFVs
+mkTemplateHaskellFVs source_fvs = emptyFVs
+#endif
+--------------------------------------------------------
+
 -- ubiquitous_names are loaded regardless, because 
 -- they are needed in virtually every program
 ubiquitousNames 
   = mkFVs [unpackCStringName, unpackCStringFoldrName, 
-          unpackCStringUtf8Name, eqStringName]
+          unpackCStringUtf8Name, eqStringName,
                -- Virtually every program has error messages in it somewhere
-         `plusFV`
-    mkFVs [getName unitTyCon, funTyConName, boolTyConName, intTyConName]
+          getName unitTyCon, funTyConName, boolTyConName, intTyConName]
                -- Add occurrences for very frequently used types.
                --       (e.g. we don't want to be bothered with making 
                --        funTyCon a free var at every function application!)
@@ -624,21 +648,34 @@ checks the type of the user thing against the type of the standard thing.
 lookupSyntaxName :: Name                       -- The standard name
                 -> RnM (Name, FreeVars)        -- Possibly a non-standard name
 lookupSyntaxName std_name
-  = getModeRn                          `thenM` \ mode ->
-    if isInterfaceMode mode then
-       returnM (std_name, unitFV std_name)
-                               -- Happens for 'derived' code
-                               -- where we don't want to rebind
+  = doptM Opt_NoImplicitPrelude                `thenM` \ no_prelude -> 
+    if not no_prelude then normal_case
     else
-
-    doptM Opt_NoImplicitPrelude                `thenM` \ no_prelude -> 
-    if not no_prelude then
-       returnM (std_name, unitFV std_name)     -- Normal case
-
+    getModeRn                          `thenM` \ mode ->
+    if isInterfaceMode mode then normal_case
+       -- Happens for 'derived' code where we don't want to rebind
     else
        -- Get the similarly named thing from the local environment
     lookupOccRn (mkRdrUnqual (nameOccName std_name)) `thenM` \ usr_name ->
     returnM (usr_name, mkFVs [usr_name, std_name])
+  where
+    normal_case = returnM (std_name, unitFV std_name)
+
+lookupSyntaxNames :: [Name]                            -- Standard names
+                 -> RnM (ReboundNames Name, FreeVars)  -- See comments with HsExpr.ReboundNames
+lookupSyntaxNames std_names
+  = doptM Opt_NoImplicitPrelude                `thenM` \ no_prelude -> 
+    if not no_prelude then normal_case 
+    else
+    getModeRn                          `thenM` \ mode ->
+    if isInterfaceMode mode then normal_case
+    else
+       -- Get the similarly named thing from the local environment
+    mappM (lookupOccRn . mkRdrUnqual . nameOccName) std_names  `thenM` \ usr_names ->
+
+    returnM (std_names `zip` map HsVar usr_names, mkFVs std_names `plusFV` mkFVs usr_names)
+  where
+    normal_case = returnM (std_names `zip` map HsVar std_names, mkFVs std_names)
 \end{code}
 
 
@@ -744,7 +781,7 @@ bindLocalsRn doc rdr_names enclosed_scope
 
        -- binLocalsFVRn is the same as bindLocalsRn
        -- except that it deals with free vars
-bindLocalsFVRn doc rdr_names enclosed_scope
+bindLocalsFV doc rdr_names enclosed_scope
   = bindLocalsRn doc rdr_names         $ \ names ->
     enclosed_scope names               `thenM` \ (thing, fvs) ->
     returnM (thing, delListFromNameSet fvs names)
@@ -767,13 +804,11 @@ bindTyVarsRn doc_str tyvar_names enclosed_scope
     bindLocatedLocalsRn doc_str located_tyvars $ \ names ->
     enclosed_scope (zipWith replaceTyVarName tyvar_names names)
 
-bindPatSigTyVars :: [RdrNameHsType]
-                -> RnM (a, FreeVars)
-                -> RnM (a, FreeVars)
+bindPatSigTyVars :: [RdrNameHsType] -> ([Name] -> RnM a) -> RnM a
   -- Find the type variables in the pattern type 
   -- signatures that must be brought into scope
 
-bindPatSigTyVars tys enclosed_scope
+bindPatSigTyVars tys thing_inside
   = getLocalRdrEnv             `thenM` \ name_env ->
     getSrcLocM                 `thenM` \ loc ->
     let
@@ -788,10 +823,15 @@ bindPatSigTyVars tys enclosed_scope
        located_tyvars = [(tv, loc) | tv <- forall_tyvars] 
        doc_sig        = text "In a pattern type-signature"
     in
-    bindLocatedLocalsRn doc_sig located_tyvars $ \ names ->
-    enclosed_scope                             `thenM` \ (thing, fvs) ->
-    returnM (thing, delListFromNameSet fvs names)
+    bindLocatedLocalsRn doc_sig located_tyvars thing_inside
 
+bindPatSigTyVarsFV :: [RdrNameHsType]
+                  -> RnM (a, FreeVars)
+                  -> RnM (a, FreeVars)
+bindPatSigTyVarsFV tys thing_inside
+  = bindPatSigTyVars tys       $ \ tvs ->
+    thing_inside               `thenM` \ (result,fvs) ->
+    returnM (result, fvs `delListFromNameSet` tvs)
 
 -------------------------------------
 checkDupOrQualNames, checkDupNames :: SDoc
@@ -800,8 +840,11 @@ checkDupOrQualNames, checkDupNames :: SDoc
        -- Works in any variant of the renamer monad
 
 checkDupOrQualNames doc_str rdr_names_w_loc
-  =    -- Check for use of qualified names
-    mappM_ (qualNameErr doc_str) quals         `thenM_`
+  =    -- Qualified names in patterns are now rejected by the parser
+       -- but I'm not 100% certain that it finds all cases, so I've left
+       -- this check in for now.  Should go eventually.
+       --      Hmm.  Sooner rather than later.. data type decls
+--     mappM_ (qualNameErr doc_str) quals      `thenM_`
     checkDupNames doc_str rdr_names_w_loc
   where
     quals = filter (isQual . fst) rdr_names_w_loc
@@ -862,10 +905,11 @@ mkGlobalRdrEnv this_mod unqual_imp mk_provenance avails deprecs
        where
          occ  = nameOccName name
          elt  = GRE {gre_name   = name,
-                     gre_parent = parent, 
+                     gre_parent = if name == parent 
+                                  then Nothing 
+                                  else Just parent, 
                      gre_prov   = mk_provenance name, 
                      gre_deprec = lookupDeprec deprecs name}
-                     
 \end{code}
 
 \begin{code}
@@ -958,44 +1002,37 @@ warnUnusedLocals names = warnUnusedBinds [(n,LocalDef) | n<-names]
 
 warnUnusedBinds :: [(Name,Provenance)] -> TcRn m ()
 warnUnusedBinds names
-  = mappM_ warnUnusedGroup  groups
+  = mappM_ warnUnusedGroup groups
   where
        -- Group by provenance
-   groups = equivClasses cmp names
+   groups = equivClasses cmp (filter reportable names)
    (_,prov1) `cmp` (_,prov2) = prov1 `compare` prov2
  
+   reportable (name,_) = reportIfUnused (nameOccName name)
+
 
 -------------------------
 
 warnUnusedGroup :: [(Name,Provenance)] -> TcRn m ()
 warnUnusedGroup names
-  | null filtered_names  = returnM ()
-  | not is_local        = returnM ()
-  | otherwise
   = addSrcLoc def_loc  $
-    addWarn                    $
-    sep [msg <> colon, nest 4 (fsep (punctuate comma (map (ppr.fst) filtered_names)))]
+    addWarn            $
+    sep [msg <> colon, nest 4 (fsep (punctuate comma (map (ppr.fst) names)))]
   where
-    filtered_names = filter reportable names
-    (name1, prov1) = head filtered_names
-    (is_local, def_loc, msg)
-       = case prov1 of
-               LocalDef -> (True, getSrcLoc name1, text "Defined but not used")
-
-               NonLocalDef (UserImport mod loc _)
-                       -> (True, loc, text "Imported from" <+> quotes (ppr mod) <+> text "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 "_".
+    (name1, prov1) = head names
+    loc1          = nameSrcLoc name1
+    (def_loc, msg) = case prov1 of
+                       LocalDef                           -> (loc1, unused_msg)
+                       NonLocalDef (UserImport mod loc _) -> (loc,  imp_from mod)
+
+    unused_msg   = text "Defined but not used"
+    imp_from mod = text "Imported from" <+> quotes (ppr mod) <+> text "but not used"
 \end{code}
 
 \begin{code}
 addNameClashErrRn rdr_name (np1:nps)
   = addErr (vcat [ptext SLIT("Ambiguous occurrence") <+> quotes (ppr rdr_name),
-                   ptext SLIT("It could refer to") <+> vcat (msg1 : msgs)])
+                 ptext SLIT("It could refer to") <+> vcat (msg1 : msgs)])
   where
     msg1 = ptext  SLIT("either") <+> mk_ref np1
     msgs = [ptext SLIT("    or") <+> mk_ref np | np <- nps]
@@ -1026,6 +1063,16 @@ dupNamesErr descriptor ((name,loc) : dup_things)
              $$ 
              descriptor)
 
+noIfaceErr dflags mod_name boot_file files
+  = ptext SLIT("Could not find interface file for") <+> quotes (ppr mod_name)
+    $$ extra
+  where 
+   extra
+    | verbosity dflags < 3 = 
+        text "(use -v to see a list of the files searched for)"
+    | otherwise =
+        hang (ptext SLIT("locations searched:")) 4 (vcat (map text files))
+
 warnDeprec :: GlobalRdrElt -> TcRn m ()
 warnDeprec (GRE {gre_name = name, gre_deprec = Just txt})
   = ifOptM Opt_WarnDeprecations        $