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 DeriveDataTypeable #-}
7 {-# LANGUAGE BangPatterns #-}
8 {-# LANGUAGE OverloadedStrings #-}
9 {-# LANGUAGE LambdaCase #-}
10
11 -- |
12 -- #name_types#
13 -- GHC uses several kinds of name internally:
14 --
15 -- * 'GHC.Types.Name.Occurrence.OccName' represents names as strings with just a little more information:
16 -- the \"namespace\" that the name came from, e.g. the namespace of value, type constructors or
17 -- data constructors
18 --
19 -- * 'GHC.Types.Name.Reader.RdrName': see "GHC.Types.Name.Reader#name_types"
20 --
21 -- * 'GHC.Types.Name.Name': see "GHC.Types.Name#name_types"
22 --
23 -- * 'GHC.Types.Id.Id': see "GHC.Types.Id#name_types"
24 --
25 -- * 'GHC.Types.Var.Var': see "GHC.Types.Var#name_types"
26
27 module GHC.Types.Name.Occurrence (
28 -- * The 'NameSpace' type
29 NameSpace, -- Abstract
30
31 -- ** Construction
32 -- $real_vs_source_data_constructors
33 tcName, clsName, tcClsName, dataName, varName,
34 tvName, srcDataName,
35
36 -- ** Pretty Printing
37 pprNameSpace, pprNonVarNameSpace, pprNameSpaceBrief,
38
39 -- * The 'OccName' type
40 OccName, -- Abstract, instance of Outputable
41 pprOccName,
42
43 -- ** Construction
44 mkOccName, mkOccNameFS,
45 mkVarOcc, mkVarOccFS,
46 mkDataOcc, mkDataOccFS,
47 mkTyVarOcc, mkTyVarOccFS,
48 mkTcOcc, mkTcOccFS,
49 mkClsOcc, mkClsOccFS,
50 mkDFunOcc,
51 setOccNameSpace,
52 demoteOccName,
53 promoteOccName,
54 HasOccName(..),
55
56 -- ** Derived 'OccName's
57 isDerivedOccName,
58 mkDataConWrapperOcc, mkWorkerOcc,
59 mkMatcherOcc, mkBuilderOcc,
60 mkDefaultMethodOcc, isDefaultMethodOcc, isTypeableBindOcc,
61 mkNewTyCoOcc, mkClassOpAuxOcc,
62 mkCon2TagOcc, mkTag2ConOcc, mkMaxTagOcc,
63 mkClassDataConOcc, mkDictOcc, mkIPOcc,
64 mkSpecOcc, mkForeignExportOcc, mkRepEqOcc,
65 mkGenR, mkGen1R,
66 mkDataTOcc, mkDataCOcc, mkDataConWorkerOcc,
67 mkSuperDictSelOcc, mkSuperDictAuxOcc,
68 mkLocalOcc, mkMethodOcc, mkInstTyTcOcc,
69 mkInstTyCoOcc, mkEqPredCoOcc,
70 mkRecFldSelOcc,
71 mkTyConRepOcc,
72
73 -- ** Deconstruction
74 occNameFS, occNameString, occNameSpace,
75
76 isVarOcc, isTvOcc, isTcOcc, isDataOcc, isDataSymOcc, isSymOcc, isValOcc,
77 parenSymOcc, startsWithUnderscore,
78
79 isTcClsNameSpace, isTvNameSpace, isDataConNameSpace, isVarNameSpace, isValNameSpace,
80
81 -- * The 'OccEnv' type
82 OccEnv, emptyOccEnv, unitOccEnv, extendOccEnv, mapOccEnv,
83 lookupOccEnv, mkOccEnv, mkOccEnv_C, extendOccEnvList, elemOccEnv,
84 nonDetOccEnvElts, foldOccEnv, plusOccEnv, plusOccEnv_C, extendOccEnv_C,
85 extendOccEnv_Acc, filterOccEnv, delListFromOccEnv, delFromOccEnv,
86 alterOccEnv, minusOccEnv, minusOccEnv_C, pprOccEnv,
87
88 -- * The 'OccSet' type
89 OccSet, emptyOccSet, unitOccSet, mkOccSet, extendOccSet,
90 extendOccSetList,
91 unionOccSets, unionManyOccSets, minusOccSet, elemOccSet,
92 isEmptyOccSet, intersectOccSet,
93 filterOccSet, occSetToEnv,
94
95 -- * Tidying up
96 TidyOccEnv, emptyTidyOccEnv, initTidyOccEnv,
97 tidyOccName, avoidClashesOccEnv, delTidyOccEnvList,
98
99 -- FsEnv
100 FastStringEnv, emptyFsEnv, lookupFsEnv, extendFsEnv, mkFsEnv
101 ) where
102
103 import GHC.Prelude
104
105 import GHC.Utils.Misc
106 import GHC.Types.Unique
107 import GHC.Builtin.Uniques
108 import GHC.Types.Unique.FM
109 import GHC.Types.Unique.Set
110 import GHC.Data.FastString
111 import GHC.Data.FastString.Env
112 import GHC.Utils.Outputable
113 import GHC.Utils.Lexeme
114 import GHC.Utils.Binary
115 import Control.DeepSeq
116 import Data.Char
117 import Data.Data
118
119 {-
120 ************************************************************************
121 * *
122 \subsection{Name space}
123 * *
124 ************************************************************************
125 -}
126
127 data NameSpace = VarName -- Variables, including "real" data constructors
128 | DataName -- "Source" data constructors
129 | TvName -- Type variables
130 | TcClsName -- Type constructors and classes; Haskell has them
131 -- in the same name space for now.
132 deriving( Eq, Ord )
133
134 -- Note [Data Constructors]
135 -- see also: Note [Data Constructor Naming] in GHC.Core.DataCon
136 --
137 -- $real_vs_source_data_constructors
138 -- There are two forms of data constructor:
139 --
140 -- [Source data constructors] The data constructors mentioned in Haskell source code
141 --
142 -- [Real data constructors] The data constructors of the representation type, which may not be the same as the source type
143 --
144 -- For example:
145 --
146 -- > data T = T !(Int, Int)
147 --
148 -- The source datacon has type @(Int, Int) -> T@
149 -- The real datacon has type @Int -> Int -> T@
150 --
151 -- GHC chooses a representation based on the strictness etc.
152
153 tcName, clsName, tcClsName :: NameSpace
154 dataName, srcDataName :: NameSpace
155 tvName, varName :: NameSpace
156
157 -- Though type constructors and classes are in the same name space now,
158 -- the NameSpace type is abstract, so we can easily separate them later
159 tcName = TcClsName -- Type constructors
160 clsName = TcClsName -- Classes
161 tcClsName = TcClsName -- Not sure which!
162
163 dataName = DataName
164 srcDataName = DataName -- Haskell-source data constructors should be
165 -- in the Data name space
166
167 tvName = TvName
168 varName = VarName
169
170 isDataConNameSpace :: NameSpace -> Bool
171 isDataConNameSpace DataName = True
172 isDataConNameSpace _ = False
173
174 isTcClsNameSpace :: NameSpace -> Bool
175 isTcClsNameSpace TcClsName = True
176 isTcClsNameSpace _ = False
177
178 isTvNameSpace :: NameSpace -> Bool
179 isTvNameSpace TvName = True
180 isTvNameSpace _ = False
181
182 isVarNameSpace :: NameSpace -> Bool -- Variables or type variables, but not constructors
183 isVarNameSpace TvName = True
184 isVarNameSpace VarName = True
185 isVarNameSpace _ = False
186
187 isValNameSpace :: NameSpace -> Bool
188 isValNameSpace DataName = True
189 isValNameSpace VarName = True
190 isValNameSpace _ = False
191
192 pprNameSpace :: NameSpace -> SDoc
193 pprNameSpace DataName = text "data constructor"
194 pprNameSpace VarName = text "variable"
195 pprNameSpace TvName = text "type variable"
196 pprNameSpace TcClsName = text "type constructor or class"
197
198 pprNonVarNameSpace :: NameSpace -> SDoc
199 pprNonVarNameSpace VarName = empty
200 pprNonVarNameSpace ns = pprNameSpace ns
201
202 pprNameSpaceBrief :: NameSpace -> SDoc
203 pprNameSpaceBrief DataName = char 'd'
204 pprNameSpaceBrief VarName = char 'v'
205 pprNameSpaceBrief TvName = text "tv"
206 pprNameSpaceBrief TcClsName = text "tc"
207
208 -- demoteNameSpace lowers the NameSpace if possible. We can not know
209 -- in advance, since a TvName can appear in an HsTyVar.
210 -- See Note [Demotion] in GHC.Rename.Env.
211 demoteNameSpace :: NameSpace -> Maybe NameSpace
212 demoteNameSpace VarName = Nothing
213 demoteNameSpace DataName = Nothing
214 demoteNameSpace TvName = Nothing
215 demoteNameSpace TcClsName = Just DataName
216
217 -- promoteNameSpace promotes the NameSpace as follows.
218 -- See Note [Promotion] in GHC.Rename.Env.
219 promoteNameSpace :: NameSpace -> Maybe NameSpace
220 promoteNameSpace DataName = Just TcClsName
221 promoteNameSpace VarName = Just TvName
222 promoteNameSpace TcClsName = Nothing
223 promoteNameSpace TvName = Nothing
224
225 {-
226 ************************************************************************
227 * *
228 \subsection[Name-pieces-datatypes]{The @OccName@ datatypes}
229 * *
230 ************************************************************************
231 -}
232
233 -- | Occurrence Name
234 --
235 -- In this context that means:
236 -- "classified (i.e. as a type name, value name, etc) but not qualified
237 -- and not yet resolved"
238 data OccName = OccName
239 { occNameSpace :: !NameSpace
240 , occNameFS :: !FastString
241 }
242
243 instance Eq OccName where
244 (OccName sp1 s1) == (OccName sp2 s2) = s1 == s2 && sp1 == sp2
245
246 instance Ord OccName where
247 -- Compares lexicographically, *not* by Unique of the string
248 compare (OccName sp1 s1) (OccName sp2 s2)
249 = (s1 `lexicalCompareFS` s2) `thenCmp` (sp1 `compare` sp2)
250
251 instance Data OccName where
252 -- don't traverse?
253 toConstr _ = abstractConstr "OccName"
254 gunfold _ _ = error "gunfold"
255 dataTypeOf _ = mkNoRepType "OccName"
256
257 instance HasOccName OccName where
258 occName = id
259
260 instance NFData OccName where
261 rnf x = x `seq` ()
262
263 {-
264 ************************************************************************
265 * *
266 \subsection{Printing}
267 * *
268 ************************************************************************
269 -}
270
271 instance Outputable OccName where
272 ppr = pprOccName
273
274 instance OutputableBndr OccName where
275 pprBndr _ = ppr
276 pprInfixOcc n = pprInfixVar (isSymOcc n) (ppr n)
277 pprPrefixOcc n = pprPrefixVar (isSymOcc n) (ppr n)
278
279 pprOccName :: OccName -> SDoc
280 pprOccName (OccName sp occ)
281 = getPprStyle $ \ sty ->
282 if codeStyle sty
283 then ztext (zEncodeFS occ)
284 else pp_occ <> whenPprDebug (braces (pprNameSpaceBrief sp))
285 where
286 pp_occ = sdocOption sdocSuppressUniques $ \case
287 True -> text (strip_th_unique (unpackFS occ))
288 False -> ftext occ
289
290 -- See Note [Suppressing uniques in OccNames]
291 strip_th_unique ('[' : c : _) | isAlphaNum c = []
292 strip_th_unique (c : cs) = c : strip_th_unique cs
293 strip_th_unique [] = []
294
295 {-
296 Note [Suppressing uniques in OccNames]
297 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
298 This is a hack to de-wobblify the OccNames that contain uniques from
299 Template Haskell that have been turned into a string in the OccName.
300 See Note [Unique OccNames from Template Haskell] in "GHC.ThToHs"
301
302 ************************************************************************
303 * *
304 \subsection{Construction}
305 * *
306 ************************************************************************
307 -}
308
309 mkOccName :: NameSpace -> String -> OccName
310 mkOccName occ_sp str = OccName occ_sp (mkFastString str)
311
312 mkOccNameFS :: NameSpace -> FastString -> OccName
313 mkOccNameFS occ_sp fs = OccName occ_sp fs
314
315 mkVarOcc :: String -> OccName
316 mkVarOcc s = mkOccName varName s
317
318 mkVarOccFS :: FastString -> OccName
319 mkVarOccFS fs = mkOccNameFS varName fs
320
321 mkDataOcc :: String -> OccName
322 mkDataOcc = mkOccName dataName
323
324 mkDataOccFS :: FastString -> OccName
325 mkDataOccFS = mkOccNameFS dataName
326
327 mkTyVarOcc :: String -> OccName
328 mkTyVarOcc = mkOccName tvName
329
330 mkTyVarOccFS :: FastString -> OccName
331 mkTyVarOccFS fs = mkOccNameFS tvName fs
332
333 mkTcOcc :: String -> OccName
334 mkTcOcc = mkOccName tcName
335
336 mkTcOccFS :: FastString -> OccName
337 mkTcOccFS = mkOccNameFS tcName
338
339 mkClsOcc :: String -> OccName
340 mkClsOcc = mkOccName clsName
341
342 mkClsOccFS :: FastString -> OccName
343 mkClsOccFS = mkOccNameFS clsName
344
345 -- demoteOccName lowers the Namespace of OccName.
346 -- See Note [Demotion] in GHC.Rename.Env.
347 demoteOccName :: OccName -> Maybe OccName
348 demoteOccName (OccName space name) = do
349 space' <- demoteNameSpace space
350 return $ OccName space' name
351
352 -- promoteOccName promotes the NameSpace of OccName.
353 -- See Note [Promotion] in GHC.Rename.Env.
354 promoteOccName :: OccName -> Maybe OccName
355 promoteOccName (OccName space name) = do
356 space' <- promoteNameSpace space
357 return $ OccName space' name
358
359 {- | Other names in the compiler add additional information to an OccName.
360 This class provides a consistent way to access the underlying OccName. -}
361 class HasOccName name where
362 occName :: name -> OccName
363
364 {-
365 ************************************************************************
366 * *
367 Environments
368 * *
369 ************************************************************************
370
371 OccEnvs are used mainly for the envts in ModIfaces.
372
373 Note [The Unique of an OccName]
374 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
375 They are efficient, because FastStrings have unique Int# keys. We assume
376 this key is less than 2^24, and indeed FastStrings are allocated keys
377 sequentially starting at 0.
378
379 So we can make a Unique using
380 mkUnique ns key :: Unique
381 where 'ns' is a Char representing the name space. This in turn makes it
382 easy to build an OccEnv.
383 -}
384
385 instance Uniquable OccName where
386 -- See Note [The Unique of an OccName]
387 getUnique (OccName VarName fs) = mkVarOccUnique fs
388 getUnique (OccName DataName fs) = mkDataOccUnique fs
389 getUnique (OccName TvName fs) = mkTvOccUnique fs
390 getUnique (OccName TcClsName fs) = mkTcOccUnique fs
391
392 newtype OccEnv a = A (UniqFM OccName a)
393 deriving Data
394
395 emptyOccEnv :: OccEnv a
396 unitOccEnv :: OccName -> a -> OccEnv a
397 extendOccEnv :: OccEnv a -> OccName -> a -> OccEnv a
398 extendOccEnvList :: OccEnv a -> [(OccName, a)] -> OccEnv a
399 lookupOccEnv :: OccEnv a -> OccName -> Maybe a
400 mkOccEnv :: [(OccName,a)] -> OccEnv a
401 mkOccEnv_C :: (a -> a -> a) -> [(OccName,a)] -> OccEnv a
402 elemOccEnv :: OccName -> OccEnv a -> Bool
403 foldOccEnv :: (a -> b -> b) -> b -> OccEnv a -> b
404 nonDetOccEnvElts :: OccEnv a -> [a]
405 extendOccEnv_C :: (a->a->a) -> OccEnv a -> OccName -> a -> OccEnv a
406 extendOccEnv_Acc :: (a->b->b) -> (a->b) -> OccEnv b -> OccName -> a -> OccEnv b
407 plusOccEnv :: OccEnv a -> OccEnv a -> OccEnv a
408 plusOccEnv_C :: (a->a->a) -> OccEnv a -> OccEnv a -> OccEnv a
409 mapOccEnv :: (a->b) -> OccEnv a -> OccEnv b
410 delFromOccEnv :: OccEnv a -> OccName -> OccEnv a
411 delListFromOccEnv :: OccEnv a -> [OccName] -> OccEnv a
412 filterOccEnv :: (elt -> Bool) -> OccEnv elt -> OccEnv elt
413 alterOccEnv :: (Maybe elt -> Maybe elt) -> OccEnv elt -> OccName -> OccEnv elt
414 minusOccEnv :: OccEnv a -> OccEnv b -> OccEnv a
415
416 -- | Alters (replaces or removes) those elements of the map that are mentioned in the second map
417 minusOccEnv_C :: (a -> b -> Maybe a) -> OccEnv a -> OccEnv b -> OccEnv a
418
419 emptyOccEnv = A emptyUFM
420 unitOccEnv x y = A $ unitUFM x y
421 extendOccEnv (A x) y z = A $ addToUFM x y z
422 extendOccEnvList (A x) l = A $ addListToUFM x l
423 lookupOccEnv (A x) y = lookupUFM x y
424 mkOccEnv l = A $ listToUFM l
425 elemOccEnv x (A y) = elemUFM x y
426 foldOccEnv a b (A c) = foldUFM a b c
427 nonDetOccEnvElts (A x) = nonDetEltsUFM x
428 plusOccEnv (A x) (A y) = A $ plusUFM x y
429 plusOccEnv_C f (A x) (A y) = A $ plusUFM_C f x y
430 extendOccEnv_C f (A x) y z = A $ addToUFM_C f x y z
431 extendOccEnv_Acc f g (A x) y z = A $ addToUFM_Acc f g x y z
432 mapOccEnv f (A x) = A $ mapUFM f x
433 mkOccEnv_C comb l = A $ addListToUFM_C comb emptyUFM l
434 delFromOccEnv (A x) y = A $ delFromUFM x y
435 delListFromOccEnv (A x) y = A $ delListFromUFM x y
436 filterOccEnv x (A y) = A $ filterUFM x y
437 alterOccEnv fn (A y) k = A $ alterUFM fn y k
438 minusOccEnv (A x) (A y) = A $ minusUFM x y
439 minusOccEnv_C fn (A x) (A y) = A $ minusUFM_C fn x y
440
441 instance Outputable a => Outputable (OccEnv a) where
442 ppr x = pprOccEnv ppr x
443
444 pprOccEnv :: (a -> SDoc) -> OccEnv a -> SDoc
445 pprOccEnv ppr_elt (A env) = pprUniqFM ppr_elt env
446
447 type OccSet = UniqSet OccName
448
449 emptyOccSet :: OccSet
450 unitOccSet :: OccName -> OccSet
451 mkOccSet :: [OccName] -> OccSet
452 extendOccSet :: OccSet -> OccName -> OccSet
453 extendOccSetList :: OccSet -> [OccName] -> OccSet
454 unionOccSets :: OccSet -> OccSet -> OccSet
455 unionManyOccSets :: [OccSet] -> OccSet
456 minusOccSet :: OccSet -> OccSet -> OccSet
457 elemOccSet :: OccName -> OccSet -> Bool
458 isEmptyOccSet :: OccSet -> Bool
459 intersectOccSet :: OccSet -> OccSet -> OccSet
460 filterOccSet :: (OccName -> Bool) -> OccSet -> OccSet
461 -- | Converts an OccSet to an OccEnv (operationally the identity)
462 occSetToEnv :: OccSet -> OccEnv OccName
463
464 emptyOccSet = emptyUniqSet
465 unitOccSet = unitUniqSet
466 mkOccSet = mkUniqSet
467 extendOccSet = addOneToUniqSet
468 extendOccSetList = addListToUniqSet
469 unionOccSets = unionUniqSets
470 unionManyOccSets = unionManyUniqSets
471 minusOccSet = minusUniqSet
472 elemOccSet = elementOfUniqSet
473 isEmptyOccSet = isEmptyUniqSet
474 intersectOccSet = intersectUniqSets
475 filterOccSet = filterUniqSet
476 occSetToEnv = A . getUniqSet
477
478 {-
479 ************************************************************************
480 * *
481 \subsection{Predicates and taking them apart}
482 * *
483 ************************************************************************
484 -}
485
486 occNameString :: OccName -> String
487 occNameString (OccName _ s) = unpackFS s
488
489 setOccNameSpace :: NameSpace -> OccName -> OccName
490 setOccNameSpace sp (OccName _ occ) = OccName sp occ
491
492 isVarOcc, isTvOcc, isTcOcc, isDataOcc :: OccName -> Bool
493
494 isVarOcc (OccName VarName _) = True
495 isVarOcc _ = False
496
497 isTvOcc (OccName TvName _) = True
498 isTvOcc _ = False
499
500 isTcOcc (OccName TcClsName _) = True
501 isTcOcc _ = False
502
503 -- | /Value/ 'OccNames's are those that are either in
504 -- the variable or data constructor namespaces
505 isValOcc :: OccName -> Bool
506 isValOcc (OccName VarName _) = True
507 isValOcc (OccName DataName _) = True
508 isValOcc _ = False
509
510 isDataOcc (OccName DataName _) = True
511 isDataOcc _ = False
512
513 -- | Test if the 'OccName' is a data constructor that starts with
514 -- a symbol (e.g. @:@, or @[]@)
515 isDataSymOcc :: OccName -> Bool
516 isDataSymOcc (OccName DataName s) = isLexConSym s
517 isDataSymOcc _ = False
518 -- Pretty inefficient!
519
520 -- | Test if the 'OccName' is that for any operator (whether
521 -- it is a data constructor or variable or whatever)
522 isSymOcc :: OccName -> Bool
523 isSymOcc (OccName DataName s) = isLexConSym s
524 isSymOcc (OccName TcClsName s) = isLexSym s
525 isSymOcc (OccName VarName s) = isLexSym s
526 isSymOcc (OccName TvName s) = isLexSym s
527 -- Pretty inefficient!
528
529 parenSymOcc :: OccName -> SDoc -> SDoc
530 -- ^ Wrap parens around an operator
531 parenSymOcc occ doc | isSymOcc occ = parens doc
532 | otherwise = doc
533
534 startsWithUnderscore :: OccName -> Bool
535 -- ^ Haskell 98 encourages compilers to suppress warnings about unused
536 -- names in a pattern if they start with @_@: this implements that test
537 startsWithUnderscore occ = headFS (occNameFS occ) == '_'
538
539 {-
540 ************************************************************************
541 * *
542 \subsection{Making system names}
543 * *
544 ************************************************************************
545
546 Here's our convention for splitting up the interface file name space:
547
548 d... dictionary identifiers
549 (local variables, so no name-clash worries)
550
551 All of these other OccNames contain a mixture of alphabetic
552 and symbolic characters, and hence cannot possibly clash with
553 a user-written type or function name
554
555 $f... Dict-fun identifiers (from inst decls)
556 $dmop Default method for 'op'
557 $pnC n'th superclass selector for class C
558 $wf Worker for function 'f'
559 $sf.. Specialised version of f
560 D:C Data constructor for dictionary for class C
561 NTCo:T Coercion connecting newtype T with its representation type
562 TFCo:R Coercion connecting a data family to its representation type R
563
564 In encoded form these appear as Zdfxxx etc
565
566 :... keywords (export:, letrec: etc.)
567 --- I THINK THIS IS WRONG!
568
569 This knowledge is encoded in the following functions.
570
571 @mk_deriv@ generates an @OccName@ from the prefix and a string.
572 NB: The string must already be encoded!
573 -}
574
575 -- | Build an 'OccName' derived from another 'OccName'.
576 --
577 -- Note that the pieces of the name are passed in as a @[FastString]@ so that
578 -- the whole name can be constructed with a single 'concatFS', minimizing
579 -- unnecessary intermediate allocations.
580 mk_deriv :: NameSpace
581 -> FastString -- ^ A prefix which distinguishes one sort of
582 -- derived name from another
583 -> [FastString] -- ^ The name we are deriving from in pieces which
584 -- will be concatenated.
585 -> OccName
586 mk_deriv occ_sp sys_prefix str =
587 mkOccNameFS occ_sp (concatFS $ sys_prefix : str)
588
589 isDerivedOccName :: OccName -> Bool
590 -- ^ Test for definitions internally generated by GHC. This predicate
591 -- is used to suppress printing of internal definitions in some debug prints
592 isDerivedOccName occ =
593 case occNameString occ of
594 '$':c:_ | isAlphaNum c -> True -- E.g. $wfoo
595 c:':':_ | isAlphaNum c -> True -- E.g. N:blah newtype coercions
596 _other -> False
597
598 isDefaultMethodOcc :: OccName -> Bool
599 isDefaultMethodOcc occ =
600 case occNameString occ of
601 '$':'d':'m':_ -> True
602 _ -> False
603
604 -- | Is an 'OccName' one of a Typeable @TyCon@ or @Module@ binding?
605 -- This is needed as these bindings are renamed differently.
606 -- See Note [Grand plan for Typeable] in "GHC.Tc.Instance.Typeable".
607 isTypeableBindOcc :: OccName -> Bool
608 isTypeableBindOcc occ =
609 case occNameString occ of
610 '$':'t':'c':_ -> True -- mkTyConRepOcc
611 '$':'t':'r':_ -> True -- Module binding
612 _ -> False
613
614 mkDataConWrapperOcc, mkWorkerOcc,
615 mkMatcherOcc, mkBuilderOcc,
616 mkDefaultMethodOcc,
617 mkClassDataConOcc, mkDictOcc,
618 mkIPOcc, mkSpecOcc, mkForeignExportOcc, mkRepEqOcc,
619 mkGenR, mkGen1R,
620 mkDataConWorkerOcc, mkNewTyCoOcc,
621 mkInstTyCoOcc, mkEqPredCoOcc, mkClassOpAuxOcc,
622 mkCon2TagOcc, mkTag2ConOcc, mkMaxTagOcc, mkDataTOcc, mkDataCOcc,
623 mkTyConRepOcc
624 :: OccName -> OccName
625
626 -- These derived variables have a prefix that no Haskell value could have
627 mkDataConWrapperOcc = mk_simple_deriv varName "$W"
628 mkWorkerOcc = mk_simple_deriv varName "$w"
629 mkMatcherOcc = mk_simple_deriv varName "$m"
630 mkBuilderOcc = mk_simple_deriv varName "$b"
631 mkDefaultMethodOcc = mk_simple_deriv varName "$dm"
632 mkClassOpAuxOcc = mk_simple_deriv varName "$c"
633 mkDictOcc = mk_simple_deriv varName "$d"
634 mkIPOcc = mk_simple_deriv varName "$i"
635 mkSpecOcc = mk_simple_deriv varName "$s"
636 mkForeignExportOcc = mk_simple_deriv varName "$f"
637 mkRepEqOcc = mk_simple_deriv tvName "$r" -- In RULES involving Coercible
638 mkClassDataConOcc = mk_simple_deriv dataName "C:" -- Data con for a class
639 mkNewTyCoOcc = mk_simple_deriv tcName "N:" -- Coercion for newtypes
640 mkInstTyCoOcc = mk_simple_deriv tcName "D:" -- Coercion for type functions
641 mkEqPredCoOcc = mk_simple_deriv tcName "$co"
642
643 -- Used in derived instances for the names of auxiliary bindings.
644 -- See Note [Auxiliary binders] in GHC.Tc.Deriv.Generate.
645 mkCon2TagOcc = mk_simple_deriv varName "$con2tag_"
646 mkTag2ConOcc = mk_simple_deriv varName "$tag2con_"
647 mkMaxTagOcc = mk_simple_deriv varName "$maxtag_"
648 mkDataTOcc = mk_simple_deriv varName "$t"
649 mkDataCOcc = mk_simple_deriv varName "$c"
650
651 -- TyConRepName stuff; see Note [Grand plan for Typeable] in GHC.Tc.Instance.Typeable
652 mkTyConRepOcc occ = mk_simple_deriv varName prefix occ
653 where
654 prefix | isDataOcc occ = "$tc'"
655 | otherwise = "$tc"
656
657 -- Generic deriving mechanism
658 mkGenR = mk_simple_deriv tcName "Rep_"
659 mkGen1R = mk_simple_deriv tcName "Rep1_"
660
661 -- Overloaded record field selectors
662 mkRecFldSelOcc :: String -> OccName
663 mkRecFldSelOcc s = mk_deriv varName "$sel" [fsLit s]
664
665 mk_simple_deriv :: NameSpace -> FastString -> OccName -> OccName
666 mk_simple_deriv sp px occ = mk_deriv sp px [occNameFS occ]
667
668 -- Data constructor workers are made by setting the name space
669 -- of the data constructor OccName (which should be a DataName)
670 -- to VarName
671 mkDataConWorkerOcc datacon_occ = setOccNameSpace varName datacon_occ
672
673 mkSuperDictAuxOcc :: Int -> OccName -> OccName
674 mkSuperDictAuxOcc index cls_tc_occ
675 = mk_deriv varName "$cp" [fsLit $ show index, occNameFS cls_tc_occ]
676
677 mkSuperDictSelOcc :: Int -- ^ Index of superclass, e.g. 3
678 -> OccName -- ^ Class, e.g. @Ord@
679 -> OccName -- ^ Derived 'Occname', e.g. @$p3Ord@
680 mkSuperDictSelOcc index cls_tc_occ
681 = mk_deriv varName "$p" [fsLit $ show index, occNameFS cls_tc_occ]
682
683 mkLocalOcc :: Unique -- ^ Unique to combine with the 'OccName'
684 -> OccName -- ^ Local name, e.g. @sat@
685 -> OccName -- ^ Nice unique version, e.g. @$L23sat@
686 mkLocalOcc uniq occ
687 = mk_deriv varName "$L" [fsLit $ show uniq, occNameFS occ]
688 -- The Unique might print with characters
689 -- that need encoding (e.g. 'z'!)
690
691 -- | Derive a name for the representation type constructor of a
692 -- @data@\/@newtype@ instance.
693 mkInstTyTcOcc :: String -- ^ Family name, e.g. @Map@
694 -> OccSet -- ^ avoid these Occs
695 -> OccName -- ^ @R:Map@
696 mkInstTyTcOcc str = chooseUniqueOcc tcName ('R' : ':' : str)
697
698 mkDFunOcc :: String -- ^ Typically the class and type glommed together e.g. @OrdMaybe@.
699 -- Only used in debug mode, for extra clarity
700 -> Bool -- ^ Is this a hs-boot instance DFun?
701 -> OccSet -- ^ avoid these Occs
702 -> OccName -- ^ E.g. @$f3OrdMaybe@
703
704 -- In hs-boot files we make dict funs like $fx7ClsTy, which get bound to the real
705 -- thing when we compile the mother module. Reason: we don't know exactly
706 -- what the mother module will call it.
707
708 mkDFunOcc info_str is_boot set
709 = chooseUniqueOcc VarName (prefix ++ info_str) set
710 where
711 prefix | is_boot = "$fx"
712 | otherwise = "$f"
713
714 {-
715 Sometimes we need to pick an OccName that has not already been used,
716 given a set of in-use OccNames.
717 -}
718
719 chooseUniqueOcc :: NameSpace -> String -> OccSet -> OccName
720 chooseUniqueOcc ns str set = loop (mkOccName ns str) (0::Int)
721 where
722 loop occ n
723 | occ `elemOccSet` set = loop (mkOccName ns (str ++ show n)) (n+1)
724 | otherwise = occ
725
726 {-
727 We used to add a '$m' to indicate a method, but that gives rise to bad
728 error messages from the type checker when we print the function name or pattern
729 of an instance-decl binding. Why? Because the binding is zapped
730 to use the method name in place of the selector name.
731 (See GHC.Tc.TyCl.Class.tcMethodBind)
732
733 The way it is now, -ddump-xx output may look confusing, but
734 you can always say -dppr-debug to get the uniques.
735
736 However, we *do* have to zap the first character to be lower case,
737 because overloaded constructors (blarg) generate methods too.
738 And convert to VarName space
739
740 e.g. a call to constructor MkFoo where
741 data (Ord a) => Foo a = MkFoo a
742
743 If this is necessary, we do it by prefixing '$m'. These
744 guys never show up in error messages. What a hack.
745 -}
746
747 mkMethodOcc :: OccName -> OccName
748 mkMethodOcc occ@(OccName VarName _) = occ
749 mkMethodOcc occ = mk_simple_deriv varName "$m" occ
750
751 {-
752 ************************************************************************
753 * *
754 \subsection{Tidying them up}
755 * *
756 ************************************************************************
757
758 Before we print chunks of code we like to rename it so that
759 we don't have to print lots of silly uniques in it. But we mustn't
760 accidentally introduce name clashes! So the idea is that we leave the
761 OccName alone unless it accidentally clashes with one that is already
762 in scope; if so, we tack on '1' at the end and try again, then '2', and
763 so on till we find a unique one.
764
765 There's a wrinkle for operators. Consider '>>='. We can't use '>>=1'
766 because that isn't a single lexeme. So we encode it to 'lle' and *then*
767 tack on the '1', if necessary.
768
769 Note [TidyOccEnv]
770 ~~~~~~~~~~~~~~~~~
771 type TidyOccEnv = UniqFM Int
772
773 * Domain = The OccName's FastString. These FastStrings are "taken";
774 make sure that we don't re-use
775
776 * Int, n = A plausible starting point for new guesses
777 There is no guarantee that "FSn" is available;
778 you must look that up in the TidyOccEnv. But
779 it's a good place to start looking.
780
781 * When looking for a renaming for "foo2" we strip off the "2" and start
782 with "foo". Otherwise if we tidy twice we get silly names like foo23.
783
784 However, if it started with digits at the end, we always make a name
785 with digits at the end, rather than shortening "foo2" to just "foo",
786 even if "foo" is unused. Reasons:
787 - Plain "foo" might be used later
788 - We use trailing digits to subtly indicate a unification variable
789 in typechecker error message; see TypeRep.tidyTyVarBndr
790
791 We have to take care though! Consider a machine-generated module (#10370)
792 module Foo where
793 a1 = e1
794 a2 = e2
795 ...
796 a2000 = e2000
797 Then "a1", "a2" etc are all marked taken. But now if we come across "a7" again,
798 we have to do a linear search to find a free one, "a2001". That might just be
799 acceptable once. But if we now come across "a8" again, we don't want to repeat
800 that search.
801
802 So we use the TidyOccEnv mapping for "a" (not "a7" or "a8") as our base for
803 starting the search; and we make sure to update the starting point for "a"
804 after we allocate a new one.
805
806
807 Note [Tidying multiple names at once]
808 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
809
810 Consider
811
812 > :t (id,id,id)
813
814 Every id contributes a type variable to the type signature, and all of them are
815 "a". If we tidy them one by one, we get
816
817 (id,id,id) :: (a2 -> a2, a1 -> a1, a -> a)
818
819 which is a bit unfortunate, as it unfairly renames only two of them. What we
820 would like to see is
821
822 (id,id,id) :: (a3 -> a3, a2 -> a2, a1 -> a1)
823
824 To achieve this, the function avoidClashesOccEnv can be used to prepare the
825 TidyEnv, by “blocking” every name that occurs twice in the map. This way, none
826 of the "a"s will get the privilege of keeping this name, and all of them will
827 get a suitable number by tidyOccName.
828
829 This prepared TidyEnv can then be used with tidyOccName. See tidyTyCoVarBndrs
830 for an example where this is used.
831
832 This is #12382.
833
834 -}
835
836 type TidyOccEnv = UniqFM FastString Int -- The in-scope OccNames
837 -- See Note [TidyOccEnv]
838
839 emptyTidyOccEnv :: TidyOccEnv
840 emptyTidyOccEnv = emptyUFM
841
842 initTidyOccEnv :: [OccName] -> TidyOccEnv -- Initialise with names to avoid!
843 initTidyOccEnv = foldl' add emptyUFM
844 where
845 add env (OccName _ fs) = addToUFM env fs 1
846
847 delTidyOccEnvList :: TidyOccEnv -> [FastString] -> TidyOccEnv
848 delTidyOccEnvList = delListFromUFM
849
850 -- see Note [Tidying multiple names at once]
851 avoidClashesOccEnv :: TidyOccEnv -> [OccName] -> TidyOccEnv
852 avoidClashesOccEnv env occs = go env emptyUFM occs
853 where
854 go env _ [] = env
855 go env seenOnce ((OccName _ fs):occs)
856 | fs `elemUFM` env = go env seenOnce occs
857 | fs `elemUFM` seenOnce = go (addToUFM env fs 1) seenOnce occs
858 | otherwise = go env (addToUFM seenOnce fs ()) occs
859
860 tidyOccName :: TidyOccEnv -> OccName -> (TidyOccEnv, OccName)
861 tidyOccName env occ@(OccName occ_sp fs)
862 | not (fs `elemUFM` env)
863 = -- Desired OccName is free, so use it,
864 -- and record in 'env' that it's no longer available
865 (addToUFM env fs 1, occ)
866
867 | otherwise
868 = case lookupUFM env base1 of
869 Nothing -> (addToUFM env base1 2, OccName occ_sp base1)
870 Just n -> find 1 n
871 where
872 base :: String -- Drop trailing digits (see Note [TidyOccEnv])
873 base = dropWhileEndLE isDigit (unpackFS fs)
874 base1 = mkFastString (base ++ "1")
875
876 find !k !n
877 = case lookupUFM env new_fs of
878 Just {} -> find (k+1 :: Int) (n+k)
879 -- By using n+k, the n argument to find goes
880 -- 1, add 1, add 2, add 3, etc which
881 -- moves at quadratic speed through a dense patch
882
883 Nothing -> (new_env, OccName occ_sp new_fs)
884 where
885 new_fs = mkFastString (base ++ show n)
886 new_env = addToUFM (addToUFM env new_fs 1) base1 (n+1)
887 -- Update: base1, so that next time we'll start where we left off
888 -- new_fs, so that we know it is taken
889 -- If they are the same (n==1), the former wins
890 -- See Note [TidyOccEnv]
891
892
893 {-
894 ************************************************************************
895 * *
896 Binary instance
897 Here rather than in GHC.Iface.Binary because OccName is abstract
898 * *
899 ************************************************************************
900 -}
901
902 instance Binary NameSpace where
903 put_ bh VarName =
904 putByte bh 0
905 put_ bh DataName =
906 putByte bh 1
907 put_ bh TvName =
908 putByte bh 2
909 put_ bh TcClsName =
910 putByte bh 3
911 get bh = do
912 h <- getByte bh
913 case h of
914 0 -> return VarName
915 1 -> return DataName
916 2 -> return TvName
917 _ -> return TcClsName
918
919 instance Binary OccName where
920 put_ bh (OccName aa ab) = do
921 put_ bh aa
922 put_ bh ab
923 get bh = do
924 aa <- get bh
925 ab <- get bh
926 return (OccName aa ab)