{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE UndecidableInstances #-}
module GHC.TcPlugin.API
(
TcPlugin(..)
, mkTcPlugin
, TcPluginStage(..), MonadTcPlugin
, TcPluginM
, tcPluginIO
, MonadTcPluginWork
, TcPluginErrorMessage(..)
, mkTcPluginErrorTy
, findImportedModule, fsLit, unpackFS, mkModuleName
, unitIdFS, stringToUnitId, pkgQual_pkg
, Module, ModuleName, FindResult(..), UnitId, PkgQual(..)
, mkVarOcc, mkDataOcc, mkTyVarOcc, mkTcOcc, mkClsOcc
, lookupOrig
, tcLookupTyCon
, tcLookupDataCon
, tcLookupClass
, tcLookupGlobal
, tcLookup
, tcLookupId
, promoteDataCon
, TcPluginSolver
#if HAS_REWRITING
, TcPluginSolveResult(..)
#else
, TcPluginSolveResult
, pattern TcPluginContradiction, pattern TcPluginOk
#endif
, tcPluginTrace
, mkNonCanonical
, Pred
, pattern ClassPred, pattern EqPred, pattern IrredPred, pattern ForAllPred
, classifyPredType, ctPred
, TyVar, CoVar
, MetaDetails, MetaInfo
, isSkolemTyVar
, isMetaTyVar, isFilledMetaTyVar_maybe
, writeMetaTyVar
, eqType
, ctLoc, ctEvidence, ctFlavour, ctEqRel, ctOrigin
, mkPluginUnivCo
, newCoercionHole
, mkReflCo, mkSymCo, mkTransCo, mkUnivCo
, mkCoercionTy, isCoercionTy, isCoercionTy_maybe
, mkPluginUnivEvTerm
, evDataConApp
, newEvVar, setEvBind
, evCoercion, evCast
, ctEvExpr
, askEvBinds, lookupEvBind, eb_lhs, eb_rhs
, newName, mkLocalId, mkTyVar
, ctev_pred, ctev_evar, ctev_loc, ctev_dest
, classDataCon
#if !MIN_VERSION_ghc(9,0,0)
, mkUncheckedIntExpr
#endif
, getInstEnvs
, newWanted, newGiven
, mkClassPred, mkPrimEqPredRole
, askDeriveds
, setCtLocM
, setCtLocRewriteM
, bumpCtLocDepth
, TcPluginRewriter, TcPluginRewriteResult(..)
, matchFam
, getFamInstEnvs
, FamInstEnv
, askRewriteEnv, rewriteEnvCtLoc, RewriteEnv
, mkTyFamAppReduction, Reduction(..)
, newUnique
, newFlexiTyVar
, isTouchableTcPluginM
, mkTyVarTy, mkTyVarTys
, isTyVarTy, getTyVar_maybe
, TcType, TcTyVar, Unique, Kind
, mkNumLitTy, isNumLitTy
, mkStrLitTy, isStrLitTy
, mkTyConTy, mkTyConApp, mkAppTy, mkAppTys
, splitTyConApp_maybe
, tyConAppTyConPicky_maybe, tyConAppTyCon_maybe
, splitAppTy_maybe, splitAppTys
, mkVisFunTyMany, mkVisFunTysMany
, mkInvisFunTy, mkInvisFunTys
, mkForAllTy, mkForAllTys
, mkPiTy, mkPiTys
#if MIN_VERSION_ghc(9,0,0)
, Mult
, pattern OneTy, pattern ManyTy
#endif
, zonkTcType
, zonkCt
, panic, pprPanic
, UniqDFM
, lookupUDFM, lookupUDFM_Directly, elemUDFM
, UniqFM
, emptyUFM, listToUFM
, getEnvs
, module GHC.Types.Basic
, Name, OccName, TyThing, TcTyThing
, MonadThings(..)
, Class(classTyCon), DataCon, TyCon, Id
, FastString
, EqRel(..), FunDep, CtFlavour
, Ct, CtLoc, CtEvidence, CtOrigin
, QCInst
, Type, PredType
, InstEnvs, TcLevel
, Coercion, Role(..), UnivCoProvenance
, CoercionHole(..)
, EvBind, EvTerm(EvExpr), EvVar, EvExpr, EvBindsVar
, Expr(Var, Type, Coercion), CoreBndr, CoreExpr
, TcEvDest(..)
, TcGblEnv, TcLclEnv
, GenLocated(..), Located, RealLocated
, unLoc, getLoc
, SDoc, Outputable(..)
)
where
import GHC
( TyThing(..) )
#if !MIN_VERSION_ghc(9,0,0)
import GHC.Builtin.Types
( intDataCon )
import GHC.Builtin.Types.Prim
( intPrimTy )
#endif
import GHC.Core
( CoreBndr, CoreExpr, Expr(..) )
import GHC.Core.Class
( Class(..), FunDep )
import GHC.Core.Coercion
( mkReflCo, mkSymCo, mkTransCo
, mkUnivCo
#if MIN_VERSION_ghc(8,10,0)
, mkPrimEqPredRole
#endif
)
import GHC.Core.Coercion.Axiom
( Role(..) )
import GHC.Core.DataCon
( DataCon
, classDataCon, promoteDataCon
)
import GHC.Core.FamInstEnv
( FamInstEnv )
import GHC.Core.InstEnv
( InstEnvs(..) )
#if !MIN_VERSION_ghc(9,0,0)
import GHC.Core.Make
( mkCoreConApps )
#endif
import GHC.Core.Predicate
( EqRel(..)
#if MIN_VERSION_ghc(8,10,0)
, Pred(..)
#else
, PredTree(..), TyCoBinder
, mkPrimEqPred, mkReprPrimEqPred
#endif
, classifyPredType, mkClassPred
)
#if HAS_REWRITING
import GHC.Core.Reduction
( Reduction(..) )
#endif
import GHC.Core.TyCon
( TyCon(..) )
#if MIN_VERSION_ghc(9,6,0)
import GHC.Core.TyCo.Compare
( eqType )
#endif
import GHC.Core.TyCo.Rep
( Type, PredType, Kind
, Coercion(..), CoercionHole(..)
, UnivCoProvenance(..)
#if MIN_VERSION_ghc(9,0,0)
, Mult
, mkVisFunTyMany, mkVisFunTysMany
#if MIN_VERSION_ghc(9,6,0)
, mkInvisFunTy, mkInvisFunTys
#else
, mkInvisFunTyMany, mkInvisFunTysMany
#endif
#elif MIN_VERSION_ghc(8,10,0)
, mkVisFunTy, mkVisFunTys
, mkInvisFunTy, mkInvisFunTys
#else
, mkFunTy, mkFunTys
#endif
#if MIN_VERSION_ghc(8,10,0)
, mkPiTy
#endif
, mkPiTys
, mkTyVarTy, mkTyVarTys
, mkForAllTy, mkForAllTys
)
import GHC.Core.Type
( mkTyConTy, mkTyConApp, splitTyConApp_maybe
, splitAppTy_maybe, splitAppTys
, tyConAppTyConPicky_maybe, tyConAppTyCon_maybe
, mkAppTy, mkAppTys, isTyVarTy, getTyVar_maybe
, mkCoercionTy, isCoercionTy, isCoercionTy_maybe
, mkNumLitTy, isNumLitTy, mkStrLitTy, isStrLitTy
#if !MIN_VERSION_ghc(9,6,0)
, eqType
#endif
#if MIN_VERSION_ghc(9,6,0)
, pattern OneTy, pattern ManyTy
#elif MIN_VERSION_ghc(9,0,0)
, pattern One, pattern Many
#endif
)
import GHC.Data.FastString
( FastString, fsLit, unpackFS )
import qualified GHC.Tc.Plugin
as GHC
import GHC.Tc.Types
( TcTyThing(..), TcGblEnv(..), TcLclEnv(..)
#if HAS_REWRITING
, TcPluginSolveResult(..), TcPluginRewriteResult(..)
, RewriteEnv(..)
#endif
)
import GHC.Tc.Types.Constraint
( Ct(..), CtLoc(..), CtEvidence(..), CtFlavour(..)
, QCInst(..), TcEvDest(..)
, ctPred, ctLoc, ctEvidence, ctEvExpr
, ctFlavour, ctEqRel, ctOrigin
, bumpCtLocDepth
, mkNonCanonical
)
import GHC.Tc.Types.Evidence
( EvBind(..), EvTerm(..), EvExpr, EvBindsVar(..)
, evCoercion, evCast, lookupEvBind, evDataConApp
)
import GHC.Tc.Types.Origin
( CtOrigin(..) )
import GHC.Tc.Utils.Monad
( newName )
import qualified GHC.Tc.Utils.Monad
as GHC
( traceTc, setCtLocM )
import GHC.Tc.Utils.TcType
( TcType, TcLevel, MetaDetails, MetaInfo
, isSkolemTyVar, isMetaTyVar
)
import GHC.Tc.Utils.TcMType
( isFilledMetaTyVar_maybe, writeMetaTyVar )
import GHC.Types.Basic
( Arity, PromotionFlag(..), isPromoted
, Boxity(..), TupleSort(..)
)
import GHC.Types.Id
( Id, mkLocalId )
#if !MIN_VERSION_ghc(9,0,0)
import GHC.Types.Literal
( Literal(..), LitNumType(..) )
#endif
import GHC.Types.Name
( Name )
import GHC.Types.Name.Occurrence
( OccName(..)
, mkVarOcc, mkDataOcc, mkTyVarOcc, mkTcOcc, mkClsOcc
)
#if MIN_VERSION_ghc(9,3,0)
import GHC.Types.PkgQual
( PkgQual(..) )
#endif
import GHC.Types.SrcLoc
( GenLocated(..), Located, RealLocated
, unLoc, getLoc
)
import GHC.Types.Unique
( Unique )
#if MIN_VERSION_ghc(9,0,0)
import GHC.Types.Unique.FM as UniqFM
( UniqFM, emptyUFM, listToUFM )
#else
import qualified GHC.Types.Unique.FM as GHC
( UniqFM )
import GHC.Types.Unique.FM as UniqFM
( emptyUFM, listToUFM )
#endif
import GHC.Types.Unique.DFM
( UniqDFM, lookupUDFM, lookupUDFM_Directly, elemUDFM )
import GHC.Types.Var
( TyVar, CoVar, TcTyVar, EvVar
, mkTyVar
)
import GHC.Utils.Outputable
( Outputable(..), SDoc
#if !MIN_VERSION_ghc(9,2,0)
, panic, pprPanic
#endif
#if !MIN_VERSION_ghc(9,3,0)
, (<+>), doubleQuotes, empty, text
#endif
)
#if MIN_VERSION_ghc(9,2,0)
import GHC.Utils.Panic
( panic, pprPanic )
#endif
#if MIN_VERSION_ghc(9,2,0)
import GHC.Unit.Finder
( FindResult(..) )
#else
import GHC.Driver.Finder
( FindResult(..) )
#endif
import GHC.Unit.Module
( UnitId, unitIdFS, stringToUnitId, mkModuleName )
#if MIN_VERSION_ghc(9,5,0)
import Language.Haskell.Syntax.Module.Name
( ModuleName )
#else
import GHC.Unit.Module.Name
( ModuleName )
#endif
import GHC.Unit.Types
( Module )
#if MIN_VERSION_ghc(9,0,0) && !MIN_VERSION_ghc(9,5,0)
import GHC.Utils.Misc
( HasDebugCallStack )
#endif
import Control.Monad.IO.Class
( MonadIO ( liftIO ) )
import GHC.TcPlugin.API.Internal
#ifndef HAS_REWRITING
import GHC.TcPlugin.API.Internal.Shim
#endif
tcPluginIO :: MonadTcPlugin m => IO a -> m a
tcPluginIO :: forall (m :: * -> *) a. MonadTcPlugin m => IO a -> m a
tcPluginIO = forall (m :: * -> *) a. MonadTcPlugin m => TcM a -> m a
unsafeLiftTcM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
tcPluginTrace :: MonadTcPlugin m
=> String
-> SDoc
-> m ()
tcPluginTrace :: forall (m :: * -> *). MonadTcPlugin m => String -> SDoc -> m ()
tcPluginTrace String
a SDoc
b = forall (m :: * -> *) a. MonadTcPlugin m => TcM a -> m a
unsafeLiftTcM forall a b. (a -> b) -> a -> b
$ String -> SDoc -> TcRn ()
GHC.traceTc String
a SDoc
b
#if MIN_VERSION_ghc(9,0,0) && !MIN_VERSION_ghc(9,5,0)
pattern OneTy, ManyTy :: Mult
pattern $bOneTy :: Mult
$mOneTy :: forall {r}. Mult -> ((# #) -> r) -> ((# #) -> r) -> r
OneTy = One
pattern $bManyTy :: Mult
$mManyTy :: forall {r}. Mult -> ((# #) -> r) -> ((# #) -> r) -> r
ManyTy = Many
mkInvisFunTy :: HasDebugCallStack => Type -> Type -> Type
mkInvisFunTy :: HasDebugCallStack => Mult -> Mult -> Mult
mkInvisFunTy = Mult -> Mult -> Mult
mkInvisFunTyMany
mkInvisFunTys :: HasDebugCallStack => [Type] -> Type -> Type
mkInvisFunTys :: HasDebugCallStack => [Mult] -> Mult -> Mult
mkInvisFunTys = [Mult] -> Mult -> Mult
mkInvisFunTysMany
#endif
#if !MIN_VERSION_ghc(9,3,0)
data PkgQual
= NoPkgQual
| ThisPkg UnitId
| OtherPkg UnitId
deriving stock ( Eq PkgQual
PkgQual -> PkgQual -> Bool
PkgQual -> PkgQual -> Ordering
PkgQual -> PkgQual -> PkgQual
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PkgQual -> PkgQual -> PkgQual
$cmin :: PkgQual -> PkgQual -> PkgQual
max :: PkgQual -> PkgQual -> PkgQual
$cmax :: PkgQual -> PkgQual -> PkgQual
>= :: PkgQual -> PkgQual -> Bool
$c>= :: PkgQual -> PkgQual -> Bool
> :: PkgQual -> PkgQual -> Bool
$c> :: PkgQual -> PkgQual -> Bool
<= :: PkgQual -> PkgQual -> Bool
$c<= :: PkgQual -> PkgQual -> Bool
< :: PkgQual -> PkgQual -> Bool
$c< :: PkgQual -> PkgQual -> Bool
compare :: PkgQual -> PkgQual -> Ordering
$ccompare :: PkgQual -> PkgQual -> Ordering
Ord, PkgQual -> PkgQual -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PkgQual -> PkgQual -> Bool
$c/= :: PkgQual -> PkgQual -> Bool
== :: PkgQual -> PkgQual -> Bool
$c== :: PkgQual -> PkgQual -> Bool
Eq )
instance Outputable PkgQual where
ppr :: PkgQual -> SDoc
ppr = \case
PkgQual
NoPkgQual -> SDoc
empty
ThisPkg UnitId
u -> SDoc -> SDoc
doubleQuotes (forall a. Outputable a => a -> SDoc
ppr UnitId
u)
OtherPkg UnitId
u -> SDoc -> SDoc
doubleQuotes (forall a. Outputable a => a -> SDoc
ppr UnitId
u)
#endif
pkgQual_pkg :: PkgQual
#if MIN_VERSION_ghc(9,3,0)
-> PkgQual
#else
-> Maybe FastString
#endif
pkgQual_pkg :: PkgQual -> Maybe FastString
pkgQual_pkg PkgQual
pkg =
#if MIN_VERSION_ghc(9,3,0)
pkg
#else
case PkgQual
pkg of
PkgQual
NoPkgQual -> forall a. Maybe a
Nothing
ThisPkg UnitId
this ->
let fs :: FastString
fs = UnitId -> FastString
unitIdFS UnitId
this
in if FastString
fs forall a. Eq a => a -> a -> Bool
== String -> FastString
fsLit String
"this"
then forall a. a -> Maybe a
Just FastString
fs
else forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"pkgQual_pkg: \'ThisPkg\' package name should be \"this\"" (String -> SDoc
text String
"pkg:" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr PkgQual
pkg)
OtherPkg UnitId
unit_id -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ UnitId -> FastString
unitIdFS UnitId
unit_id
#endif
findImportedModule :: MonadTcPlugin m
=> ModuleName
-> PkgQual
-> m FindResult
findImportedModule :: forall (m :: * -> *).
MonadTcPlugin m =>
ModuleName -> PkgQual -> m FindResult
findImportedModule ModuleName
mod_name PkgQual
pkg
= forall (m :: * -> *) a. MonadTcPlugin m => TcPluginM a -> m a
liftTcPluginM
forall a b. (a -> b) -> a -> b
$ ModuleName -> Maybe FastString -> TcPluginM FindResult
GHC.findImportedModule ModuleName
mod_name (PkgQual -> Maybe FastString
pkgQual_pkg PkgQual
pkg)
lookupOrig :: MonadTcPlugin m => Module -> OccName -> m Name
lookupOrig :: forall (m :: * -> *).
MonadTcPlugin m =>
Module -> OccName -> m Name
lookupOrig Module
md = forall (m :: * -> *) a. MonadTcPlugin m => TcPluginM a -> m a
liftTcPluginM forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module -> OccName -> TcPluginM Name
GHC.lookupOrig Module
md
tcLookupTyCon :: MonadTcPlugin m => Name -> m TyCon
tcLookupTyCon :: forall (m :: * -> *). MonadTcPlugin m => Name -> m TyCon
tcLookupTyCon = forall (m :: * -> *) a. MonadTcPlugin m => TcPluginM a -> m a
liftTcPluginM forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> TcPluginM TyCon
GHC.tcLookupTyCon
tcLookupDataCon :: MonadTcPlugin m => Name -> m DataCon
tcLookupDataCon :: forall (m :: * -> *). MonadTcPlugin m => Name -> m DataCon
tcLookupDataCon = forall (m :: * -> *) a. MonadTcPlugin m => TcPluginM a -> m a
liftTcPluginM forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> TcPluginM DataCon
GHC.tcLookupDataCon
tcLookupClass :: MonadTcPlugin m => Name -> m Class
tcLookupClass :: forall (m :: * -> *). MonadTcPlugin m => Name -> m Class
tcLookupClass = forall (m :: * -> *) a. MonadTcPlugin m => TcPluginM a -> m a
liftTcPluginM forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> TcPluginM Class
GHC.tcLookupClass
tcLookupGlobal :: MonadTcPlugin m => Name -> m TyThing
tcLookupGlobal :: forall (m :: * -> *). MonadTcPlugin m => Name -> m TyThing
tcLookupGlobal = forall (m :: * -> *) a. MonadTcPlugin m => TcPluginM a -> m a
liftTcPluginM forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> TcPluginM TyThing
GHC.tcLookupGlobal
tcLookup :: MonadTcPlugin m => Name -> m TcTyThing
tcLookup :: forall (m :: * -> *). MonadTcPlugin m => Name -> m TcTyThing
tcLookup = forall (m :: * -> *) a. MonadTcPlugin m => TcPluginM a -> m a
liftTcPluginM forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> TcPluginM TcTyThing
GHC.tcLookup
tcLookupId :: MonadTcPlugin m => Name -> m Id
tcLookupId :: forall (m :: * -> *). MonadTcPlugin m => Name -> m Id
tcLookupId = forall (m :: * -> *) a. MonadTcPlugin m => TcPluginM a -> m a
liftTcPluginM forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> TcPluginM Id
GHC.tcLookupId
getEnvs :: MonadTcPlugin m => m ( TcGblEnv, TcLclEnv )
getEnvs :: forall (m :: * -> *). MonadTcPlugin m => m (TcGblEnv, TcLclEnv)
getEnvs = forall (m :: * -> *) a. MonadTcPlugin m => TcPluginM a -> m a
liftTcPluginM TcPluginM (TcGblEnv, TcLclEnv)
GHC.getEnvs
getInstEnvs :: MonadTcPlugin m => m InstEnvs
getInstEnvs :: forall (m :: * -> *). MonadTcPlugin m => m InstEnvs
getInstEnvs = forall (m :: * -> *) a. MonadTcPlugin m => TcPluginM a -> m a
liftTcPluginM TcPluginM InstEnvs
GHC.getInstEnvs
getFamInstEnvs :: MonadTcPlugin m => m ( FamInstEnv, FamInstEnv )
getFamInstEnvs :: forall (m :: * -> *). MonadTcPlugin m => m (FamInstEnv, FamInstEnv)
getFamInstEnvs = forall (m :: * -> *) a. MonadTcPlugin m => TcPluginM a -> m a
liftTcPluginM TcPluginM (FamInstEnv, FamInstEnv)
GHC.getFamInstEnvs
matchFam :: MonadTcPlugin m
=> TyCon -> [ TcType ]
-> m ( Maybe Reduction )
matchFam :: forall (m :: * -> *).
MonadTcPlugin m =>
TyCon -> [Mult] -> m (Maybe Reduction)
matchFam TyCon
tycon [Mult]
args =
#ifndef HAS_REWRITING
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ( \ (Coercion
co,Mult
ty) -> Coercion -> Mult -> Reduction
mkReduction (Coercion -> Coercion
mkSymCo Coercion
co) Mult
ty ) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
#endif
( forall (m :: * -> *) a. MonadTcPlugin m => TcPluginM a -> m a
liftTcPluginM forall a b. (a -> b) -> a -> b
$ TyCon -> [Mult] -> TcPluginM (Maybe (Coercion, Mult))
GHC.matchFam TyCon
tycon [Mult]
args )
newUnique :: MonadTcPlugin m => m Unique
newUnique :: forall (m :: * -> *). MonadTcPlugin m => m Unique
newUnique = forall (m :: * -> *) a. MonadTcPlugin m => TcPluginM a -> m a
liftTcPluginM TcPluginM Unique
GHC.newUnique
newFlexiTyVar :: MonadTcPlugin m => Kind -> m TcTyVar
newFlexiTyVar :: forall (m :: * -> *). MonadTcPlugin m => Mult -> m Id
newFlexiTyVar = forall (m :: * -> *) a. MonadTcPlugin m => TcPluginM a -> m a
liftTcPluginM forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mult -> TcPluginM Id
GHC.newFlexiTyVar
isTouchableTcPluginM :: MonadTcPlugin m => TcTyVar -> m Bool
isTouchableTcPluginM :: forall (m :: * -> *). MonadTcPlugin m => Id -> m Bool
isTouchableTcPluginM = forall (m :: * -> *) a. MonadTcPlugin m => TcPluginM a -> m a
liftTcPluginM forall b c a. (b -> c) -> (a -> b) -> a -> c
. Id -> TcPluginM Bool
GHC.isTouchableTcPluginM
zonkTcType :: MonadTcPluginWork m => TcType -> m TcType
zonkTcType :: forall (m :: * -> *). MonadTcPluginWork m => Mult -> m Mult
zonkTcType = forall (m :: * -> *) a. MonadTcPlugin m => TcPluginM a -> m a
liftTcPluginM forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mult -> TcPluginM Mult
GHC.zonkTcType
zonkCt :: MonadTcPluginWork m => Ct -> m Ct
zonkCt :: forall (m :: * -> *). MonadTcPluginWork m => Ct -> m Ct
zonkCt = forall (m :: * -> *) a. MonadTcPlugin m => TcPluginM a -> m a
liftTcPluginM forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ct -> TcPluginM Ct
GHC.zonkCt
newWanted :: MonadTcPluginWork m => CtLoc -> PredType -> m CtEvidence
newWanted :: forall (m :: * -> *).
MonadTcPluginWork m =>
CtLoc -> Mult -> m CtEvidence
newWanted CtLoc
loc Mult
pty =
#if !HAS_REWRITING
forall (m :: * -> *) a. MonadTcPluginWork m => CtLoc -> m a -> m a
setCtLocM CtLoc
loc forall a b. (a -> b) -> a -> b
$
#endif
forall (m :: * -> *) a. MonadTcPlugin m => TcPluginM a -> m a
liftTcPluginM forall a b. (a -> b) -> a -> b
$ CtLoc -> Mult -> TcPluginM CtEvidence
GHC.newWanted CtLoc
loc Mult
pty
newGiven :: CtLoc -> PredType -> EvExpr -> TcPluginM Solve CtEvidence
newGiven :: CtLoc -> Mult -> EvExpr -> TcPluginM 'Solve CtEvidence
newGiven CtLoc
loc Mult
pty EvExpr
evtm = do
#if HAS_REWRITING
tc_evbinds <- askEvBinds
liftTcPluginM $ GHC.newGiven tc_evbinds loc pty evtm
#else
forall (m :: * -> *) a. MonadTcPlugin m => TcPluginM a -> m a
liftTcPluginM forall a b. (a -> b) -> a -> b
$ CtLoc -> Mult -> EvExpr -> TcPluginM CtEvidence
GHC.newGiven CtLoc
loc Mult
pty EvExpr
evtm
#endif
rewriteEnvCtLoc :: RewriteEnv -> CtLoc
rewriteEnvCtLoc :: RewriteEnv -> CtLoc
rewriteEnvCtLoc =
#if MIN_VERSION_ghc(9,3,0)
re_loc
#else
RewriteEnv -> CtLoc
fe_loc
#endif
setCtLocM :: MonadTcPluginWork m => CtLoc -> m a -> m a
setCtLocM :: forall (m :: * -> *) a. MonadTcPluginWork m => CtLoc -> m a -> m a
setCtLocM CtLoc
loc = forall (m :: * -> *) a b.
MonadTcPlugin m =>
(TcM a -> TcM b) -> m a -> m b
unsafeLiftThroughTcM ( forall a. CtLoc -> TcM a -> TcM a
GHC.setCtLocM CtLoc
loc )
setCtLocRewriteM :: TcPluginM Rewrite a -> TcPluginM Rewrite a
setCtLocRewriteM :: forall a. TcPluginM 'Rewrite a -> TcPluginM 'Rewrite a
setCtLocRewriteM TcPluginM 'Rewrite a
ma = do
CtLoc
rewriteCtLoc <- RewriteEnv -> CtLoc
rewriteEnvCtLoc forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TcPluginM 'Rewrite RewriteEnv
askRewriteEnv
forall (m :: * -> *) a. MonadTcPluginWork m => CtLoc -> m a -> m a
setCtLocM CtLoc
rewriteCtLoc TcPluginM 'Rewrite a
ma
newEvVar :: PredType -> TcPluginM Solve EvVar
newEvVar :: Mult -> TcPluginM 'Solve Id
newEvVar = forall (m :: * -> *) a. MonadTcPlugin m => TcPluginM a -> m a
liftTcPluginM forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mult -> TcPluginM Id
GHC.newEvVar
newCoercionHole :: PredType -> TcPluginM Solve CoercionHole
newCoercionHole :: Mult -> TcPluginM 'Solve CoercionHole
newCoercionHole = forall (m :: * -> *) a. MonadTcPlugin m => TcPluginM a -> m a
liftTcPluginM forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mult -> TcPluginM CoercionHole
GHC.newCoercionHole
setEvBind :: EvBind -> TcPluginM Solve ()
setEvBind :: EvBind -> TcPluginM 'Solve ()
setEvBind EvBind
ev_bind = do
#if HAS_REWRITING
tc_evbinds <- askEvBinds
liftTcPluginM $ GHC.setEvBind tc_evbinds ev_bind
#else
forall (m :: * -> *) a. MonadTcPlugin m => TcPluginM a -> m a
liftTcPluginM forall a b. (a -> b) -> a -> b
$ EvBind -> TcPluginM ()
GHC.setEvBind EvBind
ev_bind
#endif
mkPluginUnivCo
:: String
-> Role
-> TcType
-> TcType
-> Coercion
mkPluginUnivCo :: String -> Role -> Mult -> Mult -> Coercion
mkPluginUnivCo String
str Role
role Mult
lhs Mult
rhs = UnivCoProvenance -> Role -> Mult -> Mult -> Coercion
mkUnivCo ( String -> UnivCoProvenance
PluginProv String
str ) Role
role Mult
lhs Mult
rhs
mkPluginUnivEvTerm
:: String
-> Role
-> TcType
-> TcType
-> EvTerm
mkPluginUnivEvTerm :: String -> Role -> Mult -> Mult -> EvTerm
mkPluginUnivEvTerm String
str Role
role Mult
lhs Mult
rhs = Coercion -> EvTerm
evCoercion forall a b. (a -> b) -> a -> b
$ String -> Role -> Mult -> Mult -> Coercion
mkPluginUnivCo String
str Role
role Mult
lhs Mult
rhs
mkTyFamAppReduction
:: String
-> Role
-> TyCon
-> [TcType]
-> TcType
-> Reduction
mkTyFamAppReduction :: String -> Role -> TyCon -> [Mult] -> Mult -> Reduction
mkTyFamAppReduction String
str Role
role TyCon
tc [Mult]
args Mult
ty =
Coercion -> Mult -> Reduction
Reduction ( String -> Role -> Mult -> Mult -> Coercion
mkPluginUnivCo String
str Role
role ( TyCon -> [Mult] -> Mult
mkTyConApp TyCon
tc [Mult]
args ) Mult
ty ) Mult
ty
#if !MIN_VERSION_ghc(9,0,0)
type UniqFM ty a = GHC.UniqFM a
mkUncheckedIntExpr :: Integer -> CoreExpr
mkUncheckedIntExpr i = mkCoreConApps intDataCon [Lit lit]
where
lit = LitNumber LitNumInt i intPrimTy
#if MIN_VERSION_ghc(8,10,0)
mkVisFunTyMany :: Type -> Type -> Type
mkVisFunTyMany = mkVisFunTy
mkVisFunTysMany :: [Type] -> Type -> Type
mkVisFunTysMany = mkVisFunTys
#else
type Pred = PredTree
mkInvisFunTy, mkVisFunTyMany :: Type -> Type -> Type
mkInvisFunTy = mkFunTy
mkVisFunTyMany = mkFunTy
mkInvisFunTys, mkVisFunTysMany :: [Type] -> Type -> Type
mkInvisFunTys = mkFunTys
mkVisFunTysMany = mkFunTys
mkPiTy :: TyCoBinder -> Type -> Type
mkPiTy bndr ty = mkPiTys [bndr] ty
mkPrimEqPredRole :: Role -> Type -> Type -> PredType
mkPrimEqPredRole Nominal = mkPrimEqPred
mkPrimEqPredRole Representational = mkReprPrimEqPred
mkPrimEqPredRole Phantom = panic "mkPrimEqPredRole phantom"
#endif
#endif