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, mkTyVarOcc,
  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 StaticFlags ( opt_PprStyle_Debug )
  66 import UniqFM
  67 import UniqSet
  68 import FastString
  69 import Outputable
  70 import Binary
  71
  72 import GLAEXTS
  73 \end{code}
  74
  75 We hold both module names and identifier names in a 'Z-encoded' form
  76 that makes them acceptable both as a C identifier and as a Haskell
  77 (prefix) identifier.
  78
  79 They can always be decoded again when printing error messages
  80 or anything else for the user, but it does make sense for it
  81 to be represented here in encoded form, so that when generating
  82 code the encoding operation is not performed on each occurrence.
  83
  84 These type synonyms help documentation.
  85
  86 \begin{code}
  87 type UserFS    = FastString     -- As the user typed it
  88 type EncodedFS = FastString     -- Encoded form
  89
  90 type UserString = String        -- As the user typed it
  91 type EncodedString = String     -- Encoded form
  92
  93
  94 pprEncodedFS :: EncodedFS -> SDoc
  95 pprEncodedFS fs
  96   = getPprStyle         $ \ sty ->
  97     if userStyle sty || dumpStyle sty
  98         -- ftext (decodeFS fs) would needlessly pack the string again
  99         then text (decode (unpackFS fs))
 100         else ftext fs
 101 \end{code}
 102
 103 %************************************************************************
 104 %*                                                                      *
 105 \subsection{Name space}
 106 %*                                                                      *
 107 %************************************************************************
 108
 109 \begin{code}
 110 data NameSpace = VarName        -- Variables, including "source" data constructors
 111                | DataName       -- "Real" data constructors
 112                | TvName         -- Type variables
 113                | TcClsName      -- Type constructors and classes; Haskell has them
 114                                 -- in the same name space for now.
 115                deriving( Eq, Ord )
 116    {-! derive: Binary !-}
 117
 118 -- Note [Data Constructors]
 119 -- see also: Note [Data Constructor Naming] in DataCon.lhs
 120 --
 121 --      "Source" data constructors are the data constructors mentioned
 122 --      in Haskell source code
 123 --
 124 --      "Real" data constructors are the data constructors of the
 125 --      representation type, which may not be the same as the source
 126 --      type
 127
 128 -- Example:
 129 --      data T = T !(Int,Int)
 130 --
 131 -- The source datacon has type (Int,Int) -> T
 132 -- The real   datacon has type Int -> Int -> T
 133 -- GHC chooses a representation based on the strictness etc.
 134
 135
 136 -- Though type constructors and classes are in the same name space now,
 137 -- the NameSpace type is abstract, so we can easily separate them later
 138 tcName    = TcClsName           -- Type constructors
 139 clsName   = TcClsName           -- Classes
 140 tcClsName = TcClsName           -- Not sure which!
 141
 142 dataName    = DataName
 143 srcDataName = DataName  -- Haskell-source data constructors should be
 144                         -- in the Data name space
 145
 146 tvName      = TvName
 147 varName     = VarName
 148
 149 nameSpaceString :: NameSpace -> String
 150 nameSpaceString DataName  = "Data constructor"
 151 nameSpaceString VarName   = "Variable"
 152 nameSpaceString TvName    = "Type variable"
 153 nameSpaceString TcClsName = "Type constructor or class"
 154 \end{code}
 155
 156
 157 %************************************************************************
 158 %*                                                                      *
 159 \subsection[Name-pieces-datatypes]{The @OccName@ datatypes}
 160 %*                                                                      *
 161 %************************************************************************
 162
 163 \begin{code}
 164 data OccName = OccName
 165     { occNameSpace  :: !NameSpace
 166     , occNameFS     :: !EncodedFS
 167     }
 168 \end{code}
 169
 170
 171 \begin{code}
 172 instance Eq OccName where
 173     (OccName sp1 s1) == (OccName sp2 s2) = s1 == s2 && sp1 == sp2
 174
 175 instance Ord OccName where
 176     compare (OccName sp1 s1) (OccName sp2 s2) = (s1  `compare` s2) `thenCmp`
 177                                                 (sp1 `compare` sp2)
 178 \end{code}
 179
 180
 181 %************************************************************************
 182 %*                                                                      *
 183 \subsection{Printing}
 184 %*                                                                      *
 185 %************************************************************************
 186
 187 \begin{code}
 188 instance Outputable OccName where
 189     ppr = pprOccName
 190
 191 pprOccName :: OccName -> SDoc
 192 pprOccName (OccName sp occ)
 193   = getPprStyle $ \ sty ->
 194     pprEncodedFS occ <> if debugStyle sty then
 195                            braces (text (briefNameSpaceFlavour sp))
 196                         else empty
 197 \end{code}
 198
 199
 200 %************************************************************************
 201 %*                                                                      *
 202 \subsection{Construction}
 203 %*                                                                      *
 204 %*****p*******************************************************************
 205
 206 *Sys* things do no encoding; the caller should ensure that the thing is
 207 already encoded
 208
 209 \begin{code}
 210 mkSysOcc :: NameSpace -> EncodedString -> OccName
 211 mkSysOcc occ_sp str = ASSERT2( alreadyEncoded str, text str )
 212                       OccName occ_sp (mkFastString str)
 213
 214 mkSysOccFS :: NameSpace -> EncodedFS -> OccName
 215 mkSysOccFS occ_sp fs = ASSERT2( alreadyEncodedFS fs, ppr fs )
 216                        OccName occ_sp fs
 217
 218 mkFCallOcc :: EncodedString -> OccName
 219 -- This version of mkSysOcc doesn't check that the string is already encoded,
 220 -- because it will be something like "{__ccall f dyn Int# -> Int#}"
 221 -- This encodes a lot into something that then parses like an Id.
 222 -- But then alreadyEncoded complains about the braces!
 223 mkFCallOcc str = OccName varName (mkFastString str)
 224
 225 -- Kind constructors get a special function.  Uniquely, they are not encoded,
 226 -- so that they have names like '*'.  This means that *even in interface files*
 227 -- we'll get kinds like (* -> (* -> *)).  We can't use mkSysOcc because it
 228 -- has an ASSERT that doesn't hold.
 229 mkKindOccFS :: NameSpace -> EncodedFS -> OccName
 230 mkKindOccFS occ_sp fs = OccName occ_sp fs
 231 \end{code}
 232
 233 *Source-code* things are encoded.
 234
 235 \begin{code}
 236 mkOccFS :: NameSpace -> UserFS -> OccName
 237 mkOccFS occ_sp fs = mkSysOccFS occ_sp (encodeFS fs)
 238
 239 mkOccName :: NameSpace -> String -> OccName
 240 mkOccName ns s = mkSysOcc ns (encode s)
 241
 242 mkVarOcc :: UserFS -> OccName
 243 mkVarOcc fs = mkSysOccFS varName (encodeFS fs)
 244
 245 mkTyVarOcc :: UserFS -> OccName
 246 mkTyVarOcc fs = mkSysOccFS tvName (encodeFS fs)
 247
 248 mkVarOccEncoded :: EncodedFS -> OccName
 249 mkVarOccEncoded fs = mkSysOccFS varName fs
 250 \end{code}
 251
 252
 253
 254 %************************************************************************
 255 %*                                                                      *
 256                 Environments
 257 %*                                                                      *
 258 %************************************************************************
 259
 260 OccEnvs are used mainly for the envts in ModIfaces.
 261
 262 They are efficient, because FastStrings have unique Int# keys.  We assume
 263 this key is less than 2^24, so we can make a Unique using
 264         mkUnique ns key  :: Unique
 265 where 'ns' is a Char reprsenting the name space.  This in turn makes it
 266 easy to build an OccEnv.
 267
 268 \begin{code}
 269 instance Uniquable OccName where
 270   getUnique (OccName ns fs)
 271       = mkUnique char (I# (uniqueOfFS fs))
 272       where     -- See notes above about this getUnique function
 273         char = case ns of
 274                 VarName   -> 'i'
 275                 DataName  -> 'd'
 276                 TvName    -> 'v'
 277                 TcClsName -> 't'
 278
 279 type OccEnv a = UniqFM a
 280
 281 emptyOccEnv :: OccEnv a
 282 unitOccEnv  :: OccName -> a -> OccEnv a
 283 extendOccEnv :: OccEnv a -> OccName -> a -> OccEnv a
 284 extendOccEnvList :: OccEnv a -> [(OccName, a)] -> OccEnv a
 285 lookupOccEnv :: OccEnv a -> OccName -> Maybe a
 286 mkOccEnv     :: [(OccName,a)] -> OccEnv a
 287 elemOccEnv   :: OccName -> OccEnv a -> Bool
 288 foldOccEnv   :: (a -> b -> b) -> b -> OccEnv a -> b
 289 occEnvElts   :: OccEnv a -> [a]
 290 extendOccEnv_C :: (a->a->a) -> OccEnv a -> OccName -> a -> OccEnv a
 291 plusOccEnv     :: OccEnv a -> OccEnv a -> OccEnv a
 292 plusOccEnv_C   :: (a->a->a) -> OccEnv a -> OccEnv a -> OccEnv a
 293
 294 emptyOccEnv      = emptyUFM
 295 unitOccEnv       = unitUFM
 296 extendOccEnv     = addToUFM
 297 extendOccEnvList = addListToUFM
 298 lookupOccEnv     = lookupUFM
 299 mkOccEnv         = listToUFM
 300 elemOccEnv       = elemUFM
 301 foldOccEnv       = foldUFM
 302 occEnvElts       = eltsUFM
 303 plusOccEnv       = plusUFM
 304 plusOccEnv_C     = plusUFM_C
 305 extendOccEnv_C   = addToUFM_C
 306
 307
 308 type OccSet = UniqFM OccName
 309
 310 emptyOccSet       :: OccSet
 311 unitOccSet        :: OccName -> OccSet
 312 mkOccSet          :: [OccName] -> OccSet
 313 extendOccSet      :: OccSet -> OccName -> OccSet
 314 extendOccSetList  :: OccSet -> [OccName] -> OccSet
 315 unionOccSets      :: OccSet -> OccSet -> OccSet
 316 unionManyOccSets  :: [OccSet] -> OccSet
 317 minusOccSet       :: OccSet -> OccSet -> OccSet
 318 elemOccSet        :: OccName -> OccSet -> Bool
 319 occSetElts        :: OccSet -> [OccName]
 320 foldOccSet        :: (OccName -> b -> b) -> b -> OccSet -> b
 321 isEmptyOccSet     :: OccSet -> Bool
 322 intersectOccSet   :: OccSet -> OccSet -> OccSet
 323 intersectsOccSet  :: OccSet -> OccSet -> Bool
 324
 325 emptyOccSet       = emptyUniqSet
 326 unitOccSet        = unitUniqSet
 327 mkOccSet          = mkUniqSet
 328 extendOccSet      = addOneToUniqSet
 329 extendOccSetList  = addListToUniqSet
 330 unionOccSets      = unionUniqSets
 331 unionManyOccSets  = unionManyUniqSets
 332 minusOccSet       = minusUniqSet
 333 elemOccSet        = elementOfUniqSet
 334 occSetElts        = uniqSetToList
 335 foldOccSet        = foldUniqSet
 336 isEmptyOccSet     = isEmptyUniqSet
 337 intersectOccSet   = intersectUniqSets
 338 intersectsOccSet s1 s2 = not (isEmptyOccSet (s1 `intersectOccSet` s2))
 339 \end{code}
 340
 341
 342 %************************************************************************
 343 %*                                                                      *
 344 \subsection{Predicates and taking them apart}
 345 %*                                                                      *
 346 %************************************************************************
 347
 348 \begin{code}
 349 occNameString :: OccName -> EncodedString
 350 occNameString (OccName _ s) = unpackFS s
 351
 352 occNameUserString :: OccName -> UserString
 353 occNameUserString occ = decode (occNameString occ)
 354
 355 setOccNameSpace :: NameSpace -> OccName -> OccName
 356 setOccNameSpace sp (OccName _ occ) = OccName sp occ
 357
 358 -- occNameFlavour is used only to generate good error messages
 359 occNameFlavour :: OccName -> SDoc
 360 occNameFlavour (OccName DataName _)  = ptext SLIT("data constructor")
 361 occNameFlavour (OccName TvName _)    = ptext SLIT("type variable")
 362 occNameFlavour (OccName TcClsName _) = ptext SLIT("type constructor or class")
 363 occNameFlavour (OccName VarName s)   = empty
 364
 365 -- briefOccNameFlavour is used in debug-printing of names
 366 briefOccNameFlavour :: OccName -> String
 367 briefOccNameFlavour (OccName sp _) = briefNameSpaceFlavour sp
 368
 369 briefNameSpaceFlavour DataName  = "d"
 370 briefNameSpaceFlavour VarName   = "v"
 371 briefNameSpaceFlavour TvName    = "tv"
 372 briefNameSpaceFlavour TcClsName = "tc"
 373 \end{code}
 374
 375 \begin{code}
 376 isVarOcc, isTvOcc, isDataSymOcc, isSymOcc, isTcOcc :: OccName -> Bool
 377
 378 isVarOcc (OccName VarName _) = True
 379 isVarOcc other               = False
 380
 381 isTvOcc (OccName TvName _) = True
 382 isTvOcc other              = False
 383
 384 isTcOcc (OccName TcClsName _) = True
 385 isTcOcc other                 = False
 386
 387 isValOcc (OccName VarName  _) = True
 388 isValOcc (OccName DataName _) = True
 389 isValOcc other                = False
 390
 391 -- Data constructor operator (starts with ':', or '[]')
 392 -- Pretty inefficient!
 393 isDataSymOcc (OccName DataName s) = isLexConSym (decodeFS s)
 394 isDataSymOcc (OccName VarName s)  = isLexConSym (decodeFS s)
 395 isDataSymOcc other                = False
 396
 397 isDataOcc (OccName DataName _) = True
 398 isDataOcc (OccName VarName s)  = isLexCon (decodeFS s)
 399 isDataOcc other                = False
 400
 401 -- Any operator (data constructor or variable)
 402 -- Pretty inefficient!
 403 isSymOcc (OccName DataName s)  = isLexConSym (decodeFS s)
 404 isSymOcc (OccName TcClsName s) = isLexConSym (decodeFS s)
 405 isSymOcc (OccName VarName s)   = isLexSym (decodeFS s)
 406 isSymOcc other                 = False
 407
 408 parenSymOcc :: OccName -> SDoc -> SDoc
 409 -- Wrap parens around an operator
 410 parenSymOcc occ doc | isSymOcc occ = parens doc
 411                     | otherwise    = doc
 412 \end{code}
 413
 414
 415 \begin{code}
 416 reportIfUnused :: OccName -> Bool
 417   -- Haskell 98 encourages compilers to suppress warnings about
 418   -- unused names in a pattern if they start with "_".
 419 reportIfUnused occ = case occNameUserString occ of
 420                         ('_' : _) -> False
 421                         zz_other  -> True
 422 \end{code}
 423
 424
 425
 426 %************************************************************************
 427 %*                                                                      *
 428 \subsection{Making system names}
 429 %*                                                                      *
 430 %************************************************************************
 431
 432 Here's our convention for splitting up the interface file name space:
 433
 434         d...            dictionary identifiers
 435                         (local variables, so no name-clash worries)
 436
 437         $f...           dict-fun identifiers (from inst decls)
 438         $dm...          default methods
 439         $p...           superclass selectors
 440         $w...           workers
 441         :T...           compiler-generated tycons for dictionaries
 442         :D...           ...ditto data cons
 443         $sf..           specialised version of f
 444
 445         in encoded form these appear as Zdfxxx etc
 446
 447         :...            keywords (export:, letrec: etc.)
 448 --- I THINK THIS IS WRONG!
 449
 450 This knowledge is encoded in the following functions.
 451
 452
 453 @mk_deriv@ generates an @OccName@ from the prefix and a string.
 454 NB: The string must already be encoded!
 455
 456 \begin{code}
 457 mk_deriv :: NameSpace
 458          -> String              -- Distinguishes one sort of derived name from another
 459          -> EncodedString       -- Must be already encoded!!  We don't want to encode it a
 460                                 -- second time because encoding isn't idempotent
 461          -> OccName
 462
 463 mk_deriv occ_sp sys_prefix str = mkSysOcc occ_sp (encode sys_prefix ++ str)
 464 \end{code}
 465
 466 \begin{code}
 467 mkDictOcc, mkIPOcc, mkWorkerOcc, mkDefaultMethodOcc,
 468            mkClassTyConOcc, mkClassDataConOcc, mkSpecOcc
 469    :: OccName -> OccName
 470
 471 -- These derived variables have a prefix that no Haskell value could have
 472 mkDataConWrapperOcc = mk_simple_deriv varName  "$W"
 473 mkWorkerOcc         = mk_simple_deriv varName  "$w"
 474 mkDefaultMethodOcc  = mk_simple_deriv varName  "$dm"
 475 mkDerivedTyConOcc   = mk_simple_deriv tcName   ":"      -- The : prefix makes sure it classifies
 476 mkClassTyConOcc     = mk_simple_deriv tcName   ":T"     -- as a tycon/datacon
 477 mkClassDataConOcc   = mk_simple_deriv dataName ":D"     -- We go straight to the "real" data con
 478                                                         -- for datacons from classes
 479 mkDictOcc           = mk_simple_deriv varName  "$d"
 480 mkIPOcc             = mk_simple_deriv varName  "$i"
 481 mkSpecOcc           = mk_simple_deriv varName  "$s"
 482 mkForeignExportOcc  = mk_simple_deriv varName  "$f"
 483
 484 -- Generic derivable classes
 485 mkGenOcc1           = mk_simple_deriv varName  "$gfrom"
 486 mkGenOcc2           = mk_simple_deriv varName  "$gto"
 487
 488 -- data T = MkT ... deriving( Data ) needs defintions for
 489 --      $tT   :: Data.Generics.Basics.DataType
 490 --      $cMkT :: Data.Generics.Basics.Constr
 491 mkDataTOcc = mk_simple_deriv varName  "$t"
 492 mkDataCOcc = mk_simple_deriv varName  "$c"
 493
 494 mk_simple_deriv sp px occ = mk_deriv sp px (occNameString occ)
 495
 496
 497 -- Data constructor workers are made by setting the name space
 498 -- of the data constructor OccName (which should be a DataName)
 499 -- to VarName
 500 mkDataConWorkerOcc datacon_occ = setOccNameSpace varName datacon_occ
 501 \end{code}
 502
 503 \begin{code}
 504 mkSuperDictSelOcc :: Int        -- Index of superclass, eg 3
 505                   -> OccName    -- Class, eg "Ord"
 506                   -> OccName    -- eg "$p3Ord"
 507 mkSuperDictSelOcc index cls_occ
 508   = mk_deriv varName "$p" (show index ++ occNameString cls_occ)
 509
 510 mkLocalOcc :: Unique            -- Unique
 511            -> OccName           -- Local name (e.g. "sat")
 512            -> OccName           -- Nice unique version ("$L23sat")
 513 mkLocalOcc uniq occ
 514    = mk_deriv varName ("$L" ++ show uniq) (occNameString occ)
 515         -- The Unique might print with characters
 516         -- that need encoding (e.g. 'z'!)
 517 \end{code}
 518
 519
 520 \begin{code}
 521 mkDFunOcc :: EncodedString      -- Typically the class and type glommed together e.g. "OrdMaybe"
 522                                 -- Only used in debug mode, for extra clarity
 523           -> Bool               -- True <=> hs-boot instance dfun
 524           -> Int                -- Unique index
 525           -> OccName            -- "$f3OrdMaybe"
 526
 527 -- In hs-boot files we make dict funs like $fx7ClsTy, which get bound to the real
 528 -- thing when we compile the mother module. Reason: we don't know exactly
 529 -- what the  mother module will call it.
 530
 531 mkDFunOcc info_str is_boot index
 532   = mk_deriv VarName prefix string
 533   where
 534     prefix | is_boot   = "$fx"
 535            | otherwise = "$f"
 536     string | opt_PprStyle_Debug = show index ++ info_str
 537            | otherwise          = show index
 538 \end{code}
 539
 540 We used to add a '$m' to indicate a method, but that gives rise to bad
 541 error messages from the type checker when we print the function name or pattern
 542 of an instance-decl binding.  Why? Because the binding is zapped
 543 to use the method name in place of the selector name.
 544 (See TcClassDcl.tcMethodBind)
 545
 546 The way it is now, -ddump-xx output may look confusing, but
 547 you can always say -dppr-debug to get the uniques.
 548
 549 However, we *do* have to zap the first character to be lower case,
 550 because overloaded constructors (blarg) generate methods too.
 551 And convert to VarName space
 552
 553 e.g. a call to constructor MkFoo where
 554         data (Ord a) => Foo a = MkFoo a
 555
 556 If this is necessary, we do it by prefixing '$m'.  These
 557 guys never show up in error messages.  What a hack.
 558
 559 \begin{code}
 560 mkMethodOcc :: OccName -> OccName
 561 mkMethodOcc occ@(OccName VarName fs) = occ
 562 mkMethodOcc occ                      = mk_simple_deriv varName "$m" occ
 563 \end{code}
 564
 565
 566 %************************************************************************
 567 %*                                                                      *
 568 \subsection{Tidying them up}
 569 %*                                                                      *
 570 %************************************************************************
 571
 572 Before we print chunks of code we like to rename it so that
 573 we don't have to print lots of silly uniques in it.  But we mustn't
 574 accidentally introduce name clashes!  So the idea is that we leave the
 575 OccName alone unless it accidentally clashes with one that is already
 576 in scope; if so, we tack on '1' at the end and try again, then '2', and
 577 so on till we find a unique one.
 578
 579 There's a wrinkle for operators.  Consider '>>='.  We can't use '>>=1'
 580 because that isn't a single lexeme.  So we encode it to 'lle' and *then*
 581 tack on the '1', if necessary.
 582
 583 \begin{code}
 584 type TidyOccEnv = OccEnv Int    -- The in-scope OccNames
 585         -- Range gives a plausible starting point for new guesses
 586
 587 emptyTidyOccEnv = emptyOccEnv
 588
 589 initTidyOccEnv :: [OccName] -> TidyOccEnv       -- Initialise with names to avoid!
 590 initTidyOccEnv = foldl (\env occ -> extendOccEnv env occ 1) emptyTidyOccEnv
 591
 592 tidyOccName :: TidyOccEnv -> OccName -> (TidyOccEnv, OccName)
 593
 594 tidyOccName in_scope occ@(OccName occ_sp fs)
 595   = case lookupOccEnv in_scope occ of
 596         Nothing ->      -- Not already used: make it used
 597                    (extendOccEnv in_scope occ 1, occ)
 598
 599         Just n  ->      -- Already used: make a new guess,
 600                         -- change the guess base, and try again
 601                    tidyOccName  (extendOccEnv in_scope occ (n+1))
 602                                 (mkSysOcc occ_sp (unpackFS fs ++ show n))
 603 \end{code}
 604
 605
 606 %************************************************************************
 607 %*                                                                      *
 608 \subsection{The 'Z' encoding}
 609 %*                                                                      *
 610 %************************************************************************
 611
 612 This is the main name-encoding and decoding function.  It encodes any
 613 string into a string that is acceptable as a C name.  This is the name
 614 by which things are known right through the compiler.
 615
 616 The basic encoding scheme is this.
 617
 618 * Tuples (,,,) are coded as Z3T
 619
 620 * Alphabetic characters (upper and lower) and digits
 621         all translate to themselves;
 622         except 'Z', which translates to 'ZZ'
 623         and    'z', which translates to 'zz'
 624   We need both so that we can preserve the variable/tycon distinction
 625
 626 * Most other printable characters translate to 'zx' or 'Zx' for some
 627         alphabetic character x
 628
 629 * The others translate as 'znnnU' where 'nnn' is the decimal number
 630         of the character
 631
 632         Before          After
 633         --------------------------
 634         Trak            Trak
 635         foo_wib         foozuwib
 636         >               zg
 637         >1              zg1
 638         foo#            foozh
 639         foo##           foozhzh
 640         foo##1          foozhzh1
 641         fooZ            fooZZ
 642         :+              ZCzp
 643         ()              Z0T     0-tuple
 644         (,,,,)          Z5T     5-tuple
 645         (# #)           Z1H     unboxed 1-tuple (note the space)
 646         (#,,,,#)        Z5H     unboxed 5-tuple
 647                 (NB: There is no Z1T nor Z0H.)
 648
 649 \begin{code}
 650 -- alreadyEncoded is used in ASSERTs to check for encoded
 651 -- strings.  It isn't fail-safe, of course, because, say 'zh' might
 652 -- be encoded or not.
 653 alreadyEncoded :: String -> Bool
 654 alreadyEncoded s = all ok s
 655                  where
 656                    ok ' ' = True
 657                         -- This is a bit of a lie; if we really wanted spaces
 658                         -- in names we'd have to encode them.  But we do put
 659                         -- spaces in ccall "occurrences", and we don't want to
 660                         -- reject them here
 661                    ok ch  = isAlphaNum ch
 662
 663 alreadyEncodedFS :: FastString -> Bool
 664 alreadyEncodedFS fs = alreadyEncoded (unpackFS fs)
 665
 666 encode :: UserString -> EncodedString
 667 encode cs = case maybe_tuple cs of
 668                 Just n  -> n            -- Tuples go to Z2T etc
 669                 Nothing -> go cs
 670           where
 671                 go []     = []
 672                 go (c:cs) = encode_ch c ++ go cs
 673
 674 encodeFS :: UserFS -> EncodedFS
 675 encodeFS fast_str  | all unencodedChar str = fast_str
 676                    | otherwise             = mkFastString (encode str)
 677                    where
 678                      str = unpackFS fast_str
 679
 680 unencodedChar :: Char -> Bool   -- True for chars that don't need encoding
 681 unencodedChar 'Z' = False
 682 unencodedChar 'z' = False
 683 unencodedChar c   =  c >= 'a' && c <= 'z'
 684                   || c >= 'A' && c <= 'Z'
 685                   || c >= '0' && c <= '9'
 686
 687 encode_ch :: Char -> EncodedString
 688 encode_ch c | unencodedChar c = [c]     -- Common case first
 689
 690 -- Constructors
 691 encode_ch '('  = "ZL"   -- Needed for things like (,), and (->)
 692 encode_ch ')'  = "ZR"   -- For symmetry with (
 693 encode_ch '['  = "ZM"
 694 encode_ch ']'  = "ZN"
 695 encode_ch ':'  = "ZC"
 696 encode_ch 'Z'  = "ZZ"
 697
 698 -- Variables
 699 encode_ch 'z'  = "zz"
 700 encode_ch '&'  = "za"
 701 encode_ch '|'  = "zb"
 702 encode_ch '^'  = "zc"
 703 encode_ch '$'  = "zd"
 704 encode_ch '='  = "ze"
 705 encode_ch '>'  = "zg"
 706 encode_ch '#'  = "zh"
 707 encode_ch '.'  = "zi"
 708 encode_ch '<'  = "zl"
 709 encode_ch '-'  = "zm"
 710 encode_ch '!'  = "zn"
 711 encode_ch '+'  = "zp"
 712 encode_ch '\'' = "zq"
 713 encode_ch '\\' = "zr"
 714 encode_ch '/'  = "zs"
 715 encode_ch '*'  = "zt"
 716 encode_ch '_'  = "zu"
 717 encode_ch '%'  = "zv"
 718 encode_ch c    = 'z' : shows (ord c) "U"
 719 \end{code}
 720
 721 Decode is used for user printing.
 722
 723 \begin{code}
 724 decodeFS :: FastString -> FastString
 725 decodeFS fs = mkFastString (decode (unpackFS fs))
 726
 727 decode :: EncodedString -> UserString
 728 decode [] = []
 729 decode ('Z' : d : rest) | isDigit d = decode_tuple   d rest
 730                         | otherwise = decode_upper   d : decode rest
 731 decode ('z' : d : rest) | isDigit d = decode_num_esc d rest
 732                         | otherwise = decode_lower   d : decode rest
 733 decode (c   : rest) = c : decode rest
 734
 735 decode_upper, decode_lower :: Char -> Char
 736
 737 decode_upper 'L' = '('
 738 decode_upper 'R' = ')'
 739 decode_upper 'M' = '['
 740 decode_upper 'N' = ']'
 741 decode_upper 'C' = ':'
 742 decode_upper 'Z' = 'Z'
 743 decode_upper ch  = pprTrace "decode_upper" (char ch) ch
 744
 745 decode_lower 'z' = 'z'
 746 decode_lower 'a' = '&'
 747 decode_lower 'b' = '|'
 748 decode_lower 'c' = '^'
 749 decode_lower 'd' = '$'
 750 decode_lower 'e' = '='
 751 decode_lower 'g' = '>'
 752 decode_lower 'h' = '#'
 753 decode_lower 'i' = '.'
 754 decode_lower 'l' = '<'
 755 decode_lower 'm' = '-'
 756 decode_lower 'n' = '!'
 757 decode_lower 'p' = '+'
 758 decode_lower 'q' = '\''
 759 decode_lower 'r' = '\\'
 760 decode_lower 's' = '/'
 761 decode_lower 't' = '*'
 762 decode_lower 'u' = '_'
 763 decode_lower 'v' = '%'
 764 decode_lower ch  = pprTrace "decode_lower" (char ch) ch
 765
 766 -- Characters not having a specific code are coded as z224U
 767 decode_num_esc d rest
 768   = go (digitToInt d) rest
 769   where
 770     go n (c : rest) | isDigit c = go (10*n + digitToInt c) rest
 771     go n ('U' : rest)           = chr n : decode rest
 772     go n other = pprPanic "decode_num_esc" (ppr n <+> text other)
 773
 774 decode_tuple :: Char -> EncodedString -> UserString
 775 decode_tuple d rest
 776   = go (digitToInt d) rest
 777   where
 778         -- NB. recurse back to decode after decoding the tuple, because
 779         -- the tuple might be embedded in a longer name.
 780     go n (c : rest) | isDigit c = go (10*n + digitToInt c) rest
 781     go 0 ('T':rest)     = "()" ++ decode rest
 782     go n ('T':rest)     = '(' : replicate (n-1) ',' ++ ")" ++ decode rest
 783     go 1 ('H':rest)     = "(# #)" ++ decode rest
 784     go n ('H':rest)     = '(' : '#' : replicate (n-1) ',' ++ "#)" ++ decode rest
 785     go n other = pprPanic "decode_tuple" (ppr n <+> text other)
 786 \end{code}
 787
 788
 789 %************************************************************************
 790 %*                                                                      *
 791                 Stuff for dealing with tuples
 792 %*                                                                      *
 793 %************************************************************************
 794
 795 Tuples are encoded as
 796         Z3T or Z3H
 797 for 3-tuples or unboxed 3-tuples respectively.  No other encoding starts
 798         Z<digit>
 799
 800 * "(# #)" is the tycon for an unboxed 1-tuple (not 0-tuple)
 801   There are no unboxed 0-tuples.
 802
 803 * "()" is the tycon for a boxed 0-tuple.
 804   There are no boxed 1-tuples.
 805
 806
 807 \begin{code}
 808 maybe_tuple :: UserString -> Maybe EncodedString
 809
 810 maybe_tuple "(# #)" = Just("Z1H")
 811 maybe_tuple ('(' : '#' : cs) = case count_commas (0::Int) cs of
 812                                  (n, '#' : ')' : cs) -> Just ('Z' : shows (n+1) "H")
 813                                  other               -> Nothing
 814 maybe_tuple "()" = Just("Z0T")
 815 maybe_tuple ('(' : cs)       = case count_commas (0::Int) cs of
 816                                  (n, ')' : cs) -> Just ('Z' : shows (n+1) "T")
 817                                  other         -> Nothing
 818 maybe_tuple other            = Nothing
 819
 820 count_commas :: Int -> String -> (Int, String)
 821 count_commas n (',' : cs) = count_commas (n+1) cs
 822 count_commas n cs         = (n,cs)
 823 \end{code}
 824
 825 \begin{code}
 826 mkTupleOcc :: NameSpace -> Boxity -> Arity -> OccName
 827 mkTupleOcc ns bx ar
 828   = OccName ns (mkFastString ('Z' : (show ar ++ bx_char)))
 829   where
 830     bx_char = case bx of
 831                 Boxed   -> "T"
 832                 Unboxed -> "H"
 833
 834 isTupleOcc_maybe :: OccName -> Maybe (NameSpace, Boxity, Arity)
 835 -- Tuples are special, because there are so many of them!
 836 isTupleOcc_maybe (OccName ns fs)
 837   = case unpackFS fs of
 838         ('Z':d:rest) | isDigit d -> Just (decode_tup (digitToInt d) rest)
 839         other                    -> Nothing
 840   where
 841     decode_tup n "H"      = (ns, Unboxed, n)
 842     decode_tup n "T"      = (ns, Boxed, n)
 843     decode_tup n (d:rest) = decode_tup (n*10 + digitToInt d) rest
 844 \end{code}
 845
 846 %************************************************************************
 847 %*                                                                      *
 848 \subsection{Lexical categories}
 849 %*                                                                      *
 850 %************************************************************************
 851
 852 These functions test strings to see if they fit the lexical categories
 853 defined in the Haskell report.
 854
 855 \begin{code}
 856 isLexCon,   isLexVar,    isLexId,    isLexSym    :: FastString -> Bool
 857 isLexConId, isLexConSym, isLexVarId, isLexVarSym :: FastString -> Bool
 858
 859 isLexCon cs = isLexConId  cs || isLexConSym cs
 860 isLexVar cs = isLexVarId  cs || isLexVarSym cs
 861
 862 isLexId  cs = isLexConId  cs || isLexVarId  cs
 863 isLexSym cs = isLexConSym cs || isLexVarSym cs
 864
 865 -------------
 866
 867 isLexConId cs                           -- Prefix type or data constructors
 868   | nullFastString cs = False           --      e.g. "Foo", "[]", "(,)"
 869   | cs == FSLIT("[]") = True
 870   | otherwise         = startsConId (headFS cs)
 871
 872 isLexVarId cs                           -- Ordinary prefix identifiers
 873   | nullFastString cs = False           --      e.g. "x", "_x"
 874   | otherwise         = startsVarId (headFS cs)
 875
 876 isLexConSym cs                          -- Infix type or data constructors
 877   | nullFastString cs = False           --      e.g. ":-:", ":", "->"
 878   | cs == FSLIT("->") = True
 879   | otherwise         = startsConSym (headFS cs)
 880
 881 isLexVarSym cs                          -- Infix identifiers
 882   | nullFastString cs = False           --      e.g. "+"
 883   | otherwise         = startsVarSym (headFS cs)
 884
 885 -------------
 886 startsVarSym, startsVarId, startsConSym, startsConId :: Char -> Bool
 887 startsVarSym c = isSymbolASCII c || isSymbolISO c       -- Infix Ids
 888 startsConSym c = c == ':'                               -- Infix data constructors
 889 startsVarId c  = isLower c || isLowerISO c || c == '_'  -- Ordinary Ids
 890 startsConId c  = isUpper c || isUpperISO c || c == '('  -- Ordinary type constructors and data constructors
 891
 892
 893 isSymbolASCII c = c `elem` "!#$%&*+./<=>?@\\^|~-"
 894 isSymbolISO   c = ord c `elem` (0xd7 : 0xf7 : [0xa1 .. 0xbf])
 895 isUpperISO    (C# c#) = c# `geChar#` '\xc0'# && c# `leChar#` '\xde'# && c# `neChar#` '\xd7'#
 896         --0xc0 <= oc && oc <= 0xde && oc /= 0xd7 where oc = ord c
 897 isLowerISO    (C# c#) = c# `geChar#` '\xdf'# && c# `leChar#` '\xff'# && c# `neChar#` '\xf7'#
 898         --0xdf <= oc && oc <= 0xff && oc /= 0xf7 where oc = ord c
 899 \end{code}
 900
 901 %************************************************************************
 902 %*                                                                      *
 903                 Binary instance
 904     Here rather than BinIface because OccName is abstract
 905 %*                                                                      *
 906 %************************************************************************
 907
 908 \begin{code}
 909 instance Binary NameSpace where
 910     put_ bh VarName = do
 911             putByte bh 0
 912     put_ bh DataName = do
 913             putByte bh 1
 914     put_ bh TvName = do
 915             putByte bh 2
 916     put_ bh TcClsName = do
 917             putByte bh 3
 918     get bh = do
 919             h <- getByte bh
 920             case h of
 921               0 -> do return VarName
 922               1 -> do return DataName
 923               2 -> do return TvName
 924               _ -> do return TcClsName
 925
 926 instance Binary OccName where
 927     put_ bh (OccName aa ab) = do
 928             put_ bh aa
 929             put_ bh ab
 930     get bh = do
 931           aa <- get bh
 932           ab <- get bh
 933           return (OccName aa ab)
 934 \end{code}