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         filterOccEnv, delListFromOccEnv, delFromOccEnv,
  60
  61         -- The OccSet type
  62         OccSet, emptyOccSet, unitOccSet, mkOccSet, extendOccSet,
  63         extendOccSetList,
  64         unionOccSets, unionManyOccSets, minusOccSet, elemOccSet, occSetElts,
  65         foldOccSet, isEmptyOccSet, intersectOccSet, intersectsOccSet,
  66
  67         -- Tidying up
  68         TidyOccEnv, emptyTidyOccEnv, tidyOccName, initTidyOccEnv,
  69
  70         -- The basic form of names
  71         isLexCon, isLexVar, isLexId, isLexSym,
  72         isLexConId, isLexConSym, isLexVarId, isLexVarSym,
  73         startsVarSym, startsVarId, startsConSym, startsConId
  74     ) where
  75
  76 #include "HsVersions.h"
  77
  78 import Util
  79 import Unique
  80 import BasicTypes
  81 import StaticFlags
  82 import UniqFM
  83 import UniqSet
  84 import FastString
  85 import Outputable
  86 import Binary
  87
  88 import GHC.Exts
  89 import Data.Char
  90
  91 -- Unicode TODO: put isSymbol in libcompat
  92 #if __GLASGOW_HASKELL__ > 604
  93 #else
  94 isSymbol = const False
  95 #endif
  96
  97 \end{code}
  98
  99 %************************************************************************
 100 %*                                                                      *
 101 \subsection{Name space}
 102 %*                                                                      *
 103 %************************************************************************
 104
 105 \begin{code}
 106 data NameSpace = VarName        -- Variables, including "real" data constructors
 107                | DataName       -- "Source" data constructors
 108                | TvName         -- Type variables
 109                | TcClsName      -- Type constructors and classes; Haskell has them
 110                                 -- in the same name space for now.
 111                deriving( Eq, Ord )
 112    {-! derive: Binary !-}
 113
 114 -- Note [Data Constructors]
 115 -- see also: Note [Data Constructor Naming] in DataCon.lhs
 116 --
 117 --      "Source" data constructors are the data constructors mentioned
 118 --      in Haskell source code
 119 --
 120 --      "Real" data constructors are the data constructors of the
 121 --      representation type, which may not be the same as the source
 122 --      type
 123
 124 -- Example:
 125 --      data T = T !(Int,Int)
 126 --
 127 -- The source datacon has type (Int,Int) -> T
 128 -- The real   datacon has type Int -> Int -> T
 129 -- GHC chooses a representation based on the strictness etc.
 130
 131
 132 -- Though type constructors and classes are in the same name space now,
 133 -- the NameSpace type is abstract, so we can easily separate them later
 134 tcName    = TcClsName           -- Type constructors
 135 clsName   = TcClsName           -- Classes
 136 tcClsName = TcClsName           -- Not sure which!
 137
 138 dataName    = DataName
 139 srcDataName = DataName  -- Haskell-source data constructors should be
 140                         -- in the Data name space
 141
 142 tvName      = TvName
 143 varName     = VarName
 144
 145 isTcClsName :: NameSpace -> Bool
 146 isTcClsName TcClsName = True
 147 isTcClsName _         = False
 148
 149 isVarName :: NameSpace -> Bool  -- Variables or type variables, but not constructors
 150 isVarName TvName  = True
 151 isVarName VarName = True
 152 isVarName other   = False
 153
 154 pprNameSpace :: NameSpace -> SDoc
 155 pprNameSpace DataName  = ptext SLIT("data constructor")
 156 pprNameSpace VarName   = ptext SLIT("variable")
 157 pprNameSpace TvName    = ptext SLIT("type variable")
 158 pprNameSpace TcClsName = ptext SLIT("type constructor or class")
 159
 160 pprNonVarNameSpace :: NameSpace -> SDoc
 161 pprNonVarNameSpace VarName = empty
 162 pprNonVarNameSpace ns = pprNameSpace ns
 163
 164 pprNameSpaceBrief DataName  = char 'd'
 165 pprNameSpaceBrief VarName   = char 'v'
 166 pprNameSpaceBrief TvName    = ptext SLIT("tv")
 167 pprNameSpaceBrief TcClsName = ptext SLIT("tc")
 168 \end{code}
 169
 170
 171 %************************************************************************
 172 %*                                                                      *
 173 \subsection[Name-pieces-datatypes]{The @OccName@ datatypes}
 174 %*                                                                      *
 175 %************************************************************************
 176
 177 \begin{code}
 178 data OccName = OccName
 179     { occNameSpace  :: !NameSpace
 180     , occNameFS     :: !FastString
 181     }
 182 \end{code}
 183
 184
 185 \begin{code}
 186 instance Eq OccName where
 187     (OccName sp1 s1) == (OccName sp2 s2) = s1 == s2 && sp1 == sp2
 188
 189 instance Ord OccName where
 190         -- Compares lexicographically, *not* by Unique of the string
 191     compare (OccName sp1 s1) (OccName sp2 s2)
 192         = (s1  `compare` s2) `thenCmp` (sp1 `compare` sp2)
 193 \end{code}
 194
 195
 196 %************************************************************************
 197 %*                                                                      *
 198 \subsection{Printing}
 199 %*                                                                      *
 200 %************************************************************************
 201
 202 \begin{code}
 203 instance Outputable OccName where
 204     ppr = pprOccName
 205
 206 pprOccName :: OccName -> SDoc
 207 pprOccName (OccName sp occ)
 208   = getPprStyle $ \ sty ->
 209     if codeStyle sty
 210         then ftext (zEncodeFS occ)
 211         else ftext occ <> if debugStyle sty
 212                             then braces (pprNameSpaceBrief sp)
 213                             else empty
 214 \end{code}
 215
 216
 217 %************************************************************************
 218 %*                                                                      *
 219 \subsection{Construction}
 220 %*                                                                      *
 221 %************************************************************************
 222
 223 \begin{code}
 224 mkOccName :: NameSpace -> String -> OccName
 225 mkOccName occ_sp str = OccName occ_sp (mkFastString str)
 226
 227 mkOccNameFS :: NameSpace -> FastString -> OccName
 228 mkOccNameFS occ_sp fs = OccName occ_sp fs
 229
 230 mkVarOcc :: String -> OccName
 231 mkVarOcc s = mkOccName varName s
 232
 233 mkVarOccFS :: FastString -> OccName
 234 mkVarOccFS fs = mkOccNameFS varName fs
 235
 236 mkTyVarOcc :: FastString -> OccName
 237 mkTyVarOcc fs = mkOccNameFS tvName fs
 238 \end{code}
 239
 240
 241 %************************************************************************
 242 %*                                                                      *
 243                 Environments
 244 %*                                                                      *
 245 %************************************************************************
 246
 247 OccEnvs are used mainly for the envts in ModIfaces.
 248
 249 They are efficient, because FastStrings have unique Int# keys.  We assume
 250 this key is less than 2^24, so we can make a Unique using
 251         mkUnique ns key  :: Unique
 252 where 'ns' is a Char reprsenting the name space.  This in turn makes it
 253 easy to build an OccEnv.
 254
 255 \begin{code}
 256 instance Uniquable OccName where
 257   getUnique (OccName ns fs)
 258       = mkUnique char (I# (uniqueOfFS fs))
 259       where     -- See notes above about this getUnique function
 260         char = case ns of
 261                 VarName   -> 'i'
 262                 DataName  -> 'd'
 263                 TvName    -> 'v'
 264                 TcClsName -> 't'
 265
 266 newtype OccEnv a = A (UniqFM a)
 267
 268 emptyOccEnv :: OccEnv a
 269 unitOccEnv  :: OccName -> a -> OccEnv a
 270 extendOccEnv :: OccEnv a -> OccName -> a -> OccEnv a
 271 extendOccEnvList :: OccEnv a -> [(OccName, a)] -> OccEnv a
 272 lookupOccEnv :: OccEnv a -> OccName -> Maybe a
 273 mkOccEnv     :: [(OccName,a)] -> OccEnv a
 274 mkOccEnv_C   :: (a -> a -> a) -> [(OccName,a)] -> OccEnv a
 275 elemOccEnv   :: OccName -> OccEnv a -> Bool
 276 foldOccEnv   :: (a -> b -> b) -> b -> OccEnv a -> b
 277 occEnvElts   :: OccEnv a -> [a]
 278 extendOccEnv_C :: (a->a->a) -> OccEnv a -> OccName -> a -> OccEnv a
 279 plusOccEnv     :: OccEnv a -> OccEnv a -> OccEnv a
 280 plusOccEnv_C   :: (a->a->a) -> OccEnv a -> OccEnv a -> OccEnv a
 281 mapOccEnv      :: (a->b) -> OccEnv a -> OccEnv b
 282 delFromOccEnv      :: OccEnv a -> OccName -> OccEnv a
 283 delListFromOccEnv :: OccEnv a -> [OccName] -> OccEnv a
 284 filterOccEnv       :: (elt -> Bool) -> OccEnv elt -> OccEnv elt
 285
 286 emptyOccEnv      = A emptyUFM
 287 unitOccEnv x y = A $ unitUFM x y
 288 extendOccEnv (A x) y z = A $ addToUFM x y z
 289 extendOccEnvList (A x) l = A $ addListToUFM x l
 290 lookupOccEnv (A x) y = lookupUFM x y
 291 mkOccEnv     l    = A $ listToUFM l
 292 elemOccEnv x (A y)       = elemUFM x y
 293 foldOccEnv a b (A c)     = foldUFM a b c
 294 occEnvElts (A x)         = eltsUFM x
 295 plusOccEnv (A x) (A y)   = A $ plusUFM x y
 296 plusOccEnv_C f (A x) (A y)       = A $ plusUFM_C f x y
 297 extendOccEnv_C f (A x) y z   = A $ addToUFM_C f x y z
 298 mapOccEnv f (A x)        = A $ mapUFM f x
 299 mkOccEnv_C comb l = A $ addListToUFM_C comb emptyUFM l
 300 delFromOccEnv (A x) y    = A $ delFromUFM x y
 301 delListFromOccEnv (A x) y  = A $ delListFromUFM x y
 302 filterOccEnv x (A y)       = A $ filterUFM x y
 303
 304 instance Outputable a => Outputable (OccEnv a) where
 305     ppr (A x) = ppr x
 306
 307 type OccSet = UniqFM OccName
 308
 309 emptyOccSet       :: OccSet
 310 unitOccSet        :: OccName -> OccSet
 311 mkOccSet          :: [OccName] -> OccSet
 312 extendOccSet      :: OccSet -> OccName -> OccSet
 313 extendOccSetList  :: OccSet -> [OccName] -> OccSet
 314 unionOccSets      :: OccSet -> OccSet -> OccSet
 315 unionManyOccSets  :: [OccSet] -> OccSet
 316 minusOccSet       :: OccSet -> OccSet -> OccSet
 317 elemOccSet        :: OccName -> OccSet -> Bool
 318 occSetElts        :: OccSet -> [OccName]
 319 foldOccSet        :: (OccName -> b -> b) -> b -> OccSet -> b
 320 isEmptyOccSet     :: OccSet -> Bool
 321 intersectOccSet   :: OccSet -> OccSet -> OccSet
 322 intersectsOccSet  :: OccSet -> OccSet -> Bool
 323
 324 emptyOccSet       = emptyUniqSet
 325 unitOccSet        = unitUniqSet
 326 mkOccSet          = mkUniqSet
 327 extendOccSet      = addOneToUniqSet
 328 extendOccSetList  = addListToUniqSet
 329 unionOccSets      = unionUniqSets
 330 unionManyOccSets  = unionManyUniqSets
 331 minusOccSet       = minusUniqSet
 332 elemOccSet        = elementOfUniqSet
 333 occSetElts        = uniqSetToList
 334 foldOccSet        = foldUniqSet
 335 isEmptyOccSet     = isEmptyUniqSet
 336 intersectOccSet   = intersectUniqSets
 337 intersectsOccSet s1 s2 = not (isEmptyOccSet (s1 `intersectOccSet` s2))
 338 \end{code}
 339
 340
 341 %************************************************************************
 342 %*                                                                      *
 343 \subsection{Predicates and taking them apart}
 344 %*                                                                      *
 345 %************************************************************************
 346
 347 \begin{code}
 348 occNameString :: OccName -> String
 349 occNameString (OccName _ s) = unpackFS s
 350
 351 setOccNameSpace :: NameSpace -> OccName -> OccName
 352 setOccNameSpace sp (OccName _ occ) = OccName sp occ
 353
 354 isVarOcc, isTvOcc, isDataSymOcc, isSymOcc, isTcOcc :: OccName -> Bool
 355
 356 isVarOcc (OccName VarName _) = True
 357 isVarOcc other               = False
 358
 359 isTvOcc (OccName TvName _) = True
 360 isTvOcc other              = False
 361
 362 isTcOcc (OccName TcClsName _) = True
 363 isTcOcc other                 = False
 364
 365 isValOcc (OccName VarName  _) = True
 366 isValOcc (OccName DataName _) = True
 367 isValOcc other                = False
 368
 369 -- Data constructor operator (starts with ':', or '[]')
 370 -- Pretty inefficient!
 371 isDataSymOcc (OccName DataName s) = isLexConSym s
 372 isDataSymOcc (OccName VarName s)
 373   | isLexConSym s = pprPanic "isDataSymOcc: check me" (ppr s)
 374                 -- Jan06: I don't think this should happen
 375 isDataSymOcc other                = False
 376
 377 isDataOcc (OccName DataName _) = True
 378 isDataOcc (OccName VarName s)
 379   | isLexCon s = pprPanic "isDataOcc: check me" (ppr s)
 380                 -- Jan06: I don't think this should happen
 381 isDataOcc other                = False
 382
 383 -- Any operator (data constructor or variable)
 384 -- Pretty inefficient!
 385 isSymOcc (OccName DataName s)  = isLexConSym s
 386 isSymOcc (OccName TcClsName s) = isLexConSym s
 387 isSymOcc (OccName VarName s)   = isLexSym s
 388 isSymOcc (OccName TvName s)    = isLexSym s
 389
 390 parenSymOcc :: OccName -> SDoc -> SDoc
 391 -- Wrap parens around an operator
 392 parenSymOcc occ doc | isSymOcc occ = parens doc
 393                     | otherwise    = doc
 394 \end{code}
 395
 396
 397 \begin{code}
 398 reportIfUnused :: OccName -> Bool
 399   -- Haskell 98 encourages compilers to suppress warnings about
 400   -- unused names in a pattern if they start with "_".
 401 reportIfUnused occ = case occNameString occ of
 402                         ('_' : _) -> False
 403                         _other    -> True
 404 \end{code}
 405
 406
 407 %************************************************************************
 408 %*                                                                      *
 409 \subsection{Making system names}
 410 %*                                                                      *
 411 %************************************************************************
 412
 413 Here's our convention for splitting up the interface file name space:
 414
 415         d...            dictionary identifiers
 416                         (local variables, so no name-clash worries)
 417
 418         $f...           dict-fun identifiers (from inst decls)
 419         $dm...          default methods
 420         $p...           superclass selectors
 421         $w...           workers
 422         :T...           compiler-generated tycons for dictionaries
 423         :D...           ...ditto data cons
 424         :Co...          ...ditto coercions
 425         $sf..           specialised version of f
 426
 427         in encoded form these appear as Zdfxxx etc
 428
 429         :...            keywords (export:, letrec: etc.)
 430 --- I THINK THIS IS WRONG!
 431
 432 This knowledge is encoded in the following functions.
 433
 434
 435 @mk_deriv@ generates an @OccName@ from the prefix and a string.
 436 NB: The string must already be encoded!
 437
 438 \begin{code}
 439 mk_deriv :: NameSpace
 440          -> String              -- Distinguishes one sort of derived name from another
 441          -> String
 442          -> OccName
 443
 444 mk_deriv occ_sp sys_prefix str = mkOccName occ_sp (sys_prefix ++ str)
 445 \end{code}
 446
 447 \begin{code}
 448 mkDataConWrapperOcc, mkWorkerOcc, mkDefaultMethodOcc, mkDerivedTyConOcc,
 449         mkClassTyConOcc, mkClassDataConOcc, mkDictOcc, mkIPOcc,
 450         mkSpecOcc, mkForeignExportOcc, mkGenOcc1, mkGenOcc2,
 451         mkDataTOcc, mkDataCOcc, mkDataConWorkerOcc, mkNewTyCoOcc
 452    :: OccName -> OccName
 453
 454 -- These derived variables have a prefix that no Haskell value could have
 455 mkDataConWrapperOcc = mk_simple_deriv varName  "$W"
 456 mkWorkerOcc         = mk_simple_deriv varName  "$w"
 457 mkDefaultMethodOcc  = mk_simple_deriv varName  "$dm"
 458 mkDerivedTyConOcc   = mk_simple_deriv tcName   ":"      -- The : prefix makes sure it classifies
 459 mkClassTyConOcc     = mk_simple_deriv tcName   ":T"     -- as a tycon/datacon
 460 mkClassDataConOcc   = mk_simple_deriv dataName ":D"     -- We go straight to the "real" data con
 461                                                         -- for datacons from classes
 462 mkDictOcc           = mk_simple_deriv varName  "$d"
 463 mkIPOcc             = mk_simple_deriv varName  "$i"
 464 mkSpecOcc           = mk_simple_deriv varName  "$s"
 465 mkForeignExportOcc  = mk_simple_deriv varName  "$f"
 466 mkNewTyCoOcc        = mk_simple_deriv tcName  ":Co"
 467 mkInstTyCoOcc       = mk_simple_deriv tcName  ":CoF"     -- derived from rep ty
 468 mkEqPredCoOcc       = mk_simple_deriv tcName  "$co"
 469
 470 -- Generic derivable classes
 471 mkGenOcc1           = mk_simple_deriv varName  "$gfrom"
 472 mkGenOcc2           = mk_simple_deriv varName  "$gto"
 473
 474 -- data T = MkT ... deriving( Data ) needs defintions for
 475 --      $tT   :: Data.Generics.Basics.DataType
 476 --      $cMkT :: Data.Generics.Basics.Constr
 477 mkDataTOcc = mk_simple_deriv varName  "$t"
 478 mkDataCOcc = mk_simple_deriv varName  "$c"
 479
 480 -- Vectorisation
 481 mkVectOcc          = mk_simple_deriv varName  "$v_"
 482 mkVectTyConOcc     = mk_simple_deriv tcName   ":V_"
 483 mkVectDataConOcc   = mk_simple_deriv dataName ":VD_"
 484 mkVectIsoOcc       = mk_simple_deriv varName  "$VI_"
 485 mkPArrayTyConOcc   = mk_simple_deriv tcName   ":VP_"
 486 mkPArrayDataConOcc = mk_simple_deriv dataName ":VPD_"
 487 mkPReprTyConOcc    = mk_simple_deriv tcName   ":VR_"
 488 mkPADFunOcc        = mk_simple_deriv varName  "$PA_"
 489
 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 fs) = 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 = emptyOccEnv
 593
 594 initTidyOccEnv :: [OccName] -> TidyOccEnv       -- Initialise with names to avoid!
 595 initTidyOccEnv = foldl (\env occ -> extendOccEnv env occ 1) emptyTidyOccEnv
 596
 597 tidyOccName :: TidyOccEnv -> OccName -> (TidyOccEnv, OccName)
 598
 599 tidyOccName in_scope occ@(OccName occ_sp fs)
 600   = case lookupOccEnv in_scope occ of
 601         Nothing ->      -- Not already used: make it used
 602                    (extendOccEnv in_scope occ 1, occ)
 603
 604         Just n  ->      -- Already used: make a new guess,
 605                         -- change the guess base, and try again
 606                    tidyOccName  (extendOccEnv in_scope occ (n+1))
 607                                 (mkOccName occ_sp (unpackFS fs ++ show n))
 608 \end{code}
 609
 610 %************************************************************************
 611 %*                                                                      *
 612                 Stuff for dealing with tuples
 613 %*                                                                      *
 614 %************************************************************************
 615
 616 \begin{code}
 617 mkTupleOcc :: NameSpace -> Boxity -> Arity -> OccName
 618 mkTupleOcc ns bx ar = OccName ns (mkFastString str)
 619   where
 620         -- no need to cache these, the caching is done in the caller
 621         -- (TysWiredIn.mk_tuple)
 622     str = case bx of
 623                 Boxed   -> '(' : commas ++ ")"
 624                 Unboxed -> '(' : '#' : commas ++ "#)"
 625
 626     commas = take (ar-1) (repeat ',')
 627
 628 isTupleOcc_maybe :: OccName -> Maybe (NameSpace, Boxity, Arity)
 629 -- Tuples are special, because there are so many of them!
 630 isTupleOcc_maybe (OccName ns fs)
 631   = case unpackFS fs of
 632         '(':'#':',':rest -> Just (ns, Unboxed, 2 + count_commas rest)
 633         '(':',':rest     -> Just (ns, Boxed,   2 + count_commas rest)
 634         _other           -> Nothing
 635   where
 636     count_commas (',':rest) = 1 + count_commas rest
 637     count_commas _          = 0
 638 \end{code}
 639
 640 %************************************************************************
 641 %*                                                                      *
 642 \subsection{Lexical categories}
 643 %*                                                                      *
 644 %************************************************************************
 645
 646 These functions test strings to see if they fit the lexical categories
 647 defined in the Haskell report.
 648
 649 \begin{code}
 650 isLexCon,   isLexVar,    isLexId,    isLexSym    :: FastString -> Bool
 651 isLexConId, isLexConSym, isLexVarId, isLexVarSym :: FastString -> Bool
 652
 653 isLexCon cs = isLexConId  cs || isLexConSym cs
 654 isLexVar cs = isLexVarId  cs || isLexVarSym cs
 655
 656 isLexId  cs = isLexConId  cs || isLexVarId  cs
 657 isLexSym cs = isLexConSym cs || isLexVarSym cs
 658
 659 -------------
 660
 661 isLexConId cs                           -- Prefix type or data constructors
 662   | nullFS cs         = False           --      e.g. "Foo", "[]", "(,)"
 663   | cs == FSLIT("[]") = True
 664   | otherwise         = startsConId (headFS cs)
 665
 666 isLexVarId cs                           -- Ordinary prefix identifiers
 667   | nullFS cs         = False           --      e.g. "x", "_x"
 668   | otherwise         = startsVarId (headFS cs)
 669
 670 isLexConSym cs                          -- Infix type or data constructors
 671   | nullFS cs         = False           --      e.g. ":-:", ":", "->"
 672   | cs == FSLIT("->") = True
 673   | otherwise         = startsConSym (headFS cs)
 674
 675 isLexVarSym cs                          -- Infix identifiers
 676   | nullFS cs         = False           --      e.g. "+"
 677   | otherwise         = startsVarSym (headFS cs)
 678
 679 -------------
 680 startsVarSym, startsVarId, startsConSym, startsConId :: Char -> Bool
 681 startsVarSym c = isSymbolASCII c || (ord c > 0x7f && isSymbol c) -- Infix Ids
 682 startsConSym c = c == ':'                               -- Infix data constructors
 683 startsVarId c  = isLower c || c == '_'  -- Ordinary Ids
 684 startsConId c  = isUpper c || c == '('  -- Ordinary type constructors and data constructors
 685
 686 isSymbolASCII c = c `elem` "!#$%&*+./<=>?@\\^|~-"
 687 \end{code}
 688
 689 %************************************************************************
 690 %*                                                                      *
 691                 Binary instance
 692     Here rather than BinIface because OccName is abstract
 693 %*                                                                      *
 694 %************************************************************************
 695
 696 \begin{code}
 697 instance Binary NameSpace where
 698     put_ bh VarName = do
 699             putByte bh 0
 700     put_ bh DataName = do
 701             putByte bh 1
 702     put_ bh TvName = do
 703             putByte bh 2
 704     put_ bh TcClsName = do
 705             putByte bh 3
 706     get bh = do
 707             h <- getByte bh
 708             case h of
 709               0 -> do return VarName
 710               1 -> do return DataName
 711               2 -> do return TvName
 712               _ -> do return TcClsName
 713
 714 instance Binary OccName where
 715     put_ bh (OccName aa ab) = do
 716             put_ bh aa
 717             put_ bh ab
 718     get bh = do
 719           aa <- get bh
 720           ab <- get bh
 721           return (OccName aa ab)
 722 \end{code}