ghc/compiler/basicTypes/OccName.lhs

   1
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   3 %
   4
   5 \section[OccName]{@OccName@}
   6
   7 \begin{code}
   8 module OccName (
   9         -- Modules
  10         Module,         -- Abstract, instance of Outputable
  11         mkModule, mkModuleFS, moduleString, moduleCString, pprModule,
  12
  13         -- The OccName type
  14         OccName,        -- Abstract, instance of Outputable
  15         varOcc,    tcOcc,    tvOcc,     -- Occ constructors
  16         srcVarOcc, srcTCOcc, srcTvOcc,  -- For Occs arising from source code
  17
  18         mkSuperDictSelOcc, mkDFunOcc,
  19         mkDictOcc, mkWorkerOcc, mkDefaultMethodOcc,
  20         mkClassTyConOcc, mkClassDataConOcc,
  21
  22         isTvOcc, isTCOcc, isVarOcc, isConSymOcc, isConOcc, isSymOcc,
  23         pprOccName, occNameString, occNameFlavour,
  24
  25         -- The basic form of names
  26         isLexCon, isLexVar, isLexId, isLexSym,
  27         isLexConId, isLexConSym, isLexVarId, isLexVarSym,
  28         isLowerISO, isUpperISO,
  29
  30         -- Tidying up
  31         TidyOccEnv, emptyTidyOccEnv, tidyOccName, initTidyOccEnv,
  32
  33         -- Junk
  34         identToC
  35
  36     ) where
  37
  38 #include "HsVersions.h"
  39
  40 import Char     ( isAlpha, isUpper, isLower, isAlphanum, ord )
  41 import Util     ( thenCmp )
  42 import FiniteMap ( FiniteMap, emptyFM, lookupFM, addToFM, elemFM )
  43 import Outputable
  44 import GlaExts
  45 \end{code}
  46
  47
  48 %************************************************************************
  49 %*                                                                      *
  50 \subsection[Module]{The name of a module}
  51 %*                                                                      *
  52 %************************************************************************
  53
  54 \begin{code}
  55 data Module = Module FAST_STRING        -- User and interface files
  56                      FAST_STRING        -- Print this in C files
  57
  58         -- The C version has quote chars Z-encoded
  59
  60 instance Outputable Module where
  61   ppr = pprModule
  62
  63 instance Eq Module where
  64   (Module m1 _) == (Module m2 _) = m1 == m2
  65
  66 instance Ord Module where
  67   (Module m1 _) `compare` (Module m2 _) = m1 `compare` m2
  68
  69 pprModule :: Module -> SDoc
  70 pprModule (Module real code)
  71   = getPprStyle         $ \ sty ->
  72     if codeStyle sty then
  73         ptext code
  74     else
  75         ptext real
  76
  77 mkModule :: String -> Module
  78 mkModule s = Module (_PK_ s) (identToC s)
  79
  80 mkModuleFS :: FAST_STRING -> Module
  81 mkModuleFS s = Module s (identFsToC s)
  82
  83 moduleString :: Module -> String
  84 moduleString (Module mod _) = _UNPK_ mod
  85
  86 moduleCString :: Module -> String
  87 moduleCString (Module _ code) = _UNPK_ code
  88 \end{code}
  89
  90
  91 %************************************************************************
  92 %*                                                                      *
  93 \subsection[Name-pieces-datatypes]{The @OccName@ datatypes}
  94 %*                                                                      *
  95 %************************************************************************
  96
  97 \begin{code}
  98 data OccName = OccName
  99                   OccSpace
 100                   FAST_STRING   -- The 'real name'
 101                   FAST_STRING   -- Print this in interface files
 102                   FAST_STRING   -- Print this in C/asm code
 103
 104 -- The OccSpace/real-name pair define the OccName
 105 -- The iface and c/asm versions are simply derived from the
 106 -- other two.  They are cached here simply to avoid recomputing
 107 -- them repeatedly when printing
 108
 109 -- The latter two are irrelevant in RdrNames; on the other hand,
 110 -- the OccSpace field is irrelevant after RdrNames.
 111 -- So the OccName type might be refined a bit.
 112 -- It is now abstract so that's easier than before
 113
 114
 115 -- Why three print-names?
 116 --      Real    Iface   C
 117 --      ---------------------
 118 --      foo     foo     foo
 119 --
 120 --      +       +       Zp      Operators OK in interface files;
 121 --                              'Z' is the escape char for C names
 122 --
 123 --      x#      x#      xZh     Trailing # lexed ok by GHC -fglasgow-exts
 124 --
 125 --      _foo    _ufoo   _ufoo   Leading '_' is the escape char in interface files
 126 --
 127 --      _vfoo   _vfoo   _vfoo   Worker for foo
 128 --
 129 --      _wp     _wp     _wp     Worker for +
 130
 131
 132 data OccSpace = VarOcc  -- Variables and data constructors
 133               | TvOcc   -- Type variables
 134               | TCOcc   -- Type constructors and classes
 135               deriving( Eq, Ord )
 136 \end{code}
 137
 138
 139 %************************************************************************
 140 %*                                                                      *
 141 \subsection{Printing}
 142 %*                                                                      *
 143 %************************************************************************
 144
 145 \begin{code}
 146 instance Outputable OccName where
 147   ppr = pprOccName
 148
 149 pprOccName :: OccName -> SDoc
 150 pprOccName (OccName space real iface code)
 151   = getPprStyle $ \ sty ->
 152     if codeStyle sty then
 153         ptext code
 154     else if ifaceStyle sty then
 155         ptext iface
 156     else
 157         ptext real
 158 \end{code}
 159
 160
 161 %************************************************************************
 162 %*                                                                      *
 163 \subsection{Construction}
 164 %*                                                                      *
 165 %************************************************************************
 166
 167 *Source-code* things beginning with '_' are zapped to begin with '_u'
 168
 169 \begin{code}
 170 mkSrcOcc :: OccSpace -> FAST_STRING -> OccName
 171 mkSrcOcc occ_sp real
 172   = case _UNPK_ real of
 173
 174         '_' : rest -> OccName occ_sp real (_PK_ zapped_str) (identToC zapped_str)
 175                    where
 176                       zapped_str = '_' : 'u' : rest
 177
 178         other      -> OccName occ_sp real real (identFsToC real)
 179
 180 srcVarOcc, srcTCOcc, srcTvOcc :: FAST_STRING -> OccName
 181 srcVarOcc = mkSrcOcc VarOcc
 182 srcTCOcc  = mkSrcOcc TCOcc
 183 srcTvOcc  = mkSrcOcc TvOcc
 184 \end{code}
 185
 186 However, things that don't come from Haskell source code aren't
 187 treated specially.
 188
 189 \begin{code}
 190 mkOcc :: OccSpace -> String -> OccName
 191 mkOcc occ_sp str = OccName occ_sp fs fs (identToC str)
 192                  where
 193                    fs = _PK_ str
 194
 195 mkFsOcc :: OccSpace -> FAST_STRING -> OccName
 196 mkFsOcc occ_sp real = OccName occ_sp real real (identFsToC real)
 197
 198 varOcc, tcOcc, tvOcc :: FAST_STRING -> OccName
 199 varOcc = mkFsOcc VarOcc
 200 tcOcc  = mkFsOcc TCOcc
 201 tvOcc  = mkFsOcc TvOcc
 202 \end{code}
 203
 204
 205 %************************************************************************
 206 %*                                                                      *
 207 \subsection{Making system names}
 208 %*                                                                      *
 209 %************************************************************************
 210
 211 Here's our convention for splitting up the interface file name space:
 212
 213         _d...           dictionary identifiers
 214
 215         _f...           dict-fun identifiers (from inst decls)
 216         _g...           ditto, when the tycon has symbols
 217
 218         _t...           externally visible (non-user visible) names
 219
 220         _m...           default methods
 221         _n...           default methods (encoded symbols, eg. <= becomes _nle)
 222
 223         _p...           superclass selectors
 224
 225         _v...           workers
 226         _w...           workers (encoded symbols)
 227
 228         _x...           local variables
 229
 230         _u...           user-defined names that previously began with '_'
 231
 232         _T...           compiler-generated tycons for dictionaries
 233         _D..            ...ditto data cons
 234
 235         __....          keywords (__export, __letrec etc.)
 236
 237 This knowledge is encoded in the following functions.
 238
 239
 240
 241
 242 @mkDerivedOcc@ generates an @OccName@ from an existing @OccName@;
 243         eg: workers, derived methods
 244
 245 We pass a character to use as the prefix.  So, for example,
 246         "f" gets derived to "_vf", if the prefix char is 'v'
 247
 248 \begin{code}
 249 mk_deriv :: OccSpace -> Char -> String -> OccName
 250 mk_deriv occ_sp sys_ch str = mkOcc occ_sp ('_' : sys_ch : str)
 251 \end{code}
 252
 253 Things are a bit more complicated if the thing is an operator; then
 254 we must encode it into a normal identifier first.  We do this in
 255 a simple way, and use a different character prefix (one after the one
 256 suggested).  For example
 257         "<" gets derived to "_wl", if the prefix char is 'v'
 258
 259 \begin{code}
 260 mk_enc_deriv :: OccSpace
 261              -> Char    -- The system-name-space character (see list above)
 262              -> OccName -- The OccName from which we are deriving
 263              -> OccName
 264
 265 mk_enc_deriv occ_sp sys_ch occ
 266   | needs_encoding real_str = mk_deriv occ_sp sys_op_ch (encode_operator real_str)
 267   | otherwise               = mk_deriv occ_sp sys_ch    real_str
 268   where
 269     real_str  = occNameString occ
 270     sys_op_ch = succ sys_ch
 271
 272
 273 mkDictOcc, mkWorkerOcc, mkDefaultMethodOcc,
 274            mkClassTyConOcc, mkClassDataConOcc
 275    :: OccName -> OccName
 276
 277 mkWorkerOcc        = mk_enc_deriv VarOcc 'v'    -- v,w
 278 mkDefaultMethodOcc = mk_enc_deriv VarOcc 'm'    -- m,n
 279 mkClassTyConOcc    = mk_enc_deriv TCOcc  'T'    -- not U
 280 mkClassDataConOcc  = mk_enc_deriv VarOcc 'D'    -- not E
 281 mkDictOcc          = mk_enc_deriv VarOcc 'd'    -- not e
 282 \end{code}
 283
 284 \begin{code}
 285 mkSuperDictSelOcc :: Int        -- Index of superclass, eg 3
 286                   -> OccName    -- Class, eg "Ord"
 287                   -> OccName    -- eg "p3Ord"
 288 mkSuperDictSelOcc index cls_occ
 289   = mk_deriv VarOcc 'p' (show index ++ occNameString cls_occ)
 290 \end{code}
 291
 292
 293 \begin{code}
 294 mkDFunOcc :: OccName    -- class, eg "Ord"
 295           -> OccName    -- tycon (or something convenient from the instance type)
 296                         --      eg "Maybe"
 297           -> Int        -- Unique to distinguish dfuns which share the previous two
 298                         --      eg 3
 299           -> OccName    -- "dOrdMaybe3"
 300
 301 mkDFunOcc cls_occ tycon_occ index
 302   | needs_encoding tycon_str    -- Drat!  Have to encode the tycon
 303   = mk_deriv VarOcc 'g' (show_index ++ cls_str ++ encode_operator tycon_str)
 304   | otherwise                   -- Normal case
 305   = mk_deriv VarOcc 'f' (show_index ++ cls_str ++ tycon_str)
 306   where
 307     cls_str   = occNameString cls_occ
 308     tycon_str = occNameString tycon_occ
 309         -- NB: if a non-operator the tycon has a trailing # we don't encode.
 310     show_index | index == 0 = ""
 311                | otherwise  = show index
 312 \end{code}
 313
 314
 315 %************************************************************************
 316 %*                                                                      *
 317 \subsection{Lexical categories}
 318 %*                                                                      *
 319 %************************************************************************
 320
 321 These functions test strings to see if they fit the lexical categories
 322 defined in the Haskell report.
 323
 324 \begin{code}
 325 isLexCon,   isLexVar,    isLexId,    isLexSym    :: FAST_STRING -> Bool
 326 isLexConId, isLexConSym, isLexVarId, isLexVarSym :: FAST_STRING -> Bool
 327
 328 isLexCon cs = isLexConId  cs || isLexConSym cs
 329 isLexVar cs = isLexVarId  cs || isLexVarSym cs
 330
 331 isLexId  cs = isLexConId  cs || isLexVarId  cs
 332 isLexSym cs = isLexConSym cs || isLexVarSym cs
 333
 334 -------------
 335
 336 isLexConId cs                           -- Prefix type or data constructors
 337   | _NULL_ cs        = False            --      e.g. "Foo", "[]", "(,)"
 338   | cs == SLIT("[]") = True
 339   | c  == '('        = True     -- (), (,), (,,), ...
 340   | otherwise        = isUpper c || isUpperISO c
 341   where
 342     c = _HEAD_ cs
 343
 344 isLexVarId cs                           -- Ordinary prefix identifiers
 345   | _NULL_ cs    = False                --      e.g. "x", "_x"
 346   | otherwise    = isLower c || isLowerISO c || c == '_'
 347   where
 348     c = _HEAD_ cs
 349
 350 isLexConSym cs                          -- Infix type or data constructors
 351   | _NULL_ cs   = False                 --      e.g. ":-:", ":", "->"
 352   | otherwise   = c  == ':'
 353                || cs == SLIT("->")
 354   where
 355     c = _HEAD_ cs
 356
 357 isLexVarSym cs                          -- Infix identifiers
 358   | _NULL_ cs = False                   --      e.g. "+"
 359   | otherwise = isSymbolASCII c
 360              || isSymbolISO c
 361   where
 362     c = _HEAD_ cs
 363
 364 -------------
 365 isSymbolASCII c = c `elem` "!#$%&*+./<=>?@\\^|~-"
 366 isSymbolISO   c = ord c `elem` (0xd7 : 0xf7 : [0xa1 .. 0xbf])
 367 isUpperISO    (C# c#) = c# `geChar#` '\xc0'# && c# `leChar#` '\xde'# && c# `neChar#` '\xd7'#
 368         --0xc0 <= oc && oc <= 0xde && oc /= 0xd7 where oc = ord c
 369 isLowerISO    (C# c#) = c# `geChar#` '\xdf'# && c# `leChar#` '\xff'# && c# `neChar#` '\xf7'#
 370         --0xdf <= oc && oc <= 0xff && oc /= 0xf7 where oc = ord c
 371 \end{code}
 372
 373 %************************************************************************
 374 %*                                                                      *
 375 \subsection{Predicates and taking them apart}
 376 %*                                                                      *
 377 %************************************************************************
 378
 379 \begin{code}
 380 occNameString :: OccName -> String
 381 occNameString (OccName _ s _ _) = _UNPK_ s
 382
 383 -- occNameFlavour is used only to generate good error messages, so it doesn't matter
 384 -- that the VarOcc case isn't mega-efficient.  We could have different Occ constructors for
 385 -- data constructors and values, but that makes everything else a bit more complicated.
 386 occNameFlavour :: OccName -> String
 387 occNameFlavour (OccName VarOcc s _ _) | isLexConId s = "Data constructor"
 388                                       | otherwise    = "Value"
 389 occNameFlavour (OccName TvOcc _ _ _)                 = "Type variable"
 390 occNameFlavour (OccName TCOcc s _ _)                 = "Type constructor or class"
 391
 392 isVarOcc, isTCOcc, isTvOcc,
 393  isConSymOcc, isSymOcc :: OccName -> Bool
 394
 395 isVarOcc (OccName VarOcc _ _ _) = True
 396 isVarOcc other                  = False
 397
 398 isTvOcc (OccName TvOcc _ _ _) = True
 399 isTvOcc other                 = False
 400
 401 isTCOcc (OccName TCOcc _ _ _) = True
 402 isTCOcc other                 = False
 403
 404 isConSymOcc (OccName _ s _ _) = isLexConSym s
 405
 406 isSymOcc (OccName _ s _ _) = isLexSym s
 407
 408 isConOcc (OccName _ s _ _) = isLexCon s
 409 \end{code}
 410
 411
 412 %************************************************************************
 413 %*                                                                      *
 414 \subsection{Comparison}
 415 %*                                                                      *
 416 %************************************************************************
 417
 418 Comparison is done by space and 'real' name
 419
 420 \begin{code}
 421 instance Eq OccName where
 422     a == b = case (a `compare` b) of { EQ -> True;  _ -> False }
 423     a /= b = case (a `compare` b) of { EQ -> False; _ -> True }
 424
 425 instance Ord OccName where
 426     a <= b = case (a `compare` b) of { LT -> True;  EQ -> True;  GT -> False }
 427     a <  b = case (a `compare` b) of { LT -> True;  EQ -> False; GT -> False }
 428     a >= b = case (a `compare` b) of { LT -> False; EQ -> True;  GT -> True  }
 429     a >  b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True  }
 430
 431     compare (OccName sp1 r1 _ _) (OccName sp2 r2 _ _)
 432         = (sp1 `compare` sp2) `thenCmp` (r1 `compare` r2)
 433 \end{code}
 434
 435
 436 %************************************************************************
 437 %*                                                                      *
 438 \subsection{Tidying them up}
 439 %*                                                                      *
 440 %************************************************************************
 441
 442 Before we print chunks of code we like to rename it so that
 443 we don't have to print lots of silly uniques in it.  But we mustn't
 444 accidentally introduce name clashes!  So the idea is that we leave the
 445 OccName alone unless it accidentally clashes with one that is already
 446 in scope; if so, we tack on '1' at the end and try again, then '2', and
 447 so on till we find a unique one.
 448
 449 There's a wrinkle for operators.  Consider '>>='.  We can't use '>>=1'
 450 because that isn't a single lexeme.  So we encode it to 'lle' and *then*
 451 tack on the '1', if necessary.
 452
 453 \begin{code}
 454 type TidyOccEnv = FiniteMap FAST_STRING Int     -- The in-scope OccNames
 455 emptyTidyOccEnv = emptyFM
 456
 457 initTidyOccEnv :: [OccName] -> TidyOccEnv       -- Initialise with names to avoid!
 458 initTidyOccEnv = foldl (\env (OccName _ fs _ _) -> addToFM env fs 1) emptyTidyOccEnv
 459
 460 tidyOccName :: TidyOccEnv -> OccName -> (TidyOccEnv, OccName)
 461
 462 tidyOccName in_scope occ@(OccName occ_sp real _ _)
 463   | not (real `elemFM` in_scope) &&
 464     not (isLexCon real)                 -- Hack alert!   Specialised versions of overloaded
 465                                         -- constructors end up as ordinary Ids, but we don't
 466                                         -- want them as ConIds in interface files.
 467
 468   = (addToFM in_scope real 1, occ)      -- First occurrence
 469
 470   | otherwise                           -- Already occurs
 471   =     -- First encode, to deal with
 472         --      a) operators, and
 473         --      b) trailing # signs
 474         -- so that we can then append '1', '2', etc
 475     go in_scope (encode_operator (_UNPK_ real))
 476   where
 477
 478     go in_scope str = case lookupFM in_scope pk_str of
 479                         Just n  -> go (addToFM in_scope pk_str (n+1)) (str ++ show n)
 480                                 -- Need to go round again, just in case "t3" (say)
 481                                 -- clashes with a "t3" that's already in scope
 482
 483                         Nothing -> (addToFM in_scope pk_str 1, mkFsOcc occ_sp pk_str)
 484                                 -- str is now unique
 485                     where
 486                       pk_str = _PK_ str
 487 \end{code}
 488
 489
 490 %************************************************************************
 491 %*                                                                      *
 492 \subsection{Encoding for operators in derived names}
 493 %*                                                                      *
 494 %************************************************************************
 495
 496 See comments with mk_enc_deriv
 497
 498 \begin{code}
 499 needs_encoding :: String -> Bool        -- Needs encoding when embedded in a derived name
 500                                         -- Just look at the first character
 501 needs_encoding (c:cs) = not (isAlpha c || c == '_')
 502
 503 encode_operator :: String -> String
 504 encode_operator nm = foldr tran "" nm
 505  where
 506     tran c cs = case trChar c of
 507                    '\0'  -> '_' : show (ord c) ++ cs  -- No translation
 508                    tr_c  -> tr_c : cs
 509
 510     trChar '&'  = 'a'
 511     trChar '|'  = 'b'
 512     trChar ':'  = 'c'
 513     trChar '/'  = 'd'
 514     trChar '='  = 'e'
 515     trChar '>'  = 'g'
 516     trChar '#'  = 'h'
 517     trChar '@'  = 'i'
 518     trChar '<'  = 'l'
 519     trChar '-'  = 'm'
 520     trChar '!'  = 'n'
 521     trChar '+'  = 'p'
 522     trChar '\'' = 'q'
 523     trChar '$'  = 'r'
 524     trChar '?'  = 's'
 525     trChar '*'  = 't'
 526     trChar '_'  = 'u'
 527     trChar '.'  = 'v'
 528     trChar '\\' = 'w'
 529     trChar '%'  = 'x'
 530     trChar '~'  = 'y'
 531     trChar '^'  = 'z'
 532     trChar _    = '\0'  -- No translation
 533 \end{code}
 534
 535
 536 %************************************************************************
 537 %*                                                                      *
 538 \subsection{The 'Z' encoding}
 539 %*                                                                      *
 540 %************************************************************************
 541
 542 We provide two interfaces for efficiency.
 543
 544 \begin{code}
 545 identToC :: String -> FAST_STRING
 546 identToC str
 547   | all isAlphanum str && not std = _PK_ str
 548   | std                           = _PK_ ("Zs" ++ encode str)
 549   | otherwise                     = _PK_ (encode str)
 550   where
 551     std = has_std_prefix str
 552
 553 identFsToC :: FAST_STRING -> FAST_STRING
 554 identFsToC fast_str
 555   | all isAlphanum str && not std = fast_str
 556   | std                           = _PK_ ("Zs" ++ encode str)
 557   | otherwise                     = _PK_ (encode str)
 558   where
 559     std = has_std_prefix str
 560     str = _UNPK_ fast_str
 561
 562 -- avoid "stdin", "stdout", and "stderr"...
 563 has_std_prefix ('s':'t':'d':_) = True
 564 has_std_prefix _               = False
 565
 566 encode :: String -> String
 567 encode [] = []
 568 encode (c:cs) = encode_ch c ++ encode cs
 569
 570 encode_ch :: Char -> String
 571 encode_ch c | isAlphanum c = [c]
 572         -- Common case first
 573 encode_ch 'Z'  = "ZZ"
 574 encode_ch '&'  = "Za"
 575 encode_ch '|'  = "Zb"
 576 encode_ch ':'  = "Zc"
 577 encode_ch '/'  = "Zd"
 578 encode_ch '='  = "Ze"
 579 encode_ch '>'  = "Zg"
 580 encode_ch '#'  = "Zh"
 581 encode_ch '<'  = "Zl"
 582 encode_ch '-'  = "Zm"
 583 encode_ch '!'  = "Zn"
 584 encode_ch '.'  = "Zd"
 585 encode_ch '\'' = "Zq"
 586 encode_ch '*'  = "Zt"
 587 encode_ch '+'  = "Zp"
 588 encode_ch '_'  = "_"
 589 encode_ch c    = 'Z':show (ord c)
 590 \end{code}
 591
 592 For \tr{modnameToC}, we really only have to worry about \tr{'}s
 593 (quote chars) in the name.  Rare.
 594
 595 \begin{code}
 596 modnameToC  :: FAST_STRING -> FAST_STRING
 597 modnameToC fast_str = identFsToC fast_str
 598 \end{code}