RdrName.lhs 23.2 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 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"
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

34 35
	-- ** Destruction
	rdrNameOcc, rdrNameSpace, setRdrNameSpace,
Simon Marlow's avatar
Simon Marlow committed
36
	isRdrDataCon, isRdrTyVar, isRdrTc, isQual, isQual_maybe, isUnqual, 
37
	isOrig, isOrig_maybe, isExact, isExact_maybe, isSrcRdrName,
38

39 40
	-- ** Printing
	showRdrName,
41

42
	-- * Local mapping of 'RdrName' to 'Name.Name'
43
	LocalRdrEnv, emptyLocalRdrEnv, extendLocalRdrEnv, extendLocalRdrEnvList,
44
	lookupLocalRdrEnv, lookupLocalRdrOcc, elemLocalRdrEnv,
45

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

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

#include "HsVersions.h"

Simon Marlow's avatar
Simon Marlow committed
63 64 65 66 67
import Module
import Name
import Maybes
import SrcLoc
import FastString
68
import Outputable
Simon Marlow's avatar
Simon Marlow committed
69
import Util
70 71

import Data.Data
72 73 74 75 76 77 78 79 80
\end{code}

%************************************************************************
%*									*
\subsection{The main data type}
%*									*
%************************************************************************

\begin{code}
81 82 83
-- | Do not use the data constructors of RdrName directly: prefer the family
-- of functions that creates them, such as 'mkRdrUnqual'
data RdrName
84
  = Unqual OccName
85 86
	-- ^ Used for ordinary, unqualified occurrences, e.g. @x@, @y@ or @Foo@.
	-- Create such a 'RdrName' with 'mkRdrUnqual'
87

Simon Marlow's avatar
Simon Marlow committed
88
  | Qual ModuleName OccName
89 90
	-- ^ A qualified name written by the user in 
	-- /source/ code.  The module isn't necessarily 
91
	-- the module where the thing is defined; 
92 93 94
	-- just the one from which it is imported.
	-- Examples are @Bar.x@, @Bar.y@ or @Bar.Foo@.
	-- Create such a 'RdrName' with 'mkRdrQual'
95

96
  | Orig Module OccName
97
	-- ^ An original name; the module is the /defining/ module.
98 99
	-- This is used when GHC generates code that will be fed
	-- into the renamer (e.g. from deriving clauses), but where
100 101
	-- we want to say \"Use Prelude.map dammit\". One of these
	-- can be created with 'mkOrig'
102 103
 
  | Exact Name
104 105 106 107 108 109 110 111
	-- ^ 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'
112
  deriving (Data, Typeable)
113 114 115 116 117 118 119 120 121 122 123
\end{code}


%************************************************************************
%*									*
\subsection{Simple functions}
%*									*
%************************************************************************

\begin{code}
rdrNameOcc :: RdrName -> OccName
124 125 126 127 128
rdrNameOcc (Qual _ occ) = occ
rdrNameOcc (Unqual occ) = occ
rdrNameOcc (Orig _ occ) = occ
rdrNameOcc (Exact name) = nameOccName name

129 130 131
rdrNameSpace :: RdrName -> NameSpace
rdrNameSpace = occNameSpace . rdrNameOcc

132
setRdrNameSpace :: RdrName -> NameSpace -> RdrName
133 134 135 136 137 138 139
-- ^ 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/
140
--
141 142 143 144 145
-- The exact-name case /can/ occur when parsing:
--
-- > data [] a = [] | a : [a]
--
-- For the exact-name case we return an original name.
146 147 148
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)
149 150
setRdrNameSpace (Exact n)    ns = ASSERT( isExternalName n ) 
		       	          Orig (nameModule n)
151
				       (setOccNameSpace ns (nameOccName n))
152 153 154 155 156
\end{code}

\begin{code}
	-- These two are the basic constructors
mkRdrUnqual :: OccName -> RdrName
157
mkRdrUnqual occ = Unqual occ
158

Simon Marlow's avatar
Simon Marlow committed
159
mkRdrQual :: ModuleName -> OccName -> RdrName
160
mkRdrQual mod occ = Qual mod occ
161

162
mkOrig :: Module -> OccName -> RdrName
163
mkOrig mod occ = Orig mod occ
164

165
---------------
166 167
	-- These two are used when parsing source files
	-- They do encode the module and occurrence names
168 169
mkUnqual :: NameSpace -> FastString -> RdrName
mkUnqual sp n = Unqual (mkOccNameFS sp n)
170

171 172
mkVarUnqual :: FastString -> RdrName
mkVarUnqual n = Unqual (mkVarOccFS n)
173

174 175
-- | 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
176
mkQual :: NameSpace -> (FastString, FastString) -> RdrName
Simon Marlow's avatar
Simon Marlow committed
177
mkQual sp (m, n) = Qual (mkModuleNameFS m) (mkOccNameFS sp n)
178 179

getRdrName :: NamedThing thing => thing -> RdrName
180
getRdrName name = nameRdrName (getName name)
181

182 183
nameRdrName :: Name -> RdrName
nameRdrName name = Exact name
184 185 186
-- 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)
187

188 189
nukeExact :: Name -> RdrName
nukeExact n 
190
  | isExternalName n = Orig (nameModule n) (nameOccName n)
191
  | otherwise	     = Unqual (nameOccName n)
192 193 194
\end{code}

\begin{code}
twanvl's avatar
twanvl committed
195 196 197 198
isRdrDataCon :: RdrName -> Bool
isRdrTyVar   :: RdrName -> Bool
isRdrTc      :: RdrName -> Bool

199 200 201
isRdrDataCon rn = isDataOcc (rdrNameOcc rn)
isRdrTyVar   rn = isTvOcc   (rdrNameOcc rn)
isRdrTc      rn = isTcOcc   (rdrNameOcc rn)
202

twanvl's avatar
twanvl committed
203
isSrcRdrName :: RdrName -> Bool
204 205 206 207
isSrcRdrName (Unqual _) = True
isSrcRdrName (Qual _ _) = True
isSrcRdrName _		= False

twanvl's avatar
twanvl committed
208
isUnqual :: RdrName -> Bool
209
isUnqual (Unqual _) = True
twanvl's avatar
twanvl committed
210
isUnqual _          = False
211

twanvl's avatar
twanvl committed
212
isQual :: RdrName -> Bool
213 214
isQual (Qual _ _) = True
isQual _	  = False
215

twanvl's avatar
twanvl committed
216
isQual_maybe :: RdrName -> Maybe (ModuleName, OccName)
Simon Marlow's avatar
Simon Marlow committed
217 218 219
isQual_maybe (Qual m n) = Just (m,n)
isQual_maybe _	        = Nothing

twanvl's avatar
twanvl committed
220
isOrig :: RdrName -> Bool
221 222 223
isOrig (Orig _ _) = True
isOrig _	  = False

twanvl's avatar
twanvl committed
224
isOrig_maybe :: RdrName -> Maybe (Module, OccName)
225 226 227
isOrig_maybe (Orig m n) = Just (m,n)
isOrig_maybe _		= Nothing

twanvl's avatar
twanvl committed
228
isExact :: RdrName -> Bool
229
isExact (Exact _) = True
twanvl's avatar
twanvl committed
230
isExact _         = False
231

twanvl's avatar
twanvl committed
232
isExact_maybe :: RdrName -> Maybe Name
233
isExact_maybe (Exact n) = Just n
twanvl's avatar
twanvl committed
234
isExact_maybe _         = Nothing
235 236 237 238 239 240 241 242 243 244 245
\end{code}


%************************************************************************
%*									*
\subsection{Instances}
%*									*
%************************************************************************

\begin{code}
instance Outputable RdrName where
246
    ppr (Exact name)   = ppr name
247 248
    ppr (Unqual occ)   = ppr occ
    ppr (Qual mod occ) = ppr mod <> dot <> ppr occ
249
    ppr (Orig mod occ) = getPprStyle (\sty -> pprModulePrefix sty mod occ <> ppr occ)
250

251 252 253 254 255
instance OutputableBndr RdrName where
    pprBndr _ n 
	| isTvOcc (rdrNameOcc n) = char '@' <+> ppr n
	| otherwise		 = ppr n

256 257 258
showRdrName :: RdrName -> String
showRdrName r = showSDoc (ppr r)

259
instance Eq RdrName where
260 261 262 263 264 265 266 267
    (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
twanvl's avatar
twanvl committed
268
    _             == _             = False
269 270 271 272 273 274 275

instance Ord RdrName where
    a <= b = case (a `compare` b) of { LT -> True;  EQ -> True;  GT -> False }
    a <	 b = case (a `compare` b) of { LT -> True;  EQ -> False; GT -> False }
    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  }

276 277 278 279 280 281 282 283 284
	-- 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
twanvl's avatar
twanvl committed
285
    compare (Exact _)  _          = LT
286 287

    compare (Unqual _)   (Exact _)    = GT
288 289
    compare (Unqual o1)  (Unqual  o2) = o1 `compare` o2
    compare (Unqual _)   _ 	      = LT
290 291 292 293

    compare (Qual _ _)   (Exact _)    = GT
    compare (Qual _ _)   (Unqual _)   = GT
    compare (Qual m1 o1) (Qual m2 o2) = (o1 `compare` o2) `thenCmp` (m1 `compare` m2) 
294
    compare (Qual _ _)   (Orig _ _)   = LT
295 296 297

    compare (Orig m1 o1) (Orig m2 o2) = (o1 `compare` o2) `thenCmp` (m1 `compare` m2) 
    compare (Orig _ _)   _	      = GT
298 299
\end{code}

300 301
%************************************************************************
%*									*
302 303 304 305 306
			LocalRdrEnv
%*									*
%************************************************************************

\begin{code}
307 308
-- | 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
309 310
type LocalRdrEnv = OccEnv Name

twanvl's avatar
twanvl committed
311
emptyLocalRdrEnv :: LocalRdrEnv
312 313
emptyLocalRdrEnv = emptyOccEnv

314 315 316 317 318 319
extendLocalRdrEnv :: LocalRdrEnv -> Name -> LocalRdrEnv
extendLocalRdrEnv env name
  = extendOccEnv env (nameOccName name) name

extendLocalRdrEnvList :: LocalRdrEnv -> [Name] -> LocalRdrEnv
extendLocalRdrEnvList env names
320 321 322
  = extendOccEnvList env [(nameOccName n, n) | n <- names]

lookupLocalRdrEnv :: LocalRdrEnv -> RdrName -> Maybe Name
twanvl's avatar
twanvl committed
323
lookupLocalRdrEnv _   (Exact name) = Just name
324
lookupLocalRdrEnv env (Unqual occ) = lookupOccEnv env occ
twanvl's avatar
twanvl committed
325
lookupLocalRdrEnv _   _            = Nothing
326

327 328 329
lookupLocalRdrOcc :: LocalRdrEnv -> OccName -> Maybe Name
lookupLocalRdrOcc env occ = lookupOccEnv env occ

330 331 332 333 334 335 336 337 338 339 340 341 342 343
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]
344 345 346 347 348 349 350 351 352 353 354
-- ^ 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
--
-- INVARIANT: All the members of the list have distinct 
--	      'gre_name' fields; that is, no duplicate Names
355 356 357 358 359 360
--
-- INVARIANT: Imported provenance => Name is an ExternalName
-- 	      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]
361

362
-- | An element of the 'GlobalRdrEnv'
363 364 365
data GlobalRdrElt 
  = GRE { gre_name :: Name,
	  gre_par  :: Parent,
366
	  gre_prov :: Provenance	-- ^ Why it's in scope
367 368
    }

369 370 371 372 373 374
-- | The children of a Name are the things that are abbreviated by the ".."
--   notation in export lists.  Specifically:
--	TyCon	Children are * data constructors
--			     * record field ids
--	Class	Children are * class operations
-- Each child has the parent thing as its Parent
375
data Parent = NoParent | ParentIs Name
376
	      deriving (Eq)
377 378 379

instance Outputable Parent where
   ppr NoParent     = empty
Ian Lynagh's avatar
Ian Lynagh committed
380
   ppr (ParentIs n) = ptext (sLit "parent:") <> ppr n
381 382 383
   

plusParent :: Parent -> Parent -> Parent
384 385 386
plusParent p1 p2 = ASSERT2( p1 == p2, parens (ppr p1) <+> parens (ppr p2) )
                   p1

twanvl's avatar
twanvl committed
387
emptyGlobalRdrEnv :: GlobalRdrEnv
388 389 390 391 392 393
emptyGlobalRdrEnv = emptyOccEnv

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

instance Outputable GlobalRdrElt where
394
  ppr gre = ppr name <+> parens (ppr (gre_par gre) <+> pprNameProvenance gre)
395 396 397 398 399 400 401 402 403 404 405 406 407 408
	  where
	    name = gre_name gre

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]
409
lookupGlobalRdrEnv env occ_name = case lookupOccEnv env occ_name of
410 411 412
					Nothing   -> []
					Just gres -> gres

413
extendGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrElt -> GlobalRdrEnv
414
extendGlobalRdrEnv env gre = extendOccEnv_Acc (:) singleton env occ gre
415 416 417
  where
    occ = nameOccName (gre_name gre)

418 419
lookupGRE_RdrName :: RdrName -> GlobalRdrEnv -> [GlobalRdrElt]
lookupGRE_RdrName rdr_name env
420 421 422
  = case lookupOccEnv env (rdrNameOcc rdr_name) of
	Nothing   -> []
	Just gres -> pickGREs rdr_name gres
423 424 425 426 427 428

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

429
getGRE_NameQualifier_maybes :: GlobalRdrEnv -> Name -> [Maybe [ModuleName]]
430 431
-- Returns all the qualifiers by which 'x' is in scope
-- Nothing means "the unqualified version is in scope"
432 433
getGRE_NameQualifier_maybes env
  = map qualifier_maybe . map gre_prov . lookupGRE_Name env
434 435 436
  where
    qualifier_maybe LocalDef       = Nothing
    qualifier_maybe (Imported iss) = Just $ map (is_as . is_decl) iss
437

438
pickGREs :: RdrName -> [GlobalRdrElt] -> [GlobalRdrElt]
439
-- ^ Take a list of GREs which have the right OccName
440 441 442
-- Pick those GREs that are suitable for this RdrName
-- And for those, keep only only the Provenances that are suitable
-- 
443 444 445
-- Consider:
--
-- @
446 447 448 449
--	 module A ( f ) where
--	 import qualified Foo( f )
--	 import Baz( f )
--	 f = undefined
450 451 452 453 454 455 456
-- @
--
-- 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
-- the locally-defined @f@, and a GRE for the imported @f@, with a /single/ 
-- provenance, namely the one for @Baz(f)@.
457 458 459
pickGREs rdr_name gres
  = mapCatMaybes pick gres
  where
Simon Marlow's avatar
Simon Marlow committed
460 461
    rdr_is_unqual = isUnqual rdr_name
    rdr_is_qual   = isQual_maybe rdr_name
462 463

    pick :: GlobalRdrElt -> Maybe GlobalRdrElt
464
    pick gre@(GRE {gre_prov = LocalDef, gre_name = n}) 	-- Local def
465
	| rdr_is_unqual		 	   = Just gre
466
	| Just (mod,_) <- rdr_is_qual 	     -- Qualified name
467 468 469
	, Just n_mod <- nameModule_maybe n   -- Binder is External
	, mod == moduleName n_mod  	   = Just gre
	| otherwise 			   = Nothing
470
    pick gre@(GRE {gre_prov = Imported [is]})	-- Single import (efficiency)
Simon Marlow's avatar
Simon Marlow committed
471
	| rdr_is_unqual,
472
	  not (is_qual (is_decl is))	= Just gre
Simon Marlow's avatar
Simon Marlow committed
473
	| Just (mod,_) <- rdr_is_qual, 
474 475
	  mod == is_as (is_decl is)	= Just gre
	| otherwise     		= Nothing
476 477 478 479
    pick gre@(GRE {gre_prov = Imported is})	-- Multiple import
	| null filtered_is = Nothing
	| otherwise	   = Just (gre {gre_prov = Imported filtered_is})
	where
Simon Marlow's avatar
Simon Marlow committed
480 481 482 483 484 485
	  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
		      = []
486

487
isLocalGRE :: GlobalRdrElt -> Bool
488
isLocalGRE (GRE {gre_prov = LocalDef}) = True
twanvl's avatar
twanvl committed
489
isLocalGRE _                           = False
490 491

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

496 497 498 499 500 501 502
plusGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrEnv -> GlobalRdrEnv
plusGlobalRdrEnv env1 env2 = plusOccEnv_C (foldr insertGRE) env1 env2

mkGlobalRdrEnv :: [GlobalRdrElt] -> GlobalRdrEnv
mkGlobalRdrEnv gres
  = foldr add emptyGlobalRdrEnv gres
  where
503 504 505
    add gre env = extendOccEnv_Acc insertGRE singleton env 
				   (nameOccName (gre_name gre)) 
				   gre
506

507
findLocalDupsRdrEnv :: GlobalRdrEnv -> [OccName] -> (GlobalRdrEnv, [[Name]])
508
-- ^ For each 'OccName', see if there are multiple local definitions
509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527
-- for it.  If so, remove all but one (to suppress subsequent error messages)
-- and return a list of the duplicate bindings
findLocalDupsRdrEnv rdr_env occs 
  = go rdr_env [] occs
  where
    go rdr_env dups [] = (rdr_env, dups)
    go rdr_env dups (occ:occs)
      = case filter isLocalGRE gres of
	  []       -> WARN( True, ppr occ <+> ppr rdr_env ) 
		      go rdr_env dups occs	-- Weird!  No binding for occ
	  [_]      -> go rdr_env dups occs	-- The common case
	  dup_gres -> go (extendOccEnv rdr_env occ (head dup_gres : nonlocal_gres))
   		         (map gre_name dup_gres : dups)
			 occs
      where
        gres = lookupOccEnv rdr_env occ `orElse` []
	nonlocal_gres = filterOut isLocalGRE gres


528 529 530 531 532 533 534 535 536 537 538
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
539
  = GRE { gre_name = gre_name g1,
540 541
	  gre_prov = gre_prov g1 `plusProv`   gre_prov g2,
	  gre_par  = gre_par  g1 `plusParent` gre_par  g2 }
542

543 544 545 546 547 548
transformGREs :: (GlobalRdrElt -> GlobalRdrElt)
	      -> [OccName] 
              -> GlobalRdrEnv -> GlobalRdrEnv
-- ^ Apply a transformation function to the GREs for these OccNames
transformGREs trans_gre occs rdr_env
  = foldr trans rdr_env occs
549
  where
550 551 552 553
    trans occ env 
      = case lookupOccEnv env occ of 
           Just gres -> extendOccEnv env occ (map trans_gre gres)
           Nothing   -> env
554 555 556 557 558
\end{code}

%************************************************************************
%*									*
			Provenance
559 560 561 562
%*									*
%************************************************************************

\begin{code}
563 564
-- | 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.
565
data Provenance
566 567 568 569 570
  = LocalDef		-- ^ The thing was defined locally
  | Imported 		
	[ImportSpec]	-- ^ The thing was imported.
	                -- 
	                -- INVARIANT: the list of 'ImportSpec' is non-empty
571

572 573 574 575
data ImportSpec = ImpSpec { is_decl :: ImpDeclSpec,
			    is_item ::  ImpItemSpec }
		deriving( Eq, Ord )

576 577 578
-- | Describes a particular import declaration and is
-- shared among all the 'Provenance's for that decl
data ImpDeclSpec
579
  = ImpDeclSpec {
580 581 582 583 584 585 586 587
	is_mod      :: ModuleName, -- ^ Module imported, e.g. @import Muggle@
				   -- Note the @Muggle@ may well not be 
				   -- the defining module for this thing!

                                   -- TODO: either should be Module, or there
                                   -- should be a Maybe PackageId here too.
	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?
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
588
	is_dloc     :: SrcSpan	   -- ^ The location of the entire import declaration
589 590
    }

591 592 593 594
-- | Describes import info a particular Name
data ImpItemSpec
  = ImpAll		-- ^ The import had no import list, 
			-- or had a hiding list
595

596
  | ImpSome {
597 598
	is_explicit :: Bool,
	is_iloc     :: SrcSpan	-- Location of the import item
599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615
    }   -- ^ The import had an import list.
	-- 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.

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)
616 617 618 619 620

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

Simon Marlow's avatar
Simon Marlow committed
621
importSpecModule :: ImportSpec -> ModuleName
622
importSpecModule is = is_mod (is_decl is)
623

624 625 626 627
isExplicitItem :: ImpItemSpec -> Bool
isExplicitItem ImpAll 			     = False
isExplicitItem (ImpSome {is_explicit = exp}) = exp

628
-- Note [Comparing provenance]
629 630 631 632 633
-- 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

634 635 636 637
instance Eq ImpDeclSpec where
  p1 == p2 = case p1 `compare` p2 of EQ -> True; _ -> False

instance Eq ImpItemSpec where
638 639 640
  p1 == p2 = case p1 `compare` p2 of EQ -> True; _ -> False

instance Ord Provenance where
641 642 643
   compare LocalDef      LocalDef   	 = EQ
   compare LocalDef      (Imported _) 	 = LT
   compare (Imported _ ) LocalDef	 = GT
644 645
   compare (Imported is1) (Imported is2) = compare (head is1) 
	{- See Note [Comparing provenance] -}	   (head is2)
646

647
instance Ord ImpDeclSpec where
648
   compare is1 is2 = (is_mod is1 `compare` is_mod is2) `thenCmp` 
649 650 651 652
		     (is_dloc is1 `compare` is_dloc is2)

instance Ord ImpItemSpec where
   compare is1 is2 = is_iloc is1 `compare` is_iloc is2
653
\end{code}
654

655
\begin{code}
656 657
plusProv :: Provenance -> Provenance -> Provenance
-- Choose LocalDef over Imported
658
-- There is an obscure bug lurking here; in the presence
659 660 661 662
-- 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
twanvl's avatar
twanvl committed
663 664 665
plusProv LocalDef        LocalDef        = panic "plusProv"
plusProv LocalDef        _               = LocalDef
plusProv _               LocalDef        = LocalDef
666
plusProv (Imported is1)  (Imported is2)  = Imported (is1++is2)
667 668

pprNameProvenance :: GlobalRdrElt -> SDoc
669
-- ^ Print out the place where the name was imported
670
pprNameProvenance (GRE {gre_name = name, gre_prov = LocalDef})
Ian Lynagh's avatar
Ian Lynagh committed
671
  = ptext (sLit "defined at") <+> ppr (nameSrcLoc name)
672 673
pprNameProvenance (GRE {gre_name = name, gre_prov = Imported whys})
  = case whys of
twanvl's avatar
twanvl committed
674
	(why:_) -> sep [ppr why, nest 2 (ppr_defn (nameSrcLoc name))]
675
	[] -> panic "pprNameProvenance"
676

677 678
-- 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".
twanvl's avatar
twanvl committed
679
ppr_defn :: SrcLoc -> SDoc
Ian Lynagh's avatar
Ian Lynagh committed
680 681
ppr_defn (RealSrcLoc loc) = parens (ptext (sLit "defined at") <+> ppr loc)
ppr_defn (UnhelpfulLoc _) = empty
682

683
instance Outputable ImportSpec where
684
   ppr imp_spec
Ian Lynagh's avatar
Ian Lynagh committed
685
     = ptext (sLit "imported from") <+> ppr (importSpecModule imp_spec) 
Ian Lynagh's avatar
Ian Lynagh committed
686
	<+> pprLoc
687 688
     where
       loc = importSpecLoc imp_spec
Ian Lynagh's avatar
Ian Lynagh committed
689 690 691
       pprLoc = case loc of
                RealSrcSpan s -> ptext (sLit "at") <+> ppr s
                UnhelpfulSpan _ -> empty
692
\end{code}