Name.hs 27.4 KB
Newer Older
Austin Seipp's avatar
Austin Seipp committed
1 2 3 4
{-
(c) The University of Glasgow 2006
(c) The GRASP/AQUA Project, Glasgow University, 1992-1998

5
\section[Name]{@Name@: to transmit name info from renamer to typechecker}
Austin Seipp's avatar
Austin Seipp committed
6
-}
7

niteria's avatar
niteria committed
8
{-# LANGUAGE RecordWildCards #-}
9

10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34
-- |
-- #name_types#
-- GHC uses several kinds of name internally:
--
-- * 'OccName.OccName': see "OccName#name_types"
--
-- * 'RdrName.RdrName': see "RdrName#name_types"
--
-- *  'Name.Name' is the type of names that have had their scoping and binding resolved. They
--   have an 'OccName.OccName' but also a 'Unique.Unique' that disambiguates Names that have
--   the same 'OccName.OccName' and indeed is used for all 'Name.Name' comparison. Names
--   also contain information about where they originated from, see "Name#name_sorts"
--
-- * 'Id.Id': see "Id#name_types"
--
-- * 'Var.Var': see "Var#name_types"
--
-- #name_sorts#
-- Names are one of:
--
--  * External, if they name things declared in other modules. Some external
--    Names are wired in, i.e. they name primitives defined in the compiler itself
--
--  * Internal, if they name things in the module being compiled. Some internal
--    Names are system names, if they are names manufactured by the compiler
35

36
module Name (
37 38 39 40 41 42 43 44
        -- * The main types
        Name,                                   -- Abstract
        BuiltInSyntax(..),

        -- ** Creating 'Name's
        mkSystemName, mkSystemNameAt,
        mkInternalName, mkClonedInternalName, mkDerivedInternalName,
        mkSystemVarName, mkSysTvName,
45 46
        mkFCallName,
        mkExternalName, mkWiredInName,
47

48 49 50
        -- ** Manipulating and deconstructing 'Name's
        nameUnique, setNameUnique,
        nameOccName, nameModule, nameModule_maybe,
51
        setNameLoc,
52
        tidyNameOcc,
53
        localiseName,
54
        mkLocalisedOccName,
sof's avatar
sof committed
55

56
        nameSrcLoc, nameSrcSpan, pprNameDefnLoc, pprDefinedAt,
57

58 59 60 61 62
        -- ** Predicates on 'Name's
        isSystemName, isInternalName, isExternalName,
        isTyVarName, isTyConName, isDataConName,
        isValName, isVarName,
        isWiredInName, isBuiltInSyntax,
63
        isHoleName,
64
        wiredInNameTyThing_maybe,
65 66
        nameIsLocalOrFrom, nameIsHomePackage,
        nameIsHomePackageImport, nameIsFromExternalPackage,
67
        stableNameCmp,
68

69 70
        -- * Class 'NamedThing' and overloaded friends
        NamedThing(..),
Ben Gamari's avatar
Ben Gamari committed
71
        getSrcLoc, getSrcSpan, getOccString, getOccFS,
72

73
        pprInfixName, pprPrefixName, pprModulePrefix,
niteria's avatar
niteria committed
74
        nameStableString,
75

76 77
        -- Re-export the OccName stuff
        module OccName
78
    ) where
79

80 81
import {-# SOURCE #-} TyCoRep( TyThing )
import {-# SOURCE #-} PrelNames( starKindTyConKey, unicodeStarKindTyConKey )
82

Simon Marlow's avatar
Simon Marlow committed
83 84 85 86
import OccName
import Module
import SrcLoc
import Unique
87
import Util
Simon Marlow's avatar
Simon Marlow committed
88
import Maybes
89
import Binary
90
import DynFlags
Simon Marlow's avatar
Simon Marlow committed
91
import FastString
92
import Outputable
93

94
import Control.DeepSeq
95
import Data.Data
96

Austin Seipp's avatar
Austin Seipp committed
97 98 99
{-
************************************************************************
*                                                                      *
100
\subsection[Name-datatype]{The @Name@ datatype, and name construction}
Austin Seipp's avatar
Austin Seipp committed
101 102 103
*                                                                      *
************************************************************************
-}
104

105
-- | A unique, unambiguous name for something, containing information about where
106
-- that thing originated.
107
data Name = Name {
108 109
                n_sort :: NameSort,     -- What sort of name it is
                n_occ  :: !OccName,     -- Its occurrence name
110
                n_uniq :: {-# UNPACK #-} !Int,
111 112
                n_loc  :: !SrcSpan      -- Definition site
            }
113

114 115 116 117
-- NOTE: we make the n_loc field strict to eliminate some potential
-- (and real!) space leaks, due to the fact that we don't look at
-- the SrcLoc in a Name all that often.

118
data NameSort
119
  = External Module
120

121
  | WiredIn Module TyThing BuiltInSyntax
122
        -- A variant of External, for wired-in things
123

124 125
  | Internal            -- A user-defined Id or TyVar
                        -- defined in the module being compiled
126

127 128
  | System              -- A system-defined Id or TyVar.  Typically the
                        -- OccName is very uninformative (like 's')
129

Ben Gamari's avatar
Ben Gamari committed
130 131 132 133 134 135
instance Outputable NameSort where
  ppr (External _)    = text "external"
  ppr (WiredIn _ _ _) = text "wired-in"
  ppr  Internal       = text "internal"
  ppr  System         = text "system"

136 137 138 139 140 141 142 143 144 145 146 147
instance NFData Name where
  rnf Name{..} = rnf n_sort

instance NFData NameSort where
  rnf (External m) = rnf m
  rnf (WiredIn m t b) = rnf m `seq` t `seq` b `seq` ()
    -- XXX this is a *lie*, we're not going to rnf the TyThing, but
    -- since the TyThings for WiredIn Names are all static they can't
    -- be hiding space leaks or errors.
  rnf Internal = ()
  rnf System = ()

148
-- | BuiltInSyntax is for things like @(:)@, @[]@ and tuples,
149
-- which have special syntactic forms.  They aren't in scope
150
-- as such.
151
data BuiltInSyntax = BuiltInSyntax | UserSyntax
152

Austin Seipp's avatar
Austin Seipp committed
153
{-
154 155
Notes about the NameSorts:

156
1.  Initially, top-level Ids (including locally-defined ones) get External names,
157
    and all other local Ids get Internal names
158

159
2.  In any invocation of GHC, an External Name for "M.x" has one and only one
Austin Seipp's avatar
Austin Seipp committed
160
    unique.  This unique association is ensured via the Name Cache;
161 162 163
    see Note [The Name Cache] in IfaceEnv.

3.  Things with a External name are given C static labels, so they finally
164 165
    appear in the .o file's symbol table.  They appear in the symbol table
    in the form M.n.  If originally-local things have this property they
166
    must be made @External@ first.
167

168
4.  In the tidy-core phase, a External that is not visible to an importer
169
    is changed to Internal, and a Internal that is visible is changed to External
170

171
5.  A System Name differs in the following ways:
172 173
        a) has unique attached when printing dumps
        b) unifier eliminates sys tyvars in favour of user provs where possible
174 175 176 177 178 179 180

    Before anything gets printed in interface files or output code, it's
    fed through a 'tidy' processor, which zaps the OccNames to have
    unique names; and converts all sys-locals to user locals
    If any desugarer sys-locals have survived that far, they get changed to
    "ds1", "ds2", etc.

181 182
Built-in syntax => It's a syntactic form, not "in scope" (e.g. [])

183 184 185
Wired-in thing  => The thing (Id, TyCon) is fully known to the compiler,
                   not read from an interface file.
                   E.g. Bool, True, Int, Float, and many others
186 187

All built-in syntax is for wired-in things.
Austin Seipp's avatar
Austin Seipp committed
188
-}
189

190 191 192
instance HasOccName Name where
  occName = nameOccName

193 194 195 196 197
nameUnique              :: Name -> Unique
nameOccName             :: Name -> OccName
nameModule              :: Name -> Module
nameSrcLoc              :: Name -> SrcLoc
nameSrcSpan             :: Name -> SrcSpan
198

199
nameUnique  name = mkUniqueGrimily (n_uniq name)
200
nameOccName name = n_occ  name
201 202
nameSrcLoc  name = srcSpanStart (n_loc name)
nameSrcSpan name = n_loc  name
203

Austin Seipp's avatar
Austin Seipp committed
204 205 206
{-
************************************************************************
*                                                                      *
207
\subsection{Predicates on names}
Austin Seipp's avatar
Austin Seipp committed
208 209 210
*                                                                      *
************************************************************************
-}
211

212 213 214 215
isInternalName    :: Name -> Bool
isExternalName    :: Name -> Bool
isSystemName      :: Name -> Bool
isWiredInName     :: Name -> Bool
216

217
isWiredInName (Name {n_sort = WiredIn _ _ _}) = True
twanvl's avatar
twanvl committed
218
isWiredInName _                               = False
219

220
wiredInNameTyThing_maybe :: Name -> Maybe TyThing
221
wiredInNameTyThing_maybe (Name {n_sort = WiredIn _ thing _}) = Just thing
twanvl's avatar
twanvl committed
222
wiredInNameTyThing_maybe _                                   = Nothing
223

twanvl's avatar
twanvl committed
224
isBuiltInSyntax :: Name -> Bool
225
isBuiltInSyntax (Name {n_sort = WiredIn _ _ BuiltInSyntax}) = True
twanvl's avatar
twanvl committed
226
isBuiltInSyntax _                                           = False
227

228 229
isExternalName (Name {n_sort = External _})    = True
isExternalName (Name {n_sort = WiredIn _ _ _}) = True
twanvl's avatar
twanvl committed
230
isExternalName _                               = False
231

232
isInternalName name = not (isExternalName name)
233

234 235 236
isHoleName :: Name -> Bool
isHoleName = isHoleModule . nameModule

Ben Gamari's avatar
Ben Gamari committed
237 238 239 240
nameModule name =
  nameModule_maybe name `orElse`
  pprPanic "nameModule" (ppr (n_sort name) <+> ppr name)

twanvl's avatar
twanvl committed
241
nameModule_maybe :: Name -> Maybe Module
242 243
nameModule_maybe (Name { n_sort = External mod})    = Just mod
nameModule_maybe (Name { n_sort = WiredIn mod _ _}) = Just mod
twanvl's avatar
twanvl committed
244
nameModule_maybe _                                  = Nothing
245

246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268
nameIsLocalOrFrom :: Module -> Name -> Bool
-- ^ Returns True if the name is
--   (a) Internal
--   (b) External but from the specified module
--   (c) External but from the 'interactive' package
--
-- The key idea is that
--    False means: the entity is defined in some other module
--                 you can find the details (type, fixity, instances)
--                     in some interface file
--                 those details will be stored in the EPT or HPT
--
--    True means:  the entity is defined in this module or earlier in
--                     the GHCi session
--                 you can find details (type, fixity, instances) in the
--                     TcGblEnv or TcLclEnv
--
-- The isInteractiveModule part is because successive interactions of a GCHi session
-- each give rise to a fresh module (Ghci1, Ghci2, etc), but they all come
-- from the magic 'interactive' package; and all the details are kept in the
-- TcLclEnv, TcGblEnv, NOT in the HPT or EPT.
-- See Note [The interactive package] in HscTypes

269
nameIsLocalOrFrom from name
270 271
  | Just mod <- nameModule_maybe name = from == mod || isInteractiveModule mod
  | otherwise                         = True
272

273 274 275 276 277 278 279 280 281 282 283
nameIsHomePackage :: Module -> Name -> Bool
-- True if the Name is defined in module of this package
nameIsHomePackage this_mod
  = \nm -> case n_sort nm of
              External nm_mod    -> moduleUnitId nm_mod == this_pkg
              WiredIn nm_mod _ _ -> moduleUnitId nm_mod == this_pkg
              Internal -> True
              System   -> False
  where
    this_pkg = moduleUnitId this_mod

284 285 286 287 288 289 290
nameIsHomePackageImport :: Module -> Name -> Bool
-- True if the Name is defined in module of this package
-- /other than/ the this_mod
nameIsHomePackageImport this_mod
  = \nm -> case nameModule_maybe nm of
              Nothing -> False
              Just nm_mod -> nm_mod /= this_mod
291
                          && moduleUnitId nm_mod == this_pkg
292
  where
293
    this_pkg = moduleUnitId this_mod
294

295 296
-- | Returns True if the Name comes from some other package: neither this
-- pacakge nor the interactive package.
297
nameIsFromExternalPackage :: UnitId -> Name -> Bool
298 299
nameIsFromExternalPackage this_pkg name
  | Just mod <- nameModule_maybe name
300
  , moduleUnitId mod /= this_pkg    -- Not this package
301 302 303 304 305
  , not (isInteractiveModule mod)       -- Not the 'interactive' package
  = True
  | otherwise
  = False

306 307
isTyVarName :: Name -> Bool
isTyVarName name = isTvOcc (nameOccName name)
308

309 310 311
isTyConName :: Name -> Bool
isTyConName name = isTcOcc (nameOccName name)

312 313 314 315 316 317 318 319 320
isDataConName :: Name -> Bool
isDataConName name = isDataOcc (nameOccName name)

isValName :: Name -> Bool
isValName name = isValOcc (nameOccName name)

isVarName :: Name -> Bool
isVarName = isVarOcc . nameOccName

321
isSystemName (Name {n_sort = System}) = True
twanvl's avatar
twanvl committed
322
isSystemName _                        = False
323

Austin Seipp's avatar
Austin Seipp committed
324 325 326
{-
************************************************************************
*                                                                      *
327
\subsection{Making names}
Austin Seipp's avatar
Austin Seipp committed
328 329 330
*                                                                      *
************************************************************************
-}
331

332 333
-- | Create a name which is (for now at least) local to the current module and hence
-- does not need a 'Module' to disambiguate it from other 'Name's
334
mkInternalName :: Unique -> OccName -> SrcSpan -> Name
335
mkInternalName uniq occ loc = Name { n_uniq = getKey uniq
Simon Peyton Jones's avatar
Simon Peyton Jones committed
336 337 338
                                   , n_sort = Internal
                                   , n_occ = occ
                                   , n_loc = loc }
339 340 341 342 343 344
        -- NB: You might worry that after lots of huffing and
        -- puffing we might end up with two local names with distinct
        -- uniques, but the same OccName.  Indeed we can, but that's ok
        --      * the insides of the compiler don't care: they use the Unique
        --      * when printing for -ddump-xxx you can switch on -dppr-debug to get the
        --        uniques if you get confused
345 346
        --      * for interface files we tidyCore first, which makes
        --        the OccNames distinct when they need to be
347

348 349
mkClonedInternalName :: Unique -> Name -> Name
mkClonedInternalName uniq (Name { n_occ = occ, n_loc = loc })
350
  = Name { n_uniq = getKey uniq, n_sort = Internal
351 352
         , n_occ = occ, n_loc = loc }

353 354
mkDerivedInternalName :: (OccName -> OccName) -> Unique -> Name -> Name
mkDerivedInternalName derive_occ uniq (Name { n_occ = occ, n_loc = loc })
355
  = Name { n_uniq = getKey uniq, n_sort = Internal
356 357
         , n_occ = derive_occ occ, n_loc = loc }

358
-- | Create a name which definitely originates in the given module
359
mkExternalName :: Unique -> Module -> OccName -> SrcSpan -> Name
360 361 362
-- WATCH OUT! External Names should be in the Name Cache
-- (see Note [The Name Cache] in IfaceEnv), so don't just call mkExternalName
-- with some fresh unique without populating the Name Cache
363
mkExternalName uniq mod occ loc
364
  = Name { n_uniq = getKey uniq, n_sort = External mod,
365
           n_occ = occ, n_loc = loc }
366

367 368
-- | Create a name which is actually defined by the compiler itself
mkWiredInName :: Module -> OccName -> Unique -> TyThing -> BuiltInSyntax -> Name
369
mkWiredInName mod occ uniq thing built_in
370
  = Name { n_uniq = getKey uniq,
371 372
           n_sort = WiredIn mod thing built_in,
           n_occ = occ, n_loc = wiredInSrcSpan }
373

374
-- | Create a name brought into being by the compiler
375
mkSystemName :: Unique -> OccName -> Name
376 377 378
mkSystemName uniq occ = mkSystemNameAt uniq occ noSrcSpan

mkSystemNameAt :: Unique -> OccName -> SrcSpan -> Name
379
mkSystemNameAt uniq occ loc = Name { n_uniq = getKey uniq, n_sort = System
380
                                   , n_occ = occ, n_loc = loc }
381

382 383
mkSystemVarName :: Unique -> FastString -> Name
mkSystemVarName uniq fs = mkSystemName uniq (mkVarOccFS fs)
384

385
mkSysTvName :: Unique -> FastString -> Name
386
mkSysTvName uniq fs = mkSystemName uniq (mkOccNameFS tvName fs)
387

388
-- | Make a name for a foreign call
389
mkFCallName :: Unique -> String -> Name
390 391
mkFCallName uniq str = mkInternalName uniq (mkVarOcc str) noSrcSpan
   -- The encoded string completely describes the ccall
392

393 394 395
-- When we renumber/rename things, we need to be
-- able to change a Name's Unique to match the cached
-- one in the thing it's the name of.  If you know what I mean.
396
setNameUnique :: Name -> Unique -> Name
397
setNameUnique name uniq = name {n_uniq = getKey uniq}
398

399 400 401 402 403
-- This is used for hsigs: we want to use the name of the originally exported
-- entity, but edit the location to refer to the reexport site
setNameLoc :: Name -> SrcSpan -> Name
setNameLoc name loc = name {n_loc = loc}

404 405 406 407 408
tidyNameOcc :: Name -> OccName -> Name
-- We set the OccName of a Name when tidying
-- In doing so, we change System --> Internal, so that when we print
-- it we don't get the unique by default.  It's tidy now!
tidyNameOcc name@(Name { n_sort = System }) occ = name { n_occ = occ, n_sort = Internal}
409
tidyNameOcc name                            occ = name { n_occ = occ }
410

411
-- | Make the 'Name' into an internal name, regardless of what it was to begin with
412
localiseName :: Name -> Name
413
localiseName n = n { n_sort = Internal }
sof's avatar
sof committed
414

415
-- |Create a localised variant of a name.
416 417
--
-- If the name is external, encode the original's module name to disambiguate.
418 419
-- SPJ says: this looks like a rather odd-looking function; but it seems to
--           be used only during vectorisation, so I'm not going to worry
420 421
mkLocalisedOccName :: Module -> (Maybe String -> OccName -> OccName) -> Name -> OccName
mkLocalisedOccName this_mod mk_occ name = mk_occ origin (nameOccName name)
422
  where
423
    origin
424 425
      | nameIsLocalOrFrom this_mod name = Nothing
      | otherwise                       = Just (moduleNameColons . moduleName . nameModule $ name)
426

Austin Seipp's avatar
Austin Seipp committed
427 428 429
{-
************************************************************************
*                                                                      *
430
\subsection{Hashing and comparison}
Austin Seipp's avatar
Austin Seipp committed
431 432 433
*                                                                      *
************************************************************************
-}
434

435
cmpName :: Name -> Name -> Ordering
436
cmpName n1 n2 = n_uniq n1 `compare` n_uniq n2
437

438 439 440
-- | Compare Names lexicographically
-- This only works for Names that originate in the source code or have been
-- tidied.
441 442
stableNameCmp :: Name -> Name -> Ordering
stableNameCmp (Name { n_sort = s1, n_occ = occ1 })
443
              (Name { n_sort = s2, n_occ = occ2 })
444
  = (s1 `sort_cmp` s2) `thenCmp` (occ1 `compare` occ2)
Gabor Greif's avatar
Gabor Greif committed
445
    -- The ordinary compare on OccNames is lexicographic
446 447 448 449 450 451 452 453 454 455 456 457 458
  where
    -- Later constructors are bigger
    sort_cmp (External m1) (External m2)       = m1 `stableModuleCmp` m2
    sort_cmp (External {}) _                   = LT
    sort_cmp (WiredIn {}) (External {})        = GT
    sort_cmp (WiredIn m1 _ _) (WiredIn m2 _ _) = m1 `stableModuleCmp` m2
    sort_cmp (WiredIn {})     _                = LT
    sort_cmp Internal         (External {})    = GT
    sort_cmp Internal         (WiredIn {})     = GT
    sort_cmp Internal         Internal         = EQ
    sort_cmp Internal         System           = LT
    sort_cmp System           System           = EQ
    sort_cmp System           _                = GT
459

Austin Seipp's avatar
Austin Seipp committed
460 461 462
{-
************************************************************************
*                                                                      *
463
\subsection[Name-instances]{Instance declarations}
Austin Seipp's avatar
Austin Seipp committed
464 465 466
*                                                                      *
************************************************************************
-}
467 468

instance Eq Name where
469 470
    a == b = case (a `compare` b) of { EQ -> True;  _ -> False }
    a /= b = case (a `compare` b) of { EQ -> False; _ -> True }
471 472

instance Ord Name where
473
    a <= b = case (a `compare` b) of { LT -> True;  EQ -> True;  GT -> False }
474
    a <  b = case (a `compare` b) of { LT -> True;  EQ -> False; GT -> False }
475
    a >= b = case (a `compare` b) of { LT -> False; EQ -> True;  GT -> True  }
476
    a >  b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True  }
477
    compare a b = cmpName a b
478

479
instance Uniquable Name where
480
    getUnique = nameUnique
481

482
instance NamedThing Name where
483
    getName n = n
484 485 486 487 488 489

instance Data Name where
  -- don't traverse?
  toConstr _   = abstractConstr "Name"
  gunfold _ _  = error "gunfold"
  dataTypeOf _ = mkNoRepType "Name"
490

Austin Seipp's avatar
Austin Seipp committed
491 492 493
{-
************************************************************************
*                                                                      *
494
\subsection{Binary}
Austin Seipp's avatar
Austin Seipp committed
495 496 497
*                                                                      *
************************************************************************
-}
498

499 500 501
-- | Assumes that the 'Name' is a non-binding one. See
-- 'IfaceSyn.putIfaceTopBndr' and 'IfaceSyn.getIfaceTopBndr' for serializing
-- binding 'Name's. See 'UserData' for the rationale for this distinction.
502
instance Binary Name where
503
   put_ bh name =
504
      case getUserData bh of
505
        UserData{ ud_put_nonbinding_name = put_name } -> put_name bh name
506

507 508 509
   get bh =
      case getUserData bh of
        UserData { ud_get_name = get_name } -> get_name bh
510

Austin Seipp's avatar
Austin Seipp committed
511 512 513
{-
************************************************************************
*                                                                      *
514
\subsection{Pretty printing}
Austin Seipp's avatar
Austin Seipp committed
515 516 517
*                                                                      *
************************************************************************
-}
518 519

instance Outputable Name where
520 521
    ppr name = pprName name

522 523
instance OutputableBndr Name where
    pprBndr _ name = pprName name
524 525 526
    pprInfixOcc  = pprInfixName
    pprPrefixOcc = pprPrefixName

twanvl's avatar
twanvl committed
527
pprName :: Name -> SDoc
528
pprName (Name {n_sort = sort, n_uniq = u, n_occ = occ})
529
  = getPprStyle $ \ sty ->
530
    case sort of
531 532
      WiredIn mod _ builtin   -> pprExternal sty uniq mod occ True  builtin
      External mod            -> pprExternal sty uniq mod occ False UserSyntax
533 534
      System                  -> pprSystem sty uniq occ
      Internal                -> pprInternal sty uniq occ
535
  where uniq = mkUniqueGrimily u
536

537 538
pprExternal :: PprStyle -> Unique -> Module -> OccName -> Bool -> BuiltInSyntax -> SDoc
pprExternal sty uniq mod occ is_wired is_builtin
539
  | codeStyle sty = ppr mod <> char '_' <> ppr_z_occ_name occ
540 541 542
        -- In code style, always qualify
        -- ToDo: maybe we could print all wired-in things unqualified
        --       in code style, to reduce symbol table bloat?
543
  | debugStyle sty = pp_mod <> ppr_occ_name occ
544
                     <> braces (hsep [if is_wired then text "(w)" else empty,
545 546
                                      pprNameSpaceBrief (occNameSpace occ),
                                      pprUnique uniq])
547
  | BuiltInSyntax <- is_builtin = ppr_occ_name occ  -- Never qualify builtin syntax
Edward Z. Yang's avatar
Edward Z. Yang committed
548 549 550 551 552 553
  | otherwise                   =
        if isHoleModule mod
            then case qualName sty mod occ of
                    NameUnqual -> ppr_occ_name occ
                    _ -> braces (ppr (moduleName mod) <> dot <> ppr_occ_name occ)
            else pprModulePrefix sty mod occ <> ppr_occ_name occ
554
  where
555
    pp_mod = sdocWithDynFlags $ \dflags ->
ian@well-typed.com's avatar
ian@well-typed.com committed
556
             if gopt Opt_SuppressModulePrefixes dflags
557 558
             then empty
             else ppr mod <> dot
559

twanvl's avatar
twanvl committed
560
pprInternal :: PprStyle -> Unique -> OccName -> SDoc
561
pprInternal sty uniq occ
562
  | codeStyle sty  = pprUniqueAlways uniq
563 564
  | debugStyle sty = ppr_occ_name occ <> braces (hsep [pprNameSpaceBrief (occNameSpace occ),
                                                       pprUnique uniq])
565
  | dumpStyle sty  = ppr_occ_name occ <> ppr_underscore_unique uniq
566 567 568
                        -- For debug dumps, we're not necessarily dumping
                        -- tidied code, so we need to print the uniques.
  | otherwise      = ppr_occ_name occ   -- User style
569

570
-- Like Internal, except that we only omit the unique in Iface style
twanvl's avatar
twanvl committed
571
pprSystem :: PprStyle -> Unique -> OccName -> SDoc
572
pprSystem sty uniq occ
573
  | codeStyle sty  = pprUniqueAlways uniq
574
  | debugStyle sty = ppr_occ_name occ <> ppr_underscore_unique uniq
575 576 577 578 579
                     <> braces (pprNameSpaceBrief (occNameSpace occ))
  | otherwise      = ppr_occ_name occ <> ppr_underscore_unique uniq
                                -- If the tidy phase hasn't run, the OccName
                                -- is unlikely to be informative (like 's'),
                                -- so print the unique
580

581

582
pprModulePrefix :: PprStyle -> Module -> OccName -> SDoc
583 584
-- Print the "M." part of a name, based on whether it's in scope or not
-- See Note [Printing original names] in HscTypes
585
pprModulePrefix sty mod occ = sdocWithDynFlags $ \dflags ->
ian@well-typed.com's avatar
ian@well-typed.com committed
586
  if gopt Opt_SuppressModulePrefixes dflags
587 588
  then empty
  else
589
    case qualName sty mod occ of              -- See Outputable.QualifyName:
590
      NameQual modname -> ppr modname <> dot       -- Name is in scope
591
      NameNotInScope1  -> ppr mod <> dot           -- Not in scope
592
      NameNotInScope2  -> ppr (moduleUnitId mod) <> colon     -- Module not in
593 594
                          <> ppr (moduleName mod) <> dot          -- scope either
      NameUnqual       -> empty                   -- In scope unqualified
595

596 597 598 599 600 601 602
pprUnique :: Unique -> SDoc
-- Print a unique unless we are suppressing them
pprUnique uniq
  = sdocWithDynFlags $ \dflags ->
    ppUnless (gopt Opt_SuppressUniques dflags) $
    pprUniqueAlways uniq

603 604 605 606
ppr_underscore_unique :: Unique -> SDoc
-- Print an underscore separating the name from its unique
-- But suppress it if we aren't printing the uniques anyway
ppr_underscore_unique uniq
607
  = sdocWithDynFlags $ \dflags ->
608 609
    ppUnless (gopt Opt_SuppressUniques dflags) $
    char '_' <> pprUniqueAlways uniq
610

twanvl's avatar
twanvl committed
611
ppr_occ_name :: OccName -> SDoc
612
ppr_occ_name occ = ftext (occNameFS occ)
613 614
        -- Don't use pprOccName; instead, just print the string of the OccName;
        -- we print the namespace in the debug stuff above
615 616 617

-- In code style, we Z-encode the strings.  The results of Z-encoding each FastString are
-- cached behind the scenes in the FastString implementation.
twanvl's avatar
twanvl committed
618
ppr_z_occ_name :: OccName -> SDoc
Ian Lynagh's avatar
Ian Lynagh committed
619
ppr_z_occ_name occ = ztext (zEncodeFS (occNameFS occ))
620

621
-- Prints (if mod information is available) "Defined at <loc>" or
622
--  "Defined in <mod>" information for a Name.
623
pprDefinedAt :: Name -> SDoc
624
pprDefinedAt name = text "Defined" <+> pprNameDefnLoc name
625 626

pprNameDefnLoc :: Name -> SDoc
627
-- Prints "at <loc>" or
628
--     or "in <mod>" depending on what info is available
629
pprNameDefnLoc name
630 631
  = case nameSrcLoc name of
         -- nameSrcLoc rather than nameSrcSpan
632 633
         -- It seems less cluttered to show a location
         -- rather than a span for the definition point
634
       RealSrcLoc s -> text "at" <+> ppr s
635 636
       UnhelpfulLoc s
         | isInternalName name || isSystemName name
637
         -> text "at" <+> ftext s
638
         | otherwise
639
         -> text "in" <+> quotes (ppr (nameModule name))
640

niteria's avatar
niteria committed
641 642 643 644 645 646 647 648 649 650 651 652 653 654 655

-- | Get a string representation of a 'Name' that's unique and stable
-- across recompilations. Used for deterministic generation of binds for
-- derived instances.
-- eg. "$aeson_70dylHtv1FFGeai1IoxcQr$Data.Aeson.Types.Internal$String"
nameStableString :: Name -> String
nameStableString Name{..} =
  nameSortStableString n_sort ++ "$" ++ occNameString n_occ

nameSortStableString :: NameSort -> String
nameSortStableString System = "$_sys"
nameSortStableString Internal = "$_in"
nameSortStableString (External mod) = moduleStableString mod
nameSortStableString (WiredIn mod _ _) = moduleStableString mod

Austin Seipp's avatar
Austin Seipp committed
656 657 658
{-
************************************************************************
*                                                                      *
659
\subsection{Overloaded functions related to Names}
Austin Seipp's avatar
Austin Seipp committed
660 661 662
*                                                                      *
************************************************************************
-}
663

664
-- | A class allowing convenient access to the 'Name' of various datatypes
665
class NamedThing a where
666
    getOccName :: a -> OccName
667 668
    getName    :: a -> Name

669
    getOccName n = nameOccName (getName n)      -- Default method
670

671 672 673
instance NamedThing e => NamedThing (GenLocated l e) where
    getName = getName . unLoc

674 675 676
getSrcLoc           :: NamedThing a => a -> SrcLoc
getSrcSpan          :: NamedThing a => a -> SrcSpan
getOccString        :: NamedThing a => a -> String
Ben Gamari's avatar
Ben Gamari committed
677
getOccFS            :: NamedThing a => a -> FastString
678

679 680 681
getSrcLoc           = nameSrcLoc           . getName
getSrcSpan          = nameSrcSpan          . getName
getOccString        = occNameString        . getOccName
Ben Gamari's avatar
Ben Gamari committed
682
getOccFS            = occNameFS            . getOccName
683

684
pprInfixName :: (Outputable a, NamedThing a) => a -> SDoc
685
-- See Outputable.pprPrefixVar, pprInfixVar;
686
-- add parens or back-quotes as appropriate
687 688
pprInfixName  n = pprInfixVar (isSymOcc (getOccName n)) (ppr n)

689
pprPrefixName :: NamedThing a => a -> SDoc
Austin Seipp's avatar
Austin Seipp committed
690
pprPrefixName thing
691
 | name `hasKey` starKindTyConKey || name `hasKey` unicodeStarKindTyConKey
692 693 694 695 696
 = ppr name   -- See Note [Special treatment for kind *]
 | otherwise
 = pprPrefixVar (isSymOcc (nameOccName name)) (ppr name)
 where
   name = getName thing
697

Austin Seipp's avatar
Austin Seipp committed
698
{-
699 700 701 702 703 704 705 706
Note [Special treatment for kind *]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Do not put parens around the kind '*'.  Even though it looks like
an operator, it is really a special case.

This pprPrefixName stuff is really only used when printing HsSyn,
which has to be polymorphic in the name type, and hence has to go via
the overloaded function pprPrefixOcc.  It's easier where we know the
707
type being pretty printed; eg the pretty-printing code in TyCoRep.
708 709

See Trac #7645, which led to this.
Austin Seipp's avatar
Austin Seipp committed
710
-}