{-# 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 GHC.TypeLits.Presburger.Flags
import Data.Coerce (coerce)
import Data.Function (on)
import Data.Functor ((<&>))
import Data.Generics.Twins
import qualified GHC.Types.Unique as Unique (getKey, Unique)
import GHC.Types.Unique as GHC.TypeLits.Presburger.Compat (Unique, getUnique)
#if MIN_VERSION_ghc(9,10,1)
import GHC.Builtin.Names (gHC_INTERNAL_TYPENATS, gHC_INTERNAL_TYPEERROR)
import GHC.Builtin.Names (mkGhcInternalModule)
#else
import GHC.Builtin.Names (gHC_TYPENATS)
#if MIN_VERSION_ghc(9,4,1)
import GHC.Builtin.Names (gHC_TYPENATS, gHC_TYPEERROR)
#endif
#endif
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)
import GHC.Core.Reduction (reductionReducedType)
#else
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))
import GHC.Builtin.Names (mkBaseModule)
#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.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,10,1)
dATA_TYPE_EQUALITY :: Module
dATA_TYPE_EQUALITY = mkGhcInternalModule "GHC.Internal.Data.Type.Equality"
#else
dATA_TYPE_EQUALITY :: Module
dATA_TYPE_EQUALITY :: Module
dATA_TYPE_EQUALITY = FastString -> Module
mkBaseModule FastString
"Data.Type.Equality"
#endif

#if MIN_VERSION_ghc(9,10,1)
gHC_TYPEERROR :: Module
gHC_TYPEERROR = gHC_INTERNAL_TYPEERROR

gHC_TYPENATS :: Module
gHC_TYPENATS =  gHC_INTERNAL_TYPENATS
#elif !MIN_VERSION_ghc(9,4,1)
gHC_TYPEERROR :: Module
gHC_TYPEERROR = mkBaseModule "GHC.TypeLits"
#endif


type PredTree = Pred

data TvSubst = TvSubst InScopeSet TvSubstEnv

#if MIN_VERSION_ghc(9,6,1)
type TCvSubst = Subst
unionTCvSubst :: TCvSubst -> TCvSubst -> TCvSubst
unionTCvSubst :: TCvSubst -> TCvSubst -> TCvSubst
unionTCvSubst = TCvSubst -> TCvSubst -> TCvSubst
unionSubst

emptyTCvSubst :: Subst
emptyTCvSubst :: TCvSubst
emptyTCvSubst = TCvSubst
emptySubst
#endif

instance Outputable TvSubst where
  ppr :: TvSubst -> SDoc
ppr = TCvSubst -> SDoc
forall a. Outputable a => a -> SDoc
ppr (TCvSubst -> SDoc) -> (TvSubst -> TCvSubst) -> TvSubst -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TvSubst -> TCvSubst
toTCv

emptyTvSubst :: TvSubst
#if MIN_VERSION_ghc(9,6,1)
emptyTvSubst :: TvSubst
emptyTvSubst = case TCvSubst
emptyTCvSubst of
  Subst InScopeSet
set IdSubstEnv
_ TvSubstEnv
tvsenv CvSubstEnv
_ -> InScopeSet -> TvSubstEnv -> TvSubst
TvSubst InScopeSet
set TvSubstEnv
tvsenv
#else
emptyTvSubst = case emptyTCvSubst of
  TCvSubst set tvsenv _ -> TvSubst set tvsenv
#endif

toTCv :: TvSubst -> TCvSubst
#if MIN_VERSION_ghc(9,6,1)
toTCv :: TvSubst -> TCvSubst
toTCv (TvSubst InScopeSet
set TvSubstEnv
tvenv) = InScopeSet -> IdSubstEnv -> TvSubstEnv -> CvSubstEnv -> TCvSubst
Subst InScopeSet
set IdSubstEnv
forall key elt. UniqFM key elt
emptyUFM TvSubstEnv
tvenv CvSubstEnv
forall key elt. UniqFM key elt
emptyUFM
#else
toTCv (TvSubst set tvenv) = TCvSubst set tvenv emptyUFM
#endif

substTy :: TvSubst -> Type -> Type
substTy :: TvSubst -> Type -> Type
substTy TvSubst
tvs = (() :: Constraint) => TCvSubst -> Type -> Type
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 (TCvSubst -> TvSubst) -> TCvSubst -> TvSubst
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 :: TCvSubst -> TvSubst
fromTCv (Subst InScopeSet
set IdSubstEnv
_ TvSubstEnv
tvsenv CvSubstEnv
_) = InScopeSet -> TvSubstEnv -> TvSubst
TvSubst InScopeSet
set TvSubstEnv
tvsenv
#else
fromTCv (TCvSubst set tvsenv _) = TvSubst set 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 = (Type, Type) -> Maybe (Type, Type)
forall a. a -> Maybe a
Just (Type
t1, Type
t2)
viewFunTy Type
_ = Maybe (Type, Type)
forall a. Maybe a
Nothing

tcUnifyTy :: Type -> Type -> Maybe TvSubst
tcUnifyTy :: Type -> Type -> Maybe TvSubst
tcUnifyTy Type
t1 Type
t2 = TCvSubst -> TvSubst
fromTCv (TCvSubst -> TvSubst) -> Maybe TCvSubst -> Maybe TvSubst
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 =
  TyCon -> TcPluginM TyCon
forall a. a -> TcPluginM a
forall (m :: * -> *) a. Monad m => a -> m a
return TyCon
TysWiredIn.eqTyCon

getEqWitnessTyCon :: TcPluginM TyCon
getEqWitnessTyCon :: TcPluginM TyCon
getEqWitnessTyCon = do
  Name -> TcPluginM TyCon
tcLookupTyCon (Name -> TcPluginM TyCon) -> TcPluginM Name -> TcPluginM TyCon
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Module -> OccName -> TcPluginM Name
lookupOrig Module
dATA_TYPE_EQUALITY (String -> OccName
mkTcOcc String
":~:")

getEqBoolTyCon :: TcPluginM TyCon
getEqBoolTyCon :: TcPluginM TyCon
getEqBoolTyCon = do
  Name -> TcPluginM TyCon
tcLookupTyCon (Name -> TcPluginM TyCon) -> TcPluginM Name -> TcPluginM TyCon
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Module -> OccName -> TcPluginM Name
lookupOrig Module
dATA_TYPE_EQUALITY (String -> OccName
mkTcOcc String
"==")

decompFunTy :: Type -> [Type]
decompFunTy :: Type -> [Type]
decompFunTy (FunTy FunTyFlag
_ Type
_ Type
t1 Type
t2) = Type
t1 Type -> [Type] -> [Type]
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
(==) = Type -> Type -> Bool
forall a. Data a => a -> a -> Bool
geq (Type -> Type -> Bool)
-> (TypeEq -> Type) -> TypeEq -> TypeEq -> Bool
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 = Type -> Type -> Ordering
forall a. Data a => a -> a -> Ordering
gcompare (Type -> Type -> Ordering)
-> (TypeEq -> Type) -> TypeEq -> TypeEq -> Ordering
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 =
  ([Ct] -> TcPluginM [Ct])
-> ([Ct] -> [Ct]) -> [Ct] -> TcPluginM [Ct]
forall a b. (a -> b) -> ([Ct] -> a) -> [Ct] -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Ct] -> TcPluginM [Ct]
forall a. a -> TcPluginM a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Ct] -> TcPluginM [Ct])
-> ([Ct] -> [Ct]) -> [Ct] -> TcPluginM [Ct]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ct -> Bool) -> [Ct] -> [Ct]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Ct -> Bool) -> Ct -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> Bool
isTrivial (Type -> Bool) -> (Ct -> Type) -> Ct -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CtEvidence -> Type
ctEvPred (CtEvidence -> Type) -> (Ct -> CtEvidence) -> Ct -> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ct -> CtEvidence
ctEvidence))
    (([Ct] -> [Ct]) -> [Ct] -> TcPluginM [Ct])
-> ([Ct] -> [Ct] -> [Ct]) -> [Ct] -> [Ct] -> TcPluginM [Ct]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Ct] -> [Ct] -> [Ct]
forall a. [a] -> [a] -> [a]
(++)
    ([Ct] -> [Ct] -> TcPluginM [Ct])
-> ([Ct] -> [Ct]) -> [Ct] -> [Ct] -> TcPluginM [Ct]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Ct] -> [Ct]
forall a. a -> a
id
    ([Ct] -> [Ct] -> TcPluginM [Ct])
-> ([Ct] -> [Ct]) -> [Ct] -> TcPluginM [Ct]
forall a b. ([Ct] -> a -> b) -> ([Ct] -> a) -> [Ct] -> b
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 = (((TcTyVar, Type), Ct) -> (TcTyVar, Type))
-> [((TcTyVar, Type), Ct)] -> Substitution
forall a b. (a -> b) -> [a] -> [b]
map ((TcTyVar, Type), Ct) -> (TcTyVar, Type)
forall a b. (a, b) -> a
fst ([((TcTyVar, Type), Ct)] -> Substitution)
-> ([Ct] -> [((TcTyVar, Type), Ct)]) -> [Ct] -> Substitution
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 Name -> Name -> Bool
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 (Unit -> UnitId) -> (FastString -> Unit) -> FastString -> UnitId
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 = [FastString] -> UniqSet FastString
forall a. Uniquable a => [a] -> UniqSet a
mkUniqSet ([FastString] -> UniqSet FastString)
-> [FastString] -> UniqSet FastString
forall a b. (a -> b) -> a -> b
$ (UnitId -> FastString) -> [UnitId] -> [FastString]
forall a b. (a -> b) -> [a] -> [b]
map (\(UnitId FastString
p) -> FastString
p) ([UnitId] -> [FastString]) -> [UnitId] -> [FastString]
forall a b. (a -> b) -> a -> b
$ UnitState -> [UnitId]
preloadUnits UnitState
us
      ents :: [GenericUnitInfo PackageId PackageName UnitId ModuleName Module]
ents = (GenericUnitInfo PackageId PackageName UnitId ModuleName Module
 -> Bool)
-> [GenericUnitInfo PackageId PackageName UnitId ModuleName Module]
-> [GenericUnitInfo PackageId PackageName UnitId ModuleName Module]
forall a. (a -> Bool) -> [a] -> [a]
filter ((FastString -> UniqSet FastString -> Bool
forall a. Uniquable a => a -> UniqSet a -> Bool
`elementOfUniqSet` UniqSet FastString
preloads) (FastString -> Bool)
-> (GenericUnitInfo PackageId PackageName UnitId ModuleName Module
    -> FastString)
-> GenericUnitInfo PackageId PackageName UnitId ModuleName Module
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnitId -> FastString
unitIdFS (UnitId -> FastString)
-> (GenericUnitInfo PackageId PackageName UnitId ModuleName Module
    -> UnitId)
-> GenericUnitInfo PackageId PackageName UnitId ModuleName Module
-> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenericUnitInfo PackageId PackageName UnitId ModuleName Module
-> UnitId
forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> uid
unitId) ([GenericUnitInfo PackageId PackageName UnitId ModuleName Module]
 -> [GenericUnitInfo
       PackageId PackageName UnitId ModuleName Module])
-> [GenericUnitInfo PackageId PackageName UnitId ModuleName Module]
-> [GenericUnitInfo PackageId PackageName UnitId ModuleName Module]
forall a b. (a -> b) -> a -> b
$ (UnitDatabase UnitId
 -> [GenericUnitInfo
       PackageId PackageName UnitId ModuleName Module])
-> [UnitDatabase UnitId]
-> [GenericUnitInfo PackageId PackageName UnitId ModuleName Module]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap UnitDatabase UnitId
-> [GenericUnitInfo PackageId PackageName UnitId ModuleName Module]
forall unit. UnitDatabase unit -> [GenUnitInfo unit]
unitDatabaseUnits [UnitDatabase UnitId]
unitDb
   in (GenericUnitInfo PackageId PackageName UnitId ModuleName Module
 -> FastString)
-> [GenericUnitInfo PackageId PackageName UnitId ModuleName Module]
-> [FastString]
forall a b. (a -> b) -> [a] -> [b]
map (PackageName -> FastString
forall a b. Coercible a b => a -> b
coerce (PackageName -> FastString)
-> (GenericUnitInfo PackageId PackageName UnitId ModuleName Module
    -> PackageName)
-> GenericUnitInfo PackageId PackageName UnitId ModuleName Module
-> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenericUnitInfo PackageId PackageName UnitId ModuleName Module
-> PackageName
forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod
-> srcpkgname
unitPackageName) [GenericUnitInfo PackageId PackageName UnitId ModuleName Module]
ents

type RawPackageName = FastString

preloadedUnitsM :: TcPluginM [RawPackageName]
#if MIN_VERSION_ghc(9,4,0)
preloadedUnitsM :: TcPluginM [FastString]
preloadedUnitsM = do
  Logger
logger <- TcM Logger -> TcPluginM Logger
forall a. TcM a -> TcPluginM a
unsafeTcPluginTcM TcM Logger
forall (m :: * -> *). HasLogger m => m Logger
getLogger
  DynFlags
dflags <- HscEnv -> DynFlags
hsc_dflags (HscEnv -> DynFlags) -> TcPluginM HscEnv -> TcPluginM DynFlags
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TcPluginM HscEnv
getTopEnv
  [FastString]
packNames <- IO [FastString] -> TcPluginM [FastString]
forall a. IO a -> TcPluginM a
tcPluginIO (IO [FastString] -> TcPluginM [FastString])
-> IO [FastString] -> TcPluginM [FastString]
forall a b. (a -> b) -> a -> b
$ Logger
-> DynFlags
-> Maybe [UnitDatabase UnitId]
-> Set UnitId
-> IO
     ([UnitDatabase UnitId], UnitState, HomeUnit,
      Maybe PlatformConstants)
initUnits Logger
logger DynFlags
dflags Maybe [UnitDatabase UnitId]
forall a. Maybe a
Nothing Set UnitId
forall a. Monoid a => a
mempty IO
  ([UnitDatabase UnitId], UnitState, HomeUnit,
   Maybe PlatformConstants)
-> (([UnitDatabase UnitId], UnitState, HomeUnit,
     Maybe PlatformConstants)
    -> [FastString])
-> IO [FastString]
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" (SDoc -> TcPluginM ()) -> SDoc -> TcPluginM ()
forall a b. (a -> b) -> a -> b
$ [FastString] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [FastString]
packNames
  [FastString] -> TcPluginM [FastString]
forall a. a -> TcPluginM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FastString] -> TcPluginM [FastString])
-> [FastString] -> TcPluginM [FastString]
forall a b. (a -> b) -> a -> b
$ [FastString] -> [FastString]
forall a b. Coercible a b => a -> b
coerce [FastString]
packNames
#elif MIN_VERSION_ghc(9,2,0)
preloadedUnitsM = do
  logger <- unsafeTcPluginTcM getLogger
  dflags <- hsc_dflags <$> getTopEnv
  packNames <- tcPluginIO $ initUnits logger dflags Nothing <&> 
    \(unitDb, us, _, _ ) -> loadedPackageNames unitDb us
  tcPluginTrace "pres: packs" $ ppr packNames
  pure 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' = Module -> Unit
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 = Maybe TyCon
forall a. Maybe a
Nothing
#else
mtypeNatLeqTyCon = Just typeNatLeqTyCon
#endif

dATA_TYPE_ORD :: Module
#if MIN_VERSION_ghc(9,10,0)
dATA_TYPE_ORD = mkGhcInternalModule "GHC.Internal.Data.Type.Ord"
#else
dATA_TYPE_ORD :: Module
dATA_TYPE_ORD = FastString -> Module
mkBaseModule FastString
"Data.Type.Ord"
#endif

lookupTyNatPredLeq :: TcPluginM Name
#if MIN_VERSION_ghc(9,2,0)
lookupTyNatPredLeq :: TcPluginM Name
lookupTyNatPredLeq = Module -> OccName -> TcPluginM Name
lookupOrig Module
dATA_TYPE_ORD (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 = Name -> TcPluginM TyCon
tcLookupTyCon (Name -> TcPluginM TyCon) -> TcPluginM Name -> TcPluginM TyCon
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Module -> OccName -> TcPluginM Name
lookupOrig Module
dATA_TYPE_ORD (String -> OccName
mkTcOcc String
"<=?")
#else
lookupTyNatBoolLeq = 
  pure typeNatLeqTyCon
#endif

lookupAssertTyCon :: TcPluginM (Maybe TyCon)
#if MIN_VERSION_base(4,17,0)
lookupAssertTyCon :: TcPluginM (Maybe TyCon)
lookupAssertTyCon = 
  (TyCon -> Maybe TyCon)
-> TcPluginM TyCon -> TcPluginM (Maybe TyCon)
forall a b. (a -> b) -> TcPluginM a -> TcPluginM b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TyCon -> Maybe TyCon
forall a. a -> Maybe a
Just (TcPluginM TyCon -> TcPluginM (Maybe TyCon))
-> (Name -> TcPluginM TyCon) -> Name -> TcPluginM (Maybe TyCon)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> TcPluginM TyCon
tcLookupTyCon (Name -> TcPluginM (Maybe TyCon))
-> TcPluginM Name -> TcPluginM (Maybe TyCon)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Module -> OccName -> TcPluginM Name
lookupOrig Module
gHC_TYPEERROR (String -> OccName
mkTcOcc String
"Assert")
#else
lookupAssertTyCon = pure Nothing
#endif

lookupTyNatPredLt :: TcPluginM (Maybe TyCon)

-- Note:  base library shipepd with 9.2.1 has a wrong implementation;
-- hence we MUST NOT desugar it with <= 9.2.1
#if MIN_VERSION_ghc(9,2,2)
lookupTyNatPredLt :: TcPluginM (Maybe TyCon)
lookupTyNatPredLt = TyCon -> Maybe TyCon
forall a. a -> Maybe a
Just (TyCon -> Maybe TyCon)
-> TcPluginM TyCon -> TcPluginM (Maybe TyCon)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
  Name -> TcPluginM TyCon
tcLookupTyCon (Name -> TcPluginM TyCon) -> TcPluginM Name -> TcPluginM TyCon
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Module -> OccName -> TcPluginM Name
lookupOrig Module
dATA_TYPE_ORD (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 = TyCon -> Maybe TyCon
forall a. a -> Maybe a
Just (TyCon -> Maybe TyCon)
-> TcPluginM TyCon -> TcPluginM (Maybe TyCon)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
  Name -> TcPluginM TyCon
tcLookupTyCon (Name -> TcPluginM TyCon) -> TcPluginM Name -> TcPluginM TyCon
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Module -> OccName -> TcPluginM Name
lookupOrig Module
dATA_TYPE_ORD (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 = TyCon -> Maybe TyCon
forall a. a -> Maybe a
Just (TyCon -> Maybe TyCon)
-> TcPluginM TyCon -> TcPluginM (Maybe TyCon)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
  Name -> TcPluginM TyCon
tcLookupTyCon (Name -> TcPluginM TyCon) -> TcPluginM Name -> TcPluginM TyCon
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Module -> OccName -> TcPluginM Name
lookupOrig Module
dATA_TYPE_ORD (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 = TyCon -> Maybe TyCon
forall a. a -> Maybe a
Just (TyCon -> Maybe TyCon)
-> TcPluginM TyCon -> TcPluginM (Maybe TyCon)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
  Name -> TcPluginM TyCon
tcLookupTyCon (Name -> TcPluginM TyCon) -> TcPluginM Name -> TcPluginM TyCon
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Module -> OccName -> TcPluginM Name
lookupOrig Module
dATA_TYPE_ORD (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 = TyCon -> Maybe TyCon
forall a. a -> Maybe a
Just (TyCon -> Maybe TyCon)
-> TcPluginM TyCon -> TcPluginM (Maybe TyCon)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
  Name -> TcPluginM TyCon
tcLookupTyCon (Name -> TcPluginM TyCon) -> TcPluginM Name -> TcPluginM TyCon
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Module -> OccName -> TcPluginM Name
lookupOrig Module
dATA_TYPE_ORD (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 = TyCon -> Maybe TyCon
forall a. a -> Maybe a
Just (TyCon -> Maybe TyCon)
-> TcPluginM TyCon -> TcPluginM (Maybe TyCon)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
  Name -> TcPluginM TyCon
tcLookupTyCon (Name -> TcPluginM TyCon) -> TcPluginM Name -> TcPluginM TyCon
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Module -> OccName -> TcPluginM Name
lookupOrig Module
dATA_TYPE_ORD (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 = TyCon -> Maybe TyCon
forall a. a -> Maybe a
Just (TyCon -> Maybe TyCon)
-> TcPluginM TyCon -> TcPluginM (Maybe TyCon)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
  Name -> TcPluginM TyCon
tcLookupTyCon (Name -> TcPluginM TyCon) -> TcPluginM Name -> TcPluginM TyCon
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Module -> OccName -> TcPluginM Name
lookupOrig Module
dATA_TYPE_ORD (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 = TyCon -> Maybe TyCon
forall a. a -> Maybe a
Just (TyCon -> Maybe TyCon)
-> TcPluginM TyCon -> TcPluginM (Maybe TyCon)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
  Name -> TcPluginM TyCon
tcLookupTyCon (Name -> TcPluginM TyCon) -> TcPluginM Name -> TcPluginM TyCon
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Module -> OccName -> TcPluginM Name
lookupOrig Module
dATA_TYPE_ORD (String -> OccName
mkTcOcc String
"Compare")
#else
lookupTyGenericCompare = pure Nothing
#endif

lookupBool47 :: String -> TcPluginM (Maybe TyCon)
#if MIN_VERSION_ghc(9,10,0)
lookupBool47 nam = Just <$> do
  tcLookupTyCon =<< lookupOrig (mkGhcInternalModule "GHC.Internal.Data.Type.Bool") (mkTcOcc nam)
#elif MIN_VERSION_base(4,17,0)
lookupBool47 :: String -> TcPluginM (Maybe TyCon)
lookupBool47 String
nam = TyCon -> Maybe TyCon
forall a. a -> Maybe a
Just (TyCon -> Maybe TyCon)
-> TcPluginM TyCon -> TcPluginM (Maybe TyCon)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
  Name -> TcPluginM TyCon
tcLookupTyCon (Name -> TcPluginM TyCon) -> TcPluginM Name -> TcPluginM TyCon
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Module -> OccName -> TcPluginM Name
lookupOrig (FastString -> Module
mkBaseModule FastString
"Data.Type.Bool") (String -> OccName
mkTcOcc String
nam)
#else
lookupBool47 = const $ pure 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' :: TyCon -> [Type] -> TcPluginM (Maybe Type)
matchFam' TyCon
con [Type]
args = (Reduction -> Type) -> Maybe Reduction -> Maybe Type
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Reduction -> Type
reductionReducedType (Maybe Reduction -> Maybe Type)
-> TcPluginM (Maybe Reduction) -> TcPluginM (Maybe Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TyCon -> [Type] -> TcPluginM (Maybe Reduction)
matchFam TyCon
con [Type]
args
#else
matchFam' con args = fmap snd <$> matchFam con args 
#endif

getKey :: Unique.Unique -> Int
#if MIN_VERSION_ghc(9,10,1)
getKey = fromIntegral . Unique.getKey
#else
getKey :: Unique -> Int
getKey = Unique -> Int
Unique.getKey
#endif

getVoidTyCon :: TcPluginM TyCon
getVoidTyCon :: TcPluginM TyCon
getVoidTyCon = Name -> TcPluginM TyCon
tcLookupTyCon (Name -> TcPluginM TyCon) -> TcPluginM Name -> TcPluginM TyCon
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Module -> OccName -> TcPluginM Name
lookupOrig Module
aMod (String -> OccName
mkTcOcc String
"Void")
  where 
#if MIN_VERSION_ghc(9,10,1)
    aMod = mkGhcInternalModule "GHC.Internal.Base"
#elif MIN_VERSION_ghc(9,6,1)
    aMod :: Module
aMod = FastString -> Module
mkBaseModule FastString
"GHC.Base"
#else
    aMod = mkBaseModule "Data.Void"
#endif