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