{-# LANGUAGE LambdaCase #-}
module GHC.Types.TyThing
( TyThing (..)
, MonadThings (..)
, mkATyCon
, mkAnId
, pprShortTyThing
, pprTyThingCategory
, tyThingCategory
, implicitTyThings
, implicitConLikeThings
, implicitClassThings
, implicitTyConThings
, implicitCoTyCon
, isImplicitTyThing
, tyThingParent_maybe
, tyThingsTyCoVars
, tyThingLocalGREs, tyThingGREInfo
, tyThingTyCon
, tyThingCoAxiom
, tyThingDataCon
, tyThingConLike
, tyThingId
)
where
import GHC.Prelude
import GHC.Types.GREInfo
import GHC.Types.Name
import GHC.Types.Name.Reader
import GHC.Types.Var
import GHC.Types.Var.Set
import GHC.Types.Id
import GHC.Types.Id.Info
import GHC.Types.Unique.Set
import GHC.Core.Class
import GHC.Core.DataCon
import GHC.Core.ConLike
import GHC.Core.PatSyn
import GHC.Core.TyCo.FVs
import GHC.Core.TyCon
import GHC.Core.Coercion.Axiom
import GHC.Utils.Outputable
import GHC.Utils.Misc
import GHC.Utils.Panic
import Control.Monad ( liftM )
import Control.Monad.Trans.Reader
import Control.Monad.Trans.Class
import Data.List.NonEmpty ( NonEmpty(..) )
import qualified Data.List.NonEmpty as NE
import Data.List ( intersect )
data TyThing
= AnId Id
| AConLike ConLike
| ATyCon TyCon
| ACoAxiom (CoAxiom Branched)
instance Outputable TyThing where
ppr :: TyThing -> SDoc
ppr = TyThing -> SDoc
pprShortTyThing
instance NamedThing TyThing where
getName :: TyThing -> Name
getName (AnId Id
id) = Id -> Name
forall a. NamedThing a => a -> Name
getName Id
id
getName (ATyCon TyCon
tc) = TyCon -> Name
forall a. NamedThing a => a -> Name
getName TyCon
tc
getName (ACoAxiom CoAxiom Branched
cc) = CoAxiom Branched -> Name
forall a. NamedThing a => a -> Name
getName CoAxiom Branched
cc
getName (AConLike ConLike
cl) = ConLike -> Name
conLikeName ConLike
cl
mkATyCon :: TyCon -> TyThing
mkATyCon :: TyCon -> TyThing
mkATyCon = TyCon -> TyThing
ATyCon
mkAnId :: Id -> TyThing
mkAnId :: Id -> TyThing
mkAnId = Id -> TyThing
AnId
pprShortTyThing :: TyThing -> SDoc
pprShortTyThing :: TyThing -> SDoc
pprShortTyThing TyThing
thing
= TyThing -> SDoc
pprTyThingCategory TyThing
thing SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr (TyThing -> Name
forall a. NamedThing a => a -> Name
getName TyThing
thing))
pprTyThingCategory :: TyThing -> SDoc
pprTyThingCategory :: TyThing -> SDoc
pprTyThingCategory = String -> SDoc
forall doc. IsLine doc => String -> doc
text (String -> SDoc) -> (TyThing -> String) -> TyThing -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
capitalise (String -> String) -> (TyThing -> String) -> TyThing -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyThing -> String
tyThingCategory
tyThingCategory :: TyThing -> String
tyThingCategory :: TyThing -> String
tyThingCategory (ATyCon TyCon
tc)
| TyCon -> Bool
isClassTyCon TyCon
tc = String
"class"
| Bool
otherwise = String
"type constructor"
tyThingCategory (ACoAxiom CoAxiom Branched
_) = String
"coercion axiom"
tyThingCategory (AnId Id
_) = String
"identifier"
tyThingCategory (AConLike (RealDataCon DataCon
_)) = String
"data constructor"
tyThingCategory (AConLike (PatSynCon PatSyn
_)) = String
"pattern synonym"
implicitTyThings :: TyThing -> [TyThing]
implicitTyThings :: TyThing -> [TyThing]
implicitTyThings (AnId Id
_) = []
implicitTyThings (ACoAxiom CoAxiom Branched
_cc) = []
implicitTyThings (ATyCon TyCon
tc) = TyCon -> [TyThing]
implicitTyConThings TyCon
tc
implicitTyThings (AConLike ConLike
cl) = ConLike -> [TyThing]
implicitConLikeThings ConLike
cl
implicitConLikeThings :: ConLike -> [TyThing]
implicitConLikeThings :: ConLike -> [TyThing]
implicitConLikeThings (RealDataCon DataCon
dc)
= DataCon -> [TyThing]
dataConImplicitTyThings DataCon
dc
implicitConLikeThings (PatSynCon {})
= []
implicitClassThings :: Class -> [TyThing]
implicitClassThings :: Class -> [TyThing]
implicitClassThings Class
cl
=
(TyCon -> TyThing) -> [TyCon] -> [TyThing]
forall a b. (a -> b) -> [a] -> [b]
map TyCon -> TyThing
ATyCon (Class -> [TyCon]
classATs Class
cl) [TyThing] -> [TyThing] -> [TyThing]
forall a. [a] -> [a] -> [a]
++
(Id -> TyThing) -> [Id] -> [TyThing]
forall a b. (a -> b) -> [a] -> [b]
map Id -> TyThing
AnId (Class -> [Id]
classAllSelIds Class
cl)
implicitTyConThings :: TyCon -> [TyThing]
implicitTyConThings :: TyCon -> [TyThing]
implicitTyConThings TyCon
tc
= [TyThing]
class_stuff [TyThing] -> [TyThing] -> [TyThing]
forall a. [a] -> [a] -> [a]
++
TyCon -> [TyThing]
implicitCoTyCon TyCon
tc [TyThing] -> [TyThing] -> [TyThing]
forall a. [a] -> [a] -> [a]
++
[TyThing]
datacon_stuff
where
class_stuff :: [TyThing]
class_stuff = case TyCon -> Maybe Class
tyConClass_maybe TyCon
tc of
Maybe Class
Nothing -> []
Just Class
cl -> Class -> [TyThing]
implicitClassThings Class
cl
datacon_stuff :: [TyThing]
datacon_stuff :: [TyThing]
datacon_stuff
| TyCon -> Bool
isTypeDataTyCon TyCon
tc = [TyCon -> TyThing
ATyCon (DataCon -> TyCon
promoteDataCon DataCon
dc) | DataCon
dc <- [DataCon]
cons]
| Bool
otherwise
= [TyThing
ty_thing | DataCon
dc <- [DataCon]
cons,
TyThing
ty_thing <- ConLike -> TyThing
AConLike (DataCon -> ConLike
RealDataCon DataCon
dc) TyThing -> [TyThing] -> [TyThing]
forall a. a -> [a] -> [a]
:
DataCon -> [TyThing]
dataConImplicitTyThings DataCon
dc]
cons :: [DataCon]
cons :: [DataCon]
cons = TyCon -> [DataCon]
tyConDataCons TyCon
tc
implicitCoTyCon :: TyCon -> [TyThing]
implicitCoTyCon :: TyCon -> [TyThing]
implicitCoTyCon TyCon
tc
| Just CoAxiom Unbranched
co <- TyCon -> Maybe (CoAxiom Unbranched)
newTyConCo_maybe TyCon
tc = [CoAxiom Branched -> TyThing
ACoAxiom (CoAxiom Branched -> TyThing) -> CoAxiom Branched -> TyThing
forall a b. (a -> b) -> a -> b
$ CoAxiom Unbranched -> CoAxiom Branched
forall (br :: BranchFlag). CoAxiom br -> CoAxiom Branched
toBranchedAxiom CoAxiom Unbranched
co]
| Just CoAxiom Branched
co <- TyCon -> Maybe (CoAxiom Branched)
isClosedSynFamilyTyConWithAxiom_maybe TyCon
tc
= [CoAxiom Branched -> TyThing
ACoAxiom CoAxiom Branched
co]
| Bool
otherwise = []
isImplicitTyThing :: TyThing -> Bool
isImplicitTyThing :: TyThing -> Bool
isImplicitTyThing (AConLike ConLike
cl) = case ConLike
cl of
RealDataCon {} -> Bool
True
PatSynCon {} -> Bool
False
isImplicitTyThing (AnId Id
id) = Id -> Bool
isImplicitId Id
id
isImplicitTyThing (ATyCon TyCon
tc) = TyCon -> Bool
isImplicitTyCon TyCon
tc
isImplicitTyThing (ACoAxiom CoAxiom Branched
ax) = CoAxiom Branched -> Bool
forall (br :: BranchFlag). CoAxiom br -> Bool
isImplicitCoAxiom CoAxiom Branched
ax
tyThingParent_maybe :: TyThing -> Maybe TyThing
tyThingParent_maybe :: TyThing -> Maybe TyThing
tyThingParent_maybe (AConLike ConLike
cl) = case ConLike
cl of
RealDataCon DataCon
dc -> TyThing -> Maybe TyThing
forall a. a -> Maybe a
Just (TyCon -> TyThing
ATyCon (DataCon -> TyCon
dataConTyCon DataCon
dc))
PatSynCon{} -> Maybe TyThing
forall a. Maybe a
Nothing
tyThingParent_maybe (ATyCon TyCon
tc)
|
Just DataCon
dc <- TyCon -> Maybe DataCon
isPromotedDataCon_maybe TyCon
tc
, let parent_tc :: TyCon
parent_tc = DataCon -> TyCon
dataConTyCon DataCon
dc
, TyCon -> Bool
isTypeDataTyCon TyCon
parent_tc
= TyThing -> Maybe TyThing
forall a. a -> Maybe a
Just (TyCon -> TyThing
ATyCon TyCon
parent_tc)
| Just TyCon
tc <- TyCon -> Maybe TyCon
tyConAssoc_maybe TyCon
tc
= TyThing -> Maybe TyThing
forall a. a -> Maybe a
Just (TyCon -> TyThing
ATyCon TyCon
tc)
| Bool
otherwise
= Maybe TyThing
forall a. Maybe a
Nothing
tyThingParent_maybe (AnId Id
id) = case Id -> IdDetails
idDetails Id
id of
RecSelId { sel_tycon :: IdDetails -> RecSelParent
sel_tycon = RecSelData TyCon
tc } ->
TyThing -> Maybe TyThing
forall a. a -> Maybe a
Just (TyCon -> TyThing
ATyCon TyCon
tc)
RecSelId { sel_tycon :: IdDetails -> RecSelParent
sel_tycon = RecSelPatSyn PatSyn
ps } ->
TyThing -> Maybe TyThing
forall a. a -> Maybe a
Just (ConLike -> TyThing
AConLike (PatSyn -> ConLike
PatSynCon PatSyn
ps))
ClassOpId Class
cls Bool
_ ->
TyThing -> Maybe TyThing
forall a. a -> Maybe a
Just (TyCon -> TyThing
ATyCon (Class -> TyCon
classTyCon Class
cls))
IdDetails
_other -> Maybe TyThing
forall a. Maybe a
Nothing
tyThingParent_maybe TyThing
_other = Maybe TyThing
forall a. Maybe a
Nothing
tyThingsTyCoVars :: [TyThing] -> TyCoVarSet
tyThingsTyCoVars :: [TyThing] -> TyCoVarSet
tyThingsTyCoVars [TyThing]
tts =
[TyCoVarSet] -> TyCoVarSet
unionVarSets ([TyCoVarSet] -> TyCoVarSet) -> [TyCoVarSet] -> TyCoVarSet
forall a b. (a -> b) -> a -> b
$ (TyThing -> TyCoVarSet) -> [TyThing] -> [TyCoVarSet]
forall a b. (a -> b) -> [a] -> [b]
map TyThing -> TyCoVarSet
ttToVarSet [TyThing]
tts
where
ttToVarSet :: TyThing -> TyCoVarSet
ttToVarSet (AnId Id
id) = Type -> TyCoVarSet
tyCoVarsOfType (Type -> TyCoVarSet) -> Type -> TyCoVarSet
forall a b. (a -> b) -> a -> b
$ Id -> Type
idType Id
id
ttToVarSet (AConLike ConLike
cl) = case ConLike
cl of
RealDataCon DataCon
dc -> Type -> TyCoVarSet
tyCoVarsOfType (Type -> TyCoVarSet) -> Type -> TyCoVarSet
forall a b. (a -> b) -> a -> b
$ DataCon -> Type
dataConRepType DataCon
dc
PatSynCon{} -> TyCoVarSet
emptyVarSet
ttToVarSet (ATyCon TyCon
tc)
= case TyCon -> Maybe Class
tyConClass_maybe TyCon
tc of
Just Class
cls -> ([Id] -> TyCoVarSet
mkVarSet ([Id] -> TyCoVarSet) -> (Class -> [Id]) -> Class -> TyCoVarSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Id], [FunDep Id]) -> [Id]
forall a b. (a, b) -> a
fst (([Id], [FunDep Id]) -> [Id])
-> (Class -> ([Id], [FunDep Id])) -> Class -> [Id]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Class -> ([Id], [FunDep Id])
classTvsFds) Class
cls
Maybe Class
Nothing -> Type -> TyCoVarSet
tyCoVarsOfType (Type -> TyCoVarSet) -> Type -> TyCoVarSet
forall a b. (a -> b) -> a -> b
$ TyCon -> Type
tyConKind TyCon
tc
ttToVarSet (ACoAxiom CoAxiom Branched
_) = TyCoVarSet
emptyVarSet
tyThingLocalGREs :: TyThing -> [GlobalRdrElt]
tyThingLocalGREs :: TyThing -> [GlobalRdrElt]
tyThingLocalGREs TyThing
ty_thing =
case TyThing
ty_thing of
ATyCon TyCon
t
| Just Class
c <- TyCon -> Maybe Class
tyConClass_maybe TyCon
t
-> Parent -> GlobalRdrElt
myself Parent
NoParent
GlobalRdrElt -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. a -> [a] -> [a]
: ( (Id -> GlobalRdrElt) -> [Id] -> [GlobalRdrElt]
forall a b. (a -> b) -> [a] -> [b]
map (Parent -> Name -> GlobalRdrElt
mkLocalVanillaGRE (Name -> Parent
ParentIs (Name -> Parent) -> Name -> Parent
forall a b. (a -> b) -> a -> b
$ Class -> Name
className Class
c) (Name -> GlobalRdrElt) -> (Id -> Name) -> Id -> GlobalRdrElt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Id -> Name
forall a. NamedThing a => a -> Name
getName) (Class -> [Id]
classMethods Class
c)
[GlobalRdrElt] -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. [a] -> [a] -> [a]
++ (TyCon -> GlobalRdrElt) -> [TyCon] -> [GlobalRdrElt]
forall a b. (a -> b) -> [a] -> [b]
map TyCon -> GlobalRdrElt
tc_GRE (Class -> [TyCon]
classATs Class
c) )
| Bool
otherwise
-> let dcs :: [DataCon]
dcs = TyCon -> [DataCon]
tyConDataCons TyCon
t
par :: Parent
par = Name -> Parent
ParentIs (Name -> Parent) -> Name -> Parent
forall a b. (a -> b) -> a -> b
$ TyCon -> Name
tyConName TyCon
t
mk_nm :: DataCon -> ConLikeName
mk_nm = Name -> ConLikeName
DataConName (Name -> ConLikeName)
-> (DataCon -> Name) -> DataCon -> ConLikeName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataCon -> Name
dataConName
in Parent -> GlobalRdrElt
myself Parent
NoParent
GlobalRdrElt -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. a -> [a] -> [a]
: (DataCon -> GlobalRdrElt) -> [DataCon] -> [GlobalRdrElt]
forall a b. (a -> b) -> [a] -> [b]
map (Parent -> DataCon -> GlobalRdrElt
dc_GRE Parent
par) [DataCon]
dcs
[GlobalRdrElt] -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. [a] -> [a] -> [a]
++
Parent -> [(ConLikeName, ConInfo)] -> [GlobalRdrElt]
mkLocalFieldGREs Parent
par
[ (DataCon -> ConLikeName
mk_nm DataCon
dc, ConInfo
con_info)
| DataCon
dc <- [DataCon]
dcs
, let con_info :: ConInfo
con_info = ConLike -> ConInfo
conLikeConInfo (DataCon -> ConLike
RealDataCon DataCon
dc) ]
AConLike ConLike
con ->
let (Parent
par, [(ConLikeName, ConInfo)]
cons_flds) = case ConLike
con of
PatSynCon {} ->
(Parent
NoParent, [(ConLike -> ConLikeName
conLikeConLikeName ConLike
con, ConLike -> ConInfo
conLikeConInfo ConLike
con)])
RealDataCon DataCon
dc1 ->
(Name -> Parent
ParentIs (Name -> Parent) -> Name -> Parent
forall a b. (a -> b) -> a -> b
$ TyCon -> Name
tyConName (TyCon -> Name) -> TyCon -> Name
forall a b. (a -> b) -> a -> b
$ DataCon -> TyCon
dataConTyCon DataCon
dc1
, [ (Name -> ConLikeName
DataConName (Name -> ConLikeName) -> Name -> ConLikeName
forall a b. (a -> b) -> a -> b
$ DataCon -> Name
dataConName (DataCon -> Name) -> DataCon -> Name
forall a b. (a -> b) -> a -> b
$ DataCon
dc, ConLikeInfo -> ConFieldInfo -> ConInfo
ConInfo ConLikeInfo
conInfo (NonEmpty FieldLabel -> ConFieldInfo
ConHasRecordFields (FieldLabel
fld FieldLabel -> [FieldLabel] -> NonEmpty FieldLabel
forall a. a -> [a] -> NonEmpty a
:| [FieldLabel]
flds)))
| DataCon
dc <- TyCon -> [DataCon]
tyConDataCons (TyCon -> [DataCon]) -> TyCon -> [DataCon]
forall a b. (a -> b) -> a -> b
$ DataCon -> TyCon
dataConTyCon DataCon
dc1
, let con_info :: ConInfo
con_info = ConLike -> ConInfo
conLikeConInfo (DataCon -> ConLike
RealDataCon DataCon
dc)
, ConInfo ConLikeInfo
conInfo (ConHasRecordFields NonEmpty FieldLabel
flds0) <- [ConInfo
con_info]
, let flds1 :: [FieldLabel]
flds1 = NonEmpty FieldLabel -> [FieldLabel]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty FieldLabel
flds0 [FieldLabel] -> [FieldLabel] -> [FieldLabel]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` DataCon -> [FieldLabel]
dataConFieldLabels DataCon
dc
, FieldLabel
fld:[FieldLabel]
flds <- [[FieldLabel]
flds1]
])
in Parent -> GlobalRdrElt
myself Parent
par GlobalRdrElt -> [GlobalRdrElt] -> [GlobalRdrElt]
forall a. a -> [a] -> [a]
: Parent -> [(ConLikeName, ConInfo)] -> [GlobalRdrElt]
mkLocalFieldGREs Parent
par [(ConLikeName, ConInfo)]
cons_flds
AnId Id
id
| RecSelId { sel_tycon :: IdDetails -> RecSelParent
sel_tycon = RecSelData TyCon
tc } <- Id -> IdDetails
idDetails Id
id
-> [ Parent -> GlobalRdrElt
myself (Name -> Parent
ParentIs (Name -> Parent) -> Name -> Parent
forall a b. (a -> b) -> a -> b
$ TyCon -> Name
tyConName TyCon
tc) ]
TyThing
_ -> [ Parent -> GlobalRdrElt
myself Parent
NoParent ]
where
tc_GRE :: TyCon -> GlobalRdrElt
tc_GRE :: TyCon -> GlobalRdrElt
tc_GRE TyCon
at = TyConFlavour Name -> Name -> GlobalRdrElt
mkLocalTyConGRE
((TyCon -> Name) -> TyConFlavour TyCon -> TyConFlavour Name
forall a b. (a -> b) -> TyConFlavour a -> TyConFlavour b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TyCon -> Name
tyConName (TyConFlavour TyCon -> TyConFlavour Name)
-> TyConFlavour TyCon -> TyConFlavour Name
forall a b. (a -> b) -> a -> b
$ TyCon -> TyConFlavour TyCon
tyConFlavour TyCon
at)
(TyCon -> Name
tyConName TyCon
at)
dc_GRE :: Parent -> DataCon -> GlobalRdrElt
dc_GRE :: Parent -> DataCon -> GlobalRdrElt
dc_GRE Parent
par DataCon
dc =
let con_info :: ConInfo
con_info = ConLike -> ConInfo
conLikeConInfo (DataCon -> ConLike
RealDataCon DataCon
dc)
in Parent -> (ConLikeName, ConInfo) -> GlobalRdrElt
mkLocalConLikeGRE Parent
par (Name -> ConLikeName
DataConName (Name -> ConLikeName) -> Name -> ConLikeName
forall a b. (a -> b) -> a -> b
$ DataCon -> Name
dataConName DataCon
dc, ConInfo
con_info)
myself :: Parent -> GlobalRdrElt
myself :: Parent -> GlobalRdrElt
myself Parent
p = GREInfo -> Parent -> Name -> GlobalRdrElt
mkLocalGRE (TyThing -> GREInfo
tyThingGREInfo TyThing
ty_thing) Parent
p (TyThing -> Name
forall a. NamedThing a => a -> Name
getName TyThing
ty_thing)
tyThingGREInfo :: TyThing -> GREInfo
tyThingGREInfo :: TyThing -> GREInfo
tyThingGREInfo = \case
AConLike ConLike
con -> ConInfo -> GREInfo
IAmConLike (ConInfo -> GREInfo) -> ConInfo -> GREInfo
forall a b. (a -> b) -> a -> b
$ ConLike -> ConInfo
conLikeConInfo ConLike
con
AnId Id
id -> case Id -> IdDetails
idDetails Id
id of
RecSelId { sel_tycon :: IdDetails -> RecSelParent
sel_tycon = RecSelParent
parent, sel_fieldLabel :: IdDetails -> FieldLabel
sel_fieldLabel = FieldLabel
fl } ->
let relevant_cons :: UniqSet ConLikeName
relevant_cons = case RecSelParent
parent of
RecSelPatSyn PatSyn
ps -> ConLikeName -> UniqSet ConLikeName
forall a. Uniquable a => a -> UniqSet a
unitUniqSet (ConLikeName -> UniqSet ConLikeName)
-> ConLikeName -> UniqSet ConLikeName
forall a b. (a -> b) -> a -> b
$ Name -> ConLikeName
PatSynName (PatSyn -> Name
patSynName PatSyn
ps)
RecSelData TyCon
tc ->
let dcs :: [ConLike]
dcs = (DataCon -> ConLike) -> [DataCon] -> [ConLike]
forall a b. (a -> b) -> [a] -> [b]
map DataCon -> ConLike
RealDataCon ([DataCon] -> [ConLike]) -> [DataCon] -> [ConLike]
forall a b. (a -> b) -> a -> b
$ TyCon -> [DataCon]
tyConDataCons TyCon
tc in
case RecSelInfo -> [ConLike]
rsi_def ([ConLike] -> [FieldLabelString] -> RecSelInfo
conLikesRecSelInfo [ConLike]
dcs [FieldLabel -> FieldLabelString
flLabel FieldLabel
fl]) of
[] -> String -> SDoc -> UniqSet ConLikeName
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tyThingGREInfo: no DataCons with this FieldLabel" (SDoc -> UniqSet ConLikeName) -> SDoc -> UniqSet ConLikeName
forall a b. (a -> b) -> a -> b
$
[SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"id:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Id -> SDoc
forall a. Outputable a => a -> SDoc
ppr Id
id
, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"fl:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> FieldLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr FieldLabel
fl
, String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"dcs:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [ConLike] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [ConLike]
dcs ]
[ConLike]
cons -> [ConLikeName] -> UniqSet ConLikeName
forall a. Uniquable a => [a] -> UniqSet a
mkUniqSet ([ConLikeName] -> UniqSet ConLikeName)
-> [ConLikeName] -> UniqSet ConLikeName
forall a b. (a -> b) -> a -> b
$ (ConLike -> ConLikeName) -> [ConLike] -> [ConLikeName]
forall a b. (a -> b) -> [a] -> [b]
map ConLike -> ConLikeName
conLikeConLikeName [ConLike]
cons
in RecFieldInfo -> GREInfo
IAmRecField (RecFieldInfo -> GREInfo) -> RecFieldInfo -> GREInfo
forall a b. (a -> b) -> a -> b
$
RecFieldInfo
{ recFieldLabel :: FieldLabel
recFieldLabel = FieldLabel
fl
, recFieldCons :: UniqSet ConLikeName
recFieldCons = UniqSet ConLikeName
relevant_cons }
IdDetails
_ -> GREInfo
Vanilla
ATyCon TyCon
tc ->
TyConFlavour Name -> GREInfo
IAmTyCon ((TyCon -> Name) -> TyConFlavour TyCon -> TyConFlavour Name
forall a b. (a -> b) -> TyConFlavour a -> TyConFlavour b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TyCon -> Name
tyConName (TyConFlavour TyCon -> TyConFlavour Name)
-> TyConFlavour TyCon -> TyConFlavour Name
forall a b. (a -> b) -> a -> b
$ TyCon -> TyConFlavour TyCon
tyConFlavour TyCon
tc)
TyThing
_ -> GREInfo
Vanilla
tyThingTyCon :: HasDebugCallStack => TyThing -> TyCon
tyThingTyCon :: HasDebugCallStack => TyThing -> TyCon
tyThingTyCon (ATyCon TyCon
tc) = TyCon
tc
tyThingTyCon TyThing
other = String -> SDoc -> TyCon
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tyThingTyCon" (TyThing -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyThing
other)
tyThingCoAxiom :: HasDebugCallStack => TyThing -> CoAxiom Branched
tyThingCoAxiom :: HasDebugCallStack => TyThing -> CoAxiom Branched
tyThingCoAxiom (ACoAxiom CoAxiom Branched
ax) = CoAxiom Branched
ax
tyThingCoAxiom TyThing
other = String -> SDoc -> CoAxiom Branched
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tyThingCoAxiom" (TyThing -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyThing
other)
tyThingDataCon :: HasDebugCallStack => TyThing -> DataCon
tyThingDataCon :: HasDebugCallStack => TyThing -> DataCon
tyThingDataCon (AConLike (RealDataCon DataCon
dc)) = DataCon
dc
tyThingDataCon TyThing
other = String -> SDoc -> DataCon
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tyThingDataCon" (TyThing -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyThing
other)
tyThingConLike :: HasDebugCallStack => TyThing -> ConLike
tyThingConLike :: HasDebugCallStack => TyThing -> ConLike
tyThingConLike (AConLike ConLike
dc) = ConLike
dc
tyThingConLike TyThing
other = String -> SDoc -> ConLike
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tyThingConLike" (TyThing -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyThing
other)
tyThingId :: HasDebugCallStack => TyThing -> Id
tyThingId :: HasDebugCallStack => TyThing -> Id
tyThingId (AnId Id
id) = Id
id
tyThingId (AConLike (RealDataCon DataCon
dc)) = DataCon -> Id
dataConWrapId DataCon
dc
tyThingId TyThing
other = String -> SDoc -> Id
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tyThingId" (TyThing -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyThing
other)
class Monad m => MonadThings m where
lookupThing :: Name -> m TyThing
lookupId :: Name -> m Id
lookupId = (TyThing -> Id) -> m TyThing -> m Id
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM HasDebugCallStack => TyThing -> Id
TyThing -> Id
tyThingId (m TyThing -> m Id) -> (Name -> m TyThing) -> Name -> m Id
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> m TyThing
forall (m :: * -> *). MonadThings m => Name -> m TyThing
lookupThing
lookupDataCon :: Name -> m DataCon
lookupDataCon = (TyThing -> DataCon) -> m TyThing -> m DataCon
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM HasDebugCallStack => TyThing -> DataCon
TyThing -> DataCon
tyThingDataCon (m TyThing -> m DataCon)
-> (Name -> m TyThing) -> Name -> m DataCon
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> m TyThing
forall (m :: * -> *). MonadThings m => Name -> m TyThing
lookupThing
lookupTyCon :: Name -> m TyCon
lookupTyCon = (TyThing -> TyCon) -> m TyThing -> m TyCon
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM HasDebugCallStack => TyThing -> TyCon
TyThing -> TyCon
tyThingTyCon (m TyThing -> m TyCon) -> (Name -> m TyThing) -> Name -> m TyCon
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> m TyThing
forall (m :: * -> *). MonadThings m => Name -> m TyThing
lookupThing
instance MonadThings m => MonadThings (ReaderT s m) where
lookupThing :: Name -> ReaderT s m TyThing
lookupThing = m TyThing -> ReaderT s m TyThing
forall (m :: * -> *) a. Monad m => m a -> ReaderT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m TyThing -> ReaderT s m TyThing)
-> (Name -> m TyThing) -> Name -> ReaderT s m TyThing
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> m TyThing
forall (m :: * -> *). MonadThings m => Name -> m TyThing
lookupThing