never executed always true always false
1 {-
2 (c) The University of Glasgow 2006
3 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 -}
5
6 {-# LANGUAGE CPP #-}
7 {-# LANGUAGE DeriveDataTypeable #-}
8
9 -- |
10 -- #name_types#
11 -- GHC uses several kinds of name internally:
12 --
13 -- * 'GHC.Types.Name.Occurrence.OccName': see "GHC.Types.Name.Occurrence#name_types"
14 --
15 -- * 'GHC.Types.Name.Reader.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 'GHC.Types.Name.Occurrence.OccName' with an optional module
18 -- qualifier
19 --
20 -- * 'GHC.Types.Name.Name': see "GHC.Types.Name#name_types"
21 --
22 -- * 'GHC.Types.Id.Id': see "GHC.Types.Id#name_types"
23 --
24 -- * 'GHC.Types.Var.Var': see "GHC.Types.Var#name_types"
25
26 module GHC.Types.Name.Reader (
27 -- * The main type
28 RdrName(..), -- Constructors exported only to GHC.Iface.Binary
29
30 -- ** Construction
31 mkRdrUnqual, mkRdrQual,
32 mkUnqual, mkVarUnqual, mkQual, mkOrig,
33 nameRdrName, getRdrName,
34
35 -- ** Destruction
36 rdrNameOcc, rdrNameSpace, demoteRdrName, promoteRdrName,
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,
43 elemLocalRdrEnv, inLocalRdrEnvScope,
44 localRdrEnvElts, minusLocalRdrEnv,
45
46 -- * Global mapping of 'RdrName' to 'GlobalRdrElt's
47 GlobalRdrEnv, emptyGlobalRdrEnv, mkGlobalRdrEnv, plusGlobalRdrEnv,
48 lookupGlobalRdrEnv, extendGlobalRdrEnv, greOccName, shadowNames,
49 pprGlobalRdrEnv, globalRdrEnvElts,
50 lookupGRE_RdrName, lookupGRE_RdrName', lookupGRE_Name,
51 lookupGRE_GreName, lookupGRE_FieldLabel,
52 lookupGRE_Name_OccName,
53 getGRE_NameQualifier_maybes,
54 transformGREs, pickGREs, pickGREsModExp,
55
56 -- * GlobalRdrElts
57 gresFromAvails, gresFromAvail, localGREsFromAvail, availFromGRE,
58 greRdrNames, greSrcSpan, greQualModName,
59 gresToAvailInfo,
60 greDefinitionModule, greDefinitionSrcSpan,
61 greMangledName, grePrintableName,
62 greFieldLabel,
63
64 -- ** Global 'RdrName' mapping elements: 'GlobalRdrElt', 'Provenance', 'ImportSpec'
65 GlobalRdrElt(..), isLocalGRE, isRecFldGRE,
66 isDuplicateRecFldGRE, isNoFieldSelectorGRE, isFieldSelectorGRE,
67 unQualOK, qualSpecOK, unQualSpecOK,
68 pprNameProvenance,
69 GreName(..), greNameSrcSpan,
70 Parent(..), greParent_maybe,
71 ImportSpec(..), ImpDeclSpec(..), ImpItemSpec(..),
72 importSpecLoc, importSpecModule, isExplicitItem, bestImport,
73
74 -- * Utils for StarIsType
75 starInfo,
76
77 -- * Utils
78 opIsAt,
79 ) where
80
81 import GHC.Prelude
82
83 import GHC.Unit.Module
84 import GHC.Types.Name
85 import GHC.Types.Avail
86 import GHC.Types.Name.Set
87 import GHC.Data.Maybe
88 import GHC.Types.SrcLoc as SrcLoc
89 import GHC.Data.FastString
90 import GHC.Types.FieldLabel
91 import GHC.Utils.Outputable
92 import GHC.Types.Unique
93 import GHC.Types.Unique.FM
94 import GHC.Types.Unique.Set
95 import GHC.Utils.Misc as Utils
96 import GHC.Utils.Panic
97 import GHC.Types.Name.Env
98
99 import Data.Data
100 import Data.List( sortBy )
101 import GHC.Data.Bag
102
103 {-
104 ************************************************************************
105 * *
106 \subsection{The main data type}
107 * *
108 ************************************************************************
109 -}
110
111 -- | Reader Name
112 --
113 -- Do not use the data constructors of RdrName directly: prefer the family
114 -- of functions that creates them, such as 'mkRdrUnqual'
115 --
116 -- - Note: A Located RdrName will only have API Annotations if it is a
117 -- compound one,
118 -- e.g.
119 --
120 -- > `bar`
121 -- > ( ~ )
122 --
123 -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnType',
124 -- 'GHC.Parser.Annotation.AnnOpen' @'('@ or @'['@ or @'[:'@,
125 -- 'GHC.Parser.Annotation.AnnClose' @')'@ or @']'@ or @':]'@,,
126 -- 'GHC.Parser.Annotation.AnnBackquote' @'`'@,
127 -- 'GHC.Parser.Annotation.AnnVal'
128 -- 'GHC.Parser.Annotation.AnnTilde',
129
130 -- For details on above see note [exact print annotations] in "GHC.Parser.Annotation"
131 data RdrName
132 = Unqual OccName
133 -- ^ Unqualified name
134 --
135 -- Used for ordinary, unqualified occurrences, e.g. @x@, @y@ or @Foo@.
136 -- Create such a 'RdrName' with 'mkRdrUnqual'
137
138 | Qual ModuleName OccName
139 -- ^ Qualified name
140 --
141 -- A qualified name written by the user in
142 -- /source/ code. The module isn't necessarily
143 -- the module where the thing is defined;
144 -- just the one from which it is imported.
145 -- Examples are @Bar.x@, @Bar.y@ or @Bar.Foo@.
146 -- Create such a 'RdrName' with 'mkRdrQual'
147
148 | Orig Module OccName
149 -- ^ Original name
150 --
151 -- An original name; the module is the /defining/ module.
152 -- This is used when GHC generates code that will be fed
153 -- into the renamer (e.g. from deriving clauses), but where
154 -- we want to say \"Use Prelude.map dammit\". One of these
155 -- can be created with 'mkOrig'
156
157 | Exact Name
158 -- ^ Exact name
159 --
160 -- We know exactly the 'Name'. This is used:
161 --
162 -- (1) When the parser parses built-in syntax like @[]@
163 -- and @(,)@, but wants a 'RdrName' from it
164 --
165 -- (2) By Template Haskell, when TH has generated a unique name
166 --
167 -- Such a 'RdrName' can be created by using 'getRdrName' on a 'Name'
168 deriving Data
169
170 {-
171 ************************************************************************
172 * *
173 \subsection{Simple functions}
174 * *
175 ************************************************************************
176 -}
177
178 instance HasOccName RdrName where
179 occName = rdrNameOcc
180
181 rdrNameOcc :: RdrName -> OccName
182 rdrNameOcc (Qual _ occ) = occ
183 rdrNameOcc (Unqual occ) = occ
184 rdrNameOcc (Orig _ occ) = occ
185 rdrNameOcc (Exact name) = nameOccName name
186
187 rdrNameSpace :: RdrName -> NameSpace
188 rdrNameSpace = occNameSpace . rdrNameOcc
189
190 -- demoteRdrName lowers the NameSpace of RdrName.
191 -- See Note [Demotion] in GHC.Rename.Env
192 demoteRdrName :: RdrName -> Maybe RdrName
193 demoteRdrName (Unqual occ) = fmap Unqual (demoteOccName occ)
194 demoteRdrName (Qual m occ) = fmap (Qual m) (demoteOccName occ)
195 demoteRdrName (Orig _ _) = Nothing
196 demoteRdrName (Exact _) = Nothing
197
198 -- promoteRdrName promotes the NameSpace of RdrName.
199 -- See Note [Promotion] in GHC.Rename.Env.
200 promoteRdrName :: RdrName -> Maybe RdrName
201 promoteRdrName (Unqual occ) = fmap Unqual (promoteOccName occ)
202 promoteRdrName (Qual m occ) = fmap (Qual m) (promoteOccName occ)
203 promoteRdrName (Orig _ _) = Nothing
204 promoteRdrName (Exact _) = Nothing
205
206 -- These two are the basic constructors
207 mkRdrUnqual :: OccName -> RdrName
208 mkRdrUnqual occ = Unqual occ
209
210 mkRdrQual :: ModuleName -> OccName -> RdrName
211 mkRdrQual mod occ = Qual mod occ
212
213 mkOrig :: Module -> OccName -> RdrName
214 mkOrig mod occ = Orig mod occ
215
216 ---------------
217 -- These two are used when parsing source files
218 -- They do encode the module and occurrence names
219 mkUnqual :: NameSpace -> FastString -> RdrName
220 mkUnqual sp n = Unqual (mkOccNameFS sp n)
221
222 mkVarUnqual :: FastString -> RdrName
223 mkVarUnqual n = Unqual (mkVarOccFS n)
224
225 -- | Make a qualified 'RdrName' in the given namespace and where the 'ModuleName' and
226 -- the 'OccName' are taken from the first and second elements of the tuple respectively
227 mkQual :: NameSpace -> (FastString, FastString) -> RdrName
228 mkQual sp (m, n) = Qual (mkModuleNameFS m) (mkOccNameFS sp n)
229
230 getRdrName :: NamedThing thing => thing -> RdrName
231 getRdrName name = nameRdrName (getName name)
232
233 nameRdrName :: Name -> RdrName
234 nameRdrName name = Exact name
235 -- Keep the Name even for Internal names, so that the
236 -- unique is still there for debug printing, particularly
237 -- of Types (which are converted to IfaceTypes before printing)
238
239 nukeExact :: Name -> RdrName
240 nukeExact n
241 | isExternalName n = Orig (nameModule n) (nameOccName n)
242 | otherwise = Unqual (nameOccName n)
243
244 isRdrDataCon :: RdrName -> Bool
245 isRdrTyVar :: RdrName -> Bool
246 isRdrTc :: RdrName -> Bool
247
248 isRdrDataCon rn = isDataOcc (rdrNameOcc rn)
249 isRdrTyVar rn = isTvOcc (rdrNameOcc rn)
250 isRdrTc rn = isTcOcc (rdrNameOcc rn)
251
252 isSrcRdrName :: RdrName -> Bool
253 isSrcRdrName (Unqual _) = True
254 isSrcRdrName (Qual _ _) = True
255 isSrcRdrName _ = False
256
257 isUnqual :: RdrName -> Bool
258 isUnqual (Unqual _) = True
259 isUnqual _ = False
260
261 isQual :: RdrName -> Bool
262 isQual (Qual _ _) = True
263 isQual _ = False
264
265 isQual_maybe :: RdrName -> Maybe (ModuleName, OccName)
266 isQual_maybe (Qual m n) = Just (m,n)
267 isQual_maybe _ = Nothing
268
269 isOrig :: RdrName -> Bool
270 isOrig (Orig _ _) = True
271 isOrig _ = False
272
273 isOrig_maybe :: RdrName -> Maybe (Module, OccName)
274 isOrig_maybe (Orig m n) = Just (m,n)
275 isOrig_maybe _ = Nothing
276
277 isExact :: RdrName -> Bool
278 isExact (Exact _) = True
279 isExact _ = False
280
281 isExact_maybe :: RdrName -> Maybe Name
282 isExact_maybe (Exact n) = Just n
283 isExact_maybe _ = Nothing
284
285 {-
286 ************************************************************************
287 * *
288 \subsection{Instances}
289 * *
290 ************************************************************************
291 -}
292
293 instance Outputable RdrName where
294 ppr (Exact name) = ppr name
295 ppr (Unqual occ) = ppr occ
296 ppr (Qual mod occ) = ppr mod <> dot <> ppr occ
297 ppr (Orig mod occ) = getPprStyle (\sty -> pprModulePrefix sty mod occ <> ppr occ)
298
299 instance OutputableBndr RdrName where
300 pprBndr _ n
301 | isTvOcc (rdrNameOcc n) = char '@' <> ppr n
302 | otherwise = ppr n
303
304 pprInfixOcc rdr = pprInfixVar (isSymOcc (rdrNameOcc rdr)) (ppr rdr)
305 pprPrefixOcc rdr
306 | Just name <- isExact_maybe rdr = pprPrefixName name
307 -- pprPrefixName has some special cases, so
308 -- we delegate to them rather than reproduce them
309 | otherwise = pprPrefixVar (isSymOcc (rdrNameOcc rdr)) (ppr rdr)
310
311 instance Eq RdrName where
312 (Exact n1) == (Exact n2) = n1==n2
313 -- Convert exact to orig
314 (Exact n1) == r2@(Orig _ _) = nukeExact n1 == r2
315 r1@(Orig _ _) == (Exact n2) = r1 == nukeExact n2
316
317 (Orig m1 o1) == (Orig m2 o2) = m1==m2 && o1==o2
318 (Qual m1 o1) == (Qual m2 o2) = m1==m2 && o1==o2
319 (Unqual o1) == (Unqual o2) = o1==o2
320 _ == _ = False
321
322 instance Ord RdrName where
323 a <= b = case (a `compare` b) of { LT -> True; EQ -> True; GT -> False }
324 a < b = case (a `compare` b) of { LT -> True; EQ -> False; GT -> False }
325 a >= b = case (a `compare` b) of { LT -> False; EQ -> True; GT -> True }
326 a > b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True }
327
328 -- Exact < Unqual < Qual < Orig
329 -- [Note: Apr 2004] We used to use nukeExact to convert Exact to Orig
330 -- before comparing so that Prelude.map == the exact Prelude.map, but
331 -- that meant that we reported duplicates when renaming bindings
332 -- generated by Template Haskell; e.g
333 -- do { n1 <- newName "foo"; n2 <- newName "foo";
334 -- <decl involving n1,n2> }
335 -- I think we can do without this conversion
336 compare (Exact n1) (Exact n2) = n1 `compare` n2
337 compare (Exact _) _ = LT
338
339 compare (Unqual _) (Exact _) = GT
340 compare (Unqual o1) (Unqual o2) = o1 `compare` o2
341 compare (Unqual _) _ = LT
342
343 compare (Qual _ _) (Exact _) = GT
344 compare (Qual _ _) (Unqual _) = GT
345 compare (Qual m1 o1) (Qual m2 o2) = (o1 `compare` o2) `thenCmp` (m1 `compare` m2)
346 compare (Qual _ _) (Orig _ _) = LT
347
348 compare (Orig m1 o1) (Orig m2 o2) = (o1 `compare` o2) `thenCmp` (m1 `compare` m2)
349 compare (Orig _ _) _ = GT
350
351 {-
352 ************************************************************************
353 * *
354 LocalRdrEnv
355 * *
356 ************************************************************************
357 -}
358
359 {- Note [LocalRdrEnv]
360 ~~~~~~~~~~~~~~~~~~~~~
361 The LocalRdrEnv is used to store local bindings (let, where, lambda, case).
362
363 * It is keyed by OccName, because we never use it for qualified names.
364
365 * It maps the OccName to a Name. That Name is almost always an
366 Internal Name, but (hackily) it can be External too for top-level
367 pattern bindings. See Note [bindLocalNames for an External name]
368 in GHC.Rename.Pat
369
370 * We keep the current mapping (lre_env), *and* the set of all Names in
371 scope (lre_in_scope). Reason: see Note [Splicing Exact names] in
372 GHC.Rename.Env.
373 -}
374
375 -- | Local Reader Environment
376 -- See Note [LocalRdrEnv]
377 data LocalRdrEnv = LRE { lre_env :: OccEnv Name
378 , lre_in_scope :: NameSet }
379
380 instance Outputable LocalRdrEnv where
381 ppr (LRE {lre_env = env, lre_in_scope = ns})
382 = hang (text "LocalRdrEnv {")
383 2 (vcat [ text "env =" <+> pprOccEnv ppr_elt env
384 , text "in_scope ="
385 <+> pprUFM (getUniqSet ns) (braces . pprWithCommas ppr)
386 ] <+> char '}')
387 where
388 ppr_elt name = parens (ppr (getUnique (nameOccName name))) <+> ppr name
389 -- So we can see if the keys line up correctly
390
391 emptyLocalRdrEnv :: LocalRdrEnv
392 emptyLocalRdrEnv = LRE { lre_env = emptyOccEnv
393 , lre_in_scope = emptyNameSet }
394
395 extendLocalRdrEnv :: LocalRdrEnv -> Name -> LocalRdrEnv
396 -- See Note [LocalRdrEnv]
397 extendLocalRdrEnv lre@(LRE { lre_env = env, lre_in_scope = ns }) name
398 = lre { lre_env = extendOccEnv env (nameOccName name) name
399 , lre_in_scope = extendNameSet ns name }
400
401 extendLocalRdrEnvList :: LocalRdrEnv -> [Name] -> LocalRdrEnv
402 -- See Note [LocalRdrEnv]
403 extendLocalRdrEnvList lre@(LRE { lre_env = env, lre_in_scope = ns }) names
404 = lre { lre_env = extendOccEnvList env [(nameOccName n, n) | n <- names]
405 , lre_in_scope = extendNameSetList ns names }
406
407 lookupLocalRdrEnv :: LocalRdrEnv -> RdrName -> Maybe Name
408 lookupLocalRdrEnv (LRE { lre_env = env, lre_in_scope = ns }) rdr
409 | Unqual occ <- rdr
410 = lookupOccEnv env occ
411
412 -- See Note [Local bindings with Exact Names]
413 | Exact name <- rdr
414 , name `elemNameSet` ns
415 = Just name
416
417 | otherwise
418 = Nothing
419
420 lookupLocalRdrOcc :: LocalRdrEnv -> OccName -> Maybe Name
421 lookupLocalRdrOcc (LRE { lre_env = env }) occ = lookupOccEnv env occ
422
423 elemLocalRdrEnv :: RdrName -> LocalRdrEnv -> Bool
424 elemLocalRdrEnv rdr_name (LRE { lre_env = env, lre_in_scope = ns })
425 = case rdr_name of
426 Unqual occ -> occ `elemOccEnv` env
427 Exact name -> name `elemNameSet` ns -- See Note [Local bindings with Exact Names]
428 Qual {} -> False
429 Orig {} -> False
430
431 localRdrEnvElts :: LocalRdrEnv -> [Name]
432 localRdrEnvElts (LRE { lre_env = env }) = nonDetOccEnvElts env
433
434 inLocalRdrEnvScope :: Name -> LocalRdrEnv -> Bool
435 -- This is the point of the NameSet
436 inLocalRdrEnvScope name (LRE { lre_in_scope = ns }) = name `elemNameSet` ns
437
438 minusLocalRdrEnv :: LocalRdrEnv -> OccEnv a -> LocalRdrEnv
439 minusLocalRdrEnv lre@(LRE { lre_env = env }) occs
440 = lre { lre_env = minusOccEnv env occs }
441
442 {-
443 Note [Local bindings with Exact Names]
444 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
445 With Template Haskell we can make local bindings that have Exact Names.
446 Computing shadowing etc may use elemLocalRdrEnv (at least it certainly
447 does so in GHC.Rename.HsType.bindHsQTyVars), so for an Exact Name we must consult
448 the in-scope-name-set.
449
450
451 ************************************************************************
452 * *
453 GlobalRdrEnv
454 * *
455 ************************************************************************
456 -}
457
458 -- | Global Reader Environment
459 type GlobalRdrEnv = OccEnv [GlobalRdrElt]
460 -- ^ Keyed by 'OccName'; when looking up a qualified name
461 -- we look up the 'OccName' part, and then check the 'Provenance'
462 -- to see if the appropriate qualification is valid. This
463 -- saves routinely doubling the size of the env by adding both
464 -- qualified and unqualified names to the domain.
465 --
466 -- The list in the codomain is required because there may be name clashes
467 -- These only get reported on lookup, not on construction
468 --
469 -- INVARIANT 1: All the members of the list have distinct
470 -- 'gre_name' fields; that is, no duplicate Names
471 --
472 -- INVARIANT 2: Imported provenance => Name is an ExternalName
473 -- However LocalDefs can have an InternalName. This
474 -- happens only when type-checking a [d| ... |] Template
475 -- Haskell quotation; see this note in GHC.Rename.Names
476 -- Note [Top-level Names in Template Haskell decl quotes]
477 --
478 -- INVARIANT 3: If the GlobalRdrEnv maps [occ -> gre], then
479 -- greOccName gre = occ
480 --
481 -- NB: greOccName gre is usually the same as
482 -- nameOccName (greMangledName gre), but not always in the
483 -- case of record selectors; see Note [GreNames]
484
485 -- | Global Reader Element
486 --
487 -- An element of the 'GlobalRdrEnv'
488 data GlobalRdrElt
489 = GRE { gre_name :: !GreName -- ^ See Note [GreNames]
490 , gre_par :: !Parent -- ^ See Note [Parents]
491 , gre_lcl :: !Bool -- ^ True <=> the thing was defined locally
492 , gre_imp :: !(Bag ImportSpec) -- ^ In scope through these imports
493 } deriving (Data)
494 -- INVARIANT: either gre_lcl = True or gre_imp is non-empty
495 -- See Note [GlobalRdrElt provenance]
496
497 -- | See Note [Parents]
498 data Parent = NoParent
499 | ParentIs { par_is :: Name }
500 deriving (Eq, Data)
501
502 instance Outputable Parent where
503 ppr NoParent = empty
504 ppr (ParentIs n) = text "parent:" <> ppr n
505
506 plusParent :: Parent -> Parent -> Parent
507 -- See Note [Combining parents]
508 plusParent p1@(ParentIs _) p2 = hasParent p1 p2
509 plusParent p1 p2@(ParentIs _) = hasParent p2 p1
510 plusParent NoParent NoParent = NoParent
511
512 hasParent :: Parent -> Parent -> Parent
513 #if defined(DEBUG)
514 hasParent p NoParent = p
515 hasParent p p'
516 | p /= p' = pprPanic "hasParent" (ppr p <+> ppr p') -- Parents should agree
517 #endif
518 hasParent p _ = p
519
520
521 {- Note [GlobalRdrElt provenance]
522 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
523 The gre_lcl and gre_imp fields of a GlobalRdrElt describe its "provenance",
524 i.e. how the Name came to be in scope. It can be in scope two ways:
525 - gre_lcl = True: it is bound in this module
526 - gre_imp: a list of all the imports that brought it into scope
527
528 It's an INVARIANT that you have one or the other; that is, either
529 gre_lcl is True, or gre_imp is non-empty.
530
531 It is just possible to have *both* if there is a module loop: a Name
532 is defined locally in A, and also brought into scope by importing a
533 module that SOURCE-imported A. Example (#7672):
534
535 A.hs-boot module A where
536 data T
537
538 B.hs module B(Decl.T) where
539 import {-# SOURCE #-} qualified A as Decl
540
541 A.hs module A where
542 import qualified B
543 data T = Z | S B.T
544
545 In A.hs, 'T' is locally bound, *and* imported as B.T.
546
547
548 Note [Parents]
549 ~~~~~~~~~~~~~~~~~
550 The children of a Name are the things that are abbreviated by the ".." notation
551 in export lists.
552
553 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
554 Parent Children
555 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
556 data T Data constructors
557 Record-field ids
558
559 data family T Data constructors and record-field ids
560 of all visible data instances of T
561
562 class C Class operations
563 Associated type constructors
564
565 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
566 Constructor Meaning
567 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
568 NoParent Not bundled with a type constructor.
569 ParentIs n Bundled with the type constructor corresponding to n.
570
571 Pattern synonym constructors (and their record fields, if any) are unusual:
572 their gre_par is NoParent in the module in which they are defined. However, a
573 pattern synonym can be bundled with a type constructor on export, in which case
574 whenever the pattern synonym is imported the gre_par will be ParentIs.
575
576 Thus the gre_name and gre_par fields are independent, because a normal datatype
577 introduces FieldGreNames using ParentIs, but a record pattern synonym can
578 introduce FieldGreNames that use NoParent. (In the past we represented fields
579 using an additional constructor of the Parent type, which could not adequately
580 represent this situation.) See also
581 Note [Representing pattern synonym fields in AvailInfo] in GHC.Types.Avail.
582
583
584 Note [GreNames]
585 ~~~~~~~~~~~~~~~
586 A `GlobalRdrElt` has a field `gre_name :: GreName`, which uniquely
587 identifies what the `GlobalRdrElt` describes. There are two sorts of
588 `GreName` (see the data type decl):
589
590 * NormalGreName Name: this is used for most entities; the Name
591 uniquely identifies it. It is stored in the GlobalRdrEnv under
592 the OccName of the Name.
593
594 * FieldGreName FieldLabel: is used only for field labels of a
595 record. With -XDuplicateRecordFields there may be many field
596 labels `x` in scope; e.g.
597 data T1 = MkT1 { x :: Int }
598 data T2 = MkT2 { x :: Bool }
599 Each has a different GlobalRdrElt with a distinct GreName.
600 The two fields are uniquely identified by their record selectors,
601 which are stored in the FieldLabel, and have mangled names like
602 `$sel:x:MkT1`. See Note [FieldLabel] in GHC.Types.FieldLabel.
603
604 These GREs are stored in the GlobalRdrEnv under the OccName of the
605 field (i.e. "x" in both cases above), /not/ the OccName of the mangled
606 record selector function.
607
608 A GreName, and hence a GRE, has both a "printable" and a "mangled" Name. These
609 are identical for normal names, but for record fields compiled with
610 -XDuplicateRecordFields they will differ. So we have two pairs of functions:
611
612 * greNameMangledName :: GreName -> Name
613 greMangledName :: GlobalRdrElt -> Name
614 The "mangled" Name is the actual Name of the selector function,
615 e.g. $sel:x:MkT1. This should not be displayed to the user, but is used to
616 uniquely identify the field in the renamer, and later in the backend.
617
618 * greNamePrintableName :: GreName -> Name
619 grePrintableName :: GlobalRdrElt -> Name
620 The "printable" Name is the "manged" Name with its OccName replaced with that
621 of the field label. This is how the field should be output to the user.
622
623 Since the right Name to use is context-dependent, we do not define a NamedThing
624 instance for GREName (or GlobalRdrElt), but instead make the choice explicit.
625
626
627 Note [Combining parents]
628 ~~~~~~~~~~~~~~~~~~~~~~~~
629 With an associated type we might have
630 module M where
631 class C a where
632 data T a
633 op :: T a -> a
634 instance C Int where
635 data T Int = TInt
636 instance C Bool where
637 data T Bool = TBool
638
639 Then: C is the parent of T
640 T is the parent of TInt and TBool
641 So: in an export list
642 C(..) is short for C( op, T )
643 T(..) is short for T( TInt, TBool )
644
645 Module M exports everything, so its exports will be
646 AvailTC C [C,T,op]
647 AvailTC T [T,TInt,TBool]
648 On import we convert to GlobalRdrElt and then combine
649 those. For T that will mean we have
650 one GRE with Parent C
651 one GRE with NoParent
652 That's why plusParent picks the "best" case.
653 -}
654
655 -- | make a 'GlobalRdrEnv' where all the elements point to the same
656 -- Provenance (useful for "hiding" imports, or imports with no details).
657 gresFromAvails :: Maybe ImportSpec -> [AvailInfo] -> [GlobalRdrElt]
658 -- prov = Nothing => locally bound
659 -- Just spec => imported as described by spec
660 gresFromAvails prov avails
661 = concatMap (gresFromAvail (const prov)) avails
662
663 localGREsFromAvail :: AvailInfo -> [GlobalRdrElt]
664 -- Turn an Avail into a list of LocalDef GlobalRdrElts
665 localGREsFromAvail = gresFromAvail (const Nothing)
666
667 gresFromAvail :: (Name -> Maybe ImportSpec) -> AvailInfo -> [GlobalRdrElt]
668 gresFromAvail prov_fn avail
669 = map mk_gre (availNonFldNames avail) ++ map mk_fld_gre (availFlds avail)
670 where
671 mk_gre n
672 = case prov_fn n of -- Nothing => bound locally
673 -- Just is => imported from 'is'
674 Nothing -> GRE { gre_name = NormalGreName n, gre_par = mkParent n avail
675 , gre_lcl = True, gre_imp = emptyBag }
676 Just is -> GRE { gre_name = NormalGreName n, gre_par = mkParent n avail
677 , gre_lcl = False, gre_imp = unitBag is }
678
679 mk_fld_gre fl
680 = case prov_fn (flSelector fl) of -- Nothing => bound locally
681 -- Just is => imported from 'is'
682 Nothing -> GRE { gre_name = FieldGreName fl, gre_par = availParent avail
683 , gre_lcl = True, gre_imp = emptyBag }
684 Just is -> GRE { gre_name = FieldGreName fl, gre_par = availParent avail
685 , gre_lcl = False, gre_imp = unitBag is }
686
687 instance HasOccName GlobalRdrElt where
688 occName = greOccName
689
690 -- | See Note [GreNames]
691 greOccName :: GlobalRdrElt -> OccName
692 greOccName = occName . gre_name
693
694 -- | A 'Name' for the GRE for internal use. Careful: the 'OccName' of this
695 -- 'Name' is not necessarily the same as the 'greOccName' (see Note [GreNames]).
696 greMangledName :: GlobalRdrElt -> Name
697 greMangledName = greNameMangledName . gre_name
698
699 -- | A 'Name' for the GRE suitable for output to the user. Its 'OccName' will
700 -- be the 'greOccName' (see Note [GreNames]).
701 grePrintableName :: GlobalRdrElt -> Name
702 grePrintableName = greNamePrintableName . gre_name
703
704 -- | The SrcSpan of the name pointed to by the GRE.
705 greDefinitionSrcSpan :: GlobalRdrElt -> SrcSpan
706 greDefinitionSrcSpan = nameSrcSpan . greMangledName
707
708 -- | The module in which the name pointed to by the GRE is defined.
709 greDefinitionModule :: GlobalRdrElt -> Maybe Module
710 greDefinitionModule = nameModule_maybe . greMangledName
711
712 greQualModName :: GlobalRdrElt -> ModuleName
713 -- Get a suitable module qualifier for the GRE
714 -- (used in mkPrintUnqualified)
715 -- Prerecondition: the greMangledName is always External
716 greQualModName gre@(GRE { gre_lcl = lcl, gre_imp = iss })
717 | lcl, Just mod <- greDefinitionModule gre = moduleName mod
718 | Just is <- headMaybe iss = is_as (is_decl is)
719 | otherwise = pprPanic "greQualModName" (ppr gre)
720
721 greRdrNames :: GlobalRdrElt -> [RdrName]
722 greRdrNames gre@GRE{ gre_lcl = lcl, gre_imp = iss }
723 = bagToList $ (if lcl then unitBag unqual else emptyBag) `unionBags` concatMapBag do_spec (mapBag is_decl iss)
724 where
725 occ = greOccName gre
726 unqual = Unqual occ
727 do_spec decl_spec
728 | is_qual decl_spec = unitBag qual
729 | otherwise = listToBag [unqual,qual]
730 where qual = Qual (is_as decl_spec) occ
731
732 -- the SrcSpan that pprNameProvenance prints out depends on whether
733 -- the Name is defined locally or not: for a local definition the
734 -- definition site is used, otherwise the location of the import
735 -- declaration. We want to sort the export locations in
736 -- exportClashErr by this SrcSpan, we need to extract it:
737 greSrcSpan :: GlobalRdrElt -> SrcSpan
738 greSrcSpan gre@(GRE { gre_lcl = lcl, gre_imp = iss } )
739 | lcl = greDefinitionSrcSpan gre
740 | Just is <- headMaybe iss = is_dloc (is_decl is)
741 | otherwise = pprPanic "greSrcSpan" (ppr gre)
742
743 mkParent :: Name -> AvailInfo -> Parent
744 mkParent _ (Avail _) = NoParent
745 mkParent n (AvailTC m _) | n == m = NoParent
746 | otherwise = ParentIs m
747
748 availParent :: AvailInfo -> Parent
749 availParent (AvailTC m _) = ParentIs m
750 availParent (Avail {}) = NoParent
751
752
753 greParent_maybe :: GlobalRdrElt -> Maybe Name
754 greParent_maybe gre = case gre_par gre of
755 NoParent -> Nothing
756 ParentIs n -> Just n
757
758 -- | Takes a list of distinct GREs and folds them
759 -- into AvailInfos. This is more efficient than mapping each individual
760 -- GRE to an AvailInfo and the folding using `plusAvail` but needs the
761 -- uniqueness assumption.
762 gresToAvailInfo :: [GlobalRdrElt] -> [AvailInfo]
763 gresToAvailInfo gres
764 = nonDetNameEnvElts avail_env
765 where
766 avail_env :: NameEnv AvailInfo -- Keyed by the parent
767 (avail_env, _) = foldl' add (emptyNameEnv, emptyNameSet) gres
768
769 add :: (NameEnv AvailInfo, NameSet)
770 -> GlobalRdrElt
771 -> (NameEnv AvailInfo, NameSet)
772 add (env, done) gre
773 | name `elemNameSet` done
774 = (env, done) -- Don't insert twice into the AvailInfo
775 | otherwise
776 = ( extendNameEnv_Acc comb availFromGRE env key gre
777 , done `extendNameSet` name )
778 where
779 name = greMangledName gre
780 key = case greParent_maybe gre of
781 Just parent -> parent
782 Nothing -> greMangledName gre
783
784 -- We want to insert the child `k` into a list of children but
785 -- need to maintain the invariant that the parent is first.
786 --
787 -- We also use the invariant that `k` is not already in `ns`.
788 insertChildIntoChildren :: Name -> [GreName] -> GreName -> [GreName]
789 insertChildIntoChildren _ [] k = [k]
790 insertChildIntoChildren p (n:ns) k
791 | NormalGreName p == k = k:n:ns
792 | otherwise = n:k:ns
793
794 comb :: GlobalRdrElt -> AvailInfo -> AvailInfo
795 comb _ (Avail n) = Avail n -- Duplicated name, should not happen
796 comb gre (AvailTC m ns)
797 = case gre_par gre of
798 NoParent -> AvailTC m (gre_name gre:ns) -- Not sure this ever happens
799 ParentIs {} -> AvailTC m (insertChildIntoChildren m ns (gre_name gre))
800
801 availFromGRE :: GlobalRdrElt -> AvailInfo
802 availFromGRE (GRE { gre_name = child, gre_par = parent })
803 = case parent of
804 ParentIs p -> AvailTC p [child]
805 NoParent | NormalGreName me <- child, isTyConName me -> AvailTC me [child]
806 | otherwise -> Avail child
807
808 emptyGlobalRdrEnv :: GlobalRdrEnv
809 emptyGlobalRdrEnv = emptyOccEnv
810
811 globalRdrEnvElts :: GlobalRdrEnv -> [GlobalRdrElt]
812 globalRdrEnvElts env = foldOccEnv (++) [] env
813
814 instance Outputable GlobalRdrElt where
815 ppr gre = hang (ppr (greMangledName gre) <+> ppr (gre_par gre))
816 2 (pprNameProvenance gre)
817
818 pprGlobalRdrEnv :: Bool -> GlobalRdrEnv -> SDoc
819 pprGlobalRdrEnv locals_only env
820 = vcat [ text "GlobalRdrEnv" <+> ppWhen locals_only (text "(locals only)")
821 <+> lbrace
822 , nest 2 (vcat [ pp (remove_locals gre_list) | gre_list <- nonDetOccEnvElts env ]
823 <+> rbrace) ]
824 where
825 remove_locals gres | locals_only = filter isLocalGRE gres
826 | otherwise = gres
827 pp [] = empty
828 pp gres = hang (ppr occ
829 <+> parens (text "unique" <+> ppr (getUnique occ))
830 <> colon)
831 2 (vcat (map ppr gres))
832 where
833 occ = nameOccName (greMangledName (head gres))
834
835 lookupGlobalRdrEnv :: GlobalRdrEnv -> OccName -> [GlobalRdrElt]
836 lookupGlobalRdrEnv env occ_name = case lookupOccEnv env occ_name of
837 Nothing -> []
838 Just gres -> gres
839
840 lookupGRE_RdrName :: RdrName -> GlobalRdrEnv -> [GlobalRdrElt]
841 -- ^ Look for this 'RdrName' in the global environment. Omits record fields
842 -- without selector functions (see Note [NoFieldSelectors] in GHC.Rename.Env).
843 lookupGRE_RdrName rdr_name env =
844 filter (not . isNoFieldSelectorGRE) (lookupGRE_RdrName' rdr_name env)
845
846 lookupGRE_RdrName' :: RdrName -> GlobalRdrEnv -> [GlobalRdrElt]
847 -- ^ Look for this 'RdrName' in the global environment. Includes record fields
848 -- without selector functions (see Note [NoFieldSelectors] in GHC.Rename.Env).
849 lookupGRE_RdrName' rdr_name env
850 = case lookupOccEnv env (rdrNameOcc rdr_name) of
851 Nothing -> []
852 Just gres -> pickGREs rdr_name gres
853
854 lookupGRE_Name :: GlobalRdrEnv -> Name -> Maybe GlobalRdrElt
855 -- ^ Look for precisely this 'Name' in the environment. This tests
856 -- whether it is in scope, ignoring anything else that might be in
857 -- scope with the same 'OccName'.
858 lookupGRE_Name env name
859 = lookupGRE_Name_OccName env name (nameOccName name)
860
861 lookupGRE_GreName :: GlobalRdrEnv -> GreName -> Maybe GlobalRdrElt
862 -- ^ Look for precisely this 'GreName' in the environment. This tests
863 -- whether it is in scope, ignoring anything else that might be in
864 -- scope with the same 'OccName'.
865 lookupGRE_GreName env gname
866 = lookupGRE_Name_OccName env (greNameMangledName gname) (occName gname)
867
868 lookupGRE_FieldLabel :: GlobalRdrEnv -> FieldLabel -> Maybe GlobalRdrElt
869 -- ^ Look for a particular record field selector in the environment, where the
870 -- selector name and field label may be different: the GlobalRdrEnv is keyed on
871 -- the label. See Note [GreNames] for why this happens.
872 lookupGRE_FieldLabel env fl
873 = lookupGRE_Name_OccName env (flSelector fl) (mkVarOccFS (flLabel fl))
874
875 lookupGRE_Name_OccName :: GlobalRdrEnv -> Name -> OccName -> Maybe GlobalRdrElt
876 -- ^ Look for precisely this 'Name' in the environment, but with an 'OccName'
877 -- that might differ from that of the 'Name'. See 'lookupGRE_FieldLabel' and
878 -- Note [GreNames].
879 lookupGRE_Name_OccName env name occ
880 = case [ gre | gre <- lookupGlobalRdrEnv env occ
881 , greMangledName gre == name ] of
882 [] -> Nothing
883 [gre] -> Just gre
884 gres -> pprPanic "lookupGRE_Name_OccName"
885 (ppr name $$ ppr occ $$ ppr gres)
886 -- See INVARIANT 1 on GlobalRdrEnv
887
888
889 getGRE_NameQualifier_maybes :: GlobalRdrEnv -> Name -> [Maybe [ModuleName]]
890 -- Returns all the qualifiers by which 'x' is in scope
891 -- Nothing means "the unqualified version is in scope"
892 -- [] means the thing is not in scope at all
893 getGRE_NameQualifier_maybes env name
894 = case lookupGRE_Name env name of
895 Just gre -> [qualifier_maybe gre]
896 Nothing -> []
897 where
898 qualifier_maybe (GRE { gre_lcl = lcl, gre_imp = iss })
899 | lcl = Nothing
900 | otherwise = Just $ map (is_as . is_decl) (bagToList iss)
901
902 isLocalGRE :: GlobalRdrElt -> Bool
903 isLocalGRE (GRE {gre_lcl = lcl }) = lcl
904
905 isRecFldGRE :: GlobalRdrElt -> Bool
906 isRecFldGRE = isJust . greFieldLabel
907
908 isDuplicateRecFldGRE :: GlobalRdrElt -> Bool
909 -- ^ Is this a record field defined with DuplicateRecordFields?
910 -- (See Note [GreNames])
911 isDuplicateRecFldGRE =
912 maybe False ((DuplicateRecordFields ==) . flHasDuplicateRecordFields) . greFieldLabel
913
914 isNoFieldSelectorGRE :: GlobalRdrElt -> Bool
915 -- ^ Is this a record field defined with NoFieldSelectors?
916 -- (See Note [NoFieldSelectors] in GHC.Rename.Env)
917 isNoFieldSelectorGRE =
918 maybe False ((NoFieldSelectors ==) . flHasFieldSelector) . greFieldLabel
919
920 isFieldSelectorGRE :: GlobalRdrElt -> Bool
921 -- ^ Is this a record field defined with FieldSelectors?
922 -- (See Note [NoFieldSelectors] in GHC.Rename.Env)
923 isFieldSelectorGRE =
924 maybe False ((FieldSelectors ==) . flHasFieldSelector) . greFieldLabel
925
926 greFieldLabel :: GlobalRdrElt -> Maybe FieldLabel
927 -- ^ Returns the field label of this GRE, if it has one
928 greFieldLabel = greNameFieldLabel . gre_name
929
930 unQualOK :: GlobalRdrElt -> Bool
931 -- ^ Test if an unqualified version of this thing would be in scope
932 unQualOK (GRE {gre_lcl = lcl, gre_imp = iss })
933 | lcl = True
934 | otherwise = any unQualSpecOK iss
935
936 {- Note [GRE filtering]
937 ~~~~~~~~~~~~~~~~~~~~~~~
938 (pickGREs rdr gres) takes a list of GREs which have the same OccName
939 as 'rdr', say "x". It does two things:
940
941 (a) filters the GREs to a subset that are in scope
942 * Qualified, as 'M.x' if want_qual is Qual M _
943 * Unqualified, as 'x' if want_unqual is Unqual _
944
945 (b) for that subset, filter the provenance field (gre_lcl and gre_imp)
946 to ones that brought it into scope qualified or unqualified resp.
947
948 Example:
949 module A ( f ) where
950 import qualified Foo( f )
951 import Baz( f )
952 f = undefined
953
954 Let's suppose that Foo.f and Baz.f are the same entity really, but the local
955 'f' is different, so there will be two GREs matching "f":
956 gre1: gre_lcl = True, gre_imp = []
957 gre2: gre_lcl = False, gre_imp = [ imported from Foo, imported from Bar ]
958
959 The use of "f" in the export list is ambiguous because it's in scope
960 from the local def and the import Baz(f); but *not* the import qualified Foo.
961 pickGREs returns two GRE
962 gre1: gre_lcl = True, gre_imp = []
963 gre2: gre_lcl = False, gre_imp = [ imported from Bar ]
964
965 Now the "ambiguous occurrence" message can correctly report how the
966 ambiguity arises.
967 -}
968
969 pickGREs :: RdrName -> [GlobalRdrElt] -> [GlobalRdrElt]
970 -- ^ Takes a list of GREs which have the right OccName 'x'
971 -- Pick those GREs that are in scope
972 -- * Qualified, as 'M.x' if want_qual is Qual M _
973 -- * Unqualified, as 'x' if want_unqual is Unqual _
974 --
975 -- Return each such GRE, with its ImportSpecs filtered, to reflect
976 -- how it is in scope qualified or unqualified respectively.
977 -- See Note [GRE filtering]
978 pickGREs (Unqual {}) gres = mapMaybe pickUnqualGRE gres
979 pickGREs (Qual mod _) gres = mapMaybe (pickQualGRE mod) gres
980 pickGREs _ _ = [] -- I don't think this actually happens
981
982 pickUnqualGRE :: GlobalRdrElt -> Maybe GlobalRdrElt
983 pickUnqualGRE gre@(GRE { gre_lcl = lcl, gre_imp = iss })
984 | not lcl, null iss' = Nothing
985 | otherwise = Just (gre { gre_imp = iss' })
986 where
987 iss' = filterBag unQualSpecOK iss
988
989 pickQualGRE :: ModuleName -> GlobalRdrElt -> Maybe GlobalRdrElt
990 pickQualGRE mod gre@(GRE { gre_lcl = lcl, gre_imp = iss })
991 | not lcl', null iss' = Nothing
992 | otherwise = Just (gre { gre_lcl = lcl', gre_imp = iss' })
993 where
994 iss' = filterBag (qualSpecOK mod) iss
995 lcl' = lcl && name_is_from mod
996
997 name_is_from :: ModuleName -> Bool
998 name_is_from mod = case greDefinitionModule gre of
999 Just n_mod -> moduleName n_mod == mod
1000 Nothing -> False
1001
1002 pickGREsModExp :: ModuleName -> [GlobalRdrElt] -> [(GlobalRdrElt,GlobalRdrElt)]
1003 -- ^ Pick GREs that are in scope *both* qualified *and* unqualified
1004 -- Return each GRE that is, as a pair
1005 -- (qual_gre, unqual_gre)
1006 -- These two GREs are the original GRE with imports filtered to express how
1007 -- it is in scope qualified an unqualified respectively
1008 --
1009 -- Used only for the 'module M' item in export list;
1010 -- see 'GHC.Tc.Gen.Export.exports_from_avail'
1011 pickGREsModExp mod gres = mapMaybe (pickBothGRE mod) gres
1012
1013 -- | isBuiltInSyntax filter out names for built-in syntax They
1014 -- just clutter up the environment (esp tuples), and the
1015 -- parser will generate Exact RdrNames for them, so the
1016 -- cluttered envt is no use. Really, it's only useful for
1017 -- GHC.Base and GHC.Tuple.
1018 pickBothGRE :: ModuleName -> GlobalRdrElt -> Maybe (GlobalRdrElt, GlobalRdrElt)
1019 pickBothGRE mod gre
1020 | isBuiltInSyntax (greMangledName gre) = Nothing
1021 | Just gre1 <- pickQualGRE mod gre
1022 , Just gre2 <- pickUnqualGRE gre = Just (gre1, gre2)
1023 | otherwise = Nothing
1024
1025 -- Building GlobalRdrEnvs
1026
1027 plusGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrEnv -> GlobalRdrEnv
1028 plusGlobalRdrEnv env1 env2 = plusOccEnv_C (foldr insertGRE) env1 env2
1029
1030 mkGlobalRdrEnv :: [GlobalRdrElt] -> GlobalRdrEnv
1031 mkGlobalRdrEnv gres
1032 = foldr add emptyGlobalRdrEnv gres
1033 where
1034 add gre env = extendOccEnv_Acc insertGRE Utils.singleton env
1035 (greOccName gre)
1036 gre
1037
1038 insertGRE :: GlobalRdrElt -> [GlobalRdrElt] -> [GlobalRdrElt]
1039 insertGRE new_g [] = [new_g]
1040 insertGRE new_g (old_g : old_gs)
1041 | gre_name new_g == gre_name old_g
1042 = new_g `plusGRE` old_g : old_gs
1043 | otherwise
1044 = old_g : insertGRE new_g old_gs
1045
1046 plusGRE :: GlobalRdrElt -> GlobalRdrElt -> GlobalRdrElt
1047 -- Used when the gre_name fields match
1048 plusGRE g1 g2
1049 = GRE { gre_name = gre_name g1
1050 , gre_lcl = gre_lcl g1 || gre_lcl g2
1051 , gre_imp = gre_imp g1 `unionBags` gre_imp g2
1052 , gre_par = gre_par g1 `plusParent` gre_par g2 }
1053
1054 transformGREs :: (GlobalRdrElt -> GlobalRdrElt)
1055 -> [OccName]
1056 -> GlobalRdrEnv -> GlobalRdrEnv
1057 -- ^ Apply a transformation function to the GREs for these OccNames
1058 transformGREs trans_gre occs rdr_env
1059 = foldr trans rdr_env occs
1060 where
1061 trans occ env
1062 = case lookupOccEnv env occ of
1063 Just gres -> extendOccEnv env occ (map trans_gre gres)
1064 Nothing -> env
1065
1066 extendGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrElt -> GlobalRdrEnv
1067 extendGlobalRdrEnv env gre
1068 = extendOccEnv_Acc insertGRE Utils.singleton env
1069 (greOccName gre) gre
1070
1071 {- Note [GlobalRdrEnv shadowing]
1072 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1073 Before adding new names to the GlobalRdrEnv we nuke some existing entries;
1074 this is "shadowing". The actual work is done by RdrEnv.shadowNames.
1075 Suppose
1076 env' = shadowNames env f `extendGlobalRdrEnv` M.f
1077
1078 Then:
1079 * Looking up (Unqual f) in env' should succeed, returning M.f,
1080 even if env contains existing unqualified bindings for f.
1081 They are shadowed
1082
1083 * Looking up (Qual M.f) in env' should succeed, returning M.f
1084
1085 * Looking up (Qual X.f) in env', where X /= M, should be the same as
1086 looking up (Qual X.f) in env.
1087
1088 That is, shadowNames does /not/ delete earlier qualified bindings
1089
1090 There are two reasons for shadowing:
1091
1092 * The GHCi REPL
1093
1094 - Ids bought into scope on the command line (eg let x = True) have
1095 External Names, like Ghci4.x. We want a new binding for 'x' (say)
1096 to override the existing binding for 'x'. Example:
1097
1098 ghci> :load M -- Brings `x` and `M.x` into scope
1099 ghci> x
1100 ghci> "Hello"
1101 ghci> M.x
1102 ghci> "hello"
1103 ghci> let x = True -- Shadows `x`
1104 ghci> x -- The locally bound `x`
1105 -- NOT an ambiguous reference
1106 ghci> True
1107 ghci> M.x -- M.x is still in scope!
1108 ghci> "Hello"
1109
1110 So when we add `x = True` we must not delete the `M.x` from the
1111 `GlobalRdrEnv`; rather we just want to make it "qualified only";
1112 hence the `set_qual` in `shadowNames`. See also Note
1113 [Interactively-bound Ids in GHCi] in GHC.Runtime.Context
1114
1115 - Data types also have External Names, like Ghci4.T; but we still want
1116 'T' to mean the newly-declared 'T', not an old one.
1117
1118 * Nested Template Haskell declaration brackets
1119 See Note [Top-level Names in Template Haskell decl quotes] in GHC.Rename.Names
1120
1121 Consider a TH decl quote:
1122 module M where
1123 f x = h [d| f = ...f...M.f... |]
1124 We must shadow the outer unqualified binding of 'f', else we'll get
1125 a complaint when extending the GlobalRdrEnv, saying that there are
1126 two bindings for 'f'. There are several tricky points:
1127
1128 - This shadowing applies even if the binding for 'f' is in a
1129 where-clause, and hence is in the *local* RdrEnv not the *global*
1130 RdrEnv. This is done in lcl_env_TH in extendGlobalRdrEnvRn.
1131
1132 - The External Name M.f from the enclosing module must certainly
1133 still be available. So we don't nuke it entirely; we just make
1134 it seem like qualified import.
1135
1136 - We only shadow *External* names (which come from the main module),
1137 or from earlier GHCi commands. Do not shadow *Internal* names
1138 because in the bracket
1139 [d| class C a where f :: a
1140 f = 4 |]
1141 rnSrcDecls will first call extendGlobalRdrEnvRn with C[f] from the
1142 class decl, and *separately* extend the envt with the value binding.
1143 At that stage, the class op 'f' will have an Internal name.
1144 -}
1145
1146 shadowNames :: GlobalRdrEnv -> OccEnv a -> GlobalRdrEnv
1147 -- Remove certain old GREs that share the same OccName as this new Name.
1148 -- See Note [GlobalRdrEnv shadowing] for details
1149 shadowNames = minusOccEnv_C (\gres _ -> Just (mapMaybe shadow gres))
1150 where
1151 shadow :: GlobalRdrElt -> Maybe GlobalRdrElt
1152 shadow
1153 old_gre@(GRE { gre_lcl = lcl, gre_imp = iss })
1154 = case greDefinitionModule old_gre of
1155 Nothing -> Just old_gre -- Old name is Internal; do not shadow
1156 Just old_mod
1157 | null iss' -- Nothing remains
1158 -> Nothing
1159
1160 | otherwise
1161 -> Just (old_gre { gre_lcl = False, gre_imp = iss' })
1162
1163 where
1164 iss' = lcl_imp `unionBags` mapMaybeBag set_qual iss
1165 lcl_imp | lcl = listToBag [mk_fake_imp_spec old_gre old_mod]
1166 | otherwise = emptyBag
1167
1168 mk_fake_imp_spec old_gre old_mod -- Urgh!
1169 = ImpSpec id_spec ImpAll
1170 where
1171 old_mod_name = moduleName old_mod
1172 id_spec = ImpDeclSpec { is_mod = old_mod_name
1173 , is_as = old_mod_name
1174 , is_qual = True
1175 , is_dloc = greDefinitionSrcSpan old_gre }
1176
1177 set_qual :: ImportSpec -> Maybe ImportSpec
1178 set_qual is = Just (is { is_decl = (is_decl is) { is_qual = True } })
1179
1180
1181 {-
1182 ************************************************************************
1183 * *
1184 ImportSpec
1185 * *
1186 ************************************************************************
1187 -}
1188
1189 -- | Import Specification
1190 --
1191 -- The 'ImportSpec' of something says how it came to be imported
1192 -- It's quite elaborate so that we can give accurate unused-name warnings.
1193 data ImportSpec = ImpSpec { is_decl :: ImpDeclSpec,
1194 is_item :: ImpItemSpec }
1195 deriving( Eq, Data )
1196
1197 -- | Import Declaration Specification
1198 --
1199 -- Describes a particular import declaration and is
1200 -- shared among all the 'Provenance's for that decl
1201 data ImpDeclSpec
1202 = ImpDeclSpec {
1203 is_mod :: ModuleName, -- ^ Module imported, e.g. @import Muggle@
1204 -- Note the @Muggle@ may well not be
1205 -- the defining module for this thing!
1206
1207 -- TODO: either should be Module, or there
1208 -- should be a Maybe UnitId here too.
1209 is_as :: ModuleName, -- ^ Import alias, e.g. from @as M@ (or @Muggle@ if there is no @as@ clause)
1210 is_qual :: Bool, -- ^ Was this import qualified?
1211 is_dloc :: SrcSpan -- ^ The location of the entire import declaration
1212 } deriving (Eq, Data)
1213
1214 -- | Import Item Specification
1215 --
1216 -- Describes import info a particular Name
1217 data ImpItemSpec
1218 = ImpAll -- ^ The import had no import list,
1219 -- or had a hiding list
1220
1221 | ImpSome {
1222 is_explicit :: Bool,
1223 is_iloc :: SrcSpan -- Location of the import item
1224 } -- ^ The import had an import list.
1225 -- The 'is_explicit' field is @True@ iff the thing was named
1226 -- /explicitly/ in the import specs rather
1227 -- than being imported as part of a "..." group. Consider:
1228 --
1229 -- > import C( T(..) )
1230 --
1231 -- Here the constructors of @T@ are not named explicitly;
1232 -- only @T@ is named explicitly.
1233 deriving (Eq, Data)
1234
1235 bestImport :: [ImportSpec] -> ImportSpec
1236 -- See Note [Choosing the best import declaration]
1237 bestImport iss
1238 = case sortBy best iss of
1239 (is:_) -> is
1240 [] -> pprPanic "bestImport" (ppr iss)
1241 where
1242 best :: ImportSpec -> ImportSpec -> Ordering
1243 -- Less means better
1244 -- Unqualified always wins over qualified; then
1245 -- import-all wins over import-some; then
1246 -- earlier declaration wins over later
1247 best (ImpSpec { is_item = item1, is_decl = d1 })
1248 (ImpSpec { is_item = item2, is_decl = d2 })
1249 = (is_qual d1 `compare` is_qual d2) `thenCmp`
1250 (best_item item1 item2) `thenCmp`
1251 SrcLoc.leftmost_smallest (is_dloc d1) (is_dloc d2)
1252
1253 best_item :: ImpItemSpec -> ImpItemSpec -> Ordering
1254 best_item ImpAll ImpAll = EQ
1255 best_item ImpAll (ImpSome {}) = LT
1256 best_item (ImpSome {}) ImpAll = GT
1257 best_item (ImpSome { is_explicit = e1 })
1258 (ImpSome { is_explicit = e2 }) = e1 `compare` e2
1259 -- False < True, so if e1 is explicit and e2 is not, we get GT
1260
1261 {- Note [Choosing the best import declaration]
1262 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1263 When reporting unused import declarations we use the following rules.
1264 (see [wiki:commentary/compiler/unused-imports])
1265
1266 Say that an import-item is either
1267 * an entire import-all decl (eg import Foo), or
1268 * a particular item in an import list (eg import Foo( ..., x, ...)).
1269 The general idea is that for each /occurrence/ of an imported name, we will
1270 attribute that use to one import-item. Once we have processed all the
1271 occurrences, any import items with no uses attributed to them are unused,
1272 and are warned about. More precisely:
1273
1274 1. For every RdrName in the program text, find its GlobalRdrElt.
1275
1276 2. Then, from the [ImportSpec] (gre_imp) of that GRE, choose one
1277 the "chosen import-item", and mark it "used". This is done
1278 by 'bestImport'
1279
1280 3. After processing all the RdrNames, bleat about any
1281 import-items that are unused.
1282 This is done in GHC.Rename.Names.warnUnusedImportDecls.
1283
1284 The function 'bestImport' returns the dominant import among the
1285 ImportSpecs it is given, implementing Step 2. We say import-item A
1286 dominates import-item B if we choose A over B. In general, we try to
1287 choose the import that is most likely to render other imports
1288 unnecessary. Here is the dominance relationship we choose:
1289
1290 a) import Foo dominates import qualified Foo.
1291
1292 b) import Foo dominates import Foo(x).
1293
1294 c) Otherwise choose the textually first one.
1295
1296 Rationale for (a). Consider
1297 import qualified M -- Import #1
1298 import M( x ) -- Import #2
1299 foo = M.x + x
1300
1301 The unqualified 'x' can only come from import #2. The qualified 'M.x'
1302 could come from either, but bestImport picks import #2, because it is
1303 more likely to be useful in other imports, as indeed it is in this
1304 case (see #5211 for a concrete example).
1305
1306 But the rules are not perfect; consider
1307 import qualified M -- Import #1
1308 import M( x ) -- Import #2
1309 foo = M.x + M.y
1310
1311 The M.x will use import #2, but M.y can only use import #1.
1312 -}
1313
1314
1315 unQualSpecOK :: ImportSpec -> Bool
1316 -- ^ Is in scope unqualified?
1317 unQualSpecOK is = not (is_qual (is_decl is))
1318
1319 qualSpecOK :: ModuleName -> ImportSpec -> Bool
1320 -- ^ Is in scope qualified with the given module?
1321 qualSpecOK mod is = mod == is_as (is_decl is)
1322
1323 importSpecLoc :: ImportSpec -> SrcSpan
1324 importSpecLoc (ImpSpec decl ImpAll) = is_dloc decl
1325 importSpecLoc (ImpSpec _ item) = is_iloc item
1326
1327 importSpecModule :: ImportSpec -> ModuleName
1328 importSpecModule is = is_mod (is_decl is)
1329
1330 isExplicitItem :: ImpItemSpec -> Bool
1331 isExplicitItem ImpAll = False
1332 isExplicitItem (ImpSome {is_explicit = exp}) = exp
1333
1334 pprNameProvenance :: GlobalRdrElt -> SDoc
1335 -- ^ Print out one place where the name was define/imported
1336 -- (With -dppr-debug, print them all)
1337 pprNameProvenance gre@(GRE { gre_lcl = lcl, gre_imp = iss })
1338 = ifPprDebug (vcat pp_provs)
1339 (head pp_provs)
1340 where
1341 name = greMangledName gre
1342 pp_provs = pp_lcl ++ map pp_is (bagToList iss)
1343 pp_lcl = if lcl then [text "defined at" <+> ppr (nameSrcLoc name)]
1344 else []
1345 pp_is is = sep [ppr is, ppr_defn_site is name]
1346
1347 -- If we know the exact definition point (which we may do with GHCi)
1348 -- then show that too. But not if it's just "imported from X".
1349 ppr_defn_site :: ImportSpec -> Name -> SDoc
1350 ppr_defn_site imp_spec name
1351 | same_module && not (isGoodSrcSpan loc)
1352 = empty -- Nothing interesting to say
1353 | otherwise
1354 = parens $ hang (text "and originally defined" <+> pp_mod)
1355 2 (pprLoc loc)
1356 where
1357 loc = nameSrcSpan name
1358 defining_mod = assertPpr (isExternalName name) (ppr name) $ nameModule name
1359 same_module = importSpecModule imp_spec == moduleName defining_mod
1360 pp_mod | same_module = empty
1361 | otherwise = text "in" <+> quotes (ppr defining_mod)
1362
1363
1364 instance Outputable ImportSpec where
1365 ppr imp_spec
1366 = text "imported" <+> qual
1367 <+> text "from" <+> quotes (ppr (importSpecModule imp_spec))
1368 <+> pprLoc (importSpecLoc imp_spec)
1369 where
1370 qual | is_qual (is_decl imp_spec) = text "qualified"
1371 | otherwise = empty
1372
1373 pprLoc :: SrcSpan -> SDoc
1374 pprLoc (RealSrcSpan s _) = text "at" <+> ppr s
1375 pprLoc (UnhelpfulSpan {}) = empty
1376
1377 -- | Display info about the treatment of '*' under NoStarIsType.
1378 --
1379 -- With StarIsType, three properties of '*' hold:
1380 --
1381 -- (a) it is not an infix operator
1382 -- (b) it is always in scope
1383 -- (c) it is a synonym for Data.Kind.Type
1384 --
1385 -- However, the user might not know that they are working on a module with
1386 -- NoStarIsType and write code that still assumes (a), (b), and (c), which
1387 -- actually do not hold in that module.
1388 --
1389 -- Violation of (a) shows up in the parser. For instance, in the following
1390 -- examples, we have '*' not applied to enough arguments:
1391 --
1392 -- data A :: *
1393 -- data F :: * -> *
1394 --
1395 -- Violation of (b) or (c) show up in the renamer and the typechecker
1396 -- respectively. For instance:
1397 --
1398 -- type K = Either * Bool
1399 --
1400 -- This will parse differently depending on whether StarIsType is enabled,
1401 -- but it will parse nonetheless. With NoStarIsType it is parsed as a type
1402 -- operator, thus we have ((*) Either Bool). Now there are two cases to
1403 -- consider:
1404 --
1405 -- 1. There is no definition of (*) in scope. In this case the renamer will
1406 -- fail to look it up. This is a violation of assumption (b).
1407 --
1408 -- 2. There is a definition of the (*) type operator in scope (for example
1409 -- coming from GHC.TypeNats). In this case the user will get a kind
1410 -- mismatch error. This is a violation of assumption (c).
1411 --
1412 -- The user might unknowingly be working on a module with NoStarIsType
1413 -- or use '*' as 'Data.Kind.Type' out of habit. So it is important to give a
1414 -- hint whenever an assumption about '*' is violated. Unfortunately, it is
1415 -- somewhat difficult to deal with (c), so we limit ourselves to (a) and (b).
1416 --
1417 -- 'starInfo' generates an appropriate hint to the user depending on the
1418 -- extensions enabled in the module and the name that triggered the error.
1419 -- That is, if we have NoStarIsType and the error is related to '*' or its
1420 -- Unicode variant, the resulting SDoc will contain a helpful suggestion.
1421 -- Otherwise it is empty.
1422 --
1423 starInfo :: Bool -> RdrName -> SDoc
1424 starInfo star_is_type rdr_name =
1425 -- One might ask: if can use `sdocOption sdocStarIsType` here, why bother to
1426 -- take star_is_type as input? Why not refactor?
1427 --
1428 -- The reason is that `sdocOption sdocStarIsType` would indicate that
1429 -- StarIsType is enabled in the module that tries to load the problematic
1430 -- definition, not in the module that is being loaded.
1431 --
1432 -- So if we have 'data T :: *' in a module with NoStarIsType, then the hint
1433 -- must be displayed even if we load this definition from a module (or GHCi)
1434 -- with StarIsType enabled!
1435 --
1436 if isUnqualStar && not star_is_type
1437 then text "With NoStarIsType, " <>
1438 quotes (ppr rdr_name) <>
1439 text " is treated as a regular type operator. "
1440 $$
1441 text "Did you mean to use " <> quotes (text "Type") <>
1442 text " from Data.Kind instead?"
1443 else empty
1444 where
1445 -- Does rdr_name look like the user might have meant the '*' kind by it?
1446 -- We focus on unqualified stars specifically, because qualified stars are
1447 -- treated as type operators even under StarIsType.
1448 isUnqualStar
1449 | Unqual occName <- rdr_name
1450 = let fs = occNameFS occName
1451 in fs == fsLit "*" || fs == fsLit "★"
1452 | otherwise = False
1453
1454 -- | Indicate if the given name is the "@" operator
1455 opIsAt :: RdrName -> Bool
1456 opIsAt e = e == mkUnqual varName (fsLit "@")