module GHC.Tc.Plugin (
TcPluginM,
tcPluginIO,
tcPluginTrace,
unsafeTcPluginTcM,
Finder.FindResult(..),
findImportedModule,
lookupOrig,
tcLookupGlobal,
tcLookupTyCon,
tcLookupDataCon,
tcLookupClass,
tcLookup,
tcLookupId,
getTopEnv,
getTargetPlatform,
getEnvs,
getInstEnvs,
getFamInstEnvs,
matchFam,
newUnique,
newFlexiTyVar,
isTouchableTcPluginM,
zonkTcType,
zonkCt,
newWanted,
newGiven,
newCoercionHole,
newEvVar,
setEvBind,
) where
import GHC.Prelude
import GHC.Platform (Platform)
import qualified GHC.Tc.Utils.Monad as TcM
import qualified GHC.Tc.Solver.Monad as TcS
import qualified GHC.Tc.Utils.Env as TcM
import qualified GHC.Tc.Utils.TcMType as TcM
import qualified GHC.Tc.Instance.Family as TcM
import qualified GHC.Iface.Env as IfaceEnv
import qualified GHC.Unit.Finder as Finder
import GHC.Core.FamInstEnv ( FamInstEnv )
import GHC.Tc.Utils.Monad ( TcGblEnv, TcLclEnv, TcPluginM
, unsafeTcPluginTcM
, liftIO, traceTc )
import GHC.Tc.Types.Constraint ( Ct, CtLoc, CtEvidence(..) )
import GHC.Tc.Utils.TcMType ( TcTyVar, TcType )
import GHC.Tc.Utils.Env ( TcTyThing )
import GHC.Tc.Types.Evidence ( CoercionHole, EvTerm(..)
, EvExpr, EvBindsVar, EvBind, mkGivenEvBind )
import GHC.Types.Var ( EvVar )
import GHC.Unit.Module ( ModuleName, Module )
import GHC.Types.Name ( OccName, Name )
import GHC.Types.TyThing ( TyThing )
import GHC.Core.Reduction ( Reduction )
import GHC.Core.TyCon ( TyCon )
import GHC.Core.DataCon ( DataCon )
import GHC.Core.Class ( Class )
import GHC.Driver.Env ( HscEnv(..) )
import GHC.Utils.Outputable ( SDoc )
import GHC.Core.Type ( Kind, Type, PredType )
import GHC.Types.Id ( Id )
import GHC.Core.InstEnv ( InstEnvs )
import GHC.Types.Unique ( Unique )
import GHC.Types.PkgQual ( PkgQual )
tcPluginIO :: IO a -> TcPluginM a
tcPluginIO :: forall a. IO a -> TcPluginM a
tcPluginIO IO a
a = forall a. TcM a -> TcPluginM a
unsafeTcPluginTcM (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO a
a)
tcPluginTrace :: String -> SDoc -> TcPluginM ()
tcPluginTrace :: String -> SDoc -> TcPluginM ()
tcPluginTrace String
a SDoc
b = forall a. TcM a -> TcPluginM a
unsafeTcPluginTcM (String -> SDoc -> TcRn ()
traceTc String
a SDoc
b)
findImportedModule :: ModuleName -> PkgQual -> TcPluginM Finder.FindResult
findImportedModule :: ModuleName -> PkgQual -> TcPluginM FindResult
findImportedModule ModuleName
mod_name PkgQual
mb_pkg = do
HscEnv
hsc_env <- TcPluginM HscEnv
getTopEnv
forall a. IO a -> TcPluginM a
tcPluginIO forall a b. (a -> b) -> a -> b
$ HscEnv -> ModuleName -> PkgQual -> IO FindResult
Finder.findImportedModule HscEnv
hsc_env ModuleName
mod_name PkgQual
mb_pkg
lookupOrig :: Module -> OccName -> TcPluginM Name
lookupOrig :: Module -> OccName -> TcPluginM Name
lookupOrig Module
mod = forall a. TcM a -> TcPluginM a
unsafeTcPluginTcM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Module -> OccName -> TcRnIf a b Name
IfaceEnv.lookupOrig Module
mod
tcLookupGlobal :: Name -> TcPluginM TyThing
tcLookupGlobal :: Name -> TcPluginM TyThing
tcLookupGlobal = forall a. TcM a -> TcPluginM a
unsafeTcPluginTcM forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> TcM TyThing
TcM.tcLookupGlobal
tcLookupTyCon :: Name -> TcPluginM TyCon
tcLookupTyCon :: Name -> TcPluginM TyCon
tcLookupTyCon = forall a. TcM a -> TcPluginM a
unsafeTcPluginTcM forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> TcM TyCon
TcM.tcLookupTyCon
tcLookupDataCon :: Name -> TcPluginM DataCon
tcLookupDataCon :: Name -> TcPluginM DataCon
tcLookupDataCon = forall a. TcM a -> TcPluginM a
unsafeTcPluginTcM forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> TcM DataCon
TcM.tcLookupDataCon
tcLookupClass :: Name -> TcPluginM Class
tcLookupClass :: Name -> TcPluginM Class
tcLookupClass = forall a. TcM a -> TcPluginM a
unsafeTcPluginTcM forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> TcM Class
TcM.tcLookupClass
tcLookup :: Name -> TcPluginM TcTyThing
tcLookup :: Name -> TcPluginM TcTyThing
tcLookup = forall a. TcM a -> TcPluginM a
unsafeTcPluginTcM forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> TcM TcTyThing
TcM.tcLookup
tcLookupId :: Name -> TcPluginM Id
tcLookupId :: Name -> TcPluginM Id
tcLookupId = forall a. TcM a -> TcPluginM a
unsafeTcPluginTcM forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> TcM Id
TcM.tcLookupId
getTopEnv :: TcPluginM HscEnv
getTopEnv :: TcPluginM HscEnv
getTopEnv = forall a. TcM a -> TcPluginM a
unsafeTcPluginTcM forall gbl lcl. TcRnIf gbl lcl HscEnv
TcM.getTopEnv
getTargetPlatform :: TcPluginM Platform
getTargetPlatform :: TcPluginM Platform
getTargetPlatform = forall a. TcM a -> TcPluginM a
unsafeTcPluginTcM forall a b. TcRnIf a b Platform
TcM.getPlatform
getEnvs :: TcPluginM (TcGblEnv, TcLclEnv)
getEnvs :: TcPluginM (TcGblEnv, TcLclEnv)
getEnvs = forall a. TcM a -> TcPluginM a
unsafeTcPluginTcM forall gbl lcl. TcRnIf gbl lcl (gbl, lcl)
TcM.getEnvs
getInstEnvs :: TcPluginM InstEnvs
getInstEnvs :: TcPluginM InstEnvs
getInstEnvs = forall a. TcM a -> TcPluginM a
unsafeTcPluginTcM TcM InstEnvs
TcM.tcGetInstEnvs
getFamInstEnvs :: TcPluginM (FamInstEnv, FamInstEnv)
getFamInstEnvs :: TcPluginM (FamInstEnv, FamInstEnv)
getFamInstEnvs = forall a. TcM a -> TcPluginM a
unsafeTcPluginTcM TcM (FamInstEnv, FamInstEnv)
TcM.tcGetFamInstEnvs
matchFam :: TyCon -> [Type]
-> TcPluginM (Maybe Reduction)
matchFam :: TyCon -> [Type] -> TcPluginM (Maybe Reduction)
matchFam TyCon
tycon [Type]
args = forall a. TcM a -> TcPluginM a
unsafeTcPluginTcM forall a b. (a -> b) -> a -> b
$ TyCon -> [Type] -> TcM (Maybe Reduction)
TcS.matchFamTcM TyCon
tycon [Type]
args
newUnique :: TcPluginM Unique
newUnique :: TcPluginM Unique
newUnique = forall a. TcM a -> TcPluginM a
unsafeTcPluginTcM forall gbl lcl. TcRnIf gbl lcl Unique
TcM.newUnique
newFlexiTyVar :: Kind -> TcPluginM TcTyVar
newFlexiTyVar :: Type -> TcPluginM Id
newFlexiTyVar = forall a. TcM a -> TcPluginM a
unsafeTcPluginTcM forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> TcM Id
TcM.newFlexiTyVar
isTouchableTcPluginM :: TcTyVar -> TcPluginM Bool
isTouchableTcPluginM :: Id -> TcPluginM Bool
isTouchableTcPluginM = forall a. TcM a -> TcPluginM a
unsafeTcPluginTcM forall b c a. (b -> c) -> (a -> b) -> a -> c
. Id -> TcM Bool
TcM.isTouchableTcM
zonkTcType :: TcType -> TcPluginM TcType
zonkTcType :: Type -> TcPluginM Type
zonkTcType = forall a. TcM a -> TcPluginM a
unsafeTcPluginTcM forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> TcM Type
TcM.zonkTcType
zonkCt :: Ct -> TcPluginM Ct
zonkCt :: Ct -> TcPluginM Ct
zonkCt = forall a. TcM a -> TcPluginM a
unsafeTcPluginTcM forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ct -> TcM Ct
TcM.zonkCt
newWanted :: CtLoc -> PredType -> TcPluginM CtEvidence
newWanted :: CtLoc -> Type -> TcPluginM CtEvidence
newWanted CtLoc
loc Type
pty
= forall a. TcM a -> TcPluginM a
unsafeTcPluginTcM (CtLoc -> Type -> TcM CtEvidence
TcM.newWantedWithLoc CtLoc
loc Type
pty)
newGiven :: EvBindsVar -> CtLoc -> PredType -> EvExpr -> TcPluginM CtEvidence
newGiven :: EvBindsVar -> CtLoc -> Type -> EvExpr -> TcPluginM CtEvidence
newGiven EvBindsVar
tc_evbinds CtLoc
loc Type
pty EvExpr
evtm = do
Id
new_ev <- Type -> TcPluginM Id
newEvVar Type
pty
EvBindsVar -> EvBind -> TcPluginM ()
setEvBind EvBindsVar
tc_evbinds forall a b. (a -> b) -> a -> b
$ Id -> EvTerm -> EvBind
mkGivenEvBind Id
new_ev (EvExpr -> EvTerm
EvExpr EvExpr
evtm)
forall (m :: * -> *) a. Monad m => a -> m a
return CtGiven { ctev_pred :: Type
ctev_pred = Type
pty, ctev_evar :: Id
ctev_evar = Id
new_ev, ctev_loc :: CtLoc
ctev_loc = CtLoc
loc }
newEvVar :: PredType -> TcPluginM EvVar
newEvVar :: Type -> TcPluginM Id
newEvVar = forall a. TcM a -> TcPluginM a
unsafeTcPluginTcM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall gbl lcl. Type -> TcRnIf gbl lcl Id
TcM.newEvVar
newCoercionHole :: PredType -> TcPluginM CoercionHole
newCoercionHole :: Type -> TcPluginM CoercionHole
newCoercionHole = forall a. TcM a -> TcPluginM a
unsafeTcPluginTcM forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> TcM CoercionHole
TcM.newCoercionHole
setEvBind :: EvBindsVar -> EvBind -> TcPluginM ()
setEvBind :: EvBindsVar -> EvBind -> TcPluginM ()
setEvBind EvBindsVar
tc_evbinds EvBind
ev_bind = do
forall a. TcM a -> TcPluginM a
unsafeTcPluginTcM forall a b. (a -> b) -> a -> b
$ EvBindsVar -> EvBind -> TcRn ()
TcM.addTcEvBind EvBindsVar
tc_evbinds EvBind
ev_bind