-- | 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
   , tyThingAvailInfo
   , tyThingTyCon
   , tyThingCoAxiom
   , tyThingDataCon
   , tyThingConLike
   , tyThingId
   )
where

import GHC.Prelude

import GHC.Types.Name
import GHC.Types.Var
import GHC.Types.Var.Set
import GHC.Types.Id
import GHC.Types.Id.Info
import GHC.Types.Avail

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

{-
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)     = forall a. NamedThing a => a -> Name
getName Id
id    -- decl, because the DataCon instance
  getName (ATyCon TyCon
tc)   = forall a. NamedThing a => a -> Name
getName TyCon
tc    -- isn't visible there
  getName (ACoAxiom CoAxiom Branched
cc) = 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
<+> SDoc -> SDoc
quotes (forall a. Outputable a => a -> SDoc
ppr (forall a. NamedThing a => a -> Name
getName TyThing
thing))

pprTyThingCategory :: TyThing -> SDoc
pprTyThingCategory :: TyThing -> SDoc
pprTyThingCategory = String -> SDoc
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
capitalise 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
    forall a b. (a -> b) -> [a] -> [b]
map TyCon -> TyThing
ATyCon (Class -> [TyCon]
classATs Class
cl) forall a. [a] -> [a] -> [a]
++

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

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

      -- for each data constructor in order,
      --   the constructor, worker, and (possibly) wrapper
    [ TyThing
thing | DataCon
dc    <- TyCon -> [DataCon]
tyConDataCons TyCon
tc
            , TyThing
thing <- ConLike -> TyThing
AConLike (DataCon -> ConLike
RealDataCon DataCon
dc) forall a. a -> [a] -> [a]
: DataCon -> [TyThing]
dataConImplicitTyThings DataCon
dc ]
      -- 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 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 forall a b. (a -> b) -> a -> b
$ 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) = 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  -> forall a. a -> Maybe a
Just (TyCon -> TyThing
ATyCon (DataCon -> TyCon
dataConTyCon DataCon
dc))
    PatSynCon{}     -> forall a. Maybe a
Nothing
tyThingParent_maybe (ATyCon TyCon
tc)   = case TyCon -> Maybe TyCon
tyConAssoc_maybe TyCon
tc of
                                      Just TyCon
tc -> forall a. a -> Maybe a
Just (TyCon -> TyThing
ATyCon TyCon
tc)
                                      Maybe TyCon
Nothing -> 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 } ->
                                          forall a. a -> Maybe a
Just (TyCon -> TyThing
ATyCon TyCon
tc)
                                      ClassOpId Class
cls               ->
                                          forall a. a -> Maybe a
Just (TyCon -> TyThing
ATyCon (Class -> TyCon
classTyCon Class
cls))
                                      IdDetails
_other                      -> forall a. Maybe a
Nothing
tyThingParent_maybe TyThing
_other = forall a. Maybe a
Nothing

tyThingsTyCoVars :: [TyThing] -> TyCoVarSet
tyThingsTyCoVars :: [TyThing] -> TyCoVarSet
tyThingsTyCoVars [TyThing]
tts =
    [TyCoVarSet] -> TyCoVarSet
unionVarSets forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map TyThing -> TyCoVarSet
ttToVarSet [TyThing]
tts
    where
        ttToVarSet :: TyThing -> TyCoVarSet
ttToVarSet (AnId Id
id)     = Type -> TyCoVarSet
tyCoVarsOfType 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 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. Class -> ([Id], [FunDep Id])
classTvsFds) Class
cls
              Maybe Class
Nothing  -> Type -> TyCoVarSet
tyCoVarsOfType forall a b. (a -> b) -> a -> b
$ TyCon -> Type
tyConKind TyCon
tc
        ttToVarSet (ACoAxiom CoAxiom Branched
_)  = TyCoVarSet
emptyVarSet

-- | The Names that a TyThing should bring into scope.  Used to build
-- the GlobalRdrEnv for the InteractiveContext.
tyThingAvailInfo :: TyThing -> [AvailInfo]
tyThingAvailInfo :: TyThing -> [AvailInfo]
tyThingAvailInfo (ATyCon TyCon
t)
   = case TyCon -> Maybe Class
tyConClass_maybe TyCon
t of
        Just Class
c  -> [Name -> [Name] -> [FieldLabel] -> AvailInfo
availTC Name
n ((Name
n forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a. NamedThing a => a -> Name
getName (Class -> [Id]
classMethods Class
c)
                                 forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall a. NamedThing a => a -> Name
getName (Class -> [TyCon]
classATs Class
c))) [] ]
             where n :: Name
n = forall a. NamedThing a => a -> Name
getName Class
c
        Maybe Class
Nothing -> [Name -> [Name] -> [FieldLabel] -> AvailInfo
availTC Name
n (Name
n forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a. NamedThing a => a -> Name
getName [DataCon]
dcs) [FieldLabel]
flds]
             where n :: Name
n    = forall a. NamedThing a => a -> Name
getName TyCon
t
                   dcs :: [DataCon]
dcs  = TyCon -> [DataCon]
tyConDataCons TyCon
t
                   flds :: [FieldLabel]
flds = TyCon -> [FieldLabel]
tyConFieldLabels TyCon
t
tyThingAvailInfo (AConLike (PatSynCon PatSyn
p))
  = Name -> AvailInfo
avail (forall a. NamedThing a => a -> Name
getName PatSyn
p) forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map FieldLabel -> AvailInfo
availField (PatSyn -> [FieldLabel]
patSynFieldLabels PatSyn
p)
tyThingAvailInfo TyThing
t
   = [Name -> AvailInfo
avail (forall a. NamedThing a => a -> Name
getName TyThing
t)]

-- | 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       = forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tyThingTyCon" (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         = forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tyThingCoAxiom" (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                       = forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tyThingDataCon" (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         = forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tyThingConLike" (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                       = forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tyThingId" (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 = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM HasDebugCallStack => TyThing -> Id
tyThingId forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadThings m => Name -> m TyThing
lookupThing

        lookupDataCon :: Name -> m DataCon
        lookupDataCon = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM HasDebugCallStack => TyThing -> DataCon
tyThingDataCon forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadThings m => Name -> m TyThing
lookupThing

        lookupTyCon :: Name -> m TyCon
        lookupTyCon = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM HasDebugCallStack => TyThing -> TyCon
tyThingTyCon forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadThings m => Name -> m TyThing
lookupThing