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