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         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 -> 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)   = "Variable"
 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 VarName s)  = isLexSym (decodeFS s)
 407 isSymOcc other                = False
 408 \end{code}
 409
 410
 411 \begin{code}
 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
 416                         ('_' : _) -> False
 417                         zz_other  -> True
 418 \end{code}
 419
 420
 421
 422 %************************************************************************
 423 %*                                                                      *
 424 \subsection{Making system names}
 425 %*                                                                      *
 426 %************************************************************************
 427
 428 Here's our convention for splitting up the interface file name space:
 429
 430         d...            dictionary identifiers
 431                         (local variables, so no name-clash worries)
 432
 433         $f...           dict-fun identifiers (from inst decls)
 434         $dm...          default methods
 435         $p...           superclass selectors
 436         $w...           workers
 437         :T...           compiler-generated tycons for dictionaries
 438         :D...           ...ditto data cons
 439         $sf..           specialised version of f
 440
 441         in encoded form these appear as Zdfxxx etc
 442
 443         :...            keywords (export:, letrec: etc.)
 444 --- I THINK THIS IS WRONG!
 445
 446 This knowledge is encoded in the following functions.
 447
 448
 449 @mk_deriv@ generates an @OccName@ from the prefix and a string.
 450 NB: The string must already be encoded!
 451
 452 \begin{code}
 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
 457          -> OccName
 458
 459 mk_deriv occ_sp sys_prefix str = mkSysOcc occ_sp (encode sys_prefix ++ str)
 460 \end{code}
 461
 462 \begin{code}
 463 mkDictOcc, mkIPOcc, mkWorkerOcc, mkDefaultMethodOcc,
 464            mkClassTyConOcc, mkClassDataConOcc, mkSpecOcc
 465    :: OccName -> OccName
 466
 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"
 479
 480 -- Generic derivable classes
 481 mkGenOcc1           = mk_simple_deriv varName  "$gfrom"
 482 mkGenOcc2           = mk_simple_deriv varName  "$gto"
 483
 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"
 489
 490 mk_simple_deriv sp px occ = mk_deriv sp px (occNameString occ)
 491
 492
 493 -- Data constructor workers are made by setting the name space
 494 -- of the data constructor OccName (which should be a DataName)
 495 -- to DataName
 496 mkDataConWorkerOcc datacon_occ = setOccNameSpace varName datacon_occ
 497 \end{code}
 498
 499 \begin{code}
 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)
 505
 506 mkLocalOcc :: Unique            -- Unique
 507            -> OccName           -- Local name (e.g. "sat")
 508            -> OccName           -- Nice unique version ("$L23sat")
 509 mkLocalOcc uniq occ
 510    = mk_deriv varName ("$L" ++ show uniq) (occNameString occ)
 511         -- The Unique might print with characters
 512         -- that need encoding (e.g. 'z'!)
 513 \end{code}
 514
 515
 516 \begin{code}
 517 mkDFunOcc :: EncodedString      -- Typically the class and type glommed together e.g. "OrdMaybe"
 518           -> OccName            -- "$fOrdMaybe"
 519
 520 mkDFunOcc string = mk_deriv VarName "$f" string
 521 \end{code}
 522
 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)
 528
 529 The way it is now, -ddump-xx output may look confusing, but
 530 you can always say -dppr-debug to get the uniques.
 531
 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
 535
 536 e.g. a call to constructor MkFoo where
 537         data (Ord a) => Foo a = MkFoo a
 538
 539 If this is necessary, we do it by prefixing '$m'.  These
 540 guys never show up in error messages.  What a hack.
 541
 542 \begin{code}
 543 mkMethodOcc :: OccName -> OccName
 544 mkMethodOcc occ@(OccName VarName fs) = occ
 545 mkMethodOcc occ                      = mk_simple_deriv varName "$m" occ
 546 \end{code}
 547
 548
 549 %************************************************************************
 550 %*                                                                      *
 551 \subsection{Tidying them up}
 552 %*                                                                      *
 553 %************************************************************************
 554
 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.
 561
 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.
 565
 566 \begin{code}
 567 type TidyOccEnv = OccEnv Int    -- The in-scope OccNames
 568         -- Range gives a plausible starting point for new guesses
 569
 570 emptyTidyOccEnv = emptyOccEnv
 571
 572 initTidyOccEnv :: [OccName] -> TidyOccEnv       -- Initialise with names to avoid!
 573 initTidyOccEnv = foldl (\env occ -> extendOccEnv env occ 1) emptyTidyOccEnv
 574
 575 tidyOccName :: TidyOccEnv -> OccName -> (TidyOccEnv, OccName)
 576
 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)
 581
 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))
 586 \end{code}
 587
 588
 589 %************************************************************************
 590 %*                                                                      *
 591 \subsection{The 'Z' encoding}
 592 %*                                                                      *
 593 %************************************************************************
 594
 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.
 598
 599 The basic encoding scheme is this.
 600
 601 * Tuples (,,,) are coded as Z3T
 602
 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
 608
 609 * Most other printable characters translate to 'zx' or 'Zx' for some
 610         alphabetic character x
 611
 612 * The others translate as 'znnnU' where 'nnn' is the decimal number
 613         of the character
 614
 615         Before          After
 616         --------------------------
 617         Trak            Trak
 618         foo_wib         foozuwib
 619         >               zg
 620         >1              zg1
 621         foo#            foozh
 622         foo##           foozhzh
 623         foo##1          foozhzh1
 624         fooZ            fooZZ
 625         :+              ZCzp
 626         ()              Z0T     0-tuple
 627         (,,,,)          Z5T     5-tuple
 628         (# #)           Z1H     unboxed 1-tuple (note the space)
 629         (#,,,,#)        Z5H     unboxed 5-tuple
 630                 (NB: There is no Z1T nor Z0H.)
 631
 632 \begin{code}
 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
 638                  where
 639                    ok ' ' = True
 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
 643                         -- reject them here
 644                    ok ch  = isAlphaNum ch
 645
 646 alreadyEncodedFS :: FastString -> Bool
 647 alreadyEncodedFS fs = alreadyEncoded (unpackFS fs)
 648
 649 encode :: UserString -> EncodedString
 650 encode cs = case maybe_tuple cs of
 651                 Just n  -> n            -- Tuples go to Z2T etc
 652                 Nothing -> go cs
 653           where
 654                 go []     = []
 655                 go (c:cs) = encode_ch c ++ go cs
 656
 657 encodeFS :: UserFS -> EncodedFS
 658 encodeFS fast_str  | all unencodedChar str = fast_str
 659                    | otherwise             = mkFastString (encode str)
 660                    where
 661                      str = unpackFS fast_str
 662
 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'
 669
 670 encode_ch :: Char -> EncodedString
 671 encode_ch c | unencodedChar c = [c]     -- Common case first
 672
 673 -- Constructors
 674 encode_ch '('  = "ZL"   -- Needed for things like (,), and (->)
 675 encode_ch ')'  = "ZR"   -- For symmetry with (
 676 encode_ch '['  = "ZM"
 677 encode_ch ']'  = "ZN"
 678 encode_ch ':'  = "ZC"
 679 encode_ch 'Z'  = "ZZ"
 680
 681 -- Variables
 682 encode_ch 'z'  = "zz"
 683 encode_ch '&'  = "za"
 684 encode_ch '|'  = "zb"
 685 encode_ch '^'  = "zc"
 686 encode_ch '$'  = "zd"
 687 encode_ch '='  = "ze"
 688 encode_ch '>'  = "zg"
 689 encode_ch '#'  = "zh"
 690 encode_ch '.'  = "zi"
 691 encode_ch '<'  = "zl"
 692 encode_ch '-'  = "zm"
 693 encode_ch '!'  = "zn"
 694 encode_ch '+'  = "zp"
 695 encode_ch '\'' = "zq"
 696 encode_ch '\\' = "zr"
 697 encode_ch '/'  = "zs"
 698 encode_ch '*'  = "zt"
 699 encode_ch '_'  = "zu"
 700 encode_ch '%'  = "zv"
 701 encode_ch c    = 'z' : shows (ord c) "U"
 702 \end{code}
 703
 704 Decode is used for user printing.
 705
 706 \begin{code}
 707 decodeFS :: FastString -> FastString
 708 decodeFS fs = mkFastString (decode (unpackFS fs))
 709
 710 decode :: EncodedString -> UserString
 711 decode [] = []
 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
 717
 718 decode_upper, decode_lower :: Char -> Char
 719
 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
 727
 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
 748
 749 -- Characters not having a specific code are coded as z224U
 750 decode_num_esc d rest
 751   = go (digitToInt d) rest
 752   where
 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)
 756 \end{code}
 757
 758
 759 %************************************************************************
 760 %*                                                                      *
 761                 Stuff for dealing with tuples
 762 %*                                                                      *
 763 %************************************************************************
 764
 765 Tuples are encoded as
 766         Z3T or Z3H
 767 for 3-tuples or unboxed 3-tuples respectively.  No other encoding starts
 768         Z<digit>
 769
 770 * "(# #)" is the tycon for an unboxed 1-tuple (not 0-tuple)
 771   There are no unboxed 0-tuples.
 772
 773 * "()" is the tycon for a boxed 0-tuple.
 774   There are no boxed 1-tuples.
 775
 776
 777 \begin{code}
 778 maybe_tuple :: UserString -> Maybe EncodedString
 779
 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")
 783                                  other               -> Nothing
 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")
 787                                  other         -> Nothing
 788 maybe_tuple other            = Nothing
 789
 790 count_commas :: Int -> String -> (Int, String)
 791 count_commas n (',' : cs) = count_commas (n+1) cs
 792 count_commas n cs         = (n,cs)
 793 \end{code}
 794
 795 \begin{code}
 796 decode_tuple :: Char -> EncodedString -> UserString
 797 decode_tuple d rest
 798   = go (digitToInt d) rest
 799   where
 800     go n (c : rest) | isDigit c = go (10*n + digitToInt c) rest
 801     go 0 ['T']                  = "()"
 802     go n ['T']                  = '(' : replicate (n-1) ',' ++ ")"
 803     go 1 ['H']                  = "(# #)"
 804     go n ['H']                  = '(' : '#' : replicate (n-1) ',' ++ "#)"
 805     go n other = pprPanic "decode_tuple" (ppr n <+> text other)
 806
 807 mkTupleOcc :: NameSpace -> Boxity -> Arity -> OccName
 808 mkTupleOcc ns bx ar
 809   = OccName ns (mkFastString ('Z' : (show ar ++ bx_char)))
 810   where
 811     bx_char = case bx of
 812                 Boxed   -> "T"
 813                 Unboxed -> "H"
 814
 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)
 820         other                    -> Nothing
 821   where
 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
 825 \end{code}
 826
 827 %************************************************************************
 828 %*                                                                      *
 829 \subsection{Lexical categories}
 830 %*                                                                      *
 831 %************************************************************************
 832
 833 These functions test strings to see if they fit the lexical categories
 834 defined in the Haskell report.
 835
 836 \begin{code}
 837 isLexCon,   isLexVar,    isLexId,    isLexSym    :: FastString -> Bool
 838 isLexConId, isLexConSym, isLexVarId, isLexVarSym :: FastString -> Bool
 839
 840 isLexCon cs = isLexConId  cs || isLexConSym cs
 841 isLexVar cs = isLexVarId  cs || isLexVarSym cs
 842
 843 isLexId  cs = isLexConId  cs || isLexVarId  cs
 844 isLexSym cs = isLexConSym cs || isLexVarSym cs
 845
 846 -------------
 847
 848 isLexConId cs                           -- Prefix type or data constructors
 849   | nullFastString cs = False           --      e.g. "Foo", "[]", "(,)"
 850   | cs == FSLIT("[]") = True
 851   | otherwise         = startsConId (headFS cs)
 852
 853 isLexVarId cs                           -- Ordinary prefix identifiers
 854   | nullFastString cs = False           --      e.g. "x", "_x"
 855   | otherwise         = startsVarId (headFS cs)
 856
 857 isLexConSym cs                          -- Infix type or data constructors
 858   | nullFastString cs = False           --      e.g. ":-:", ":", "->"
 859   | cs == FSLIT("->") = True
 860   | otherwise         = startsConSym (headFS cs)
 861
 862 isLexVarSym cs                          -- Infix identifiers
 863   | nullFastString cs = False           --      e.g. "+"
 864   | otherwise         = startsVarSym (headFS cs)
 865
 866 -------------
 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
 872
 873
 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
 880 \end{code}
 881
 882 %************************************************************************
 883 %*                                                                      *
 884                 Binary instance
 885     Here rather than BinIface because OccName is abstract
 886 %*                                                                      *
 887 %************************************************************************
 888
 889 \begin{code}
 890 instance Binary NameSpace where
 891     put_ bh VarName = do
 892             putByte bh 0
 893     put_ bh DataName = do
 894             putByte bh 1
 895     put_ bh TvName = do
 896             putByte bh 2
 897     put_ bh TcClsName = do
 898             putByte bh 3
 899     get bh = do
 900             h <- getByte bh
 901             case h of
 902               0 -> do return VarName
 903               1 -> do return DataName
 904               2 -> do return TvName
 905               _ -> do return TcClsName
 906
 907 instance Binary OccName where
 908     put_ bh (OccName aa ab) = do
 909             put_ bh aa
 910             put_ bh ab
 911     get bh = do
 912           aa <- get bh
 913           ab <- get bh
 914           return (OccName aa ab)
 915 \end{code}