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