{-# LANGUAGE LambdaCase #-}

-- | A global typecheckable-thing, essentially anything that has a name.
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 )


{-
Note [ATyCon for classes]
~~~~~~~~~~~~~~~~~~~~~~~~~
Both classes and type constructors are represented in the type environment
as ATyCon.  You can tell the difference, and get to the class, with
   isClassTyCon :: TyCon -> Bool
   tyConClass_maybe :: TyCon -> Maybe Class
The Class and its associated TyCon have the same Name.
-}

-- | A global typecheckable-thing, essentially anything that has a name.
-- Not to be confused with a 'TcTyThing', which is also a typecheckable
-- thing but in the *local* context.  See "GHC.Tc.Utils.Env" for how to retrieve
-- a 'TyThing' given a 'Name'.
data TyThing
  = AnId     Id
  | AConLike ConLike
  | ATyCon   TyCon       -- TyCons and classes; see Note [ATyCon for classes]
  | ACoAxiom (CoAxiom Branched)

instance Outputable TyThing where
  ppr :: TyThing -> SDoc
ppr = TyThing -> SDoc
pprShortTyThing

instance NamedThing TyThing where       -- Can't put this with the type
  getName :: TyThing -> Name
getName (AnId Id
id)     = Id -> Name
forall a. NamedThing a => a -> Name
getName Id
id    -- decl, because the DataCon instance
  getName (ATyCon TyCon
tc)   = TyCon -> Name
forall a. NamedThing a => a -> Name
getName TyCon
tc    -- isn't visible there
  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
-- c.f. GHC.Types.TyThing.Ppr.pprTyThing, which prints all the details
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"



{-
Note [Implicit TyThings]
~~~~~~~~~~~~~~~~~~~~~~~~
  DEFINITION: An "implicit" TyThing is one that does not have its own
  IfaceDecl in an interface file.  Instead, its binding in the type
  environment is created as part of typechecking the IfaceDecl for
  some other thing.

Examples:
  * All DataCons are implicit, because they are generated from the
    IfaceDecl for the data/newtype.  Ditto class methods.

  * Record selectors are *not* implicit, because they get their own
    free-standing IfaceDecl.

  * Associated data/type families are implicit because they are
    included in the IfaceDecl of the parent class.  (NB: the
    IfaceClass decl happens to use IfaceDecl recursively for the
    associated types, but that's irrelevant here.)

  * Dictionary function Ids are not implicit.

  * Axioms for newtypes are implicit (same as above), but axioms
    for data/type family instances are *not* implicit (like DFunIds).
-}

-- | Determine the 'TyThing's brought into scope by another 'TyThing'
-- /other/ than itself. For example, Id's don't have any implicit TyThings
-- as they just bring themselves into scope, but classes bring their
-- dictionary datatype, type constructor and some selector functions into
-- scope, just for a start!

-- N.B. the set of TyThings returned here *must* match the set of
-- names returned by 'GHC.Iface.Load.ifaceDeclImplicitBndrs', in the sense that
-- TyThing.getOccName should define a bijection between the two lists.
-- This invariant is used in 'GHC.IfaceToCore.tc_iface_decl_fingerprint' (see
-- Note [Tricky iface loop])
-- The order of the list does not matter.
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 {})
  = []  -- Pattern synonyms have no implicit Ids; the wrapper and matcher
        -- are not "implicit"; they are simply new top-level bindings,
        -- and they have their own declaration in an interface file
        -- Unless a record pat syn when there are implicit selectors
        -- They are still not included here as `implicitConLikeThings` is
        -- used by `tcTyClsDecls` whilst pattern synonyms are typed checked
        -- by `tcTopValBinds`.

implicitClassThings :: Class -> [TyThing]
implicitClassThings :: Class -> [TyThing]
implicitClassThings Class
cl
  = -- Does not include default methods, because those Ids may have
    --    their own pragmas, unfoldings etc, not derived from the Class object

    -- associated types
    --    No recursive call for the classATs, because they
    --    are only the family decls; they have no implicit things
    (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]
++

    -- superclass and operation selectors
    (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]
++
      -- fields (names of selectors)

      -- (possibly) implicit newtype axioms
      -- or type family axioms
    TyCon -> [TyThing]
implicitCoTyCon TyCon
tc [TyThing] -> [TyThing] -> [TyThing]
forall a. [a] -> [a] -> [a]
++

      -- for each data constructor in order,
      --   the constructor and associated implicit 'Id's
    [TyThing]
datacon_stuff
      -- NB. record selectors are *not* implicit, they have fully-fledged
      -- bindings that pass through the compilation pipeline as normal.
  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

    -- For each data constructor in order,
    --   the constructor, worker, and (possibly) wrapper
    --
    -- If the data constructor is in a "type data" declaration,
    -- promote it to the type level now.
    -- See Note [Type data declarations] in GHC.Rename.Module.
    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

-- For newtypes and closed type families (only) add the implicit coercion tycon
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                      = []

-- | Returns @True@ if there should be no interface-file declaration
-- for this thing on its own: either it is built-in, or it is part
-- of some other declaration, or it is generated implicitly by some
-- other declaration.
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 x returns (Just p)
-- when pprTyThingInContext should print a declaration for p
-- (albeit with some "..." in it) when asked to show x
-- It returns the *immediate* parent.  So a datacon returns its tycon
-- but the tycon could be the associated type of a class, so it in turn
-- might have a parent.
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)
  | -- Special case for `type data` data constructors.  They appear as an
    -- ATyCon (not ADataCon) but we want to display them here as if they were
    -- a DataCon (i.e. with the parent declaration) (#22817).
    -- See Note [Type data declarations] in GHC.Rename.Module.
    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

-- | The 'GlobalRdrElt's that a 'TyThing' should bring into scope.
-- Used to build the 'GlobalRdrEnv' for the InteractiveContext.
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)])
              -- NB: NoParent for local pattern synonyms, as per
              -- Note [Parents] in GHC.Types.Name.Reader.
            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
                -- Go through all the data constructors of the parent TyCon,
                -- to ensure that all the record fields have the correct set
                -- of parent data constructors. See #23546.
                , 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) ]
      -- Fallback to NoParent for PatSyn record selectors,
      -- as per Note [Parents] in GHC.Types.Name.Reader.
    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)

-- | Obtain information pertinent to the renamer about a particular 'TyThing'.
--
-- This extracts out renamer information from typechecker information.
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

-- | Get the 'TyCon' from a 'TyThing' if it is a type constructor thing. Panics otherwise
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)

-- | Get the 'CoAxiom' from a 'TyThing' if it is a coercion axiom thing. Panics otherwise
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)

-- | Get the 'DataCon' from a 'TyThing' if it is a data constructor thing. Panics otherwise
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)

-- | Get the 'ConLike' from a 'TyThing' if it is a data constructor thing.
-- Panics otherwise
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)

-- | Get the 'Id' from a 'TyThing' if it is a id *or* data constructor thing. Panics otherwise
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 that abstracts out the common ability of the monads in GHC
-- to lookup a 'TyThing' in the monadic environment by 'Name'. Provides
-- a number of related convenience functions for accessing particular
-- kinds of 'TyThing'
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 used in GHC.HsToCore.Quote
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