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