{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
module GHC.Types.Name (
Name,
BuiltInSyntax(..),
mkSystemName, mkSystemNameAt,
mkInternalName, mkClonedInternalName, mkDerivedInternalName,
mkSystemVarName, mkSysTvName,
mkFCallName,
mkExternalName, mkWiredInName,
nameUnique, setNameUnique,
nameOccName, nameNameSpace, nameModule, nameModule_maybe,
setNameLoc,
tidyNameOcc,
localiseName,
nameSrcLoc, nameSrcSpan, pprNameDefnLoc, pprDefinedAt,
pprFullName, pprTickyName,
isSystemName, isInternalName, isExternalName,
isTyVarName, isTyConName, isDataConName,
isValName, isVarName, isDynLinkName,
isWiredInName, isWiredIn, isBuiltInSyntax,
isHoleName,
wiredInNameTyThing_maybe,
nameIsLocalOrFrom, nameIsExternalOrFrom, nameIsHomePackage,
nameIsHomePackageImport, nameIsFromExternalPackage,
stableNameCmp,
NamedThing(..),
getSrcLoc, getSrcSpan, getOccString, getOccFS,
pprInfixName, pprPrefixName, pprModulePrefix, pprNameUnqualified,
nameStableString,
module GHC.Types.Name.Occurrence
) where
import GHC.Prelude
import {-# SOURCE #-} GHC.Types.TyThing ( TyThing )
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
data Name = Name
{ Name -> NameSort
n_sort :: NameSort
, Name -> OccName
n_occ :: OccName
, Name -> Unique
n_uniq :: {-# UNPACK #-} !Unique
, Name -> SrcSpan
n_loc :: !SrcSpan
}
data NameSort
= External Module
| WiredIn Module TyThing BuiltInSyntax
| Internal
| System
instance Outputable NameSort where
ppr :: NameSort -> SDoc
ppr (External Module
_) = String -> SDoc
text String
"external"
ppr (WiredIn Module
_ TyThing
_ BuiltInSyntax
_) = String -> SDoc
text String
"wired-in"
ppr NameSort
Internal = String -> SDoc
text String
"internal"
ppr NameSort
System = String -> SDoc
text String
"system"
instance NFData Name where
rnf :: Name -> ()
rnf Name{OccName
Unique
SrcSpan
NameSort
n_sort :: Name -> NameSort
n_occ :: Name -> OccName
n_uniq :: Name -> Unique
n_loc :: Name -> SrcSpan
n_sort :: NameSort
n_occ :: OccName
n_uniq :: Unique
n_loc :: SrcSpan
..} = NameSort -> ()
forall a. NFData a => a -> ()
rnf NameSort
n_sort
instance NFData NameSort where
rnf :: NameSort -> ()
rnf (External Module
m) = Module -> ()
forall a. NFData a => a -> ()
rnf Module
m
rnf (WiredIn Module
m TyThing
t BuiltInSyntax
b) = Module -> ()
forall a. NFData a => a -> ()
rnf Module
m () -> () -> ()
forall a b. a -> b -> b
`seq` TyThing
t TyThing -> () -> ()
forall a b. a -> b -> b
`seq` BuiltInSyntax
b BuiltInSyntax -> () -> ()
forall a b. a -> b -> b
`seq` ()
rnf NameSort
Internal = ()
rnf NameSort
System = ()
data BuiltInSyntax = BuiltInSyntax | UserSyntax
instance HasOccName Name where
occName :: Name -> OccName
occName = Name -> OccName
nameOccName
nameUnique :: Name -> Unique
nameOccName :: Name -> OccName
nameNameSpace :: Name -> NameSpace
nameModule :: HasDebugCallStack => Name -> Module
nameSrcLoc :: Name -> SrcLoc
nameSrcSpan :: Name -> SrcSpan
nameUnique :: Name -> Unique
nameUnique Name
name = Name -> Unique
n_uniq Name
name
nameOccName :: Name -> OccName
nameOccName Name
name = Name -> OccName
n_occ Name
name
nameNameSpace :: Name -> NameSpace
nameNameSpace Name
name = OccName -> NameSpace
occNameSpace (Name -> OccName
n_occ Name
name)
nameSrcLoc :: Name -> SrcLoc
nameSrcLoc Name
name = SrcSpan -> SrcLoc
srcSpanStart (Name -> SrcSpan
n_loc Name
name)
nameSrcSpan :: Name -> SrcSpan
nameSrcSpan Name
name = Name -> SrcSpan
n_loc Name
name
isInternalName :: Name -> Bool
isExternalName :: Name -> Bool
isSystemName :: Name -> Bool
isWiredInName :: Name -> Bool
isWiredInName :: Name -> Bool
isWiredInName (Name {n_sort :: Name -> NameSort
n_sort = WiredIn Module
_ TyThing
_ BuiltInSyntax
_}) = Bool
True
isWiredInName Name
_ = Bool
False
isWiredIn :: NamedThing thing => thing -> Bool
isWiredIn :: forall thing. NamedThing thing => thing -> Bool
isWiredIn = Name -> Bool
isWiredInName (Name -> Bool) -> (thing -> Name) -> thing -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. thing -> Name
forall a. NamedThing a => a -> Name
getName
wiredInNameTyThing_maybe :: Name -> Maybe TyThing
wiredInNameTyThing_maybe :: Name -> Maybe TyThing
wiredInNameTyThing_maybe (Name {n_sort :: Name -> NameSort
n_sort = WiredIn Module
_ TyThing
thing BuiltInSyntax
_}) = TyThing -> Maybe TyThing
forall a. a -> Maybe a
Just TyThing
thing
wiredInNameTyThing_maybe Name
_ = Maybe TyThing
forall a. Maybe a
Nothing
isBuiltInSyntax :: Name -> Bool
isBuiltInSyntax :: Name -> Bool
isBuiltInSyntax (Name {n_sort :: Name -> NameSort
n_sort = WiredIn Module
_ TyThing
_ BuiltInSyntax
BuiltInSyntax}) = Bool
True
isBuiltInSyntax Name
_ = Bool
False
isExternalName :: Name -> Bool
isExternalName (Name {n_sort :: Name -> NameSort
n_sort = External Module
_}) = Bool
True
isExternalName (Name {n_sort :: Name -> NameSort
n_sort = WiredIn Module
_ TyThing
_ BuiltInSyntax
_}) = Bool
True
isExternalName Name
_ = Bool
False
isInternalName :: Name -> Bool
isInternalName Name
name = Bool -> Bool
not (Name -> Bool
isExternalName Name
name)
isHoleName :: Name -> Bool
isHoleName :: Name -> Bool
isHoleName = Module -> Bool
forall u. GenModule (GenUnit u) -> Bool
isHoleModule (Module -> Bool) -> (Name -> Module) -> Name -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (() :: Constraint) => Name -> Module
Name -> Module
nameModule
isDynLinkName :: Platform -> Module -> Name -> Bool
isDynLinkName :: Platform -> Module -> Name -> Bool
isDynLinkName Platform
platform Module
this_mod Name
name
| Just Module
mod <- Name -> Maybe Module
nameModule_maybe Name
name
= case Platform -> OS
platformOS Platform
platform of
OS
OSMinGW32 -> Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit Module
mod Unit -> Unit -> Bool
forall a. Eq a => a -> a -> Bool
/= Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit Module
this_mod
OS
_ -> Module
mod Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
/= Module
this_mod
| Bool
otherwise = Bool
False
nameModule :: (() :: Constraint) => Name -> Module
nameModule Name
name =
Name -> Maybe Module
nameModule_maybe Name
name Maybe Module -> Module -> Module
forall a. Maybe a -> a -> a
`orElse`
String -> SDoc -> Module
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"nameModule" (NameSort -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Name -> NameSort
n_sort Name
name) SDoc -> SDoc -> SDoc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name)
nameModule_maybe :: Name -> Maybe Module
nameModule_maybe :: Name -> Maybe Module
nameModule_maybe (Name { n_sort :: Name -> NameSort
n_sort = External Module
mod}) = Module -> Maybe Module
forall a. a -> Maybe a
Just Module
mod
nameModule_maybe (Name { n_sort :: Name -> NameSort
n_sort = WiredIn Module
mod TyThing
_ BuiltInSyntax
_}) = Module -> Maybe Module
forall a. a -> Maybe a
Just Module
mod
nameModule_maybe Name
_ = Maybe Module
forall a. Maybe a
Nothing
is_interactive_or_from :: Module -> Module -> Bool
is_interactive_or_from :: Module -> Module -> Bool
is_interactive_or_from Module
from Module
mod = Module
from Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
== Module
mod Bool -> Bool -> Bool
|| Module -> Bool
isInteractiveModule Module
mod
nameIsLocalOrFrom :: Module -> Name -> Bool
nameIsLocalOrFrom :: Module -> Name -> Bool
nameIsLocalOrFrom Module
from Name
name
| Just Module
mod <- Name -> Maybe Module
nameModule_maybe Name
name = Module -> Module -> Bool
is_interactive_or_from Module
from Module
mod
| Bool
otherwise = Bool
True
nameIsExternalOrFrom :: Module -> Name -> Bool
nameIsExternalOrFrom :: Module -> Name -> Bool
nameIsExternalOrFrom Module
from Name
name
| Just Module
mod <- Name -> Maybe Module
nameModule_maybe Name
name = Module -> Module -> Bool
is_interactive_or_from Module
from Module
mod
| Bool
otherwise = Bool
False
nameIsHomePackage :: Module -> Name -> Bool
nameIsHomePackage :: Module -> Name -> Bool
nameIsHomePackage Module
this_mod
= \Name
nm -> case Name -> NameSort
n_sort Name
nm of
External Module
nm_mod -> Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit Module
nm_mod Unit -> Unit -> Bool
forall a. Eq a => a -> a -> Bool
== Unit
this_pkg
WiredIn Module
nm_mod TyThing
_ BuiltInSyntax
_ -> Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit Module
nm_mod Unit -> Unit -> Bool
forall a. Eq a => a -> a -> Bool
== Unit
this_pkg
NameSort
Internal -> Bool
True
NameSort
System -> Bool
False
where
this_pkg :: Unit
this_pkg = Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit Module
this_mod
nameIsHomePackageImport :: Module -> Name -> Bool
nameIsHomePackageImport :: Module -> Name -> Bool
nameIsHomePackageImport Module
this_mod
= \Name
nm -> case Name -> Maybe Module
nameModule_maybe Name
nm of
Maybe Module
Nothing -> Bool
False
Just Module
nm_mod -> Module
nm_mod Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
/= Module
this_mod
Bool -> Bool -> Bool
&& Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit Module
nm_mod Unit -> Unit -> Bool
forall a. Eq a => a -> a -> Bool
== Unit
this_pkg
where
this_pkg :: Unit
this_pkg = Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit Module
this_mod
nameIsFromExternalPackage :: HomeUnit -> Name -> Bool
nameIsFromExternalPackage :: HomeUnit -> Name -> Bool
nameIsFromExternalPackage HomeUnit
home_unit Name
name
| Just Module
mod <- Name -> Maybe Module
nameModule_maybe Name
name
, HomeUnit -> Module -> Bool
notHomeModule HomeUnit
home_unit Module
mod
, Bool -> Bool
not (Module -> Bool
isInteractiveModule Module
mod)
= Bool
True
| Bool
otherwise
= Bool
False
isTyVarName :: Name -> Bool
isTyVarName :: Name -> Bool
isTyVarName Name
name = OccName -> Bool
isTvOcc (Name -> OccName
nameOccName Name
name)
isTyConName :: Name -> Bool
isTyConName :: Name -> Bool
isTyConName Name
name = OccName -> Bool
isTcOcc (Name -> OccName
nameOccName Name
name)
isDataConName :: Name -> Bool
isDataConName :: Name -> Bool
isDataConName Name
name = OccName -> Bool
isDataOcc (Name -> OccName
nameOccName Name
name)
isValName :: Name -> Bool
isValName :: Name -> Bool
isValName Name
name = OccName -> Bool
isValOcc (Name -> OccName
nameOccName Name
name)
isVarName :: Name -> Bool
isVarName :: Name -> Bool
isVarName = OccName -> Bool
isVarOcc (OccName -> Bool) -> (Name -> OccName) -> Name -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> OccName
nameOccName
isSystemName :: Name -> Bool
isSystemName (Name {n_sort :: Name -> NameSort
n_sort = NameSort
System}) = Bool
True
isSystemName Name
_ = Bool
False
mkInternalName :: Unique -> OccName -> SrcSpan -> Name
mkInternalName :: Unique -> OccName -> SrcSpan -> Name
mkInternalName Unique
uniq OccName
occ SrcSpan
loc = Name { n_uniq :: Unique
n_uniq = Unique
uniq
, n_sort :: NameSort
n_sort = NameSort
Internal
, n_occ :: OccName
n_occ = OccName
occ
, n_loc :: SrcSpan
n_loc = SrcSpan
loc }
mkClonedInternalName :: Unique -> Name -> Name
mkClonedInternalName :: Unique -> Name -> Name
mkClonedInternalName Unique
uniq (Name { n_occ :: Name -> OccName
n_occ = OccName
occ, n_loc :: Name -> SrcSpan
n_loc = SrcSpan
loc })
= Name { n_uniq :: Unique
n_uniq = Unique
uniq, n_sort :: NameSort
n_sort = NameSort
Internal
, n_occ :: OccName
n_occ = OccName
occ, n_loc :: SrcSpan
n_loc = SrcSpan
loc }
mkDerivedInternalName :: (OccName -> OccName) -> Unique -> Name -> Name
mkDerivedInternalName :: (OccName -> OccName) -> Unique -> Name -> Name
mkDerivedInternalName OccName -> OccName
derive_occ Unique
uniq (Name { n_occ :: Name -> OccName
n_occ = OccName
occ, n_loc :: Name -> SrcSpan
n_loc = SrcSpan
loc })
= Name { n_uniq :: Unique
n_uniq = Unique
uniq, n_sort :: NameSort
n_sort = NameSort
Internal
, n_occ :: OccName
n_occ = OccName -> OccName
derive_occ OccName
occ, n_loc :: SrcSpan
n_loc = SrcSpan
loc }
mkExternalName :: Unique -> Module -> OccName -> SrcSpan -> Name
{-# INLINE mkExternalName #-}
mkExternalName :: Unique -> Module -> OccName -> SrcSpan -> Name
mkExternalName Unique
uniq Module
mod OccName
occ SrcSpan
loc
= Name { n_uniq :: Unique
n_uniq = Unique
uniq, n_sort :: NameSort
n_sort = Module -> NameSort
External Module
mod,
n_occ :: OccName
n_occ = OccName
occ, n_loc :: SrcSpan
n_loc = SrcSpan
loc }
mkWiredInName :: Module -> OccName -> Unique -> TyThing -> BuiltInSyntax -> Name
{-# INLINE mkWiredInName #-}
mkWiredInName :: Module -> OccName -> Unique -> TyThing -> BuiltInSyntax -> Name
mkWiredInName Module
mod OccName
occ Unique
uniq TyThing
thing BuiltInSyntax
built_in
= Name { n_uniq :: Unique
n_uniq = Unique
uniq,
n_sort :: NameSort
n_sort = Module -> TyThing -> BuiltInSyntax -> NameSort
WiredIn Module
mod TyThing
thing BuiltInSyntax
built_in,
n_occ :: OccName
n_occ = OccName
occ, n_loc :: SrcSpan
n_loc = SrcSpan
wiredInSrcSpan }
mkSystemName :: Unique -> OccName -> Name
mkSystemName :: Unique -> OccName -> Name
mkSystemName Unique
uniq OccName
occ = Unique -> OccName -> SrcSpan -> Name
mkSystemNameAt Unique
uniq OccName
occ SrcSpan
noSrcSpan
mkSystemNameAt :: Unique -> OccName -> SrcSpan -> Name
mkSystemNameAt :: Unique -> OccName -> SrcSpan -> Name
mkSystemNameAt Unique
uniq OccName
occ SrcSpan
loc = Name { n_uniq :: Unique
n_uniq = Unique
uniq, n_sort :: NameSort
n_sort = NameSort
System
, n_occ :: OccName
n_occ = OccName
occ, n_loc :: SrcSpan
n_loc = SrcSpan
loc }
mkSystemVarName :: Unique -> FastString -> Name
mkSystemVarName :: Unique -> FastString -> Name
mkSystemVarName Unique
uniq FastString
fs = Unique -> OccName -> Name
mkSystemName Unique
uniq (FastString -> OccName
mkVarOccFS FastString
fs)
mkSysTvName :: Unique -> FastString -> Name
mkSysTvName :: Unique -> FastString -> Name
mkSysTvName Unique
uniq FastString
fs = Unique -> OccName -> Name
mkSystemName Unique
uniq (FastString -> OccName
mkTyVarOccFS FastString
fs)
mkFCallName :: Unique -> String -> Name
mkFCallName :: Unique -> String -> Name
mkFCallName Unique
uniq String
str = Unique -> OccName -> SrcSpan -> Name
mkInternalName Unique
uniq (String -> OccName
mkVarOcc String
str) SrcSpan
noSrcSpan
setNameUnique :: Name -> Unique -> Name
setNameUnique :: Name -> Unique -> Name
setNameUnique Name
name Unique
uniq = Name
name {n_uniq :: Unique
n_uniq = Unique
uniq}
setNameLoc :: Name -> SrcSpan -> Name
setNameLoc :: Name -> SrcSpan -> Name
setNameLoc Name
name SrcSpan
loc = Name
name {n_loc :: SrcSpan
n_loc = SrcSpan
loc}
tidyNameOcc :: Name -> OccName -> Name
tidyNameOcc :: Name -> OccName -> Name
tidyNameOcc name :: Name
name@(Name { n_sort :: Name -> NameSort
n_sort = NameSort
System }) OccName
occ = Name
name { n_occ :: OccName
n_occ = OccName
occ, n_sort :: NameSort
n_sort = NameSort
Internal}
tidyNameOcc Name
name OccName
occ = Name
name { n_occ :: OccName
n_occ = OccName
occ }
localiseName :: Name -> Name
localiseName :: Name -> Name
localiseName Name
n = Name
n { n_sort :: NameSort
n_sort = NameSort
Internal }
cmpName :: Name -> Name -> Ordering
cmpName :: Name -> Name -> Ordering
cmpName Name
n1 Name
n2 = Name -> Unique
n_uniq Name
n1 Unique -> Unique -> Ordering
`nonDetCmpUnique` Name -> Unique
n_uniq Name
n2
stableNameCmp :: Name -> Name -> Ordering
stableNameCmp :: Name -> Name -> Ordering
stableNameCmp (Name { n_sort :: Name -> NameSort
n_sort = NameSort
s1, n_occ :: Name -> OccName
n_occ = OccName
occ1 })
(Name { n_sort :: Name -> NameSort
n_sort = NameSort
s2, n_occ :: Name -> OccName
n_occ = OccName
occ2 })
= (NameSort
s1 NameSort -> NameSort -> Ordering
`sort_cmp` NameSort
s2) Ordering -> Ordering -> Ordering
`thenCmp` (OccName
occ1 OccName -> OccName -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` OccName
occ2)
where
sort_cmp :: NameSort -> NameSort -> Ordering
sort_cmp (External Module
m1) (External Module
m2) = Module
m1 Module -> Module -> Ordering
`stableModuleCmp` Module
m2
sort_cmp (External {}) NameSort
_ = Ordering
LT
sort_cmp (WiredIn {}) (External {}) = Ordering
GT
sort_cmp (WiredIn Module
m1 TyThing
_ BuiltInSyntax
_) (WiredIn Module
m2 TyThing
_ BuiltInSyntax
_) = Module
m1 Module -> Module -> Ordering
`stableModuleCmp` Module
m2
sort_cmp (WiredIn {}) NameSort
_ = Ordering
LT
sort_cmp NameSort
Internal (External {}) = Ordering
GT
sort_cmp NameSort
Internal (WiredIn {}) = Ordering
GT
sort_cmp NameSort
Internal NameSort
Internal = Ordering
EQ
sort_cmp NameSort
Internal NameSort
System = Ordering
LT
sort_cmp NameSort
System NameSort
System = Ordering
EQ
sort_cmp NameSort
System NameSort
_ = Ordering
GT
instance Eq Name where
Name
a == :: Name -> Name -> Bool
== Name
b = case (Name
a Name -> Name -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Name
b) of { Ordering
EQ -> Bool
True; Ordering
_ -> Bool
False }
Name
a /= :: Name -> Name -> Bool
/= Name
b = case (Name
a Name -> Name -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Name
b) of { Ordering
EQ -> Bool
False; Ordering
_ -> Bool
True }
instance Ord Name where
compare :: Name -> Name -> Ordering
compare = Name -> Name -> Ordering
cmpName
instance Uniquable Name where
getUnique :: Name -> Unique
getUnique = Name -> Unique
nameUnique
instance NamedThing Name where
getName :: Name -> Name
getName Name
n = Name
n
instance Data Name where
toConstr :: Name -> Constr
toConstr Name
_ = String -> Constr
abstractConstr String
"Name"
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Name
gunfold forall b r. Data b => c (b -> r) -> c r
_ forall r. r -> c r
_ = String -> Constr -> c Name
forall a. HasCallStack => String -> a
error String
"gunfold"
dataTypeOf :: Name -> DataType
dataTypeOf Name
_ = String -> DataType
mkNoRepType String
"Name"
instance Binary Name where
put_ :: BinHandle -> Name -> IO ()
put_ BinHandle
bh Name
name =
case BinHandle -> UserData
getUserData BinHandle
bh of
UserData{ ud_put_nonbinding_name :: UserData -> BinHandle -> Name -> IO ()
ud_put_nonbinding_name = BinHandle -> Name -> IO ()
put_name } -> BinHandle -> Name -> IO ()
put_name BinHandle
bh Name
name
get :: BinHandle -> IO Name
get BinHandle
bh =
case BinHandle -> UserData
getUserData BinHandle
bh of
UserData { ud_get_name :: UserData -> BinHandle -> IO Name
ud_get_name = BinHandle -> IO Name
get_name } -> BinHandle -> IO Name
get_name BinHandle
bh
instance Outputable Name where
ppr :: Name -> SDoc
ppr Name
name = Name -> SDoc
pprName Name
name
instance OutputableBndr Name where
pprBndr :: BindingSite -> Name -> SDoc
pprBndr BindingSite
_ Name
name = Name -> SDoc
pprName Name
name
pprInfixOcc :: Name -> SDoc
pprInfixOcc = Name -> SDoc
forall a. (Outputable a, NamedThing a) => a -> SDoc
pprInfixName
pprPrefixOcc :: Name -> SDoc
pprPrefixOcc = Name -> SDoc
forall a. NamedThing a => a -> SDoc
pprPrefixName
pprName :: Name -> SDoc
pprName :: Name -> SDoc
pprName (Name {n_sort :: Name -> NameSort
n_sort = NameSort
sort, n_uniq :: Name -> Unique
n_uniq = Unique
uniq, n_occ :: Name -> OccName
n_occ = OccName
occ})
= (PprStyle -> SDoc) -> SDoc
getPprStyle ((PprStyle -> SDoc) -> SDoc) -> (PprStyle -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \PprStyle
sty ->
(Bool -> SDoc) -> SDoc
getPprDebug ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Bool
debug ->
case NameSort
sort of
WiredIn Module
mod TyThing
_ BuiltInSyntax
builtin -> Bool
-> PprStyle
-> Unique
-> Module
-> OccName
-> Bool
-> BuiltInSyntax
-> SDoc
pprExternal Bool
debug PprStyle
sty Unique
uniq Module
mod OccName
occ Bool
True BuiltInSyntax
builtin
External Module
mod -> Bool
-> PprStyle
-> Unique
-> Module
-> OccName
-> Bool
-> BuiltInSyntax
-> SDoc
pprExternal Bool
debug PprStyle
sty Unique
uniq Module
mod OccName
occ Bool
False BuiltInSyntax
UserSyntax
NameSort
System -> Bool -> PprStyle -> Unique -> OccName -> SDoc
pprSystem Bool
debug PprStyle
sty Unique
uniq OccName
occ
NameSort
Internal -> Bool -> PprStyle -> Unique -> OccName -> SDoc
pprInternal Bool
debug PprStyle
sty Unique
uniq OccName
occ
pprFullName :: Module -> Name -> SDoc
pprFullName :: Module -> Name -> SDoc
pprFullName Module
this_mod Name{n_sort :: Name -> NameSort
n_sort = NameSort
sort, n_uniq :: Name -> Unique
n_uniq = Unique
uniq, n_occ :: Name -> OccName
n_occ = OccName
occ} =
let mod :: Module
mod = case NameSort
sort of
WiredIn Module
m TyThing
_ BuiltInSyntax
_ -> Module
m
External Module
m -> Module
m
NameSort
System -> Module
this_mod
NameSort
Internal -> Module
this_mod
in FastString -> SDoc
ftext (UnitId -> FastString
unitIdFS (Module -> UnitId
moduleUnitId Module
mod))
SDoc -> SDoc -> SDoc
<> SDoc
colon SDoc -> SDoc -> SDoc
<> FastString -> SDoc
ftext (ModuleName -> FastString
moduleNameFS (ModuleName -> FastString) -> ModuleName -> FastString
forall a b. (a -> b) -> a -> b
$ Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
mod)
SDoc -> SDoc -> SDoc
<> SDoc
dot SDoc -> SDoc -> SDoc
<> FastString -> SDoc
ftext (OccName -> FastString
occNameFS OccName
occ)
SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
'_' SDoc -> SDoc -> SDoc
<> Unique -> SDoc
pprUniqueAlways Unique
uniq
pprTickyName :: Module -> Name -> SDoc
pprTickyName :: Module -> Name -> SDoc
pprTickyName Module
this_mod Name
name
| Name -> Bool
isInternalName Name
name = Name -> SDoc
pprName Name
name SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
parens (Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
this_mod)
| Bool
otherwise = Name -> SDoc
pprName Name
name
pprNameUnqualified :: Name -> SDoc
pprNameUnqualified :: Name -> SDoc
pprNameUnqualified Name { n_occ :: Name -> OccName
n_occ = OccName
occ } = OccName -> SDoc
ppr_occ_name OccName
occ
pprExternal :: Bool -> PprStyle -> Unique -> Module -> OccName -> Bool -> BuiltInSyntax -> SDoc
pprExternal :: Bool
-> PprStyle
-> Unique
-> Module
-> OccName
-> Bool
-> BuiltInSyntax
-> SDoc
pprExternal Bool
debug PprStyle
sty Unique
uniq Module
mod OccName
occ Bool
is_wired BuiltInSyntax
is_builtin
| PprStyle -> Bool
codeStyle PprStyle
sty = Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
mod SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
'_' SDoc -> SDoc -> SDoc
<> OccName -> SDoc
ppr_z_occ_name OccName
occ
| Bool
debug = SDoc
pp_mod SDoc -> SDoc -> SDoc
<> OccName -> SDoc
ppr_occ_name OccName
occ
SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
braces ([SDoc] -> SDoc
hsep [if Bool
is_wired then String -> SDoc
text String
"(w)" else SDoc
empty,
NameSpace -> SDoc
pprNameSpaceBrief (OccName -> NameSpace
occNameSpace OccName
occ),
Unique -> SDoc
pprUnique Unique
uniq])
| BuiltInSyntax
BuiltInSyntax <- BuiltInSyntax
is_builtin = OccName -> SDoc
ppr_occ_name OccName
occ
| Bool
otherwise =
if Module -> Bool
forall u. GenModule (GenUnit u) -> Bool
isHoleModule Module
mod
then case PprStyle -> QueryQualifyName
qualName PprStyle
sty Module
mod OccName
occ of
QualifyName
NameUnqual -> OccName -> SDoc
ppr_occ_name OccName
occ
QualifyName
_ -> SDoc -> SDoc
braces (ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
mod) SDoc -> SDoc -> SDoc
<> SDoc
dot SDoc -> SDoc -> SDoc
<> OccName -> SDoc
ppr_occ_name OccName
occ)
else PprStyle -> Module -> OccName -> SDoc
pprModulePrefix PprStyle
sty Module
mod OccName
occ SDoc -> SDoc -> SDoc
<> OccName -> SDoc
ppr_occ_name OccName
occ
where
pp_mod :: SDoc
pp_mod = (SDocContext -> Bool) -> SDoc -> SDoc
ppUnlessOption SDocContext -> Bool
sdocSuppressModulePrefixes
(Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
mod SDoc -> SDoc -> SDoc
<> SDoc
dot)
pprInternal :: Bool -> PprStyle -> Unique -> OccName -> SDoc
pprInternal :: Bool -> PprStyle -> Unique -> OccName -> SDoc
pprInternal Bool
debug PprStyle
sty Unique
uniq OccName
occ
| PprStyle -> Bool
codeStyle PprStyle
sty = Unique -> SDoc
pprUniqueAlways Unique
uniq
| Bool
debug = OccName -> SDoc
ppr_occ_name OccName
occ SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
braces ([SDoc] -> SDoc
hsep [NameSpace -> SDoc
pprNameSpaceBrief (OccName -> NameSpace
occNameSpace OccName
occ),
Unique -> SDoc
pprUnique Unique
uniq])
| PprStyle -> Bool
dumpStyle PprStyle
sty = OccName -> SDoc
ppr_occ_name OccName
occ SDoc -> SDoc -> SDoc
<> Unique -> SDoc
ppr_underscore_unique Unique
uniq
| Bool
otherwise = OccName -> SDoc
ppr_occ_name OccName
occ
pprSystem :: Bool -> PprStyle -> Unique -> OccName -> SDoc
pprSystem :: Bool -> PprStyle -> Unique -> OccName -> SDoc
pprSystem Bool
debug PprStyle
sty Unique
uniq OccName
occ
| PprStyle -> Bool
codeStyle PprStyle
sty = Unique -> SDoc
pprUniqueAlways Unique
uniq
| Bool
debug = OccName -> SDoc
ppr_occ_name OccName
occ SDoc -> SDoc -> SDoc
<> Unique -> SDoc
ppr_underscore_unique Unique
uniq
SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
braces (NameSpace -> SDoc
pprNameSpaceBrief (OccName -> NameSpace
occNameSpace OccName
occ))
| Bool
otherwise = OccName -> SDoc
ppr_occ_name OccName
occ SDoc -> SDoc -> SDoc
<> Unique -> SDoc
ppr_underscore_unique Unique
uniq
pprModulePrefix :: PprStyle -> Module -> OccName -> SDoc
pprModulePrefix :: PprStyle -> Module -> OccName -> SDoc
pprModulePrefix PprStyle
sty Module
mod OccName
occ = (SDocContext -> Bool) -> SDoc -> SDoc
ppUnlessOption SDocContext -> Bool
sdocSuppressModulePrefixes (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
case PprStyle -> QueryQualifyName
qualName PprStyle
sty Module
mod OccName
occ of
NameQual ModuleName
modname -> ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
modname SDoc -> SDoc -> SDoc
<> SDoc
dot
QualifyName
NameNotInScope1 -> Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
mod SDoc -> SDoc -> SDoc
<> SDoc
dot
QualifyName
NameNotInScope2 -> Unit -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit Module
mod) SDoc -> SDoc -> SDoc
<> SDoc
colon
SDoc -> SDoc -> SDoc
<> ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
mod) SDoc -> SDoc -> SDoc
<> SDoc
dot
QualifyName
NameUnqual -> SDoc
empty
pprUnique :: Unique -> SDoc
pprUnique :: Unique -> SDoc
pprUnique Unique
uniq
= (SDocContext -> Bool) -> SDoc -> SDoc
ppUnlessOption SDocContext -> Bool
sdocSuppressUniques (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
Unique -> SDoc
pprUniqueAlways Unique
uniq
ppr_underscore_unique :: Unique -> SDoc
ppr_underscore_unique :: Unique -> SDoc
ppr_underscore_unique Unique
uniq
= (SDocContext -> Bool) -> SDoc -> SDoc
ppUnlessOption SDocContext -> Bool
sdocSuppressUniques (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
Char -> SDoc
char Char
'_' SDoc -> SDoc -> SDoc
<> Unique -> SDoc
pprUniqueAlways Unique
uniq
ppr_occ_name :: OccName -> SDoc
ppr_occ_name :: OccName -> SDoc
ppr_occ_name OccName
occ = FastString -> SDoc
ftext (OccName -> FastString
occNameFS OccName
occ)
ppr_z_occ_name :: OccName -> SDoc
ppr_z_occ_name :: OccName -> SDoc
ppr_z_occ_name OccName
occ = FastZString -> SDoc
ztext (FastString -> FastZString
zEncodeFS (OccName -> FastString
occNameFS OccName
occ))
pprDefinedAt :: Name -> SDoc
pprDefinedAt :: Name -> SDoc
pprDefinedAt Name
name = String -> SDoc
text String
"Defined" SDoc -> SDoc -> SDoc
<+> Name -> SDoc
pprNameDefnLoc Name
name
pprNameDefnLoc :: Name -> SDoc
pprNameDefnLoc :: Name -> SDoc
pprNameDefnLoc Name
name
= case Name -> SrcLoc
nameSrcLoc Name
name of
RealSrcLoc RealSrcLoc
s Maybe BufPos
_ -> String -> SDoc
text String
"at" SDoc -> SDoc -> SDoc
<+> RealSrcLoc -> SDoc
forall a. Outputable a => a -> SDoc
ppr RealSrcLoc
s
UnhelpfulLoc FastString
s
| Name -> Bool
isInternalName Name
name Bool -> Bool -> Bool
|| Name -> Bool
isSystemName Name
name
-> String -> SDoc
text String
"at" SDoc -> SDoc -> SDoc
<+> FastString -> SDoc
ftext FastString
s
| Bool
otherwise
-> String -> SDoc
text String
"in" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr ((() :: Constraint) => Name -> Module
Name -> Module
nameModule Name
name))
nameStableString :: Name -> String
nameStableString :: Name -> String
nameStableString Name{OccName
Unique
SrcSpan
NameSort
n_sort :: Name -> NameSort
n_occ :: Name -> OccName
n_uniq :: Name -> Unique
n_loc :: Name -> SrcSpan
n_sort :: NameSort
n_occ :: OccName
n_uniq :: Unique
n_loc :: SrcSpan
..} =
NameSort -> String
nameSortStableString NameSort
n_sort String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"$" String -> String -> String
forall a. [a] -> [a] -> [a]
++ OccName -> String
occNameString OccName
n_occ
nameSortStableString :: NameSort -> String
nameSortStableString :: NameSort -> String
nameSortStableString NameSort
System = String
"$_sys"
nameSortStableString NameSort
Internal = String
"$_in"
nameSortStableString (External Module
mod) = Module -> String
moduleStableString Module
mod
nameSortStableString (WiredIn Module
mod TyThing
_ BuiltInSyntax
_) = Module -> String
moduleStableString Module
mod
class NamedThing a where
getOccName :: a -> OccName
getName :: a -> Name
getOccName a
n = Name -> OccName
nameOccName (a -> Name
forall a. NamedThing a => a -> Name
getName a
n)
instance NamedThing e => NamedThing (Located e) where
getName :: Located e -> Name
getName = e -> Name
forall a. NamedThing a => a -> Name
getName (e -> Name) -> (Located e -> e) -> Located e -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located e -> e
forall l e. GenLocated l e -> e
unLoc
getSrcLoc :: NamedThing a => a -> SrcLoc
getSrcSpan :: NamedThing a => a -> SrcSpan
getOccString :: NamedThing a => a -> String
getOccFS :: NamedThing a => a -> FastString
getSrcLoc :: forall a. NamedThing a => a -> SrcLoc
getSrcLoc = Name -> SrcLoc
nameSrcLoc (Name -> SrcLoc) -> (a -> Name) -> a -> SrcLoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Name
forall a. NamedThing a => a -> Name
getName
getSrcSpan :: forall a. NamedThing a => a -> SrcSpan
getSrcSpan = Name -> SrcSpan
nameSrcSpan (Name -> SrcSpan) -> (a -> Name) -> a -> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Name
forall a. NamedThing a => a -> Name
getName
getOccString :: forall a. NamedThing a => a -> String
getOccString = OccName -> String
occNameString (OccName -> String) -> (a -> OccName) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> OccName
forall a. NamedThing a => a -> OccName
getOccName
getOccFS :: forall a. NamedThing a => a -> FastString
getOccFS = OccName -> FastString
occNameFS (OccName -> FastString) -> (a -> OccName) -> a -> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> OccName
forall a. NamedThing a => a -> OccName
getOccName
pprInfixName :: (Outputable a, NamedThing a) => a -> SDoc
pprInfixName :: forall a. (Outputable a, NamedThing a) => a -> SDoc
pprInfixName a
n = Bool -> SDoc -> SDoc
pprInfixVar (OccName -> Bool
isSymOcc (a -> OccName
forall a. NamedThing a => a -> OccName
getOccName a
n)) (a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
n)
pprPrefixName :: NamedThing a => a -> SDoc
pprPrefixName :: forall a. NamedThing a => a -> SDoc
pprPrefixName a
thing = Bool -> SDoc -> SDoc
pprPrefixVar (OccName -> Bool
isSymOcc (Name -> OccName
nameOccName Name
name)) (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name)
where
name :: Name
name = a -> Name
forall a. NamedThing a => a -> Name
getName a
thing