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