summaryrefslogtreecommitdiff
path: root/compiler/GHC/Types/Name.hs
blob: 1b70c4d910d97a29ce894adb9976e976d0271e9e (plain)
1
2
3
4
5
6
7
8
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
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE TypeFamilies      #-}

{-
(c) The University of Glasgow 2006
(c) The GRASP/AQUA Project, Glasgow University, 1992-1998

\section[Name]{@Name@: to transmit name info from renamer to typechecker}
-}

-- |
-- #name_types#
-- GHC uses several kinds of name internally:
--
-- * 'GHC.Types.Name.Occurrence.OccName': see "GHC.Types.Name.Occurrence#name_types"
--
-- * 'GHC.Types.Name.Reader.RdrName': see "GHC.Types.Name.Reader#name_types"
--
-- * 'GHC.Types.Name.Name' is the type of names that have had their scoping and
--   binding resolved. They have an 'OccName' but also a 'GHC.Types.Unique.Unique'
--   that disambiguates Names that have the same 'OccName' and indeed is used for all
--   'Name' comparison. Names also contain information about where they originated
--   from, see "GHC.Types.Name#name_sorts"
--
-- * 'GHC.Types.Id.Id': see "GHC.Types.Id#name_types"
--
-- * 'GHC.Types.Var.Var': see "GHC.Types.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

module GHC.Types.Name (
        -- * The main types
        Name,                                   -- Abstract
        BuiltInSyntax(..),

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

        -- ** Manipulating and deconstructing 'Name's
        nameUnique, setNameUnique,
        nameOccName, nameNameSpace, nameModule, nameModule_maybe,
        setNameLoc,
        tidyNameOcc,
        localiseName,
        namePun_maybe,

        pprName,
        nameSrcLoc, nameSrcSpan, pprNameDefnLoc, pprDefinedAt,
        pprFullName, pprTickyName,

        -- ** Predicates on 'Name's
        isSystemName, isInternalName, isExternalName,
        isTyVarName, isTyConName, isDataConName,
        isValName, isVarName, isDynLinkName,
        isWiredInName, isWiredIn, isBuiltInSyntax,
        isHoleName,
        wiredInNameTyThing_maybe,
        nameIsLocalOrFrom, nameIsExternalOrFrom, nameIsHomePackage,
        nameIsHomePackageImport, nameIsFromExternalPackage,
        stableNameCmp,

        -- * Class 'NamedThing' and overloaded friends
        NamedThing(..),
        getSrcLoc, getSrcSpan, getOccString, getOccFS,

        pprInfixName, pprPrefixName, pprModulePrefix, pprNameUnqualified,
        nameStableString,

        -- Re-export the OccName stuff
        module GHC.Types.Name.Occurrence
    ) where

import GHC.Prelude

import {-# SOURCE #-} GHC.Types.TyThing ( TyThing )
import {-# SOURCE #-} GHC.Builtin.Types ( listTyCon )

import GHC.Platform
import GHC.Types.Name.Occurrence
import GHC.Unit.Module
import GHC.Unit.Home
import GHC.Types.SrcLoc
import GHC.Types.Unique
import GHC.Utils.Misc
import GHC.Data.Maybe
import GHC.Utils.Binary
import GHC.Data.FastString
import GHC.Utils.Outputable
import GHC.Utils.Panic

import Control.DeepSeq
import Data.Data
import qualified Data.Semigroup as S

{-
************************************************************************
*                                                                      *
\subsection[Name-datatype]{The @Name@ datatype, and name construction}
*                                                                      *
************************************************************************
-}

-- | A unique, unambiguous name for something, containing information about where
-- that thing originated.
data Name = Name
  { n_sort :: NameSort
    -- ^ What sort of name it is

  , n_occ  :: OccName
    -- ^ Its occurrence name.
    --
    -- NOTE: kept lazy to allow known names to be known constructor applications
    -- and to inline better. See Note [Fast comparison for built-in Names]

  , n_uniq :: {-# UNPACK #-} !Unique
    -- ^ Its unique.

  , n_loc  :: !SrcSpan
    -- ^ Definition site
    --
    -- 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.
  }

-- See Note [About the NameSorts]
data NameSort
  = External Module

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

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

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

instance Outputable NameSort where
  ppr (External _)    = text "external"
  ppr (WiredIn _ _ _) = text "wired-in"
  ppr  Internal       = text "internal"
  ppr  System         = text "system"

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 = ()

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

{-
Note [Fast comparison for built-in Names]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider this wired-in Name in GHC.Builtin.Names:

   int8TyConName = tcQual gHC_INT  (fsLit "Int8")  int8TyConKey

Ultimately this turns into something like:

   int8TyConName = Name gHC_INT (mkOccName ..."Int8") int8TyConKey

So a comparison like `x == int8TyConName` will turn into `getUnique x ==
int8TyConKey`, nice and efficient.  But if the `n_occ` field is strict, that
definition will look like:

   int8TyCOnName = case (mkOccName..."Int8") of occ ->
                   Name gHC_INT occ int8TyConKey

and now the comparison will not optimise.  This matters even more when there are
numerous comparisons (see #19386):

if | tc == int8TyCon  -> ...
   | tc == int16TyCon -> ...
   ...etc...

when we would like to get a single multi-branched case.

TL;DR: we make the `n_occ` field lazy.
-}

{-
Note [About the NameSorts]
~~~~~~~~~~~~~~~~~~~~~~~~~~

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

2.  In any invocation of GHC, an External Name for "M.x" has one and only one
    unique.  This unique association is ensured via the Name Cache;
    see Note [The Name Cache] in GHC.Iface.Env.

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

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

5.  A System Name differs in the following ways:
        a) has unique attached when printing dumps
        b) unifier eliminates sys tyvars in favour of user provs where possible

    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.

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

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

All built-in syntax is for wired-in things.
-}

instance HasOccName Name where
  occName = nameOccName

nameUnique              :: Name -> Unique
nameOccName             :: Name -> OccName
nameNameSpace           :: Name -> NameSpace
nameModule              :: HasDebugCallStack => Name -> Module
nameSrcLoc              :: Name -> SrcLoc
nameSrcSpan             :: Name -> SrcSpan

nameUnique    name = n_uniq name
nameOccName   name = n_occ  name
nameNameSpace name = occNameSpace (n_occ name)
nameSrcLoc    name = srcSpanStart (n_loc name)
nameSrcSpan   name = n_loc  name

{-
************************************************************************
*                                                                      *
\subsection{Predicates on names}
*                                                                      *
************************************************************************
-}

isInternalName    :: Name -> Bool
isExternalName    :: Name -> Bool
isSystemName      :: Name -> Bool
isWiredInName     :: Name -> Bool

isWiredInName (Name {n_sort = WiredIn _ _ _}) = True
isWiredInName _                               = False

isWiredIn :: NamedThing thing => thing -> Bool
isWiredIn = isWiredInName . getName

wiredInNameTyThing_maybe :: Name -> Maybe TyThing
wiredInNameTyThing_maybe (Name {n_sort = WiredIn _ thing _}) = Just thing
wiredInNameTyThing_maybe _                                   = Nothing

isBuiltInSyntax :: Name -> Bool
isBuiltInSyntax (Name {n_sort = WiredIn _ _ BuiltInSyntax}) = True
isBuiltInSyntax _                                           = False

isExternalName (Name {n_sort = External _})    = True
isExternalName (Name {n_sort = WiredIn _ _ _}) = True
isExternalName _                               = False

isInternalName name = not (isExternalName name)

isHoleName :: Name -> Bool
isHoleName = isHoleModule . nameModule

-- | Will the 'Name' come from a dynamically linked package?
isDynLinkName :: Platform -> Module -> Name -> Bool
isDynLinkName platform this_mod name
  | Just mod <- nameModule_maybe name
    -- Issue #8696 - when GHC is dynamically linked, it will attempt
    -- to load the dynamic dependencies of object files at compile
    -- time for things like QuasiQuotes or
    -- TemplateHaskell. Unfortunately, this interacts badly with
    -- intra-package linking, because we don't generate indirect
    -- (dynamic) symbols for intra-package calls. This means that if a
    -- module with an intra-package call is loaded without its
    -- dependencies, then GHC fails to link.
    --
    -- In the mean time, always force dynamic indirections to be
    -- generated: when the module name isn't the module being
    -- compiled, references are dynamic.
    = case platformOS platform of
        -- On Windows the hack for #8696 makes it unlinkable.
        -- As the entire setup of the code from Cmm down to the RTS expects
        -- the use of trampolines for the imported functions only when
        -- doing intra-package linking, e.g. referring to a symbol defined in the same
        -- package should not use a trampoline.
        -- I much rather have dynamic TH not supported than the entire Dynamic linking
        -- not due to a hack.
        -- Also not sure this would break on Windows anyway.
        OSMinGW32 -> moduleUnit mod /= moduleUnit this_mod

        -- For the other platforms, still perform the hack
        _         -> mod /= this_mod

  | otherwise = False  -- no, it is not even an external name


nameModule name =
  nameModule_maybe name `orElse`
  pprPanic "nameModule" (ppr (n_sort name) <+> ppr name)

nameModule_maybe :: Name -> Maybe Module
nameModule_maybe (Name { n_sort = External mod})    = Just mod
nameModule_maybe (Name { n_sort = WiredIn mod _ _}) = Just mod
nameModule_maybe _                                  = Nothing

is_interactive_or_from :: Module -> Module -> Bool
is_interactive_or_from from mod = from == mod || isInteractiveModule mod

-- Return the pun for a name if available.
-- Used for pretty-printing under ListTuplePuns.
namePun_maybe :: Name -> Maybe FastString
namePun_maybe name | getUnique name == getUnique listTyCon = Just (fsLit "[]")
namePun_maybe _ = Nothing

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 GHCi 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 "GHC.Runtime.Context"

nameIsLocalOrFrom from name
  | Just mod <- nameModule_maybe name = is_interactive_or_from from mod
  | otherwise                         = True

nameIsExternalOrFrom :: Module -> Name -> Bool
-- ^ Returns True if the name is external or from the 'interactive' package
-- See documentation of `nameIsLocalOrFrom` function
nameIsExternalOrFrom from name
  | Just mod <- nameModule_maybe name = is_interactive_or_from from mod
  | otherwise                         = False

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    -> moduleUnit nm_mod == this_pkg
              WiredIn nm_mod _ _ -> moduleUnit nm_mod == this_pkg
              Internal -> True
              System   -> False
  where
    this_pkg = moduleUnit this_mod

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
                          && moduleUnit nm_mod == this_pkg
  where
    this_pkg = moduleUnit this_mod

-- | Returns True if the Name comes from some other package: neither this
-- package nor the interactive package.
nameIsFromExternalPackage :: HomeUnit -> Name -> Bool
nameIsFromExternalPackage home_unit name
  | Just mod <- nameModule_maybe name
  , notHomeModule home_unit mod   -- Not the current unit
  , not (isInteractiveModule mod) -- Not the 'interactive' package
  = True
  | otherwise
  = False

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

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

isDataConName :: Name -> Bool
isDataConName name = isDataOcc (nameOccName name)

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

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

isSystemName (Name {n_sort = System}) = True
isSystemName _                        = False

{-
************************************************************************
*                                                                      *
\subsection{Making names}
*                                                                      *
************************************************************************
-}

-- | 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
mkInternalName :: Unique -> OccName -> SrcSpan -> Name
mkInternalName uniq occ loc = Name { n_uniq = uniq
                                   , n_sort = Internal
                                   , n_occ = occ
                                   , n_loc = loc }
        -- 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
        --      * for interface files we tidyCore first, which makes
        --        the OccNames distinct when they need to be

mkClonedInternalName :: Unique -> Name -> Name
mkClonedInternalName uniq (Name { n_occ = occ, n_loc = loc })
  = Name { n_uniq = uniq, n_sort = Internal
         , n_occ = occ, n_loc = loc }

mkDerivedInternalName :: (OccName -> OccName) -> Unique -> Name -> Name
mkDerivedInternalName derive_occ uniq (Name { n_occ = occ, n_loc = loc })
  = Name { n_uniq = uniq, n_sort = Internal
         , n_occ = derive_occ occ, n_loc = loc }

-- | Create a name which definitely originates in the given module
mkExternalName :: Unique -> Module -> OccName -> SrcSpan -> Name
{-# INLINE mkExternalName #-}
-- WATCH OUT! External Names should be in the Name Cache
-- (see Note [The Name Cache] in GHC.Iface.Env), so don't just call mkExternalName
-- with some fresh unique without populating the Name Cache
mkExternalName uniq mod occ loc
  = Name { n_uniq = uniq, n_sort = External mod,
           n_occ = occ, n_loc = loc }

-- | Create a name which is actually defined by the compiler itself
mkWiredInName :: Module -> OccName -> Unique -> TyThing -> BuiltInSyntax -> Name
{-# INLINE mkWiredInName #-}
mkWiredInName mod occ uniq thing built_in
  = Name { n_uniq = uniq,
           n_sort = WiredIn mod thing built_in,
           n_occ = occ, n_loc = wiredInSrcSpan }

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

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

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

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

-- | Make a name for a foreign call
mkFCallName :: Unique -> FastString -> Name
mkFCallName uniq str = mkInternalName uniq (mkVarOccFS str) noSrcSpan
   -- The encoded string completely describes the ccall

-- 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.
setNameUnique :: Name -> Unique -> Name
setNameUnique name uniq = name {n_uniq = uniq}

-- 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}

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}
tidyNameOcc name                            occ = name { n_occ = occ }

-- | Make the 'Name' into an internal name, regardless of what it was to begin with
localiseName :: Name -> Name
localiseName n = n { n_sort = Internal }

{-
************************************************************************
*                                                                      *
\subsection{Hashing and comparison}
*                                                                      *
************************************************************************
-}

cmpName :: Name -> Name -> Ordering
cmpName n1 n2 = n_uniq n1 `nonDetCmpUnique` n_uniq n2

-- | Compare Names lexicographically
-- This only works for Names that originate in the source code or have been
-- tidied.
stableNameCmp :: Name -> Name -> Ordering
stableNameCmp (Name { n_sort = s1, n_occ = occ1 })
              (Name { n_sort = s2, n_occ = occ2 })
  = sort_cmp s1 s2 S.<> compare occ1 occ2
    -- The ordinary compare on OccNames is lexicographic
  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

{-
************************************************************************
*                                                                      *
\subsection[Name-instances]{Instance declarations}
*                                                                      *
************************************************************************
-}

-- | The same comments as for `Name`'s `Ord` instance apply.
instance Eq Name where
    a == b = case (a `compare` b) of { EQ -> True;  _ -> False }
    a /= b = case (a `compare` b) of { EQ -> False; _ -> True }

-- | __Caution__: This instance is implemented via `nonDetCmpUnique`, which
-- means that the ordering is not stable across deserialization or rebuilds.
--
-- See `nonDetCmpUnique` for further information, and trac #15240 for a bug
-- caused by improper use of this instance.

-- For a deterministic lexicographic ordering, use `stableNameCmp`.
instance Ord Name where
    compare = cmpName

instance Uniquable Name where
    getUnique = nameUnique

instance NamedThing Name where
    getName n = n

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

{-
************************************************************************
*                                                                      *
\subsection{Binary}
*                                                                      *
************************************************************************
-}

-- | Assumes that the 'Name' is a non-binding one. See
-- 'GHC.Iface.Syntax.putIfaceTopBndr' and 'GHC.Iface.Syntax.getIfaceTopBndr' for
-- serializing binding 'Name's. See 'UserData' for the rationale for this
-- distinction.
instance Binary Name where
   put_ bh name =
      case getUserData bh of
        UserData{ ud_put_nonbinding_name = put_name } -> put_name bh name

   get bh =
      case getUserData bh of
        UserData { ud_get_name = get_name } -> get_name bh

{-
************************************************************************
*                                                                      *
\subsection{Pretty printing}
*                                                                      *
************************************************************************
-}

instance Outputable Name where
    ppr name = pprName name

instance OutputableBndr Name where
    pprBndr _ name = pprName name
    pprInfixOcc  = pprInfixName
    pprPrefixOcc = pprPrefixName

pprName :: forall doc. IsLine doc => Name -> doc
pprName name@(Name {n_sort = sort, n_uniq = uniq, n_occ = occ})
  = docWithContext $ \ctx ->
    let sty = sdocStyle ctx
        debug = sdocPprDebug ctx
        listTuplePuns = sdocListTuplePuns ctx
    in handlePuns listTuplePuns (namePun_maybe name) $
    case sort of
      WiredIn mod _ builtin   -> pprExternal debug sty uniq mod occ True  builtin
      External mod            -> pprExternal debug sty uniq mod occ False UserSyntax
      System                  -> pprSystem   debug sty uniq occ
      Internal                -> pprInternal debug sty uniq occ
  where
    -- Print GHC.Types.List as [], etc.
    handlePuns :: Bool -> Maybe FastString -> doc -> doc
    handlePuns True (Just pun) _ = ftext pun
    handlePuns _    _          r = r
{-# SPECIALISE pprName :: Name -> SDoc #-}
{-# SPECIALISE pprName :: Name -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable

-- | Print fully qualified name (with unit-id, module and unique)
pprFullName :: Module -> Name -> SDoc
pprFullName this_mod Name{n_sort = sort, n_uniq = uniq, n_occ = occ} =
  let mod = case sort of
        WiredIn  m _ _ -> m
        External m     -> m
        System         -> this_mod
        Internal       -> this_mod
      in ftext (unitIdFS (moduleUnitId mod))
         <> colon    <> ftext (moduleNameFS $ moduleName mod)
         <> dot      <> ftext (occNameFS occ)
         <> char '_' <> pprUniqueAlways uniq


-- | Print a ticky ticky styled name
--
-- Module argument is the module to use for internal and system names. When
-- printing the name in a ticky profile, the module name is included even for
-- local things. However, ticky uses the format "x (M)" rather than "M.x".
-- Hence, this function provides a separation from normal styling.
pprTickyName :: Module -> Name -> SDoc
pprTickyName this_mod name
  | isInternalName name = pprName name <+> parens (ppr this_mod)
  | otherwise           = pprName name

-- | Print the string of Name unqualifiedly directly.
pprNameUnqualified :: Name -> SDoc
pprNameUnqualified Name { n_occ = occ } = ppr_occ_name occ

pprExternal :: IsLine doc => Bool -> PprStyle -> Unique -> Module -> OccName -> Bool -> BuiltInSyntax -> doc
pprExternal debug sty uniq mod occ is_wired is_builtin
  | codeStyle sty = pprModule mod <> char '_' <> ppr_z_occ_name occ
        -- In code style, always qualify
        -- ToDo: maybe we could print all wired-in things unqualified
        --       in code style, to reduce symbol table bloat?
  | debug         = pp_mod <> ppr_occ_name occ
                     <> braces (hsep [if is_wired then text "(w)" else empty,
                                      pprNameSpaceBrief (occNameSpace occ),
                                      pprUnique uniq])
  | BuiltInSyntax <- is_builtin = ppr_occ_name occ  -- Never qualify builtin syntax
  | otherwise                   =
        if isHoleModule mod
            then case qualName sty mod occ of
                    NameUnqual -> ppr_occ_name occ
                    _ -> braces (pprModuleName (moduleName mod) <> dot <> ppr_occ_name occ)
            else pprModulePrefix sty mod occ <> ppr_occ_name occ
  where
    pp_mod = ppUnlessOption sdocSuppressModulePrefixes
               (pprModule mod <> dot)

pprInternal :: IsLine doc => Bool -> PprStyle -> Unique -> OccName -> doc
pprInternal debug sty uniq occ
  | codeStyle sty  = pprUniqueAlways uniq
  | debug          = ppr_occ_name occ <> braces (hsep [pprNameSpaceBrief (occNameSpace occ),
                                                       pprUnique uniq])
  | dumpStyle sty  = ppr_occ_name occ <> ppr_underscore_unique uniq
                        -- For debug dumps, we're not necessarily dumping
                        -- tidied code, so we need to print the uniques.
  | otherwise      = ppr_occ_name occ   -- User style

-- Like Internal, except that we only omit the unique in Iface style
pprSystem :: IsLine doc => Bool -> PprStyle -> Unique -> OccName -> doc
pprSystem debug sty uniq occ
  | codeStyle sty  = pprUniqueAlways uniq
  | debug          = ppr_occ_name occ <> ppr_underscore_unique uniq
                     <> 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


pprModulePrefix :: IsLine doc => PprStyle -> Module -> OccName -> doc
-- Print the "M." part of a name, based on whether it's in scope or not
-- See Note [Printing original names] in GHC.Types.Name.Ppr
pprModulePrefix sty mod occ = ppUnlessOption sdocSuppressModulePrefixes $
    case qualName sty mod occ of              -- See Outputable.QualifyName:
      NameQual modname -> pprModuleName modname <> dot       -- Name is in scope
      NameNotInScope1  -> pprModule mod <> dot               -- Not in scope
      NameNotInScope2  -> pprUnit (moduleUnit mod) <> colon           -- Module not in
                          <> pprModuleName (moduleName mod) <> dot    -- scope either
      NameUnqual       -> empty                   -- In scope unqualified

pprUnique :: IsLine doc => Unique -> doc
-- Print a unique unless we are suppressing them
pprUnique uniq
  = ppUnlessOption sdocSuppressUniques $
      pprUniqueAlways uniq

ppr_underscore_unique :: IsLine doc => Unique -> doc
-- Print an underscore separating the name from its unique
-- But suppress it if we aren't printing the uniques anyway
ppr_underscore_unique uniq
  = ppUnlessOption sdocSuppressUniques $
      char '_' <> pprUniqueAlways uniq

ppr_occ_name :: IsLine doc => OccName -> doc
ppr_occ_name occ = ftext (occNameFS occ)
        -- Don't use pprOccName; instead, just print the string of the OccName;
        -- we print the namespace in the debug stuff above

-- In code style, we Z-encode the strings.  The results of Z-encoding each FastString are
-- cached behind the scenes in the FastString implementation.
ppr_z_occ_name :: IsLine doc => OccName -> doc
ppr_z_occ_name occ = ztext (zEncodeFS (occNameFS occ))

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

pprNameDefnLoc :: Name -> SDoc
-- Prints "at <loc>" or
--     or "in <mod>" depending on what info is available
pprNameDefnLoc name
  = case nameSrcLoc name of
         -- nameSrcLoc rather than nameSrcSpan
         -- It seems less cluttered to show a location
         -- rather than a span for the definition point
       RealSrcLoc s _ -> text "at" <+> ppr s
       UnhelpfulLoc s
         | isInternalName name || isSystemName name
         -> text "at" <+> ftext s
         | otherwise
         -> text "in" <+> quotes (ppr (nameModule name))


-- | 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

{-
************************************************************************
*                                                                      *
\subsection{Overloaded functions related to Names}
*                                                                      *
************************************************************************
-}

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

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

instance NamedThing e => NamedThing (Located e) where
    getName = getName . unLoc

getSrcLoc           :: NamedThing a => a -> SrcLoc
getSrcSpan          :: NamedThing a => a -> SrcSpan
getOccString        :: NamedThing a => a -> String
getOccFS            :: NamedThing a => a -> FastString

getSrcLoc           = nameSrcLoc           . getName
getSrcSpan          = nameSrcSpan          . getName
getOccString        = occNameString        . getOccName
getOccFS            = occNameFS            . getOccName

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

pprPrefixName :: NamedThing a => a -> SDoc
pprPrefixName thing = pprPrefixVar (isSymOcc (nameOccName name)) (ppr name)
 where
   name = getName thing