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