{-# 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,
namePun_maybe,
pprName,
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 {-# 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
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
_) = forall doc. IsLine doc => String -> doc
text String
"external"
ppr (WiredIn Module
_ TyThing
_ BuiltInSyntax
_) = forall doc. IsLine doc => String -> doc
text String
"wired-in"
ppr NameSort
Internal = forall doc. IsLine doc => String -> doc
text String
"internal"
ppr NameSort
System = forall doc. IsLine doc => String -> doc
text String
"system"
instance NFData Name where
rnf :: Name -> ()
rnf Name{OccName
SrcSpan
Unique
NameSort
n_loc :: SrcSpan
n_uniq :: Unique
n_occ :: OccName
n_sort :: NameSort
n_loc :: Name -> SrcSpan
n_uniq :: Name -> Unique
n_occ :: Name -> OccName
n_sort :: Name -> NameSort
..} = forall a. NFData a => a -> ()
rnf NameSort
n_sort seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf OccName
n_occ seq :: forall a b. a -> b -> b
`seq` Unique
n_uniq seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf SrcSpan
n_loc
instance NFData NameSort where
rnf :: NameSort -> ()
rnf (External Module
m) = forall a. NFData a => a -> ()
rnf Module
m
rnf (WiredIn Module
m TyThing
t BuiltInSyntax
b) = forall a. NFData a => a -> ()
rnf Module
m seq :: forall a b. a -> b -> b
`seq` TyThing
t seq :: forall a b. a -> b -> b
`seq` BuiltInSyntax
b seq :: 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
_}) = forall a. a -> Maybe a
Just TyThing
thing
wiredInNameTyThing_maybe Name
_ = 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 = forall u. GenModule (GenUnit u) -> Bool
isHoleModule forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasDebugCallStack => 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 -> forall unit. GenModule unit -> unit
moduleUnit Module
mod forall a. Eq a => a -> a -> Bool
/= forall unit. GenModule unit -> unit
moduleUnit Module
this_mod
OS
_ -> Module
mod forall a. Eq a => a -> a -> Bool
/= Module
this_mod
| Bool
otherwise = Bool
False
nameModule :: HasDebugCallStack => Name -> Module
nameModule Name
name =
Name -> Maybe Module
nameModule_maybe Name
name forall a. Maybe a -> a -> a
`orElse`
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"nameModule" (forall a. Outputable a => a -> SDoc
ppr (Name -> NameSort
n_sort Name
name) forall doc. IsLine doc => doc -> doc -> doc
<+> 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}) = forall a. a -> Maybe a
Just Module
mod
nameModule_maybe (Name { n_sort :: Name -> NameSort
n_sort = WiredIn Module
mod TyThing
_ BuiltInSyntax
_}) = forall a. a -> Maybe a
Just Module
mod
nameModule_maybe Name
_ = 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 forall a. Eq a => a -> a -> Bool
== Module
mod Bool -> Bool -> Bool
|| Module -> Bool
isInteractiveModule Module
mod
namePun_maybe :: Name -> Maybe FastString
namePun_maybe :: Name -> Maybe FastString
namePun_maybe Name
name | forall a. Uniquable a => a -> Unique
getUnique Name
name forall a. Eq a => a -> a -> Bool
== forall a. Uniquable a => a -> Unique
getUnique TyCon
listTyCon = forall a. a -> Maybe a
Just (String -> FastString
fsLit String
"[]")
namePun_maybe Name
_ = forall a. Maybe a
Nothing
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 -> forall unit. GenModule unit -> unit
moduleUnit Module
nm_mod forall a. Eq a => a -> a -> Bool
== Unit
this_pkg
WiredIn Module
nm_mod TyThing
_ BuiltInSyntax
_ -> forall unit. GenModule unit -> unit
moduleUnit Module
nm_mod forall a. Eq a => a -> a -> Bool
== Unit
this_pkg
NameSort
Internal -> Bool
True
NameSort
System -> Bool
False
where
this_pkg :: Unit
this_pkg = 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 forall a. Eq a => a -> a -> Bool
/= Module
this_mod
Bool -> Bool -> Bool
&& forall unit. GenModule unit -> unit
moduleUnit Module
nm_mod forall a. Eq a => a -> a -> Bool
== Unit
this_pkg
where
this_pkg :: Unit
this_pkg = 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 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 -> FastString -> Name
mkFCallName :: Unique -> FastString -> Name
mkFCallName Unique
uniq FastString
str = Unique -> OccName -> SrcSpan -> Name
mkInternalName Unique
uniq (FastString -> OccName
mkVarOccFS FastString
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 -> NameSort -> Ordering
sort_cmp NameSort
s1 NameSort
s2 forall a. Semigroup a => a -> a -> a
S.<> forall a. Ord a => a -> a -> Ordering
compare OccName
occ1 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 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 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
_ = 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 = forall doc. IsLine doc => Name -> doc
pprName Name
name
instance OutputableBndr Name where
pprBndr :: BindingSite -> Name -> SDoc
pprBndr BindingSite
_ Name
name = forall doc. IsLine doc => Name -> doc
pprName Name
name
pprInfixOcc :: Name -> SDoc
pprInfixOcc = forall a. (Outputable a, NamedThing a) => a -> SDoc
pprInfixName
pprPrefixOcc :: Name -> SDoc
pprPrefixOcc = forall a. NamedThing a => a -> SDoc
pprPrefixName
pprName :: forall doc. IsLine doc => Name -> doc
pprName :: forall doc. IsLine doc => Name -> doc
pprName name :: Name
name@(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})
= forall doc. IsOutput doc => (SDocContext -> doc) -> doc
docWithContext forall a b. (a -> b) -> a -> b
$ \SDocContext
ctx ->
let sty :: PprStyle
sty = SDocContext -> PprStyle
sdocStyle SDocContext
ctx
debug :: Bool
debug = SDocContext -> Bool
sdocPprDebug SDocContext
ctx
listTuplePuns :: Bool
listTuplePuns = SDocContext -> Bool
sdocListTuplePuns SDocContext
ctx
in Bool -> Maybe FastString -> doc -> doc
handlePuns Bool
listTuplePuns (Name -> Maybe FastString
namePun_maybe Name
name) forall a b. (a -> b) -> a -> b
$
case NameSort
sort of
WiredIn Module
mod TyThing
_ BuiltInSyntax
builtin -> forall doc.
IsLine doc =>
Bool
-> PprStyle
-> Unique
-> Module
-> OccName
-> Bool
-> BuiltInSyntax
-> doc
pprExternal Bool
debug PprStyle
sty Unique
uniq Module
mod OccName
occ Bool
True BuiltInSyntax
builtin
External Module
mod -> forall doc.
IsLine doc =>
Bool
-> PprStyle
-> Unique
-> Module
-> OccName
-> Bool
-> BuiltInSyntax
-> doc
pprExternal Bool
debug PprStyle
sty Unique
uniq Module
mod OccName
occ Bool
False BuiltInSyntax
UserSyntax
NameSort
System -> forall doc.
IsLine doc =>
Bool -> PprStyle -> Unique -> OccName -> doc
pprSystem Bool
debug PprStyle
sty Unique
uniq OccName
occ
NameSort
Internal -> forall doc.
IsLine doc =>
Bool -> PprStyle -> Unique -> OccName -> doc
pprInternal Bool
debug PprStyle
sty Unique
uniq OccName
occ
where
handlePuns :: Bool -> Maybe FastString -> doc -> doc
handlePuns :: Bool -> Maybe FastString -> doc -> doc
handlePuns Bool
True (Just FastString
pun) doc
_ = forall doc. IsLine doc => FastString -> doc
ftext FastString
pun
handlePuns Bool
_ Maybe FastString
_ doc
r = doc
r
{-# SPECIALISE pprName :: Name -> SDoc #-}
{-# SPECIALISE pprName :: Name -> HLine #-}
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 forall doc. IsLine doc => FastString -> doc
ftext (UnitId -> FastString
unitIdFS (Module -> UnitId
moduleUnitId Module
mod))
forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
colon forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => FastString -> doc
ftext (ModuleName -> FastString
moduleNameFS forall a b. (a -> b) -> a -> b
$ forall unit. GenModule unit -> ModuleName
moduleName Module
mod)
forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
dot forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => FastString -> doc
ftext (OccName -> FastString
occNameFS OccName
occ)
forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => Char -> doc
char Char
'_' forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => Unique -> doc
pprUniqueAlways Unique
uniq
pprTickyName :: Module -> Name -> SDoc
pprTickyName :: Module -> Name -> SDoc
pprTickyName Module
this_mod Name
name
| Name -> Bool
isInternalName Name
name = forall doc. IsLine doc => Name -> doc
pprName Name
name forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => doc -> doc
parens (forall a. Outputable a => a -> SDoc
ppr Module
this_mod)
| Bool
otherwise = forall doc. IsLine doc => Name -> doc
pprName Name
name
pprNameUnqualified :: Name -> SDoc
pprNameUnqualified :: Name -> SDoc
pprNameUnqualified Name { n_occ :: Name -> OccName
n_occ = OccName
occ } = forall doc. IsLine doc => OccName -> doc
ppr_occ_name OccName
occ
pprExternal :: IsLine doc => Bool -> PprStyle -> Unique -> Module -> OccName -> Bool -> BuiltInSyntax -> doc
pprExternal :: forall doc.
IsLine doc =>
Bool
-> PprStyle
-> Unique
-> Module
-> OccName
-> Bool
-> BuiltInSyntax
-> doc
pprExternal Bool
debug PprStyle
sty Unique
uniq Module
mod OccName
occ Bool
is_wired BuiltInSyntax
is_builtin
| PprStyle -> Bool
codeStyle PprStyle
sty = forall doc. IsLine doc => Module -> doc
pprModule Module
mod forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => Char -> doc
char Char
'_' forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => OccName -> doc
ppr_z_occ_name OccName
occ
| Bool
debug = doc
pp_mod forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => OccName -> doc
ppr_occ_name OccName
occ
forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc -> doc
braces (forall doc. IsLine doc => [doc] -> doc
hsep [if Bool
is_wired then forall doc. IsLine doc => String -> doc
text String
"(w)" else forall doc. IsOutput doc => doc
empty,
forall doc. IsLine doc => NameSpace -> doc
pprNameSpaceBrief (OccName -> NameSpace
occNameSpace OccName
occ),
forall doc. IsLine doc => Unique -> doc
pprUnique Unique
uniq])
| BuiltInSyntax
BuiltInSyntax <- BuiltInSyntax
is_builtin = forall doc. IsLine doc => OccName -> doc
ppr_occ_name OccName
occ
| Bool
otherwise =
if forall u. GenModule (GenUnit u) -> Bool
isHoleModule Module
mod
then case PprStyle -> QueryQualifyName
qualName PprStyle
sty Module
mod OccName
occ of
QualifyName
NameUnqual -> forall doc. IsLine doc => OccName -> doc
ppr_occ_name OccName
occ
QualifyName
_ -> forall doc. IsLine doc => doc -> doc
braces (forall doc. IsLine doc => ModuleName -> doc
pprModuleName (forall unit. GenModule unit -> ModuleName
moduleName Module
mod) forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
dot forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => OccName -> doc
ppr_occ_name OccName
occ)
else forall doc. IsLine doc => PprStyle -> Module -> OccName -> doc
pprModulePrefix PprStyle
sty Module
mod OccName
occ forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => OccName -> doc
ppr_occ_name OccName
occ
where
pp_mod :: doc
pp_mod = forall doc. IsLine doc => (SDocContext -> Bool) -> doc -> doc
ppUnlessOption SDocContext -> Bool
sdocSuppressModulePrefixes
(forall doc. IsLine doc => Module -> doc
pprModule Module
mod forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
dot)
pprInternal :: IsLine doc => Bool -> PprStyle -> Unique -> OccName -> doc
pprInternal :: forall doc.
IsLine doc =>
Bool -> PprStyle -> Unique -> OccName -> doc
pprInternal Bool
debug PprStyle
sty Unique
uniq OccName
occ
| PprStyle -> Bool
codeStyle PprStyle
sty = forall doc. IsLine doc => Unique -> doc
pprUniqueAlways Unique
uniq
| Bool
debug = forall doc. IsLine doc => OccName -> doc
ppr_occ_name OccName
occ forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc -> doc
braces (forall doc. IsLine doc => [doc] -> doc
hsep [forall doc. IsLine doc => NameSpace -> doc
pprNameSpaceBrief (OccName -> NameSpace
occNameSpace OccName
occ),
forall doc. IsLine doc => Unique -> doc
pprUnique Unique
uniq])
| PprStyle -> Bool
dumpStyle PprStyle
sty = forall doc. IsLine doc => OccName -> doc
ppr_occ_name OccName
occ forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => Unique -> doc
ppr_underscore_unique Unique
uniq
| Bool
otherwise = forall doc. IsLine doc => OccName -> doc
ppr_occ_name OccName
occ
pprSystem :: IsLine doc => Bool -> PprStyle -> Unique -> OccName -> doc
pprSystem :: forall doc.
IsLine doc =>
Bool -> PprStyle -> Unique -> OccName -> doc
pprSystem Bool
debug PprStyle
sty Unique
uniq OccName
occ
| PprStyle -> Bool
codeStyle PprStyle
sty = forall doc. IsLine doc => Unique -> doc
pprUniqueAlways Unique
uniq
| Bool
debug = forall doc. IsLine doc => OccName -> doc
ppr_occ_name OccName
occ forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => Unique -> doc
ppr_underscore_unique Unique
uniq
forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc -> doc
braces (forall doc. IsLine doc => NameSpace -> doc
pprNameSpaceBrief (OccName -> NameSpace
occNameSpace OccName
occ))
| Bool
otherwise = forall doc. IsLine doc => OccName -> doc
ppr_occ_name OccName
occ forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => Unique -> doc
ppr_underscore_unique Unique
uniq
pprModulePrefix :: IsLine doc => PprStyle -> Module -> OccName -> doc
pprModulePrefix :: forall doc. IsLine doc => PprStyle -> Module -> OccName -> doc
pprModulePrefix PprStyle
sty Module
mod OccName
occ = forall doc. IsLine doc => (SDocContext -> Bool) -> doc -> doc
ppUnlessOption SDocContext -> Bool
sdocSuppressModulePrefixes forall a b. (a -> b) -> a -> b
$
case PprStyle -> QueryQualifyName
qualName PprStyle
sty Module
mod OccName
occ of
NameQual ModuleName
modname -> forall doc. IsLine doc => ModuleName -> doc
pprModuleName ModuleName
modname forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
dot
QualifyName
NameNotInScope1 -> forall doc. IsLine doc => Module -> doc
pprModule Module
mod forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
dot
QualifyName
NameNotInScope2 -> forall doc. IsLine doc => Unit -> doc
pprUnit (forall unit. GenModule unit -> unit
moduleUnit Module
mod) forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
colon
forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => ModuleName -> doc
pprModuleName (forall unit. GenModule unit -> ModuleName
moduleName Module
mod) forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => doc
dot
QualifyName
NameUnqual -> forall doc. IsOutput doc => doc
empty
pprUnique :: IsLine doc => Unique -> doc
pprUnique :: forall doc. IsLine doc => Unique -> doc
pprUnique Unique
uniq
= forall doc. IsLine doc => (SDocContext -> Bool) -> doc -> doc
ppUnlessOption SDocContext -> Bool
sdocSuppressUniques forall a b. (a -> b) -> a -> b
$
forall doc. IsLine doc => Unique -> doc
pprUniqueAlways Unique
uniq
ppr_underscore_unique :: IsLine doc => Unique -> doc
ppr_underscore_unique :: forall doc. IsLine doc => Unique -> doc
ppr_underscore_unique Unique
uniq
= forall doc. IsLine doc => (SDocContext -> Bool) -> doc -> doc
ppUnlessOption SDocContext -> Bool
sdocSuppressUniques forall a b. (a -> b) -> a -> b
$
forall doc. IsLine doc => Char -> doc
char Char
'_' forall doc. IsLine doc => doc -> doc -> doc
<> forall doc. IsLine doc => Unique -> doc
pprUniqueAlways Unique
uniq
ppr_occ_name :: IsLine doc => OccName -> doc
ppr_occ_name :: forall doc. IsLine doc => OccName -> doc
ppr_occ_name OccName
occ = forall doc. IsLine doc => FastString -> doc
ftext (OccName -> FastString
occNameFS OccName
occ)
ppr_z_occ_name :: IsLine doc => OccName -> doc
ppr_z_occ_name :: forall doc. IsLine doc => OccName -> doc
ppr_z_occ_name OccName
occ = forall doc. IsLine doc => FastZString -> doc
ztext (FastString -> FastZString
zEncodeFS (OccName -> FastString
occNameFS OccName
occ))
pprDefinedAt :: Name -> SDoc
pprDefinedAt :: Name -> SDoc
pprDefinedAt Name
name = forall doc. IsLine doc => String -> doc
text String
"Defined" forall doc. IsLine doc => doc -> doc -> doc
<+> 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
_ -> forall doc. IsLine doc => String -> doc
text String
"at" forall doc. IsLine doc => doc -> doc -> doc
<+> 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
-> forall doc. IsLine doc => String -> doc
text String
"at" forall doc. IsLine doc => doc -> doc -> doc
<+> forall doc. IsLine doc => FastString -> doc
ftext FastString
s
| Bool
otherwise
-> forall doc. IsLine doc => String -> doc
text String
"in" forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr (HasDebugCallStack => Name -> Module
nameModule Name
name))
nameStableString :: Name -> String
nameStableString :: Name -> String
nameStableString Name{OccName
SrcSpan
Unique
NameSort
n_loc :: SrcSpan
n_uniq :: Unique
n_occ :: OccName
n_sort :: NameSort
n_loc :: Name -> SrcSpan
n_uniq :: Name -> Unique
n_occ :: Name -> OccName
n_sort :: Name -> NameSort
..} =
NameSort -> String
nameSortStableString NameSort
n_sort forall a. [a] -> [a] -> [a]
++ 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 (forall a. NamedThing a => a -> Name
getName a
n)
instance NamedThing e => NamedThing (Located e) where
getName :: Located e -> Name
getName = forall a. NamedThing a => a -> Name
getName forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NamedThing a => a -> Name
getName
getSrcSpan :: forall a. NamedThing a => a -> SrcSpan
getSrcSpan = Name -> SrcSpan
nameSrcSpan forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NamedThing a => a -> Name
getName
getOccString :: forall a. NamedThing a => a -> String
getOccString = OccName -> String
occNameString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NamedThing a => a -> OccName
getOccName
getOccFS :: forall a. NamedThing a => a -> FastString
getOccFS = OccName -> FastString
occNameFS forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 (forall a. NamedThing a => a -> OccName
getOccName a
n)) (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)) (forall a. Outputable a => a -> SDoc
ppr Name
name)
where
name :: Name
name = forall a. NamedThing a => a -> Name
getName a
thing