RdrName.lhs 35.4 KB
Newer Older
1
%
Simon Marlow's avatar
Simon Marlow committed
2
% (c) The University of Glasgow 2006
3 4 5 6
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%

\begin{code}
7
{-# LANGUAGE CPP, DeriveDataTypeable #-}
8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24

-- |
-- #name_types#
-- GHC uses several kinds of name internally:
--
-- * 'OccName.OccName': see "OccName#name_types"
--
-- * 'RdrName.RdrName' is the type of names that come directly from the parser. They
--   have not yet had their scoping and binding resolved by the renamer and can be
--   thought of to a first approximation as an 'OccName.OccName' with an optional module
--   qualifier
--
-- * 'Name.Name': see "Name#name_types"
--
-- * 'Id.Id': see "Id#name_types"
--
-- * 'Var.Var': see "Var#name_types"
Ian Lynagh's avatar
Ian Lynagh committed
25

26
module RdrName (
27
        -- * The main type
28
        RdrName(..),    -- Constructors exported only to BinIface
29

30 31 32 33
        -- ** Construction
        mkRdrUnqual, mkRdrQual,
        mkUnqual, mkVarUnqual, mkQual, mkOrig,
        nameRdrName, getRdrName,
34

35 36 37 38
        -- ** Destruction
        rdrNameOcc, rdrNameSpace, setRdrNameSpace, demoteRdrName,
        isRdrDataCon, isRdrTyVar, isRdrTc, isQual, isQual_maybe, isUnqual,
        isOrig, isOrig_maybe, isExact, isExact_maybe, isSrcRdrName,
39

40 41
        -- * Local mapping of 'RdrName' to 'Name.Name'
        LocalRdrEnv, emptyLocalRdrEnv, extendLocalRdrEnv, extendLocalRdrEnvList,
42
        lookupLocalRdrEnv, lookupLocalRdrOcc,
gmainland's avatar
gmainland committed
43
        elemLocalRdrEnv, inLocalRdrEnvScope,
44
        localRdrEnvElts, delLocalRdrEnvList,
45

46 47
        -- * Global mapping of 'RdrName' to 'GlobalRdrElt's
        GlobalRdrEnv, emptyGlobalRdrEnv, mkGlobalRdrEnv, plusGlobalRdrEnv,
48
        lookupGlobalRdrEnv, extendGlobalRdrEnv, 
49 50
        pprGlobalRdrEnv, globalRdrEnvElts,
        lookupGRE_RdrName, lookupGRE_Name, getGRE_NameQualifier_maybes,
51
        transformGREs, findLocalDupsRdrEnv, pickGREs,
52

53 54 55
        -- * GlobalRdrElts
        gresFromAvails, gresFromAvail,

56 57 58 59 60 61 62
        -- ** Global 'RdrName' mapping elements: 'GlobalRdrElt', 'Provenance', 'ImportSpec'
        GlobalRdrElt(..), isLocalGRE, unQualOK, qualSpecOK, unQualSpecOK,
        Provenance(..), pprNameProvenance,
        Parent(..),
        ImportSpec(..), ImpDeclSpec(..), ImpItemSpec(..),
        importSpecLoc, importSpecModule, isExplicitItem
  ) where
63 64 65

#include "HsVersions.h"

Simon Marlow's avatar
Simon Marlow committed
66 67
import Module
import Name
68
import Avail
69
import NameSet
Simon Marlow's avatar
Simon Marlow committed
70 71 72
import Maybes
import SrcLoc
import FastString
73
import Outputable
74
import Unique
Simon Marlow's avatar
Simon Marlow committed
75
import Util
76
import StaticFlags( opt_PprStyle_Debug )
77 78

import Data.Data
79 80 81
\end{code}

%************************************************************************
82
%*                                                                      *
83
\subsection{The main data type}
84
%*                                                                      *
85 86 87
%************************************************************************

\begin{code}
88 89 90
-- | Do not use the data constructors of RdrName directly: prefer the family
-- of functions that creates them, such as 'mkRdrUnqual'
data RdrName
91
  = Unqual OccName
92 93
        -- ^ Used for ordinary, unqualified occurrences, e.g. @x@, @y@ or @Foo@.
        -- Create such a 'RdrName' with 'mkRdrUnqual'
94

Simon Marlow's avatar
Simon Marlow committed
95
  | Qual ModuleName OccName
96 97 98 99 100 101
        -- ^ 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.
        -- Examples are @Bar.x@, @Bar.y@ or @Bar.Foo@.
        -- Create such a 'RdrName' with 'mkRdrQual'
102

103
  | Orig Module OccName
104 105 106 107 108 109
        -- ^ 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\". One of these
        -- can be created with 'mkOrig'

110
  | Exact Name
111 112 113 114 115 116 117 118
        -- ^ We know exactly the 'Name'. This is used:
        --
        --  (1) When the parser parses built-in syntax like @[]@
        --      and @(,)@, but wants a 'RdrName' from it
        --
        --  (2) By Template Haskell, when TH has generated a unique name
        --
        -- Such a 'RdrName' can be created by using 'getRdrName' on a 'Name'
119
  deriving (Data, Typeable)
120 121 122 123
\end{code}


%************************************************************************
124
%*                                                                      *
125
\subsection{Simple functions}
126
%*                                                                      *
127 128 129
%************************************************************************

\begin{code}
130 131 132 133

instance HasOccName RdrName where
  occName = rdrNameOcc

134
rdrNameOcc :: RdrName -> OccName
135 136 137 138 139
rdrNameOcc (Qual _ occ) = occ
rdrNameOcc (Unqual occ) = occ
rdrNameOcc (Orig _ occ) = occ
rdrNameOcc (Exact name) = nameOccName name

140 141 142
rdrNameSpace :: RdrName -> NameSpace
rdrNameSpace = occNameSpace . rdrNameOcc

143
setRdrNameSpace :: RdrName -> NameSpace -> RdrName
144 145 146 147 148 149 150
-- ^ 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/
151
--
152 153 154 155 156
-- The exact-name case /can/ occur when parsing:
--
-- > data [] a = [] | a : [a]
--
-- For the exact-name case we return an original name.
157 158 159
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)
eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
160 161 162 163 164 165 166 167
setRdrNameSpace (Exact n)    ns
  | isExternalName n
  = Orig (nameModule n) occ
  | otherwise   -- This can happen when quoting and then splicing a fixity
                -- declaration for a type
  = Exact $ mkSystemNameAt (nameUnique n) occ (nameSrcSpan n)
  where
    occ = setOccNameSpace ns (nameOccName n)
dreixel's avatar
dreixel committed
168 169 170 171 172 173 174 175

-- demoteRdrName lowers the NameSpace of RdrName.
-- see Note [Demotion] in OccName
demoteRdrName :: RdrName -> Maybe RdrName
demoteRdrName (Unqual occ) = fmap Unqual (demoteOccName occ)
demoteRdrName (Qual m occ) = fmap (Qual m) (demoteOccName occ)
demoteRdrName (Orig _ _) = panic "demoteRdrName"
demoteRdrName (Exact _) = panic "demoteRdrName"
176 177 178
\end{code}

\begin{code}
179
        -- These two are the basic constructors
180
mkRdrUnqual :: OccName -> RdrName
181
mkRdrUnqual occ = Unqual occ
182

Simon Marlow's avatar
Simon Marlow committed
183
mkRdrQual :: ModuleName -> OccName -> RdrName
184
mkRdrQual mod occ = Qual mod occ
185

186
mkOrig :: Module -> OccName -> RdrName
187
mkOrig mod occ = Orig mod occ
188

189
---------------
190 191
        -- These two are used when parsing source files
        -- They do encode the module and occurrence names
192 193
mkUnqual :: NameSpace -> FastString -> RdrName
mkUnqual sp n = Unqual (mkOccNameFS sp n)
194

195 196
mkVarUnqual :: FastString -> RdrName
mkVarUnqual n = Unqual (mkVarOccFS n)
197

198 199
-- | Make a qualified 'RdrName' in the given namespace and where the 'ModuleName' and
-- the 'OccName' are taken from the first and second elements of the tuple respectively
200
mkQual :: NameSpace -> (FastString, FastString) -> RdrName
Simon Marlow's avatar
Simon Marlow committed
201
mkQual sp (m, n) = Qual (mkModuleNameFS m) (mkOccNameFS sp n)
202 203

getRdrName :: NamedThing thing => thing -> RdrName
204
getRdrName name = nameRdrName (getName name)
205

206 207
nameRdrName :: Name -> RdrName
nameRdrName name = Exact name
208 209 210
-- 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)
211

212
nukeExact :: Name -> RdrName
213
nukeExact n
214
  | isExternalName n = Orig (nameModule n) (nameOccName n)
215
  | otherwise        = Unqual (nameOccName n)
216 217 218
\end{code}

\begin{code}
219 220 221 222
isRdrDataCon :: RdrName -> Bool
isRdrTyVar   :: RdrName -> Bool
isRdrTc      :: RdrName -> Bool

223 224 225
isRdrDataCon rn = isDataOcc (rdrNameOcc rn)
isRdrTyVar   rn = isTvOcc   (rdrNameOcc rn)
isRdrTc      rn = isTcOcc   (rdrNameOcc rn)
226

227
isSrcRdrName :: RdrName -> Bool
228 229
isSrcRdrName (Unqual _) = True
isSrcRdrName (Qual _ _) = True
230
isSrcRdrName _          = False
231

232
isUnqual :: RdrName -> Bool
233
isUnqual (Unqual _) = True
234
isUnqual _          = False
235

236
isQual :: RdrName -> Bool
237
isQual (Qual _ _) = True
238
isQual _          = False
239

240
isQual_maybe :: RdrName -> Maybe (ModuleName, OccName)
Simon Marlow's avatar
Simon Marlow committed
241
isQual_maybe (Qual m n) = Just (m,n)
242
isQual_maybe _          = Nothing
Simon Marlow's avatar
Simon Marlow committed
243

244
isOrig :: RdrName -> Bool
245
isOrig (Orig _ _) = True
246
isOrig _          = False
247

248
isOrig_maybe :: RdrName -> Maybe (Module, OccName)
249
isOrig_maybe (Orig m n) = Just (m,n)
250
isOrig_maybe _          = Nothing
251

252
isExact :: RdrName -> Bool
253
isExact (Exact _) = True
254
isExact _         = False
255

256
isExact_maybe :: RdrName -> Maybe Name
257
isExact_maybe (Exact n) = Just n
258
isExact_maybe _         = Nothing
259 260 261 262
\end{code}


%************************************************************************
263
%*                                                                      *
264
\subsection{Instances}
265
%*                                                                      *
266 267 268 269
%************************************************************************

\begin{code}
instance Outputable RdrName where
270
    ppr (Exact name)   = ppr name
271 272
    ppr (Unqual occ)   = ppr occ
    ppr (Qual mod occ) = ppr mod <> dot <> ppr occ
273
    ppr (Orig mod occ) = getPprStyle (\sty -> pprModulePrefix sty mod occ <> ppr occ)
274

275
instance OutputableBndr RdrName where
276 277 278
    pprBndr _ n
        | isTvOcc (rdrNameOcc n) = char '@' <+> ppr n
        | otherwise              = ppr n
279

280
    pprInfixOcc  rdr = pprInfixVar  (isSymOcc (rdrNameOcc rdr)) (ppr rdr)
281
    pprPrefixOcc rdr
282 283 284 285
      | Just name <- isExact_maybe rdr = pprPrefixName name
             -- pprPrefixName has some special cases, so
             -- we delegate to them rather than reproduce them
      | otherwise = pprPrefixVar (isSymOcc (rdrNameOcc rdr)) (ppr rdr)
286

287
instance Eq RdrName where
288 289 290
    (Exact n1)    == (Exact n2)    = n1==n2
        -- Convert exact to orig
    (Exact n1)    == r2@(Orig _ _) = nukeExact n1 == r2
291 292 293 294 295
    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
296
    _             == _             = False
297 298 299

instance Ord RdrName where
    a <= b = case (a `compare` b) of { LT -> True;  EQ -> True;  GT -> False }
300
    a <  b = case (a `compare` b) of { LT -> True;  EQ -> False; GT -> False }
301
    a >= b = case (a `compare` b) of { LT -> False; EQ -> True;  GT -> True  }
302 303 304 305 306 307 308 309 310 311
    a >  b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True  }

        -- 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
312
    compare (Exact n1) (Exact n2) = n1 `compare` n2
313
    compare (Exact _)  _          = LT
314 315

    compare (Unqual _)   (Exact _)    = GT
316
    compare (Unqual o1)  (Unqual  o2) = o1 `compare` o2
317
    compare (Unqual _)   _            = LT
318 319 320

    compare (Qual _ _)   (Exact _)    = GT
    compare (Qual _ _)   (Unqual _)   = GT
321
    compare (Qual m1 o1) (Qual m2 o2) = (o1 `compare` o2) `thenCmp` (m1 `compare` m2)
322
    compare (Qual _ _)   (Orig _ _)   = LT
323

324 325
    compare (Orig m1 o1) (Orig m2 o2) = (o1 `compare` o2) `thenCmp` (m1 `compare` m2)
    compare (Orig _ _)   _            = GT
326 327
\end{code}

328
%************************************************************************
329 330 331
%*                                                                      *
                        LocalRdrEnv
%*                                                                      *
332 333 334
%************************************************************************

\begin{code}
335 336
-- | This environment is used to store local bindings (@let@, @where@, lambda, @case@).
-- It is keyed by OccName, because we never use it for qualified names
337 338
-- We keep the current mapping, *and* the set of all Names in scope
-- Reason: see Note [Splicing Exact Names] in RnEnv
339 340 341 342 343 344 345 346 347 348 349 350
data LocalRdrEnv = LRE { lre_env      :: OccEnv Name
                       , lre_in_scope :: NameSet }

instance Outputable LocalRdrEnv where
  ppr (LRE {lre_env = env, lre_in_scope = ns})
    = hang (ptext (sLit "LocalRdrEnv {"))
         2 (vcat [ ptext (sLit "env =") <+> pprOccEnv ppr_elt env
                 , ptext (sLit "in_scope =") <+> braces (pprWithCommas ppr (nameSetToList ns))
                 ] <+> char '}')
    where
      ppr_elt name = parens (ppr (getUnique (nameOccName name))) <+> ppr name
                     -- So we can see if the keys line up correctly
351

352
emptyLocalRdrEnv :: LocalRdrEnv
353
emptyLocalRdrEnv = LRE { lre_env = emptyOccEnv, lre_in_scope = emptyNameSet }
gmainland's avatar
gmainland committed
354

355 356
extendLocalRdrEnv :: LocalRdrEnv -> Name -> LocalRdrEnv
-- The Name should be a non-top-level thing
357
extendLocalRdrEnv (LRE { lre_env = env, lre_in_scope = ns }) name
358
  = WARN( isExternalName name, ppr name )
359 360
    LRE { lre_env      = extendOccEnv env (nameOccName name) name
        , lre_in_scope = addOneToNameSet ns name }
gmainland's avatar
gmainland committed
361

362
extendLocalRdrEnvList :: LocalRdrEnv -> [Name] -> LocalRdrEnv
363
extendLocalRdrEnvList (LRE { lre_env = env, lre_in_scope = ns }) names
364
  = WARN( any isExternalName names, ppr names )
365 366
    LRE { lre_env = extendOccEnvList env [(nameOccName n, n) | n <- names]
        , lre_in_scope = addListToNameSet ns names }
367 368

lookupLocalRdrEnv :: LocalRdrEnv -> RdrName -> Maybe Name
369 370
lookupLocalRdrEnv (LRE { lre_env = env }) (Unqual occ) = lookupOccEnv env occ
lookupLocalRdrEnv _                       _            = Nothing
371

372
lookupLocalRdrOcc :: LocalRdrEnv -> OccName -> Maybe Name
373
lookupLocalRdrOcc (LRE { lre_env = env }) occ = lookupOccEnv env occ
374

375
elemLocalRdrEnv :: RdrName -> LocalRdrEnv -> Bool
376 377 378 379 380 381
elemLocalRdrEnv rdr_name (LRE { lre_env = env, lre_in_scope = ns })
  = case rdr_name of
      Unqual occ -> occ  `elemOccEnv` env
      Exact name -> name `elemNameSet` ns  -- See Note [Local bindings with Exact Names]
      Qual {} -> False
      Orig {} -> False
382 383

localRdrEnvElts :: LocalRdrEnv -> [Name]
384
localRdrEnvElts (LRE { lre_env = env }) = occEnvElts env
385 386 387

inLocalRdrEnvScope :: Name -> LocalRdrEnv -> Bool
-- This is the point of the NameSet
388
inLocalRdrEnvScope name (LRE { lre_in_scope = ns }) = name `elemNameSet` ns
389 390

delLocalRdrEnvList :: LocalRdrEnv -> [OccName] -> LocalRdrEnv
391 392 393
delLocalRdrEnvList (LRE { lre_env = env, lre_in_scope = ns }) occs 
  = LRE { lre_env = delListFromOccEnv env occs
        , lre_in_scope = ns }
394 395
\end{code}

396 397 398 399 400 401 402 403
Note [Local bindings with Exact Names]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
With Template Haskell we can make local bindings that have Exact Names.
Computing shadowing etc may use elemLocalRdrEnv (at least it certainly
does so in RnTpes.bindHsTyVars), so for an Exact Name we must consult
the in-scope-name-set.


404
%************************************************************************
405 406 407
%*                                                                      *
                        GlobalRdrEnv
%*                                                                      *
408 409 410 411
%************************************************************************

\begin{code}
type GlobalRdrEnv = OccEnv [GlobalRdrElt]
412 413 414 415 416 417 418 419 420
-- ^ 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 codomain is required because there may be name clashes
-- These only get reported on lookup, not on construction
--
421 422
-- INVARIANT: All the members of the list have distinct
--            'gre_name' fields; that is, no duplicate Names
423 424
--
-- INVARIANT: Imported provenance => Name is an ExternalName
425 426 427 428
--            However LocalDefs can have an InternalName.  This
--            happens only when type-checking a [d| ... |] Template
--            Haskell quotation; see this note in RnNames
--            Note [Top-level Names in Template Haskell decl quotes]
429

430
-- | An element of the 'GlobalRdrEnv'
431
data GlobalRdrElt
432
  = GRE { gre_name :: Name,
433 434
          gre_par  :: Parent,
          gre_prov :: Provenance        -- ^ Why it's in scope
435 436
    }

437
-- | The children of a Name are the things that are abbreviated by the ".."
438
--   notation in export lists.  See Note [Parents]
439
data Parent = NoParent | ParentIs Name
440
              deriving (Eq)
441

442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460
instance Outputable Parent where
   ppr NoParent     = empty
   ppr (ParentIs n) = ptext (sLit "parent:") <> ppr n

plusParent :: Parent -> Parent -> Parent
-- See Note [Combining parents]
plusParent (ParentIs n) p2 = hasParent n p2
plusParent p1 (ParentIs n) = hasParent n p1
plusParent _ _ = NoParent

hasParent :: Name -> Parent -> Parent
#ifdef DEBUG
hasParent n (ParentIs n')
  | n /= n' = pprPanic "hasParent" (ppr n <+> ppr n')  -- Parents should agree
#endif
hasParent n _  = ParentIs n
\end{code}

Note [Parents]
461
~~~~~~~~~~~~~~~~~
462
  Parent           Children
463 464
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  data T           Data constructors
465
                   Record-field ids
466 467 468 469

  data family T    Data constructors and record-field ids
                   of all visible data instances of T

470 471
  class C          Class operations
                   Associated type constructors
472 473 474 475 476 477 478 479 480 481 482 483 484 485

Note [Combining parents]
~~~~~~~~~~~~~~~~~~~~~~~~
With an associated type we might have
   module M where
     class C a where
       data T a
       op :: T a -> a
     instance C Int where
       data T Int = TInt
     instance C Bool where
       data T Bool = TBool

Then:   C is the parent of T
486
        T is the parent of TInt and TBool
487 488 489 490 491 492 493 494
So: in an export list
    C(..) is short for C( op, T )
    T(..) is short for T( TInt, TBool )

Module M exports everything, so its exports will be
   AvailTC C [C,T,op]
   AvailTC T [T,TInt,TBool]
On import we convert to GlobalRdrElt and the combine
495
those.  For T that will mean we have
496 497 498 499
  one GRE with Parent C
  one GRE with NoParent
That's why plusParent picks the "best" case.

500

501 502 503 504 505 506 507 508 509 510 511 512 513 514 515
\begin{code}
-- | make a 'GlobalRdrEnv' where all the elements point to the same
-- Provenance (useful for "hiding" imports, or imports with
-- no details).
gresFromAvails :: Provenance -> [AvailInfo] -> [GlobalRdrElt]
gresFromAvails prov avails
  = concatMap (gresFromAvail (const prov)) avails

gresFromAvail :: (Name -> Provenance) -> AvailInfo -> [GlobalRdrElt]
gresFromAvail prov_fn avail
  = [ GRE {gre_name = n,
           gre_par = mkParent n avail,
           gre_prov = prov_fn n}
    | n <- availNames avail ]
  where
516

517 518 519 520
mkParent :: Name -> AvailInfo -> Parent
mkParent _ (Avail _)                 = NoParent
mkParent n (AvailTC m _) | n == m    = NoParent
                         | otherwise = ParentIs m
521

522
emptyGlobalRdrEnv :: GlobalRdrEnv
523 524 525 526 527 528
emptyGlobalRdrEnv = emptyOccEnv

globalRdrEnvElts :: GlobalRdrEnv -> [GlobalRdrElt]
globalRdrEnvElts env = foldOccEnv (++) [] env

instance Outputable GlobalRdrElt where
529 530
  ppr gre = hang (ppr (gre_name gre) <+> ppr (gre_par gre))
               2 (pprNameProvenance gre)
531

532 533 534 535 536 537
pprGlobalRdrEnv :: Bool -> GlobalRdrEnv -> SDoc
pprGlobalRdrEnv locals_only env
  = vcat [ ptext (sLit "GlobalRdrEnv") <+> ppWhen locals_only (ptext (sLit "(locals only)")) 
             <+> lbrace
         , nest 2 (vcat [ pp (remove_locals gre_list) | gre_list <- occEnvElts env ] 
             <+> rbrace) ]
538
  where
539 540 541 542 543 544 545 546 547
    remove_locals gres | locals_only = filter isLocalGRE gres
                       | otherwise   = gres
    pp []   = empty
    pp gres = hang (ppr occ
                     <+> parens (ptext (sLit "unique") <+> ppr (getUnique occ))
                     <> colon)
                 2 (vcat (map ppr gres))
      where
        occ = nameOccName (gre_name (head gres))
548 549

lookupGlobalRdrEnv :: GlobalRdrEnv -> OccName -> [GlobalRdrElt]
550
lookupGlobalRdrEnv env occ_name = case lookupOccEnv env occ_name of
551 552
                                  Nothing   -> []
                                  Just gres -> gres
553 554 555

lookupGRE_RdrName :: RdrName -> GlobalRdrEnv -> [GlobalRdrElt]
lookupGRE_RdrName rdr_name env
556
  = case lookupOccEnv env (rdrNameOcc rdr_name) of
557 558
    Nothing   -> []
    Just gres -> pickGREs rdr_name gres
559 560 561 562

lookupGRE_Name :: GlobalRdrEnv -> Name -> [GlobalRdrElt]
lookupGRE_Name env name
  = [ gre | gre <- lookupGlobalRdrEnv env (nameOccName name),
563
            gre_name gre == name ]
564

565
getGRE_NameQualifier_maybes :: GlobalRdrEnv -> Name -> [Maybe [ModuleName]]
566 567
-- Returns all the qualifiers by which 'x' is in scope
-- Nothing means "the unqualified version is in scope"
568
-- [] means the thing is not in scope at all
569
getGRE_NameQualifier_maybes env
570
  = map (qualifier_maybe . gre_prov) . lookupGRE_Name env
571 572 573
  where
    qualifier_maybe LocalDef       = Nothing
    qualifier_maybe (Imported iss) = Just $ map (is_as . is_decl) iss
574

575 576 577 578 579 580 581 582 583
isLocalGRE :: GlobalRdrElt -> Bool
isLocalGRE (GRE {gre_prov = LocalDef}) = True
isLocalGRE _                           = False

unQualOK :: GlobalRdrElt -> Bool
-- ^ Test if an unqualifed version of this thing would be in scope
unQualOK (GRE {gre_prov = LocalDef})    = True
unQualOK (GRE {gre_prov = Imported is}) = any unQualSpecOK is

584
pickGREs :: RdrName -> [GlobalRdrElt] -> [GlobalRdrElt]
585
-- ^ Take a list of GREs which have the right OccName
586 587
-- Pick those GREs that are suitable for this RdrName
-- And for those, keep only only the Provenances that are suitable
Simon Peyton Jones's avatar
Simon Peyton Jones committed
588
-- Only used for Qual and Unqual, not Orig or Exact
589
--
590 591 592
-- Consider:
--
-- @
593 594 595 596
--       module A ( f ) where
--       import qualified Foo( f )
--       import Baz( f )
--       f = undefined
597 598 599 600 601
-- @
--
-- Let's suppose that @Foo.f@ and @Baz.f@ are the same entity really.
-- The export of @f@ is ambiguous because it's in scope from the local def
-- and the import.  The lookup of @Unqual f@ should return a GRE for
602
-- the locally-defined @f@, and a GRE for the imported @f@, with a /single/
603
-- provenance, namely the one for @Baz(f)@.
604
pickGREs rdr_name gres
605 606 607 608 609 610 611 612
  | (_ : _ : _) <- candidates  -- This is usually false, so we don't have to
                               -- even look at internal_candidates
  , (gre : _)   <- internal_candidates
  = [gre]  -- For this internal_candidate stuff,
           -- see Note [Template Haskell binders in the GlobalRdrEnv]
           -- If there are multiple Internal candidates, pick the
           -- first one (ie with the (innermost binding)
  | otherwise
Simon Peyton Jones's avatar
Simon Peyton Jones committed
613
  = ASSERT2( isSrcRdrName rdr_name, ppr rdr_name )
614
    candidates
615
  where
Icelandjack's avatar
Icelandjack committed
616
    candidates = mapMaybe pick gres
617 618
    internal_candidates = filter (isInternalName . gre_name) candidates

Simon Marlow's avatar
Simon Marlow committed
619 620
    rdr_is_unqual = isUnqual rdr_name
    rdr_is_qual   = isQual_maybe rdr_name
621 622

    pick :: GlobalRdrElt -> Maybe GlobalRdrElt
623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644
    pick gre@(GRE {gre_prov = LocalDef, gre_name = n})  -- Local def
        | rdr_is_unqual                    = Just gre
        | Just (mod,_) <- rdr_is_qual        -- Qualified name
        , Just n_mod <- nameModule_maybe n   -- Binder is External
        , mod == moduleName n_mod          = Just gre
        | otherwise                        = Nothing
    pick gre@(GRE {gre_prov = Imported [is]})   -- Single import (efficiency)
        | rdr_is_unqual,
          not (is_qual (is_decl is))    = Just gre
        | Just (mod,_) <- rdr_is_qual,
          mod == is_as (is_decl is)     = Just gre
        | otherwise                     = Nothing
    pick gre@(GRE {gre_prov = Imported is})     -- Multiple import
        | null filtered_is = Nothing
        | otherwise        = Just (gre {gre_prov = Imported filtered_is})
        where
          filtered_is | rdr_is_unqual
                      = filter (not . is_qual    . is_decl) is
                      | Just (mod,_) <- rdr_is_qual
                      = filter ((== mod) . is_as . is_decl) is
                      | otherwise
                      = []
645
\end{code}
646

647
Building GlobalRdrEnvs
648

649
\begin{code}
650 651 652 653 654 655 656
plusGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrEnv -> GlobalRdrEnv
plusGlobalRdrEnv env1 env2 = plusOccEnv_C (foldr insertGRE) env1 env2

mkGlobalRdrEnv :: [GlobalRdrElt] -> GlobalRdrEnv
mkGlobalRdrEnv gres
  = foldr add emptyGlobalRdrEnv gres
  where
657 658 659
    add gre env = extendOccEnv_Acc insertGRE singleton env
                                   (nameOccName (gre_name gre))
                                   gre
660 661 662 663

insertGRE :: GlobalRdrElt -> [GlobalRdrElt] -> [GlobalRdrElt]
insertGRE new_g [] = [new_g]
insertGRE new_g (old_g : old_gs)
664 665 666 667
        | gre_name new_g == gre_name old_g
        = new_g `plusGRE` old_g : old_gs
        | otherwise
        = old_g : insertGRE new_g old_gs
668 669 670 671

plusGRE :: GlobalRdrElt -> GlobalRdrElt -> GlobalRdrElt
-- Used when the gre_name fields match
plusGRE g1 g2
672
  = GRE { gre_name = gre_name g1,
673 674
          gre_prov = gre_prov g1 `plusProv`   gre_prov g2,
          gre_par  = gre_par  g1 `plusParent` gre_par  g2 }
675

676
transformGREs :: (GlobalRdrElt -> GlobalRdrElt)
677
              -> [OccName]
678 679 680 681
              -> GlobalRdrEnv -> GlobalRdrEnv
-- ^ Apply a transformation function to the GREs for these OccNames
transformGREs trans_gre occs rdr_env
  = foldr trans rdr_env occs
682
  where
683 684
    trans occ env
      = case lookupOccEnv env occ of
685 686
           Just gres -> extendOccEnv env occ (map trans_gre gres)
           Nothing   -> env
687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729

extendGlobalRdrEnv :: Bool -> GlobalRdrEnv -> [AvailInfo] -> GlobalRdrEnv
-- Extend with new LocalDef GREs from the AvailInfos.
--
-- If do_shadowing is True, first remove name clashes between the new
-- AvailInfos and the existing GlobalRdrEnv.
-- This is used by the GHCi top-level
--
-- E.g.  Adding a LocalDef "x" when there is an existing GRE for Q.x
--       should remove any unqualified import of Q.x,
--       leaving only the qualified one
--
-- However do *not* remove name clashes between the AvailInfos themselves,
-- so that (say)   data T = A | A
-- will still give a duplicate-binding error.
-- Same thing if there are multiple AvailInfos (don't remove clashes),
-- though I'm not sure this ever happens with do_shadowing=True

extendGlobalRdrEnv do_shadowing env avails
  = foldl add_avail env1 avails
  where
    names = concatMap availNames avails
    env1 | do_shadowing = foldl shadow_name env names
         | otherwise    = env
         -- By doing the removal first, we ensure that the new AvailInfos
         -- don't shadow each other; that would conceal genuine errors
         -- E.g. in GHCi   data T = A | A

    add_avail env avail = foldl (add_name avail) env (availNames avail)

    add_name avail env name
       = extendOccEnv_Acc (:) singleton env occ gre
       where
         occ = nameOccName name
         gre = GRE { gre_name = name
                   , gre_par = mkParent name avail
                   , gre_prov = LocalDef }

shadow_name :: GlobalRdrEnv -> Name -> GlobalRdrEnv
shadow_name env name
  = alterOccEnv (fmap alter_fn) env (nameOccName name)
  where
    alter_fn :: [GlobalRdrElt] -> [GlobalRdrElt]
Icelandjack's avatar
Icelandjack committed
730
    alter_fn gres = mapMaybe (shadow_with name) gres
731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748

    shadow_with :: Name -> GlobalRdrElt -> Maybe GlobalRdrElt
    shadow_with new_name old_gre@(GRE { gre_name = old_name, gre_prov = LocalDef })
       = case (nameModule_maybe old_name, nameModule_maybe new_name) of
           (Nothing,      _)                                 -> Nothing
           (Just old_mod, Just new_mod) | new_mod == old_mod -> Nothing
           (Just old_mod, _) -> Just (old_gre { gre_prov = Imported [fake_imp_spec] })
              where
                 fake_imp_spec = ImpSpec id_spec ImpAll  -- Urgh!
                 old_mod_name = moduleName old_mod
                 id_spec = ImpDeclSpec { is_mod = old_mod_name
                                       , is_as = old_mod_name
                                       , is_qual = True
                                       , is_dloc = nameSrcSpan old_name }
    shadow_with new_name old_gre@(GRE { gre_prov = Imported imp_specs })
       | null imp_specs' = Nothing
       | otherwise       = Just (old_gre { gre_prov = Imported imp_specs' })
       where
Icelandjack's avatar
Icelandjack committed
749
         imp_specs' = mapMaybe (shadow_is new_name) imp_specs
750 751 752 753 754 755 756 757

    shadow_is :: Name -> ImportSpec -> Maybe ImportSpec
    shadow_is new_name is@(ImpSpec { is_decl = id_spec })
       | Just new_mod <- nameModule_maybe new_name
       , is_as id_spec == moduleName new_mod
       = Nothing   -- Shadow both qualified and unqualified
       | otherwise -- Shadow unqualified only
       = Just (is { is_decl = id_spec { is_qual = True } })
758 759
\end{code}

760 761 762 763 764 765 766
Note [Template Haskell binders in the GlobalRdrEnv]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
For reasons described in Note [Top-level Names in Template Haskell decl quotes]
in RnNames, a GRE with an Internal gre_name (i.e. one generated by a TH decl
quote) should *shadow* a GRE with an External gre_name.  Hence some faffing
around in pickGREs and findLocalDupsRdrEnv

767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795
\begin{code}
findLocalDupsRdrEnv :: GlobalRdrEnv -> [Name] -> [[GlobalRdrElt]]
-- ^ For each 'OccName', see if there are multiple local definitions
-- for it; return a list of all such
-- and return a list of the duplicate bindings
findLocalDupsRdrEnv rdr_env occs
  = go rdr_env [] occs
  where
    go _       dups [] = dups
    go rdr_env dups (name:names)
      = case filter (pick name) gres of
          []       -> go rdr_env  dups              names
          [_]      -> go rdr_env  dups              names   -- The common case
          dup_gres -> go rdr_env' (dup_gres : dups) names
      where
        occ      = nameOccName name
        gres     = lookupOccEnv rdr_env occ `orElse` []
        rdr_env' = delFromOccEnv rdr_env occ
            -- The delFromOccEnv avoids repeating the same
            -- complaint twice, when names itself has a duplicate
            -- which is a common case

    -- See Note [Template Haskell binders in the GlobalRdrEnv]
    pick name (GRE { gre_name = n, gre_prov = LocalDef })
      | isInternalName name = isInternalName n
      | otherwise           = True
    pick _ _ = False
\end{code}

796
%************************************************************************
797 798 799
%*                                                                      *
                        Provenance
%*                                                                      *
800 801 802
%************************************************************************

\begin{code}
803 804
-- | The 'Provenance' of something says how it came to be in scope.
-- It's quite elaborate so that we can give accurate unused-name warnings.
805
data Provenance
806 807 808 809 810
  = LocalDef            -- ^ The thing was defined locally
  | Imported
        [ImportSpec]    -- ^ The thing was imported.
                        --
                        -- INVARIANT: the list of 'ImportSpec' is non-empty
811

812
data ImportSpec = ImpSpec { is_decl :: ImpDeclSpec,
813 814
                            is_item :: ImpItemSpec }
                deriving( Eq, Ord )
815

816 817 818
-- | Describes a particular import declaration and is
-- shared among all the 'Provenance's for that decl
data ImpDeclSpec
819
  = ImpDeclSpec {
820 821 822
        is_mod      :: ModuleName, -- ^ Module imported, e.g. @import Muggle@
                                   -- Note the @Muggle@ may well not be
                                   -- the defining module for this thing!
823 824

                                   -- TODO: either should be Module, or there
825
                                   -- should be a Maybe PackageKey here too.
826 827 828
        is_as       :: ModuleName, -- ^ Import alias, e.g. from @as M@ (or @Muggle@ if there is no @as@ clause)
        is_qual     :: Bool,       -- ^ Was this import qualified?
        is_dloc     :: SrcSpan     -- ^ The location of the entire import declaration
829 830
    }

831 832
-- | Describes import info a particular Name
data ImpItemSpec
833 834
  = ImpAll              -- ^ The import had no import list,
                        -- or had a hiding list
835

836
  | ImpSome {
837 838
        is_explicit :: Bool,
        is_iloc     :: SrcSpan  -- Location of the import item
839
    }   -- ^ The import had an import list.
840 841 842 843 844 845 846 847
        -- The 'is_explicit' field is @True@ iff the thing was named
        -- /explicitly/ in the import specs rather
        -- than being imported as part of a "..." group. Consider:
        --
        -- > import C( T(..) )
        --
        -- Here the constructors of @T@ are not named explicitly;
        -- only @T@ is named explicitly.
848 849 850 851 852 853 854 855

unQualSpecOK :: ImportSpec -> Bool
-- ^ Is in scope unqualified?
unQualSpecOK is = not (is_qual (is_decl is))

qualSpecOK :: ModuleName -> ImportSpec -> Bool
-- ^ Is in scope qualified with the given module?
qualSpecOK mod is = mod == is_as (is_decl is)
856 857 858 859 860

importSpecLoc :: ImportSpec -> SrcSpan
importSpecLoc (ImpSpec decl ImpAll) = is_dloc decl
importSpecLoc (ImpSpec _    item)   = is_iloc item

Simon Marlow's avatar
Simon Marlow committed
861
importSpecModule :: ImportSpec -> ModuleName
862
importSpecModule is = is_mod (is_decl is)
863

864
isExplicitItem :: ImpItemSpec -> Bool
865
isExplicitItem ImpAll                        = False
866 867
isExplicitItem (ImpSome {is_explicit = exp}) = exp

868
-- Note [Comparing provenance]
869
-- Comparison of provenance is just used for grouping
870 871 872 873
-- error messages (in RnEnv.warnUnusedBinds)
instance Eq Provenance where
  p1 == p2 = case p1 `compare` p2 of EQ -> True; _ -> False

874 875 876 877
instance Eq ImpDeclSpec where
  p1 == p2 = case p1 `compare` p2 of EQ -> True; _ -> False

instance Eq ImpItemSpec where
878 879 880
  p1 == p2 = case p1 `compare` p2 of EQ -> True; _ -> False

instance Ord Provenance where
881 882 883 884 885
   compare LocalDef      LocalDef        = EQ
   compare LocalDef      (Imported _)    = LT
   compare (Imported _ ) LocalDef        = GT
   compare (Imported is1) (Imported is2) = compare (head is1)
        {- See Note [Comparing provenance] -}      (head is2)
886

887
instance Ord ImpDeclSpec where
888 889
   compare is1 is2 = (is_mod is1 `compare` is_mod is2) `thenCmp`
                     (is_dloc is1 `compare` is_dloc is2)
890 891 892

instance Ord ImpItemSpec where
   compare is1 is2 = is_iloc is1 `compare` is_iloc is2
893
\end{code}
894

895
\begin{code}
896 897
plusProv :: Provenance -> Provenance -> Provenance
-- Choose LocalDef over Imported
898
-- There is an obscure bug lurking here; in the presence
899 900 901 902
-- 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
903 904 905
plusProv LocalDef        LocalDef        = panic "plusProv"
plusProv LocalDef        _               = LocalDef
plusProv _               LocalDef        = LocalDef
906
plusProv (Imported is1)  (Imported is2)  = Imported (is1++is2)
907 908

pprNameProvenance :: GlobalRdrElt -> SDoc
909
-- ^ Print out the place where the name was imported
910
pprNameProvenance (GRE {gre_name = name, gre_prov = LocalDef})
Ian Lynagh's avatar
Ian Lynagh committed
911
  = ptext (sLit "defined at") <+> ppr (nameSrcLoc name)
912 913
pprNameProvenance (GRE {gre_name = name, gre_prov = Imported whys})
  = case whys of
914
        (why:_) | opt_PprStyle_Debug -> vcat (map pp_why whys)
915
                | otherwise          -> pp_why why
916
        [] -> panic "pprNameProvenance"
917 918
  where
    pp_why why = sep [ppr why, ppr_defn_site why name]
919

920 921
-- 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".
922
ppr_defn_site :: ImportSpec -> Name -> SDoc
923
ppr_defn_site imp_spec name
924
  | same_module && not (isGoodSrcSpan loc)
925
  = empty              -- Nothing interesting to say
926 927 928 929 930 931 932 933 934 935
  | otherwise
  = parens $ hang (ptext (sLit "and originally defined") <+> pp_mod)
                2 (pprLoc loc)
  where
    loc = nameSrcSpan name
    defining_mod = nameModule name
    same_module = importSpecModule imp_spec == moduleName defining_mod
    pp_mod | same_module = empty
           | otherwise   = ptext (sLit "in") <+> quotes (ppr defining_mod)

936

937
instance Outputable ImportSpec where
938
   ppr imp_spec
939
     = ptext (sLit "imported") <+> qual
940
        <+> ptext (sLit "from") <+> quotes (ppr (importSpecModule imp_spec))
941
        <+> pprLoc (importSpecLoc imp_spec)
942
     where
943 944
       qual | is_qual (is_decl imp_spec) = ptext (sLit "qualified")
            | otherwise                  = empty
945 946 947 948

pprLoc :: SrcSpan -> SDoc
pprLoc (RealSrcSpan s)    = ptext (sLit "at") <+> ppr s
pprLoc (UnhelpfulSpan {}) = empty
949
\end{code}