{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module GHC.TypeLits.Presburger.Compat (module GHC.TypeLits.Presburger.Compat) where
import Data.Coerce (coerce)
import Data.Function (on)
import Data.Functor ((<&>))
import Data.Generics.Twins
import GHC.Builtin.Names as GHC.TypeLits.Presburger.Compat (gHC_TYPENATS)
import GHC.Tc.Types.Constraint as GHC.TypeLits.Presburger.Compat (CtLoc (..), initialSubGoalDepth)
import GHC.Tc.Types.Origin as GHC.TypeLits.Presburger.Compat (CtOrigin (..))
import GHC.TcPluginM.Extra as GHC.TypeLits.Presburger.Compat (
evByFiat,
lookupModule,
lookupName,
tracePlugin,
)
#if MIN_VERSION_ghc(9,4,1)
import GHC.Tc.Types as GHC.TypeLits.Presburger.Compat (TcPlugin (..), TcPluginSolveResult (..))
import GHC.Builtin.Types as GHC.TypeLits.Presburger.Compat (cTupleTyCon, cTupleDataCon)
import GHC.Tc.Types.Evidence as GHC.TypeLits.Presburger.Compat (evCast)
import GHC.Plugins as GHC.TypeLits.Presburger.Compat (mkUnivCo)
import GHC.Core.TyCo.Rep as GHC.TypeLits.Presburger.Compat (UnivCoProvenance(..))
import GHC.Core.DataCon as GHC.TypeLits.Presburger.Compat (dataConWrapId)
#else
import GHC.Tc.Types as GHC.TypeLits.Presburger.Compat (TcPlugin (..), TcPluginResult (..))
#endif
#if MIN_VERSION_ghc(9,4,1)
import GHC.Builtin.Names as GHC.TypeLits.Presburger.Compat (mkBaseModule, gHC_TYPEERROR)
import GHC.Core.Reduction (reductionReducedType)
#else
import GHC.Builtin.Names as GHC.TypeLits.Presburger.Compat (dATA_TYPE_EQUALITY)
import qualified GHC.Builtin.Names as Old
#endif
import GHC.Builtin.Types as GHC.TypeLits.Presburger.Compat (
boolTyCon,
eqTyConName,
promotedEQDataCon,
promotedGTDataCon,
promotedLTDataCon,
)
import qualified GHC.Builtin.Types as TysWiredIn
import GHC.Builtin.Types.Literals as GHC.TypeLits.Presburger.Compat
import GHC.Core.Class as GHC.TypeLits.Presburger.Compat (className, classTyCon)
import GHC.Core.FamInstEnv as GHC.TypeLits.Presburger.Compat
import GHC.Core.Predicate as GHC.TypeLits.Presburger.Compat (EqRel (..), Pred (..), isEqPred, mkPrimEqPredRole)
import qualified GHC.Core.Predicate as Old (classifyPredType)
import GHC.Core.TyCo.Rep as GHC.TypeLits.Presburger.Compat (TyLit (NumTyLit), Type (..))
import GHC.Core.TyCon as GHC.TypeLits.Presburger.Compat
import qualified GHC.Core.Type as Old
import GHC.Core.Unify as Old (tcUnifyTy)
import GHC.Data.FastString as GHC.TypeLits.Presburger.Compat (FastString, fsLit, unpackFS)
import GHC.Hs as GHC.TypeLits.Presburger.Compat (HsModule (..), NoExtField (..))
import GHC.Hs.Extension as GHC.TypeLits.Presburger.Compat (GhcPs)
import GHC.Hs.ImpExp as GHC.TypeLits.Presburger.Compat (ImportDecl (..), ImportDeclQualifiedStyle (..))
import GHC.Unit.Types (Module, UnitId, toUnitId)
import GHC.Unit.Types as GHC.TypeLits.Presburger.Compat (mkModule)
#if MIN_VERSION_ghc(9,2,0)
import GHC.Driver.Env.Types as GHC.TypeLits.Presburger.Compat (HscEnv (hsc_dflags))
#else
import GHC.Driver.Types as GHC.TypeLits.Presburger.Compat (HscEnv (hsc_dflags))
import GHC.Driver.Session (unitState, unitDatabases)
#endif
import GHC.Plugins (InScopeSet, Name, Outputable, Unit, emptyUFM, moduleUnit)
#if MIN_VERSION_ghc(9,2,0)
import GHC.Hs as GHC.TypeLits.Presburger.Compat (HsParsedModule(..))
import GHC.Types.TyThing as GHC.TypeLits.Presburger.Compat (lookupTyCon)
import GHC.Builtin.Types (naturalTy)
#else
import GHC.Plugins as GHC.TypeLits.Presburger.Compat
( HsParsedModule(..),
lookupTyCon,
typeNatKind
)
#endif
#if MIN_VERSION_ghc(9,6,1)
import GHC.Plugins as GHC.TypeLits.Presburger.Compat
( Subst (..),
emptySubst,
unionSubst,
)
import GHC.Core.TyCo.Compare as GHC.TypeLits.Presburger.Compat
(eqType)
#else
import GHC.Plugins as GHC.TypeLits.Presburger.Compat
( TCvSubst (..),
emptyTCvSubst,
eqType,
unionTCvSubst,
)
#endif
import GHC.Core.InstEnv as GHC.TypeLits.Presburger.Compat (classInstances)
import GHC.Plugins as GHC.TypeLits.Presburger.Compat (
GenericUnitInfo (..),
Hsc,
PackageName (..),
Plugin (..),
TvSubstEnv,
TyVar,
UnitDatabase (..),
consDataCon,
defaultPlugin,
elementOfUniqSet,
isNumLitTy,
isStrLitTy,
mkTcOcc,
mkTyConTy,
mkTyVarTy,
mkUniqSet,
nilDataCon,
ppr,
promotedFalseDataCon,
promotedTrueDataCon,
purePlugin,
splitTyConApp,
splitTyConApp_maybe,
text,
tyConAppTyCon_maybe,
typeKind,
)
import GHC.Tc.Plugin (lookupOrig)
#if MIN_VERSION_ghc(9,2,0)
import GHC.Tc.Plugin (unsafeTcPluginTcM)
import GHC.Utils.Logger (getLogger)
import GHC.Unit.Types as GHC.TypeLits.Presburger.Compat (IsBootInterface(..))
#else
import GHC.Driver.Types as GHC.TypeLits.Presburger.Compat (IsBootInterface(..))
#endif
import GHC.Tc.Plugin as GHC.TypeLits.Presburger.Compat (
TcPluginM,
getInstEnvs,
getTopEnv,
lookupOrig,
matchFam,
newFlexiTyVar,
newWanted,
tcLookupClass,
tcLookupTyCon,
tcPluginIO,
tcPluginTrace,
)
import GHC.Tc.Types as GHC.TypeLits.Presburger.Compat (TcPlugin (..))
import GHC.Tc.Types.Constraint as GHC.TypeLits.Presburger.Compat (
Ct,
CtEvidence,
ctEvPred,
ctEvidence,
isWanted,
)
import GHC.Tc.Types.Evidence as GHC.TypeLits.Presburger.Compat (EvTerm)
import GHC.Tc.Utils.Monad as GHC.TypeLits.Presburger.Compat (getCtLocM, unsafeTcPluginTcM)
import GHC.Tc.Utils.TcType (TcTyVar, TcType)
import GHC.Tc.Utils.TcType as GHC.TypeLits.Presburger.Compat (tcTyFamInsts)
import qualified GHC.TcPluginM.Extra as Extra
import GHC.Types.Name.Occurrence as GHC.TypeLits.Presburger.Compat (emptyOccSet, mkInstTyTcOcc)
import GHC.Types.Unique as GHC.TypeLits.Presburger.Compat (getKey, getUnique)
import GHC.Unit.Module as GHC.TypeLits.Presburger.Compat (ModuleName, mkModuleName)
import GHC.Unit.State (UnitState (preloadUnits), initUnits)
import GHC.Unit.State as GHC.TypeLits.Presburger.Compat (lookupPackageName)
import GHC.Unit.Types (UnitId (..), fsToUnit, toUnitId)
import GHC.Utils.Outputable as GHC.TypeLits.Presburger.Compat (showSDocUnsafe)
#if !MIN_VERSION_ghc(9,4,1)
type TcPluginSolveResult = TcPluginResult
#endif
#if MIN_VERSION_ghc(9,4,1)
dATA_TYPE_EQUALITY :: Module
dATA_TYPE_EQUALITY = mkBaseModule "Data.Type.Equality"
#endif
type PredTree = Pred
data TvSubst = TvSubst InScopeSet TvSubstEnv
#if MIN_VERSION_ghc(9,6,1)
type TCvSubst = Subst
unionTCvSubst :: TCvSubst -> TCvSubst -> TCvSubst
unionTCvSubst = unionSubst
emptyTCvSubst :: Subst
emptyTCvSubst = emptySubst
#endif
instance Outputable TvSubst where
ppr :: TvSubst -> SDoc
ppr = forall a. Outputable a => a -> SDoc
ppr forall b c a. (b -> c) -> (a -> b) -> a -> c
. TvSubst -> TCvSubst
toTCv
emptyTvSubst :: TvSubst
#if MIN_VERSION_ghc(9,6,1)
emptyTvSubst = case emptyTCvSubst of
Subst set _ tvsenv _ -> TvSubst set tvsenv
#else
emptyTvSubst :: TvSubst
emptyTvSubst = case TCvSubst
emptyTCvSubst of
TCvSubst InScopeSet
set TvSubstEnv
tvsenv CvSubstEnv
_ -> InScopeSet -> TvSubstEnv -> TvSubst
TvSubst InScopeSet
set TvSubstEnv
tvsenv
#endif
toTCv :: TvSubst -> TCvSubst
#if MIN_VERSION_ghc(9,6,1)
toTCv (TvSubst set tvenv) = Subst set emptyUFM tvenv emptyUFM
#else
toTCv :: TvSubst -> TCvSubst
toTCv (TvSubst InScopeSet
set TvSubstEnv
tvenv) = InScopeSet -> TvSubstEnv -> CvSubstEnv -> TCvSubst
TCvSubst InScopeSet
set TvSubstEnv
tvenv forall key elt. UniqFM key elt
emptyUFM
#endif
substTy :: TvSubst -> Type -> Type
substTy :: TvSubst -> Type -> Type
substTy TvSubst
tvs = HasCallStack => TCvSubst -> Type -> Type
Old.substTy (TvSubst -> TCvSubst
toTCv TvSubst
tvs)
unionTvSubst :: TvSubst -> TvSubst -> TvSubst
unionTvSubst :: TvSubst -> TvSubst -> TvSubst
unionTvSubst TvSubst
s1 TvSubst
s2 =
TCvSubst -> TvSubst
fromTCv forall a b. (a -> b) -> a -> b
$ TCvSubst -> TCvSubst -> TCvSubst
unionTCvSubst (TvSubst -> TCvSubst
toTCv TvSubst
s1) (TvSubst -> TCvSubst
toTCv TvSubst
s2)
fromTCv :: TCvSubst -> TvSubst
#if MIN_VERSION_ghc(9,6,1)
fromTCv (Subst set _ tvsenv _) = TvSubst set tvsenv
#else
fromTCv :: TCvSubst -> TvSubst
fromTCv (TCvSubst InScopeSet
set TvSubstEnv
tvsenv CvSubstEnv
_) = InScopeSet -> TvSubstEnv -> TvSubst
TvSubst InScopeSet
set TvSubstEnv
tvsenv
#endif
promotedBoolTyCon :: TyCon
promotedBoolTyCon :: TyCon
promotedBoolTyCon = TyCon
boolTyCon
viewFunTy :: Type -> Maybe (Type, Type)
viewFunTy :: Type -> Maybe (Type, Type)
viewFunTy t :: Type
t@(TyConApp TyCon
_ [Type
t1, Type
t2])
| Type -> Bool
Old.isFunTy Type
t = forall a. a -> Maybe a
Just (Type
t1, Type
t2)
viewFunTy Type
_ = forall a. Maybe a
Nothing
tcUnifyTy :: Type -> Type -> Maybe TvSubst
tcUnifyTy :: Type -> Type -> Maybe TvSubst
tcUnifyTy Type
t1 Type
t2 = TCvSubst -> TvSubst
fromTCv forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> Type -> Maybe TCvSubst
Old.tcUnifyTy Type
t1 Type
t2
getEqTyCon :: TcPluginM TyCon
getEqTyCon :: TcPluginM TyCon
getEqTyCon =
forall (m :: * -> *) a. Monad m => a -> m a
return TyCon
TysWiredIn.eqTyCon
getEqWitnessTyCon :: TcPluginM TyCon
getEqWitnessTyCon :: TcPluginM TyCon
getEqWitnessTyCon = do
Module
md <- ModuleName -> FastString -> TcPluginM Module
lookupModule (String -> ModuleName
mkModuleName String
"Data.Type.Equality") (String -> FastString
fsLit String
"base")
Name -> TcPluginM TyCon
tcLookupTyCon forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Module -> OccName -> TcPluginM Name
lookupOrig Module
md (String -> OccName
mkTcOcc String
":~:")
decompFunTy :: Type -> [Type]
decompFunTy :: Type -> [Type]
decompFunTy (FunTy AnonArgFlag
_ Type
_ Type
t1 Type
t2) = Type
t1 forall a. a -> [a] -> [a]
: Type -> [Type]
decompFunTy Type
t2
decompFunTy Type
t = [Type
t]
newtype TypeEq = TypeEq {TypeEq -> Type
runTypeEq :: Type}
instance Eq TypeEq where
== :: TypeEq -> TypeEq -> Bool
(==) = forall a. Data a => a -> a -> Bool
geq forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` TypeEq -> Type
runTypeEq
instance Ord TypeEq where
compare :: TypeEq -> TypeEq -> Ordering
compare = forall a. Data a => a -> a -> Ordering
gcompare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` TypeEq -> Type
runTypeEq
isTrivial :: Old.PredType -> Bool
isTrivial :: Type -> Bool
isTrivial Type
ty =
case Type -> PredTree
classifyPredType Type
ty of
EqPred EqRel
_ Type
l Type
r -> Type
l Type -> Type -> Bool
`eqType` Type
r
PredTree
_ -> Bool
False
normaliseGivens ::
[Ct] -> TcPluginM [Ct]
normaliseGivens :: [Ct] -> TcPluginM [Ct]
normaliseGivens =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> Bool
isTrivial forall b c a. (b -> c) -> (a -> b) -> a -> c
. CtEvidence -> Type
ctEvPred forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ct -> CtEvidence
ctEvidence))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a] -> [a]
(++)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> a
id
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Ct] -> [Ct]
Extra.flattenGivens
#if MIN_VERSION_ghc(8,4,1)
type Substitution = [(TcTyVar, TcType)]
#else
type Substitution = TvSubst
#endif
subsCt :: Substitution -> Ct -> Ct
subsCt :: Substitution -> Ct -> Ct
subsCt = Substitution -> Ct -> Ct
Extra.substCt
subsType :: Substitution -> Type -> Type
subsType :: Substitution -> Type -> Type
subsType = Substitution -> Type -> Type
Extra.substType
mkSubstitution :: [Ct] -> Substitution
mkSubstitution :: [Ct] -> Substitution
mkSubstitution = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Ct] -> [((TcTyVar, Type), Ct)]
Extra.mkSubst'
classifyPredType :: Type -> PredTree
classifyPredType :: Type -> PredTree
classifyPredType Type
ty = case Type -> PredTree
Old.classifyPredType Type
ty of
e :: PredTree
e@EqPred {} -> PredTree
e
ClassPred Class
cls [Type
_, Type
t1, Type
t2]
| Class -> Name
className Class
cls forall a. Eq a => a -> a -> Bool
== Name
eqTyConName ->
EqRel -> Type -> Type -> PredTree
EqPred EqRel
NomEq Type
t1 Type
t2
PredTree
e -> PredTree
e
fsToUnitId :: FastString -> UnitId
fsToUnitId :: FastString -> UnitId
fsToUnitId = Unit -> UnitId
toUnitId forall b c a. (b -> c) -> (a -> b) -> a -> c
. FastString -> Unit
fsToUnit
loadedPackageNames ::
[UnitDatabase UnitId] ->
UnitState ->
[RawPackageName]
loadedPackageNames :: [UnitDatabase UnitId] -> UnitState -> [FastString]
loadedPackageNames [UnitDatabase UnitId]
unitDb UnitState
us =
let preloads :: UniqSet FastString
preloads = forall a. Uniquable a => [a] -> UniqSet a
mkUniqSet forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(UnitId FastString
p) -> FastString
p) forall a b. (a -> b) -> a -> b
$ UnitState -> [UnitId]
preloadUnits UnitState
us
ents :: [GenericUnitInfo
(Indefinite UnitId) PackageId PackageName UnitId ModuleName Module]
ents = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Uniquable a => a -> UniqSet a -> Bool
`elementOfUniqSet` UniqSet FastString
preloads) forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnitId -> FastString
unitIdFS forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> uid
unitId) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall unit. UnitDatabase unit -> [GenUnitInfo unit]
unitDatabaseUnits [UnitDatabase UnitId]
unitDb
in forall a b. (a -> b) -> [a] -> [b]
map (coerce :: forall a b. Coercible a b => a -> b
coerce forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall compid srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
-> srcpkgname
unitPackageName) [GenericUnitInfo
(Indefinite UnitId) PackageId PackageName UnitId ModuleName Module]
ents
type RawPackageName = FastString
preloadedUnitsM :: TcPluginM [RawPackageName]
#if MIN_VERSION_ghc(9,4,0)
preloadedUnitsM = do
logger <- unsafeTcPluginTcM getLogger
dflags <- hsc_dflags <$> getTopEnv
packNames <- tcPluginIO $ initUnits logger dflags Nothing mempty <&>
\(unitDb, us, _, _ ) -> loadedPackageNames unitDb us
tcPluginTrace "pres: packs" $ ppr packNames
pure $ coerce packNames
#elif MIN_VERSION_ghc(9,2,0)
preloadedUnitsM :: TcPluginM [FastString]
preloadedUnitsM = do
Logger
logger <- forall a. TcM a -> TcPluginM a
unsafeTcPluginTcM forall (m :: * -> *). HasLogger m => m Logger
getLogger
DynFlags
dflags <- HscEnv -> DynFlags
hsc_dflags forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TcPluginM HscEnv
getTopEnv
[FastString]
packNames <- forall a. IO a -> TcPluginM a
tcPluginIO forall a b. (a -> b) -> a -> b
$ Logger
-> DynFlags
-> Maybe [UnitDatabase UnitId]
-> IO
([UnitDatabase UnitId], UnitState, HomeUnit,
Maybe PlatformConstants)
initUnits Logger
logger DynFlags
dflags forall a. Maybe a
Nothing forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&>
\([UnitDatabase UnitId]
unitDb, UnitState
us, HomeUnit
_, Maybe PlatformConstants
_ ) -> [UnitDatabase UnitId] -> UnitState -> [FastString]
loadedPackageNames [UnitDatabase UnitId]
unitDb UnitState
us
String -> SDoc -> TcPluginM ()
tcPluginTrace String
"pres: packs" forall a b. (a -> b) -> a -> b
$ forall a. Outputable a => a -> SDoc
ppr [FastString]
packNames
forall (f :: * -> *) a. Applicative f => a -> f a
pure [FastString]
packNames
#elif MIN_VERSION_ghc(9,0,0)
preloadedUnitsM = do
dflags <- hsc_dflags <$> getTopEnv
packNames <- tcPluginIO $ initUnits dflags <&> \dfs' ->
let st = unitState dfs'
db = maybe [] id $ unitDatabases dfs'
in loadedPackageNames db st
tcPluginTrace "pres: packs" $ ppr packNames
pure packNames
#else
preloadedUnitsM = do
dflags <- hsc_dflags <$> getTopEnv
(dfs', packs) <- tcPluginIO $ initPackages dflags
let db = listPackageConfigMap dfs'
loadeds = mkUniqSet $ map (\(InstalledUnitId p) -> p) packs
packNames = map (coerce . packageName) $
filter ((`elementOfUniqSet` loadeds) . coerce . unitId) db
tcPluginTrace "pres: packs" $ ppr packNames
pure packNames
#endif
type ModuleUnit = Unit
moduleUnit' :: Module -> ModuleUnit
moduleUnit' :: Module -> Unit
moduleUnit' = forall unit. GenModule unit -> unit
moduleUnit
noExtField :: NoExtField
noExtField :: NoExtField
noExtField = NoExtField
NoExtField
type HsModule' = HsModule
#if MIN_VERSION_ghc(9,2,0)
typeNatKind :: TcType
typeNatKind :: Type
typeNatKind = Type
naturalTy
#endif
mtypeNatLeqTyCon :: Maybe TyCon
#if MIN_VERSION_ghc(9,2,0)
mtypeNatLeqTyCon :: Maybe TyCon
mtypeNatLeqTyCon = forall a. Maybe a
Nothing
#else
mtypeNatLeqTyCon = Just typeNatLeqTyCon
#endif
lookupTyNatPredLeq :: TcPluginM Name
#if MIN_VERSION_ghc(9,2,0)
lookupTyNatPredLeq :: TcPluginM Name
lookupTyNatPredLeq = do
Module
tyOrd <- ModuleName -> FastString -> TcPluginM Module
lookupModule (String -> ModuleName
mkModuleName String
"Data.Type.Ord") FastString
"base"
Module -> OccName -> TcPluginM Name
lookupOrig Module
tyOrd (String -> OccName
mkTcOcc String
"<=")
#else
lookupTyNatPredLeq =
lookupOrig gHC_TYPENATS (mkTcOcc "<=")
#endif
lookupTyNatBoolLeq :: TcPluginM TyCon
#if MIN_VERSION_ghc(9,2,0)
lookupTyNatBoolLeq :: TcPluginM TyCon
lookupTyNatBoolLeq = do
Module
tyOrd <- ModuleName -> FastString -> TcPluginM Module
lookupModule (String -> ModuleName
mkModuleName String
"Data.Type.Ord") FastString
"base"
Name -> TcPluginM TyCon
tcLookupTyCon forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Module -> OccName -> TcPluginM Name
lookupOrig Module
tyOrd (String -> OccName
mkTcOcc String
"<=?")
#else
lookupTyNatBoolLeq =
pure typeNatLeqTyCon
#endif
lookupAssertTyCon :: TcPluginM (Maybe TyCon)
#if MIN_VERSION_base(4,17,0)
lookupAssertTyCon =
fmap Just . tcLookupTyCon =<< lookupOrig gHC_TYPEERROR (mkTcOcc "Assert")
#else
lookupAssertTyCon :: TcPluginM (Maybe TyCon)
lookupAssertTyCon = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
#endif
lookupTyNatPredLt :: TcPluginM (Maybe TyCon)
#if MIN_VERSION_ghc(9,2,2)
lookupTyNatPredLt :: TcPluginM (Maybe TyCon)
lookupTyNatPredLt = forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
Module
tyOrd <- ModuleName -> FastString -> TcPluginM Module
lookupModule (String -> ModuleName
mkModuleName String
"Data.Type.Ord") FastString
"base"
Name -> TcPluginM TyCon
tcLookupTyCon forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Module -> OccName -> TcPluginM Name
lookupOrig Module
tyOrd (String -> OccName
mkTcOcc String
"<")
#else
lookupTyNatPredLt = pure Nothing
#endif
lookupTyNatBoolLt :: TcPluginM (Maybe TyCon)
#if MIN_VERSION_ghc(9,2,0)
lookupTyNatBoolLt :: TcPluginM (Maybe TyCon)
lookupTyNatBoolLt = forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
Module
tyOrd <- ModuleName -> FastString -> TcPluginM Module
lookupModule (String -> ModuleName
mkModuleName String
"Data.Type.Ord") FastString
"base"
Name -> TcPluginM TyCon
tcLookupTyCon forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Module -> OccName -> TcPluginM Name
lookupOrig Module
tyOrd (String -> OccName
mkTcOcc String
"<?")
#else
lookupTyNatBoolLt = pure Nothing
#endif
lookupTyNatPredGt :: TcPluginM (Maybe TyCon)
#if MIN_VERSION_ghc(9,2,0)
lookupTyNatPredGt :: TcPluginM (Maybe TyCon)
lookupTyNatPredGt = forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
Module
tyOrd <- ModuleName -> FastString -> TcPluginM Module
lookupModule (String -> ModuleName
mkModuleName String
"Data.Type.Ord") FastString
"base"
Name -> TcPluginM TyCon
tcLookupTyCon forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Module -> OccName -> TcPluginM Name
lookupOrig Module
tyOrd (String -> OccName
mkTcOcc String
">")
#else
lookupTyNatPredGt = pure Nothing
#endif
lookupTyNatBoolGt :: TcPluginM (Maybe TyCon)
#if MIN_VERSION_ghc(9,2,0)
lookupTyNatBoolGt :: TcPluginM (Maybe TyCon)
lookupTyNatBoolGt = forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
Module
tyOrd <- ModuleName -> FastString -> TcPluginM Module
lookupModule (String -> ModuleName
mkModuleName String
"Data.Type.Ord") FastString
"base"
Name -> TcPluginM TyCon
tcLookupTyCon forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Module -> OccName -> TcPluginM Name
lookupOrig Module
tyOrd (String -> OccName
mkTcOcc String
">?")
#else
lookupTyNatBoolGt = pure Nothing
#endif
lookupTyNatPredGeq :: TcPluginM (Maybe TyCon)
#if MIN_VERSION_ghc(9,2,0)
lookupTyNatPredGeq :: TcPluginM (Maybe TyCon)
lookupTyNatPredGeq = forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
Module
tyOrd <- ModuleName -> FastString -> TcPluginM Module
lookupModule (String -> ModuleName
mkModuleName String
"Data.Type.Ord") FastString
"base"
Name -> TcPluginM TyCon
tcLookupTyCon forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Module -> OccName -> TcPluginM Name
lookupOrig Module
tyOrd (String -> OccName
mkTcOcc String
">=")
#else
lookupTyNatPredGeq = pure Nothing
#endif
lookupTyNatBoolGeq :: TcPluginM (Maybe TyCon)
#if MIN_VERSION_ghc(9,2,0)
lookupTyNatBoolGeq :: TcPluginM (Maybe TyCon)
lookupTyNatBoolGeq = forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
Module
tyOrd <- ModuleName -> FastString -> TcPluginM Module
lookupModule (String -> ModuleName
mkModuleName String
"Data.Type.Ord") FastString
"base"
Name -> TcPluginM TyCon
tcLookupTyCon forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Module -> OccName -> TcPluginM Name
lookupOrig Module
tyOrd (String -> OccName
mkTcOcc String
">=?")
#else
lookupTyNatBoolGeq = pure Nothing
#endif
mOrdCondTyCon :: TcPluginM (Maybe TyCon)
#if MIN_VERSION_ghc(9,2,0)
mOrdCondTyCon :: TcPluginM (Maybe TyCon)
mOrdCondTyCon = forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
Module
tyOrd <- ModuleName -> FastString -> TcPluginM Module
lookupModule (String -> ModuleName
mkModuleName String
"Data.Type.Ord") FastString
"base"
Name -> TcPluginM TyCon
tcLookupTyCon forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Module -> OccName -> TcPluginM Name
lookupOrig Module
tyOrd (String -> OccName
mkTcOcc String
"OrdCond")
#else
mOrdCondTyCon = pure Nothing
#endif
lookupTyGenericCompare :: TcPluginM (Maybe TyCon)
#if MIN_VERSION_ghc(9,2,0)
lookupTyGenericCompare :: TcPluginM (Maybe TyCon)
lookupTyGenericCompare = forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
Module
tyOrd <- ModuleName -> FastString -> TcPluginM Module
lookupModule (String -> ModuleName
mkModuleName String
"Data.Type.Ord") FastString
"base"
Name -> TcPluginM TyCon
tcLookupTyCon forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Module -> OccName -> TcPluginM Name
lookupOrig Module
tyOrd (String -> OccName
mkTcOcc String
"Compare")
#else
lookupTyGenericCompare = pure Nothing
#endif
lookupBool47 :: String -> TcPluginM (Maybe TyCon)
#if MIN_VERSION_base(4,17,0)
lookupBool47 nam = Just <$> do
tcLookupTyCon =<< lookupOrig (mkBaseModule "Data.Type.Bool") (mkTcOcc nam)
#else
lookupBool47 :: String -> TcPluginM (Maybe TyCon)
lookupBool47 = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
#endif
lookupTyNot, lookupTyIf, lookupTyAnd, lookupTyOr :: TcPluginM (Maybe TyCon)
lookupTyNot :: TcPluginM (Maybe TyCon)
lookupTyNot = String -> TcPluginM (Maybe TyCon)
lookupBool47 String
"Not"
lookupTyIf :: TcPluginM (Maybe TyCon)
lookupTyIf = String -> TcPluginM (Maybe TyCon)
lookupBool47 String
"If"
lookupTyAnd :: TcPluginM (Maybe TyCon)
lookupTyAnd = String -> TcPluginM (Maybe TyCon)
lookupBool47 String
"&&"
lookupTyOr :: TcPluginM (Maybe TyCon)
lookupTyOr = String -> TcPluginM (Maybe TyCon)
lookupBool47 String
"||"
matchFam' :: TyCon -> [Type] -> TcPluginM (Maybe Type)
#if MIN_VERSION_ghc(9,4,1)
matchFam' con args = fmap reductionReducedType <$> matchFam con args
#else
matchFam' :: TyCon -> [Type] -> TcPluginM (Maybe Type)
matchFam' TyCon
con [Type]
args = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TyCon -> [Type] -> TcPluginM (Maybe (TcCoercion, Type))
matchFam TyCon
con [Type]
args
#endif