module GHC.Types.Name.Ppr
( mkNamePprCtx
, mkQualModule
, mkQualPackage
, pkgQual
)
where
import GHC.Prelude
import GHC.Data.FastString
import GHC.Unit
import GHC.Unit.Env
import GHC.Types.Name
import GHC.Types.Name.Reader
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Utils.Misc
import GHC.Builtin.Types.Prim ( fUNTyConName )
import GHC.Builtin.Types
import Data.Maybe (isJust)
mkNamePprCtx :: Outputable info => PromotionTickContext -> UnitEnv -> GlobalRdrEnvX info -> NamePprCtx
mkNamePprCtx :: forall info.
Outputable info =>
PromotionTickContext -> UnitEnv -> GlobalRdrEnvX info -> NamePprCtx
mkNamePprCtx PromotionTickContext
ptc UnitEnv
unit_env GlobalRdrEnvX info
env
= QueryQualifyName
-> QueryQualifyModule
-> QueryQualifyPackage
-> QueryPromotionTick
-> NamePprCtx
QueryQualify
(GlobalRdrEnvX info -> QueryQualifyName
forall info.
Outputable info =>
GlobalRdrEnvX info -> QueryQualifyName
mkQualName GlobalRdrEnvX info
env)
(UnitState -> Maybe HomeUnit -> QueryQualifyModule
mkQualModule UnitState
unit_state Maybe HomeUnit
home_unit)
(UnitState -> QueryQualifyPackage
mkQualPackage UnitState
unit_state)
(PromotionTickContext -> GlobalRdrEnvX info -> QueryPromotionTick
forall info.
PromotionTickContext -> GlobalRdrEnvX info -> QueryPromotionTick
mkPromTick PromotionTickContext
ptc GlobalRdrEnvX info
env)
where
unit_state :: UnitState
unit_state = HasDebugCallStack => UnitEnv -> UnitState
UnitEnv -> UnitState
ue_units UnitEnv
unit_env
home_unit :: Maybe HomeUnit
home_unit = UnitEnv -> Maybe HomeUnit
ue_homeUnit UnitEnv
unit_env
mkQualName :: Outputable info => GlobalRdrEnvX info -> QueryQualifyName
mkQualName :: forall info.
Outputable info =>
GlobalRdrEnvX info -> QueryQualifyName
mkQualName GlobalRdrEnvX info
env = QueryQualifyName
qual_name where
qual_name :: QueryQualifyName
qual_name Module
mod OccName
occ
| [GlobalRdrEltX info
gre] <- [GlobalRdrEltX info]
unqual_gres
, GlobalRdrEltX info -> Bool
right_name GlobalRdrEltX info
gre
= QualifyName
NameUnqual
| [] <- [GlobalRdrEltX info]
unqual_gres
, Bool
pretendNameIsInScopeForPpr
, Bool -> Bool
not (OccName -> Bool
isDerivedOccName OccName
occ)
= QualifyName
NameUnqual
| [GlobalRdrEltX info
gre] <- [GlobalRdrEltX info]
qual_gres
= ModuleName -> QualifyName
NameQual (GlobalRdrEltX info -> ModuleName
forall info. Outputable info => GlobalRdrEltX info -> ModuleName
greQualModName GlobalRdrEltX info
gre)
| [GlobalRdrEltX info] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GlobalRdrEltX info]
qual_gres
= if [GlobalRdrEltX info] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([GlobalRdrEltX info] -> Bool) -> [GlobalRdrEltX info] -> Bool
forall a b. (a -> b) -> a -> b
$ GlobalRdrEnvX info -> LookupGRE info -> [GlobalRdrEltX info]
forall info.
GlobalRdrEnvX info -> LookupGRE info -> [GlobalRdrEltX info]
lookupGRE GlobalRdrEnvX info
env (LookupGRE info -> [GlobalRdrEltX info])
-> LookupGRE info -> [GlobalRdrEltX info]
forall a b. (a -> b) -> a -> b
$
RdrName -> WhichGREs info -> LookupGRE info
forall info. RdrName -> WhichGREs info -> LookupGRE info
LookupRdrName (ModuleName -> OccName -> RdrName
mkRdrQual (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
mod) OccName
occ) WhichGREs info
forall info. WhichGREs info
SameNameSpace
then QualifyName
NameNotInScope1
else QualifyName
NameNotInScope2
| Bool
otherwise
= QualifyName
NameNotInScope1
where
is_name :: Name -> Bool
is_name :: Name -> Bool
is_name Name
name = Bool -> SDoc -> Bool -> Bool
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (Name -> Bool
isExternalName Name
name) (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
HasDebugCallStack => Name -> Module
Name -> Module
nameModule Name
name Module -> QueryQualifyModule
forall a. Eq a => a -> a -> Bool
== Module
mod Bool -> Bool -> Bool
&& Name -> OccName
nameOccName Name
name OccName -> OccName -> Bool
forall a. Eq a => a -> a -> Bool
== OccName
occ
pretendNameIsInScopeForPpr :: Bool
pretendNameIsInScopeForPpr :: Bool
pretendNameIsInScopeForPpr =
(Name -> Bool) -> [Name] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Name -> Bool
is_name
[ Name
liftedTypeKindTyConName
, Name
constraintKindTyConName
, Name
heqTyConName
, Name
coercibleTyConName
, Name
eqTyConName
, Name
tYPETyConName
, Name
fUNTyConName, Name
unrestrictedFunTyConName
, Name
oneDataConName
, Name
listTyConName
, Name
manyDataConName ]
Bool -> Bool -> Bool
|| Maybe Name -> Bool
forall a. Maybe a -> Bool
isJust (Module -> OccName -> Maybe Name
isTupleTyOcc_maybe Module
mod OccName
occ)
Bool -> Bool -> Bool
|| Maybe Name -> Bool
forall a. Maybe a -> Bool
isJust (Module -> OccName -> Maybe Name
isSumTyOcc_maybe Module
mod OccName
occ)
right_name :: GlobalRdrEltX info -> Bool
right_name GlobalRdrEltX info
gre = GlobalRdrEltX info -> Maybe Module
forall info. GlobalRdrEltX info -> Maybe Module
greDefinitionModule GlobalRdrEltX info
gre Maybe Module -> Maybe Module -> Bool
forall a. Eq a => a -> a -> Bool
== Module -> Maybe Module
forall a. a -> Maybe a
Just Module
mod
unqual_gres :: [GlobalRdrEltX info]
unqual_gres = GlobalRdrEnvX info -> LookupGRE info -> [GlobalRdrEltX info]
forall info.
GlobalRdrEnvX info -> LookupGRE info -> [GlobalRdrEltX info]
lookupGRE GlobalRdrEnvX info
env (RdrName -> WhichGREs info -> LookupGRE info
forall info. RdrName -> WhichGREs info -> LookupGRE info
LookupRdrName (OccName -> RdrName
mkRdrUnqual OccName
occ) WhichGREs info
forall info. WhichGREs info
SameNameSpace)
qual_gres :: [GlobalRdrEltX info]
qual_gres = (GlobalRdrEltX info -> Bool)
-> [GlobalRdrEltX info] -> [GlobalRdrEltX info]
forall a. (a -> Bool) -> [a] -> [a]
filter GlobalRdrEltX info -> Bool
right_name (GlobalRdrEnvX info -> LookupGRE info -> [GlobalRdrEltX info]
forall info.
GlobalRdrEnvX info -> LookupGRE info -> [GlobalRdrEltX info]
lookupGRE GlobalRdrEnvX info
env (OccName -> WhichGREs info -> LookupGRE info
forall info. OccName -> WhichGREs info -> LookupGRE info
LookupOccName OccName
occ WhichGREs info
forall info. WhichGREs info
SameNameSpace))
mkPromTick :: PromotionTickContext -> GlobalRdrEnvX info -> QueryPromotionTick
mkPromTick :: forall info.
PromotionTickContext -> GlobalRdrEnvX info -> QueryPromotionTick
mkPromTick PromotionTickContext
ptc GlobalRdrEnvX info
env
| PromotionTickContext -> Bool
ptcPrintRedundantPromTicks PromotionTickContext
ptc = QueryPromotionTick
alwaysPrintPromTick
| Bool
otherwise = QueryPromotionTick
print_prom_tick
where
print_prom_tick :: QueryPromotionTick
print_prom_tick (PromotedItemListSyntax (IsEmptyOrSingleton Bool
eos)) =
PromotionTickContext -> Bool
ptcListTuplePuns PromotionTickContext
ptc Bool -> Bool -> Bool
&& Bool
eos
print_prom_tick PromotedItem
PromotedItemTupleSyntax =
PromotionTickContext -> Bool
ptcListTuplePuns PromotionTickContext
ptc
print_prom_tick (PromotedItemDataCon OccName
occ)
| OccName -> Bool
isPunnedDataConName OccName
occ
= PromotionTickContext -> Bool
ptcListTuplePuns PromotionTickContext
ptc
| Just OccName
occ' <- OccName -> Maybe OccName
promoteOccName OccName
occ
, [] <- GlobalRdrEnvX info -> LookupGRE info -> [GlobalRdrEltX info]
forall info.
GlobalRdrEnvX info -> LookupGRE info -> [GlobalRdrEltX info]
lookupGRE GlobalRdrEnvX info
env (RdrName -> WhichGREs info -> LookupGRE info
forall info. RdrName -> WhichGREs info -> LookupGRE info
LookupRdrName (OccName -> RdrName
mkRdrUnqual OccName
occ') WhichGREs info
forall info. WhichGREs info
SameNameSpace)
=
Bool
False
| Bool
otherwise = Bool
True
isPunnedDataConName :: OccName -> Bool
isPunnedDataConName :: OccName -> Bool
isPunnedDataConName OccName
occ =
OccName -> Bool
isDataOcc OccName
occ Bool -> Bool -> Bool
&& case FastString -> String
unpackFS (OccName -> FastString
occNameFS OccName
occ) of
Char
'[':String
_ -> Bool
True
Char
'(':String
_ -> Bool
True
String
_ -> Bool
False
mkQualModule :: UnitState -> Maybe HomeUnit -> QueryQualifyModule
mkQualModule :: UnitState -> Maybe HomeUnit -> QueryQualifyModule
mkQualModule UnitState
unit_state Maybe HomeUnit
mhome_unit Module
mod
| Just HomeUnit
home_unit <- Maybe HomeUnit
mhome_unit
, HomeUnit -> QueryQualifyModule
isHomeModule HomeUnit
home_unit Module
mod = Bool
False
| [(Module
_, UnitInfo
pkgconfig)] <- [(Module, UnitInfo)]
lookup,
UnitInfo -> Unit
mkUnit UnitInfo
pkgconfig Unit -> QueryQualifyPackage
forall a. Eq a => a -> a -> Bool
== Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit Module
mod
= Bool
False
| Bool
otherwise = Bool
True
where lookup :: [(Module, UnitInfo)]
lookup = UnitState -> ModuleName -> [(Module, UnitInfo)]
lookupModuleInAllUnits UnitState
unit_state (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
mod)
mkQualPackage :: UnitState -> QueryQualifyPackage
mkQualPackage :: UnitState -> QueryQualifyPackage
mkQualPackage UnitState
pkgs Unit
uid
| Unit
uid Unit -> QueryQualifyPackage
forall a. Eq a => a -> a -> Bool
== Unit
mainUnit Bool -> Bool -> Bool
|| Unit
uid Unit -> QueryQualifyPackage
forall a. Eq a => a -> a -> Bool
== Unit
interactiveUnit
= Bool
False
| Just PackageId
pkgid <- Maybe PackageId
mb_pkgid
, UnitState -> PackageId -> [UnitInfo]
searchPackageId UnitState
pkgs PackageId
pkgid [UnitInfo] -> Int -> Bool
forall a. [a] -> Int -> Bool
`lengthIs` Int
1
= Bool
False
| Bool
otherwise
= Bool
True
where mb_pkgid :: Maybe PackageId
mb_pkgid = (UnitInfo -> PackageId) -> Maybe UnitInfo -> Maybe PackageId
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UnitInfo -> PackageId
forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> srcpkgid
unitPackageId (UnitState -> Unit -> Maybe UnitInfo
lookupUnit UnitState
pkgs Unit
uid)
pkgQual :: UnitState -> NamePprCtx
pkgQual :: UnitState -> NamePprCtx
pkgQual UnitState
pkgs = NamePprCtx
alwaysQualify { queryQualifyPackage = mkQualPackage pkgs }