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,
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 -> String
362 occNameFlavour (OccName DataName _) = "data constructor"
363 occNameFlavour (OccName TvName _) = "type variable"
364 occNameFlavour (OccName TcClsName _) = "type constructor or class"
365 occNameFlavour (OccName VarName s) = ""
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 VarName s) = isLexSym (decodeFS s)
407 isSymOcc other = False
412 reportIfUnused :: OccName -> Bool
413 -- Haskell 98 encourages compilers to suppress warnings about
414 -- unused names in a pattern if they start with "_".
415 reportIfUnused occ = case occNameUserString occ of
422 %************************************************************************
424 \subsection{Making system names}
426 %************************************************************************
428 Here's our convention for splitting up the interface file name space:
430 d... dictionary identifiers
431 (local variables, so no name-clash worries)
433 $f... dict-fun identifiers (from inst decls)
434 $dm... default methods
435 $p... superclass selectors
437 :T... compiler-generated tycons for dictionaries
438 :D... ...ditto data cons
439 $sf.. specialised version of f
441 in encoded form these appear as Zdfxxx etc
443 :... keywords (export:, letrec: etc.)
444 --- I THINK THIS IS WRONG!
446 This knowledge is encoded in the following functions.
449 @mk_deriv@ generates an @OccName@ from the prefix and a string.
450 NB: The string must already be encoded!
453 mk_deriv :: NameSpace
454 -> String -- Distinguishes one sort of derived name from another
455 -> EncodedString -- Must be already encoded!! We don't want to encode it a
456 -- second time because encoding isn't idempotent
459 mk_deriv occ_sp sys_prefix str = mkSysOcc occ_sp (encode sys_prefix ++ str)
463 mkDictOcc, mkIPOcc, mkWorkerOcc, mkDefaultMethodOcc,
464 mkClassTyConOcc, mkClassDataConOcc, mkSpecOcc
465 :: OccName -> OccName
467 -- These derived variables have a prefix that no Haskell value could have
468 mkDataConWrapperOcc = mk_simple_deriv varName "$W"
469 mkWorkerOcc = mk_simple_deriv varName "$w"
470 mkDefaultMethodOcc = mk_simple_deriv varName "$dm"
471 mkDerivedTyConOcc = mk_simple_deriv tcName ":" -- The : prefix makes sure it classifies
472 mkClassTyConOcc = mk_simple_deriv tcName ":T" -- as a tycon/datacon
473 mkClassDataConOcc = mk_simple_deriv dataName ":D" -- We go straight to the "real" data con
474 -- for datacons from classes
475 mkDictOcc = mk_simple_deriv varName "$d"
476 mkIPOcc = mk_simple_deriv varName "$i"
477 mkSpecOcc = mk_simple_deriv varName "$s"
478 mkForeignExportOcc = mk_simple_deriv varName "$f"
480 -- Generic derivable classes
481 mkGenOcc1 = mk_simple_deriv varName "$gfrom"
482 mkGenOcc2 = mk_simple_deriv varName "$gto"
484 -- data T = MkT ... deriving( Data ) needs defintions for
485 -- $tT :: Data.Generics.Basics.DataType
486 -- $cMkT :: Data.Generics.Basics.Constr
487 mkDataTOcc = mk_simple_deriv varName "$t"
488 mkDataCOcc = mk_simple_deriv varName "$c"
490 mk_simple_deriv sp px occ = mk_deriv sp px (occNameString occ)
493 -- Data constructor workers are made by setting the name space
494 -- of the data constructor OccName (which should be a DataName)
496 mkDataConWorkerOcc datacon_occ = setOccNameSpace varName datacon_occ
500 mkSuperDictSelOcc :: Int -- Index of superclass, eg 3
501 -> OccName -- Class, eg "Ord"
502 -> OccName -- eg "$p3Ord"
503 mkSuperDictSelOcc index cls_occ
504 = mk_deriv varName "$p" (show index ++ occNameString cls_occ)
506 mkLocalOcc :: Unique -- Unique
507 -> OccName -- Local name (e.g. "sat")
508 -> OccName -- Nice unique version ("$L23sat")
510 = mk_deriv varName ("$L" ++ show uniq) (occNameString occ)
511 -- The Unique might print with characters
512 -- that need encoding (e.g. 'z'!)
517 mkDFunOcc :: EncodedString -- Typically the class and type glommed together e.g. "OrdMaybe"
518 -> OccName -- "$fOrdMaybe"
520 mkDFunOcc string = mk_deriv VarName "$f" string
523 We used to add a '$m' to indicate a method, but that gives rise to bad
524 error messages from the type checker when we print the function name or pattern
525 of an instance-decl binding. Why? Because the binding is zapped
526 to use the method name in place of the selector name.
527 (See TcClassDcl.tcMethodBind)
529 The way it is now, -ddump-xx output may look confusing, but
530 you can always say -dppr-debug to get the uniques.
532 However, we *do* have to zap the first character to be lower case,
533 because overloaded constructors (blarg) generate methods too.
534 And convert to VarName space
536 e.g. a call to constructor MkFoo where
537 data (Ord a) => Foo a = MkFoo a
539 If this is necessary, we do it by prefixing '$m'. These
540 guys never show up in error messages. What a hack.
543 mkMethodOcc :: OccName -> OccName
544 mkMethodOcc occ@(OccName VarName fs) = occ
545 mkMethodOcc occ = mk_simple_deriv varName "$m" occ
549 %************************************************************************
551 \subsection{Tidying them up}
553 %************************************************************************
555 Before we print chunks of code we like to rename it so that
556 we don't have to print lots of silly uniques in it. But we mustn't
557 accidentally introduce name clashes! So the idea is that we leave the
558 OccName alone unless it accidentally clashes with one that is already
559 in scope; if so, we tack on '1' at the end and try again, then '2', and
560 so on till we find a unique one.
562 There's a wrinkle for operators. Consider '>>='. We can't use '>>=1'
563 because that isn't a single lexeme. So we encode it to 'lle' and *then*
564 tack on the '1', if necessary.
567 type TidyOccEnv = OccEnv Int -- The in-scope OccNames
568 -- Range gives a plausible starting point for new guesses
570 emptyTidyOccEnv = emptyOccEnv
572 initTidyOccEnv :: [OccName] -> TidyOccEnv -- Initialise with names to avoid!
573 initTidyOccEnv = foldl (\env occ -> extendOccEnv env occ 1) emptyTidyOccEnv
575 tidyOccName :: TidyOccEnv -> OccName -> (TidyOccEnv, OccName)
577 tidyOccName in_scope occ@(OccName occ_sp fs)
578 = case lookupOccEnv in_scope occ of
579 Nothing -> -- Not already used: make it used
580 (extendOccEnv in_scope occ 1, occ)
582 Just n -> -- Already used: make a new guess,
583 -- change the guess base, and try again
584 tidyOccName (extendOccEnv in_scope occ (n+1))
585 (mkSysOcc occ_sp (unpackFS fs ++ show n))
589 %************************************************************************
591 \subsection{The 'Z' encoding}
593 %************************************************************************
595 This is the main name-encoding and decoding function. It encodes any
596 string into a string that is acceptable as a C name. This is the name
597 by which things are known right through the compiler.
599 The basic encoding scheme is this.
601 * Tuples (,,,) are coded as Z3T
603 * Alphabetic characters (upper and lower) and digits
604 all translate to themselves;
605 except 'Z', which translates to 'ZZ'
606 and 'z', which translates to 'zz'
607 We need both so that we can preserve the variable/tycon distinction
609 * Most other printable characters translate to 'zx' or 'Zx' for some
610 alphabetic character x
612 * The others translate as 'znnnU' where 'nnn' is the decimal number
616 --------------------------
628 (# #) Z1H unboxed 1-tuple (note the space)
629 (#,,,,#) Z5H unboxed 5-tuple
630 (NB: There is no Z1T nor Z0H.)
633 -- alreadyEncoded is used in ASSERTs to check for encoded
634 -- strings. It isn't fail-safe, of course, because, say 'zh' might
635 -- be encoded or not.
636 alreadyEncoded :: String -> Bool
637 alreadyEncoded s = all ok s
640 -- This is a bit of a lie; if we really wanted spaces
641 -- in names we'd have to encode them. But we do put
642 -- spaces in ccall "occurrences", and we don't want to
644 ok ch = isAlphaNum ch
646 alreadyEncodedFS :: FastString -> Bool
647 alreadyEncodedFS fs = alreadyEncoded (unpackFS fs)
649 encode :: UserString -> EncodedString
650 encode cs = case maybe_tuple cs of
651 Just n -> n -- Tuples go to Z2T etc
655 go (c:cs) = encode_ch c ++ go cs
657 encodeFS :: UserFS -> EncodedFS
658 encodeFS fast_str | all unencodedChar str = fast_str
659 | otherwise = mkFastString (encode str)
661 str = unpackFS fast_str
663 unencodedChar :: Char -> Bool -- True for chars that don't need encoding
664 unencodedChar 'Z' = False
665 unencodedChar 'z' = False
666 unencodedChar c = c >= 'a' && c <= 'z'
667 || c >= 'A' && c <= 'Z'
668 || c >= '0' && c <= '9'
670 encode_ch :: Char -> EncodedString
671 encode_ch c | unencodedChar c = [c] -- Common case first
674 encode_ch '(' = "ZL" -- Needed for things like (,), and (->)
675 encode_ch ')' = "ZR" -- For symmetry with (
695 encode_ch '\'' = "zq"
696 encode_ch '\\' = "zr"
701 encode_ch c = 'z' : shows (ord c) "U"
704 Decode is used for user printing.
707 decodeFS :: FastString -> FastString
708 decodeFS fs = mkFastString (decode (unpackFS fs))
710 decode :: EncodedString -> UserString
712 decode ('Z' : d : rest) | isDigit d = decode_tuple d rest
713 | otherwise = decode_upper d : decode rest
714 decode ('z' : d : rest) | isDigit d = decode_num_esc d rest
715 | otherwise = decode_lower d : decode rest
716 decode (c : rest) = c : decode rest
718 decode_upper, decode_lower :: Char -> Char
720 decode_upper 'L' = '('
721 decode_upper 'R' = ')'
722 decode_upper 'M' = '['
723 decode_upper 'N' = ']'
724 decode_upper 'C' = ':'
725 decode_upper 'Z' = 'Z'
726 decode_upper ch = pprTrace "decode_upper" (char ch) ch
728 decode_lower 'z' = 'z'
729 decode_lower 'a' = '&'
730 decode_lower 'b' = '|'
731 decode_lower 'c' = '^'
732 decode_lower 'd' = '$'
733 decode_lower 'e' = '='
734 decode_lower 'g' = '>'
735 decode_lower 'h' = '#'
736 decode_lower 'i' = '.'
737 decode_lower 'l' = '<'
738 decode_lower 'm' = '-'
739 decode_lower 'n' = '!'
740 decode_lower 'p' = '+'
741 decode_lower 'q' = '\''
742 decode_lower 'r' = '\\'
743 decode_lower 's' = '/'
744 decode_lower 't' = '*'
745 decode_lower 'u' = '_'
746 decode_lower 'v' = '%'
747 decode_lower ch = pprTrace "decode_lower" (char ch) ch
749 -- Characters not having a specific code are coded as z224U
750 decode_num_esc d rest
751 = go (digitToInt d) rest
753 go n (c : rest) | isDigit c = go (10*n + digitToInt c) rest
754 go n ('U' : rest) = chr n : decode rest
755 go n other = pprPanic "decode_num_esc" (ppr n <+> text other)
759 %************************************************************************
761 Stuff for dealing with tuples
763 %************************************************************************
765 Tuples are encoded as
767 for 3-tuples or unboxed 3-tuples respectively. No other encoding starts
770 * "(# #)" is the tycon for an unboxed 1-tuple (not 0-tuple)
771 There are no unboxed 0-tuples.
773 * "()" is the tycon for a boxed 0-tuple.
774 There are no boxed 1-tuples.
778 maybe_tuple :: UserString -> Maybe EncodedString
780 maybe_tuple "(# #)" = Just("Z1H")
781 maybe_tuple ('(' : '#' : cs) = case count_commas (0::Int) cs of
782 (n, '#' : ')' : cs) -> Just ('Z' : shows (n+1) "H")
784 maybe_tuple "()" = Just("Z0T")
785 maybe_tuple ('(' : cs) = case count_commas (0::Int) cs of
786 (n, ')' : cs) -> Just ('Z' : shows (n+1) "T")
788 maybe_tuple other = Nothing
790 count_commas :: Int -> String -> (Int, String)
791 count_commas n (',' : cs) = count_commas (n+1) cs
792 count_commas n cs = (n,cs)
796 decode_tuple :: Char -> EncodedString -> UserString
798 = go (digitToInt d) rest
800 go n (c : rest) | isDigit c = go (10*n + digitToInt c) rest
802 go n ['T'] = '(' : replicate (n-1) ',' ++ ")"
804 go n ['H'] = '(' : '#' : replicate (n-1) ',' ++ "#)"
805 go n other = pprPanic "decode_tuple" (ppr n <+> text other)
807 mkTupleOcc :: NameSpace -> Boxity -> Arity -> OccName
809 = OccName ns (mkFastString ('Z' : (show ar ++ bx_char)))
815 isTupleOcc_maybe :: OccName -> Maybe (NameSpace, Boxity, Arity)
816 -- Tuples are special, because there are so many of them!
817 isTupleOcc_maybe (OccName ns fs)
818 = case unpackFS fs of
819 ('Z':d:rest) | isDigit d -> Just (decode_tup (digitToInt d) rest)
822 decode_tup n "H" = (ns, Unboxed, n)
823 decode_tup n "T" = (ns, Boxed, n)
824 decode_tup n (d:rest) = decode_tup (n*10 + digitToInt d) rest
827 %************************************************************************
829 \subsection{Lexical categories}
831 %************************************************************************
833 These functions test strings to see if they fit the lexical categories
834 defined in the Haskell report.
837 isLexCon, isLexVar, isLexId, isLexSym :: FastString -> Bool
838 isLexConId, isLexConSym, isLexVarId, isLexVarSym :: FastString -> Bool
840 isLexCon cs = isLexConId cs || isLexConSym cs
841 isLexVar cs = isLexVarId cs || isLexVarSym cs
843 isLexId cs = isLexConId cs || isLexVarId cs
844 isLexSym cs = isLexConSym cs || isLexVarSym cs
848 isLexConId cs -- Prefix type or data constructors
849 | nullFastString cs = False -- e.g. "Foo", "[]", "(,)"
850 | cs == FSLIT("[]") = True
851 | otherwise = startsConId (headFS cs)
853 isLexVarId cs -- Ordinary prefix identifiers
854 | nullFastString cs = False -- e.g. "x", "_x"
855 | otherwise = startsVarId (headFS cs)
857 isLexConSym cs -- Infix type or data constructors
858 | nullFastString cs = False -- e.g. ":-:", ":", "->"
859 | cs == FSLIT("->") = True
860 | otherwise = startsConSym (headFS cs)
862 isLexVarSym cs -- Infix identifiers
863 | nullFastString cs = False -- e.g. "+"
864 | otherwise = startsVarSym (headFS cs)
867 startsVarSym, startsVarId, startsConSym, startsConId :: Char -> Bool
868 startsVarSym c = isSymbolASCII c || isSymbolISO c -- Infix Ids
869 startsConSym c = c == ':' -- Infix data constructors
870 startsVarId c = isLower c || isLowerISO c || c == '_' -- Ordinary Ids
871 startsConId c = isUpper c || isUpperISO c || c == '(' -- Ordinary type constructors and data constructors
874 isSymbolASCII c = c `elem` "!#$%&*+./<=>?@\\^|~-"
875 isSymbolISO c = ord c `elem` (0xd7 : 0xf7 : [0xa1 .. 0xbf])
876 isUpperISO (C# c#) = c# `geChar#` '\xc0'# && c# `leChar#` '\xde'# && c# `neChar#` '\xd7'#
877 --0xc0 <= oc && oc <= 0xde && oc /= 0xd7 where oc = ord c
878 isLowerISO (C# c#) = c# `geChar#` '\xdf'# && c# `leChar#` '\xff'# && c# `neChar#` '\xf7'#
879 --0xdf <= oc && oc <= 0xff && oc /= 0xf7 where oc = ord c
882 %************************************************************************
885 Here rather than BinIface because OccName is abstract
887 %************************************************************************
890 instance Binary NameSpace where
893 put_ bh DataName = do
897 put_ bh TcClsName = do
902 0 -> do return VarName
903 1 -> do return DataName
904 2 -> do return TvName
905 _ -> do return TcClsName
907 instance Binary OccName where
908 put_ bh (OccName aa ab) = do
914 return (OccName aa ab)