projects / ghc-hetmet.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
[project @ 2003-07-23 13:08:55 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 affbcc9..84d0f69 100644 (file)
--- a/ghc/compiler/rename/RnEnv.lhs
+++ b/ghc/compiler/rename/RnEnv.lhs
@@ -8,54 +8,53 @@ module RnEnv where            -- Export everything
 
 #include "HsVersions.h"
 
 
 #include "HsVersions.h"
 
-import {-# SOURCE #-} RnHiFiles
+import {-# SOURCE #-} RnHiFiles( loadInterface )
 
 
+import FlattenInfo      ( namesNeededForFlattening )
 import HsSyn
 import HsSyn
-import RdrHsSyn                ( RdrNameIE, RdrNameHsType, extractHsTyRdrTyVars )
+import RdrHsSyn                ( RdrNameHsType, RdrNameFixitySig, extractHsTyRdrTyVars )
 import RdrName         ( RdrName, rdrNameModule, rdrNameOcc, isQual, isUnqual, isOrig,
 import RdrName         ( RdrName, rdrNameModule, rdrNameOcc, isQual, isUnqual, isOrig,
-                         mkRdrUnqual, mkRdrQual, 
-                         lookupRdrEnv, foldRdrEnv, rdrEnvToList, elemRdrEnv,
-                         unqualifyRdrName
+                         mkRdrUnqual, mkRdrQual, setRdrNameSpace, rdrNameOcc,
+                         lookupRdrEnv, rdrEnvToList, elemRdrEnv, 
+                         extendRdrEnv, addListToRdrEnv, emptyRdrEnv,
+                         isExact_maybe, unqualifyRdrName
                        )
 import HsTypes         ( hsTyVarName, replaceTyVarName )
 import HscTypes                ( Provenance(..), pprNameProvenance, hasBetterProv,
                        )
 import HsTypes         ( hsTyVarName, replaceTyVarName )
 import HscTypes                ( Provenance(..), pprNameProvenance, hasBetterProv,
-                         ImportReason(..), GlobalRdrEnv, GlobalRdrElt(..), AvailEnv,
-                         AvailInfo, Avails, GenAvailInfo(..), NameSupply(..), 
-                         ModIface(..),
-                         Deprecations(..), lookupDeprec,
-                         extendLocalRdrEnv
+                         ImportReason(..), GlobalRdrEnv, GlobalRdrElt(..), 
+                         GenAvailInfo(..), AvailInfo, Avails, 
+                         ModIface(..), NameCache(..), OrigNameCache,
+                         Deprecations(..), lookupDeprec, isLocalGRE,
+                         extendLocalRdrEnv, availName, availNames,
+                         lookupFixity
                        )
                        )
-import RnMonad
-import Name            ( Name, 
-                         getSrcLoc, nameIsLocalOrFrom,
-                         mkLocalName, mkGlobalName, nameModule,
-                         mkIPName, nameOccName, nameModule_maybe,
-                         setNameModuleAndLoc
-                       )
-import NameEnv
+import TcRnMonad
+import Name            ( Name, getName, nameIsLocalOrFrom, 
+                         isWiredInName, mkInternalName, mkExternalName, mkIPName, 
+                         nameSrcLoc, nameOccName, setNameSrcLoc, nameModule    )
 import NameSet
 import NameSet
-import OccName         ( OccName, occNameUserString, occNameFlavour )
-import Module          ( ModuleName, moduleName, mkVanillaModule, 
-                         mkSysModuleNameFS, moduleNameFS, WhereFrom(..) )
-import PrelNames       ( mkUnboundName, 
-                         derivingOccurrences,
-                         mAIN_Name, pREL_MAIN_Name, 
-                         ioTyConName, intTyConName, 
+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,
                          boolTyConName, funTyConName,
                          unpackCStringName, unpackCStringFoldrName, unpackCStringUtf8Name,
-                         eqStringName, printName, 
-                         bindIOName, returnIOName, failIOName
+                         eqStringName, printName, integerTyConName,
+                         bindIOName, returnIOName, failIOName, thenIOName,
+                         rOOT_MAIN_Name
                        )
                        )
+#ifdef GHCI    
+import DsMeta          ( templateHaskellNames, qTyConName )
+#endif
 import TysWiredIn      ( unitTyCon )   -- A little odd
 import TysWiredIn      ( unitTyCon )   -- A little odd
+import Finder          ( findModule )
 import FiniteMap
 import UniqSupply
 import FiniteMap
 import UniqSupply
-import SrcLoc          ( SrcLoc, noSrcLoc )
+import SrcLoc          ( SrcLoc, importedSrcLoc )
 import Outputable
 import ListSetOps      ( removeDups, equivClasses )
 import Outputable
 import ListSetOps      ( removeDups, equivClasses )
-import Util            ( sortLt )
-import BasicTypes      ( mapIPName )
+import BasicTypes      ( mapIPName, FixitySig(..) )
 import List            ( nub )
 import List            ( nub )
-import UniqFM          ( lookupWithDefaultUFM )
 import CmdLineOpts
 import FastString      ( FastString )
 \end{code}
 import CmdLineOpts
 import FastString      ( FastString )
 \end{code}
@@ -67,110 +66,120 @@ import FastString ( FastString )
 %*********************************************************
 
 \begin{code}
 %*********************************************************
 
 \begin{code}
-newTopBinder :: Module -> RdrName -> SrcLoc -> RnM d 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 :: Module -> RdrName -> SrcLoc -> TcRn m Name
 newTopBinder mod rdr_name loc
 newTopBinder mod rdr_name loc
-  =    -- First check the cache
+  | Just name <- isExact_maybe rdr_name
+  = returnM name
 
 
-       -- There should never be a qualified name in a binding position (except in instance decls)
-       -- The parser doesn't check this because the same parser parses instance decls
-    (if isQual rdr_name then
-       qualNameErr (text "In its declaration") (rdr_name,loc)
-     else
-       returnRn ()
-    )                          `thenRn_`
-
-    getNameSupplyRn            `thenRn` \ 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 -> let 
-                       new_name  = setNameModuleAndLoc name mod loc
-                       new_cache = addToFM cache key new_name
-                    in
-                    setNameSupplyRn (name_supply {nsNames = new_cache})        `thenRn_`
---                  traceRn (text "newTopBinder: overwrite" <+> ppr new_name) `thenRn_`
-                    returnRn new_name
+  | isOrig rdr_name
+  = ASSERT( rdr_mod == moduleName mod || rdr_mod == rOOT_MAIN_Name )
+       -- When reading External Core we get Orig names as binders, 
+       -- but they should agree with the module gotten from the monad
+       --
+       -- Except for the ":Main.main = ..." definition inserted into 
+       -- the Main module
+       --
+       -- Because of this latter case, we take the module from the RdrName,
+       -- not from the environment.  In principle, it'd be fine to have an
+       -- arbitrary mixture of external core definitions in a single module,
+       -- (apart from module-initialisation issues, perhaps).
+    newGlobalName (mkHomeModule rdr_mod) (rdrNameOcc rdr_name) loc
+
+  | otherwise
+  = newGlobalName mod (rdrNameOcc rdr_name) loc
+  where
+    rdr_mod = rdrNameModule rdr_name
+
+newGlobalName :: Module -> OccName -> SrcLoc -> TcRn m Name
+newGlobalName mod occ loc
+  =    -- First check the cache
+    getNameCache               `thenM` \ name_supply -> 
+    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
                     
        -- 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 -> let
-                       (us', us1) = splitUniqSupply (nsUniqs name_supply)
-                       uniq       = uniqFromSupply us1
-                       new_name   = mkGlobalName uniq mod occ loc
-                       new_cache  = addToFM cache key new_name
-                  in
-                  setNameSupplyRn (name_supply {nsUniqs = us', nsNames = new_cache})   `thenRn_`
---                traceRn (text "newTopBinder: new" <+> ppr new_name) `thenRn_`
-                  returnRn new_name
-
-
-newGlobalName :: ModuleName -> OccName -> RnM d 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.
+       Nothing -> addNewName name_supply mod occ loc
+
+-- Look up a "system name" in the name cache.
+-- This is done by the type checker... 
+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.
   --
   --
-  -- (We have to pass 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
   --
   --
-  -- 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
-  = getNameSupplyRn            `thenRn` \ name_supply ->
+  -- 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
     let
-       key = (mod_name, occ)
-       cache = nsNames name_supply
+       new_name mod = addNewName name_supply mod occ importedSrcLoc
     in
     in
-    case lookupFM cache key of
-       Just name -> -- traceRn (text "newGlobalName: hit" <+> ppr name) `thenRn_`
-                    returnRn name
+    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)
 
 
-       Nothing   -> setNameSupplyRn (name_supply {nsUniqs = us', nsNames = new_cache})  `thenRn_`
-                    -- traceRn (text "newGlobalName: new" <+> ppr name)                  `thenRn_`
-                    returnRn name
-                 where
-                    (us', us1) = splitUniqSupply (nsUniqs name_supply)
-                    uniq       = uniqFromSupply us1
-                    mod        = mkVanillaModule mod_name
-                    name       = mkGlobalName uniq mod occ noSrcLoc
-                    new_cache  = addToFM cache key name
 
 newIPName rdr_name_ip
 
 newIPName rdr_name_ip
-  = getNameSupplyRn            `thenRn` \ name_supply ->
+  = getNameCache               `thenM` \ name_supply ->
     let
        ipcache = nsIPs name_supply
     in
     case lookupFM ipcache key of
     let
        ipcache = nsIPs name_supply
     in
     case lookupFM ipcache key of
-       Just name_ip -> returnRn name_ip
-       Nothing      -> setNameSupplyRn new_ns  `thenRn_`
-                       returnRn name_ip
+       Just name_ip -> returnM name_ip
+       Nothing      -> setNameCache new_ns     `thenM_`
+                       returnM name_ip
                  where
                     (us', us1)  = splitUniqSupply (nsUniqs name_supply)
                     uniq        = uniqFromSupply us1
                  where
                     (us', us1)  = splitUniqSupply (nsUniqs name_supply)
                     uniq        = uniqFromSupply us1
@@ -180,6 +189,43 @@ newIPName rdr_name_ip
                     new_ns      = name_supply {nsUniqs = us', nsIPs = new_ipcache}
     where 
        key = rdr_name_ip       -- Ensures that ?x and %x get distinct Names
                     new_ns      = name_supply {nsUniqs = us', nsIPs = new_ipcache}
     where 
        key = rdr_name_ip       -- Ensures that ?x and %x get distinct Names
+
+-- A local helper function
+addNewName name_supply mod occ loc
+  = setNameCache new_name_supply       `thenM_`
+    returnM name
+  where
+    (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}
 
 %*********************************************************
 \end{code}
 
 %*********************************************************
@@ -192,9 +238,9 @@ Looking up a name in the RnEnv.
 
 \begin{code}
 lookupBndrRn rdr_name
 
 \begin{code}
 lookupBndrRn rdr_name
-  = getLocalNameEnv            `thenRn` \ local_env ->
+  = getLocalRdrEnv             `thenM` \ local_env ->
     case lookupRdrEnv local_env rdr_name of 
     case lookupRdrEnv local_env rdr_name of 
-         Just name -> returnRn name
+         Just name -> returnM name
          Nothing   -> lookupTopBndrRn rdr_name
 
 lookupTopBndrRn rdr_name
          Nothing   -> lookupTopBndrRn rdr_name
 
 lookupTopBndrRn rdr_name
@@ -204,31 +250,59 @@ lookupTopBndrRn rdr_name
 -- A separate function (importsFromLocalDecls) reports duplicate top level
 -- decls, so here it's safe just to choose an arbitrary one.
 
 -- A separate function (importsFromLocalDecls) reports duplicate top level
 -- decls, so here it's safe just to choose an arbitrary one.
 
-  | isOrig rdr_name
+-- 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 ->
+    case mode of
+       InterfaceMode mod -> 
+           getSrcLocM          `thenM` \ loc ->
+           newTopBinder mod rdr_name loc
+
+       other -> lookupTopSrcBndr rdr_name
+
+lookupTopSrcBndr :: RdrName -> TcRn m Name
+lookupTopSrcBndr rdr_name
+  = lookupTopSrcBndr_maybe rdr_name    `thenM` \ maybe_name ->
+    case maybe_name of
+       Just name -> returnM name
+       Nothing   -> unboundName rdr_name
+                               
+
+lookupTopSrcBndr_maybe :: RdrName -> TcRn m (Maybe Name)
+-- Look up a source-code binder 
+
+-- Ignores imported names; for example, this is OK:
+--     import Foo( f )
+--     infix 9 f       -- The 'f' here does not need to be qualified
+--     f x = x         -- Nor here, of course
+
+lookupTopSrcBndr_maybe rdr_name
+  | Just name <- isExact_maybe rdr_name
        -- This is here just to catch the PrelBase defn of (say) [] and similar
        -- This is here just to catch the PrelBase defn of (say) [] and similar
-       -- The parser reads the special syntax and returns an Orig RdrName
+       -- The parser reads the special syntax and returns an Exact RdrName
        -- But the global_env contains only Qual RdrNames, so we won't
        -- find it there; instead just get the name via the Orig route
        -- But the global_env contains only Qual RdrNames, so we won't
        -- find it there; instead just get the name via the Orig route
-  = lookupOrigName rdr_name
+       --
+       -- We are at a binding site for the name, so check first that it 
+       -- the current module is the correct one; otherwise GHC can get
+       -- very confused indeed.  This test rejects code like
+       --      data T = (,) Int Int
+       -- unless we are in GHC.Tup
+  = getModule                          `thenM` \ mod -> 
+    checkErr (moduleName mod == moduleName (nameModule name))
+            (badOrigBinding rdr_name)  `thenM_`
+    returnM (Just name)
 
   | otherwise
 
   | otherwise
-  = getModeRn  `thenRn` \ mode ->
-    if isInterfaceMode mode
-       then lookupIfaceName rdr_name   
-    else 
-    getModuleRn                `thenRn` \ mod ->
-    getGlobalNameEnv   `thenRn` \ global_env ->
-    case lookup_local mod global_env rdr_name of
-       Just name -> returnRn name
-       Nothing   -> failWithRn (mkUnboundName rdr_name)
-                               (unknownNameErr rdr_name)
-  where
-    lookup_local mod global_env rdr_name
-      = case lookupRdrEnv global_env rdr_name of
-         Nothing   -> Nothing
-         Just gres -> case [n | GRE n _ _ <- gres, nameIsLocalOrFrom mod n] of
-                        []     -> Nothing
-                        (n:ns) -> Just n
+  = getGlobalRdrEnv                    `thenM` \ global_env ->
+    case lookupRdrEnv global_env rdr_name of
+         Nothing   -> returnM Nothing
+         Just gres -> case [gre_name gre | gre <- gres, isLocalGRE gre] of
+                        []     -> returnM Nothing
+                        (n:ns) -> returnM (Just n)
              
 
 -- lookupSigOccRn is used for type signatures and pragmas
              
 
 -- lookupSigOccRn is used for type signatures and pragmas
@@ -241,40 +315,69 @@ lookupTopBndrRn rdr_name
 -- The Haskell98 report does not stipulate this, but it will!
 -- So we must treat the 'f' in the signature in the same way
 -- as the binding occurrence of 'f', using lookupBndrRn
 -- The Haskell98 report does not stipulate this, but it will!
 -- So we must treat the 'f' in the signature in the same way
 -- as the binding occurrence of 'f', using lookupBndrRn
-lookupSigOccRn :: RdrName -> RnMS Name
+lookupSigOccRn :: RdrName -> RnM Name
 lookupSigOccRn = lookupBndrRn
 
 -- lookupInstDeclBndr is used for the binders in an 
 -- instance declaration.   Here we use the class name to
 -- disambiguate.  
 
 lookupSigOccRn = lookupBndrRn
 
 -- lookupInstDeclBndr is used for the binders in an 
 -- instance declaration.   Here we use the class name to
 -- disambiguate.  
 
-lookupInstDeclBndr :: Name -> RdrName -> RnMS Name
+lookupInstDeclBndr :: Name -> RdrName -> RnM Name
        -- We use the selector name as the binder
 lookupInstDeclBndr cls_name rdr_name
        -- We use the selector name as the binder
 lookupInstDeclBndr cls_name rdr_name
-  | isOrig rdr_name    -- Occurs in derived instances, where we just
-                       -- refer diectly to the right method
-  = lookupOrigName rdr_name
-
-  | otherwise  
-  = getGlobalAvails    `thenRn` \ avail_env ->
-    case lookupNameEnv avail_env cls_name of
-         -- class not in scope; don't fail as later checks will catch this,
-         -- but just return (bogus) name. Icky.
-       Nothing -> returnRn (mkUnboundName rdr_name)
+  | isUnqual rdr_name
+  =    -- Find all the things the class op name maps to
+       -- and pick the one with the right parent name
+    getGblEnv                          `thenM` \ gbl_env ->
+    let
+       avail_env = imp_env (tcg_imports gbl_env)
+        occ       = rdrNameOcc rdr_name
+    in
+    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
+           -- that in the error list.  Example:
+           -- e.g.   import Prelude hiding( Ord )
+           --      instance Ord T where ...
+           -- The program is wrong, but that should not cause a crash.
+               returnM (mkUnboundName rdr_name)
+
        Just (AvailTC _ ns) -> case [n | n <- ns, nameOccName n == occ] of
        Just (AvailTC _ ns) -> case [n | n <- ns, nameOccName n == occ] of
-                               (n:ns)-> ASSERT( null ns ) returnRn n
-                               []    -> failWithRn (mkUnboundName rdr_name)
-                                                   (unknownNameErr rdr_name)
+                               (n:ns)-> ASSERT( null ns ) returnM n
+                               []    -> unboundName rdr_name
+
        other               -> pprPanic "lookupInstDeclBndr" (ppr cls_name)
        other               -> pprPanic "lookupInstDeclBndr" (ppr cls_name)
-  where
-    occ = rdrNameOcc 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
+
+
+lookupSysBndr :: RdrName -> RnM Name
+-- Used for the 'system binders' in a data type or class declaration
+-- Do *not* look up in the RdrEnv; these system binders are never in scope
+-- Instead, get the module from the monad... but remember that
+-- where the module is depends on whether we are renaming source or 
+-- interface file stuff
+lookupSysBndr rdr_name
+  = getSrcLocM         `thenM` \ loc ->
+    getModeRn          `thenM` \ mode ->
+    case mode of
+       InterfaceMode mod -> newTopBinder mod rdr_name loc
+       other             -> getModule  `thenM` \ mod ->
+                            newTopBinder mod rdr_name loc
 
 -- lookupOccRn looks up an occurrence of a RdrName
 
 -- lookupOccRn looks up an occurrence of a RdrName
-lookupOccRn :: RdrName -> RnMS Name
+lookupOccRn :: RdrName -> RnM Name
 lookupOccRn rdr_name
 lookupOccRn rdr_name
-  = getLocalNameEnv                    `thenRn` \ local_env ->
+  = getLocalRdrEnv                     `thenM` \ local_env ->
     case lookupRdrEnv local_env rdr_name of
     case lookupRdrEnv local_env rdr_name of
-         Just name -> returnRn name
+         Just name -> returnM name
          Nothing   -> lookupGlobalOccRn rdr_name
 
 -- lookupGlobalOccRn is like lookupOccRn, except that it looks in the global 
          Nothing   -> lookupGlobalOccRn rdr_name
 
 -- lookupGlobalOccRn is like lookupOccRn, except that it looks in the global 
@@ -283,18 +386,14 @@ lookupOccRn rdr_name
 --     class op names in class and instance decls
 
 lookupGlobalOccRn rdr_name
 --     class op names in class and instance decls
 
 lookupGlobalOccRn rdr_name
-  = getModeRn          `thenRn` \ mode ->
-    if (isInterfaceMode mode)
-       then lookupIfaceName rdr_name
-       else 
-
-    getGlobalNameEnv   `thenRn` \ global_env ->
-    case mode of 
-       SourceMode -> lookupSrcName global_env rdr_name
+  = getModeRn          `thenM` \ mode ->
+    case mode of
+       InterfaceMode mod -> lookupIfaceName mod rdr_name 
+       SourceMode        -> lookupSrcName       rdr_name 
 
 
-       CmdLineMode
+       CmdLineMode 
         | not (isQual rdr_name) -> 
         | not (isQual rdr_name) -> 
-               lookupSrcName global_env rdr_name
+               lookupSrcName rdr_name
 
                -- We allow qualified names on the command line to refer to 
                -- *any* name exported by any module in scope, just as if 
 
                -- We allow qualified names on the command line to refer to 
                -- *any* name exported by any module in scope, just as if 
@@ -305,94 +404,168 @@ lookupGlobalOccRn rdr_name
                -- it isn't there, we manufacture a new occurrence of an
                -- original name.
         | otherwise -> 
                -- it isn't there, we manufacture a new occurrence of an
                -- original name.
         | otherwise -> 
-               case lookupRdrEnv global_env rdr_name of
-                      Just _  -> lookupSrcName global_env rdr_name
-                      Nothing -> lookupQualifiedName rdr_name
+               lookupSrcName_maybe rdr_name    `thenM` \ mb_name ->
+               case mb_name of
+                 Just name -> returnM name
+                 Nothing   -> lookupQualifiedName rdr_name
 
 
--- a qualified name on the command line can refer to any module at all: we
+-- A qualified name on the command line can refer to any module at all: we
 -- try to load the interface if we don't already have it.
 -- try to load the interface if we don't already have it.
-lookupQualifiedName :: RdrName -> RnM d Name
+lookupQualifiedName :: RdrName -> TcRn m Name
 lookupQualifiedName rdr_name
  = let 
        mod = rdrNameModule rdr_name
        occ = rdrNameOcc rdr_name
    in
 lookupQualifiedName rdr_name
  = let 
        mod = rdrNameModule rdr_name
        occ = rdrNameOcc rdr_name
    in
-   loadInterface (ppr rdr_name) mod ImportByUser `thenRn` \ iface ->
+   loadInterface (ppr rdr_name) mod (ImportByUser False) `thenM` \ iface ->
    case  [ name | (_,avails) <- mi_exports iface,
           avail             <- avails,
           name              <- availNames avail,
           nameOccName name == occ ] of
    case  [ name | (_,avails) <- mi_exports iface,
           avail             <- avails,
           name              <- availNames avail,
           nameOccName name == occ ] of
-      (n:ns) -> ASSERT (null ns) returnRn n
-      _      -> failWithRn (mkUnboundName rdr_name) (unknownNameErr rdr_name)
-
-lookupSrcName :: GlobalRdrEnv -> RdrName -> RnM d Name
--- NB: passed GlobalEnv explicitly, not necessarily in RnMS monad
-lookupSrcName global_env rdr_name
-  | isOrig rdr_name    -- Can occur in source code too
-  = lookupOrigName rdr_name
+      (n:ns) -> ASSERT (null ns) returnM n
+      _      -> unboundName rdr_name
+
+lookupSrcName :: RdrName -> TcRn m Name
+lookupSrcName rdr_name
+  = lookupSrcName_maybe rdr_name       `thenM` \ mb_name ->
+    case mb_name of
+       Nothing   -> unboundName rdr_name
+       Just name -> returnM name
+                       
+lookupSrcName_maybe :: RdrName -> TcRn m (Maybe Name)
+lookupSrcName_maybe rdr_name
+  | Just name <- isExact_maybe rdr_name        -- Can occur in source code too
+  = returnM (Just name)
+
+  | isOrig rdr_name                    -- An original name
+  = newGlobalNameFromRdrName rdr_name  `thenM` \ name ->
+    returnM (Just name)
 
   | otherwise
 
   | otherwise
-  = case lookupRdrEnv global_env rdr_name of
-       Just [GRE name _ Nothing]       -> returnRn name
-       Just [GRE name _ (Just deprec)] -> warnDeprec name deprec       `thenRn_`
-                                          returnRn name
-       Just stuff@(GRE name _ _ : _)   -> addNameClashErrRn rdr_name stuff     `thenRn_`
-                                          returnRn name
-       Nothing                         -> failWithRn (mkUnboundName rdr_name)
-                                                     (unknownNameErr rdr_name)
-
-lookupOrigName :: RdrName -> RnM d Name 
-lookupOrigName rdr_name
-  = ASSERT( isOrig rdr_name )
-    newGlobalName (rdrNameModule rdr_name) (rdrNameOcc rdr_name)
-
-lookupIfaceUnqual :: RdrName -> RnM d Name
-lookupIfaceUnqual rdr_name
-  = ASSERT( isUnqual rdr_name )
+  = lookupGRE rdr_name         `thenM` \ mb_gre ->
+    case mb_gre of
+       Nothing  -> returnM Nothing
+       Just gre -> returnM (Just (gre_name gre))
+
+lookupGRE :: RdrName -> TcRn m (Maybe GlobalRdrElt)
+lookupGRE rdr_name
+  = getGlobalRdrEnv                    `thenM` \ global_env ->
+    case lookupRdrEnv global_env rdr_name of
+       Just [gre] -> case gre_deprec gre of
+                       Nothing -> returnM (Just gre)
+                       Just _  -> warnDeprec gre       `thenM_`
+                                  returnM (Just gre)
+       Just stuff@(gre : _) -> addNameClashErrRn rdr_name stuff        `thenM_`
+                               returnM (Just gre)
+       Nothing              -> return Nothing
+                       
+lookupIfaceName :: Module -> RdrName -> TcRn m Name
        -- An Unqual is allowed; interface files contain 
        -- unqualified names for locally-defined things, such as
        -- constructors of a data type.
        -- An Unqual is allowed; interface files contain 
        -- unqualified names for locally-defined things, such as
        -- constructors of a data type.
-    getModuleRn                        `thenRn ` \ mod ->
-    newGlobalName (moduleName mod) (rdrNameOcc rdr_name)
-
-lookupIfaceName :: RdrName -> RnM d Name
-lookupIfaceName rdr_name
-  | isUnqual rdr_name = lookupIfaceUnqual rdr_name
+lookupIfaceName mod rdr_name
+  | isUnqual rdr_name = newGlobalName mod (rdrNameOcc rdr_name) importedSrcLoc
   | otherwise        = lookupOrigName rdr_name
   | otherwise        = lookupOrigName rdr_name
-\end{code}
 
 
-@lookupOrigName@ takes an RdrName representing an {\em original}
-name, and adds it to the occurrence pool so that it'll be loaded
-later.  This is used when language constructs (such as monad
-comprehensions, overloaded literals, or deriving clauses) require some
-stuff to be loaded that isn't explicitly mentioned in the code.
+lookupOrigName :: RdrName -> TcRn m Name
+       -- Just for original or exact names
+lookupOrigName rdr_name
+  | Just n <- isExact_maybe rdr_name 
+       -- This happens in derived code, which we 
+       -- rename in InterfaceMode
+  = returnM n
+
+  | otherwise  -- Usually Orig, but can be a Qual when 
+               -- we are reading a .hi-boot file
+  = newGlobalNameFromRdrName rdr_name
+
+
+dataTcOccs :: RdrName -> [RdrName]
+-- If the input is a data constructor, return both it and a type
+-- constructor.  This is useful when we aren't sure which we are
+-- looking at.
+--
+-- ToDo: If the user typed "[]" or "(,,)", we'll generate an Exact RdrName,
+--      and we don't have a systematic way to find the TyCon's Name from
+--      the DataCon's name.  Sigh
+dataTcOccs rdr_name
+  | isDataOcc occ = [rdr_name_tc, rdr_name]
+  | otherwise    = [rdr_name]
+  where    
+    occ        = rdrNameOcc rdr_name
+    rdr_name_tc = setRdrNameSpace rdr_name tcName
+\end{code}
 
 
-This doesn't apply in interface mode, where everything is explicit,
-but we don't check for this case: it does no harm to record an
-``extra'' occurrence and @lookupOrigNames@ isn't used much in
-interface mode (it's only the @Nothing@ clause of @rnDerivs@ that
-calls it at all I think).
+\begin{code}
+unboundName rdr_name = addErr (unknownNameErr rdr_name)        `thenM_`
+                      returnM (mkUnboundName rdr_name)
+\end{code}
 
 
-  \fbox{{\em Jan 98: this comment is wrong: @rnHsType@ uses it quite a bit.}}
+%*********************************************************
+%*                                                     *
+               Fixities
+%*                                                     *
+%*********************************************************
 
 \begin{code}
 
 \begin{code}
-lookupOrigNames :: [RdrName] -> RnM d NameSet
-lookupOrigNames rdr_names
-  = mapRn lookupOrigName rdr_names     `thenRn` \ names ->
-    returnRn (mkNameSet names)
+--------------------------------
+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  = mappM rn_sig fixes    `thenM` \ new_bit ->
+                extendFixityEnv new_bit thing_inside
+  where
+    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}
 
 \end{code}
 
-lookupSysBinder is used for the "system binders" of a type, class, or
-instance decl.  It ensures that the module is set correctly in the
-name cache, and sets the provenance on the returned name too.  The
-returned name will end up actually in the type, class, or instance.
+--------------------------------
+lookupFixity is a bit strange.  
+
+* Nested local fixity decls are put in the local fixity env, which we
+  find with getFixtyEnv
+
+* Imported fixities are found in the HIT or PIT
+
+* Top-level fixity decls in this module may be for Names that are
+    either  Global        (constructors, class operations)
+    or             Local/Exported (everything else)
+  (See notes with RnNames.getLocalDeclBinders for why we have this split.)
+  We put them all in the local fixity environment
 
 \begin{code}
 
 \begin{code}
-lookupSysBinder rdr_name
-  = ASSERT( isUnqual rdr_name )
-    getModuleRn                                `thenRn` \ mod ->
-    getSrcLocRn                                `thenRn` \ loc ->
-    newTopBinder mod rdr_name loc
+lookupFixityRn :: Name -> RnM Fixity
+lookupFixityRn name
+  = getModule                          `thenM` \ this_mod ->
+    if nameIsLocalOrFrom this_mod name
+    then       -- It's defined in this module
+       getFixityEnv            `thenM` \ local_fix_env ->
+       returnM (lookupFixity local_fix_env name)
+
+    else       -- It's imported
+      -- For imported names, we have to get their fixities by doing a
+      -- loadHomeInterface, and consulting the Ifaces that comes back
+      -- from that, because the interface file for the Name might not
+      -- have been loaded yet.  Why not?  Suppose you import module A,
+      -- which exports a function 'f', thus;
+      --        module CurrentModule where
+      --         import A( f )
+      --       module A( f ) where
+      --         import B( f )
+      -- Then B isn't loaded right away (after all, it's possible that
+      -- nothing from B will be used).  When we come across a use of
+      -- 'f', we need to know its fixity, and it's then, and only
+      -- then, that we load B.hi.  That is what's happening here.
+        loadInterface doc name_mod ImportBySystem      `thenM` \ iface ->
+       returnM (lookupFixity (mi_fixities iface) name)
+  where
+    doc      = ptext SLIT("Checking fixity for") <+> ppr name
+    name_mod = moduleName (nameModule name)
 \end{code}
 
 
 \end{code}
 
 
@@ -406,37 +579,60 @@ lookupSysBinder rdr_name
 mentioned explicitly, but which might be needed by the type checker.
 
 \begin{code}
 mentioned explicitly, but which might be needed by the type checker.
 
 \begin{code}
-getImplicitStmtFVs     -- Compiling a statement
-  = returnRn (mkFVs [printName, bindIOName, returnIOName, failIOName]
-             `plusFV` ubiquitousNames)
+implicitStmtFVs source_fvs     -- Compiling a statement
+  = stmt_fvs `plusFV` implicitModuleFVs source_fvs
+  where
+    stmt_fvs = mkFVs [printName, bindIOName, thenIOName, returnIOName, failIOName, 
+                     integerTyConName]
                -- These are all needed implicitly when compiling a statement
                -- See TcModule.tc_stmts
                -- These are all needed implicitly when compiling a statement
                -- See TcModule.tc_stmts
-
-getImplicitModuleFVs mod_name decls    -- Compiling a module
-  = lookupOrigNames deriv_occs         `thenRn` \ deriving_names ->
-    returnRn (deriving_names `plusFV` implicit_main `plusFV` ubiquitousNames)
-  where
-       -- Add occurrences for IO or PrimIO
-       implicit_main |  mod_name == mAIN_Name
-                     || mod_name == pREL_MAIN_Name = unitFV ioTyConName
-                     |  otherwise                  = emptyFVs
-
-       deriv_occs = [occ | TyClD (TyData {tcdDerivs = Just deriv_classes}) <- decls,
-                           cls <- deriv_classes,
-                           occ <- lookupWithDefaultUFM derivingOccurrences [] cls ]
+       -- Reason for integerTyConName: consider this in GHCi
+       --      ghci>  []
+       -- We get an ambigous constraint (Show a), which we now default just like
+       -- numeric types... but unless we have the instance decl for Integer we 
+       -- won't find a valid default!
+
+implicitModuleFVs source_fvs
+  = mkTemplateHaskellFVs source_fvs    `plusFV` 
+    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
+
+#ifdef GHCI
+---------------        Template Haskell enabled --------------
+thProxyName = unitFV qTyConName
+
+mkTemplateHaskellFVs source_fvs
+  | qTyConName `elemNameSet` source_fvs = templateHaskellNames
+  | 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, 
 
 -- ubiquitous_names are loaded regardless, because 
 -- they are needed in virtually every program
 ubiquitousNames 
   = mkFVs [unpackCStringName, unpackCStringFoldrName, 
-          unpackCStringUtf8Name, eqStringName]
-       -- Virtually every program has error messages in it somewhere
-
-  `plusFV`
-    mkFVs [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!)
+          unpackCStringUtf8Name, eqStringName,
+               -- Virtually every program has error messages in it somewhere
+          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!)
 \end{code}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************
@@ -458,28 +654,52 @@ At the moment this just happens for
   * fromInteger, fromRational on literals (in expressions and patterns)
   * negate (in expressions)
   * minus  (arising from n+k patterns)
   * fromInteger, fromRational on literals (in expressions and patterns)
   * negate (in expressions)
   * minus  (arising from n+k patterns)
+  * "do" notation
 
 We store the relevant Name in the HsSyn tree, in 
   * HsIntegral/HsFractional    
   * NegApp
   * NPlusKPatIn
 
 We store the relevant Name in the HsSyn tree, in 
   * HsIntegral/HsFractional    
   * NegApp
   * NPlusKPatIn
+  * HsDo
 respectively.  Initially, we just store the "standard" name (PrelNames.fromIntegralName,
 fromRationalName etc), but the renamer changes this to the appropriate user
 name if Opt_NoImplicitPrelude is on.  That is what lookupSyntaxName does.
 
 respectively.  Initially, we just store the "standard" name (PrelNames.fromIntegralName,
 fromRationalName etc), but the renamer changes this to the appropriate user
 name if Opt_NoImplicitPrelude is on.  That is what lookupSyntaxName does.
 
+We treat the orignal (standard) names as free-vars too, because the type checker
+checks the type of the user thing against the type of the standard thing.
+
 \begin{code}
 \begin{code}
-lookupSyntaxName :: Name       -- The standard name
-                -> RnMS Name   -- Possibly a non-standard name
+lookupSyntaxName :: Name                       -- The standard name
+                -> RnM (Name, FreeVars)        -- Possibly a non-standard name
 lookupSyntaxName std_name
 lookupSyntaxName std_name
-  = doptRn Opt_NoImplicitPrelude       `thenRn` \ no_prelude -> 
-    if not no_prelude then
-       returnRn std_name       -- Normal case
+  = doptM Opt_NoImplicitPrelude                `thenM` \ no_prelude -> 
+    if not no_prelude then normal_case
+    else
+    getModeRn                          `thenM` \ mode ->
+    if isInterfaceMode mode then normal_case
+       -- Happens for 'derived' code where we don't want to rebind
     else
     else
-    let
-       rdr_name = mkRdrUnqual (nameOccName std_name)
        -- Get the similarly named thing from the local environment
        -- Get the similarly named thing from the local environment
-    in
-    lookupOccRn rdr_name
+    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}
 
 
 \end{code}
 
 
@@ -491,55 +711,53 @@ lookupSyntaxName std_name
 
 \begin{code}
 newLocalsRn :: [(RdrName,SrcLoc)]
 
 \begin{code}
 newLocalsRn :: [(RdrName,SrcLoc)]
-           -> RnMS [Name]
+           -> RnM [Name]
 newLocalsRn rdr_names_w_loc
 newLocalsRn rdr_names_w_loc
- =  getNameSupplyRn            `thenRn` \ name_supply ->
+ =  newUniqueSupply            `thenM` \ us ->
     let
     let
-       (us', us1) = splitUniqSupply (nsUniqs name_supply)
-       uniqs      = uniqsFromSupply us1
-       names      = [ mkLocalName uniq (rdrNameOcc rdr_name) loc
+       uniqs      = uniqsFromSupply us
+       names      = [ mkInternalName uniq (rdrNameOcc rdr_name) loc
                     | ((rdr_name,loc), uniq) <- rdr_names_w_loc `zip` uniqs
                     ]
     in
                     | ((rdr_name,loc), uniq) <- rdr_names_w_loc `zip` uniqs
                     ]
     in
-    setNameSupplyRn (name_supply {nsUniqs = us'})      `thenRn_`
-    returnRn names
+    returnM names
 
 
 bindLocatedLocalsRn :: SDoc    -- Documentation string for error message
                    -> [(RdrName,SrcLoc)]
 
 
 bindLocatedLocalsRn :: SDoc    -- Documentation string for error message
                    -> [(RdrName,SrcLoc)]
-                   -> ([Name] -> RnMS a)
-                   -> RnMS a
+                   -> ([Name] -> RnM a)
+                   -> RnM a
 bindLocatedLocalsRn doc_str rdr_names_w_loc enclosed_scope
 bindLocatedLocalsRn doc_str rdr_names_w_loc enclosed_scope
-  = getModeRn                          `thenRn` \ mode ->
-    getLocalNameEnv                    `thenRn` \ local_env ->
-    getGlobalNameEnv                   `thenRn` \ global_env ->
+  = getModeRn                  `thenM` \ mode ->
+    getLocalRdrEnv             `thenM` \ local_env ->
+    getGlobalRdrEnv            `thenM` \ global_env ->
 
        -- Check for duplicate names
 
        -- Check for duplicate names
-    checkDupOrQualNames doc_str rdr_names_w_loc        `thenRn_`
+    checkDupOrQualNames doc_str rdr_names_w_loc        `thenM_`
 
        -- Warn about shadowing, but only in source modules
     let
       check_shadow (rdr_name,loc)
        |  rdr_name `elemRdrEnv` local_env 
        || rdr_name `elemRdrEnv` global_env 
 
        -- Warn about shadowing, but only in source modules
     let
       check_shadow (rdr_name,loc)
        |  rdr_name `elemRdrEnv` local_env 
        || rdr_name `elemRdrEnv` global_env 
-       = pushSrcLocRn loc $ addWarnRn (shadowedNameWarn rdr_name)
+       = addSrcLoc loc $ addWarn (shadowedNameWarn rdr_name)
         | otherwise 
         | otherwise 
-       = returnRn ()
+       = returnM ()
     in
 
     (case mode of
     in
 
     (case mode of
-       SourceMode -> ifOptRn Opt_WarnNameShadowing     $
-                     mapRn_ check_shadow rdr_names_w_loc
-       other      -> returnRn ()
-    )                                  `thenRn_`
+       SourceMode -> ifOptM Opt_WarnNameShadowing      $
+                     mappM_ check_shadow rdr_names_w_loc
+       other      -> returnM ()
+    )                                  `thenM_`
 
 
-    newLocalsRn rdr_names_w_loc                `thenRn` \ names ->
+    newLocalsRn rdr_names_w_loc                `thenM` \ names ->
     let
        new_local_env = addListToRdrEnv local_env (map fst rdr_names_w_loc `zip` names)
     in
     let
        new_local_env = addListToRdrEnv local_env (map fst rdr_names_w_loc `zip` names)
     in
-    setLocalNameEnv new_local_env (enclosed_scope names)
+    setLocalRdrEnv new_local_env (enclosed_scope names)
 
 
-bindCoreLocalRn :: RdrName -> (Name -> RnMS a) -> RnMS a
+bindCoreLocalRn :: RdrName -> (Name -> RnM a) -> RnM a
   -- A specialised variant when renaming stuff from interface
   -- files (of which there is a lot)
   --   * one at a time
   -- A specialised variant when renaming stuff from interface
   -- files (of which there is a lot)
   --   * one at a time
@@ -547,19 +765,14 @@ bindCoreLocalRn :: RdrName -> (Name -> RnMS a) -> RnMS a
   --   * always imported
   --   * deal with free vars
 bindCoreLocalRn rdr_name enclosed_scope
   --   * always imported
   --   * deal with free vars
 bindCoreLocalRn rdr_name enclosed_scope
-  = getSrcLocRn                `thenRn` \ loc ->
-    getLocalNameEnv            `thenRn` \ name_env ->
-    getNameSupplyRn            `thenRn` \ name_supply ->
-    let
-       (us', us1) = splitUniqSupply (nsUniqs name_supply)
-       uniq       = uniqFromSupply us1
-       name       = mkLocalName uniq (rdrNameOcc rdr_name) loc
-    in
-    setNameSupplyRn (name_supply {nsUniqs = us'})      `thenRn_`
+  = getSrcLocM                 `thenM` \ loc ->
+    getLocalRdrEnv             `thenM` \ name_env ->
+    newUnique                  `thenM` \ uniq ->
     let
     let
+       name         = mkInternalName uniq (rdrNameOcc rdr_name) loc
        new_name_env = extendRdrEnv name_env rdr_name name
     in
        new_name_env = extendRdrEnv name_env rdr_name name
     in
-    setLocalNameEnv new_name_env (enclosed_scope name)
+    setLocalRdrEnv new_name_env (enclosed_scope name)
 
 bindCoreLocalsRn []     thing_inside = thing_inside []
 bindCoreLocalsRn (b:bs) thing_inside = bindCoreLocalRn b       $ \ name' ->
 
 bindCoreLocalsRn []     thing_inside = thing_inside []
 bindCoreLocalsRn (b:bs) thing_inside = bindCoreLocalRn b       $ \ name' ->
@@ -567,71 +780,61 @@ bindCoreLocalsRn (b:bs) thing_inside = bindCoreLocalRn b  $ \ name' ->
                                       thing_inside (name':names')
 
 bindLocalNames names enclosed_scope
                                       thing_inside (name':names')
 
 bindLocalNames names enclosed_scope
-  = getLocalNameEnv            `thenRn` \ name_env ->
-    setLocalNameEnv (extendLocalRdrEnv name_env names)
+  = getLocalRdrEnv             `thenM` \ name_env ->
+    setLocalRdrEnv (extendLocalRdrEnv name_env names)
                    enclosed_scope
 
 bindLocalNamesFV names enclosed_scope
   = bindLocalNames names $
                    enclosed_scope
 
 bindLocalNamesFV names enclosed_scope
   = bindLocalNames names $
-    enclosed_scope `thenRn` \ (thing, fvs) ->
-    returnRn (thing, delListFromNameSet fvs names)
+    enclosed_scope `thenM` \ (thing, fvs) ->
+    returnM (thing, delListFromNameSet fvs names)
 
 
 -------------------------------------
 bindLocalRn doc rdr_name enclosed_scope
 
 
 -------------------------------------
 bindLocalRn doc rdr_name enclosed_scope
-  = getSrcLocRn                                `thenRn` \ loc ->
+  = getSrcLocM                                 `thenM` \ loc ->
     bindLocatedLocalsRn doc [(rdr_name,loc)]   $ \ (n:ns) ->
     ASSERT( null ns )
     enclosed_scope n
 
 bindLocalsRn doc rdr_names enclosed_scope
     bindLocatedLocalsRn doc [(rdr_name,loc)]   $ \ (n:ns) ->
     ASSERT( null ns )
     enclosed_scope n
 
 bindLocalsRn doc rdr_names enclosed_scope
-  = getSrcLocRn                `thenRn` \ loc ->
+  = getSrcLocM         `thenM` \ loc ->
     bindLocatedLocalsRn doc
                        (rdr_names `zip` repeat loc)
                        enclosed_scope
 
        -- binLocalsFVRn is the same as bindLocalsRn
        -- except that it deals with free vars
     bindLocatedLocalsRn doc
                        (rdr_names `zip` repeat loc)
                        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 ->
   = bindLocalsRn doc rdr_names         $ \ names ->
-    enclosed_scope names               `thenRn` \ (thing, fvs) ->
-    returnRn (thing, delListFromNameSet fvs names)
+    enclosed_scope names               `thenM` \ (thing, fvs) ->
+    returnM (thing, delListFromNameSet fvs names)
 
 -------------------------------------
 
 -------------------------------------
-extendTyVarEnvFVRn :: [Name] -> RnMS (a, FreeVars) -> RnMS (a, FreeVars)
+extendTyVarEnvFVRn :: [Name] -> RnM (a, FreeVars) -> RnM (a, FreeVars)
        -- This tiresome function is used only in rnSourceDecl on InstDecl
 extendTyVarEnvFVRn tyvars enclosed_scope
        -- This tiresome function is used only in rnSourceDecl on InstDecl
 extendTyVarEnvFVRn tyvars enclosed_scope
-  = bindLocalNames tyvars enclosed_scope       `thenRn` \ (thing, fvs) -> 
-    returnRn (thing, delListFromNameSet fvs tyvars)
+  = bindLocalNames tyvars enclosed_scope       `thenM` \ (thing, fvs) -> 
+    returnM (thing, delListFromNameSet fvs tyvars)
 
 bindTyVarsRn :: SDoc -> [HsTyVarBndr RdrName]
 
 bindTyVarsRn :: SDoc -> [HsTyVarBndr RdrName]
-             -> ([HsTyVarBndr Name] -> RnMS a)
-             -> RnMS a
+             -> ([HsTyVarBndr Name] -> RnM a)
+             -> RnM a
 bindTyVarsRn doc_str tyvar_names enclosed_scope
 bindTyVarsRn doc_str tyvar_names enclosed_scope
-  = bindTyVars2Rn doc_str tyvar_names  $ \ names tyvars ->
-    enclosed_scope tyvars
-
--- Gruesome name: return Names as well as HsTyVars
-bindTyVars2Rn :: SDoc -> [HsTyVarBndr RdrName]
-             -> ([Name] -> [HsTyVarBndr Name] -> RnMS a)
-             -> RnMS a
-bindTyVars2Rn doc_str tyvar_names enclosed_scope
-  = getSrcLocRn                                        `thenRn` \ loc ->
+  = getSrcLocM                                 `thenM` \ loc ->
     let
        located_tyvars = [(hsTyVarName tv, loc) | tv <- tyvar_names] 
     in
     bindLocatedLocalsRn doc_str located_tyvars $ \ names ->
     let
        located_tyvars = [(hsTyVarName tv, loc) | tv <- tyvar_names] 
     in
     bindLocatedLocalsRn doc_str located_tyvars $ \ names ->
-    enclosed_scope names (zipWith replaceTyVarName tyvar_names names)
+    enclosed_scope (zipWith replaceTyVarName tyvar_names names)
 
 
-bindPatSigTyVars :: [RdrNameHsType]
-                -> RnMS (a, FreeVars)
-                -> RnMS (a, FreeVars)
+bindPatSigTyVars :: [RdrNameHsType] -> ([Name] -> RnM a) -> RnM a
   -- Find the type variables in the pattern type 
   -- signatures that must be brought into scope
 
   -- Find the type variables in the pattern type 
   -- signatures that must be brought into scope
 
-bindPatSigTyVars tys enclosed_scope
-  = getLocalNameEnv                    `thenRn` \ name_env ->
-    getSrcLocRn                                `thenRn` \ loc ->
+bindPatSigTyVars tys thing_inside
+  = getLocalRdrEnv             `thenM` \ name_env ->
+    getSrcLocM                 `thenM` \ loc ->
     let
        forall_tyvars  = nub [ tv | ty <- tys,
                                    tv <- extractHsTyRdrTyVars ty, 
     let
        forall_tyvars  = nub [ tv | ty <- tys,
                                    tv <- extractHsTyRdrTyVars ty, 
@@ -644,27 +847,35 @@ bindPatSigTyVars tys enclosed_scope
        located_tyvars = [(tv, loc) | tv <- forall_tyvars] 
        doc_sig        = text "In a pattern type-signature"
     in
        located_tyvars = [(tv, loc) | tv <- forall_tyvars] 
        doc_sig        = text "In a pattern type-signature"
     in
-    bindLocatedLocalsRn doc_sig located_tyvars $ \ names ->
-    enclosed_scope                             `thenRn` \ (thing, fvs) ->
-    returnRn (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
                                   -> [(RdrName, SrcLoc)]
 
 -------------------------------------
 checkDupOrQualNames, checkDupNames :: SDoc
                                   -> [(RdrName, SrcLoc)]
-                                  -> RnM d ()
+                                  -> TcRn m ()
        -- Works in any variant of the renamer monad
 
 checkDupOrQualNames doc_str rdr_names_w_loc
        -- Works in any variant of the renamer monad
 
 checkDupOrQualNames doc_str rdr_names_w_loc
-  =    -- Check for use of qualified names
-    mapRn_ (qualNameErr doc_str) quals         `thenRn_`
+  =    -- 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
     
 checkDupNames doc_str rdr_names_w_loc
   =    -- Check for duplicated names in a binding group
     checkDupNames doc_str rdr_names_w_loc
   where
     quals = filter (isQual . fst) rdr_names_w_loc
     
 checkDupNames doc_str rdr_names_w_loc
   =    -- Check for duplicated names in a binding group
-    mapRn_ (dupNamesErr doc_str) dups
+    mappM_ (dupNamesErr doc_str) dups
   where
     (_, dups) = removeDups (\(n1,l1) (n2,l2) -> n1 `compare` n2) rdr_names_w_loc
 \end{code}
   where
     (_, dups) = removeDups (\(n1,l1) (n2,l2) -> n1 `compare` n2) rdr_names_w_loc
 \end{code}
@@ -681,13 +892,11 @@ mkGlobalRdrEnv :: ModuleName              -- Imported module (after doing the "as M" name ch
               -> Bool                  -- True <=> want unqualified import
               -> (Name -> Provenance)
               -> Avails                -- Whats imported
               -> Bool                  -- True <=> want unqualified import
               -> (Name -> Provenance)
               -> Avails                -- Whats imported
-              -> Avails                -- What's to be hidden
-                                       -- I.e. import (imports - hides)
               -> Deprecations
               -> GlobalRdrEnv
 
               -> Deprecations
               -> GlobalRdrEnv
 
-mkGlobalRdrEnv this_mod unqual_imp mk_provenance avails hides deprecs
-  = gbl_env3
+mkGlobalRdrEnv this_mod unqual_imp mk_provenance avails deprecs
+  = gbl_env2
   where
        -- Make the name environment.  We're talking about a 
        -- single module here, so there must be no name clashes.
   where
        -- Make the name environment.  We're talking about a 
        -- single module here, so there must be no name clashes.
@@ -698,12 +907,9 @@ mkGlobalRdrEnv this_mod unqual_imp mk_provenance avails hides deprecs
        -- (Qualified names are always imported)
     gbl_env1 = foldl add_avail emptyRdrEnv avails
 
        -- (Qualified names are always imported)
     gbl_env1 = foldl add_avail emptyRdrEnv avails
 
-       -- Delete (qualified names of) things that are hidden
-    gbl_env2 = foldl del_avail gbl_env1 hides
-
        -- Add unqualified names
        -- Add unqualified names
-    gbl_env3 | unqual_imp = foldl add_unqual gbl_env2 (rdrEnvToList gbl_env2)
-            | otherwise  = gbl_env2
+    gbl_env2 | unqual_imp = foldl add_unqual gbl_env1 (rdrEnvToList gbl_env1)
+            | otherwise  = gbl_env1
 
     add_unqual env (qual_name, elts)
        = foldl add_one env elts
 
     add_unqual env (qual_name, elts)
        = foldl add_one env elts
@@ -715,33 +921,19 @@ mkGlobalRdrEnv this_mod unqual_imp mk_provenance avails hides deprecs
        -- the module (multiple bindings for the same name) we may get
        -- duplicates.  So the simple thing is to do the fold.
 
        -- the module (multiple bindings for the same name) we may get
        -- duplicates.  So the simple thing is to do the fold.
 
-    del_avail env avail 
-       = foldl delOneFromGlobalRdrEnv env rdr_names
-       where
-         rdr_names = map (mkRdrQual this_mod . nameOccName)
-                         (availNames avail)
-
-
     add_avail :: GlobalRdrEnv -> AvailInfo -> GlobalRdrEnv
     add_avail :: GlobalRdrEnv -> AvailInfo -> GlobalRdrEnv
-    add_avail env avail = foldl add_name env (availNames avail)
+    add_avail env avail = foldl (add_name (availName avail)) env (availNames avail)
 
 
-    add_name env name  -- Add qualified name only
-       = addOneToGlobalRdrEnv env  (mkRdrQual this_mod occ) elt
+    add_name parent env name   -- Add qualified name only
+       = addOneToGlobalRdrEnv env (mkRdrQual this_mod occ) elt
        where
          occ  = nameOccName name
        where
          occ  = nameOccName name
-         elt  = GRE name (mk_provenance name) (lookupDeprec deprecs name)
-
-mkIfaceGlobalRdrEnv :: [(ModuleName,Avails)] -> GlobalRdrEnv
--- Used to construct a GlobalRdrEnv for an interface that we've
--- read from a .hi file.  We can't construct the original top-level
--- environment because we don't have enough info, but we compromise
--- by making an environment from its exports
-mkIfaceGlobalRdrEnv m_avails
-  = foldl add emptyRdrEnv m_avails
-  where
-    add env (mod,avails) = plusGlobalRdrEnv env (mkGlobalRdrEnv mod True 
-                                                               (\n -> LocalDef) avails [] NoDeprecs)
-               -- The NoDeprecs is a bit of a hack I suppose
+         elt  = GRE {gre_name   = name,
+                     gre_parent = if name == parent 
+                                  then Nothing 
+                                  else Just parent, 
+                     gre_prov   = mk_provenance name, 
+                     gre_deprec = lookupDeprec deprecs name}
 \end{code}
 
 \begin{code}
 \end{code}
 
 \begin{code}
@@ -766,11 +958,12 @@ combine_globals ns_old ns_new     -- ns_new is often short
     choose n m | n `beats` m = n
               | otherwise   = m
 
     choose n m | n `beats` m = n
               | otherwise   = m
 
-    (GRE n pn _) `beats` (GRE m pm _) = n==m && pn `hasBetterProv` pm
+    g1 `beats` g2 = gre_name g1 == gre_name g2 && 
+                   gre_prov g1 `hasBetterProv` gre_prov g2
 
     is_duplicate :: GlobalRdrElt -> GlobalRdrElt -> Bool
 
     is_duplicate :: GlobalRdrElt -> GlobalRdrElt -> Bool
-    is_duplicate (GRE n1 LocalDef _) (GRE n2 LocalDef _) = False
-    is_duplicate (GRE n1 _        _) (GRE n2 _       _) = n1 == n2
+    is_duplicate g1 g2 | isLocalGRE g1 && isLocalGRE g2 = False
+    is_duplicate g1 g2 = gre_name g1 == gre_name g2
 \end{code}
 
 We treat two bindings of a locally-defined name as a duplicate,
 \end{code}
 
 We treat two bindings of a locally-defined name as a duplicate,
@@ -786,140 +979,6 @@ defn of the same name; in this case the names will compare as equal, but
 will still have different provenances.
 
 
 will still have different provenances.
 
 
-@unQualInScope@ returns a function that takes a @Name@ and tells whether
-its unqualified name is in scope.  This is put as a boolean flag in
-the @Name@'s provenance to guide whether or not to print the name qualified
-in error messages.
-
-\begin{code}
-unQualInScope :: GlobalRdrEnv -> Name -> Bool
--- True if 'f' is in scope, and has only one binding
--- (i.e. false if A.f and B.f are both in scope as unqualified 'f')
-unQualInScope env
-  = (`elemNameSet` unqual_names)
-  where
-    unqual_names :: NameSet
-    unqual_names = foldRdrEnv add emptyNameSet env
-    add rdr_name [GRE name _ _] unquals | isUnqual rdr_name = addOneToNameSet unquals name
-    add _        _              unquals                            = unquals
-\end{code}
-
-
-%************************************************************************
-%*                                                                     *
-\subsection{Avails}
-%*                                                                     *
-%************************************************************************
-
-\begin{code}
-plusAvail (Avail n1)      (Avail n2)       = Avail n1
-plusAvail (AvailTC n1 ns1) (AvailTC n2 ns2) = AvailTC n2 (nub (ns1 ++ ns2))
--- Added SOF 4/97
-#ifdef DEBUG
-plusAvail a1 a2 = pprPanic "RnEnv.plusAvail" (hsep [ppr a1,ppr a2])
-#endif
-
-addAvail :: AvailEnv -> AvailInfo -> AvailEnv
-addAvail avails avail = extendNameEnv_C plusAvail avails (availName avail) avail
-
-unitAvailEnv :: AvailInfo -> AvailEnv
-unitAvailEnv a = unitNameEnv (availName a) a
-
-plusAvailEnv :: AvailEnv -> AvailEnv -> AvailEnv
-plusAvailEnv = plusNameEnv_C plusAvail
-
-availEnvElts = nameEnvElts
-
-addAvailToNameSet :: NameSet -> AvailInfo -> NameSet
-addAvailToNameSet names avail = addListToNameSet names (availNames avail)
-
-availsToNameSet :: [AvailInfo] -> NameSet
-availsToNameSet avails = foldl addAvailToNameSet emptyNameSet avails
-
-availName :: GenAvailInfo name -> name
-availName (Avail n)     = n
-availName (AvailTC n _) = n
-
-availNames :: GenAvailInfo name -> [name]
-availNames (Avail n)      = [n]
-availNames (AvailTC n ns) = ns
-
--------------------------------------
-filterAvail :: RdrNameIE       -- Wanted
-           -> AvailInfo        -- Available
-           -> Maybe AvailInfo  -- Resulting available; 
-                               -- Nothing if (any of the) wanted stuff isn't there
-
-filterAvail ie@(IEThingWith want wants) avail@(AvailTC n ns)
-  | sub_names_ok = Just (AvailTC n (filter is_wanted ns))
-  | otherwise    = Nothing
-  where
-    is_wanted name = nameOccName name `elem` wanted_occs
-    sub_names_ok   = all (`elem` avail_occs) wanted_occs
-    avail_occs    = map nameOccName ns
-    wanted_occs    = map rdrNameOcc (want:wants)
-
-filterAvail (IEThingAbs _) (AvailTC n ns)       = ASSERT( n `elem` ns ) 
-                                                 Just (AvailTC n [n])
-
-filterAvail (IEThingAbs _) avail@(Avail n)      = Just avail           -- Type synonyms
-
-filterAvail (IEVar _)      avail@(Avail n)      = Just avail
-filterAvail (IEVar v)      avail@(AvailTC n ns) = Just (AvailTC n (filter wanted ns))
-                                               where
-                                                 wanted n = nameOccName n == occ
-                                                 occ      = rdrNameOcc v
-       -- The second equation happens if we import a class op, thus
-       --      import A( op ) 
-       -- where op is a class operation
-
-filterAvail (IEThingAll _) avail@(AvailTC _ _)   = Just avail
-       -- We don't complain even if the IE says T(..), but
-       -- no constrs/class ops of T are available
-       -- Instead that's caught with a warning by the caller
-
-filterAvail ie avail = Nothing
-
--------------------------------------
-groupAvails :: Module -> Avails -> [(ModuleName, Avails)]
-  -- Group by module and sort by occurrence
-  -- This keeps the list in canonical order
-groupAvails this_mod avails 
-  = [ (mkSysModuleNameFS fs, sortLt lt avails)
-    | (fs,avails) <- fmToList groupFM
-    ]
-  where
-    groupFM :: FiniteMap FastString Avails
-       -- Deliberately use the FastString so we
-       -- get a canonical ordering
-    groupFM = foldl add emptyFM avails
-
-    add env avail = addToFM_C combine env mod_fs [avail']
-                 where
-                   mod_fs = moduleNameFS (moduleName avail_mod)
-                   avail_mod = case nameModule_maybe (availName avail) of
-                                         Just m  -> m
-                                         Nothing -> this_mod
-                   combine old _ = avail':old
-                   avail'        = sortAvail avail
-
-    a1 `lt` a2 = occ1 < occ2
-              where
-                occ1  = nameOccName (availName a1)
-                occ2  = nameOccName (availName a2)
-
-sortAvail :: AvailInfo -> AvailInfo
--- Sort the sub-names into canonical order.
--- The canonical order has the "main name" at the beginning 
--- (if it's there at all)
-sortAvail (Avail n) = Avail n
-sortAvail (AvailTC n ns) | n `elem` ns = AvailTC n (n : sortLt lt (filter (/= n) ns))
-                        | otherwise   = AvailTC n (    sortLt lt ns)
-                        where
-                          n1 `lt` n2 = nameOccName n1 < nameOccName n2
-\end{code}
-
-
 %************************************************************************
 %*                                                                     *
 \subsection{Free variable manipulation}
 %************************************************************************
 %*                                                                     *
 \subsection{Free variable manipulation}
@@ -928,11 +987,11 @@ sortAvail (AvailTC n ns) | n `elem` ns = AvailTC n (n : sortLt lt (filter (/= n)
 
 \begin{code}
 -- A useful utility
 
 \begin{code}
 -- A useful utility
-mapFvRn f xs = mapRn f xs      `thenRn` \ stuff ->
+mapFvRn f xs = mappM f xs      `thenM` \ stuff ->
               let
                  (ys, fvs_s) = unzip stuff
               in
               let
                  (ys, fvs_s) = unzip stuff
               in
-              returnRn (ys, plusFVs fvs_s)
+              returnM (ys, plusFVs fvs_s)
 \end{code}
 
 
 \end{code}
 
 
@@ -943,72 +1002,65 @@ mapFvRn f xs = mapRn f xs        `thenRn` \ stuff ->
 %************************************************************************
 
 \begin{code}
 %************************************************************************
 
 \begin{code}
-warnUnusedModules :: [ModuleName] -> RnM d ()
+warnUnusedModules :: [ModuleName] -> TcRn m ()
 warnUnusedModules mods
 warnUnusedModules mods
-  = ifOptRn Opt_WarnUnusedImports (mapRn_ (addWarnRn . unused_mod) mods)
+  = ifOptM Opt_WarnUnusedImports (mappM_ (addWarn . unused_mod) mods)
   where
     unused_mod m = vcat [ptext SLIT("Module") <+> quotes (ppr m) <+> 
                           text "is imported, but nothing from it is used",
   where
     unused_mod m = vcat [ptext SLIT("Module") <+> quotes (ppr m) <+> 
                           text "is imported, but nothing from it is used",
-                        parens (ptext SLIT("except perhaps to re-export instances visible in") <+>
+                        parens (ptext SLIT("except perhaps instances visible in") <+>
                                   quotes (ppr m))]
 
                                   quotes (ppr m))]
 
-warnUnusedImports :: [(Name,Provenance)] -> RnM d ()
-warnUnusedImports names
-  = ifOptRn Opt_WarnUnusedImports (warnUnusedBinds names)
-
-warnUnusedLocalBinds, warnUnusedMatches :: [Name] -> RnM d ()
-warnUnusedLocalBinds names
-  = ifOptRn Opt_WarnUnusedBinds (warnUnusedBinds [(n,LocalDef) | n<-names])
+warnUnusedImports, warnUnusedTopBinds :: [GlobalRdrElt] -> TcRn m ()
+warnUnusedImports gres  = ifOptM Opt_WarnUnusedImports (warnUnusedGREs gres)
+warnUnusedTopBinds gres = ifOptM Opt_WarnUnusedBinds   (warnUnusedGREs gres)
 
 
-warnUnusedMatches names
-  = ifOptRn Opt_WarnUnusedMatches (warnUnusedGroup [(n,LocalDef) | n<-names])
+warnUnusedLocalBinds, warnUnusedMatches :: [Name] -> TcRn m ()
+warnUnusedLocalBinds names = ifOptM Opt_WarnUnusedBinds   (warnUnusedLocals names)
+warnUnusedMatches    names = ifOptM Opt_WarnUnusedMatches (warnUnusedLocals names)
 
 -------------------------
 
 -------------------------
+--     Helpers
+warnUnusedGREs   gres  = warnUnusedBinds [(n,p) | GRE {gre_name = n, gre_prov = p} <- gres]
+warnUnusedLocals names = warnUnusedBinds [(n,LocalDef) | n<-names]
 
 
-warnUnusedBinds :: [(Name,Provenance)] -> RnM d ()
+warnUnusedBinds :: [(Name,Provenance)] -> TcRn m ()
 warnUnusedBinds names
 warnUnusedBinds names
-  = mapRn_ warnUnusedGroup  groups
+  = mappM_ warnUnusedGroup groups
   where
        -- Group by provenance
   where
        -- Group by provenance
-   groups = equivClasses cmp names
+   groups = equivClasses cmp (filter reportable names)
    (_,prov1) `cmp` (_,prov2) = prov1 `compare` prov2
  
    (_,prov1) `cmp` (_,prov2) = prov1 `compare` prov2
  
+   reportable (name,_) = reportIfUnused (nameOccName name)
+
 
 -------------------------
 
 
 -------------------------
 
-warnUnusedGroup :: [(Name,Provenance)] -> RnM d ()
+warnUnusedGroup :: [(Name,Provenance)] -> TcRn m ()
 warnUnusedGroup names
 warnUnusedGroup names
-  | null filtered_names  = returnRn ()
-  | not is_local        = returnRn ()
-  | otherwise
-  = pushSrcLocRn def_loc       $
-    addWarnRn                  $
-    sep [msg <> colon, nest 4 (fsep (punctuate comma (map (ppr.fst) filtered_names)))]
+  = addSrcLoc def_loc  $
+    addWarn            $
+    sep [msg <> colon, nest 4 (fsep (punctuate comma (map (ppr.fst) names)))]
   where
   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)
 \end{code}
 
 \begin{code}
 addNameClashErrRn rdr_name (np1:nps)
-  = addErrRn (vcat [ptext SLIT("Ambiguous occurrence") <+> quotes (ppr rdr_name),
-                   ptext SLIT("It could refer to") <+> vcat (msg1 : msgs)])
+  = addErr (vcat [ptext SLIT("Ambiguous occurrence") <+> quotes (ppr rdr_name),
+                 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]
   where
     msg1 = ptext  SLIT("either") <+> mk_ref np1
     msgs = [ptext SLIT("    or") <+> mk_ref np | np <- nps]
-    mk_ref (GRE name prov _) = quotes (ppr name) <> comma <+> pprNameProvenance name prov
+    mk_ref gre = quotes (ppr (gre_name gre)) <> comma <+> pprNameProvenance gre
 
 shadowedNameWarn shadow
   = hsep [ptext SLIT("This binding for"), 
 
 shadowedNameWarn shadow
   = hsep [ptext SLIT("This binding for"), 
@@ -1020,21 +1072,35 @@ unknownNameErr name
   where
     flavour = occNameFlavour (rdrNameOcc name)
 
   where
     flavour = occNameFlavour (rdrNameOcc name)
 
+badOrigBinding name
+  = ptext SLIT("Illegal binding of built-in syntax:") <+> ppr (rdrNameOcc name)
+       -- The rdrNameOcc is because we don't want to print Prelude.(,)
+
 qualNameErr descriptor (name,loc)
 qualNameErr descriptor (name,loc)
-  = pushSrcLocRn loc $
-    addErrRn (vcat [ ptext SLIT("Invalid use of qualified name") <+> quotes (ppr name),
+  = addSrcLoc loc $
+    addErr (vcat [ ptext SLIT("Invalid use of qualified name") <+> quotes (ppr name),
                     descriptor])
 
 dupNamesErr descriptor ((name,loc) : dup_things)
                     descriptor])
 
 dupNamesErr descriptor ((name,loc) : dup_things)
-  = pushSrcLocRn loc $
-    addErrRn ((ptext SLIT("Conflicting definitions for") <+> quotes (ppr name))
+  = addSrcLoc loc $
+    addErr ((ptext SLIT("Conflicting definitions for") <+> quotes (ppr name))
              $$ 
              descriptor)
 
              $$ 
              descriptor)
 
-warnDeprec :: Name -> DeprecTxt -> RnM d ()
-warnDeprec name txt
-  = ifOptRn Opt_WarnDeprecations       $
-    addWarnRn (sep [ text (occNameFlavour (nameOccName name)) <+> 
+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        $
+    addWarn (sep [ text (occNameFlavour (nameOccName name)) <+> 
                     quotes (ppr name) <+> text "is deprecated:", 
                     nest 4 (ppr txt) ])
 \end{code}
                     quotes (ppr name) <+> text "is deprecated:", 
                     nest 4 (ppr txt) ])
 \end{code}
Glasgow Haskell Compiler with heterogeneous metaprogramming (generalized arrows and modal types)