ghc/compiler/basicTypes/Name.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
   3 %
   4 \section[Name]{@Name@: to transmit name info from renamer to typechecker}
   5
   6 \begin{code}
   7 #include "HsVersions.h"
   8
   9 module Name (
  10         SYN_IE(Module),
  11
  12         OrigName(..), -- glorified pair
  13         qualToOrigName, -- a Qual to an OrigName
  14
  15         RdrName(..),
  16         preludeQual,
  17         moduleNamePair,
  18         isUnqual,
  19         isQual,
  20         isRdrLexCon, isRdrLexConOrSpecial,
  21         appendRdr,
  22         showRdr,
  23         cmpRdr,
  24
  25         Name,
  26         Provenance,
  27         mkLocalName, isLocalName,
  28         mkTopLevName, mkImportedName, oddlyImportedName,
  29         mkImplicitName, isImplicitName,
  30         mkPrimitiveName, mkWiredInName,
  31         mkCompoundName, mkCompoundName2,
  32
  33         mkFunTyConName, mkTupleDataConName, mkTupleTyConName,
  34         mkTupNameStr,
  35
  36         NamedThing(..), -- class
  37         ExportFlag(..),
  38         isExported{-overloaded-}, exportFlagOn{-not-},
  39
  40         nameUnique, changeUnique,
  41         nameOccName,
  42 --      nameOrigName, : not exported
  43         nameExportFlag,
  44         nameSrcLoc,
  45         nameImpLocs,
  46         nameImportFlag,
  47         isLocallyDefinedName, isWiredInName,
  48
  49         origName, moduleOf, nameOf,
  50         getOccName, getExportFlag,
  51         getSrcLoc, getImpLocs,
  52         isLocallyDefined,
  53         getLocalName,
  54
  55         isSymLexeme, pprSym, pprNonSym,
  56         isLexCon, isLexVar, isLexId, isLexSym, isLexSpecialSym,
  57         isLexConId, isLexConSym, isLexVarId, isLexVarSym
  58     ) where
  59
  60 IMP_Ubiq()
  61 IMPORT_1_3(Char(isUpper,isLower))
  62
  63 import CmdLineOpts      ( maybe_CompilingGhcInternals )
  64 import CStrings         ( identToC, modnameToC, cSEP )
  65 import Outputable       ( Outputable(..) )
  66 import PprStyle         ( PprStyle(..), codeStyle )
  67 import PrelMods         ( pRELUDE )
  68 import Pretty
  69 import SrcLoc           ( mkBuiltinSrcLoc, mkUnknownSrcLoc, SrcLoc )
  70 import Unique           ( funTyConKey, mkTupleDataConUnique, mkTupleTyConUnique,
  71                           pprUnique, Unique
  72                         )
  73 import Util             ( thenCmp, _CMP_STRING_, nOfThem, panic, assertPanic, pprTrace{-ToDo:rm-} )
  74
  75 #ifdef REALLY_HASKELL_1_3
  76 ord = fromEnum :: Char -> Int
  77 #endif
  78 \end{code}
  79
  80 %************************************************************************
  81 %*                                                                      *
  82 \subsection[RdrName]{The @RdrName@ datatype; names read from files}
  83 %*                                                                      *
  84 %************************************************************************
  85
  86 \begin{code}
  87 type Module = FAST_STRING
  88
  89 data OrigName = OrigName Module FAST_STRING
  90
  91 qualToOrigName (Qual m n) = OrigName m n
  92
  93 data RdrName
  94   = Unqual FAST_STRING
  95   | Qual   Module FAST_STRING
  96
  97 preludeQual n = Qual pRELUDE n
  98
  99 moduleNamePair (Qual m n) = (m, n)  -- we make *no* claim whether this
 100                                     -- constitutes an original name or
 101                                     -- an occurrence name, or anything else
 102
 103 isUnqual (Unqual _) = True
 104 isUnqual (Qual _ _) = False
 105
 106 isQual (Unqual _) = False
 107 isQual (Qual _ _) = True
 108
 109 isRdrLexCon (Unqual n) = isLexCon n
 110 isRdrLexCon (Qual m n) = isLexCon n
 111
 112 isRdrLexConOrSpecial (Unqual n) = isLexCon n || isLexSpecialSym n
 113 isRdrLexConOrSpecial (Qual m n) = isLexCon n || isLexSpecialSym n
 114
 115 appendRdr (Unqual n) str = Unqual (n _APPEND_ str)
 116 appendRdr (Qual m n) str = Qual m (n _APPEND_ str)
 117
 118 cmpRdr (Unqual  n1) (Unqual  n2) = _CMP_STRING_ n1 n2
 119 cmpRdr (Unqual  n1) (Qual m2 n2) = LT_
 120 cmpRdr (Qual m1 n1) (Unqual  n2) = GT_
 121 cmpRdr (Qual m1 n1) (Qual m2 n2) = _CMP_STRING_ n1 n2 `thenCmp` _CMP_STRING_ m1 m2
 122                                    -- always compare module-names *second*
 123
 124 cmpOrig (OrigName m1 n1) (OrigName m2 n2)
 125   = _CMP_STRING_ n1 n2 `thenCmp` _CMP_STRING_ m1 m2 -- again; module-names *second*
 126
 127 instance Eq RdrName where
 128     a == b = case (a `cmp` b) of { EQ_ -> True;  _ -> False }
 129     a /= b = case (a `cmp` b) of { EQ_ -> False; _ -> True }
 130
 131 instance Ord RdrName where
 132     a <= b = case (a `cmp` b) of { LT_ -> True;  EQ_ -> True;  GT__ -> False }
 133     a <  b = case (a `cmp` b) of { LT_ -> True;  EQ_ -> False; GT__ -> False }
 134     a >= b = case (a `cmp` b) of { LT_ -> False; EQ_ -> True;  GT__ -> True  }
 135     a >  b = case (a `cmp` b) of { LT_ -> False; EQ_ -> False; GT__ -> True  }
 136
 137 instance Ord3 RdrName where
 138     cmp = cmpRdr
 139
 140 instance NamedThing RdrName where
 141     -- We're sorta faking it here
 142     getName (Unqual n)
 143       = Local u n True locn
 144       where
 145         u    = panic "NamedThing.RdrName:Unique1"
 146         locn = panic "NamedThing.RdrName:locn"
 147
 148     getName rdr_name@(Qual m n)
 149       = Global u m (Left n) prov ex [rdr_name]
 150       where
 151         u    = panic "NamedThing.RdrName:Unique"
 152         prov = panic "NamedThing.RdrName:Provenance"
 153         ex   = panic "NamedThing.RdrName:ExportFlag"
 154
 155 instance Outputable RdrName where
 156     ppr sty (Unqual n) = pp_name sty n
 157     ppr sty (Qual m n) = ppBeside (pp_mod sty m) (pp_name sty n)
 158
 159 pp_mod sty m
 160   = case sty of
 161       PprForC           -> pp_code
 162       PprForAsm False _ -> pp_code
 163       PprForAsm True  _ -> ppBeside (ppPStr cSEP) pp_code
 164       _                 -> ppBeside (ppPStr m)    (ppChar '.')
 165   where
 166     pp_code = ppBeside (ppPStr (modnameToC m)) (ppPStr cSEP)
 167
 168 pp_name sty n = (if codeStyle sty then identToC else ppPStr) n
 169
 170 pp_name2 sty pieces
 171   = ppIntersperse sep (map pp_piece pieces)
 172   where
 173     sep = if codeStyle sty then ppPStr cSEP else ppChar '.'
 174
 175     pp_piece (Left (OrigName m n)) = ppBeside (pp_mod sty m) (pp_name sty n)
 176     pp_piece (Right n)             = pp_name sty n
 177
 178 showRdr sty rdr = ppShow 100 (ppr sty rdr)
 179
 180 -------------------------
 181 instance Eq OrigName where
 182     a == b = case (a `cmp` b) of { EQ_ -> True;  _ -> False }
 183     a /= b = case (a `cmp` b) of { EQ_ -> False; _ -> True }
 184
 185 instance Ord OrigName where
 186     a <= b = case (a `cmp` b) of { LT_ -> True;  EQ_ -> True;  GT__ -> False }
 187     a <  b = case (a `cmp` b) of { LT_ -> True;  EQ_ -> False; GT__ -> False }
 188     a >= b = case (a `cmp` b) of { LT_ -> False; EQ_ -> True;  GT__ -> True  }
 189     a >  b = case (a `cmp` b) of { LT_ -> False; EQ_ -> False; GT__ -> True  }
 190
 191 instance Ord3 OrigName where
 192     cmp = cmpOrig
 193
 194 instance NamedThing OrigName where -- faking it
 195     getName (OrigName m n) = getName (Qual m n)
 196
 197 instance Outputable OrigName where -- ditto
 198     ppr sty (OrigName m n) = ppr sty (Qual m n)
 199 \end{code}
 200
 201 %************************************************************************
 202 %*                                                                      *
 203 \subsection[Name-datatype]{The @Name@ datatype}
 204 %*                                                                      *
 205 %************************************************************************
 206
 207 \begin{code}
 208 data Name
 209   = Local    Unique
 210              FAST_STRING
 211              Bool       -- True <=> emphasize Unique when
 212                         -- printing; this is just an esthetic thing...
 213              SrcLoc
 214
 215   | Global   Unique
 216              Module     -- original name
 217              (Either
 218                 FAST_STRING -- just an ordinary M.n name... or...
 219                 ([Either OrigName FAST_STRING]))
 220                             -- "dot" these bits of name together...
 221              Provenance -- where it came from
 222              ExportFlag -- is it exported?
 223              [RdrName]  -- ordered occurrence names (usually just one);
 224                         -- first may be *un*qual.
 225
 226 data Provenance
 227   = LocalDef SrcLoc     -- locally defined; give its source location
 228
 229   | Imported ExportFlag -- how it was imported
 230              SrcLoc     -- *original* source location
 231              [SrcLoc]   -- any import source location(s)
 232
 233   | Implicit
 234   | Primitive           -- really and truly primitive thing (not
 235                         -- definable in Haskell)
 236   | WiredIn  Bool       -- something defined in Haskell; True <=>
 237                         -- definition is in the module in question;
 238                         -- this probably comes from the -fcompiling-prelude=...
 239                         -- flag.
 240 \end{code}
 241
 242 \begin{code}
 243 mkLocalName = Local
 244
 245 mkTopLevName   u (OrigName m n) locn exp occs = Global u m (Left n) (LocalDef locn) exp occs
 246 mkImportedName u (OrigName m n) imp locn imp_locs exp occs = Global u m (Left n) (Imported imp locn imp_locs) exp occs
 247
 248 mkImplicitName :: Unique -> OrigName -> Name
 249 mkImplicitName u (OrigName m n) = Global u m (Left n) Implicit NotExported []
 250
 251 mkPrimitiveName :: Unique -> OrigName -> Name
 252 mkPrimitiveName u (OrigName m n)  = Global u m (Left n) Primitive NotExported []
 253
 254 mkWiredInName :: Unique -> OrigName -> ExportFlag -> Name
 255 mkWiredInName u (OrigName m n) exp
 256   = Global u m (Left n) (WiredIn from_here) exp []
 257   where
 258     from_here
 259       = case maybe_CompilingGhcInternals of
 260           Nothing  -> False
 261           Just mod -> mod == _UNPK_ m
 262
 263 mkCompoundName :: Unique
 264                -> Module
 265                -> FAST_STRING   -- indicates what kind of compound thing it is (e.g., "sdsel")
 266                -> [Either OrigName FAST_STRING] -- "dot" these names together
 267                -> Name          -- from which we get provenance, etc....
 268                -> Name          -- result!
 269
 270 mkCompoundName u m str ns (Local _ _ _ locn) -- these arise for workers...
 271   = Local u str True{-emph uniq-} locn
 272
 273 mkCompoundName u m str ns (Global _ _ _ prov exp _)
 274   = Global u m (Right (Right str : ns)) prov exp []
 275
 276 glue = glue1
 277 glue1 (Left (OrigName m n):ns) = m : _CONS_ '.' n : glue2 ns
 278 glue1 (Right n            :ns) = n                : glue2 ns
 279 glue2 []                       = []
 280 glue2 (Left (OrigName m n):ns) = _CONS_ '.' m : _CONS_ '.' n : glue2 ns
 281 glue2 (Right n            :ns) = _CONS_ '.' n                : glue2 ns
 282
 283 -- this ugly one is used for instance-y things
 284 mkCompoundName2 :: Unique
 285                 -> Module
 286                 -> FAST_STRING  -- indicates what kind of compound thing it is
 287                 -> [Either OrigName FAST_STRING] -- "dot" these names together
 288                 -> Bool         -- True <=> defined in this module
 289                 -> SrcLoc
 290                 -> Name         -- result!
 291
 292 mkCompoundName2 u m str ns from_here locn
 293   = Global u m (Right (Right str : ns))
 294              (if from_here then LocalDef locn else Imported ExportAll locn [])
 295              ExportAll{-instances-}
 296              []
 297
 298 mkFunTyConName
 299   = mkPrimitiveName funTyConKey                (OrigName pRELUDE SLIT("->"))
 300 mkTupleDataConName arity
 301   = mkWiredInName (mkTupleDataConUnique arity) (OrigName pRELUDE (mkTupNameStr arity)) ExportAll
 302 mkTupleTyConName   arity
 303   = mkWiredInName (mkTupleTyConUnique   arity) (OrigName pRELUDE (mkTupNameStr arity)) ExportAll
 304
 305 mkTupNameStr 0 = SLIT("()")
 306 mkTupNameStr 1 = panic "Name.mkTupNameStr: 1 ???"
 307 mkTupNameStr 2 = _PK_ "(,)"   -- not strictly necessary
 308 mkTupNameStr 3 = _PK_ "(,,)"  -- ditto
 309 mkTupNameStr 4 = _PK_ "(,,,)" -- ditto
 310 mkTupNameStr n
 311   = _PK_ ("(" ++ nOfThem (n-1) ',' ++ ")")
 312
 313         -- ToDo: what about module ???
 314         -- ToDo: exported when compiling builtin ???
 315
 316 isLocalName (Local _ _ _ _) = True
 317 isLocalName _               = False
 318
 319 -- things the compiler "knows about" are in some sense
 320 -- "imported".  When we are compiling the module where
 321 -- the entities are defined, we need to be able to pick
 322 -- them out, often in combination with isLocallyDefined.
 323 oddlyImportedName (Global _ _ _ Primitive   _ _) = True
 324 oddlyImportedName (Global _ _ _ (WiredIn _) _ _) = True
 325 oddlyImportedName _                              = False
 326
 327 isImplicitName (Global _ _ _ Implicit _ _) = True
 328 isImplicitName _                           = False
 329 \end{code}
 330
 331 %************************************************************************
 332 %*                                                                      *
 333 \subsection[Name-instances]{Instance declarations}
 334 %*                                                                      *
 335 %************************************************************************
 336
 337 \begin{code}
 338 cmpName n1 n2 = c n1 n2
 339   where
 340     c (Local  u1 _ _ _)     (Local  u2 _ _ _)     = cmp u1 u2
 341     c (Local   _ _ _ _)     _                     = LT_
 342     c (Global u1 _ _ _ _ _) (Global u2 _ _ _ _ _) = cmp u1 u2
 343     c (Global  _ _ _ _ _ _) _                     = GT_
 344 \end{code}
 345
 346 \begin{code}
 347 instance Eq Name where
 348     a == b = case (a `cmp` b) of { EQ_ -> True;  _ -> False }
 349     a /= b = case (a `cmp` b) of { EQ_ -> False; _ -> True }
 350
 351 instance Ord Name where
 352     a <= b = case (a `cmp` b) of { LT_ -> True;  EQ_ -> True;  GT__ -> False }
 353     a <  b = case (a `cmp` b) of { LT_ -> True;  EQ_ -> False; GT__ -> False }
 354     a >= b = case (a `cmp` b) of { LT_ -> False; EQ_ -> True;  GT__ -> True  }
 355     a >  b = case (a `cmp` b) of { LT_ -> False; EQ_ -> False; GT__ -> True  }
 356
 357 instance Ord3 Name where
 358     cmp = cmpName
 359
 360 instance Uniquable Name where
 361     uniqueOf = nameUnique
 362
 363 instance NamedThing Name where
 364     getName n = n
 365 \end{code}
 366
 367 \begin{code}
 368 nameUnique (Local  u _ _ _)     = u
 369 nameUnique (Global u _ _ _ _ _) = u
 370
 371 -- when we renumber/rename things, we need to be
 372 -- able to change a Name's Unique to match the cached
 373 -- one in the thing it's the name of.  If you know what I mean.
 374 changeUnique (Local      _ n b l)    u = Local u n b l
 375 changeUnique (Global   _ m n p e os) u = Global u m n p e os
 376
 377 nameOrigName msg (Global _ m (Left  n) _ _ _) = OrigName m n
 378 nameOrigName msg (Global _ m (Right n) _ _ _) = let str = _CONCAT_ (glue n) in
 379                                                 pprTrace ("nameOrigName:"++msg) (ppPStr str) $
 380                                                 OrigName m str
 381 #ifdef DEBUG
 382 nameOrigName msg (Local  _ n _ _)     = panic ("nameOrigName:Local:"++msg++":"++ _UNPK_ n)
 383 #endif
 384
 385 nameOccName (Local  _ n _ _)         = Unqual n
 386 nameOccName (Global _ m (Left  n) _ _ []  )  = Qual m n
 387 nameOccName (Global _ m (Right n) _ _ []  )  =  let str = _CONCAT_ (glue n) in
 388                                                 pprTrace "nameOccName:" (ppPStr str) $
 389                                                 Qual m str
 390 nameOccName (Global _ m (Left  _) _ _ (o:_)) = o
 391 nameOccName (Global _ m (Right _) _ _ (o:_)) = panic "nameOccName:compound name"
 392
 393 nameExportFlag (Local  _ _ _ _)       = NotExported
 394 nameExportFlag (Global _ _ _ _ exp _) = exp
 395
 396 nameSrcLoc (Local  _ _ _ loc)                    = loc
 397 nameSrcLoc (Global _ _ _ (LocalDef loc)     _ _) = loc
 398 nameSrcLoc (Global _ _ _ (Imported _ loc _) _ _) = loc
 399 nameSrcLoc (Global _ _ _ Implicit           _ _) = mkUnknownSrcLoc
 400 nameSrcLoc (Global _ _ _ Primitive          _ _) = mkBuiltinSrcLoc
 401 nameSrcLoc (Global _ _ _ (WiredIn _)        _ _) = mkBuiltinSrcLoc
 402
 403 nameImpLocs (Global _ _ _ (Imported _ _ locs) _ _) = locs
 404 nameImpLocs _                                      = []
 405
 406 nameImportFlag (Local  _ _ _ _)                      = NotExported
 407 nameImportFlag (Global _ _ _ (LocalDef _)       _ _) = ExportAll
 408 nameImportFlag (Global _ _ _ (Imported exp _ _) _ _) = exp
 409 nameImportFlag (Global _ _ _ Implicit           _ _) = ExportAll
 410 nameImportFlag (Global _ _ _ Primitive          _ _) = ExportAll
 411 nameImportFlag (Global _ _ _ (WiredIn _)        _ _) = ExportAll
 412
 413 isLocallyDefinedName (Local  _ _ _ _)                       = True
 414 isLocallyDefinedName (Global _ _ _ (LocalDef _)        _ _) = True
 415 isLocallyDefinedName (Global _ _ _ (Imported _ _ _)    _ _) = False
 416 isLocallyDefinedName (Global _ _ _ Implicit            _ _) = False
 417 isLocallyDefinedName (Global _ _ _ Primitive           _ _) = False
 418 isLocallyDefinedName (Global _ _ _ (WiredIn from_here) _ _) = from_here
 419
 420 isWiredInName (Global _ _ _ (WiredIn _) _ _) = True
 421 isWiredInName _                              = False
 422 \end{code}
 423
 424 \begin{code}
 425 instance Outputable Name where
 426     ppr sty (Local u n emph_uniq _)
 427       | codeStyle sty = pprUnique u
 428       | emph_uniq     = ppBesides [pprUnique u, ppStr "{-", ppPStr n, ppStr "-}"]
 429       | otherwise     = ppBesides [ppPStr n, ppStr "{-", pprUnique u, ppStr "-}"]
 430
 431     ppr PprDebug   (Global   u m (Left  n) _ _ _) = ppBesides [pp_mod PprDebug m, pp_name  PprDebug n, ppStr "{-", pprUnique u, ppStr "-}"]
 432     ppr PprDebug   (Global   u m (Right n) _ _ _) = ppBesides [pp_mod PprDebug m, pp_name2 PprDebug n, ppStr "{-", pprUnique u, ppStr "-}"]
 433
 434     ppr PprForUser (Global   u m (Left  n) _ _ []  ) = ppBeside (pp_mod PprForUser m) (pp_name  PprForUser n)
 435     ppr PprForUser (Global   u m (Right n) _ _ []  ) = ppBeside (pp_mod PprForUser m) (pp_name2 PprForUser n)
 436     ppr PprForUser (Global   u m (Left  _) _ _ occs) = ppr PprForUser (head occs)
 437
 438 -- LATER:?
 439 --  ppr PprShowAll (Global   u m n prov exp occs) = pp_all (Qual m n) prov exp occs
 440
 441     ppr sty (Global u m (Left  n) _ _ _) = ppBeside (pp_mod sty m) (pp_name  sty n)
 442     ppr sty (Global u m (Right n) _ _ _) = ppBeside (pp_mod sty m) (pp_name2 sty n)
 443
 444 pp_all orig prov exp occs
 445   = ppBesides [ppr PprShowAll orig, ppr PprShowAll occs, pp_prov prov, pp_exp exp]
 446
 447 pp_exp NotExported = ppNil
 448 pp_exp ExportAll   = ppPStr SLIT("/EXP(..)")
 449 pp_exp ExportAbs   = ppPStr SLIT("/EXP")
 450
 451 pp_prov Implicit    = ppPStr SLIT("/IMPLICIT")
 452 pp_prov Primitive   = ppPStr SLIT("/PRIMITIVE")
 453 pp_prov (WiredIn _) = ppPStr SLIT("/WIREDIN")
 454 pp_prov _           = ppNil
 455 \end{code}
 456
 457 %************************************************************************
 458 %*                                                                      *
 459 \subsection[ExportFlag-datatype]{The @ExportFlag@ datatype}
 460 %*                                                                      *
 461 %************************************************************************
 462
 463 The export flag @ExportAll@ means `export all there is', so there are
 464 times when it is attached to a class or data type which has no
 465 ops/constructors (if the class/type was imported abstractly).  In
 466 fact, @ExportAll@ is attached to everything except to classes/types
 467 which are being {\em exported} abstractly, regardless of how they were
 468 imported.
 469
 470 \begin{code}
 471 data ExportFlag
 472   = ExportAll           -- export with all constructors/methods
 473   | ExportAbs           -- export abstractly (tycons/classes only)
 474   | NotExported
 475
 476 exportFlagOn NotExported = False
 477 exportFlagOn _           = True
 478
 479 -- Be very wary about using "isExported"; perhaps you
 480 -- really mean "externallyVisibleId"?
 481
 482 isExported a = exportFlagOn (getExportFlag a)
 483 \end{code}
 484
 485 %************************************************************************
 486 %*                                                                      *
 487 \subsection{Overloaded functions related to Names}
 488 %*                                                                      *
 489 %************************************************************************
 490
 491 \begin{code}
 492 class NamedThing a where
 493     getName :: a -> Name
 494 \end{code}
 495
 496 \begin{code}
 497 origName            :: NamedThing a => String -> a -> OrigName
 498 moduleOf            :: OrigName -> Module
 499 nameOf              :: OrigName -> FAST_STRING
 500
 501 getOccName          :: NamedThing a => a -> RdrName
 502 getLocalName        :: NamedThing a => a -> FAST_STRING
 503 getExportFlag       :: NamedThing a => a -> ExportFlag
 504 getSrcLoc           :: NamedThing a => a -> SrcLoc
 505 getImpLocs          :: NamedThing a => a -> [SrcLoc]
 506 isLocallyDefined    :: NamedThing a => a -> Bool
 507
 508 origName str n      = nameOrigName str (getName n)
 509
 510 moduleOf (OrigName m n) = m
 511 nameOf   (OrigName m n) = n
 512
 513 getLocalName n
 514   = case (getName n) of
 515       Local  _ n _ _             -> n
 516       Global _ m (Left  n) _ _ _ -> n
 517       Global _ m (Right n) _ _ _ -> let str = _CONCAT_ (glue n) in
 518                                     -- pprTrace "getLocalName:" (ppPStr str) $
 519                                     str
 520
 521 getOccName          = nameOccName          . getName
 522 getExportFlag       = nameExportFlag       . getName
 523 getSrcLoc           = nameSrcLoc           . getName
 524 getImpLocs          = nameImpLocs          . getName
 525 isLocallyDefined    = isLocallyDefinedName . getName
 526 \end{code}
 527
 528 \begin{code}
 529 {-# SPECIALIZE getLocalName
 530         :: Name     -> FAST_STRING
 531          , OrigName -> FAST_STRING
 532          , RdrName  -> FAST_STRING
 533          , RnName   -> FAST_STRING
 534   #-}
 535 {-# SPECIALIZE isLocallyDefined
 536         :: Name     -> Bool
 537          , RnName   -> Bool
 538   #-}
 539 {-# SPECIALIZE origName
 540         :: String -> Name     -> OrigName
 541          , String -> RdrName  -> OrigName
 542          , String -> RnName   -> OrigName
 543   #-}
 544 \end{code}
 545
 546 These functions test strings to see if they fit the lexical categories
 547 defined in the Haskell report.  Normally applied as in e.g. @isCon
 548 (getLocalName foo)@.
 549
 550 \begin{code}
 551 isLexCon, isLexVar, isLexId, isLexSym, isLexConId, isLexConSym,
 552  isLexVarId, isLexVarSym, isLexSpecialSym :: FAST_STRING -> Bool
 553
 554 isLexCon cs = isLexConId  cs || isLexConSym cs
 555 isLexVar cs = isLexVarId  cs || isLexVarSym cs
 556
 557 isLexId  cs = isLexConId  cs || isLexVarId  cs
 558 isLexSym cs = isLexConSym cs || isLexVarSym cs
 559
 560 -------------
 561
 562 isLexConId cs
 563   | _NULL_ cs   = False
 564   | otherwise   = isUpper c || isUpperISO c
 565   where
 566     c = _HEAD_ cs
 567
 568 isLexVarId cs
 569   | _NULL_ cs    = False
 570   | otherwise    = isLower c || isLowerISO c
 571   where
 572     c = _HEAD_ cs
 573
 574 isLexConSym cs
 575   | _NULL_ cs   = False
 576   | otherwise   = c  == ':'
 577 --             || c  == '('     -- (), (,), (,,), ...
 578                || cs == SLIT("->")
 579 --             || cs == SLIT("[]")
 580   where
 581     c = _HEAD_ cs
 582
 583 isLexVarSym cs
 584   | _NULL_ cs = False
 585   | otherwise = isSymbolASCII c
 586              || isSymbolISO c
 587 --           || c  == '('       -- (), (,), (,,), ...
 588 --           || cs == SLIT("[]")
 589   where
 590     c = _HEAD_ cs
 591
 592 isLexSpecialSym cs
 593   | _NULL_ cs = False
 594   | otherwise = c  == '('       -- (), (,), (,,), ...
 595              || cs == SLIT("[]")
 596   where
 597     c = _HEAD_ cs
 598
 599 -------------
 600 isSymbolASCII c = c `elem` "!#$%&*+./<=>?@\\^|~-"
 601 isSymbolISO   c = ord c `elem` (0xd7 : 0xf7 : [0xa1 .. 0xbf])
 602 isUpperISO    c = 0xc0 <= oc && oc <= 0xde && oc /= 0xd7 where oc = ord c
 603 isLowerISO    c = 0xdf <= oc && oc <= 0xff && oc /= 0xf7 where oc = ord c
 604 \end{code}
 605
 606 And one ``higher-level'' interface to those:
 607
 608 \begin{code}
 609 isSymLexeme :: NamedThing a => a -> Bool
 610
 611 isSymLexeme v
 612   = let str = getLocalName v in isLexSym str
 613
 614 -- print `vars`, (op) correctly
 615 pprSym, pprNonSym :: (NamedThing name, Outputable name) => PprStyle -> name -> Pretty
 616
 617 pprSym sty var
 618   = let
 619         str = getLocalName var
 620     in
 621     if isLexSym str && not (isLexSpecialSym str)
 622     then ppr sty var
 623     else ppBesides [ppChar '`', ppr sty var, ppChar '`']
 624
 625 pprNonSym sty var
 626   = if isSymLexeme var
 627     then ppParens (ppr sty var)
 628     else ppr sty var
 629 \end{code}