ghc/compiler/basicTypes/OccName.lhs

   1 {-% DrIFT (Automatic class derivations for Haskell) v1.1 %-}
   2 %
   3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   4 %
   5
   6 \section[OccName]{@OccName@}
   7
   8 \begin{code}
   9 module OccName (
  10         -- The NameSpace type; abstact
  11         NameSpace, tcName, clsName, tcClsName, dataName, varName,
  12         tvName, srcDataName, nameSpaceString,
  13
  14         -- The OccName type
  15         OccName,        -- Abstract, instance of Outputable
  16         pprOccName,
  17
  18         -- The OccEnv type
  19         OccEnv, emptyOccEnv, unitOccEnv, extendOccEnv,
  20         lookupOccEnv, mkOccEnv, extendOccEnvList, elemOccEnv,
  21         occEnvElts, foldOccEnv, plusOccEnv, plusOccEnv_C, extendOccEnv_C,
  22
  23
  24         -- The OccSet type
  25         OccSet, emptyOccSet, unitOccSet, mkOccSet, extendOccSet, extendOccSetList,
  26         unionOccSets, unionManyOccSets, minusOccSet, elemOccSet, occSetElts,
  27         foldOccSet, isEmptyOccSet, intersectOccSet, intersectsOccSet,
  28
  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,
  36
  37         isVarOcc, isTvOcc, isTcOcc, isDataOcc, isDataSymOcc, isSymOcc, isValOcc,
  38         parenSymOcc, reportIfUnused,
  39
  40         occNameFS, occNameString, occNameUserString, occNameSpace,
  41         occNameFlavour, briefOccNameFlavour,
  42         setOccNameSpace,
  43
  44         mkTupleOcc, isTupleOcc_maybe,
  45
  46         -- Tidying up
  47         TidyOccEnv, emptyTidyOccEnv, tidyOccName, initTidyOccEnv,
  48
  49         -- Encoding
  50         EncodedString, EncodedFS, UserString, UserFS, encode, encodeFS, decode, pprEncodedFS,
  51
  52         -- The basic form of names
  53         isLexCon, isLexVar, isLexId, isLexSym,
  54         isLexConId, isLexConSym, isLexVarId, isLexVarSym,
  55         isLowerISO, isUpperISO
  56
  57     ) where
  58
  59 #include "HsVersions.h"
  60
  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 )
  65 import UniqFM
  66 import UniqSet
  67 import FastString
  68 import Outputable
  69 import Binary
  70
  71 import GLAEXTS
  72 \end{code}
  73
  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
  76 (prefix) identifier.
  77
  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.
  82
  83 These type synonyms help documentation.
  84
  85 \begin{code}
  86 type UserFS    = FastString     -- As the user typed it
  87 type EncodedFS = FastString     -- Encoded form
  88
  89 type UserString = String        -- As the user typed it
  90 type EncodedString = String     -- Encoded form
  91
  92
  93 pprEncodedFS :: EncodedFS -> SDoc
  94 pprEncodedFS fs
  95   = getPprStyle         $ \ sty ->
  96     if userStyle sty
  97         -- ftext (decodeFS fs) would needlessly pack the string again
  98         then text (decode (unpackFS fs))
  99         else ftext fs
 100 \end{code}
 101
 102 %************************************************************************
 103 %*                                                                      *
 104 \subsection{Name space}
 105 %*                                                                      *
 106 %************************************************************************
 107
 108 \begin{code}
 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.
 114                deriving( Eq, Ord )
 115    {-! derive: Binary !-}
 116
 117 -- Note [Data Constructors]
 118 -- see also: Note [Data Constructor Naming] in DataCon.lhs
 119 --
 120 --      "Source" data constructors are the data constructors mentioned
 121 --      in Haskell source code
 122 --
 123 --      "Real" data constructors are the data constructors of the
 124 --      representation type, which may not be the same as the source
 125 --      type
 126
 127 -- Example:
 128 --      data T = T !(Int,Int)
 129 --
 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.
 133
 134
 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!
 140
 141 dataName    = DataName
 142 srcDataName = DataName  -- Haskell-source data constructors should be
 143                         -- in the Data name space
 144
 145 tvName      = TvName
 146 varName     = VarName
 147
 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"
 153 \end{code}
 154
 155
 156 %************************************************************************
 157 %*                                                                      *
 158 \subsection[Name-pieces-datatypes]{The @OccName@ datatypes}
 159 %*                                                                      *
 160 %************************************************************************
 161
 162 \begin{code}
 163 data OccName = OccName
 164                         NameSpace
 165                         EncodedFS
 166    {-! derive : Binary !-}
 167 \end{code}
 168
 169
 170 \begin{code}
 171 instance Eq OccName where
 172     (OccName sp1 s1) == (OccName sp2 s2) = s1 == s2 && sp1 == sp2
 173
 174 instance Ord OccName where
 175     compare (OccName sp1 s1) (OccName sp2 s2) = (s1  `compare` s2) `thenCmp`
 176                                                 (sp1 `compare` sp2)
 177 \end{code}
 178
 179
 180 %************************************************************************
 181 %*                                                                      *
 182 \subsection{Printing}
 183 %*                                                                      *
 184 %************************************************************************
 185
 186 \begin{code}
 187 instance Outputable OccName where
 188     ppr = pprOccName
 189
 190 pprOccName :: OccName -> SDoc
 191 pprOccName (OccName sp occ)
 192   = getPprStyle $ \ sty ->
 193     pprEncodedFS occ <> if debugStyle sty then
 194                            braces (text (briefNameSpaceFlavour sp))
 195                         else empty
 196 \end{code}
 197
 198
 199 %************************************************************************
 200 %*                                                                      *
 201 \subsection{Construction}
 202 %*                                                                      *
 203 %*****p*******************************************************************
 204
 205 *Sys* things do no encoding; the caller should ensure that the thing is
 206 already encoded
 207
 208 \begin{code}
 209 mkSysOcc :: NameSpace -> EncodedString -> OccName
 210 mkSysOcc occ_sp str = ASSERT2( alreadyEncoded str, text str )
 211                       OccName occ_sp (mkFastString str)
 212
 213 mkSysOccFS :: NameSpace -> EncodedFS -> OccName
 214 mkSysOccFS occ_sp fs = ASSERT2( alreadyEncodedFS fs, ppr fs )
 215                        OccName occ_sp fs
 216
 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)
 223
 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
 230 \end{code}
 231
 232 *Source-code* things are encoded.
 233
 234 \begin{code}
 235 mkOccFS :: NameSpace -> UserFS -> OccName
 236 mkOccFS occ_sp fs = mkSysOccFS occ_sp (encodeFS fs)
 237
 238 mkOccName :: NameSpace -> String -> OccName
 239 mkOccName ns s = mkSysOcc ns (encode s)
 240
 241 mkVarOcc :: UserFS -> OccName
 242 mkVarOcc fs = mkSysOccFS varName (encodeFS fs)
 243
 244 mkVarOccEncoded :: EncodedFS -> OccName
 245 mkVarOccEncoded fs = mkSysOccFS varName fs
 246 \end{code}
 247
 248
 249
 250 %************************************************************************
 251 %*                                                                      *
 252                 Environments
 253 %*                                                                      *
 254 %************************************************************************
 255
 256 OccEnvs are used mainly for the envts in ModIfaces.
 257
 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.
 263
 264 \begin{code}
 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
 269         char = case ns of
 270                 VarName   -> 'i'
 271                 DataName  -> 'd'
 272                 TvName    -> 'v'
 273                 TcClsName -> 't'
 274
 275 type OccEnv a = UniqFM a
 276
 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
 289
 290 emptyOccEnv      = emptyUFM
 291 unitOccEnv       = unitUFM
 292 extendOccEnv     = addToUFM
 293 extendOccEnvList = addListToUFM
 294 lookupOccEnv     = lookupUFM
 295 mkOccEnv         = listToUFM
 296 elemOccEnv       = elemUFM
 297 foldOccEnv       = foldUFM
 298 occEnvElts       = eltsUFM
 299 plusOccEnv       = plusUFM
 300 plusOccEnv_C     = plusUFM_C
 301 extendOccEnv_C   = addToUFM_C
 302
 303
 304 type OccSet = UniqFM OccName
 305
 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
 320
 321 emptyOccSet       = emptyUniqSet
 322 unitOccSet        = unitUniqSet
 323 mkOccSet          = mkUniqSet
 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))
 335 \end{code}
 336
 337
 338 %************************************************************************
 339 %*                                                                      *
 340 \subsection{Predicates and taking them apart}
 341 %*                                                                      *
 342 %************************************************************************
 343
 344 \begin{code}
 345 occNameFS :: OccName -> EncodedFS
 346 occNameFS (OccName _ s) = s
 347
 348 occNameString :: OccName -> EncodedString
 349 occNameString (OccName _ s) = unpackFS s
 350
 351 occNameUserString :: OccName -> UserString
 352 occNameUserString occ = decode (occNameString occ)
 353
 354 occNameSpace :: OccName -> NameSpace
 355 occNameSpace (OccName sp _) = sp
 356
 357 setOccNameSpace :: NameSpace -> OccName -> OccName
 358 setOccNameSpace sp (OccName _ occ) = OccName sp occ
 359
 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
 366
 367 -- briefOccNameFlavour is used in debug-printing of names
 368 briefOccNameFlavour :: OccName -> String
 369 briefOccNameFlavour (OccName sp _) = briefNameSpaceFlavour sp
 370
 371 briefNameSpaceFlavour DataName  = "d"
 372 briefNameSpaceFlavour VarName   = "v"
 373 briefNameSpaceFlavour TvName    = "tv"
 374 briefNameSpaceFlavour TcClsName = "tc"
 375 \end{code}
 376
 377 \begin{code}
 378 isVarOcc, isTvOcc, isDataSymOcc, isSymOcc, isTcOcc :: OccName -> Bool
 379
 380 isVarOcc (OccName VarName _) = True
 381 isVarOcc other               = False
 382
 383 isTvOcc (OccName TvName _) = True
 384 isTvOcc other              = False
 385
 386 isTcOcc (OccName TcClsName _) = True
 387 isTcOcc other                 = False
 388
 389 isValOcc (OccName VarName  _) = True
 390 isValOcc (OccName DataName _) = True
 391 isValOcc other                = False
 392
 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
 398
 399 isDataOcc (OccName DataName _) = True
 400 isDataOcc (OccName VarName s)  = isLexCon (decodeFS s)
 401 isDataOcc other                = False
 402
 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
 409
 410 parenSymOcc :: OccName -> SDoc -> SDoc
 411 -- Wrap parens around an operator
 412 parenSymOcc occ doc | isSymOcc occ = parens doc
 413                     | otherwise    = doc
 414 \end{code}
 415
 416
 417 \begin{code}
 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
 422                         ('_' : _) -> False
 423                         zz_other  -> True
 424 \end{code}
 425
 426
 427
 428 %************************************************************************
 429 %*                                                                      *
 430 \subsection{Making system names}
 431 %*                                                                      *
 432 %************************************************************************
 433
 434 Here's our convention for splitting up the interface file name space:
 435
 436         d...            dictionary identifiers
 437                         (local variables, so no name-clash worries)
 438
 439         $f...           dict-fun identifiers (from inst decls)
 440         $dm...          default methods
 441         $p...           superclass selectors
 442         $w...           workers
 443         :T...           compiler-generated tycons for dictionaries
 444         :D...           ...ditto data cons
 445         $sf..           specialised version of f
 446
 447         in encoded form these appear as Zdfxxx etc
 448
 449         :...            keywords (export:, letrec: etc.)
 450 --- I THINK THIS IS WRONG!
 451
 452 This knowledge is encoded in the following functions.
 453
 454
 455 @mk_deriv@ generates an @OccName@ from the prefix and a string.
 456 NB: The string must already be encoded!
 457
 458 \begin{code}
 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
 463          -> OccName
 464
 465 mk_deriv occ_sp sys_prefix str = mkSysOcc occ_sp (encode sys_prefix ++ str)
 466 \end{code}
 467
 468 \begin{code}
 469 mkDictOcc, mkIPOcc, mkWorkerOcc, mkDefaultMethodOcc,
 470            mkClassTyConOcc, mkClassDataConOcc, mkSpecOcc
 471    :: OccName -> OccName
 472
 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"
 485
 486 -- Generic derivable classes
 487 mkGenOcc1           = mk_simple_deriv varName  "$gfrom"
 488 mkGenOcc2           = mk_simple_deriv varName  "$gto"
 489
 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"
 495
 496 mk_simple_deriv sp px occ = mk_deriv sp px (occNameString occ)
 497
 498
 499 -- Data constructor workers are made by setting the name space
 500 -- of the data constructor OccName (which should be a DataName)
 501 -- to DataName
 502 mkDataConWorkerOcc datacon_occ = setOccNameSpace varName datacon_occ
 503 \end{code}
 504
 505 \begin{code}
 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)
 511
 512 mkLocalOcc :: Unique            -- Unique
 513            -> OccName           -- Local name (e.g. "sat")
 514            -> OccName           -- Nice unique version ("$L23sat")
 515 mkLocalOcc uniq occ
 516    = mk_deriv varName ("$L" ++ show uniq) (occNameString occ)
 517         -- The Unique might print with characters
 518         -- that need encoding (e.g. 'z'!)
 519 \end{code}
 520
 521
 522 \begin{code}
 523 mkDFunOcc :: EncodedString      -- Typically the class and type glommed together e.g. "OrdMaybe"
 524           -> OccName            -- "$fOrdMaybe"
 525
 526 mkDFunOcc string = mk_deriv VarName "$f" string
 527 \end{code}
 528
 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)
 534
 535 The way it is now, -ddump-xx output may look confusing, but
 536 you can always say -dppr-debug to get the uniques.
 537
 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
 541
 542 e.g. a call to constructor MkFoo where
 543         data (Ord a) => Foo a = MkFoo a
 544
 545 If this is necessary, we do it by prefixing '$m'.  These
 546 guys never show up in error messages.  What a hack.
 547
 548 \begin{code}
 549 mkMethodOcc :: OccName -> OccName
 550 mkMethodOcc occ@(OccName VarName fs) = occ
 551 mkMethodOcc occ                      = mk_simple_deriv varName "$m" occ
 552 \end{code}
 553
 554
 555 %************************************************************************
 556 %*                                                                      *
 557 \subsection{Tidying them up}
 558 %*                                                                      *
 559 %************************************************************************
 560
 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.
 567
 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.
 571
 572 \begin{code}
 573 type TidyOccEnv = OccEnv Int    -- The in-scope OccNames
 574         -- Range gives a plausible starting point for new guesses
 575
 576 emptyTidyOccEnv = emptyOccEnv
 577
 578 initTidyOccEnv :: [OccName] -> TidyOccEnv       -- Initialise with names to avoid!
 579 initTidyOccEnv = foldl (\env occ -> extendOccEnv env occ 1) emptyTidyOccEnv
 580
 581 tidyOccName :: TidyOccEnv -> OccName -> (TidyOccEnv, OccName)
 582
 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)
 587
 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))
 592 \end{code}
 593
 594
 595 %************************************************************************
 596 %*                                                                      *
 597 \subsection{The 'Z' encoding}
 598 %*                                                                      *
 599 %************************************************************************
 600
 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.
 604
 605 The basic encoding scheme is this.
 606
 607 * Tuples (,,,) are coded as Z3T
 608
 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
 614
 615 * Most other printable characters translate to 'zx' or 'Zx' for some
 616         alphabetic character x
 617
 618 * The others translate as 'znnnU' where 'nnn' is the decimal number
 619         of the character
 620
 621         Before          After
 622         --------------------------
 623         Trak            Trak
 624         foo_wib         foozuwib
 625         >               zg
 626         >1              zg1
 627         foo#            foozh
 628         foo##           foozhzh
 629         foo##1          foozhzh1
 630         fooZ            fooZZ
 631         :+              ZCzp
 632         ()              Z0T     0-tuple
 633         (,,,,)          Z5T     5-tuple
 634         (# #)           Z1H     unboxed 1-tuple (note the space)
 635         (#,,,,#)        Z5H     unboxed 5-tuple
 636                 (NB: There is no Z1T nor Z0H.)
 637
 638 \begin{code}
 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
 644                  where
 645                    ok ' ' = True
 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
 649                         -- reject them here
 650                    ok ch  = isAlphaNum ch
 651
 652 alreadyEncodedFS :: FastString -> Bool
 653 alreadyEncodedFS fs = alreadyEncoded (unpackFS fs)
 654
 655 encode :: UserString -> EncodedString
 656 encode cs = case maybe_tuple cs of
 657                 Just n  -> n            -- Tuples go to Z2T etc
 658                 Nothing -> go cs
 659           where
 660                 go []     = []
 661                 go (c:cs) = encode_ch c ++ go cs
 662
 663 encodeFS :: UserFS -> EncodedFS
 664 encodeFS fast_str  | all unencodedChar str = fast_str
 665                    | otherwise             = mkFastString (encode str)
 666                    where
 667                      str = unpackFS fast_str
 668
 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'
 675
 676 encode_ch :: Char -> EncodedString
 677 encode_ch c | unencodedChar c = [c]     -- Common case first
 678
 679 -- Constructors
 680 encode_ch '('  = "ZL"   -- Needed for things like (,), and (->)
 681 encode_ch ')'  = "ZR"   -- For symmetry with (
 682 encode_ch '['  = "ZM"
 683 encode_ch ']'  = "ZN"
 684 encode_ch ':'  = "ZC"
 685 encode_ch 'Z'  = "ZZ"
 686
 687 -- Variables
 688 encode_ch 'z'  = "zz"
 689 encode_ch '&'  = "za"
 690 encode_ch '|'  = "zb"
 691 encode_ch '^'  = "zc"
 692 encode_ch '$'  = "zd"
 693 encode_ch '='  = "ze"
 694 encode_ch '>'  = "zg"
 695 encode_ch '#'  = "zh"
 696 encode_ch '.'  = "zi"
 697 encode_ch '<'  = "zl"
 698 encode_ch '-'  = "zm"
 699 encode_ch '!'  = "zn"
 700 encode_ch '+'  = "zp"
 701 encode_ch '\'' = "zq"
 702 encode_ch '\\' = "zr"
 703 encode_ch '/'  = "zs"
 704 encode_ch '*'  = "zt"
 705 encode_ch '_'  = "zu"
 706 encode_ch '%'  = "zv"
 707 encode_ch c    = 'z' : shows (ord c) "U"
 708 \end{code}
 709
 710 Decode is used for user printing.
 711
 712 \begin{code}
 713 decodeFS :: FastString -> FastString
 714 decodeFS fs = mkFastString (decode (unpackFS fs))
 715
 716 decode :: EncodedString -> UserString
 717 decode [] = []
 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
 723
 724 decode_upper, decode_lower :: Char -> Char
 725
 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
 733
 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
 754
 755 -- Characters not having a specific code are coded as z224U
 756 decode_num_esc d rest
 757   = go (digitToInt d) rest
 758   where
 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)
 762
 763 decode_tuple :: Char -> EncodedString -> UserString
 764 decode_tuple d rest
 765   = go (digitToInt d) rest
 766   where
 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)
 775 \end{code}
 776
 777
 778 %************************************************************************
 779 %*                                                                      *
 780                 Stuff for dealing with tuples
 781 %*                                                                      *
 782 %************************************************************************
 783
 784 Tuples are encoded as
 785         Z3T or Z3H
 786 for 3-tuples or unboxed 3-tuples respectively.  No other encoding starts
 787         Z<digit>
 788
 789 * "(# #)" is the tycon for an unboxed 1-tuple (not 0-tuple)
 790   There are no unboxed 0-tuples.
 791
 792 * "()" is the tycon for a boxed 0-tuple.
 793   There are no boxed 1-tuples.
 794
 795
 796 \begin{code}
 797 maybe_tuple :: UserString -> Maybe EncodedString
 798
 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")
 802                                  other               -> Nothing
 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")
 806                                  other         -> Nothing
 807 maybe_tuple other            = Nothing
 808
 809 count_commas :: Int -> String -> (Int, String)
 810 count_commas n (',' : cs) = count_commas (n+1) cs
 811 count_commas n cs         = (n,cs)
 812 \end{code}
 813
 814 \begin{code}
 815 mkTupleOcc :: NameSpace -> Boxity -> Arity -> OccName
 816 mkTupleOcc ns bx ar
 817   = OccName ns (mkFastString ('Z' : (show ar ++ bx_char)))
 818   where
 819     bx_char = case bx of
 820                 Boxed   -> "T"
 821                 Unboxed -> "H"
 822
 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)
 828         other                    -> Nothing
 829   where
 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
 833 \end{code}
 834
 835 %************************************************************************
 836 %*                                                                      *
 837 \subsection{Lexical categories}
 838 %*                                                                      *
 839 %************************************************************************
 840
 841 These functions test strings to see if they fit the lexical categories
 842 defined in the Haskell report.
 843
 844 \begin{code}
 845 isLexCon,   isLexVar,    isLexId,    isLexSym    :: FastString -> Bool
 846 isLexConId, isLexConSym, isLexVarId, isLexVarSym :: FastString -> Bool
 847
 848 isLexCon cs = isLexConId  cs || isLexConSym cs
 849 isLexVar cs = isLexVarId  cs || isLexVarSym cs
 850
 851 isLexId  cs = isLexConId  cs || isLexVarId  cs
 852 isLexSym cs = isLexConSym cs || isLexVarSym cs
 853
 854 -------------
 855
 856 isLexConId cs                           -- Prefix type or data constructors
 857   | nullFastString cs = False           --      e.g. "Foo", "[]", "(,)"
 858   | cs == FSLIT("[]") = True
 859   | otherwise         = startsConId (headFS cs)
 860
 861 isLexVarId cs                           -- Ordinary prefix identifiers
 862   | nullFastString cs = False           --      e.g. "x", "_x"
 863   | otherwise         = startsVarId (headFS cs)
 864
 865 isLexConSym cs                          -- Infix type or data constructors
 866   | nullFastString cs = False           --      e.g. ":-:", ":", "->"
 867   | cs == FSLIT("->") = True
 868   | otherwise         = startsConSym (headFS cs)
 869
 870 isLexVarSym cs                          -- Infix identifiers
 871   | nullFastString cs = False           --      e.g. "+"
 872   | otherwise         = startsVarSym (headFS cs)
 873
 874 -------------
 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
 880
 881
 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
 888 \end{code}
 889
 890 %************************************************************************
 891 %*                                                                      *
 892                 Binary instance
 893     Here rather than BinIface because OccName is abstract
 894 %*                                                                      *
 895 %************************************************************************
 896
 897 \begin{code}
 898 instance Binary NameSpace where
 899     put_ bh VarName = do
 900             putByte bh 0
 901     put_ bh DataName = do
 902             putByte bh 1
 903     put_ bh TvName = do
 904             putByte bh 2
 905     put_ bh TcClsName = do
 906             putByte bh 3
 907     get bh = do
 908             h <- getByte bh
 909             case h of
 910               0 -> do return VarName
 911               1 -> do return DataName
 912               2 -> do return TvName
 913               _ -> do return TcClsName
 914
 915 instance Binary OccName where
 916     put_ bh (OccName aa ab) = do
 917             put_ bh aa
 918             put_ bh ab
 919     get bh = do
 920           aa <- get bh
 921           ab <- get bh
 922           return (OccName aa ab)
 923 \end{code}