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
mkNamePprCtx :: PromotionTickContext -> UnitEnv -> GlobalRdrEnv -> NamePprCtx
mkNamePprCtx :: PromotionTickContext -> UnitEnv -> GlobalRdrEnv -> NamePprCtx
mkNamePprCtx PromotionTickContext
ptc UnitEnv
unit_env GlobalRdrEnv
env
= QueryQualifyName
-> QueryQualifyModule
-> QueryQualifyPackage
-> QueryPromotionTick
-> NamePprCtx
QueryQualify
(GlobalRdrEnv -> QueryQualifyName
mkQualName GlobalRdrEnv
env)
(UnitState -> Maybe HomeUnit -> QueryQualifyModule
mkQualModule UnitState
unit_state Maybe HomeUnit
home_unit)
(UnitState -> QueryQualifyPackage
mkQualPackage UnitState
unit_state)
(PromotionTickContext -> GlobalRdrEnv -> QueryPromotionTick
mkPromTick PromotionTickContext
ptc GlobalRdrEnv
env)
where
unit_state :: UnitState
unit_state = (() :: Constraint) => UnitEnv -> UnitState
UnitEnv -> UnitState
ue_units UnitEnv
unit_env
home_unit :: Maybe HomeUnit
home_unit = UnitEnv -> Maybe HomeUnit
ue_homeUnit UnitEnv
unit_env
mkQualName :: GlobalRdrEnv -> QueryQualifyName
mkQualName :: GlobalRdrEnv -> QueryQualifyName
mkQualName GlobalRdrEnv
env = QueryQualifyName
qual_name where
qual_name :: QueryQualifyName
qual_name Module
mod OccName
occ
| [GlobalRdrElt
gre] <- [GlobalRdrElt]
unqual_gres
, GlobalRdrElt -> Bool
right_name GlobalRdrElt
gre
= QualifyName
NameUnqual
| [] <- [GlobalRdrElt]
unqual_gres
, Bool
pretendNameIsInScopeForPpr
, Bool -> Bool
not (OccName -> Bool
isDerivedOccName OccName
occ)
= QualifyName
NameUnqual
| [GlobalRdrElt
gre] <- [GlobalRdrElt]
qual_gres
= ModuleName -> QualifyName
NameQual (GlobalRdrElt -> ModuleName
greQualModName GlobalRdrElt
gre)
| [GlobalRdrElt] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GlobalRdrElt]
qual_gres
= if [GlobalRdrElt] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (RdrName -> GlobalRdrEnv -> [GlobalRdrElt]
lookupGRE_RdrName (ModuleName -> OccName -> RdrName
mkRdrQual (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
mod) OccName
occ) GlobalRdrEnv
env)
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
$
(() :: Constraint) => 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
manyDataConName ]
right_name :: GlobalRdrElt -> Bool
right_name GlobalRdrElt
gre = GlobalRdrElt -> Maybe Module
greDefinitionModule GlobalRdrElt
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 :: [GlobalRdrElt]
unqual_gres = RdrName -> GlobalRdrEnv -> [GlobalRdrElt]
lookupGRE_RdrName (OccName -> RdrName
mkRdrUnqual OccName
occ) GlobalRdrEnv
env
qual_gres :: [GlobalRdrElt]
qual_gres = (GlobalRdrElt -> Bool) -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. (a -> Bool) -> [a] -> [a]
filter GlobalRdrElt -> Bool
right_name (GlobalRdrEnv -> OccName -> [GlobalRdrElt]
lookupGlobalRdrEnv GlobalRdrEnv
env OccName
occ)
mkPromTick :: PromotionTickContext -> GlobalRdrEnv -> QueryPromotionTick
mkPromTick :: PromotionTickContext -> GlobalRdrEnv -> QueryPromotionTick
mkPromTick PromotionTickContext
ptc GlobalRdrEnv
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
, [] <- RdrName -> GlobalRdrEnv -> [GlobalRdrElt]
lookupGRE_RdrName (OccName -> RdrName
mkRdrUnqual OccName
occ') GlobalRdrEnv
env
=
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 }