1 {-% DrIFT (Automatic class derivations for Haskell) v1.1 %-}
3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
6 \section[OccName]{@OccName@}
10 -- * The NameSpace type; abstact
11 NameSpace, tcName, clsName, tcClsName, dataName, varName,
15 pprNameSpace, pprNonVarNameSpace, pprNameSpaceBrief,
18 OccName, -- Abstract, instance of Outputable
22 mkOccName, mkOccNameFS,
29 -- ** Derived OccNames
30 mkDataConWrapperOcc, mkWorkerOcc, mkDefaultMethodOcc, mkDerivedTyConOcc,
32 mkClassTyConOcc, mkClassDataConOcc, mkDictOcc, mkIPOcc,
33 mkSpecOcc, mkForeignExportOcc, mkGenOcc1, mkGenOcc2,
34 mkDataTOcc, mkDataCOcc, mkDataConWorkerOcc,
35 mkSuperDictSelOcc, mkLocalOcc, mkMethodOcc,
38 occNameFS, occNameString, occNameSpace,
40 isVarOcc, isTvOcc, isTcOcc, isDataOcc, isDataSymOcc, isSymOcc, isValOcc,
41 parenSymOcc, reportIfUnused, isTcClsName, isVarName,
46 OccEnv, emptyOccEnv, unitOccEnv, extendOccEnv, mapOccEnv,
47 lookupOccEnv, mkOccEnv, extendOccEnvList, elemOccEnv,
48 occEnvElts, foldOccEnv, plusOccEnv, plusOccEnv_C, extendOccEnv_C,
51 OccSet, emptyOccSet, unitOccSet, mkOccSet, extendOccSet,
53 unionOccSets, unionManyOccSets, minusOccSet, elemOccSet, occSetElts,
54 foldOccSet, isEmptyOccSet, intersectOccSet, intersectsOccSet,
57 TidyOccEnv, emptyTidyOccEnv, tidyOccName, initTidyOccEnv,
59 -- The basic form of names
60 isLexCon, isLexVar, isLexId, isLexSym,
61 isLexConId, isLexConSym, isLexVarId, isLexVarSym,
62 startsVarSym, startsVarId, startsConSym, startsConId
65 #include "HsVersions.h"
67 import Util ( thenCmp )
68 import Unique ( Unique, mkUnique, Uniquable(..) )
69 import BasicTypes ( Boxity(..), Arity )
70 import StaticFlags ( opt_PprStyle_Debug )
79 import Data.Char ( isUpper, isLower, ord )
81 -- Unicode TODO: put isSymbol in libcompat
82 #if __GLASGOW_HASKELL__ > 604
83 import Data.Char ( isSymbol )
85 isSymbol = const False
90 %************************************************************************
92 \subsection{Name space}
94 %************************************************************************
97 data NameSpace = VarName -- Variables, including "source" data constructors
98 | DataName -- "Real" data constructors
99 | TvName -- Type variables
100 | TcClsName -- Type constructors and classes; Haskell has them
101 -- in the same name space for now.
103 {-! derive: Binary !-}
105 -- Note [Data Constructors]
106 -- see also: Note [Data Constructor Naming] in DataCon.lhs
108 -- "Source" data constructors are the data constructors mentioned
109 -- in Haskell source code
111 -- "Real" data constructors are the data constructors of the
112 -- representation type, which may not be the same as the source
116 -- data T = T !(Int,Int)
118 -- The source datacon has type (Int,Int) -> T
119 -- The real datacon has type Int -> Int -> T
120 -- GHC chooses a representation based on the strictness etc.
123 -- Though type constructors and classes are in the same name space now,
124 -- the NameSpace type is abstract, so we can easily separate them later
125 tcName = TcClsName -- Type constructors
126 clsName = TcClsName -- Classes
127 tcClsName = TcClsName -- Not sure which!
130 srcDataName = DataName -- Haskell-source data constructors should be
131 -- in the Data name space
136 isTcClsName :: NameSpace -> Bool
137 isTcClsName TcClsName = True
138 isTcClsName _ = False
140 isVarName :: NameSpace -> Bool -- Variables or type variables, but not constructors
141 isVarName TvName = True
142 isVarName VarName = True
143 isVarName other = False
145 pprNameSpace :: NameSpace -> SDoc
146 pprNameSpace DataName = ptext SLIT("data constructor")
147 pprNameSpace VarName = ptext SLIT("variable")
148 pprNameSpace TvName = ptext SLIT("type variable")
149 pprNameSpace TcClsName = ptext SLIT("type constructor or class")
151 pprNonVarNameSpace :: NameSpace -> SDoc
152 pprNonVarNameSpace VarName = empty
153 pprNonVarNameSpace ns = pprNameSpace ns
155 pprNameSpaceBrief DataName = char 'd'
156 pprNameSpaceBrief VarName = char 'v'
157 pprNameSpaceBrief TvName = ptext SLIT("tv")
158 pprNameSpaceBrief TcClsName = ptext SLIT("tc")
162 %************************************************************************
164 \subsection[Name-pieces-datatypes]{The @OccName@ datatypes}
166 %************************************************************************
169 data OccName = OccName
170 { occNameSpace :: !NameSpace
171 , occNameFS :: !FastString
177 instance Eq OccName where
178 (OccName sp1 s1) == (OccName sp2 s2) = s1 == s2 && sp1 == sp2
180 instance Ord OccName where
181 compare (OccName sp1 s1) (OccName sp2 s2) = (s1 `compare` s2) `thenCmp`
186 %************************************************************************
188 \subsection{Printing}
190 %************************************************************************
193 instance Outputable OccName where
196 pprOccName :: OccName -> SDoc
197 pprOccName (OccName sp occ)
198 = getPprStyle $ \ sty ->
200 then ftext (zEncodeFS occ)
201 else ftext occ <> if debugStyle sty
202 then braces (pprNameSpaceBrief sp)
207 %************************************************************************
209 \subsection{Construction}
211 %************************************************************************
214 mkOccName :: NameSpace -> String -> OccName
215 mkOccName occ_sp str = OccName occ_sp (mkFastString str)
217 mkOccNameFS :: NameSpace -> FastString -> OccName
218 mkOccNameFS occ_sp fs = OccName occ_sp fs
220 mkVarOcc :: String -> OccName
221 mkVarOcc s = mkOccName varName s
223 mkVarOccFS :: FastString -> OccName
224 mkVarOccFS fs = mkOccNameFS varName fs
226 mkTyVarOcc :: FastString -> OccName
227 mkTyVarOcc fs = mkOccNameFS tvName fs
231 %************************************************************************
235 %************************************************************************
237 OccEnvs are used mainly for the envts in ModIfaces.
239 They are efficient, because FastStrings have unique Int# keys. We assume
240 this key is less than 2^24, so we can make a Unique using
241 mkUnique ns key :: Unique
242 where 'ns' is a Char reprsenting the name space. This in turn makes it
243 easy to build an OccEnv.
246 instance Uniquable OccName where
247 getUnique (OccName ns fs)
248 = mkUnique char (I# (uniqueOfFS fs))
249 where -- See notes above about this getUnique function
256 type OccEnv a = UniqFM a
258 emptyOccEnv :: OccEnv a
259 unitOccEnv :: OccName -> a -> OccEnv a
260 extendOccEnv :: OccEnv a -> OccName -> a -> OccEnv a
261 extendOccEnvList :: OccEnv a -> [(OccName, a)] -> OccEnv a
262 lookupOccEnv :: OccEnv a -> OccName -> Maybe a
263 mkOccEnv :: [(OccName,a)] -> OccEnv a
264 elemOccEnv :: OccName -> OccEnv a -> Bool
265 foldOccEnv :: (a -> b -> b) -> b -> OccEnv a -> b
266 occEnvElts :: OccEnv a -> [a]
267 extendOccEnv_C :: (a->a->a) -> OccEnv a -> OccName -> a -> OccEnv a
268 plusOccEnv :: OccEnv a -> OccEnv a -> OccEnv a
269 plusOccEnv_C :: (a->a->a) -> OccEnv a -> OccEnv a -> OccEnv a
270 mapOccEnv :: (a->b) -> OccEnv a -> OccEnv b
272 emptyOccEnv = emptyUFM
274 extendOccEnv = addToUFM
275 extendOccEnvList = addListToUFM
276 lookupOccEnv = lookupUFM
282 plusOccEnv_C = plusUFM_C
283 extendOccEnv_C = addToUFM_C
286 type OccSet = UniqFM OccName
288 emptyOccSet :: OccSet
289 unitOccSet :: OccName -> OccSet
290 mkOccSet :: [OccName] -> OccSet
291 extendOccSet :: OccSet -> OccName -> OccSet
292 extendOccSetList :: OccSet -> [OccName] -> OccSet
293 unionOccSets :: OccSet -> OccSet -> OccSet
294 unionManyOccSets :: [OccSet] -> OccSet
295 minusOccSet :: OccSet -> OccSet -> OccSet
296 elemOccSet :: OccName -> OccSet -> Bool
297 occSetElts :: OccSet -> [OccName]
298 foldOccSet :: (OccName -> b -> b) -> b -> OccSet -> b
299 isEmptyOccSet :: OccSet -> Bool
300 intersectOccSet :: OccSet -> OccSet -> OccSet
301 intersectsOccSet :: OccSet -> OccSet -> Bool
303 emptyOccSet = emptyUniqSet
304 unitOccSet = unitUniqSet
306 extendOccSet = addOneToUniqSet
307 extendOccSetList = addListToUniqSet
308 unionOccSets = unionUniqSets
309 unionManyOccSets = unionManyUniqSets
310 minusOccSet = minusUniqSet
311 elemOccSet = elementOfUniqSet
312 occSetElts = uniqSetToList
313 foldOccSet = foldUniqSet
314 isEmptyOccSet = isEmptyUniqSet
315 intersectOccSet = intersectUniqSets
316 intersectsOccSet s1 s2 = not (isEmptyOccSet (s1 `intersectOccSet` s2))
320 %************************************************************************
322 \subsection{Predicates and taking them apart}
324 %************************************************************************
327 occNameString :: OccName -> String
328 occNameString (OccName _ s) = unpackFS s
330 setOccNameSpace :: NameSpace -> OccName -> OccName
331 setOccNameSpace sp (OccName _ occ) = OccName sp occ
333 isVarOcc, isTvOcc, isDataSymOcc, isSymOcc, isTcOcc :: OccName -> Bool
335 isVarOcc (OccName VarName _) = True
336 isVarOcc other = False
338 isTvOcc (OccName TvName _) = True
339 isTvOcc other = False
341 isTcOcc (OccName TcClsName _) = True
342 isTcOcc other = False
344 isValOcc (OccName VarName _) = True
345 isValOcc (OccName DataName _) = True
346 isValOcc other = False
348 -- Data constructor operator (starts with ':', or '[]')
349 -- Pretty inefficient!
350 isDataSymOcc (OccName DataName s) = isLexConSym s
351 isDataSymOcc (OccName VarName s)
352 | isLexConSym s = pprPanic "isDataSymOcc: check me" (ppr s)
353 -- Jan06: I don't think this should happen
354 isDataSymOcc other = False
356 isDataOcc (OccName DataName _) = True
357 isDataOcc (OccName VarName s)
358 | isLexCon s = pprPanic "isDataOcc: check me" (ppr s)
359 -- Jan06: I don't think this should happen
360 isDataOcc other = False
362 -- Any operator (data constructor or variable)
363 -- Pretty inefficient!
364 isSymOcc (OccName DataName s) = isLexConSym s
365 isSymOcc (OccName TcClsName s) = isLexConSym s
366 isSymOcc (OccName VarName s) = isLexSym s
367 isSymOcc other = False
369 parenSymOcc :: OccName -> SDoc -> SDoc
370 -- Wrap parens around an operator
371 parenSymOcc occ doc | isSymOcc occ = parens doc
377 reportIfUnused :: OccName -> Bool
378 -- Haskell 98 encourages compilers to suppress warnings about
379 -- unused names in a pattern if they start with "_".
380 reportIfUnused occ = case occNameString occ of
386 %************************************************************************
388 \subsection{Making system names}
390 %************************************************************************
392 Here's our convention for splitting up the interface file name space:
394 d... dictionary identifiers
395 (local variables, so no name-clash worries)
397 $f... dict-fun identifiers (from inst decls)
398 $dm... default methods
399 $p... superclass selectors
401 :T... compiler-generated tycons for dictionaries
402 :D... ...ditto data cons
403 $sf.. specialised version of f
405 in encoded form these appear as Zdfxxx etc
407 :... keywords (export:, letrec: etc.)
408 --- I THINK THIS IS WRONG!
410 This knowledge is encoded in the following functions.
413 @mk_deriv@ generates an @OccName@ from the prefix and a string.
414 NB: The string must already be encoded!
417 mk_deriv :: NameSpace
418 -> String -- Distinguishes one sort of derived name from another
422 mk_deriv occ_sp sys_prefix str = mkOccName occ_sp (sys_prefix ++ str)
426 mkDataConWrapperOcc, mkWorkerOcc, mkDefaultMethodOcc, mkDerivedTyConOcc,
427 mkClassTyConOcc, mkClassDataConOcc, mkDictOcc, mkIPOcc,
428 mkSpecOcc, mkForeignExportOcc, mkGenOcc1, mkGenOcc2,
429 mkDataTOcc, mkDataCOcc, mkDataConWorkerOcc, mkNewTyCoOcc
430 :: OccName -> OccName
432 -- These derived variables have a prefix that no Haskell value could have
433 mkDataConWrapperOcc = mk_simple_deriv varName "$W"
434 mkWorkerOcc = mk_simple_deriv varName "$w"
435 mkDefaultMethodOcc = mk_simple_deriv varName "$dm"
436 mkDerivedTyConOcc = mk_simple_deriv tcName ":" -- The : prefix makes sure it classifies
437 mkClassTyConOcc = mk_simple_deriv tcName ":T" -- as a tycon/datacon
438 mkClassDataConOcc = mk_simple_deriv dataName ":D" -- We go straight to the "real" data con
439 -- for datacons from classes
440 mkDictOcc = mk_simple_deriv varName "$d"
441 mkIPOcc = mk_simple_deriv varName "$i"
442 mkSpecOcc = mk_simple_deriv varName "$s"
443 mkForeignExportOcc = mk_simple_deriv varName "$f"
444 mkNewTyCoOcc = mk_simple_deriv tcName "Co"
446 -- Generic derivable classes
447 mkGenOcc1 = mk_simple_deriv varName "$gfrom"
448 mkGenOcc2 = mk_simple_deriv varName "$gto"
450 -- data T = MkT ... deriving( Data ) needs defintions for
451 -- $tT :: Data.Generics.Basics.DataType
452 -- $cMkT :: Data.Generics.Basics.Constr
453 mkDataTOcc = mk_simple_deriv varName "$t"
454 mkDataCOcc = mk_simple_deriv varName "$c"
456 mk_simple_deriv sp px occ = mk_deriv sp px (occNameString occ)
458 -- Data constructor workers are made by setting the name space
459 -- of the data constructor OccName (which should be a DataName)
461 mkDataConWorkerOcc datacon_occ = setOccNameSpace varName datacon_occ
465 mkSuperDictSelOcc :: Int -- Index of superclass, eg 3
466 -> OccName -- Class, eg "Ord"
467 -> OccName -- eg "$p3Ord"
468 mkSuperDictSelOcc index cls_occ
469 = mk_deriv varName "$p" (show index ++ occNameString cls_occ)
471 mkLocalOcc :: Unique -- Unique
472 -> OccName -- Local name (e.g. "sat")
473 -> OccName -- Nice unique version ("$L23sat")
475 = mk_deriv varName ("$L" ++ show uniq) (occNameString occ)
476 -- The Unique might print with characters
477 -- that need encoding (e.g. 'z'!)
482 mkDFunOcc :: String -- Typically the class and type glommed together e.g. "OrdMaybe"
483 -- Only used in debug mode, for extra clarity
484 -> Bool -- True <=> hs-boot instance dfun
485 -> Int -- Unique index
486 -> OccName -- "$f3OrdMaybe"
488 -- In hs-boot files we make dict funs like $fx7ClsTy, which get bound to the real
489 -- thing when we compile the mother module. Reason: we don't know exactly
490 -- what the mother module will call it.
492 mkDFunOcc info_str is_boot index
493 = mk_deriv VarName prefix string
495 prefix | is_boot = "$fx"
497 string | opt_PprStyle_Debug = show index ++ info_str
498 | otherwise = show index
501 We used to add a '$m' to indicate a method, but that gives rise to bad
502 error messages from the type checker when we print the function name or pattern
503 of an instance-decl binding. Why? Because the binding is zapped
504 to use the method name in place of the selector name.
505 (See TcClassDcl.tcMethodBind)
507 The way it is now, -ddump-xx output may look confusing, but
508 you can always say -dppr-debug to get the uniques.
510 However, we *do* have to zap the first character to be lower case,
511 because overloaded constructors (blarg) generate methods too.
512 And convert to VarName space
514 e.g. a call to constructor MkFoo where
515 data (Ord a) => Foo a = MkFoo a
517 If this is necessary, we do it by prefixing '$m'. These
518 guys never show up in error messages. What a hack.
521 mkMethodOcc :: OccName -> OccName
522 mkMethodOcc occ@(OccName VarName fs) = occ
523 mkMethodOcc occ = mk_simple_deriv varName "$m" occ
527 %************************************************************************
529 \subsection{Tidying them up}
531 %************************************************************************
533 Before we print chunks of code we like to rename it so that
534 we don't have to print lots of silly uniques in it. But we mustn't
535 accidentally introduce name clashes! So the idea is that we leave the
536 OccName alone unless it accidentally clashes with one that is already
537 in scope; if so, we tack on '1' at the end and try again, then '2', and
538 so on till we find a unique one.
540 There's a wrinkle for operators. Consider '>>='. We can't use '>>=1'
541 because that isn't a single lexeme. So we encode it to 'lle' and *then*
542 tack on the '1', if necessary.
545 type TidyOccEnv = OccEnv Int -- The in-scope OccNames
546 -- Range gives a plausible starting point for new guesses
548 emptyTidyOccEnv = emptyOccEnv
550 initTidyOccEnv :: [OccName] -> TidyOccEnv -- Initialise with names to avoid!
551 initTidyOccEnv = foldl (\env occ -> extendOccEnv env occ 1) emptyTidyOccEnv
553 tidyOccName :: TidyOccEnv -> OccName -> (TidyOccEnv, OccName)
555 tidyOccName in_scope occ@(OccName occ_sp fs)
556 = case lookupOccEnv in_scope occ of
557 Nothing -> -- Not already used: make it used
558 (extendOccEnv in_scope occ 1, occ)
560 Just n -> -- Already used: make a new guess,
561 -- change the guess base, and try again
562 tidyOccName (extendOccEnv in_scope occ (n+1))
563 (mkOccName occ_sp (unpackFS fs ++ show n))
566 %************************************************************************
568 Stuff for dealing with tuples
570 %************************************************************************
573 mkTupleOcc :: NameSpace -> Boxity -> Arity -> OccName
574 mkTupleOcc ns bx ar = OccName ns (mkFastString str)
576 -- no need to cache these, the caching is done in the caller
577 -- (TysWiredIn.mk_tuple)
579 Boxed -> '(' : commas ++ ")"
580 Unboxed -> '(' : '#' : commas ++ "#)"
582 commas = take (ar-1) (repeat ',')
584 isTupleOcc_maybe :: OccName -> Maybe (NameSpace, Boxity, Arity)
585 -- Tuples are special, because there are so many of them!
586 isTupleOcc_maybe (OccName ns fs)
587 = case unpackFS fs of
588 '(':'#':',':rest -> Just (ns, Unboxed, 2 + count_commas rest)
589 '(':',':rest -> Just (ns, Boxed, 2 + count_commas rest)
592 count_commas (',':rest) = 1 + count_commas rest
596 %************************************************************************
598 \subsection{Lexical categories}
600 %************************************************************************
602 These functions test strings to see if they fit the lexical categories
603 defined in the Haskell report.
606 isLexCon, isLexVar, isLexId, isLexSym :: FastString -> Bool
607 isLexConId, isLexConSym, isLexVarId, isLexVarSym :: FastString -> Bool
609 isLexCon cs = isLexConId cs || isLexConSym cs
610 isLexVar cs = isLexVarId cs || isLexVarSym cs
612 isLexId cs = isLexConId cs || isLexVarId cs
613 isLexSym cs = isLexConSym cs || isLexVarSym cs
617 isLexConId cs -- Prefix type or data constructors
618 | nullFS cs = False -- e.g. "Foo", "[]", "(,)"
619 | cs == FSLIT("[]") = True
620 | otherwise = startsConId (headFS cs)
622 isLexVarId cs -- Ordinary prefix identifiers
623 | nullFS cs = False -- e.g. "x", "_x"
624 | otherwise = startsVarId (headFS cs)
626 isLexConSym cs -- Infix type or data constructors
627 | nullFS cs = False -- e.g. ":-:", ":", "->"
628 | cs == FSLIT("->") = True
629 | otherwise = startsConSym (headFS cs)
631 isLexVarSym cs -- Infix identifiers
632 | nullFS cs = False -- e.g. "+"
633 | otherwise = startsVarSym (headFS cs)
636 startsVarSym, startsVarId, startsConSym, startsConId :: Char -> Bool
637 startsVarSym c = isSymbolASCII c || (ord c > 0x7f && isSymbol c) -- Infix Ids
638 startsConSym c = c == ':' -- Infix data constructors
639 startsVarId c = isLower c || c == '_' -- Ordinary Ids
640 startsConId c = isUpper c || c == '(' -- Ordinary type constructors and data constructors
642 isSymbolASCII c = c `elem` "!#$%&*+./<=>?@\\^|~-"
645 %************************************************************************
648 Here rather than BinIface because OccName is abstract
650 %************************************************************************
653 instance Binary NameSpace where
656 put_ bh DataName = do
660 put_ bh TcClsName = do
665 0 -> do return VarName
666 1 -> do return DataName
667 2 -> do return TvName
668 _ -> do return TcClsName
670 instance Binary OccName where
671 put_ bh (OccName aa ab) = do
677 return (OccName aa ab)