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 import {-hide from mkdependHS-}
  75         RnHsSyn         ( RnName ) -- instance for specializing only
  76
  77 #ifdef REALLY_HASKELL_1_3
  78 ord = fromEnum :: Char -> Int
  79 #endif
  80 \end{code}
  81
  82 %************************************************************************
  83 %*                                                                      *
  84 \subsection[RdrName]{The @RdrName@ datatype; names read from files}
  85 %*                                                                      *
  86 %************************************************************************
  87
  88 \begin{code}
  89 type Module = FAST_STRING
  90
  91 data OrigName = OrigName Module FAST_STRING
  92
  93 qualToOrigName (Qual m n) = OrigName m n
  94
  95 data RdrName
  96   = Unqual FAST_STRING
  97   | Qual   Module FAST_STRING
  98
  99 preludeQual n = Qual pRELUDE n
 100
 101 moduleNamePair (Qual m n) = (m, n)  -- we make *no* claim whether this
 102                                     -- constitutes an original name or
 103                                     -- an occurrence name, or anything else
 104
 105 isUnqual (Unqual _) = True
 106 isUnqual (Qual _ _) = False
 107
 108 isQual (Unqual _) = False
 109 isQual (Qual _ _) = True
 110
 111 isRdrLexCon (Unqual n) = isLexCon n
 112 isRdrLexCon (Qual m n) = isLexCon n
 113
 114 isRdrLexConOrSpecial (Unqual n) = isLexCon n || isLexSpecialSym n
 115 isRdrLexConOrSpecial (Qual m n) = isLexCon n || isLexSpecialSym n
 116
 117 appendRdr (Unqual n) str = Unqual (n _APPEND_ str)
 118 appendRdr (Qual m n) str = Qual m (n _APPEND_ str)
 119
 120 cmpRdr (Unqual  n1) (Unqual  n2) = _CMP_STRING_ n1 n2
 121 cmpRdr (Unqual  n1) (Qual m2 n2) = LT_
 122 cmpRdr (Qual m1 n1) (Unqual  n2) = GT_
 123 cmpRdr (Qual m1 n1) (Qual m2 n2) = _CMP_STRING_ n1 n2 `thenCmp` _CMP_STRING_ m1 m2
 124                                    -- always compare module-names *second*
 125
 126 cmpOrig (OrigName m1 n1) (OrigName m2 n2)
 127   = _CMP_STRING_ n1 n2 `thenCmp` _CMP_STRING_ m1 m2 -- again; module-names *second*
 128
 129 instance Eq RdrName where
 130     a == b = case (a `cmp` b) of { EQ_ -> True;  _ -> False }
 131     a /= b = case (a `cmp` b) of { EQ_ -> False; _ -> True }
 132
 133 instance Ord RdrName where
 134     a <= b = case (a `cmp` b) of { LT_ -> True;  EQ_ -> True;  GT__ -> False }
 135     a <  b = case (a `cmp` b) of { LT_ -> True;  EQ_ -> False; GT__ -> False }
 136     a >= b = case (a `cmp` b) of { LT_ -> False; EQ_ -> True;  GT__ -> True  }
 137     a >  b = case (a `cmp` b) of { LT_ -> False; EQ_ -> False; GT__ -> True  }
 138
 139 instance Ord3 RdrName where
 140     cmp = cmpRdr
 141
 142 instance NamedThing RdrName where
 143     -- We're sorta faking it here
 144     getName (Unqual n)
 145       = Local u n True locn
 146       where
 147         u    = panic "NamedThing.RdrName:Unique1"
 148         locn = panic "NamedThing.RdrName:locn"
 149
 150     getName rdr_name@(Qual m n)
 151       = Global u m (Left n) prov ex [rdr_name]
 152       where
 153         u    = panic "NamedThing.RdrName:Unique"
 154         prov = panic "NamedThing.RdrName:Provenance"
 155         ex   = panic "NamedThing.RdrName:ExportFlag"
 156
 157 instance Outputable RdrName where
 158     ppr sty (Unqual n) = pp_name sty n
 159     ppr sty (Qual m n) = ppBeside (pp_mod sty m) (pp_name sty n)
 160
 161 pp_mod sty m
 162   = case sty of
 163       PprForC           -> pp_code
 164       PprForAsm False _ -> pp_code
 165       PprForAsm True  _ -> ppBeside (ppPStr cSEP) pp_code
 166       _                 -> ppBeside (ppPStr m)    (ppChar '.')
 167   where
 168     pp_code = ppBeside (ppPStr (modnameToC m)) (ppPStr cSEP)
 169
 170 pp_name sty n = (if codeStyle sty then identToC else ppPStr) n
 171
 172 pp_name2 sty pieces
 173   = ppIntersperse sep (map pp_piece pieces)
 174   where
 175     sep = if codeStyle sty then ppPStr cSEP else ppChar '.'
 176
 177     pp_piece (Left (OrigName m n)) = ppBeside (pp_mod sty m) (pp_name sty n)
 178     pp_piece (Right n)             = pp_name sty n
 179
 180 showRdr sty rdr = ppShow 100 (ppr sty rdr)
 181
 182 -------------------------
 183 instance Eq OrigName where
 184     a == b = case (a `cmp` b) of { EQ_ -> True;  _ -> False }
 185     a /= b = case (a `cmp` b) of { EQ_ -> False; _ -> True }
 186
 187 instance Ord OrigName where
 188     a <= b = case (a `cmp` b) of { LT_ -> True;  EQ_ -> True;  GT__ -> False }
 189     a <  b = case (a `cmp` b) of { LT_ -> True;  EQ_ -> False; GT__ -> False }
 190     a >= b = case (a `cmp` b) of { LT_ -> False; EQ_ -> True;  GT__ -> True  }
 191     a >  b = case (a `cmp` b) of { LT_ -> False; EQ_ -> False; GT__ -> True  }
 192
 193 instance Ord3 OrigName where
 194     cmp = cmpOrig
 195
 196 instance NamedThing OrigName where -- faking it
 197     getName (OrigName m n) = getName (Qual m n)
 198
 199 instance Outputable OrigName where -- ditto
 200     ppr sty (OrigName m n) = ppr sty (Qual m n)
 201 \end{code}
 202
 203 %************************************************************************
 204 %*                                                                      *
 205 \subsection[Name-datatype]{The @Name@ datatype}
 206 %*                                                                      *
 207 %************************************************************************
 208
 209 \begin{code}
 210 data Name
 211   = Local    Unique
 212              FAST_STRING
 213              Bool       -- True <=> emphasize Unique when
 214                         -- printing; this is just an esthetic thing...
 215              SrcLoc
 216
 217   | Global   Unique
 218              Module     -- original name
 219              (Either
 220                 FAST_STRING -- just an ordinary M.n name... or...
 221                 ([Either OrigName FAST_STRING]))
 222                             -- "dot" these bits of name together...
 223              Provenance -- where it came from
 224              ExportFlag -- is it exported?
 225              [RdrName]  -- ordered occurrence names (usually just one);
 226                         -- first may be *un*qual.
 227
 228 data Provenance
 229   = LocalDef SrcLoc     -- locally defined; give its source location
 230
 231   | Imported ExportFlag -- how it was imported
 232              SrcLoc     -- *original* source location
 233              [SrcLoc]   -- any import source location(s)
 234
 235   | Implicit
 236   | Primitive           -- really and truly primitive thing (not
 237                         -- definable in Haskell)
 238   | WiredIn  Bool       -- something defined in Haskell; True <=>
 239                         -- definition is in the module in question;
 240                         -- this probably comes from the -fcompiling-prelude=...
 241                         -- flag.
 242 \end{code}
 243
 244 \begin{code}
 245 mkLocalName = Local
 246
 247 mkTopLevName   u (OrigName m n) locn exp occs = Global u m (Left n) (LocalDef locn) exp occs
 248 mkImportedName u (OrigName m n) imp locn imp_locs exp occs = Global u m (Left n) (Imported imp locn imp_locs) exp occs
 249
 250 mkImplicitName :: Unique -> OrigName -> Name
 251 mkImplicitName u (OrigName m n) = Global u m (Left n) Implicit NotExported []
 252
 253 mkPrimitiveName :: Unique -> OrigName -> Name
 254 mkPrimitiveName u (OrigName m n)  = Global u m (Left n) Primitive NotExported []
 255
 256 mkWiredInName :: Unique -> OrigName -> ExportFlag -> Name
 257 mkWiredInName u (OrigName m n) exp
 258   = Global u m (Left n) (WiredIn from_here) exp []
 259   where
 260     from_here
 261       = case maybe_CompilingGhcInternals of
 262           Nothing  -> False
 263           Just mod -> mod == _UNPK_ m
 264
 265 mkCompoundName :: Unique
 266                -> Module
 267                -> FAST_STRING   -- indicates what kind of compound thing it is (e.g., "sdsel")
 268                -> [Either OrigName FAST_STRING] -- "dot" these names together
 269                -> Name          -- from which we get provenance, etc....
 270                -> Name          -- result!
 271
 272 mkCompoundName u m str ns (Local _ _ _ _) = panic "mkCompoundName:Local?"
 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 = SLIT("(,)")   -- not strictly necessary
 308 mkTupNameStr 3 = SLIT("(,,)")  -- ditto
 309 mkTupNameStr 4 = SLIT("(,,,)") -- 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}