{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE PatternSynonyms #-}
module 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,
isSystemName, isInternalName, isExternalName,
isTyVarName, isTyConName, isDataConName,
isValName, isVarName,
isWiredInName, isBuiltInSyntax,
isHoleName,
wiredInNameTyThing_maybe,
nameIsLocalOrFrom, nameIsHomePackage,
nameIsHomePackageImport, nameIsFromExternalPackage,
stableNameCmp,
NamedThing(..),
getSrcLoc, getSrcSpan, getOccString, getOccFS,
pprInfixName, pprPrefixName, pprModulePrefix, pprNameUnqualified,
nameStableString,
module OccName
) where
import GhcPrelude
import {-# SOURCE #-} TyCoRep( TyThing )
import OccName
import Module
import SrcLoc
import Unique
import Util
import Maybes
import Binary
import DynFlags
import FastString
import Outputable
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
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 -> ()
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 () -> () -> ()
`seq` TyThing
t TyThing -> () -> ()
`seq` BuiltInSyntax
b BuiltInSyntax -> () -> ()
`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
type instance SrcSpanLess Name = Name
instance HasSrcSpan Name where
composeSrcSpan :: Located (SrcSpanLess Name) -> Name
composeSrcSpan (L SrcSpan
sp SrcSpanLess Name
n) = Name
SrcSpanLess Name
n {n_loc :: SrcSpan
n_loc = SrcSpan
sp}
decomposeSrcSpan :: Name -> Located (SrcSpanLess Name)
decomposeSrcSpan Name
n = SrcSpan -> Name -> GenLocated SrcSpan Name
forall l e. l -> e -> GenLocated l e
L (Name -> SrcSpan
n_loc Name
n) Name
n
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
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
isHoleModule (Module -> Bool) -> (Name -> Module) -> Name -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasDebugCallStack => Name -> Module
Name -> Module
nameModule
nameModule :: 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
nameIsLocalOrFrom :: Module -> Name -> Bool
nameIsLocalOrFrom :: Module -> Name -> Bool
nameIsLocalOrFrom Module
from Name
name
| Just Module
mod <- Name -> Maybe Module
nameModule_maybe Name
name = Module
from Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
== Module
mod Bool -> Bool -> Bool
|| Module -> Bool
isInteractiveModule Module
mod
| Bool
otherwise = Bool
True
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 -> UnitId
moduleUnitId Module
nm_mod UnitId -> UnitId -> Bool
forall a. Eq a => a -> a -> Bool
== UnitId
this_pkg
WiredIn Module
nm_mod TyThing
_ BuiltInSyntax
_ -> Module -> UnitId
moduleUnitId Module
nm_mod UnitId -> UnitId -> Bool
forall a. Eq a => a -> a -> Bool
== UnitId
this_pkg
NameSort
Internal -> Bool
True
NameSort
System -> Bool
False
where
this_pkg :: UnitId
this_pkg = Module -> UnitId
moduleUnitId 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 -> UnitId
moduleUnitId Module
nm_mod UnitId -> UnitId -> Bool
forall a. Eq a => a -> a -> Bool
== UnitId
this_pkg
where
this_pkg :: UnitId
this_pkg = Module -> UnitId
moduleUnitId Module
this_mod
nameIsFromExternalPackage :: UnitId -> Name -> Bool
nameIsFromExternalPackage :: UnitId -> Name -> Bool
nameIsFromExternalPackage UnitId
this_pkg Name
name
| Just Module
mod <- Name -> Maybe Module
nameModule_maybe Name
name
, Module -> UnitId
moduleUnitId Module
mod UnitId -> UnitId -> Bool
forall a. Eq a => a -> a -> Bool
/= UnitId
this_pkg
, 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 :: NameSort -> OccName -> Unique -> SrcSpan -> Name
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 :: NameSort -> OccName -> Unique -> SrcSpan -> Name
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 :: NameSort -> OccName -> Unique -> SrcSpan -> Name
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
mkExternalName :: Unique -> Module -> OccName -> SrcSpan -> Name
mkExternalName Unique
uniq Module
mod OccName
occ SrcSpan
loc
= Name :: NameSort -> OccName -> Unique -> SrcSpan -> Name
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
mkWiredInName :: Module -> OccName -> Unique -> TyThing -> BuiltInSyntax -> Name
mkWiredInName Module
mod OccName
occ Unique
uniq TyThing
thing BuiltInSyntax
built_in
= Name :: NameSort -> OccName -> Unique -> SrcSpan -> Name
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 :: NameSort -> OccName -> Unique -> SrcSpan -> Name
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
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
LT -> Bool
True; Ordering
EQ -> Bool
True; Ordering
GT -> 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
LT -> Bool
True; Ordering
EQ -> Bool
False; Ordering
GT -> 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
LT -> Bool
False; Ordering
EQ -> Bool
True; Ordering
GT -> Bool
True }
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
LT -> Bool
False; Ordering
EQ -> Bool
False; Ordering
GT -> Bool
True }
compare :: Name -> Name -> Ordering
compare Name
a Name
b = Name -> Name -> Ordering
cmpName Name
a Name
b
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 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 ->
case NameSort
sort of
WiredIn Module
mod TyThing
_ BuiltInSyntax
builtin -> PprStyle
-> Unique -> Module -> OccName -> Bool -> BuiltInSyntax -> SDoc
pprExternal PprStyle
sty Unique
uniq Module
mod OccName
occ Bool
True BuiltInSyntax
builtin
External Module
mod -> PprStyle
-> Unique -> Module -> OccName -> Bool -> BuiltInSyntax -> SDoc
pprExternal PprStyle
sty Unique
uniq Module
mod OccName
occ Bool
False BuiltInSyntax
UserSyntax
NameSort
System -> PprStyle -> Unique -> OccName -> SDoc
pprSystem PprStyle
sty Unique
uniq OccName
occ
NameSort
Internal -> PprStyle -> Unique -> OccName -> SDoc
pprInternal PprStyle
sty Unique
uniq OccName
occ
pprNameUnqualified :: Name -> SDoc
pprNameUnqualified :: Name -> SDoc
pprNameUnqualified Name { n_occ :: Name -> OccName
n_occ = OccName
occ } = OccName -> SDoc
ppr_occ_name OccName
occ
pprExternal :: PprStyle -> Unique -> Module -> OccName -> Bool -> BuiltInSyntax -> SDoc
pprExternal :: PprStyle
-> Unique -> Module -> OccName -> Bool -> BuiltInSyntax -> SDoc
pprExternal 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
| PprStyle -> Bool
debugStyle PprStyle
sty = 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
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
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 = (DynFlags -> SDoc) -> SDoc
sdocWithDynFlags ((DynFlags -> SDoc) -> SDoc) -> (DynFlags -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \DynFlags
dflags ->
if GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_SuppressModulePrefixes DynFlags
dflags
then SDoc
empty
else Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
mod SDoc -> SDoc -> SDoc
<> SDoc
dot
pprInternal :: PprStyle -> Unique -> OccName -> SDoc
pprInternal :: PprStyle -> Unique -> OccName -> SDoc
pprInternal PprStyle
sty Unique
uniq OccName
occ
| PprStyle -> Bool
codeStyle PprStyle
sty = Unique -> SDoc
pprUniqueAlways Unique
uniq
| PprStyle -> Bool
debugStyle PprStyle
sty = 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 :: PprStyle -> Unique -> OccName -> SDoc
pprSystem :: PprStyle -> Unique -> OccName -> SDoc
pprSystem PprStyle
sty Unique
uniq OccName
occ
| PprStyle -> Bool
codeStyle PprStyle
sty = Unique -> SDoc
pprUniqueAlways Unique
uniq
| PprStyle -> Bool
debugStyle PprStyle
sty = 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 = (DynFlags -> SDoc) -> SDoc
sdocWithDynFlags ((DynFlags -> SDoc) -> SDoc) -> (DynFlags -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \DynFlags
dflags ->
if GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_SuppressModulePrefixes DynFlags
dflags
then SDoc
empty
else
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 -> UnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Module -> UnitId
moduleUnitId Module
mod) SDoc -> SDoc -> SDoc
<> SDoc
colon
SDoc -> SDoc -> SDoc
<> ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Module -> ModuleName
moduleName Module
mod) SDoc -> SDoc -> SDoc
<> SDoc
dot
QualifyName
NameUnqual -> SDoc
empty
pprUnique :: Unique -> SDoc
pprUnique :: Unique -> SDoc
pprUnique Unique
uniq
= (DynFlags -> SDoc) -> SDoc
sdocWithDynFlags ((DynFlags -> SDoc) -> SDoc) -> (DynFlags -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \DynFlags
dflags ->
Bool -> SDoc -> SDoc
ppUnless (GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_SuppressUniques DynFlags
dflags) (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
= (DynFlags -> SDoc) -> SDoc
sdocWithDynFlags ((DynFlags -> SDoc) -> SDoc) -> (DynFlags -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \DynFlags
dflags ->
Bool -> SDoc -> SDoc
ppUnless (GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_SuppressUniques DynFlags
dflags) (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 -> 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 (HasDebugCallStack => Name -> Module
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 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 a. HasSrcSpan a => a -> SrcSpanLess a
unLoc
getSrcLoc :: NamedThing a => a -> SrcLoc
getSrcSpan :: NamedThing a => a -> SrcSpan
getOccString :: NamedThing a => a -> String
getOccFS :: NamedThing a => a -> FastString
getSrcLoc :: 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 :: 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 :: 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 :: 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 :: 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 :: 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