compiler/basicTypes/RdrName.lhs

   1 %
   2 % (c) The University of Glasgow 2006
   3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   4 %
   5
   6 \begin{code}
   7 {-# LANGUAGE DeriveDataTypeable #-}
   8
   9 -- |
  10 -- #name_types#
  11 -- GHC uses several kinds of name internally:
  12 --
  13 -- * 'OccName.OccName': see "OccName#name_types"
  14 --
  15 -- * 'RdrName.RdrName' is the type of names that come directly from the parser. They
  16 --   have not yet had their scoping and binding resolved by the renamer and can be
  17 --   thought of to a first approximation as an 'OccName.OccName' with an optional module
  18 --   qualifier
  19 --
  20 -- * 'Name.Name': see "Name#name_types"
  21 --
  22 -- * 'Id.Id': see "Id#name_types"
  23 --
  24 -- * 'Var.Var': see "Var#name_types"
  25 module RdrName (
  26         -- * The main type
  27         RdrName(..),    -- Constructors exported only to BinIface
  28
  29         -- ** Construction
  30         mkRdrUnqual, mkRdrQual,
  31         mkUnqual, mkVarUnqual, mkQual, mkOrig,
  32         nameRdrName, getRdrName,
  33         mkDerivedRdrName,
  34
  35         -- ** Destruction
  36         rdrNameOcc, rdrNameSpace, setRdrNameSpace,
  37         isRdrDataCon, isRdrTyVar, isRdrTc, isQual, isQual_maybe, isUnqual,
  38         isOrig, isOrig_maybe, isExact, isExact_maybe, isSrcRdrName,
  39
  40         -- ** Printing
  41         showRdrName,
  42
  43         -- * Local mapping of 'RdrName' to 'Name.Name'
  44         LocalRdrEnv, emptyLocalRdrEnv, extendLocalRdrEnv, extendLocalRdrEnvList,
  45         lookupLocalRdrEnv, lookupLocalRdrOcc, elemLocalRdrEnv,
  46
  47         -- * Global mapping of 'RdrName' to 'GlobalRdrElt's
  48         GlobalRdrEnv, emptyGlobalRdrEnv, mkGlobalRdrEnv, plusGlobalRdrEnv,
  49         lookupGlobalRdrEnv, extendGlobalRdrEnv,
  50         pprGlobalRdrEnv, globalRdrEnvElts,
  51         lookupGRE_RdrName, lookupGRE_Name, getGRE_NameQualifier_maybes,
  52         hideSomeUnquals, findLocalDupsRdrEnv, pickGREs,
  53
  54         -- ** Global 'RdrName' mapping elements: 'GlobalRdrElt', 'Provenance', 'ImportSpec'
  55         GlobalRdrElt(..), isLocalGRE, unQualOK, qualSpecOK, unQualSpecOK,
  56         Provenance(..), pprNameProvenance,
  57         Parent(..),
  58         ImportSpec(..), ImpDeclSpec(..), ImpItemSpec(..),
  59         importSpecLoc, importSpecModule, isExplicitItem
  60   ) where
  61
  62 #include "HsVersions.h"
  63
  64 import Module
  65 import Name
  66 import Maybes
  67 import SrcLoc
  68 import FastString
  69 import Outputable
  70 import Util
  71
  72 import Data.Data
  73 \end{code}
  74
  75 %************************************************************************
  76 %*                                                                      *
  77 \subsection{The main data type}
  78 %*                                                                      *
  79 %************************************************************************
  80
  81 \begin{code}
  82 -- | Do not use the data constructors of RdrName directly: prefer the family
  83 -- of functions that creates them, such as 'mkRdrUnqual'
  84 data RdrName
  85   = Unqual OccName
  86         -- ^ Used for ordinary, unqualified occurrences, e.g. @x@, @y@ or @Foo@.
  87         -- Create such a 'RdrName' with 'mkRdrUnqual'
  88
  89   | Qual ModuleName OccName
  90         -- ^ A qualified name written by the user in
  91         -- /source/ code.  The module isn't necessarily
  92         -- the module where the thing is defined;
  93         -- just the one from which it is imported.
  94         -- Examples are @Bar.x@, @Bar.y@ or @Bar.Foo@.
  95         -- Create such a 'RdrName' with 'mkRdrQual'
  96
  97   | Orig Module OccName
  98         -- ^ An original name; the module is the /defining/ module.
  99         -- This is used when GHC generates code that will be fed
 100         -- into the renamer (e.g. from deriving clauses), but where
 101         -- we want to say \"Use Prelude.map dammit\". One of these
 102         -- can be created with 'mkOrig'
 103
 104   | Exact Name
 105         -- ^ We know exactly the 'Name'. This is used:
 106         --
 107         --  (1) When the parser parses built-in syntax like @[]@
 108         --      and @(,)@, but wants a 'RdrName' from it
 109         --
 110         --  (2) By Template Haskell, when TH has generated a unique name
 111         --
 112         -- Such a 'RdrName' can be created by using 'getRdrName' on a 'Name'
 113   deriving (Data, Typeable)
 114 \end{code}
 115
 116
 117 %************************************************************************
 118 %*                                                                      *
 119 \subsection{Simple functions}
 120 %*                                                                      *
 121 %************************************************************************
 122
 123 \begin{code}
 124 rdrNameOcc :: RdrName -> OccName
 125 rdrNameOcc (Qual _ occ) = occ
 126 rdrNameOcc (Unqual occ) = occ
 127 rdrNameOcc (Orig _ occ) = occ
 128 rdrNameOcc (Exact name) = nameOccName name
 129
 130 rdrNameSpace :: RdrName -> NameSpace
 131 rdrNameSpace = occNameSpace . rdrNameOcc
 132
 133 setRdrNameSpace :: RdrName -> NameSpace -> RdrName
 134 -- ^ This rather gruesome function is used mainly by the parser.
 135 -- When parsing:
 136 --
 137 -- > data T a = T | T1 Int
 138 --
 139 -- we parse the data constructors as /types/ because of parser ambiguities,
 140 -- so then we need to change the /type constr/ to a /data constr/
 141 --
 142 -- The exact-name case /can/ occur when parsing:
 143 --
 144 -- > data [] a = [] | a : [a]
 145 --
 146 -- For the exact-name case we return an original name.
 147 setRdrNameSpace (Unqual occ) ns = Unqual (setOccNameSpace ns occ)
 148 setRdrNameSpace (Qual m occ) ns = Qual m (setOccNameSpace ns occ)
 149 setRdrNameSpace (Orig m occ) ns = Orig m (setOccNameSpace ns occ)
 150 setRdrNameSpace (Exact n)    ns = ASSERT( isExternalName n )
 151                                   Orig (nameModule n)
 152                                        (setOccNameSpace ns (nameOccName n))
 153 \end{code}
 154
 155 \begin{code}
 156         -- These two are the basic constructors
 157 mkRdrUnqual :: OccName -> RdrName
 158 mkRdrUnqual occ = Unqual occ
 159
 160 mkRdrQual :: ModuleName -> OccName -> RdrName
 161 mkRdrQual mod occ = Qual mod occ
 162
 163 mkOrig :: Module -> OccName -> RdrName
 164 mkOrig mod occ = Orig mod occ
 165
 166 ---------------
 167 -- | Produce an original 'RdrName' whose module that of a parent 'Name' but its 'OccName'
 168 -- is derived from that of it's parent using the supplied function
 169 mkDerivedRdrName :: Name -> (OccName -> OccName) -> RdrName
 170 mkDerivedRdrName parent mk_occ
 171   = ASSERT2( isExternalName parent, ppr parent )
 172     mkOrig (nameModule parent) (mk_occ (nameOccName parent))
 173
 174 ---------------
 175         -- These two are used when parsing source files
 176         -- They do encode the module and occurrence names
 177 mkUnqual :: NameSpace -> FastString -> RdrName
 178 mkUnqual sp n = Unqual (mkOccNameFS sp n)
 179
 180 mkVarUnqual :: FastString -> RdrName
 181 mkVarUnqual n = Unqual (mkVarOccFS n)
 182
 183 -- | Make a qualified 'RdrName' in the given namespace and where the 'ModuleName' and
 184 -- the 'OccName' are taken from the first and second elements of the tuple respectively
 185 mkQual :: NameSpace -> (FastString, FastString) -> RdrName
 186 mkQual sp (m, n) = Qual (mkModuleNameFS m) (mkOccNameFS sp n)
 187
 188 getRdrName :: NamedThing thing => thing -> RdrName
 189 getRdrName name = nameRdrName (getName name)
 190
 191 nameRdrName :: Name -> RdrName
 192 nameRdrName name = Exact name
 193 -- Keep the Name even for Internal names, so that the
 194 -- unique is still there for debug printing, particularly
 195 -- of Types (which are converted to IfaceTypes before printing)
 196
 197 nukeExact :: Name -> RdrName
 198 nukeExact n
 199   | isExternalName n = Orig (nameModule n) (nameOccName n)
 200   | otherwise        = Unqual (nameOccName n)
 201 \end{code}
 202
 203 \begin{code}
 204 isRdrDataCon :: RdrName -> Bool
 205 isRdrTyVar   :: RdrName -> Bool
 206 isRdrTc      :: RdrName -> Bool
 207
 208 isRdrDataCon rn = isDataOcc (rdrNameOcc rn)
 209 isRdrTyVar   rn = isTvOcc   (rdrNameOcc rn)
 210 isRdrTc      rn = isTcOcc   (rdrNameOcc rn)
 211
 212 isSrcRdrName :: RdrName -> Bool
 213 isSrcRdrName (Unqual _) = True
 214 isSrcRdrName (Qual _ _) = True
 215 isSrcRdrName _          = False
 216
 217 isUnqual :: RdrName -> Bool
 218 isUnqual (Unqual _) = True
 219 isUnqual _          = False
 220
 221 isQual :: RdrName -> Bool
 222 isQual (Qual _ _) = True
 223 isQual _          = False
 224
 225 isQual_maybe :: RdrName -> Maybe (ModuleName, OccName)
 226 isQual_maybe (Qual m n) = Just (m,n)
 227 isQual_maybe _          = Nothing
 228
 229 isOrig :: RdrName -> Bool
 230 isOrig (Orig _ _) = True
 231 isOrig _          = False
 232
 233 isOrig_maybe :: RdrName -> Maybe (Module, OccName)
 234 isOrig_maybe (Orig m n) = Just (m,n)
 235 isOrig_maybe _          = Nothing
 236
 237 isExact :: RdrName -> Bool
 238 isExact (Exact _) = True
 239 isExact _         = False
 240
 241 isExact_maybe :: RdrName -> Maybe Name
 242 isExact_maybe (Exact n) = Just n
 243 isExact_maybe _         = Nothing
 244 \end{code}
 245
 246
 247 %************************************************************************
 248 %*                                                                      *
 249 \subsection{Instances}
 250 %*                                                                      *
 251 %************************************************************************
 252
 253 \begin{code}
 254 instance Outputable RdrName where
 255     ppr (Exact name)   = ppr name
 256     ppr (Unqual occ)   = ppr occ
 257     ppr (Qual mod occ) = ppr mod <> dot <> ppr occ
 258     ppr (Orig mod occ) = getPprStyle (\sty -> pprModulePrefix sty mod occ <> ppr occ)
 259
 260 instance OutputableBndr RdrName where
 261     pprBndr _ n
 262         | isTvOcc (rdrNameOcc n) = char '@' <+> ppr n
 263         | otherwise              = ppr n
 264
 265 showRdrName :: RdrName -> String
 266 showRdrName r = showSDoc (ppr r)
 267
 268 instance Eq RdrName where
 269     (Exact n1)    == (Exact n2)    = n1==n2
 270         -- Convert exact to orig
 271     (Exact n1)    == r2@(Orig _ _) = nukeExact n1 == r2
 272     r1@(Orig _ _) == (Exact n2)    = r1 == nukeExact n2
 273
 274     (Orig m1 o1)  == (Orig m2 o2)  = m1==m2 && o1==o2
 275     (Qual m1 o1)  == (Qual m2 o2)  = m1==m2 && o1==o2
 276     (Unqual o1)   == (Unqual o2)   = o1==o2
 277     _             == _             = False
 278
 279 instance Ord RdrName where
 280     a <= b = case (a `compare` b) of { LT -> True;  EQ -> True;  GT -> False }
 281     a <  b = case (a `compare` b) of { LT -> True;  EQ -> False; GT -> False }
 282     a >= b = case (a `compare` b) of { LT -> False; EQ -> True;  GT -> True  }
 283     a >  b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True  }
 284
 285         -- Exact < Unqual < Qual < Orig
 286         -- [Note: Apr 2004] We used to use nukeExact to convert Exact to Orig
 287         --      before comparing so that Prelude.map == the exact Prelude.map, but
 288         --      that meant that we reported duplicates when renaming bindings
 289         --      generated by Template Haskell; e.g
 290         --      do { n1 <- newName "foo"; n2 <- newName "foo";
 291         --           <decl involving n1,n2> }
 292         --      I think we can do without this conversion
 293     compare (Exact n1) (Exact n2) = n1 `compare` n2
 294     compare (Exact _)  _          = LT
 295
 296     compare (Unqual _)   (Exact _)    = GT
 297     compare (Unqual o1)  (Unqual  o2) = o1 `compare` o2
 298     compare (Unqual _)   _            = LT
 299
 300     compare (Qual _ _)   (Exact _)    = GT
 301     compare (Qual _ _)   (Unqual _)   = GT
 302     compare (Qual m1 o1) (Qual m2 o2) = (o1 `compare` o2) `thenCmp` (m1 `compare` m2)
 303     compare (Qual _ _)   (Orig _ _)   = LT
 304
 305     compare (Orig m1 o1) (Orig m2 o2) = (o1 `compare` o2) `thenCmp` (m1 `compare` m2)
 306     compare (Orig _ _)   _            = GT
 307 \end{code}
 308
 309 %************************************************************************
 310 %*                                                                      *
 311                         LocalRdrEnv
 312 %*                                                                      *
 313 %************************************************************************
 314
 315 \begin{code}
 316 -- | This environment is used to store local bindings (@let@, @where@, lambda, @case@).
 317 -- It is keyed by OccName, because we never use it for qualified names
 318 type LocalRdrEnv = OccEnv Name
 319
 320 emptyLocalRdrEnv :: LocalRdrEnv
 321 emptyLocalRdrEnv = emptyOccEnv
 322
 323 extendLocalRdrEnv :: LocalRdrEnv -> Name -> LocalRdrEnv
 324 extendLocalRdrEnv env name
 325   = extendOccEnv env (nameOccName name) name
 326
 327 extendLocalRdrEnvList :: LocalRdrEnv -> [Name] -> LocalRdrEnv
 328 extendLocalRdrEnvList env names
 329   = extendOccEnvList env [(nameOccName n, n) | n <- names]
 330
 331 lookupLocalRdrEnv :: LocalRdrEnv -> RdrName -> Maybe Name
 332 lookupLocalRdrEnv _   (Exact name) = Just name
 333 lookupLocalRdrEnv env (Unqual occ) = lookupOccEnv env occ
 334 lookupLocalRdrEnv _   _            = Nothing
 335
 336 lookupLocalRdrOcc :: LocalRdrEnv -> OccName -> Maybe Name
 337 lookupLocalRdrOcc env occ = lookupOccEnv env occ
 338
 339 elemLocalRdrEnv :: RdrName -> LocalRdrEnv -> Bool
 340 elemLocalRdrEnv rdr_name env
 341   | isUnqual rdr_name = rdrNameOcc rdr_name `elemOccEnv` env
 342   | otherwise         = False
 343 \end{code}
 344
 345 %************************************************************************
 346 %*                                                                      *
 347                         GlobalRdrEnv
 348 %*                                                                      *
 349 %************************************************************************
 350
 351 \begin{code}
 352 type GlobalRdrEnv = OccEnv [GlobalRdrElt]
 353 -- ^ Keyed by 'OccName'; when looking up a qualified name
 354 -- we look up the 'OccName' part, and then check the 'Provenance'
 355 -- to see if the appropriate qualification is valid.  This
 356 -- saves routinely doubling the size of the env by adding both
 357 -- qualified and unqualified names to the domain.
 358 --
 359 -- The list in the codomain is required because there may be name clashes
 360 -- These only get reported on lookup, not on construction
 361 --
 362 -- INVARIANT: All the members of the list have distinct
 363 --            'gre_name' fields; that is, no duplicate Names
 364 --
 365 -- INVARIANT: Imported provenance => Name is an ExternalName
 366 --            However LocalDefs can have an InternalName.  This
 367 --            happens only when type-checking a [d| ... |] Template
 368 --            Haskell quotation; see this note in RnNames
 369 --            Note [Top-level Names in Template Haskell decl quotes]
 370
 371 -- | An element of the 'GlobalRdrEnv'
 372 data GlobalRdrElt
 373   = GRE { gre_name :: Name,
 374           gre_par  :: Parent,
 375           gre_prov :: Provenance        -- ^ Why it's in scope
 376     }
 377
 378 -- | The children of a Name are the things that are abbreviated by the ".."
 379 --   notation in export lists.  Specifically:
 380 --      TyCon   Children are * data constructors
 381 --                           * record field ids
 382 --      Class   Children are * class operations
 383 -- Each child has the parent thing as its Parent
 384 data Parent = NoParent | ParentIs Name
 385               deriving (Eq)
 386
 387 instance Outputable Parent where
 388    ppr NoParent     = empty
 389    ppr (ParentIs n) = ptext (sLit "parent:") <> ppr n
 390
 391
 392 plusParent :: Parent -> Parent -> Parent
 393 plusParent p1 p2 = ASSERT2( p1 == p2, parens (ppr p1) <+> parens (ppr p2) )
 394                    p1
 395
 396 {- Why so complicated? -=chak
 397 plusParent :: Parent -> Parent -> Parent
 398 plusParent NoParent     rel =
 399   ASSERT2( case rel of { NoParent -> True; other -> False },
 400            ptext (sLit "plusParent[NoParent]: ") <+> ppr rel )
 401   NoParent
 402 plusParent (ParentIs n) rel =
 403   ASSERT2( case rel of { ParentIs m -> n==m;  other -> False },
 404            ptext (sLit "plusParent[ParentIs]:") <+> ppr n <> comma <+> ppr rel )
 405   ParentIs n
 406  -}
 407
 408 emptyGlobalRdrEnv :: GlobalRdrEnv
 409 emptyGlobalRdrEnv = emptyOccEnv
 410
 411 globalRdrEnvElts :: GlobalRdrEnv -> [GlobalRdrElt]
 412 globalRdrEnvElts env = foldOccEnv (++) [] env
 413
 414 instance Outputable GlobalRdrElt where
 415   ppr gre = ppr name <+> parens (ppr (gre_par gre) <+> pprNameProvenance gre)
 416           where
 417             name = gre_name gre
 418
 419 pprGlobalRdrEnv :: GlobalRdrEnv -> SDoc
 420 pprGlobalRdrEnv env
 421   = vcat (map pp (occEnvElts env))
 422   where
 423     pp gres = ppr (nameOccName (gre_name (head gres))) <> colon <+>
 424               vcat [ ppr (gre_name gre) <+> pprNameProvenance gre
 425                    | gre <- gres]
 426 \end{code}
 427
 428 \begin{code}
 429 lookupGlobalRdrEnv :: GlobalRdrEnv -> OccName -> [GlobalRdrElt]
 430 lookupGlobalRdrEnv env occ_name = case lookupOccEnv env occ_name of
 431                                         Nothing   -> []
 432                                         Just gres -> gres
 433
 434 extendGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrElt -> GlobalRdrEnv
 435 extendGlobalRdrEnv env gre = extendOccEnv_Acc (:) singleton env occ gre
 436   where
 437     occ = nameOccName (gre_name gre)
 438
 439 lookupGRE_RdrName :: RdrName -> GlobalRdrEnv -> [GlobalRdrElt]
 440 lookupGRE_RdrName rdr_name env
 441   = case lookupOccEnv env (rdrNameOcc rdr_name) of
 442         Nothing   -> []
 443         Just gres -> pickGREs rdr_name gres
 444
 445 lookupGRE_Name :: GlobalRdrEnv -> Name -> [GlobalRdrElt]
 446 lookupGRE_Name env name
 447   = [ gre | gre <- lookupGlobalRdrEnv env (nameOccName name),
 448             gre_name gre == name ]
 449
 450 getGRE_NameQualifier_maybes :: GlobalRdrEnv -> Name -> [Maybe [ModuleName]]
 451 getGRE_NameQualifier_maybes env
 452   = map qualifier_maybe . map gre_prov . lookupGRE_Name env
 453   where qualifier_maybe LocalDef       = Nothing
 454         qualifier_maybe (Imported iss) = Just $ map (is_as . is_decl) iss
 455
 456 pickGREs :: RdrName -> [GlobalRdrElt] -> [GlobalRdrElt]
 457 -- ^ Take a list of GREs which have the right OccName
 458 -- Pick those GREs that are suitable for this RdrName
 459 -- And for those, keep only only the Provenances that are suitable
 460 --
 461 -- Consider:
 462 --
 463 -- @
 464 --       module A ( f ) where
 465 --       import qualified Foo( f )
 466 --       import Baz( f )
 467 --       f = undefined
 468 -- @
 469 --
 470 -- Let's suppose that @Foo.f@ and @Baz.f@ are the same entity really.
 471 -- The export of @f@ is ambiguous because it's in scope from the local def
 472 -- and the import.  The lookup of @Unqual f@ should return a GRE for
 473 -- the locally-defined @f@, and a GRE for the imported @f@, with a /single/
 474 -- provenance, namely the one for @Baz(f)@.
 475 pickGREs rdr_name gres
 476   = mapCatMaybes pick gres
 477   where
 478     rdr_is_unqual = isUnqual rdr_name
 479     rdr_is_qual   = isQual_maybe rdr_name
 480
 481     pick :: GlobalRdrElt -> Maybe GlobalRdrElt
 482     pick gre@(GRE {gre_prov = LocalDef, gre_name = n})  -- Local def
 483         | rdr_is_unqual                    = Just gre
 484         | Just (mod,_) <- rdr_is_qual        -- Qualified name
 485         , Just n_mod <- nameModule_maybe n   -- Binder is External
 486         , mod == moduleName n_mod          = Just gre
 487         | otherwise                        = Nothing
 488     pick gre@(GRE {gre_prov = Imported [is]})   -- Single import (efficiency)
 489         | rdr_is_unqual,
 490           not (is_qual (is_decl is))    = Just gre
 491         | Just (mod,_) <- rdr_is_qual,
 492           mod == is_as (is_decl is)     = Just gre
 493         | otherwise                     = Nothing
 494     pick gre@(GRE {gre_prov = Imported is})     -- Multiple import
 495         | null filtered_is = Nothing
 496         | otherwise        = Just (gre {gre_prov = Imported filtered_is})
 497         where
 498           filtered_is | rdr_is_unqual
 499                       = filter (not . is_qual    . is_decl) is
 500                       | Just (mod,_) <- rdr_is_qual
 501                       = filter ((== mod) . is_as . is_decl) is
 502                       | otherwise
 503                       = []
 504
 505 isLocalGRE :: GlobalRdrElt -> Bool
 506 isLocalGRE (GRE {gre_prov = LocalDef}) = True
 507 isLocalGRE _                           = False
 508
 509 unQualOK :: GlobalRdrElt -> Bool
 510 -- ^ Test if an unqualifed version of this thing would be in scope
 511 unQualOK (GRE {gre_prov = LocalDef})    = True
 512 unQualOK (GRE {gre_prov = Imported is}) = any unQualSpecOK is
 513
 514 plusGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrEnv -> GlobalRdrEnv
 515 plusGlobalRdrEnv env1 env2 = plusOccEnv_C (foldr insertGRE) env1 env2
 516
 517 mkGlobalRdrEnv :: [GlobalRdrElt] -> GlobalRdrEnv
 518 mkGlobalRdrEnv gres
 519   = foldr add emptyGlobalRdrEnv gres
 520   where
 521     add gre env = extendOccEnv_Acc insertGRE singleton env
 522                                    (nameOccName (gre_name gre))
 523                                    gre
 524
 525 findLocalDupsRdrEnv :: GlobalRdrEnv -> [OccName] -> (GlobalRdrEnv, [[Name]])
 526 -- ^ For each 'OccName', see if there are multiple local definitions
 527 -- for it.  If so, remove all but one (to suppress subsequent error messages)
 528 -- and return a list of the duplicate bindings
 529 findLocalDupsRdrEnv rdr_env occs
 530   = go rdr_env [] occs
 531   where
 532     go rdr_env dups [] = (rdr_env, dups)
 533     go rdr_env dups (occ:occs)
 534       = case filter isLocalGRE gres of
 535           []       -> WARN( True, ppr occ <+> ppr rdr_env )
 536                       go rdr_env dups occs      -- Weird!  No binding for occ
 537           [_]      -> go rdr_env dups occs      -- The common case
 538           dup_gres -> go (extendOccEnv rdr_env occ (head dup_gres : nonlocal_gres))
 539                          (map gre_name dup_gres : dups)
 540                          occs
 541       where
 542         gres = lookupOccEnv rdr_env occ `orElse` []
 543         nonlocal_gres = filterOut isLocalGRE gres
 544
 545
 546 insertGRE :: GlobalRdrElt -> [GlobalRdrElt] -> [GlobalRdrElt]
 547 insertGRE new_g [] = [new_g]
 548 insertGRE new_g (old_g : old_gs)
 549         | gre_name new_g == gre_name old_g
 550         = new_g `plusGRE` old_g : old_gs
 551         | otherwise
 552         = old_g : insertGRE new_g old_gs
 553
 554 plusGRE :: GlobalRdrElt -> GlobalRdrElt -> GlobalRdrElt
 555 -- Used when the gre_name fields match
 556 plusGRE g1 g2
 557   = GRE { gre_name = gre_name g1,
 558           gre_prov = gre_prov g1 `plusProv`   gre_prov g2,
 559           gre_par  = gre_par  g1 `plusParent` gre_par  g2 }
 560
 561 hideSomeUnquals :: GlobalRdrEnv -> [OccName] -> GlobalRdrEnv
 562 -- ^ Hide any unqualified bindings for the specified OccNames
 563 -- This is used in TH, when renaming a declaration bracket
 564 --
 565 -- > [d| foo = ... |]
 566 --
 567 -- We want unqualified @foo@ in "..." to mean this @foo@, not
 568 -- the one from the enclosing module.  But the /qualified/ name
 569 -- from the enclosing module must certainly still be available
 570
 571 --      Seems like 5 times as much work as it deserves!
 572 hideSomeUnquals rdr_env occs
 573   = foldr hide rdr_env occs
 574   where
 575     hide occ env
 576         | Just gres <- lookupOccEnv env occ = extendOccEnv env occ (map qual_gre gres)
 577         | otherwise                         = env
 578     qual_gre gre@(GRE { gre_name = name, gre_prov = LocalDef })
 579         = gre { gre_prov = Imported [imp_spec] }
 580         where   -- Local defs get transfomed to (fake) imported things
 581           mod = ASSERT2( isExternalName name, ppr name) moduleName (nameModule name)
 582           imp_spec = ImpSpec { is_item = ImpAll, is_decl = decl_spec }
 583           decl_spec = ImpDeclSpec { is_mod = mod, is_as = mod,
 584                                     is_qual = True,
 585                                     is_dloc = srcLocSpan (nameSrcLoc name) }
 586
 587     qual_gre gre@(GRE { gre_prov = Imported specs })
 588         = gre { gre_prov = Imported (map qual_spec specs) }
 589
 590     qual_spec spec@(ImpSpec { is_decl = decl_spec })
 591         = spec { is_decl = decl_spec { is_qual = True } }
 592 \end{code}
 593
 594 %************************************************************************
 595 %*                                                                      *
 596                         Provenance
 597 %*                                                                      *
 598 %************************************************************************
 599
 600 \begin{code}
 601 -- | The 'Provenance' of something says how it came to be in scope.
 602 -- It's quite elaborate so that we can give accurate unused-name warnings.
 603 data Provenance
 604   = LocalDef            -- ^ The thing was defined locally
 605   | Imported
 606         [ImportSpec]    -- ^ The thing was imported.
 607                         --
 608                         -- INVARIANT: the list of 'ImportSpec' is non-empty
 609
 610 data ImportSpec = ImpSpec { is_decl :: ImpDeclSpec,
 611                             is_item ::  ImpItemSpec }
 612                 deriving( Eq, Ord )
 613
 614 -- | Describes a particular import declaration and is
 615 -- shared among all the 'Provenance's for that decl
 616 data ImpDeclSpec
 617   = ImpDeclSpec {
 618         is_mod      :: ModuleName, -- ^ Module imported, e.g. @import Muggle@
 619                                    -- Note the @Muggle@ may well not be
 620                                    -- the defining module for this thing!
 621
 622                                    -- TODO: either should be Module, or there
 623                                    -- should be a Maybe PackageId here too.
 624         is_as       :: ModuleName, -- ^ Import alias, e.g. from @as M@ (or @Muggle@ if there is no @as@ clause)
 625         is_qual     :: Bool,       -- ^ Was this import qualified?
 626         is_dloc     :: SrcSpan     -- ^ The location of the entire import declaration
 627     }
 628
 629 -- | Describes import info a particular Name
 630 data ImpItemSpec
 631   = ImpAll              -- ^ The import had no import list,
 632                         -- or had a hiding list
 633
 634   | ImpSome {
 635         is_explicit :: Bool,
 636         is_iloc     :: SrcSpan  -- Location of the import item
 637     }   -- ^ The import had an import list.
 638         -- The 'is_explicit' field is @True@ iff the thing was named
 639         -- /explicitly/ in the import specs rather
 640         -- than being imported as part of a "..." group. Consider:
 641         --
 642         -- > import C( T(..) )
 643         --
 644         -- Here the constructors of @T@ are not named explicitly;
 645         -- only @T@ is named explicitly.
 646
 647 unQualSpecOK :: ImportSpec -> Bool
 648 -- ^ Is in scope unqualified?
 649 unQualSpecOK is = not (is_qual (is_decl is))
 650
 651 qualSpecOK :: ModuleName -> ImportSpec -> Bool
 652 -- ^ Is in scope qualified with the given module?
 653 qualSpecOK mod is = mod == is_as (is_decl is)
 654
 655 importSpecLoc :: ImportSpec -> SrcSpan
 656 importSpecLoc (ImpSpec decl ImpAll) = is_dloc decl
 657 importSpecLoc (ImpSpec _    item)   = is_iloc item
 658
 659 importSpecModule :: ImportSpec -> ModuleName
 660 importSpecModule is = is_mod (is_decl is)
 661
 662 isExplicitItem :: ImpItemSpec -> Bool
 663 isExplicitItem ImpAll                        = False
 664 isExplicitItem (ImpSome {is_explicit = exp}) = exp
 665
 666 -- Note [Comparing provenance]
 667 -- Comparison of provenance is just used for grouping
 668 -- error messages (in RnEnv.warnUnusedBinds)
 669 instance Eq Provenance where
 670   p1 == p2 = case p1 `compare` p2 of EQ -> True; _ -> False
 671
 672 instance Eq ImpDeclSpec where
 673   p1 == p2 = case p1 `compare` p2 of EQ -> True; _ -> False
 674
 675 instance Eq ImpItemSpec where
 676   p1 == p2 = case p1 `compare` p2 of EQ -> True; _ -> False
 677
 678 instance Ord Provenance where
 679    compare LocalDef      LocalDef        = EQ
 680    compare LocalDef      (Imported _)    = LT
 681    compare (Imported _ ) LocalDef        = GT
 682    compare (Imported is1) (Imported is2) = compare (head is1)
 683         {- See Note [Comparing provenance] -}      (head is2)
 684
 685 instance Ord ImpDeclSpec where
 686    compare is1 is2 = (is_mod is1 `compare` is_mod is2) `thenCmp`
 687                      (is_dloc is1 `compare` is_dloc is2)
 688
 689 instance Ord ImpItemSpec where
 690    compare is1 is2 = is_iloc is1 `compare` is_iloc is2
 691 \end{code}
 692
 693 \begin{code}
 694 plusProv :: Provenance -> Provenance -> Provenance
 695 -- Choose LocalDef over Imported
 696 -- There is an obscure bug lurking here; in the presence
 697 -- of recursive modules, something can be imported *and* locally
 698 -- defined, and one might refer to it with a qualified name from
 699 -- the import -- but I'm going to ignore that because it makes
 700 -- the isLocalGRE predicate so much nicer this way
 701 plusProv LocalDef        LocalDef        = panic "plusProv"
 702 plusProv LocalDef        _               = LocalDef
 703 plusProv _               LocalDef        = LocalDef
 704 plusProv (Imported is1)  (Imported is2)  = Imported (is1++is2)
 705
 706 pprNameProvenance :: GlobalRdrElt -> SDoc
 707 -- ^ Print out the place where the name was imported
 708 pprNameProvenance (GRE {gre_name = name, gre_prov = LocalDef})
 709   = ptext (sLit "defined at") <+> ppr (nameSrcLoc name)
 710 pprNameProvenance (GRE {gre_name = name, gre_prov = Imported whys})
 711   = case whys of
 712         (why:_) -> sep [ppr why, nest 2 (ppr_defn (nameSrcLoc name))]
 713         [] -> panic "pprNameProvenance"
 714
 715 -- If we know the exact definition point (which we may do with GHCi)
 716 -- then show that too.  But not if it's just "imported from X".
 717 ppr_defn :: SrcLoc -> SDoc
 718 ppr_defn loc | isGoodSrcLoc loc = parens (ptext (sLit "defined at") <+> ppr loc)
 719              | otherwise        = empty
 720
 721 instance Outputable ImportSpec where
 722    ppr imp_spec
 723      = ptext (sLit "imported from") <+> ppr (importSpecModule imp_spec)
 724         <+> if isGoodSrcSpan loc then ptext (sLit "at") <+> ppr loc
 725                                  else empty
 726      where
 727        loc = importSpecLoc imp_spec
 728 \end{code}