compiler/basicTypes/OccName.lhs

   1 %
   2 % (c) The University of Glasgow 2006
   3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   4 %
   5
   6 \begin{code}
   7 module OccName (
   8         -- * The NameSpace type; abstact
   9         NameSpace, tcName, clsName, tcClsName, dataName, varName,
  10         tvName, srcDataName,
  11
  12         -- ** Printing
  13         pprNameSpace, pprNonVarNameSpace, pprNameSpaceBrief,
  14
  15         -- * The OccName type
  16         OccName,        -- Abstract, instance of Outputable
  17         pprOccName,
  18
  19         -- ** Construction
  20         mkOccName, mkOccNameFS,
  21         mkVarOcc, mkVarOccFS,
  22         mkTyVarOcc,
  23         mkDFunOcc,
  24         mkTupleOcc,
  25         setOccNameSpace,
  26
  27         -- ** Derived OccNames
  28         mkDataConWrapperOcc, mkWorkerOcc, mkDefaultMethodOcc,
  29         mkDerivedTyConOcc, mkNewTyCoOcc,
  30         mkClassTyConOcc, mkClassDataConOcc, mkDictOcc, mkIPOcc,
  31         mkSpecOcc, mkForeignExportOcc, mkGenOcc1, mkGenOcc2,
  32         mkDataTOcc, mkDataCOcc, mkDataConWorkerOcc,
  33         mkSuperDictSelOcc, mkLocalOcc, mkMethodOcc, mkInstTyTcOcc,
  34         mkInstTyCoOcc, mkEqPredCoOcc,
  35         mkVectOcc, mkVectTyConOcc, mkVectDataConOcc, mkVectIsoOcc,
  36         mkPArrayTyConOcc, mkPArrayDataConOcc,
  37
  38         -- ** Deconstruction
  39         occNameFS, occNameString, occNameSpace,
  40
  41         isVarOcc, isTvOcc, isTcOcc, isDataOcc, isDataSymOcc, isSymOcc, isValOcc,
  42         parenSymOcc, reportIfUnused, isTcClsName, isVarName,
  43
  44         isTupleOcc_maybe,
  45
  46         -- The OccEnv type
  47         OccEnv, emptyOccEnv, unitOccEnv, extendOccEnv, mapOccEnv,
  48         lookupOccEnv, mkOccEnv, mkOccEnv_C, extendOccEnvList, elemOccEnv,
  49         occEnvElts, foldOccEnv, plusOccEnv, plusOccEnv_C, extendOccEnv_C,
  50
  51         -- The OccSet type
  52         OccSet, emptyOccSet, unitOccSet, mkOccSet, extendOccSet,
  53         extendOccSetList,
  54         unionOccSets, unionManyOccSets, minusOccSet, elemOccSet, occSetElts,
  55         foldOccSet, isEmptyOccSet, intersectOccSet, intersectsOccSet,
  56
  57         -- Tidying up
  58         TidyOccEnv, emptyTidyOccEnv, tidyOccName, initTidyOccEnv,
  59
  60         -- The basic form of names
  61         isLexCon, isLexVar, isLexId, isLexSym,
  62         isLexConId, isLexConSym, isLexVarId, isLexVarSym,
  63         startsVarSym, startsVarId, startsConSym, startsConId
  64     ) where
  65
  66 #include "HsVersions.h"
  67
  68 import Util
  69 import Unique
  70 import BasicTypes
  71 import StaticFlags
  72 import UniqFM
  73 import UniqSet
  74 import FastString
  75 import Outputable
  76 import Binary
  77
  78 import GHC.Exts
  79 import Data.Char
  80
  81 -- Unicode TODO: put isSymbol in libcompat
  82 #if __GLASGOW_HASKELL__ > 604
  83 #else
  84 isSymbol = const False
  85 #endif
  86
  87 \end{code}
  88
  89 %************************************************************************
  90 %*                                                                      *
  91 \subsection{Name space}
  92 %*                                                                      *
  93 %************************************************************************
  94
  95 \begin{code}
  96 data NameSpace = VarName        -- Variables, including "real" data constructors
  97                | DataName       -- "Source" data constructors
  98                | TvName         -- Type variables
  99                | TcClsName      -- Type constructors and classes; Haskell has them
 100                                 -- in the same name space for now.
 101                deriving( Eq, Ord )
 102    {-! derive: Binary !-}
 103
 104 -- Note [Data Constructors]
 105 -- see also: Note [Data Constructor Naming] in DataCon.lhs
 106 --
 107 --      "Source" data constructors are the data constructors mentioned
 108 --      in Haskell source code
 109 --
 110 --      "Real" data constructors are the data constructors of the
 111 --      representation type, which may not be the same as the source
 112 --      type
 113
 114 -- Example:
 115 --      data T = T !(Int,Int)
 116 --
 117 -- The source datacon has type (Int,Int) -> T
 118 -- The real   datacon has type Int -> Int -> T
 119 -- GHC chooses a representation based on the strictness etc.
 120
 121
 122 -- Though type constructors and classes are in the same name space now,
 123 -- the NameSpace type is abstract, so we can easily separate them later
 124 tcName    = TcClsName           -- Type constructors
 125 clsName   = TcClsName           -- Classes
 126 tcClsName = TcClsName           -- Not sure which!
 127
 128 dataName    = DataName
 129 srcDataName = DataName  -- Haskell-source data constructors should be
 130                         -- in the Data name space
 131
 132 tvName      = TvName
 133 varName     = VarName
 134
 135 isTcClsName :: NameSpace -> Bool
 136 isTcClsName TcClsName = True
 137 isTcClsName _         = False
 138
 139 isVarName :: NameSpace -> Bool  -- Variables or type variables, but not constructors
 140 isVarName TvName  = True
 141 isVarName VarName = True
 142 isVarName other   = False
 143
 144 pprNameSpace :: NameSpace -> SDoc
 145 pprNameSpace DataName  = ptext SLIT("data constructor")
 146 pprNameSpace VarName   = ptext SLIT("variable")
 147 pprNameSpace TvName    = ptext SLIT("type variable")
 148 pprNameSpace TcClsName = ptext SLIT("type constructor or class")
 149
 150 pprNonVarNameSpace :: NameSpace -> SDoc
 151 pprNonVarNameSpace VarName = empty
 152 pprNonVarNameSpace ns = pprNameSpace ns
 153
 154 pprNameSpaceBrief DataName  = char 'd'
 155 pprNameSpaceBrief VarName   = char 'v'
 156 pprNameSpaceBrief TvName    = ptext SLIT("tv")
 157 pprNameSpaceBrief TcClsName = ptext SLIT("tc")
 158 \end{code}
 159
 160
 161 %************************************************************************
 162 %*                                                                      *
 163 \subsection[Name-pieces-datatypes]{The @OccName@ datatypes}
 164 %*                                                                      *
 165 %************************************************************************
 166
 167 \begin{code}
 168 data OccName = OccName
 169     { occNameSpace  :: !NameSpace
 170     , occNameFS     :: !FastString
 171     }
 172 \end{code}
 173
 174
 175 \begin{code}
 176 instance Eq OccName where
 177     (OccName sp1 s1) == (OccName sp2 s2) = s1 == s2 && sp1 == sp2
 178
 179 instance Ord OccName where
 180         -- Compares lexicographically, *not* by Unique of the string
 181     compare (OccName sp1 s1) (OccName sp2 s2)
 182         = (s1  `compare` s2) `thenCmp` (sp1 `compare` sp2)
 183 \end{code}
 184
 185
 186 %************************************************************************
 187 %*                                                                      *
 188 \subsection{Printing}
 189 %*                                                                      *
 190 %************************************************************************
 191
 192 \begin{code}
 193 instance Outputable OccName where
 194     ppr = pprOccName
 195
 196 pprOccName :: OccName -> SDoc
 197 pprOccName (OccName sp occ)
 198   = getPprStyle $ \ sty ->
 199     if codeStyle sty
 200         then ftext (zEncodeFS occ)
 201         else ftext occ <> if debugStyle sty
 202                             then braces (pprNameSpaceBrief sp)
 203                             else empty
 204 \end{code}
 205
 206
 207 %************************************************************************
 208 %*                                                                      *
 209 \subsection{Construction}
 210 %*                                                                      *
 211 %************************************************************************
 212
 213 \begin{code}
 214 mkOccName :: NameSpace -> String -> OccName
 215 mkOccName occ_sp str = OccName occ_sp (mkFastString str)
 216
 217 mkOccNameFS :: NameSpace -> FastString -> OccName
 218 mkOccNameFS occ_sp fs = OccName occ_sp fs
 219
 220 mkVarOcc :: String -> OccName
 221 mkVarOcc s = mkOccName varName s
 222
 223 mkVarOccFS :: FastString -> OccName
 224 mkVarOccFS fs = mkOccNameFS varName fs
 225
 226 mkTyVarOcc :: FastString -> OccName
 227 mkTyVarOcc fs = mkOccNameFS tvName fs
 228 \end{code}
 229
 230
 231 %************************************************************************
 232 %*                                                                      *
 233                 Environments
 234 %*                                                                      *
 235 %************************************************************************
 236
 237 OccEnvs are used mainly for the envts in ModIfaces.
 238
 239 They are efficient, because FastStrings have unique Int# keys.  We assume
 240 this key is less than 2^24, so we can make a Unique using
 241         mkUnique ns key  :: Unique
 242 where 'ns' is a Char reprsenting the name space.  This in turn makes it
 243 easy to build an OccEnv.
 244
 245 \begin{code}
 246 instance Uniquable OccName where
 247   getUnique (OccName ns fs)
 248       = mkUnique char (I# (uniqueOfFS fs))
 249       where     -- See notes above about this getUnique function
 250         char = case ns of
 251                 VarName   -> 'i'
 252                 DataName  -> 'd'
 253                 TvName    -> 'v'
 254                 TcClsName -> 't'
 255
 256 type OccEnv a = UniqFM a
 257
 258 emptyOccEnv :: OccEnv a
 259 unitOccEnv  :: OccName -> a -> OccEnv a
 260 extendOccEnv :: OccEnv a -> OccName -> a -> OccEnv a
 261 extendOccEnvList :: OccEnv a -> [(OccName, a)] -> OccEnv a
 262 lookupOccEnv :: OccEnv a -> OccName -> Maybe a
 263 mkOccEnv     :: [(OccName,a)] -> OccEnv a
 264 mkOccEnv_C   :: (a -> a -> a) -> [(OccName,a)] -> OccEnv a
 265 elemOccEnv   :: OccName -> OccEnv a -> Bool
 266 foldOccEnv   :: (a -> b -> b) -> b -> OccEnv a -> b
 267 occEnvElts   :: OccEnv a -> [a]
 268 extendOccEnv_C :: (a->a->a) -> OccEnv a -> OccName -> a -> OccEnv a
 269 plusOccEnv     :: OccEnv a -> OccEnv a -> OccEnv a
 270 plusOccEnv_C   :: (a->a->a) -> OccEnv a -> OccEnv a -> OccEnv a
 271 mapOccEnv      :: (a->b) -> OccEnv a -> OccEnv b
 272
 273 emptyOccEnv      = emptyUFM
 274 unitOccEnv       = unitUFM
 275 extendOccEnv     = addToUFM
 276 extendOccEnvList = addListToUFM
 277 lookupOccEnv     = lookupUFM
 278 mkOccEnv         = listToUFM
 279 elemOccEnv       = elemUFM
 280 foldOccEnv       = foldUFM
 281 occEnvElts       = eltsUFM
 282 plusOccEnv       = plusUFM
 283 plusOccEnv_C     = plusUFM_C
 284 extendOccEnv_C   = addToUFM_C
 285 mapOccEnv        = mapUFM
 286
 287 mkOccEnv_C comb l = addListToUFM_C comb emptyOccEnv l
 288
 289 type OccSet = UniqFM OccName
 290
 291 emptyOccSet       :: OccSet
 292 unitOccSet        :: OccName -> OccSet
 293 mkOccSet          :: [OccName] -> OccSet
 294 extendOccSet      :: OccSet -> OccName -> OccSet
 295 extendOccSetList  :: OccSet -> [OccName] -> OccSet
 296 unionOccSets      :: OccSet -> OccSet -> OccSet
 297 unionManyOccSets  :: [OccSet] -> OccSet
 298 minusOccSet       :: OccSet -> OccSet -> OccSet
 299 elemOccSet        :: OccName -> OccSet -> Bool
 300 occSetElts        :: OccSet -> [OccName]
 301 foldOccSet        :: (OccName -> b -> b) -> b -> OccSet -> b
 302 isEmptyOccSet     :: OccSet -> Bool
 303 intersectOccSet   :: OccSet -> OccSet -> OccSet
 304 intersectsOccSet  :: OccSet -> OccSet -> Bool
 305
 306 emptyOccSet       = emptyUniqSet
 307 unitOccSet        = unitUniqSet
 308 mkOccSet          = mkUniqSet
 309 extendOccSet      = addOneToUniqSet
 310 extendOccSetList  = addListToUniqSet
 311 unionOccSets      = unionUniqSets
 312 unionManyOccSets  = unionManyUniqSets
 313 minusOccSet       = minusUniqSet
 314 elemOccSet        = elementOfUniqSet
 315 occSetElts        = uniqSetToList
 316 foldOccSet        = foldUniqSet
 317 isEmptyOccSet     = isEmptyUniqSet
 318 intersectOccSet   = intersectUniqSets
 319 intersectsOccSet s1 s2 = not (isEmptyOccSet (s1 `intersectOccSet` s2))
 320 \end{code}
 321
 322
 323 %************************************************************************
 324 %*                                                                      *
 325 \subsection{Predicates and taking them apart}
 326 %*                                                                      *
 327 %************************************************************************
 328
 329 \begin{code}
 330 occNameString :: OccName -> String
 331 occNameString (OccName _ s) = unpackFS s
 332
 333 setOccNameSpace :: NameSpace -> OccName -> OccName
 334 setOccNameSpace sp (OccName _ occ) = OccName sp occ
 335
 336 isVarOcc, isTvOcc, isDataSymOcc, isSymOcc, isTcOcc :: OccName -> Bool
 337
 338 isVarOcc (OccName VarName _) = True
 339 isVarOcc other               = False
 340
 341 isTvOcc (OccName TvName _) = True
 342 isTvOcc other              = False
 343
 344 isTcOcc (OccName TcClsName _) = True
 345 isTcOcc other                 = False
 346
 347 isValOcc (OccName VarName  _) = True
 348 isValOcc (OccName DataName _) = True
 349 isValOcc other                = False
 350
 351 -- Data constructor operator (starts with ':', or '[]')
 352 -- Pretty inefficient!
 353 isDataSymOcc (OccName DataName s) = isLexConSym s
 354 isDataSymOcc (OccName VarName s)
 355   | isLexConSym s = pprPanic "isDataSymOcc: check me" (ppr s)
 356                 -- Jan06: I don't think this should happen
 357 isDataSymOcc other                = False
 358
 359 isDataOcc (OccName DataName _) = True
 360 isDataOcc (OccName VarName s)
 361   | isLexCon s = pprPanic "isDataOcc: check me" (ppr s)
 362                 -- Jan06: I don't think this should happen
 363 isDataOcc other                = False
 364
 365 -- Any operator (data constructor or variable)
 366 -- Pretty inefficient!
 367 isSymOcc (OccName DataName s)  = isLexConSym s
 368 isSymOcc (OccName TcClsName s) = isLexConSym s
 369 isSymOcc (OccName VarName s)   = isLexSym s
 370 isSymOcc other                 = False
 371
 372 parenSymOcc :: OccName -> SDoc -> SDoc
 373 -- Wrap parens around an operator
 374 parenSymOcc occ doc | isSymOcc occ = parens doc
 375                     | otherwise    = doc
 376 \end{code}
 377
 378
 379 \begin{code}
 380 reportIfUnused :: OccName -> Bool
 381   -- Haskell 98 encourages compilers to suppress warnings about
 382   -- unused names in a pattern if they start with "_".
 383 reportIfUnused occ = case occNameString occ of
 384                         ('_' : _) -> False
 385                         _other    -> True
 386 \end{code}
 387
 388
 389 %************************************************************************
 390 %*                                                                      *
 391 \subsection{Making system names}
 392 %*                                                                      *
 393 %************************************************************************
 394
 395 Here's our convention for splitting up the interface file name space:
 396
 397         d...            dictionary identifiers
 398                         (local variables, so no name-clash worries)
 399
 400         $f...           dict-fun identifiers (from inst decls)
 401         $dm...          default methods
 402         $p...           superclass selectors
 403         $w...           workers
 404         :T...           compiler-generated tycons for dictionaries
 405         :D...           ...ditto data cons
 406         :Co...          ...ditto coercions
 407         $sf..           specialised version of f
 408
 409         in encoded form these appear as Zdfxxx etc
 410
 411         :...            keywords (export:, letrec: etc.)
 412 --- I THINK THIS IS WRONG!
 413
 414 This knowledge is encoded in the following functions.
 415
 416
 417 @mk_deriv@ generates an @OccName@ from the prefix and a string.
 418 NB: The string must already be encoded!
 419
 420 \begin{code}
 421 mk_deriv :: NameSpace
 422          -> String              -- Distinguishes one sort of derived name from another
 423          -> String
 424          -> OccName
 425
 426 mk_deriv occ_sp sys_prefix str = mkOccName occ_sp (sys_prefix ++ str)
 427 \end{code}
 428
 429 \begin{code}
 430 mkDataConWrapperOcc, mkWorkerOcc, mkDefaultMethodOcc, mkDerivedTyConOcc,
 431         mkClassTyConOcc, mkClassDataConOcc, mkDictOcc, mkIPOcc,
 432         mkSpecOcc, mkForeignExportOcc, mkGenOcc1, mkGenOcc2,
 433         mkDataTOcc, mkDataCOcc, mkDataConWorkerOcc, mkNewTyCoOcc
 434    :: OccName -> OccName
 435
 436 -- These derived variables have a prefix that no Haskell value could have
 437 mkDataConWrapperOcc = mk_simple_deriv varName  "$W"
 438 mkWorkerOcc         = mk_simple_deriv varName  "$w"
 439 mkDefaultMethodOcc  = mk_simple_deriv varName  "$dm"
 440 mkDerivedTyConOcc   = mk_simple_deriv tcName   ":"      -- The : prefix makes sure it classifies
 441 mkClassTyConOcc     = mk_simple_deriv tcName   ":T"     -- as a tycon/datacon
 442 mkClassDataConOcc   = mk_simple_deriv dataName ":D"     -- We go straight to the "real" data con
 443                                                         -- for datacons from classes
 444 mkDictOcc           = mk_simple_deriv varName  "$d"
 445 mkIPOcc             = mk_simple_deriv varName  "$i"
 446 mkSpecOcc           = mk_simple_deriv varName  "$s"
 447 mkForeignExportOcc  = mk_simple_deriv varName  "$f"
 448 mkNewTyCoOcc        = mk_simple_deriv tcName  ":Co"
 449 mkInstTyCoOcc       = mk_simple_deriv tcName  ":CoF"     -- derived from rep ty
 450 mkEqPredCoOcc       = mk_simple_deriv tcName  "$co"
 451
 452 -- Generic derivable classes
 453 mkGenOcc1           = mk_simple_deriv varName  "$gfrom"
 454 mkGenOcc2           = mk_simple_deriv varName  "$gto"
 455
 456 -- data T = MkT ... deriving( Data ) needs defintions for
 457 --      $tT   :: Data.Generics.Basics.DataType
 458 --      $cMkT :: Data.Generics.Basics.Constr
 459 mkDataTOcc = mk_simple_deriv varName  "$t"
 460 mkDataCOcc = mk_simple_deriv varName  "$c"
 461
 462 -- Vectorisation
 463 mkVectOcc          = mk_simple_deriv varName  "$v_"
 464 mkVectTyConOcc     = mk_simple_deriv tcName   ":V_"
 465 mkVectDataConOcc   = mk_simple_deriv dataName ":VD_"
 466 mkVectIsoOcc       = mk_simple_deriv varName  "$VI_"
 467 mkPArrayTyConOcc   = mk_simple_deriv tcName   ":VP_"
 468 mkPArrayDataConOcc = mk_simple_deriv dataName ":VPD_"
 469
 470 mk_simple_deriv sp px occ = mk_deriv sp px (occNameString occ)
 471
 472 -- Data constructor workers are made by setting the name space
 473 -- of the data constructor OccName (which should be a DataName)
 474 -- to VarName
 475 mkDataConWorkerOcc datacon_occ = setOccNameSpace varName datacon_occ
 476 \end{code}
 477
 478 \begin{code}
 479 mkSuperDictSelOcc :: Int        -- Index of superclass, eg 3
 480                   -> OccName    -- Class, eg "Ord"
 481                   -> OccName    -- eg "$p3Ord"
 482 mkSuperDictSelOcc index cls_occ
 483   = mk_deriv varName "$p" (show index ++ occNameString cls_occ)
 484
 485 mkLocalOcc :: Unique            -- Unique
 486            -> OccName           -- Local name (e.g. "sat")
 487            -> OccName           -- Nice unique version ("$L23sat")
 488 mkLocalOcc uniq occ
 489    = mk_deriv varName ("$L" ++ show uniq) (occNameString occ)
 490         -- The Unique might print with characters
 491         -- that need encoding (e.g. 'z'!)
 492 \end{code}
 493
 494 Derive a name for the representation type constructor of a data/newtype
 495 instance.
 496
 497 \begin{code}
 498 mkInstTyTcOcc :: Int                    -- Index
 499               -> OccName                -- Family name (e.g. "Map")
 500               -> OccName                -- Nice unique version (":R23Map")
 501 mkInstTyTcOcc index occ
 502    = mk_deriv tcName (":R" ++ show index) (occNameString occ)
 503 \end{code}
 504
 505 \begin{code}
 506 mkDFunOcc :: String             -- Typically the class and type glommed together e.g. "OrdMaybe"
 507                                 -- Only used in debug mode, for extra clarity
 508           -> Bool               -- True <=> hs-boot instance dfun
 509           -> Int                -- Unique index
 510           -> OccName            -- "$f3OrdMaybe"
 511
 512 -- In hs-boot files we make dict funs like $fx7ClsTy, which get bound to the real
 513 -- thing when we compile the mother module. Reason: we don't know exactly
 514 -- what the  mother module will call it.
 515
 516 mkDFunOcc info_str is_boot index
 517   = mk_deriv VarName prefix string
 518   where
 519     prefix | is_boot   = "$fx"
 520            | otherwise = "$f"
 521     string | opt_PprStyle_Debug = show index ++ info_str
 522            | otherwise          = show index
 523 \end{code}
 524
 525 We used to add a '$m' to indicate a method, but that gives rise to bad
 526 error messages from the type checker when we print the function name or pattern
 527 of an instance-decl binding.  Why? Because the binding is zapped
 528 to use the method name in place of the selector name.
 529 (See TcClassDcl.tcMethodBind)
 530
 531 The way it is now, -ddump-xx output may look confusing, but
 532 you can always say -dppr-debug to get the uniques.
 533
 534 However, we *do* have to zap the first character to be lower case,
 535 because overloaded constructors (blarg) generate methods too.
 536 And convert to VarName space
 537
 538 e.g. a call to constructor MkFoo where
 539         data (Ord a) => Foo a = MkFoo a
 540
 541 If this is necessary, we do it by prefixing '$m'.  These
 542 guys never show up in error messages.  What a hack.
 543
 544 \begin{code}
 545 mkMethodOcc :: OccName -> OccName
 546 mkMethodOcc occ@(OccName VarName fs) = occ
 547 mkMethodOcc occ                      = mk_simple_deriv varName "$m" occ
 548 \end{code}
 549
 550
 551 %************************************************************************
 552 %*                                                                      *
 553 \subsection{Tidying them up}
 554 %*                                                                      *
 555 %************************************************************************
 556
 557 Before we print chunks of code we like to rename it so that
 558 we don't have to print lots of silly uniques in it.  But we mustn't
 559 accidentally introduce name clashes!  So the idea is that we leave the
 560 OccName alone unless it accidentally clashes with one that is already
 561 in scope; if so, we tack on '1' at the end and try again, then '2', and
 562 so on till we find a unique one.
 563
 564 There's a wrinkle for operators.  Consider '>>='.  We can't use '>>=1'
 565 because that isn't a single lexeme.  So we encode it to 'lle' and *then*
 566 tack on the '1', if necessary.
 567
 568 \begin{code}
 569 type TidyOccEnv = OccEnv Int    -- The in-scope OccNames
 570         -- Range gives a plausible starting point for new guesses
 571
 572 emptyTidyOccEnv = emptyOccEnv
 573
 574 initTidyOccEnv :: [OccName] -> TidyOccEnv       -- Initialise with names to avoid!
 575 initTidyOccEnv = foldl (\env occ -> extendOccEnv env occ 1) emptyTidyOccEnv
 576
 577 tidyOccName :: TidyOccEnv -> OccName -> (TidyOccEnv, OccName)
 578
 579 tidyOccName in_scope occ@(OccName occ_sp fs)
 580   = case lookupOccEnv in_scope occ of
 581         Nothing ->      -- Not already used: make it used
 582                    (extendOccEnv in_scope occ 1, occ)
 583
 584         Just n  ->      -- Already used: make a new guess,
 585                         -- change the guess base, and try again
 586                    tidyOccName  (extendOccEnv in_scope occ (n+1))
 587                                 (mkOccName occ_sp (unpackFS fs ++ show n))
 588 \end{code}
 589
 590 %************************************************************************
 591 %*                                                                      *
 592                 Stuff for dealing with tuples
 593 %*                                                                      *
 594 %************************************************************************
 595
 596 \begin{code}
 597 mkTupleOcc :: NameSpace -> Boxity -> Arity -> OccName
 598 mkTupleOcc ns bx ar = OccName ns (mkFastString str)
 599   where
 600         -- no need to cache these, the caching is done in the caller
 601         -- (TysWiredIn.mk_tuple)
 602     str = case bx of
 603                 Boxed   -> '(' : commas ++ ")"
 604                 Unboxed -> '(' : '#' : commas ++ "#)"
 605
 606     commas = take (ar-1) (repeat ',')
 607
 608 isTupleOcc_maybe :: OccName -> Maybe (NameSpace, Boxity, Arity)
 609 -- Tuples are special, because there are so many of them!
 610 isTupleOcc_maybe (OccName ns fs)
 611   = case unpackFS fs of
 612         '(':'#':',':rest -> Just (ns, Unboxed, 2 + count_commas rest)
 613         '(':',':rest     -> Just (ns, Boxed,   2 + count_commas rest)
 614         _other           -> Nothing
 615   where
 616     count_commas (',':rest) = 1 + count_commas rest
 617     count_commas _          = 0
 618 \end{code}
 619
 620 %************************************************************************
 621 %*                                                                      *
 622 \subsection{Lexical categories}
 623 %*                                                                      *
 624 %************************************************************************
 625
 626 These functions test strings to see if they fit the lexical categories
 627 defined in the Haskell report.
 628
 629 \begin{code}
 630 isLexCon,   isLexVar,    isLexId,    isLexSym    :: FastString -> Bool
 631 isLexConId, isLexConSym, isLexVarId, isLexVarSym :: FastString -> Bool
 632
 633 isLexCon cs = isLexConId  cs || isLexConSym cs
 634 isLexVar cs = isLexVarId  cs || isLexVarSym cs
 635
 636 isLexId  cs = isLexConId  cs || isLexVarId  cs
 637 isLexSym cs = isLexConSym cs || isLexVarSym cs
 638
 639 -------------
 640
 641 isLexConId cs                           -- Prefix type or data constructors
 642   | nullFS cs         = False           --      e.g. "Foo", "[]", "(,)"
 643   | cs == FSLIT("[]") = True
 644   | otherwise         = startsConId (headFS cs)
 645
 646 isLexVarId cs                           -- Ordinary prefix identifiers
 647   | nullFS cs         = False           --      e.g. "x", "_x"
 648   | otherwise         = startsVarId (headFS cs)
 649
 650 isLexConSym cs                          -- Infix type or data constructors
 651   | nullFS cs         = False           --      e.g. ":-:", ":", "->"
 652   | cs == FSLIT("->") = True
 653   | otherwise         = startsConSym (headFS cs)
 654
 655 isLexVarSym cs                          -- Infix identifiers
 656   | nullFS cs         = False           --      e.g. "+"
 657   | otherwise         = startsVarSym (headFS cs)
 658
 659 -------------
 660 startsVarSym, startsVarId, startsConSym, startsConId :: Char -> Bool
 661 startsVarSym c = isSymbolASCII c || (ord c > 0x7f && isSymbol c) -- Infix Ids
 662 startsConSym c = c == ':'                               -- Infix data constructors
 663 startsVarId c  = isLower c || c == '_'  -- Ordinary Ids
 664 startsConId c  = isUpper c || c == '('  -- Ordinary type constructors and data constructors
 665
 666 isSymbolASCII c = c `elem` "!#$%&*+./<=>?@\\^|~-"
 667 \end{code}
 668
 669 %************************************************************************
 670 %*                                                                      *
 671                 Binary instance
 672     Here rather than BinIface because OccName is abstract
 673 %*                                                                      *
 674 %************************************************************************
 675
 676 \begin{code}
 677 instance Binary NameSpace where
 678     put_ bh VarName = do
 679             putByte bh 0
 680     put_ bh DataName = do
 681             putByte bh 1
 682     put_ bh TvName = do
 683             putByte bh 2
 684     put_ bh TcClsName = do
 685             putByte bh 3
 686     get bh = do
 687             h <- getByte bh
 688             case h of
 689               0 -> do return VarName
 690               1 -> do return DataName
 691               2 -> do return TvName
 692               _ -> do return TcClsName
 693
 694 instance Binary OccName where
 695     put_ bh (OccName aa ab) = do
 696             put_ bh aa
 697             put_ bh ab
 698     get bh = do
 699           aa <- get bh
 700           ab <- get bh
 701           return (OccName aa ab)
 702 \end{code}