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,
12 tvName, srcDataName, nameSpaceString,
15 OccName, -- Abstract, instance of Outputable
19 OccEnv, emptyOccEnv, unitOccEnv, extendOccEnv,
20 lookupOccEnv, mkOccEnv, extendOccEnvList, elemOccEnv,
21 occEnvElts, foldOccEnv, plusOccEnv, plusOccEnv_C, extendOccEnv_C,
25 OccSet, emptyOccSet, unitOccSet, mkOccSet, extendOccSet, extendOccSetList,
26 unionOccSets, unionManyOccSets, minusOccSet, elemOccSet, occSetElts,
27 foldOccSet, isEmptyOccSet, intersectOccSet, intersectsOccSet,
29 mkOccName, mkOccFS, mkSysOcc, mkSysOccFS, mkFCallOcc, mkKindOccFS,
30 mkVarOcc, mkVarOccEncoded,
31 mkSuperDictSelOcc, mkDFunOcc, mkForeignExportOcc,
32 mkDictOcc, mkIPOcc, mkWorkerOcc, mkMethodOcc, mkDefaultMethodOcc,
33 mkDerivedTyConOcc, mkClassTyConOcc, mkClassDataConOcc, mkSpecOcc,
34 mkGenOcc1, mkGenOcc2, mkLocalOcc, mkDataTOcc, mkDataCOcc,
35 mkDataConWrapperOcc, mkDataConWorkerOcc,
37 isVarOcc, isTvOcc, isTcOcc, isDataOcc, isDataSymOcc, isSymOcc, isValOcc,
38 parenSymOcc, reportIfUnused,
40 occNameFS, occNameString, occNameUserString, occNameSpace,
41 occNameFlavour, briefOccNameFlavour,
44 mkTupleOcc, isTupleOcc_maybe,
47 TidyOccEnv, emptyTidyOccEnv, tidyOccName, initTidyOccEnv,
50 EncodedString, EncodedFS, UserString, UserFS, encode, encodeFS, decode, pprEncodedFS,
52 -- The basic form of names
53 isLexCon, isLexVar, isLexId, isLexSym,
54 isLexConId, isLexConSym, isLexVarId, isLexVarSym,
55 isLowerISO, isUpperISO
59 #include "HsVersions.h"
61 import Char ( isDigit, isUpper, isLower, isAlphaNum, ord, chr, digitToInt )
62 import Util ( thenCmp )
63 import Unique ( Unique, mkUnique, Uniquable(..) )
64 import BasicTypes ( Boxity(..), Arity )
74 We hold both module names and identifier names in a 'Z-encoded' form
75 that makes them acceptable both as a C identifier and as a Haskell
78 They can always be decoded again when printing error messages
79 or anything else for the user, but it does make sense for it
80 to be represented here in encoded form, so that when generating
81 code the encoding operation is not performed on each occurrence.
83 These type synonyms help documentation.
86 type UserFS = FastString -- As the user typed it
87 type EncodedFS = FastString -- Encoded form
89 type UserString = String -- As the user typed it
90 type EncodedString = String -- Encoded form
93 pprEncodedFS :: EncodedFS -> SDoc
95 = getPprStyle $ \ sty ->
97 -- ftext (decodeFS fs) would needlessly pack the string again
98 then text (decode (unpackFS fs))
102 %************************************************************************
104 \subsection{Name space}
106 %************************************************************************
109 data NameSpace = VarName -- Variables, including "source" data constructors
110 | DataName -- "Real" data constructors
111 | TvName -- Type variables
112 | TcClsName -- Type constructors and classes; Haskell has them
113 -- in the same name space for now.
115 {-! derive: Binary !-}
117 -- Note [Data Constructors]
118 -- see also: Note [Data Constructor Naming] in DataCon.lhs
120 -- "Source" data constructors are the data constructors mentioned
121 -- in Haskell source code
123 -- "Real" data constructors are the data constructors of the
124 -- representation type, which may not be the same as the source
128 -- data T = T !(Int,Int)
130 -- The source datacon has type (Int,Int) -> T
131 -- The real datacon has type Int -> Int -> T
132 -- GHC chooses a representation based on the strictness etc.
135 -- Though type constructors and classes are in the same name space now,
136 -- the NameSpace type is abstract, so we can easily separate them later
137 tcName = TcClsName -- Type constructors
138 clsName = TcClsName -- Classes
139 tcClsName = TcClsName -- Not sure which!
142 srcDataName = DataName -- Haskell-source data constructors should be
143 -- in the Data name space
148 nameSpaceString :: NameSpace -> String
149 nameSpaceString DataName = "Data constructor"
150 nameSpaceString VarName = "Variable"
151 nameSpaceString TvName = "Type variable"
152 nameSpaceString TcClsName = "Type constructor or class"
156 %************************************************************************
158 \subsection[Name-pieces-datatypes]{The @OccName@ datatypes}
160 %************************************************************************
163 data OccName = OccName
166 {-! derive : Binary !-}
171 instance Eq OccName where
172 (OccName sp1 s1) == (OccName sp2 s2) = s1 == s2 && sp1 == sp2
174 instance Ord OccName where
175 compare (OccName sp1 s1) (OccName sp2 s2) = (s1 `compare` s2) `thenCmp`
180 %************************************************************************
182 \subsection{Printing}
184 %************************************************************************
187 instance Outputable OccName where
190 pprOccName :: OccName -> SDoc
191 pprOccName (OccName sp occ)
192 = getPprStyle $ \ sty ->
193 pprEncodedFS occ <> if debugStyle sty then
194 braces (text (briefNameSpaceFlavour sp))
199 %************************************************************************
201 \subsection{Construction}
203 %*****p*******************************************************************
205 *Sys* things do no encoding; the caller should ensure that the thing is
209 mkSysOcc :: NameSpace -> EncodedString -> OccName
210 mkSysOcc occ_sp str = ASSERT2( alreadyEncoded str, text str )
211 OccName occ_sp (mkFastString str)
213 mkSysOccFS :: NameSpace -> EncodedFS -> OccName
214 mkSysOccFS occ_sp fs = ASSERT2( alreadyEncodedFS fs, ppr fs )
217 mkFCallOcc :: EncodedString -> OccName
218 -- This version of mkSysOcc doesn't check that the string is already encoded,
219 -- because it will be something like "{__ccall f dyn Int# -> Int#}"
220 -- This encodes a lot into something that then parses like an Id.
221 -- But then alreadyEncoded complains about the braces!
222 mkFCallOcc str = OccName varName (mkFastString str)
224 -- Kind constructors get a special function. Uniquely, they are not encoded,
225 -- so that they have names like '*'. This means that *even in interface files*
226 -- we'll get kinds like (* -> (* -> *)). We can't use mkSysOcc because it
227 -- has an ASSERT that doesn't hold.
228 mkKindOccFS :: NameSpace -> EncodedFS -> OccName
229 mkKindOccFS occ_sp fs = OccName occ_sp fs
232 *Source-code* things are encoded.
235 mkOccFS :: NameSpace -> UserFS -> OccName
236 mkOccFS occ_sp fs = mkSysOccFS occ_sp (encodeFS fs)
238 mkOccName :: NameSpace -> String -> OccName
239 mkOccName ns s = mkSysOcc ns (encode s)
241 mkVarOcc :: UserFS -> OccName
242 mkVarOcc fs = mkSysOccFS varName (encodeFS fs)
244 mkVarOccEncoded :: EncodedFS -> OccName
245 mkVarOccEncoded fs = mkSysOccFS varName fs
250 %************************************************************************
254 %************************************************************************
256 OccEnvs are used mainly for the envts in ModIfaces.
258 They are efficient, because FastStrings have unique Int# keys. We assume
259 this key is less than 2^24, so we can make a Unique using
260 mkUnique ns key :: Unique
261 where 'ns' is a Char reprsenting the name space. This in turn makes it
262 easy to build an OccEnv.
265 instance Uniquable OccName where
266 getUnique (OccName ns fs)
267 = mkUnique char (I# (uniqueOfFS fs))
268 where -- See notes above about this getUnique function
275 type OccEnv a = UniqFM a
277 emptyOccEnv :: OccEnv a
278 unitOccEnv :: OccName -> a -> OccEnv a
279 extendOccEnv :: OccEnv a -> OccName -> a -> OccEnv a
280 extendOccEnvList :: OccEnv a -> [(OccName, a)] -> OccEnv a
281 lookupOccEnv :: OccEnv a -> OccName -> Maybe a
282 mkOccEnv :: [(OccName,a)] -> OccEnv a
283 elemOccEnv :: OccName -> OccEnv a -> Bool
284 foldOccEnv :: (a -> b -> b) -> b -> OccEnv a -> b
285 occEnvElts :: OccEnv a -> [a]
286 extendOccEnv_C :: (a->a->a) -> OccEnv a -> OccName -> a -> OccEnv a
287 plusOccEnv :: OccEnv a -> OccEnv a -> OccEnv a
288 plusOccEnv_C :: (a->a->a) -> OccEnv a -> OccEnv a -> OccEnv a
290 emptyOccEnv = emptyUFM
292 extendOccEnv = addToUFM
293 extendOccEnvList = addListToUFM
294 lookupOccEnv = lookupUFM
300 plusOccEnv_C = plusUFM_C
301 extendOccEnv_C = addToUFM_C
304 type OccSet = UniqFM OccName
306 emptyOccSet :: OccSet
307 unitOccSet :: OccName -> OccSet
308 mkOccSet :: [OccName] -> OccSet
309 extendOccSet :: OccSet -> OccName -> OccSet
310 extendOccSetList :: OccSet -> [OccName] -> OccSet
311 unionOccSets :: OccSet -> OccSet -> OccSet
312 unionManyOccSets :: [OccSet] -> OccSet
313 minusOccSet :: OccSet -> OccSet -> OccSet
314 elemOccSet :: OccName -> OccSet -> Bool
315 occSetElts :: OccSet -> [OccName]
316 foldOccSet :: (OccName -> b -> b) -> b -> OccSet -> b
317 isEmptyOccSet :: OccSet -> Bool
318 intersectOccSet :: OccSet -> OccSet -> OccSet
319 intersectsOccSet :: OccSet -> OccSet -> Bool
321 emptyOccSet = emptyUniqSet
322 unitOccSet = unitUniqSet
324 extendOccSet = addOneToUniqSet
325 extendOccSetList = addListToUniqSet
326 unionOccSets = unionUniqSets
327 unionManyOccSets = unionManyUniqSets
328 minusOccSet = minusUniqSet
329 elemOccSet = elementOfUniqSet
330 occSetElts = uniqSetToList
331 foldOccSet = foldUniqSet
332 isEmptyOccSet = isEmptyUniqSet
333 intersectOccSet = intersectUniqSets
334 intersectsOccSet s1 s2 = not (isEmptyOccSet (s1 `intersectOccSet` s2))
338 %************************************************************************
340 \subsection{Predicates and taking them apart}
342 %************************************************************************
345 occNameFS :: OccName -> EncodedFS
346 occNameFS (OccName _ s) = s
348 occNameString :: OccName -> EncodedString
349 occNameString (OccName _ s) = unpackFS s
351 occNameUserString :: OccName -> UserString
352 occNameUserString occ = decode (occNameString occ)
354 occNameSpace :: OccName -> NameSpace
355 occNameSpace (OccName sp _) = sp
357 setOccNameSpace :: NameSpace -> OccName -> OccName
358 setOccNameSpace sp (OccName _ occ) = OccName sp occ
360 -- occNameFlavour is used only to generate good error messages
361 occNameFlavour :: OccName -> SDoc
362 occNameFlavour (OccName DataName _) = ptext SLIT("data constructor")
363 occNameFlavour (OccName TvName _) = ptext SLIT("type variable")
364 occNameFlavour (OccName TcClsName _) = ptext SLIT("type constructor or class")
365 occNameFlavour (OccName VarName s) = empty
367 -- briefOccNameFlavour is used in debug-printing of names
368 briefOccNameFlavour :: OccName -> String
369 briefOccNameFlavour (OccName sp _) = briefNameSpaceFlavour sp
371 briefNameSpaceFlavour DataName = "d"
372 briefNameSpaceFlavour VarName = "v"
373 briefNameSpaceFlavour TvName = "tv"
374 briefNameSpaceFlavour TcClsName = "tc"
378 isVarOcc, isTvOcc, isDataSymOcc, isSymOcc, isTcOcc :: OccName -> Bool
380 isVarOcc (OccName VarName _) = True
381 isVarOcc other = False
383 isTvOcc (OccName TvName _) = True
384 isTvOcc other = False
386 isTcOcc (OccName TcClsName _) = True
387 isTcOcc other = False
389 isValOcc (OccName VarName _) = True
390 isValOcc (OccName DataName _) = True
391 isValOcc other = False
393 -- Data constructor operator (starts with ':', or '[]')
394 -- Pretty inefficient!
395 isDataSymOcc (OccName DataName s) = isLexConSym (decodeFS s)
396 isDataSymOcc (OccName VarName s) = isLexConSym (decodeFS s)
397 isDataSymOcc other = False
399 isDataOcc (OccName DataName _) = True
400 isDataOcc (OccName VarName s) = isLexCon (decodeFS s)
401 isDataOcc other = False
403 -- Any operator (data constructor or variable)
404 -- Pretty inefficient!
405 isSymOcc (OccName DataName s) = isLexConSym (decodeFS s)
406 isSymOcc (OccName TcClsName s) = isLexConSym (decodeFS s)
407 isSymOcc (OccName VarName s) = isLexSym (decodeFS s)
408 isSymOcc other = False
410 parenSymOcc :: OccName -> SDoc -> SDoc
411 -- Wrap parens around an operator
412 parenSymOcc occ doc | isSymOcc occ = parens doc
418 reportIfUnused :: OccName -> Bool
419 -- Haskell 98 encourages compilers to suppress warnings about
420 -- unused names in a pattern if they start with "_".
421 reportIfUnused occ = case occNameUserString occ of
428 %************************************************************************
430 \subsection{Making system names}
432 %************************************************************************
434 Here's our convention for splitting up the interface file name space:
436 d... dictionary identifiers
437 (local variables, so no name-clash worries)
439 $f... dict-fun identifiers (from inst decls)
440 $dm... default methods
441 $p... superclass selectors
443 :T... compiler-generated tycons for dictionaries
444 :D... ...ditto data cons
445 $sf.. specialised version of f
447 in encoded form these appear as Zdfxxx etc
449 :... keywords (export:, letrec: etc.)
450 --- I THINK THIS IS WRONG!
452 This knowledge is encoded in the following functions.
455 @mk_deriv@ generates an @OccName@ from the prefix and a string.
456 NB: The string must already be encoded!
459 mk_deriv :: NameSpace
460 -> String -- Distinguishes one sort of derived name from another
461 -> EncodedString -- Must be already encoded!! We don't want to encode it a
462 -- second time because encoding isn't idempotent
465 mk_deriv occ_sp sys_prefix str = mkSysOcc occ_sp (encode sys_prefix ++ str)
469 mkDictOcc, mkIPOcc, mkWorkerOcc, mkDefaultMethodOcc,
470 mkClassTyConOcc, mkClassDataConOcc, mkSpecOcc
471 :: OccName -> OccName
473 -- These derived variables have a prefix that no Haskell value could have
474 mkDataConWrapperOcc = mk_simple_deriv varName "$W"
475 mkWorkerOcc = mk_simple_deriv varName "$w"
476 mkDefaultMethodOcc = mk_simple_deriv varName "$dm"
477 mkDerivedTyConOcc = mk_simple_deriv tcName ":" -- The : prefix makes sure it classifies
478 mkClassTyConOcc = mk_simple_deriv tcName ":T" -- as a tycon/datacon
479 mkClassDataConOcc = mk_simple_deriv dataName ":D" -- We go straight to the "real" data con
480 -- for datacons from classes
481 mkDictOcc = mk_simple_deriv varName "$d"
482 mkIPOcc = mk_simple_deriv varName "$i"
483 mkSpecOcc = mk_simple_deriv varName "$s"
484 mkForeignExportOcc = mk_simple_deriv varName "$f"
486 -- Generic derivable classes
487 mkGenOcc1 = mk_simple_deriv varName "$gfrom"
488 mkGenOcc2 = mk_simple_deriv varName "$gto"
490 -- data T = MkT ... deriving( Data ) needs defintions for
491 -- $tT :: Data.Generics.Basics.DataType
492 -- $cMkT :: Data.Generics.Basics.Constr
493 mkDataTOcc = mk_simple_deriv varName "$t"
494 mkDataCOcc = mk_simple_deriv varName "$c"
496 mk_simple_deriv sp px occ = mk_deriv sp px (occNameString occ)
499 -- Data constructor workers are made by setting the name space
500 -- of the data constructor OccName (which should be a DataName)
502 mkDataConWorkerOcc datacon_occ = setOccNameSpace varName datacon_occ
506 mkSuperDictSelOcc :: Int -- Index of superclass, eg 3
507 -> OccName -- Class, eg "Ord"
508 -> OccName -- eg "$p3Ord"
509 mkSuperDictSelOcc index cls_occ
510 = mk_deriv varName "$p" (show index ++ occNameString cls_occ)
512 mkLocalOcc :: Unique -- Unique
513 -> OccName -- Local name (e.g. "sat")
514 -> OccName -- Nice unique version ("$L23sat")
516 = mk_deriv varName ("$L" ++ show uniq) (occNameString occ)
517 -- The Unique might print with characters
518 -- that need encoding (e.g. 'z'!)
523 mkDFunOcc :: EncodedString -- Typically the class and type glommed together e.g. "OrdMaybe"
524 -> OccName -- "$fOrdMaybe"
526 mkDFunOcc string = mk_deriv VarName "$f" string
529 We used to add a '$m' to indicate a method, but that gives rise to bad
530 error messages from the type checker when we print the function name or pattern
531 of an instance-decl binding. Why? Because the binding is zapped
532 to use the method name in place of the selector name.
533 (See TcClassDcl.tcMethodBind)
535 The way it is now, -ddump-xx output may look confusing, but
536 you can always say -dppr-debug to get the uniques.
538 However, we *do* have to zap the first character to be lower case,
539 because overloaded constructors (blarg) generate methods too.
540 And convert to VarName space
542 e.g. a call to constructor MkFoo where
543 data (Ord a) => Foo a = MkFoo a
545 If this is necessary, we do it by prefixing '$m'. These
546 guys never show up in error messages. What a hack.
549 mkMethodOcc :: OccName -> OccName
550 mkMethodOcc occ@(OccName VarName fs) = occ
551 mkMethodOcc occ = mk_simple_deriv varName "$m" occ
555 %************************************************************************
557 \subsection{Tidying them up}
559 %************************************************************************
561 Before we print chunks of code we like to rename it so that
562 we don't have to print lots of silly uniques in it. But we mustn't
563 accidentally introduce name clashes! So the idea is that we leave the
564 OccName alone unless it accidentally clashes with one that is already
565 in scope; if so, we tack on '1' at the end and try again, then '2', and
566 so on till we find a unique one.
568 There's a wrinkle for operators. Consider '>>='. We can't use '>>=1'
569 because that isn't a single lexeme. So we encode it to 'lle' and *then*
570 tack on the '1', if necessary.
573 type TidyOccEnv = OccEnv Int -- The in-scope OccNames
574 -- Range gives a plausible starting point for new guesses
576 emptyTidyOccEnv = emptyOccEnv
578 initTidyOccEnv :: [OccName] -> TidyOccEnv -- Initialise with names to avoid!
579 initTidyOccEnv = foldl (\env occ -> extendOccEnv env occ 1) emptyTidyOccEnv
581 tidyOccName :: TidyOccEnv -> OccName -> (TidyOccEnv, OccName)
583 tidyOccName in_scope occ@(OccName occ_sp fs)
584 = case lookupOccEnv in_scope occ of
585 Nothing -> -- Not already used: make it used
586 (extendOccEnv in_scope occ 1, occ)
588 Just n -> -- Already used: make a new guess,
589 -- change the guess base, and try again
590 tidyOccName (extendOccEnv in_scope occ (n+1))
591 (mkSysOcc occ_sp (unpackFS fs ++ show n))
595 %************************************************************************
597 \subsection{The 'Z' encoding}
599 %************************************************************************
601 This is the main name-encoding and decoding function. It encodes any
602 string into a string that is acceptable as a C name. This is the name
603 by which things are known right through the compiler.
605 The basic encoding scheme is this.
607 * Tuples (,,,) are coded as Z3T
609 * Alphabetic characters (upper and lower) and digits
610 all translate to themselves;
611 except 'Z', which translates to 'ZZ'
612 and 'z', which translates to 'zz'
613 We need both so that we can preserve the variable/tycon distinction
615 * Most other printable characters translate to 'zx' or 'Zx' for some
616 alphabetic character x
618 * The others translate as 'znnnU' where 'nnn' is the decimal number
622 --------------------------
634 (# #) Z1H unboxed 1-tuple (note the space)
635 (#,,,,#) Z5H unboxed 5-tuple
636 (NB: There is no Z1T nor Z0H.)
639 -- alreadyEncoded is used in ASSERTs to check for encoded
640 -- strings. It isn't fail-safe, of course, because, say 'zh' might
641 -- be encoded or not.
642 alreadyEncoded :: String -> Bool
643 alreadyEncoded s = all ok s
646 -- This is a bit of a lie; if we really wanted spaces
647 -- in names we'd have to encode them. But we do put
648 -- spaces in ccall "occurrences", and we don't want to
650 ok ch = isAlphaNum ch
652 alreadyEncodedFS :: FastString -> Bool
653 alreadyEncodedFS fs = alreadyEncoded (unpackFS fs)
655 encode :: UserString -> EncodedString
656 encode cs = case maybe_tuple cs of
657 Just n -> n -- Tuples go to Z2T etc
661 go (c:cs) = encode_ch c ++ go cs
663 encodeFS :: UserFS -> EncodedFS
664 encodeFS fast_str | all unencodedChar str = fast_str
665 | otherwise = mkFastString (encode str)
667 str = unpackFS fast_str
669 unencodedChar :: Char -> Bool -- True for chars that don't need encoding
670 unencodedChar 'Z' = False
671 unencodedChar 'z' = False
672 unencodedChar c = c >= 'a' && c <= 'z'
673 || c >= 'A' && c <= 'Z'
674 || c >= '0' && c <= '9'
676 encode_ch :: Char -> EncodedString
677 encode_ch c | unencodedChar c = [c] -- Common case first
680 encode_ch '(' = "ZL" -- Needed for things like (,), and (->)
681 encode_ch ')' = "ZR" -- For symmetry with (
701 encode_ch '\'' = "zq"
702 encode_ch '\\' = "zr"
707 encode_ch c = 'z' : shows (ord c) "U"
710 Decode is used for user printing.
713 decodeFS :: FastString -> FastString
714 decodeFS fs = mkFastString (decode (unpackFS fs))
716 decode :: EncodedString -> UserString
718 decode ('Z' : d : rest) | isDigit d = decode_tuple d rest
719 | otherwise = decode_upper d : decode rest
720 decode ('z' : d : rest) | isDigit d = decode_num_esc d rest
721 | otherwise = decode_lower d : decode rest
722 decode (c : rest) = c : decode rest
724 decode_upper, decode_lower :: Char -> Char
726 decode_upper 'L' = '('
727 decode_upper 'R' = ')'
728 decode_upper 'M' = '['
729 decode_upper 'N' = ']'
730 decode_upper 'C' = ':'
731 decode_upper 'Z' = 'Z'
732 decode_upper ch = pprTrace "decode_upper" (char ch) ch
734 decode_lower 'z' = 'z'
735 decode_lower 'a' = '&'
736 decode_lower 'b' = '|'
737 decode_lower 'c' = '^'
738 decode_lower 'd' = '$'
739 decode_lower 'e' = '='
740 decode_lower 'g' = '>'
741 decode_lower 'h' = '#'
742 decode_lower 'i' = '.'
743 decode_lower 'l' = '<'
744 decode_lower 'm' = '-'
745 decode_lower 'n' = '!'
746 decode_lower 'p' = '+'
747 decode_lower 'q' = '\''
748 decode_lower 'r' = '\\'
749 decode_lower 's' = '/'
750 decode_lower 't' = '*'
751 decode_lower 'u' = '_'
752 decode_lower 'v' = '%'
753 decode_lower ch = pprTrace "decode_lower" (char ch) ch
755 -- Characters not having a specific code are coded as z224U
756 decode_num_esc d rest
757 = go (digitToInt d) rest
759 go n (c : rest) | isDigit c = go (10*n + digitToInt c) rest
760 go n ('U' : rest) = chr n : decode rest
761 go n other = pprPanic "decode_num_esc" (ppr n <+> text other)
763 decode_tuple :: Char -> EncodedString -> UserString
765 = go (digitToInt d) rest
767 -- NB. recurse back to decode after decoding the tuple, because
768 -- the tuple might be embedded in a longer name.
769 go n (c : rest) | isDigit c = go (10*n + digitToInt c) rest
770 go 0 ('T':rest) = "()" ++ decode rest
771 go n ('T':rest) = '(' : replicate (n-1) ',' ++ ")" ++ decode rest
772 go 1 ('H':rest) = "(# #)" ++ decode rest
773 go n ('H':rest) = '(' : '#' : replicate (n-1) ',' ++ "#)" ++ decode rest
774 go n other = pprPanic "decode_tuple" (ppr n <+> text other)
778 %************************************************************************
780 Stuff for dealing with tuples
782 %************************************************************************
784 Tuples are encoded as
786 for 3-tuples or unboxed 3-tuples respectively. No other encoding starts
789 * "(# #)" is the tycon for an unboxed 1-tuple (not 0-tuple)
790 There are no unboxed 0-tuples.
792 * "()" is the tycon for a boxed 0-tuple.
793 There are no boxed 1-tuples.
797 maybe_tuple :: UserString -> Maybe EncodedString
799 maybe_tuple "(# #)" = Just("Z1H")
800 maybe_tuple ('(' : '#' : cs) = case count_commas (0::Int) cs of
801 (n, '#' : ')' : cs) -> Just ('Z' : shows (n+1) "H")
803 maybe_tuple "()" = Just("Z0T")
804 maybe_tuple ('(' : cs) = case count_commas (0::Int) cs of
805 (n, ')' : cs) -> Just ('Z' : shows (n+1) "T")
807 maybe_tuple other = Nothing
809 count_commas :: Int -> String -> (Int, String)
810 count_commas n (',' : cs) = count_commas (n+1) cs
811 count_commas n cs = (n,cs)
815 mkTupleOcc :: NameSpace -> Boxity -> Arity -> OccName
817 = OccName ns (mkFastString ('Z' : (show ar ++ bx_char)))
823 isTupleOcc_maybe :: OccName -> Maybe (NameSpace, Boxity, Arity)
824 -- Tuples are special, because there are so many of them!
825 isTupleOcc_maybe (OccName ns fs)
826 = case unpackFS fs of
827 ('Z':d:rest) | isDigit d -> Just (decode_tup (digitToInt d) rest)
830 decode_tup n "H" = (ns, Unboxed, n)
831 decode_tup n "T" = (ns, Boxed, n)
832 decode_tup n (d:rest) = decode_tup (n*10 + digitToInt d) rest
835 %************************************************************************
837 \subsection{Lexical categories}
839 %************************************************************************
841 These functions test strings to see if they fit the lexical categories
842 defined in the Haskell report.
845 isLexCon, isLexVar, isLexId, isLexSym :: FastString -> Bool
846 isLexConId, isLexConSym, isLexVarId, isLexVarSym :: FastString -> Bool
848 isLexCon cs = isLexConId cs || isLexConSym cs
849 isLexVar cs = isLexVarId cs || isLexVarSym cs
851 isLexId cs = isLexConId cs || isLexVarId cs
852 isLexSym cs = isLexConSym cs || isLexVarSym cs
856 isLexConId cs -- Prefix type or data constructors
857 | nullFastString cs = False -- e.g. "Foo", "[]", "(,)"
858 | cs == FSLIT("[]") = True
859 | otherwise = startsConId (headFS cs)
861 isLexVarId cs -- Ordinary prefix identifiers
862 | nullFastString cs = False -- e.g. "x", "_x"
863 | otherwise = startsVarId (headFS cs)
865 isLexConSym cs -- Infix type or data constructors
866 | nullFastString cs = False -- e.g. ":-:", ":", "->"
867 | cs == FSLIT("->") = True
868 | otherwise = startsConSym (headFS cs)
870 isLexVarSym cs -- Infix identifiers
871 | nullFastString cs = False -- e.g. "+"
872 | otherwise = startsVarSym (headFS cs)
875 startsVarSym, startsVarId, startsConSym, startsConId :: Char -> Bool
876 startsVarSym c = isSymbolASCII c || isSymbolISO c -- Infix Ids
877 startsConSym c = c == ':' -- Infix data constructors
878 startsVarId c = isLower c || isLowerISO c || c == '_' -- Ordinary Ids
879 startsConId c = isUpper c || isUpperISO c || c == '(' -- Ordinary type constructors and data constructors
882 isSymbolASCII c = c `elem` "!#$%&*+./<=>?@\\^|~-"
883 isSymbolISO c = ord c `elem` (0xd7 : 0xf7 : [0xa1 .. 0xbf])
884 isUpperISO (C# c#) = c# `geChar#` '\xc0'# && c# `leChar#` '\xde'# && c# `neChar#` '\xd7'#
885 --0xc0 <= oc && oc <= 0xde && oc /= 0xd7 where oc = ord c
886 isLowerISO (C# c#) = c# `geChar#` '\xdf'# && c# `leChar#` '\xff'# && c# `neChar#` '\xf7'#
887 --0xdf <= oc && oc <= 0xff && oc /= 0xf7 where oc = ord c
890 %************************************************************************
893 Here rather than BinIface because OccName is abstract
895 %************************************************************************
898 instance Binary NameSpace where
901 put_ bh DataName = do
905 put_ bh TcClsName = do
910 0 -> do return VarName
911 1 -> do return DataName
912 2 -> do return TvName
913 _ -> do return TcClsName
915 instance Binary OccName where
916 put_ bh (OccName aa ab) = do
922 return (OccName aa ab)