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