[project @ 2004-11-26 16:19:45 by simonmar]
[ghc-hetmet.git] / ghc / compiler / basicTypes / RdrName.lhs
index 7ad104e..c4d71ca 100644 (file)
@@ -6,39 +6,51 @@
 
 \begin{code}
 module RdrName (
-       RdrName,
+       RdrName(..),    -- Constructors exported only to BinIface
 
        -- Construction
-       mkRdrUnqual, mkRdrQual, mkRdrOrig, mkRdrUnqual,
-       mkUnqual, mkQual, mkIfaceOrig, mkOrig,
-       qualifyRdrName, unqualifyRdrName, mkRdrNameWkr,
-       dummyRdrVarName, dummyRdrTcName,
+       mkRdrUnqual, mkRdrQual, 
+       mkUnqual, mkVarUnqual, mkQual, mkOrig,
+       nameRdrName, getRdrName, 
+       mkDerivedRdrName, 
 
        -- Destruction
-       rdrNameModule, rdrNameOcc, setRdrNameOcc,
-       isRdrDataCon, isRdrTyVar, isQual, isUnqual, isOrig,
-
-       -- Environment
-       RdrNameEnv, 
-       emptyRdrEnv, lookupRdrEnv, addListToRdrEnv, rdrEnvElts, 
-       extendRdrEnv, rdrEnvToList, elemRdrEnv, foldRdrEnv, 
+       rdrNameModule, rdrNameOcc, setRdrNameSpace,
+       isRdrDataCon, isRdrTyVar, isRdrTc, isQual, isUnqual, 
+       isOrig, isOrig_maybe, isExact, isExact_maybe, isSrcRdrName,
 
        -- Printing;    instance Outputable RdrName
-       pprUnqualRdrName 
+
+       -- LocalRdrEnv
+       LocalRdrEnv, emptyLocalRdrEnv, extendLocalRdrEnv,
+       lookupLocalRdrEnv, elemLocalRdrEnv,
+
+       -- GlobalRdrEnv
+       GlobalRdrEnv, emptyGlobalRdrEnv, mkGlobalRdrEnv, plusGlobalRdrEnv, 
+       lookupGlobalRdrEnv, pprGlobalRdrEnv, globalRdrEnvElts,
+       lookupGRE_RdrName, lookupGRE_Name,
+
+       -- GlobalRdrElt, Provenance, ImportSpec
+       GlobalRdrElt(..), Provenance(..), ImportSpec(..),
+       isLocalGRE, unQualOK,
+       pprNameProvenance
   ) where 
 
 #include "HsVersions.h"
 
-import OccName ( NameSpace, tcName,
-                 OccName, UserFS, EncodedFS,
-                 mkSysOccFS,
-                 mkOccFS, mkVarOcc,
-                 isDataOcc, isTvOcc, mkWorkerOcc
-               )
-import Module   ( ModuleName,
-                 mkSysModuleNameFS, mkModuleNameFS
+import OccName ( NameSpace, varName,
+                 OccName, UserFS, 
+                 setOccNameSpace,
+                 mkOccFS, occNameFlavour,
+                 isDataOcc, isTvOcc, isTcOcc,
+                 OccEnv, emptyOccEnv, extendOccEnvList, lookupOccEnv, 
+                 elemOccEnv, plusOccEnv_C, extendOccEnv_C, foldOccEnv,
+                 occEnvElts
                )
-import FiniteMap
+import Module   ( Module, mkModuleFS )
+import Name    ( Name, NamedThing(getName), nameModule, nameParent_maybe,
+                 nameOccName, isExternalName, nameSrcLoc )
+import SrcLoc  ( isGoodSrcLoc, SrcSpan )
 import Outputable
 import Util    ( thenCmp )
 \end{code}
@@ -51,17 +63,30 @@ import Util ( thenCmp )
 %************************************************************************
 
 \begin{code}
-data RdrName = RdrName Qual OccName
-
-data Qual = Unqual
-
-         | Qual ModuleName     -- A qualified name written by the user in source code
-                               -- The module isn't necessarily the module where
-                               -- the thing is defined; just the one from which it
-                               -- is imported
-
-         | Orig ModuleName     -- This is an *original* name; the module is the place
-                               -- where the thing was defined
+data RdrName 
+  = Unqual OccName
+       -- Used for ordinary, unqualified occurrences 
+
+  | Qual Module OccName
+       -- A qualified name written by the user in 
+       -- *source* code.  The module isn't necessarily 
+       -- the module where the thing is defined; 
+       -- just the one from which it is imported
+
+  | Orig Module OccName
+       -- An original name; the module is the *defining* module.
+       -- This is used when GHC generates code that will be fed
+       -- into the renamer (e.g. from deriving clauses), but where
+       -- we want to say "Use Prelude.map dammit".  
+  | Exact Name
+       -- We know exactly the Name. This is used 
+       --  (a) when the parser parses built-in syntax like "[]" 
+       --      and "(,)", but wants a RdrName from it
+       --  (b) when converting names to the RdrNames in IfaceTypes
+       --      Here an Exact RdrName always contains an External Name
+       --      (Internal Names are converted to simple Unquals)
+       --  (c) by Template Haskell, when TH has generated a unique name
 \end{code}
 
 
@@ -72,77 +97,103 @@ data Qual = Unqual
 %************************************************************************
 
 \begin{code}
-rdrNameModule :: RdrName -> ModuleName
-rdrNameModule (RdrName (Qual m) _) = m
-rdrNameModule (RdrName (Orig m) _) = m
+rdrNameModule :: RdrName -> Module
+rdrNameModule (Qual m _) = m
+rdrNameModule (Orig m _) = m
+rdrNameModule (Exact n)  = nameModule n
+rdrNameModule (Unqual n) = pprPanic "rdrNameModule" (ppr n)
 
 rdrNameOcc :: RdrName -> OccName
-rdrNameOcc (RdrName _ occ) = occ
-
-setRdrNameOcc :: RdrName -> OccName -> RdrName
-setRdrNameOcc (RdrName q _) occ = RdrName q occ
+rdrNameOcc (Qual _ occ) = occ
+rdrNameOcc (Unqual occ) = occ
+rdrNameOcc (Orig _ occ) = occ
+rdrNameOcc (Exact name) = nameOccName name
+
+setRdrNameSpace :: RdrName -> NameSpace -> RdrName
+-- This rather gruesome function is used mainly by the parser
+-- When parsing                data T a = T | T1 Int
+-- we parse the data constructors as *types* because of parser ambiguities,
+-- so then we need to change the *type constr* to a *data constr*
+--
+-- The original-name case *can* occur when parsing
+--             data [] a = [] | a : [a]
+-- For the orig-name case we return an unqualified name.
+setRdrNameSpace (Unqual occ) ns = Unqual (setOccNameSpace ns occ)
+setRdrNameSpace (Qual m occ) ns = Qual m (setOccNameSpace ns occ)
+setRdrNameSpace (Orig m occ) ns = Orig m (setOccNameSpace ns occ)
+setRdrNameSpace (Exact n)    ns = Orig (nameModule n)
+                                      (setOccNameSpace ns (nameOccName n))
 \end{code}
 
 \begin{code}
        -- These two are the basic constructors
 mkRdrUnqual :: OccName -> RdrName
-mkRdrUnqual occ = RdrName Unqual occ
+mkRdrUnqual occ = Unqual occ
 
-mkRdrQual :: ModuleName -> OccName -> RdrName
-mkRdrQual mod occ = RdrName (Qual mod) occ
+mkRdrQual :: Module -> OccName -> RdrName
+mkRdrQual mod occ = Qual mod occ
 
-mkRdrOrig :: ModuleName -> OccName -> RdrName
-mkRdrOrig mod occ = RdrName (Orig mod) occ
-
-mkIfaceOrig :: NameSpace -> (EncodedFS, EncodedFS) -> RdrName
-mkIfaceOrig ns (m,n) = RdrName (Orig (mkSysModuleNameFS m)) (mkSysOccFS ns n)
+mkOrig :: Module -> OccName -> RdrName
+mkOrig mod occ = Orig mod occ
 
+---------------
+mkDerivedRdrName :: Name -> (OccName -> OccName) -> (RdrName)
+mkDerivedRdrName parent mk_occ
+  = mkOrig (nameModule parent) (mk_occ (nameOccName parent))
 
+---------------
        -- These two are used when parsing source files
        -- They do encode the module and occurrence names
 mkUnqual :: NameSpace -> UserFS -> RdrName
-mkUnqual sp n = RdrName Unqual (mkOccFS sp n)
+mkUnqual sp n = Unqual (mkOccFS sp n)
 
-mkQual :: NameSpace -> (UserFS, UserFS) -> RdrName
-mkQual sp (m, n) = RdrName (Qual (mkModuleNameFS m)) (mkOccFS sp n)
+mkVarUnqual :: UserFS -> RdrName
+mkVarUnqual n = Unqual (mkOccFS varName n)
 
-mkOrig :: NameSpace -> ModuleName -> UserFS -> RdrName
-mkOrig sp mod n = RdrName (Orig mod) (mkOccFS sp n)
+mkQual :: NameSpace -> (UserFS, UserFS) -> RdrName
+mkQual sp (m, n) = Qual (mkModuleFS m) (mkOccFS sp n)
 
-qualifyRdrName :: ModuleName -> RdrName -> RdrName
-       -- Sets the module name of a RdrName, even if it has one already
-qualifyRdrName mod (RdrName _ occ) = RdrName (Qual mod) occ
+getRdrName :: NamedThing thing => thing -> RdrName
+getRdrName name = nameRdrName (getName name)
 
-unqualifyRdrName :: RdrName -> RdrName
-unqualifyRdrName (RdrName _ occ) = RdrName Unqual occ
+nameRdrName :: Name -> RdrName
+nameRdrName name = Exact name
+-- Keep the Name even for Internal names, so that the
+-- unique is still there for debug printing, particularly
+-- of Types (which are converted to IfaceTypes before printing)
 
-mkRdrNameWkr :: RdrName -> RdrName     -- Worker-ify it
-mkRdrNameWkr (RdrName qual occ) = RdrName qual (mkWorkerOcc occ)
+nukeExact :: Name -> RdrName
+nukeExact n 
+  | isExternalName n = Orig (nameModule n) (nameOccName n)
+  | otherwise       = Unqual (nameOccName n)
 \end{code}
 
 \begin{code}
-       -- This guy is used by the reader when HsSyn has a slot for
-       -- an implicit name that's going to be filled in by
-       -- the renamer.  We can't just put "error..." because
-       -- we sometimes want to print out stuff after reading but
-       -- before renaming
-dummyRdrVarName = RdrName Unqual (mkVarOcc SLIT("V-DUMMY"))
-dummyRdrTcName  = RdrName Unqual (mkOccFS tcName SLIT("TC-DUMMY"))
-\end{code}
+isRdrDataCon rn = isDataOcc (rdrNameOcc rn)
+isRdrTyVar   rn = isTvOcc   (rdrNameOcc rn)
+isRdrTc      rn = isTcOcc   (rdrNameOcc rn)
 
+isSrcRdrName (Unqual _) = True
+isSrcRdrName (Qual _ _) = True
+isSrcRdrName _         = False
 
-\begin{code}
-isRdrDataCon (RdrName _ occ) = isDataOcc occ
-isRdrTyVar   (RdrName _ occ) = isTvOcc occ
+isUnqual (Unqual _) = True
+isUnqual other     = False
+
+isQual (Qual _ _) = True
+isQual _         = False
 
-isUnqual (RdrName Unqual _) = True
-isUnqual other             = False
+isOrig (Orig _ _) = True
+isOrig _         = False
 
-isQual (RdrName (Qual _) _) = True
-isQual _                   = False
+isOrig_maybe (Orig m n) = Just (m,n)
+isOrig_maybe _         = Nothing
 
-isOrig (RdrName (Orig _)    _) = True
-isOrig other                  = False
+isExact (Exact _) = True
+isExact other  = False
+
+isExact_maybe (Exact n) = Just n
+isExact_maybe other    = Nothing
 \end{code}
 
 
@@ -154,17 +205,28 @@ isOrig other                     = False
 
 \begin{code}
 instance Outputable RdrName where
-    ppr (RdrName qual occ) = pp_qual qual <> ppr occ
-                          where
-                            pp_qual Unqual      = empty
-                            pp_qual (Qual mod)  = ppr mod <> dot
-                            pp_qual (Orig mod)  = ppr mod <> dot
+    ppr (Exact name)   = ppr name
+    ppr (Unqual occ)   = ppr occ <+> ppr_name_space occ
+    ppr (Qual mod occ) = ppr mod <> dot <> ppr occ <+> ppr_name_space occ
+    ppr (Orig mod occ) = ppr mod <> dot <> ppr occ <+> ppr_name_space occ
+
+ppr_name_space occ = ifPprDebug (parens (occNameFlavour occ))
 
-pprUnqualRdrName (RdrName qual occ) = ppr occ
+instance OutputableBndr RdrName where
+    pprBndr _ n 
+       | isTvOcc (rdrNameOcc n) = char '@' <+> ppr n
+       | otherwise              = ppr n
 
 instance Eq RdrName where
-    a == b = case (a `compare` b) of { EQ -> True;  _ -> False }
-    a /= b = case (a `compare` b) of { EQ -> False; _ -> True }
+    (Exact n1)           == (Exact n2)    = n1==n2
+       -- Convert exact to orig
+    (Exact n1)           == r2@(Orig _ _) = nukeExact n1 == r2
+    r1@(Orig _ _) == (Exact n2)    = r1 == nukeExact n2
+
+    (Orig m1 o1)  == (Orig m2 o2)  = m1==m2 && o1==o2
+    (Qual m1 o1)  == (Qual m2 o2)  = m1==m2 && o1==o2
+    (Unqual o1)   == (Unqual o2)   = o1==o2
+    r1 == r2 = False
 
 instance Ord RdrName where
     a <= b = case (a `compare` b) of { LT -> True;  EQ -> True;  GT -> False }
@@ -172,44 +234,255 @@ instance Ord RdrName where
     a >= b = case (a `compare` b) of { LT -> False; EQ -> True;  GT -> True  }
     a >         b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True  }
 
-    compare (RdrName q1 o1) (RdrName q2 o2)
-       = (o1  `compare` o2) `thenCmp` 
-         (q1  `cmpQual` q2) 
+       -- Exact < Unqual < Qual < Orig
+       -- [Note: Apr 2004] We used to use nukeExact to convert Exact to Orig 
+       --      before comparing so that Prelude.map == the exact Prelude.map, but 
+       --      that meant that we reported duplicates when renaming bindings 
+       --      generated by Template Haskell; e.g 
+       --      do { n1 <- newName "foo"; n2 <- newName "foo"; 
+       --           <decl involving n1,n2> }
+       --      I think we can do without this conversion
+    compare (Exact n1) (Exact n2) = n1 `compare` n2
+    compare (Exact n1) n2        = LT
+
+    compare (Unqual _)   (Exact _)    = GT
+    compare (Unqual o1)  (Unqual  o2) = o1 `compare` o2
+    compare (Unqual _)   _           = LT
+
+    compare (Qual _ _)   (Exact _)    = GT
+    compare (Qual _ _)   (Unqual _)   = GT
+    compare (Qual m1 o1) (Qual m2 o2) = (o1 `compare` o2) `thenCmp` (m1 `compare` m2) 
+    compare (Qual _ _)   (Orig _ _)   = LT
+
+    compare (Orig m1 o1) (Orig m2 o2) = (o1 `compare` o2) `thenCmp` (m1 `compare` m2) 
+    compare (Orig _ _)   _           = GT
+\end{code}
+
+
 
-cmpQual Unqual     Unqual      = EQ
-cmpQual (Qual m1)   (Qual m2)   = m1 `compare` m2
-cmpQual (Orig m1)   (Orig m2)   = m1 `compare` m2
-cmpQual Unqual      _          = LT
-cmpQual (Qual _)    (Orig _)    = LT
-cmpQual _          _           = GT
+%************************************************************************
+%*                                                                     *
+                       LocalRdrEnv
+%*                                                                     *
+%************************************************************************
+
+A LocalRdrEnv is used for local bindings (let, where, lambda, case)
+It is keyed by OccName, because we never use it for qualified names.
+
+\begin{code}
+type LocalRdrEnv = OccEnv Name
+
+emptyLocalRdrEnv = emptyOccEnv
+
+extendLocalRdrEnv :: LocalRdrEnv -> [Name] -> LocalRdrEnv
+extendLocalRdrEnv env names
+  = extendOccEnvList env [(nameOccName n, n) | n <- names]
+
+lookupLocalRdrEnv :: LocalRdrEnv -> RdrName -> Maybe Name
+lookupLocalRdrEnv env (Exact name) = Just name
+lookupLocalRdrEnv env (Unqual occ) = lookupOccEnv env occ
+lookupLocalRdrEnv env other       = Nothing
+
+elemLocalRdrEnv :: RdrName -> LocalRdrEnv -> Bool
+elemLocalRdrEnv rdr_name env 
+  | isUnqual rdr_name = rdrNameOcc rdr_name `elemOccEnv` env
+  | otherwise        = False
 \end{code}
 
 
+%************************************************************************
+%*                                                                     *
+                       GlobalRdrEnv
+%*                                                                     *
+%************************************************************************
+
+\begin{code}
+type GlobalRdrEnv = OccEnv [GlobalRdrElt]
+       -- Keyed by OccName; when looking up a qualified name
+       -- we look up the OccName part, and then check the Provenance
+       -- to see if the appropriate qualification is valid.  This
+       -- saves routinely doubling the size of the env by adding both
+       -- qualified and unqualified names to the domain.
+       --
+       -- The list in the range is reqd because there may be name clashes
+       -- These only get reported on lookup, not on construction
+
+       -- INVARIANT: All the members of the list have distinct 
+       --            gre_name fields; that is, no duplicate Names
+
+emptyGlobalRdrEnv = emptyOccEnv
+
+globalRdrEnvElts :: GlobalRdrEnv -> [GlobalRdrElt]
+globalRdrEnvElts env = foldOccEnv (++) [] env
+
+data GlobalRdrElt 
+  = GRE { gre_name   :: Name,
+         gre_prov   :: Provenance      -- Why it's in scope
+    }
+
+instance Outputable GlobalRdrElt where
+  ppr gre = ppr name <+> pp_parent (nameParent_maybe name)
+               <+> parens (pprNameProvenance gre)
+         where
+           name = gre_name gre
+           pp_parent (Just p) = brackets (text "parent:" <+> ppr p)
+           pp_parent Nothing  = empty
+
+pprGlobalRdrEnv :: GlobalRdrEnv -> SDoc
+pprGlobalRdrEnv env
+  = vcat (map pp (occEnvElts env))
+  where
+    pp gres = ppr (nameOccName (gre_name (head gres))) <> colon <+> 
+             vcat [ ppr (gre_name gre) <+> pprNameProvenance gre
+                  | gre <- gres]
+\end{code}
+
+\begin{code}
+lookupGlobalRdrEnv :: GlobalRdrEnv -> OccName -> [GlobalRdrElt]
+lookupGlobalRdrEnv env rdr_name = case lookupOccEnv env rdr_name of
+                                       Nothing   -> []
+                                       Just gres -> gres
+
+lookupGRE_RdrName :: RdrName -> GlobalRdrEnv -> [GlobalRdrElt]
+lookupGRE_RdrName rdr_name env
+  = case lookupOccEnv env occ of
+       Nothing -> []
+       Just gres | isUnqual rdr_name -> filter unQualOK gres
+                 | otherwise         -> filter (hasQual mod) gres
+  where
+    mod = rdrNameModule rdr_name
+    occ = rdrNameOcc rdr_name
+
+lookupGRE_Name :: GlobalRdrEnv -> Name -> [GlobalRdrElt]
+lookupGRE_Name env name
+  = [ gre | gre <- lookupGlobalRdrEnv env (nameOccName name),
+           gre_name gre == name ]
+
+
+isLocalGRE :: GlobalRdrElt -> Bool
+isLocalGRE (GRE {gre_prov = LocalDef _}) = True
+isLocalGRE other                        = False
+
+unQualOK :: GlobalRdrElt -> Bool
+-- An unqualifed version of this thing is in scope
+unQualOK (GRE {gre_prov = LocalDef _})    = True
+unQualOK (GRE {gre_prov = Imported is _}) = not (all is_qual is)
+
+hasQual :: Module -> GlobalRdrElt -> Bool
+-- A qualified version of this thing is in scope
+hasQual mod (GRE {gre_prov = LocalDef m})    = m == mod
+hasQual mod (GRE {gre_prov = Imported is _}) = any ((== mod) . is_as) is
+
+plusGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrEnv -> GlobalRdrEnv
+plusGlobalRdrEnv env1 env2 = plusOccEnv_C (foldr insertGRE) env1 env2
+
+mkGlobalRdrEnv :: [GlobalRdrElt] -> GlobalRdrEnv
+mkGlobalRdrEnv gres
+  = foldr add emptyGlobalRdrEnv gres
+  where
+    add gre env = extendOccEnv_C (foldr insertGRE) env 
+                                (nameOccName (gre_name gre)) 
+                                [gre]
+
+insertGRE :: GlobalRdrElt -> [GlobalRdrElt] -> [GlobalRdrElt]
+insertGRE new_g [] = [new_g]
+insertGRE new_g (old_g : old_gs)
+       | gre_name new_g == gre_name old_g
+       = new_g `plusGRE` old_g : old_gs
+       | otherwise
+       = old_g : insertGRE new_g old_gs
+
+plusGRE :: GlobalRdrElt -> GlobalRdrElt -> GlobalRdrElt
+-- Used when the gre_name fields match
+plusGRE g1 g2
+  = GRE { gre_name = gre_name g1,
+         gre_prov = gre_prov g1 `plusProv` gre_prov g2 }
+\end{code}
+
 
 %************************************************************************
 %*                                                                     *
-\subsection{Environment}
+                       Provenance
 %*                                                                     *
 %************************************************************************
 
+The "provenance" of something says how it came to be in scope.
+
+\begin{code}
+data Provenance
+  = LocalDef           -- Defined locally
+       Module
+
+  | Imported           -- Imported
+       [ImportSpec]    -- INVARIANT: non-empty
+       Bool            -- True iff the thing was named *explicitly* 
+                       -- in *any* of the import specs rather than being 
+                       -- imported as part of a group; 
+       -- e.g.
+       --      import B
+       --      import C( T(..) )
+       -- Here, everything imported by B, and the constructors of T
+       -- are not named explicitly; only T is named explicitly.
+       -- This info is used when warning of unused names.
+
+data ImportSpec                -- Describes a particular import declaration
+                       -- Shared among all the Provenaces for a particular
+                       -- import declaration
+  = ImportSpec {
+       is_mod  :: Module,              -- 'import Muggle'
+                                       -- Note the Muggle may well not be 
+                                       -- the defining module for this thing!
+       is_as   :: Module,              -- 'as M' (or 'Muggle' if there is no 'as' clause)
+       is_qual :: Bool,                -- True <=> qualified (only)
+       is_loc  :: SrcSpan }            -- Location of import statment
+
+-- Comparison of provenance is just used for grouping 
+-- error messages (in RnEnv.warnUnusedBinds)
+instance Eq Provenance where
+  p1 == p2 = case p1 `compare` p2 of EQ -> True; _ -> False
+
+instance Eq ImportSpec where
+  p1 == p2 = case p1 `compare` p2 of EQ -> True; _ -> False
+
+instance Ord Provenance where
+   compare (LocalDef _) (LocalDef _)   = EQ
+   compare (LocalDef _) (Imported _ _) = LT
+   compare (Imported _ _) (LocalDef _) = GT
+   compare (Imported is1 _) (Imported is2 _) = compare (head is1) (head is2)
+
+instance Ord ImportSpec where
+   compare is1 is2 = (is_mod is1 `compare` is_mod is2) `thenCmp` 
+                    (is_loc is1 `compare` is_loc is2)
+\end{code}
+
 \begin{code}
-type RdrNameEnv a = FiniteMap RdrName a
-
-emptyRdrEnv    :: RdrNameEnv a
-lookupRdrEnv   :: RdrNameEnv a -> RdrName -> Maybe a
-addListToRdrEnv :: RdrNameEnv a -> [(RdrName,a)] -> RdrNameEnv a
-extendRdrEnv   :: RdrNameEnv a -> RdrName -> a -> RdrNameEnv a
-rdrEnvToList    :: RdrNameEnv a -> [(RdrName, a)]
-rdrEnvElts     :: RdrNameEnv a -> [a]
-elemRdrEnv     :: RdrName -> RdrNameEnv a -> Bool
-foldRdrEnv     :: (RdrName -> a -> b -> b) -> b -> RdrNameEnv a -> b
-
-emptyRdrEnv     = emptyFM
-lookupRdrEnv    = lookupFM
-addListToRdrEnv = addListToFM
-rdrEnvElts     = eltsFM
-extendRdrEnv    = addToFM
-rdrEnvToList    = fmToList
-elemRdrEnv      = elemFM
-foldRdrEnv     = foldFM
+plusProv :: Provenance -> Provenance -> Provenance
+-- Choose LocalDef over Imported
+-- There is an obscure bug lurking here; in the presence
+-- of recursive modules, something can be imported *and* locally
+-- defined, and one might refer to it with a qualified name from
+-- the import -- but I'm going to ignore that because it makes
+-- the isLocalGRE predicate so much nicer this way
+plusProv (LocalDef m1) (LocalDef m2) 
+  = pprPanic "plusProv" (ppr m1 <+> ppr m2)
+plusProv p1@(LocalDef _) p2 = p1
+plusProv p1 p2@(LocalDef _) = p2
+plusProv (Imported is1 ex1) (Imported is2 ex2) 
+  = Imported (is1++is2) (ex1 || ex2)
+
+pprNameProvenance :: GlobalRdrElt -> SDoc
+pprNameProvenance (GRE {gre_name = name, gre_prov = LocalDef _})
+  = ptext SLIT("defined at") <+> ppr (nameSrcLoc name)
+pprNameProvenance (GRE {gre_name = name, gre_prov = Imported (why:whys) _})
+  = sep [ppr why, nest 2 (ppr_defn (nameSrcLoc name))]
+
+-- If we know the exact definition point (which we may do with GHCi)
+-- then show that too.  But not if it's just "imported from X".
+ppr_defn loc | isGoodSrcLoc loc = parens (ptext SLIT("defined at") <+> ppr loc)
+            | otherwise        = empty
+
+instance Outputable ImportSpec where
+   ppr imp_spec
+     = ptext SLIT("imported from") <+> ppr (is_mod imp_spec) 
+       <+> ptext SLIT("at") <+> ppr (is_loc imp_spec)
 \end{code}