Name.hs 27.3 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 GhcPrelude

82
83
import {-# SOURCE #-} TyCoRep( TyThing )
import {-# SOURCE #-} PrelNames( starKindTyConKey, unicodeStarKindTyConKey )
84

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

96
import Control.DeepSeq
97
import Data.Data
98

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

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

116
117
118
119
-- 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.

120
data NameSort
121
  = External Module
122

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

126
127
  | Internal            -- A user-defined Id or TyVar
                        -- defined in the module being compiled
128

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

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

138
139
140
141
142
143
144
145
146
147
148
149
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 = ()

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

Austin Seipp's avatar
Austin Seipp committed
155
{-
156
157
Notes about the NameSorts:

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

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

3.  Things with a External name are given C static labels, so they finally
166
167
    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
168
    must be made @External@ first.
169

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

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

    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.

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

185
186
187
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
188
189

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

192
193
194
instance HasOccName Name where
  occName = nameOccName

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

alexbiehl's avatar
alexbiehl committed
201
nameUnique  name = n_uniq name
202
nameOccName name = n_occ  name
203
204
nameSrcLoc  name = srcSpanStart (n_loc name)
nameSrcSpan name = n_loc  name
205

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

214
215
216
217
isInternalName    :: Name -> Bool
isExternalName    :: Name -> Bool
isSystemName      :: Name -> Bool
isWiredInName     :: Name -> Bool
218

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

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

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

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

234
isInternalName name = not (isExternalName name)
235

236
237
238
isHoleName :: Name -> Bool
isHoleName = isHoleModule . nameModule

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

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

248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
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

271
nameIsLocalOrFrom from name
272
273
  | Just mod <- nameModule_maybe name = from == mod || isInteractiveModule mod
  | otherwise                         = True
274

275
276
277
278
279
280
281
282
283
284
285
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

286
287
288
289
290
291
292
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
293
                          && moduleUnitId nm_mod == this_pkg
294
  where
295
    this_pkg = moduleUnitId this_mod
296

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

308
309
isTyVarName :: Name -> Bool
isTyVarName name = isTvOcc (nameOccName name)
310

311
312
313
isTyConName :: Name -> Bool
isTyConName name = isTcOcc (nameOccName name)

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

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

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

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

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

334
335
-- | 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
336
mkInternalName :: Unique -> OccName -> SrcSpan -> Name
alexbiehl's avatar
alexbiehl committed
337
mkInternalName uniq occ loc = Name { n_uniq = uniq
Simon Peyton Jones's avatar
Simon Peyton Jones committed
338
339
340
                                   , n_sort = Internal
                                   , n_occ = occ
                                   , n_loc = loc }
341
342
343
344
345
346
        -- 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
347
348
        --      * for interface files we tidyCore first, which makes
        --        the OccNames distinct when they need to be
349

350
351
mkClonedInternalName :: Unique -> Name -> Name
mkClonedInternalName uniq (Name { n_occ = occ, n_loc = loc })
alexbiehl's avatar
alexbiehl committed
352
  = Name { n_uniq = uniq, n_sort = Internal
353
354
         , n_occ = occ, n_loc = loc }

355
356
mkDerivedInternalName :: (OccName -> OccName) -> Unique -> Name -> Name
mkDerivedInternalName derive_occ uniq (Name { n_occ = occ, n_loc = loc })
alexbiehl's avatar
alexbiehl committed
357
  = Name { n_uniq = uniq, n_sort = Internal
358
359
         , n_occ = derive_occ occ, n_loc = loc }

360
-- | Create a name which definitely originates in the given module
361
mkExternalName :: Unique -> Module -> OccName -> SrcSpan -> Name
362
363
364
-- 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
365
mkExternalName uniq mod occ loc
alexbiehl's avatar
alexbiehl committed
366
  = Name { n_uniq = uniq, n_sort = External mod,
367
           n_occ = occ, n_loc = loc }
368

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

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

mkSystemNameAt :: Unique -> OccName -> SrcSpan -> Name
alexbiehl's avatar
alexbiehl committed
381
mkSystemNameAt uniq occ loc = Name { n_uniq = uniq, n_sort = System
382
                                   , n_occ = occ, n_loc = loc }
383

384
385
mkSystemVarName :: Unique -> FastString -> Name
mkSystemVarName uniq fs = mkSystemName uniq (mkVarOccFS fs)
386

387
mkSysTvName :: Unique -> FastString -> Name
388
mkSysTvName uniq fs = mkSystemName uniq (mkTyVarOccFS fs)
389

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

395
396
397
-- 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.
398
setNameUnique :: Name -> Unique -> Name
alexbiehl's avatar
alexbiehl committed
399
setNameUnique name uniq = name {n_uniq = uniq}
400

401
402
403
404
405
-- 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}

406
407
408
409
410
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}
411
tidyNameOcc name                            occ = name { n_occ = occ }
412

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

417
-- |Create a localised variant of a name.
418
419
--
-- If the name is external, encode the original's module name to disambiguate.
420
421
-- 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
422
423
mkLocalisedOccName :: Module -> (Maybe String -> OccName -> OccName) -> Name -> OccName
mkLocalisedOccName this_mod mk_occ name = mk_occ origin (nameOccName name)
424
  where
425
    origin
426
427
      | nameIsLocalOrFrom this_mod name = Nothing
      | otherwise                       = Just (moduleNameColons . moduleName . nameModule $ name)
428

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

437
cmpName :: Name -> Name -> Ordering
alexbiehl's avatar
alexbiehl committed
438
cmpName n1 n2 = n_uniq n1 `nonDetCmpUnique` n_uniq n2
439

440
441
442
-- | Compare Names lexicographically
-- This only works for Names that originate in the source code or have been
-- tidied.
443
444
stableNameCmp :: Name -> Name -> Ordering
stableNameCmp (Name { n_sort = s1, n_occ = occ1 })
445
              (Name { n_sort = s2, n_occ = occ2 })
446
  = (s1 `sort_cmp` s2) `thenCmp` (occ1 `compare` occ2)
Gabor Greif's avatar
Gabor Greif committed
447
    -- The ordinary compare on OccNames is lexicographic
448
449
450
451
452
453
454
455
456
457
458
459
460
  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
461

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

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

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

481
instance Uniquable Name where
482
    getUnique = nameUnique
483

484
instance NamedThing Name where
485
    getName n = n
486
487
488
489
490
491

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

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

501
502
503
-- | 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.
504
instance Binary Name where
505
   put_ bh name =
506
      case getUserData bh of
507
        UserData{ ud_put_nonbinding_name = put_name } -> put_name bh name
508

509
510
511
   get bh =
      case getUserData bh of
        UserData { ud_get_name = get_name } -> get_name bh
512

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

instance Outputable Name where
522
523
    ppr name = pprName name

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

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

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

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

571
-- Like Internal, except that we only omit the unique in Iface style
twanvl's avatar
twanvl committed
572
pprSystem :: PprStyle -> Unique -> OccName -> SDoc
573
pprSystem sty uniq occ
574
  | codeStyle sty  = pprUniqueAlways uniq
575
  | debugStyle sty = ppr_occ_name occ <> ppr_underscore_unique uniq
576
577
578
579
580
                     <> 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
581

582

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

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

604
605
606
607
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
608
  = sdocWithDynFlags $ \dflags ->
609
610
    ppUnless (gopt Opt_SuppressUniques dflags) $
    char '_' <> pprUniqueAlways uniq
611

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

-- 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
619
ppr_z_occ_name :: OccName -> SDoc
Ian Lynagh's avatar
Ian Lynagh committed
620
ppr_z_occ_name occ = ztext (zEncodeFS (occNameFS occ))
621

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

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

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

-- | 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
657
658
659
{-
************************************************************************
*                                                                      *
660
\subsection{Overloaded functions related to Names}
Austin Seipp's avatar
Austin Seipp committed
661
662
663
*                                                                      *
************************************************************************
-}
664

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

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

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

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

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

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

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

Austin Seipp's avatar
Austin Seipp committed
699
{-
700
701
702
703
704
705
706
707
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
708
type being pretty printed; eg the pretty-printing code in TyCoRep.
709
710

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