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,
31 mkClassTyConOcc, mkClassDataConOcc, mkDictOcc, mkIPOcc,
32 mkSpecOcc, mkForeignExportOcc, mkGenOcc1, mkGenOcc2,
33 mkDataTOcc, mkDataCOcc, mkDataConWorkerOcc,
34 mkSuperDictSelOcc, mkLocalOcc, mkMethodOcc,
37 occNameFS, occNameString, occNameSpace,
39 isVarOcc, isTvOcc, isTcOcc, isDataOcc, isDataSymOcc, isSymOcc, isValOcc,
40 parenSymOcc, reportIfUnused, isTcClsName, isVarName,
45 OccEnv, emptyOccEnv, unitOccEnv, extendOccEnv,
46 lookupOccEnv, mkOccEnv, extendOccEnvList, elemOccEnv,
47 occEnvElts, foldOccEnv, plusOccEnv, plusOccEnv_C, extendOccEnv_C,
50 OccSet, emptyOccSet, unitOccSet, mkOccSet, extendOccSet,
52 unionOccSets, unionManyOccSets, minusOccSet, elemOccSet, occSetElts,
53 foldOccSet, isEmptyOccSet, intersectOccSet, intersectsOccSet,
56 TidyOccEnv, emptyTidyOccEnv, tidyOccName, initTidyOccEnv,
58 -- The basic form of names
59 isLexCon, isLexVar, isLexId, isLexSym,
60 isLexConId, isLexConSym, isLexVarId, isLexVarSym,
61 startsVarSym, startsVarId, startsConSym, startsConId
64 #include "HsVersions.h"
66 import Util ( thenCmp )
67 import Unique ( Unique, mkUnique, Uniquable(..) )
68 import BasicTypes ( Boxity(..), Arity )
69 import StaticFlags ( opt_PprStyle_Debug )
78 import Data.Char ( isUpper, isLower, ord )
80 -- Unicode TODO: put isSymbol in libcompat
81 #if __GLASGOW_HASKELL__ > 604
82 import Data.Char ( isSymbol )
84 isSymbol = const False
89 %************************************************************************
91 \subsection{Name space}
93 %************************************************************************
96 data NameSpace = VarName -- Variables, including "source" data constructors
97 | DataName -- "Real" data constructors
98 | TvName -- Type variables
99 | TcClsName -- Type constructors and classes; Haskell has them
100 -- in the same name space for now.
102 {-! derive: Binary !-}
104 -- Note [Data Constructors]
105 -- see also: Note [Data Constructor Naming] in DataCon.lhs
107 -- "Source" data constructors are the data constructors mentioned
108 -- in Haskell source code
110 -- "Real" data constructors are the data constructors of the
111 -- representation type, which may not be the same as the source
115 -- data T = T !(Int,Int)
117 -- The source datacon has type (Int,Int) -> T
118 -- The real datacon has type Int -> Int -> T
119 -- GHC chooses a representation based on the strictness etc.
122 -- Though type constructors and classes are in the same name space now,
123 -- the NameSpace type is abstract, so we can easily separate them later
124 tcName = TcClsName -- Type constructors
125 clsName = TcClsName -- Classes
126 tcClsName = TcClsName -- Not sure which!
129 srcDataName = DataName -- Haskell-source data constructors should be
130 -- in the Data name space
135 isTcClsName :: NameSpace -> Bool
136 isTcClsName TcClsName = True
137 isTcClsName _ = False
139 isVarName :: NameSpace -> Bool -- Variables or type variables, but not constructors
140 isVarName TvName = True
141 isVarName VarName = True
142 isVarName other = False
144 pprNameSpace :: NameSpace -> SDoc
145 pprNameSpace DataName = ptext SLIT("data constructor")
146 pprNameSpace VarName = ptext SLIT("variable")
147 pprNameSpace TvName = ptext SLIT("type variable")
148 pprNameSpace TcClsName = ptext SLIT("type constructor or class")
150 pprNonVarNameSpace :: NameSpace -> SDoc
151 pprNonVarNameSpace VarName = empty
152 pprNonVarNameSpace ns = pprNameSpace ns
154 pprNameSpaceBrief DataName = char 'd'
155 pprNameSpaceBrief VarName = char 'v'
156 pprNameSpaceBrief TvName = ptext SLIT("tv")
157 pprNameSpaceBrief TcClsName = ptext SLIT("tc")
161 %************************************************************************
163 \subsection[Name-pieces-datatypes]{The @OccName@ datatypes}
165 %************************************************************************
168 data OccName = OccName
169 { occNameSpace :: !NameSpace
170 , occNameFS :: !FastString
176 instance Eq OccName where
177 (OccName sp1 s1) == (OccName sp2 s2) = s1 == s2 && sp1 == sp2
179 instance Ord OccName where
180 compare (OccName sp1 s1) (OccName sp2 s2) = (s1 `compare` s2) `thenCmp`
185 %************************************************************************
187 \subsection{Printing}
189 %************************************************************************
192 instance Outputable OccName where
195 pprOccName :: OccName -> SDoc
196 pprOccName (OccName sp occ)
197 = getPprStyle $ \ sty ->
199 then ftext (zEncodeFS occ)
200 else ftext occ <> if debugStyle sty
201 then braces (pprNameSpaceBrief sp)
206 %************************************************************************
208 \subsection{Construction}
210 %************************************************************************
213 mkOccName :: NameSpace -> String -> OccName
214 mkOccName occ_sp str = OccName occ_sp (mkFastString str)
216 mkOccNameFS :: NameSpace -> FastString -> OccName
217 mkOccNameFS occ_sp fs = OccName occ_sp fs
219 mkVarOcc :: String -> OccName
220 mkVarOcc s = mkOccName varName s
222 mkVarOccFS :: FastString -> OccName
223 mkVarOccFS fs = mkOccNameFS varName fs
225 mkTyVarOcc :: FastString -> OccName
226 mkTyVarOcc fs = mkOccNameFS tvName fs
230 %************************************************************************
234 %************************************************************************
236 OccEnvs are used mainly for the envts in ModIfaces.
238 They are efficient, because FastStrings have unique Int# keys. We assume
239 this key is less than 2^24, so we can make a Unique using
240 mkUnique ns key :: Unique
241 where 'ns' is a Char reprsenting the name space. This in turn makes it
242 easy to build an OccEnv.
245 instance Uniquable OccName where
246 getUnique (OccName ns fs)
247 = mkUnique char (I# (uniqueOfFS fs))
248 where -- See notes above about this getUnique function
255 type OccEnv a = UniqFM a
257 emptyOccEnv :: OccEnv a
258 unitOccEnv :: OccName -> a -> OccEnv a
259 extendOccEnv :: OccEnv a -> OccName -> a -> OccEnv a
260 extendOccEnvList :: OccEnv a -> [(OccName, a)] -> OccEnv a
261 lookupOccEnv :: OccEnv a -> OccName -> Maybe a
262 mkOccEnv :: [(OccName,a)] -> OccEnv a
263 elemOccEnv :: OccName -> OccEnv a -> Bool
264 foldOccEnv :: (a -> b -> b) -> b -> OccEnv a -> b
265 occEnvElts :: OccEnv a -> [a]
266 extendOccEnv_C :: (a->a->a) -> OccEnv a -> OccName -> a -> OccEnv a
267 plusOccEnv :: OccEnv a -> OccEnv a -> OccEnv a
268 plusOccEnv_C :: (a->a->a) -> OccEnv a -> OccEnv a -> OccEnv a
270 emptyOccEnv = emptyUFM
272 extendOccEnv = addToUFM
273 extendOccEnvList = addListToUFM
274 lookupOccEnv = lookupUFM
280 plusOccEnv_C = plusUFM_C
281 extendOccEnv_C = addToUFM_C
284 type OccSet = UniqFM OccName
286 emptyOccSet :: OccSet
287 unitOccSet :: OccName -> OccSet
288 mkOccSet :: [OccName] -> OccSet
289 extendOccSet :: OccSet -> OccName -> OccSet
290 extendOccSetList :: OccSet -> [OccName] -> OccSet
291 unionOccSets :: OccSet -> OccSet -> OccSet
292 unionManyOccSets :: [OccSet] -> OccSet
293 minusOccSet :: OccSet -> OccSet -> OccSet
294 elemOccSet :: OccName -> OccSet -> Bool
295 occSetElts :: OccSet -> [OccName]
296 foldOccSet :: (OccName -> b -> b) -> b -> OccSet -> b
297 isEmptyOccSet :: OccSet -> Bool
298 intersectOccSet :: OccSet -> OccSet -> OccSet
299 intersectsOccSet :: OccSet -> OccSet -> Bool
301 emptyOccSet = emptyUniqSet
302 unitOccSet = unitUniqSet
304 extendOccSet = addOneToUniqSet
305 extendOccSetList = addListToUniqSet
306 unionOccSets = unionUniqSets
307 unionManyOccSets = unionManyUniqSets
308 minusOccSet = minusUniqSet
309 elemOccSet = elementOfUniqSet
310 occSetElts = uniqSetToList
311 foldOccSet = foldUniqSet
312 isEmptyOccSet = isEmptyUniqSet
313 intersectOccSet = intersectUniqSets
314 intersectsOccSet s1 s2 = not (isEmptyOccSet (s1 `intersectOccSet` s2))
318 %************************************************************************
320 \subsection{Predicates and taking them apart}
322 %************************************************************************
325 occNameString :: OccName -> String
326 occNameString (OccName _ s) = unpackFS s
328 setOccNameSpace :: NameSpace -> OccName -> OccName
329 setOccNameSpace sp (OccName _ occ) = OccName sp occ
331 isVarOcc, isTvOcc, isDataSymOcc, isSymOcc, isTcOcc :: OccName -> Bool
333 isVarOcc (OccName VarName _) = True
334 isVarOcc other = False
336 isTvOcc (OccName TvName _) = True
337 isTvOcc other = False
339 isTcOcc (OccName TcClsName _) = True
340 isTcOcc other = False
342 isValOcc (OccName VarName _) = True
343 isValOcc (OccName DataName _) = True
344 isValOcc other = False
346 -- Data constructor operator (starts with ':', or '[]')
347 -- Pretty inefficient!
348 isDataSymOcc (OccName DataName s) = isLexConSym s
349 isDataSymOcc (OccName VarName s)
350 | isLexConSym s = pprPanic "isDataSymOcc: check me" (ppr s)
351 -- Jan06: I don't think this should happen
352 isDataSymOcc other = False
354 isDataOcc (OccName DataName _) = True
355 isDataOcc (OccName VarName s)
356 | isLexCon s = pprPanic "isDataOcc: check me" (ppr s)
357 -- Jan06: I don't think this should happen
358 isDataOcc other = False
360 -- Any operator (data constructor or variable)
361 -- Pretty inefficient!
362 isSymOcc (OccName DataName s) = isLexConSym s
363 isSymOcc (OccName TcClsName s) = isLexConSym s
364 isSymOcc (OccName VarName s) = isLexSym s
365 isSymOcc other = False
367 parenSymOcc :: OccName -> SDoc -> SDoc
368 -- Wrap parens around an operator
369 parenSymOcc occ doc | isSymOcc occ = parens doc
375 reportIfUnused :: OccName -> Bool
376 -- Haskell 98 encourages compilers to suppress warnings about
377 -- unused names in a pattern if they start with "_".
378 reportIfUnused occ = case occNameString occ of
384 %************************************************************************
386 \subsection{Making system names}
388 %************************************************************************
390 Here's our convention for splitting up the interface file name space:
392 d... dictionary identifiers
393 (local variables, so no name-clash worries)
395 $f... dict-fun identifiers (from inst decls)
396 $dm... default methods
397 $p... superclass selectors
399 :T... compiler-generated tycons for dictionaries
400 :D... ...ditto data cons
401 $sf.. specialised version of f
403 in encoded form these appear as Zdfxxx etc
405 :... keywords (export:, letrec: etc.)
406 --- I THINK THIS IS WRONG!
408 This knowledge is encoded in the following functions.
411 @mk_deriv@ generates an @OccName@ from the prefix and a string.
412 NB: The string must already be encoded!
415 mk_deriv :: NameSpace
416 -> String -- Distinguishes one sort of derived name from another
420 mk_deriv occ_sp sys_prefix str = mkOccName occ_sp (sys_prefix ++ str)
424 mkDataConWrapperOcc, mkWorkerOcc, mkDefaultMethodOcc, mkDerivedTyConOcc,
425 mkClassTyConOcc, mkClassDataConOcc, mkDictOcc, mkIPOcc,
426 mkSpecOcc, mkForeignExportOcc, mkGenOcc1, mkGenOcc2,
427 mkDataTOcc, mkDataCOcc, mkDataConWorkerOcc
428 :: OccName -> OccName
430 -- These derived variables have a prefix that no Haskell value could have
431 mkDataConWrapperOcc = mk_simple_deriv varName "$W"
432 mkWorkerOcc = mk_simple_deriv varName "$w"
433 mkDefaultMethodOcc = mk_simple_deriv varName "$dm"
434 mkDerivedTyConOcc = mk_simple_deriv tcName ":" -- The : prefix makes sure it classifies
435 mkClassTyConOcc = mk_simple_deriv tcName ":T" -- as a tycon/datacon
436 mkClassDataConOcc = mk_simple_deriv dataName ":D" -- We go straight to the "real" data con
437 -- for datacons from classes
438 mkDictOcc = mk_simple_deriv varName "$d"
439 mkIPOcc = mk_simple_deriv varName "$i"
440 mkSpecOcc = mk_simple_deriv varName "$s"
441 mkForeignExportOcc = mk_simple_deriv varName "$f"
443 -- Generic derivable classes
444 mkGenOcc1 = mk_simple_deriv varName "$gfrom"
445 mkGenOcc2 = mk_simple_deriv varName "$gto"
447 -- data T = MkT ... deriving( Data ) needs defintions for
448 -- $tT :: Data.Generics.Basics.DataType
449 -- $cMkT :: Data.Generics.Basics.Constr
450 mkDataTOcc = mk_simple_deriv varName "$t"
451 mkDataCOcc = mk_simple_deriv varName "$c"
453 mk_simple_deriv sp px occ = mk_deriv sp px (occNameString occ)
455 -- Data constructor workers are made by setting the name space
456 -- of the data constructor OccName (which should be a DataName)
458 mkDataConWorkerOcc datacon_occ = setOccNameSpace varName datacon_occ
462 mkSuperDictSelOcc :: Int -- Index of superclass, eg 3
463 -> OccName -- Class, eg "Ord"
464 -> OccName -- eg "$p3Ord"
465 mkSuperDictSelOcc index cls_occ
466 = mk_deriv varName "$p" (show index ++ occNameString cls_occ)
468 mkLocalOcc :: Unique -- Unique
469 -> OccName -- Local name (e.g. "sat")
470 -> OccName -- Nice unique version ("$L23sat")
472 = mk_deriv varName ("$L" ++ show uniq) (occNameString occ)
473 -- The Unique might print with characters
474 -- that need encoding (e.g. 'z'!)
479 mkDFunOcc :: String -- Typically the class and type glommed together e.g. "OrdMaybe"
480 -- Only used in debug mode, for extra clarity
481 -> Bool -- True <=> hs-boot instance dfun
482 -> Int -- Unique index
483 -> OccName -- "$f3OrdMaybe"
485 -- In hs-boot files we make dict funs like $fx7ClsTy, which get bound to the real
486 -- thing when we compile the mother module. Reason: we don't know exactly
487 -- what the mother module will call it.
489 mkDFunOcc info_str is_boot index
490 = mk_deriv VarName prefix string
492 prefix | is_boot = "$fx"
494 string | opt_PprStyle_Debug = show index ++ info_str
495 | otherwise = show index
498 We used to add a '$m' to indicate a method, but that gives rise to bad
499 error messages from the type checker when we print the function name or pattern
500 of an instance-decl binding. Why? Because the binding is zapped
501 to use the method name in place of the selector name.
502 (See TcClassDcl.tcMethodBind)
504 The way it is now, -ddump-xx output may look confusing, but
505 you can always say -dppr-debug to get the uniques.
507 However, we *do* have to zap the first character to be lower case,
508 because overloaded constructors (blarg) generate methods too.
509 And convert to VarName space
511 e.g. a call to constructor MkFoo where
512 data (Ord a) => Foo a = MkFoo a
514 If this is necessary, we do it by prefixing '$m'. These
515 guys never show up in error messages. What a hack.
518 mkMethodOcc :: OccName -> OccName
519 mkMethodOcc occ@(OccName VarName fs) = occ
520 mkMethodOcc occ = mk_simple_deriv varName "$m" occ
524 %************************************************************************
526 \subsection{Tidying them up}
528 %************************************************************************
530 Before we print chunks of code we like to rename it so that
531 we don't have to print lots of silly uniques in it. But we mustn't
532 accidentally introduce name clashes! So the idea is that we leave the
533 OccName alone unless it accidentally clashes with one that is already
534 in scope; if so, we tack on '1' at the end and try again, then '2', and
535 so on till we find a unique one.
537 There's a wrinkle for operators. Consider '>>='. We can't use '>>=1'
538 because that isn't a single lexeme. So we encode it to 'lle' and *then*
539 tack on the '1', if necessary.
542 type TidyOccEnv = OccEnv Int -- The in-scope OccNames
543 -- Range gives a plausible starting point for new guesses
545 emptyTidyOccEnv = emptyOccEnv
547 initTidyOccEnv :: [OccName] -> TidyOccEnv -- Initialise with names to avoid!
548 initTidyOccEnv = foldl (\env occ -> extendOccEnv env occ 1) emptyTidyOccEnv
550 tidyOccName :: TidyOccEnv -> OccName -> (TidyOccEnv, OccName)
552 tidyOccName in_scope occ@(OccName occ_sp fs)
553 = case lookupOccEnv in_scope occ of
554 Nothing -> -- Not already used: make it used
555 (extendOccEnv in_scope occ 1, occ)
557 Just n -> -- Already used: make a new guess,
558 -- change the guess base, and try again
559 tidyOccName (extendOccEnv in_scope occ (n+1))
560 (mkOccName occ_sp (unpackFS fs ++ show n))
563 %************************************************************************
565 Stuff for dealing with tuples
567 %************************************************************************
570 mkTupleOcc :: NameSpace -> Boxity -> Arity -> OccName
571 mkTupleOcc ns bx ar = OccName ns (mkFastString str)
573 -- no need to cache these, the caching is done in the caller
574 -- (TysWiredIn.mk_tuple)
576 Boxed -> '(' : commas ++ ")"
577 Unboxed -> '(' : '#' : commas ++ "#)"
579 commas = take (ar-1) (repeat ',')
581 isTupleOcc_maybe :: OccName -> Maybe (NameSpace, Boxity, Arity)
582 -- Tuples are special, because there are so many of them!
583 isTupleOcc_maybe (OccName ns fs)
584 = case unpackFS fs of
585 '(':'#':',':rest -> Just (ns, Unboxed, 2 + count_commas rest)
586 '(':',':rest -> Just (ns, Boxed, 2 + count_commas rest)
589 count_commas (',':rest) = 1 + count_commas rest
593 %************************************************************************
595 \subsection{Lexical categories}
597 %************************************************************************
599 These functions test strings to see if they fit the lexical categories
600 defined in the Haskell report.
603 isLexCon, isLexVar, isLexId, isLexSym :: FastString -> Bool
604 isLexConId, isLexConSym, isLexVarId, isLexVarSym :: FastString -> Bool
606 isLexCon cs = isLexConId cs || isLexConSym cs
607 isLexVar cs = isLexVarId cs || isLexVarSym cs
609 isLexId cs = isLexConId cs || isLexVarId cs
610 isLexSym cs = isLexConSym cs || isLexVarSym cs
614 isLexConId cs -- Prefix type or data constructors
615 | nullFS cs = False -- e.g. "Foo", "[]", "(,)"
616 | cs == FSLIT("[]") = True
617 | otherwise = startsConId (headFS cs)
619 isLexVarId cs -- Ordinary prefix identifiers
620 | nullFS cs = False -- e.g. "x", "_x"
621 | otherwise = startsVarId (headFS cs)
623 isLexConSym cs -- Infix type or data constructors
624 | nullFS cs = False -- e.g. ":-:", ":", "->"
625 | cs == FSLIT("->") = True
626 | otherwise = startsConSym (headFS cs)
628 isLexVarSym cs -- Infix identifiers
629 | nullFS cs = False -- e.g. "+"
630 | otherwise = startsVarSym (headFS cs)
633 startsVarSym, startsVarId, startsConSym, startsConId :: Char -> Bool
634 startsVarSym c = isSymbolASCII c || (ord c > 0x7f && isSymbol c) -- Infix Ids
635 startsConSym c = c == ':' -- Infix data constructors
636 startsVarId c = isLower c || c == '_' -- Ordinary Ids
637 startsConId c = isUpper c || c == '(' -- Ordinary type constructors and data constructors
639 isSymbolASCII c = c `elem` "!#$%&*+./<=>?@\\^|~-"
642 %************************************************************************
645 Here rather than BinIface because OccName is abstract
647 %************************************************************************
650 instance Binary NameSpace where
653 put_ bh DataName = do
657 put_ bh TcClsName = do
662 0 -> do return VarName
663 1 -> do return DataName
664 2 -> do return TvName
665 _ -> do return TcClsName
667 instance Binary OccName where
668 put_ bh (OccName aa ab) = do
674 return (OccName aa ab)