{-# LANGUAGE CPP, GADTs, ViewPatterns #-}
module GHC.Tc.Instance.Family (
FamInstEnvs, tcGetFamInstEnvs,
checkFamInstConsistency, tcExtendLocalFamInstEnv,
tcLookupDataFamInst, tcLookupDataFamInst_maybe,
tcInstNewTyCon_maybe, tcTopNormaliseNewTypeTF_maybe,
newFamInst,
reportInjectivityErrors, reportConflictingInjectivityErrs
) where
import GHC.Prelude
import GHC.Driver.Session
import GHC.Driver.Env
import GHC.Core.FamInstEnv
import GHC.Core.InstEnv( roughMatchTcs )
import GHC.Core.Coercion
import GHC.Core.TyCon
import GHC.Core.Coercion.Axiom
import GHC.Core.DataCon ( dataConName )
import GHC.Core.TyCo.Rep
import GHC.Core.TyCo.FVs
import GHC.Core.TyCo.Ppr ( pprWithExplicitKindsWhen )
import GHC.Iface.Load
import GHC.Tc.Types.Evidence
import GHC.Tc.Utils.Monad
import GHC.Tc.Utils.Instantiate( freshenTyVarBndrs, freshenCoVarBndrsX )
import GHC.Tc.Utils.TcType
import GHC.Unit.External
import GHC.Unit.Module
import GHC.Unit.Module.ModIface
import GHC.Unit.Module.ModDetails
import GHC.Unit.Module.Deps
import GHC.Unit.Home.ModInfo
import GHC.Types.SrcLoc as SrcLoc
import GHC.Types.Name.Reader
import GHC.Types.Name
import GHC.Types.Var.Set
import GHC.Utils.Outputable
import GHC.Utils.Misc
import GHC.Utils.Panic
import GHC.Utils.FV
import GHC.Data.Bag( Bag, unionBags, unitBag )
import GHC.Data.Maybe
import Control.Monad
import Data.List ( sortBy )
import Data.List.NonEmpty ( NonEmpty(..) )
import Data.Function ( on )
import qualified GHC.LanguageExtensions as LangExt
#include "HsVersions.h"
newFamInst :: FamFlavor -> CoAxiom Unbranched -> TcM FamInst
newFamInst :: FamFlavor -> CoAxiom Unbranched -> TcM FamInst
newFamInst FamFlavor
flavor axiom :: CoAxiom Unbranched
axiom@(CoAxiom { co_ax_tc :: forall (br :: BranchFlag). CoAxiom br -> TyCon
co_ax_tc = TyCon
fam_tc })
= do {
(TCvSubst
subst, [TyCoVar]
tvs') <- [TyCoVar] -> TcM (TCvSubst, [TyCoVar])
freshenTyVarBndrs [TyCoVar]
tvs
; (TCvSubst
subst, [TyCoVar]
cvs') <- TCvSubst -> [TyCoVar] -> TcM (TCvSubst, [TyCoVar])
freshenCoVarBndrsX TCvSubst
subst [TyCoVar]
cvs
; let lhs' :: [Type]
lhs' = HasCallStack => TCvSubst -> [Type] -> [Type]
substTys TCvSubst
subst [Type]
lhs
rhs' :: Type
rhs' = HasCallStack => TCvSubst -> Type -> Type
substTy TCvSubst
subst Type
rhs
; forall (m :: * -> *) a. Monad m => a -> m a
return (FamInst { fi_fam :: Name
fi_fam = TyCon -> Name
tyConName TyCon
fam_tc
, fi_flavor :: FamFlavor
fi_flavor = FamFlavor
flavor
, fi_tcs :: [RoughMatchTc]
fi_tcs = [Type] -> [RoughMatchTc]
roughMatchTcs [Type]
lhs
, fi_tvs :: [TyCoVar]
fi_tvs = [TyCoVar]
tvs'
, fi_cvs :: [TyCoVar]
fi_cvs = [TyCoVar]
cvs'
, fi_tys :: [Type]
fi_tys = [Type]
lhs'
, fi_rhs :: Type
fi_rhs = Type
rhs'
, fi_axiom :: CoAxiom Unbranched
fi_axiom = CoAxiom Unbranched
axiom }) }
where
CoAxBranch { cab_tvs :: CoAxBranch -> [TyCoVar]
cab_tvs = [TyCoVar]
tvs
, cab_cvs :: CoAxBranch -> [TyCoVar]
cab_cvs = [TyCoVar]
cvs
, cab_lhs :: CoAxBranch -> [Type]
cab_lhs = [Type]
lhs
, cab_rhs :: CoAxBranch -> Type
cab_rhs = Type
rhs } = CoAxiom Unbranched -> CoAxBranch
coAxiomSingleBranch CoAxiom Unbranched
axiom
checkFamInstConsistency :: [Module] -> TcM ()
checkFamInstConsistency :: [Module] -> TcM ()
checkFamInstConsistency [Module]
directlyImpMods
= do { (ExternalPackageState
eps, HomePackageTable
hpt) <- forall gbl lcl.
TcRnIf gbl lcl (ExternalPackageState, HomePackageTable)
getEpsAndHpt
; String -> SDoc -> TcM ()
traceTc String
"checkFamInstConsistency" (forall a. Outputable a => a -> SDoc
ppr [Module]
directlyImpMods)
; let {
modIface :: Module -> ModIface
modIface Module
mod =
case HomePackageTable -> PackageIfaceTable -> Module -> Maybe ModIface
lookupIfaceByModule HomePackageTable
hpt (ExternalPackageState -> PackageIfaceTable
eps_PIT ExternalPackageState
eps) Module
mod of
Maybe ModIface
Nothing -> forall a. String -> SDoc -> a
panicDoc String
"FamInst.checkFamInstConsistency"
(forall a. Outputable a => a -> SDoc
ppr Module
mod SDoc -> SDoc -> SDoc
$$ HomePackageTable -> SDoc
pprHPT HomePackageTable
hpt)
Just ModIface
iface -> ModIface
iface
; modConsistent :: Module -> [Module]
; modConsistent :: Module -> [Module]
modConsistent Module
mod =
if ModIfaceBackend -> WhetherHasFamInst
mi_finsts (forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBackendExts phase
mi_final_exts (Module -> ModIface
modIface Module
mod)) then Module
modforall a. a -> [a] -> [a]
:[Module]
deps else [Module]
deps
where
deps :: [Module]
deps = Dependencies -> [Module]
dep_finsts forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (phase :: ModIfacePhase). ModIface_ phase -> Dependencies
mi_deps forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module -> ModIface
modIface forall a b. (a -> b) -> a -> b
$ Module
mod
; hmiModule :: HomeModInfo -> Module
hmiModule = forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module forall b c a. (b -> c) -> (a -> b) -> a -> c
. HomeModInfo -> ModIface
hm_iface
; hmiFamInstEnv :: HomeModInfo -> FamInstEnv
hmiFamInstEnv = FamInstEnv -> [FamInst] -> FamInstEnv
extendFamInstEnvList FamInstEnv
emptyFamInstEnv
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModDetails -> [FamInst]
md_fam_insts forall b c a. (b -> c) -> (a -> b) -> a -> c
. HomeModInfo -> ModDetails
hm_details
; hpt_fam_insts :: ModuleEnv FamInstEnv
hpt_fam_insts = forall a. [(Module, a)] -> ModuleEnv a
mkModuleEnv [ (HomeModInfo -> Module
hmiModule HomeModInfo
hmi, HomeModInfo -> FamInstEnv
hmiFamInstEnv HomeModInfo
hmi)
| HomeModInfo
hmi <- HomePackageTable -> [HomeModInfo]
eltsHpt HomePackageTable
hpt]
}
; ModuleEnv FamInstEnv -> (Module -> [Module]) -> [Module] -> TcM ()
checkMany ModuleEnv FamInstEnv
hpt_fam_insts Module -> [Module]
modConsistent [Module]
directlyImpMods
}
where
checkMany
:: ModuleEnv FamInstEnv
-> (Module -> [Module])
-> [Module]
-> TcM ()
checkMany :: ModuleEnv FamInstEnv -> (Module -> [Module]) -> [Module] -> TcM ()
checkMany ModuleEnv FamInstEnv
hpt_fam_insts Module -> [Module]
modConsistent [Module]
mods = [Module] -> ModuleSet -> [Module] -> TcM ()
go [] ModuleSet
emptyModuleSet [Module]
mods
where
go :: [Module]
-> ModuleSet
-> [Module]
-> TcM ()
go :: [Module] -> ModuleSet -> [Module] -> TcM ()
go [Module]
_ ModuleSet
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return ()
go [Module]
consistent ModuleSet
consistent_set (Module
mod:[Module]
mods) = do
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
[ ModuleEnv FamInstEnv -> Module -> Module -> TcM ()
check ModuleEnv FamInstEnv
hpt_fam_insts Module
m1 Module
m2
| Module
m1 <- [Module]
to_check_from_mod
, Module
m2 <- [Module]
to_check_from_consistent
]
[Module] -> ModuleSet -> [Module] -> TcM ()
go [Module]
consistent' ModuleSet
consistent_set' [Module]
mods
where
mod_deps_consistent :: [Module]
mod_deps_consistent = Module -> [Module]
modConsistent Module
mod
mod_deps_consistent_set :: ModuleSet
mod_deps_consistent_set = [Module] -> ModuleSet
mkModuleSet [Module]
mod_deps_consistent
consistent' :: [Module]
consistent' = [Module]
to_check_from_mod forall a. [a] -> [a] -> [a]
++ [Module]
consistent
consistent_set' :: ModuleSet
consistent_set' =
ModuleSet -> [Module] -> ModuleSet
extendModuleSetList ModuleSet
consistent_set [Module]
to_check_from_mod
to_check_from_consistent :: [Module]
to_check_from_consistent =
forall a. (a -> WhetherHasFamInst) -> [a] -> [a]
filterOut (Module -> ModuleSet -> WhetherHasFamInst
`elemModuleSet` ModuleSet
mod_deps_consistent_set) [Module]
consistent
to_check_from_mod :: [Module]
to_check_from_mod =
forall a. (a -> WhetherHasFamInst) -> [a] -> [a]
filterOut (Module -> ModuleSet -> WhetherHasFamInst
`elemModuleSet` ModuleSet
consistent_set) [Module]
mod_deps_consistent
check :: ModuleEnv FamInstEnv -> Module -> Module -> TcM ()
check ModuleEnv FamInstEnv
hpt_fam_insts Module
m1 Module
m2
= do { FamInstEnv
env1' <- ModuleEnv FamInstEnv -> Module -> TcM FamInstEnv
getFamInsts ModuleEnv FamInstEnv
hpt_fam_insts Module
m1
; FamInstEnv
env2' <- ModuleEnv FamInstEnv -> Module -> TcM FamInstEnv
getFamInsts ModuleEnv FamInstEnv
hpt_fam_insts Module
m2
; let sizeE1 :: Int
sizeE1 = FamInstEnv -> Int
famInstEnvSize FamInstEnv
env1'
sizeE2 :: Int
sizeE2 = FamInstEnv -> Int
famInstEnvSize FamInstEnv
env2'
(FamInstEnv
env1, FamInstEnv
env2) = if Int
sizeE1 forall a. Ord a => a -> a -> WhetherHasFamInst
< Int
sizeE2 then (FamInstEnv
env1', FamInstEnv
env2')
else (FamInstEnv
env2', FamInstEnv
env1')
; let check_now :: [FamInst]
check_now = FamInstEnv -> [FamInst]
famInstEnvElts FamInstEnv
env1
; forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((FamInstEnv, FamInstEnv) -> FamInst -> TcM ()
checkForConflicts (FamInstEnv
emptyFamInstEnv, FamInstEnv
env2)) [FamInst]
check_now
; forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((FamInstEnv, FamInstEnv) -> FamInst -> TcM ()
checkForInjectivityConflicts (FamInstEnv
emptyFamInstEnv,FamInstEnv
env2)) [FamInst]
check_now
}
getFamInsts :: ModuleEnv FamInstEnv -> Module -> TcM FamInstEnv
getFamInsts :: ModuleEnv FamInstEnv -> Module -> TcM FamInstEnv
getFamInsts ModuleEnv FamInstEnv
hpt_fam_insts Module
mod
| Just FamInstEnv
env <- forall a. ModuleEnv a -> Module -> Maybe a
lookupModuleEnv ModuleEnv FamInstEnv
hpt_fam_insts Module
mod = forall (m :: * -> *) a. Monad m => a -> m a
return FamInstEnv
env
| WhetherHasFamInst
otherwise = do { ModIface
_ <- forall a. IfG a -> TcRn a
initIfaceTcRn (forall lcl. SDoc -> Module -> IfM lcl ModIface
loadSysInterface SDoc
doc Module
mod)
; ExternalPackageState
eps <- forall gbl lcl. TcRnIf gbl lcl ExternalPackageState
getEps
; forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. HasCallStack => String -> Maybe a -> a
expectJust String
"checkFamInstConsistency" forall a b. (a -> b) -> a -> b
$
forall a. ModuleEnv a -> Module -> Maybe a
lookupModuleEnv (ExternalPackageState -> ModuleEnv FamInstEnv
eps_mod_fam_inst_env ExternalPackageState
eps) Module
mod) }
where
doc :: SDoc
doc = forall a. Outputable a => a -> SDoc
ppr Module
mod SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"is a family-instance module"
tcInstNewTyCon_maybe :: TyCon -> [TcType] -> Maybe (TcType, TcCoercion)
tcInstNewTyCon_maybe :: TyCon -> [Type] -> Maybe (Type, TcCoercion)
tcInstNewTyCon_maybe = TyCon -> [Type] -> Maybe (Type, TcCoercion)
instNewTyCon_maybe
tcLookupDataFamInst :: FamInstEnvs -> TyCon -> [TcType]
-> (TyCon, [TcType], Coercion)
tcLookupDataFamInst :: (FamInstEnv, FamInstEnv)
-> TyCon -> [Type] -> (TyCon, [Type], TcCoercion)
tcLookupDataFamInst (FamInstEnv, FamInstEnv)
fam_inst_envs TyCon
tc [Type]
tc_args
| Just (TyCon
rep_tc, [Type]
rep_args, TcCoercion
co)
<- (FamInstEnv, FamInstEnv)
-> TyCon -> [Type] -> Maybe (TyCon, [Type], TcCoercion)
tcLookupDataFamInst_maybe (FamInstEnv, FamInstEnv)
fam_inst_envs TyCon
tc [Type]
tc_args
= (TyCon
rep_tc, [Type]
rep_args, TcCoercion
co)
| WhetherHasFamInst
otherwise
= (TyCon
tc, [Type]
tc_args, Type -> TcCoercion
mkRepReflCo (TyCon -> [Type] -> Type
mkTyConApp TyCon
tc [Type]
tc_args))
tcLookupDataFamInst_maybe :: FamInstEnvs -> TyCon -> [TcType]
-> Maybe (TyCon, [TcType], Coercion)
tcLookupDataFamInst_maybe :: (FamInstEnv, FamInstEnv)
-> TyCon -> [Type] -> Maybe (TyCon, [Type], TcCoercion)
tcLookupDataFamInst_maybe (FamInstEnv, FamInstEnv)
fam_inst_envs TyCon
tc [Type]
tc_args
| TyCon -> WhetherHasFamInst
isDataFamilyTyCon TyCon
tc
, FamInstMatch
match : [FamInstMatch]
_ <- (FamInstEnv, FamInstEnv) -> TyCon -> [Type] -> [FamInstMatch]
lookupFamInstEnv (FamInstEnv, FamInstEnv)
fam_inst_envs TyCon
tc [Type]
tc_args
, FamInstMatch { fim_instance :: FamInstMatch -> FamInst
fim_instance = rep_fam :: FamInst
rep_fam@(FamInst { fi_axiom :: FamInst -> CoAxiom Unbranched
fi_axiom = CoAxiom Unbranched
ax
, fi_cvs :: FamInst -> [TyCoVar]
fi_cvs = [TyCoVar]
cvs })
, fim_tys :: FamInstMatch -> [Type]
fim_tys = [Type]
rep_args
, fim_cos :: FamInstMatch -> [TcCoercion]
fim_cos = [TcCoercion]
rep_cos } <- FamInstMatch
match
, let rep_tc :: TyCon
rep_tc = FamInst -> TyCon
dataFamInstRepTyCon FamInst
rep_fam
co :: TcCoercion
co = Role -> CoAxiom Unbranched -> [Type] -> [TcCoercion] -> TcCoercion
mkUnbranchedAxInstCo Role
Representational CoAxiom Unbranched
ax [Type]
rep_args
([TyCoVar] -> [TcCoercion]
mkCoVarCos [TyCoVar]
cvs)
= ASSERT( null rep_cos )
forall a. a -> Maybe a
Just (TyCon
rep_tc, [Type]
rep_args, TcCoercion
co)
| WhetherHasFamInst
otherwise
= forall a. Maybe a
Nothing
tcTopNormaliseNewTypeTF_maybe :: FamInstEnvs
-> GlobalRdrEnv
-> Type
-> Maybe ((Bag GlobalRdrElt, TcCoercion), Type)
tcTopNormaliseNewTypeTF_maybe :: (FamInstEnv, FamInstEnv)
-> GlobalRdrEnv
-> Type
-> Maybe ((Bag GlobalRdrElt, TcCoercion), Type)
tcTopNormaliseNewTypeTF_maybe (FamInstEnv, FamInstEnv)
faminsts GlobalRdrEnv
rdr_env Type
ty
= forall ev.
NormaliseStepper ev -> (ev -> ev -> ev) -> Type -> Maybe (ev, Type)
topNormaliseTypeX NormaliseStepper (Bag GlobalRdrElt, TcCoercion)
stepper (Bag GlobalRdrElt, TcCoercion)
-> (Bag GlobalRdrElt, TcCoercion) -> (Bag GlobalRdrElt, TcCoercion)
plus Type
ty
where
plus :: (Bag GlobalRdrElt, TcCoercion) -> (Bag GlobalRdrElt, TcCoercion)
-> (Bag GlobalRdrElt, TcCoercion)
plus :: (Bag GlobalRdrElt, TcCoercion)
-> (Bag GlobalRdrElt, TcCoercion) -> (Bag GlobalRdrElt, TcCoercion)
plus (Bag GlobalRdrElt
gres1, TcCoercion
co1) (Bag GlobalRdrElt
gres2, TcCoercion
co2) = ( Bag GlobalRdrElt
gres1 forall a. Bag a -> Bag a -> Bag a
`unionBags` Bag GlobalRdrElt
gres2
, TcCoercion
co1 TcCoercion -> TcCoercion -> TcCoercion
`mkTransCo` TcCoercion
co2 )
stepper :: NormaliseStepper (Bag GlobalRdrElt, TcCoercion)
stepper :: NormaliseStepper (Bag GlobalRdrElt, TcCoercion)
stepper = NormaliseStepper (Bag GlobalRdrElt, TcCoercion)
unwrap_newtype forall ev.
NormaliseStepper ev -> NormaliseStepper ev -> NormaliseStepper ev
`composeSteppers` NormaliseStepper (Bag GlobalRdrElt, TcCoercion)
unwrap_newtype_instance
unwrap_newtype_instance :: NormaliseStepper (Bag GlobalRdrElt, TcCoercion)
unwrap_newtype_instance RecTcChecker
rec_nts TyCon
tc [Type]
tys
| Just (TyCon
tc', [Type]
tys', TcCoercion
co) <- (FamInstEnv, FamInstEnv)
-> TyCon -> [Type] -> Maybe (TyCon, [Type], TcCoercion)
tcLookupDataFamInst_maybe (FamInstEnv, FamInstEnv)
faminsts TyCon
tc [Type]
tys
= forall ev1 ev2.
(ev1 -> ev2) -> NormaliseStepResult ev1 -> NormaliseStepResult ev2
mapStepResult (\(Bag GlobalRdrElt
gres, TcCoercion
co1) -> (Bag GlobalRdrElt
gres, TcCoercion
co TcCoercion -> TcCoercion -> TcCoercion
`mkTransCo` TcCoercion
co1)) forall a b. (a -> b) -> a -> b
$
NormaliseStepper (Bag GlobalRdrElt, TcCoercion)
unwrap_newtype RecTcChecker
rec_nts TyCon
tc' [Type]
tys'
| WhetherHasFamInst
otherwise = forall ev. NormaliseStepResult ev
NS_Done
unwrap_newtype :: NormaliseStepper (Bag GlobalRdrElt, TcCoercion)
unwrap_newtype RecTcChecker
rec_nts TyCon
tc [Type]
tys
| Just DataCon
con <- TyCon -> Maybe DataCon
newTyConDataCon_maybe TyCon
tc
, Just GlobalRdrElt
gre <- GlobalRdrEnv -> Name -> Maybe GlobalRdrElt
lookupGRE_Name GlobalRdrEnv
rdr_env (DataCon -> Name
dataConName DataCon
con)
= forall ev1 ev2.
(ev1 -> ev2) -> NormaliseStepResult ev1 -> NormaliseStepResult ev2
mapStepResult (\TcCoercion
co -> (forall a. a -> Bag a
unitBag GlobalRdrElt
gre, TcCoercion
co)) forall a b. (a -> b) -> a -> b
$
NormaliseStepper TcCoercion
unwrapNewTypeStepper RecTcChecker
rec_nts TyCon
tc [Type]
tys
| WhetherHasFamInst
otherwise
= forall ev. NormaliseStepResult ev
NS_Done
tcExtendLocalFamInstEnv :: [FamInst] -> TcM a -> TcM a
tcExtendLocalFamInstEnv :: forall a. [FamInst] -> TcM a -> TcM a
tcExtendLocalFamInstEnv [] TcM a
thing_inside = TcM a
thing_inside
tcExtendLocalFamInstEnv [FamInst]
fam_insts TcM a
thing_inside
= do {
[FamInst] -> TcM ()
loadDependentFamInstModules [FamInst]
fam_insts
; TcGblEnv
env <- forall gbl lcl. TcRnIf gbl lcl gbl
getGblEnv
; (FamInstEnv
inst_env', [FamInst]
fam_insts') <- forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM (FamInstEnv, [FamInst]) -> FamInst -> TcM (FamInstEnv, [FamInst])
addLocalFamInst
(TcGblEnv -> FamInstEnv
tcg_fam_inst_env TcGblEnv
env, TcGblEnv -> [FamInst]
tcg_fam_insts TcGblEnv
env)
[FamInst]
fam_insts
; let env' :: TcGblEnv
env' = TcGblEnv
env { tcg_fam_insts :: [FamInst]
tcg_fam_insts = [FamInst]
fam_insts'
, tcg_fam_inst_env :: FamInstEnv
tcg_fam_inst_env = FamInstEnv
inst_env' }
; forall gbl lcl a. gbl -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
setGblEnv TcGblEnv
env' TcM a
thing_inside
}
loadDependentFamInstModules :: [FamInst] -> TcM ()
loadDependentFamInstModules :: [FamInst] -> TcM ()
loadDependentFamInstModules [FamInst]
fam_insts
= do { TcGblEnv
env <- forall gbl lcl. TcRnIf gbl lcl gbl
getGblEnv
; let this_mod :: Module
this_mod = TcGblEnv -> Module
tcg_mod TcGblEnv
env
imports :: ImportAvails
imports = TcGblEnv -> ImportAvails
tcg_imports TcGblEnv
env
want_module :: Module -> WhetherHasFamInst
want_module Module
mod
| Module
mod forall a. Eq a => a -> a -> WhetherHasFamInst
== Module
this_mod = WhetherHasFamInst
False
| WhetherHasFamInst
home_fams_only = forall unit. GenModule unit -> unit
moduleUnit Module
mod forall a. Eq a => a -> a -> WhetherHasFamInst
== forall unit. GenModule unit -> unit
moduleUnit Module
this_mod
| WhetherHasFamInst
otherwise = WhetherHasFamInst
True
home_fams_only :: WhetherHasFamInst
home_fams_only = forall (t :: * -> *) a.
Foldable t =>
(a -> WhetherHasFamInst) -> t a -> WhetherHasFamInst
all (Module -> Name -> WhetherHasFamInst
nameIsHomePackage Module
this_mod forall b c a. (b -> c) -> (a -> b) -> a -> c
. FamInst -> Name
fi_fam) [FamInst]
fam_insts
; SDoc -> [Module] -> TcM ()
loadModuleInterfaces (String -> SDoc
text String
"Loading family-instance modules") forall a b. (a -> b) -> a -> b
$
forall a. (a -> WhetherHasFamInst) -> [a] -> [a]
filter Module -> WhetherHasFamInst
want_module (ImportAvails -> [Module]
imp_finsts ImportAvails
imports) }
addLocalFamInst :: (FamInstEnv,[FamInst])
-> FamInst
-> TcM (FamInstEnv, [FamInst])
addLocalFamInst :: (FamInstEnv, [FamInst]) -> FamInst -> TcM (FamInstEnv, [FamInst])
addLocalFamInst (FamInstEnv
home_fie, [FamInst]
my_fis) FamInst
fam_inst
= do { String -> SDoc -> TcM ()
traceTc String
"addLocalFamInst" (forall a. Outputable a => a -> SDoc
ppr FamInst
fam_inst)
; Module
mod <- forall (m :: * -> *). HasModule m => m Module
getModule
; String -> SDoc -> TcM ()
traceTc String
"alfi" (forall a. Outputable a => a -> SDoc
ppr Module
mod)
; ExternalPackageState
eps <- forall gbl lcl. TcRnIf gbl lcl ExternalPackageState
getEps
; let inst_envs :: (FamInstEnv, FamInstEnv)
inst_envs = (ExternalPackageState -> FamInstEnv
eps_fam_inst_env ExternalPackageState
eps, FamInstEnv
home_fie)
home_fie' :: FamInstEnv
home_fie' = FamInstEnv -> FamInst -> FamInstEnv
extendFamInstEnv FamInstEnv
home_fie FamInst
fam_inst
; ((), WhetherHasFamInst
no_errs) <- forall a. TcRn a -> TcRn (a, WhetherHasFamInst)
askNoErrs forall a b. (a -> b) -> a -> b
$
do { (FamInstEnv, FamInstEnv) -> FamInst -> TcM ()
checkForConflicts (FamInstEnv, FamInstEnv)
inst_envs FamInst
fam_inst
; (FamInstEnv, FamInstEnv) -> FamInst -> TcM ()
checkForInjectivityConflicts (FamInstEnv, FamInstEnv)
inst_envs FamInst
fam_inst
; FamInst -> TcM ()
checkInjectiveEquation FamInst
fam_inst
}
; if WhetherHasFamInst
no_errs then
forall (m :: * -> *) a. Monad m => a -> m a
return (FamInstEnv
home_fie', FamInst
fam_inst forall a. a -> [a] -> [a]
: [FamInst]
my_fis)
else
forall (m :: * -> *) a. Monad m => a -> m a
return (FamInstEnv
home_fie, [FamInst]
my_fis) }
checkForConflicts :: FamInstEnvs -> FamInst -> TcM ()
checkForConflicts :: (FamInstEnv, FamInstEnv) -> FamInst -> TcM ()
checkForConflicts (FamInstEnv, FamInstEnv)
inst_envs FamInst
fam_inst
= do { let conflicts :: [FamInstMatch]
conflicts = (FamInstEnv, FamInstEnv) -> FamInst -> [FamInstMatch]
lookupFamInstEnvConflicts (FamInstEnv, FamInstEnv)
inst_envs FamInst
fam_inst
; String -> SDoc -> TcM ()
traceTc String
"checkForConflicts" forall a b. (a -> b) -> a -> b
$
[SDoc] -> SDoc
vcat [ forall a. Outputable a => a -> SDoc
ppr (forall a b. (a -> b) -> [a] -> [b]
map FamInstMatch -> FamInst
fim_instance [FamInstMatch]
conflicts)
, forall a. Outputable a => a -> SDoc
ppr FamInst
fam_inst
]
; FamInst -> [FamInstMatch] -> TcM ()
reportConflictInstErr FamInst
fam_inst [FamInstMatch]
conflicts }
checkForInjectivityConflicts :: FamInstEnvs -> FamInst -> TcM ()
checkForInjectivityConflicts :: (FamInstEnv, FamInstEnv) -> FamInst -> TcM ()
checkForInjectivityConflicts (FamInstEnv, FamInstEnv)
instEnvs FamInst
famInst
| TyCon -> WhetherHasFamInst
isTypeFamilyTyCon TyCon
tycon
, Injective [WhetherHasFamInst]
inj <- TyCon -> Injectivity
tyConInjectivityInfo TyCon
tycon
= let conflicts :: [CoAxBranch]
conflicts = [WhetherHasFamInst]
-> (FamInstEnv, FamInstEnv) -> FamInst -> [CoAxBranch]
lookupFamInstEnvInjectivityConflicts [WhetherHasFamInst]
inj (FamInstEnv, FamInstEnv)
instEnvs FamInst
famInst in
TyCon -> [CoAxBranch] -> CoAxBranch -> TcM ()
reportConflictingInjectivityErrs TyCon
tycon [CoAxBranch]
conflicts (CoAxiom Unbranched -> CoAxBranch
coAxiomSingleBranch (FamInst -> CoAxiom Unbranched
fi_axiom FamInst
famInst))
| WhetherHasFamInst
otherwise
= forall (m :: * -> *) a. Monad m => a -> m a
return ()
where tycon :: TyCon
tycon = FamInst -> TyCon
famInstTyCon FamInst
famInst
checkInjectiveEquation :: FamInst -> TcM ()
checkInjectiveEquation :: FamInst -> TcM ()
checkInjectiveEquation FamInst
famInst
| TyCon -> WhetherHasFamInst
isTypeFamilyTyCon TyCon
tycon
, Injective [WhetherHasFamInst]
inj <- TyCon -> Injectivity
tyConInjectivityInfo TyCon
tycon = do
{ DynFlags
dflags <- forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
; let axiom :: CoAxBranch
axiom = CoAxiom Unbranched -> CoAxBranch
coAxiomSingleBranch CoAxiom Unbranched
fi_ax
; forall (br :: BranchFlag).
DynFlags
-> CoAxiom br -> CoAxBranch -> [WhetherHasFamInst] -> TcM ()
reportInjectivityErrors DynFlags
dflags CoAxiom Unbranched
fi_ax CoAxBranch
axiom [WhetherHasFamInst]
inj
}
| WhetherHasFamInst
otherwise
= forall (m :: * -> *) a. Monad m => a -> m a
return ()
where tycon :: TyCon
tycon = FamInst -> TyCon
famInstTyCon FamInst
famInst
fi_ax :: CoAxiom Unbranched
fi_ax = FamInst -> CoAxiom Unbranched
fi_axiom FamInst
famInst
reportInjectivityErrors
:: DynFlags
-> CoAxiom br
-> CoAxBranch
-> [Bool]
-> TcM ()
reportInjectivityErrors :: forall (br :: BranchFlag).
DynFlags
-> CoAxiom br -> CoAxBranch -> [WhetherHasFamInst] -> TcM ()
reportInjectivityErrors DynFlags
dflags CoAxiom br
fi_ax CoAxBranch
axiom [WhetherHasFamInst]
inj
= ASSERT2( any id inj, text "No injective type variables" )
do let lhs :: [Type]
lhs = CoAxBranch -> [Type]
coAxBranchLHS CoAxBranch
axiom
rhs :: Type
rhs = CoAxBranch -> Type
coAxBranchRHS CoAxBranch
axiom
fam_tc :: TyCon
fam_tc = forall (br :: BranchFlag). CoAxiom br -> TyCon
coAxiomTyCon CoAxiom br
fi_ax
(TyVarSet
unused_inj_tvs, WhetherHasFamInst
unused_vis, WhetherHasFamInst
undec_inst_flag)
= DynFlags
-> TyCon
-> [Type]
-> Type
-> (TyVarSet, WhetherHasFamInst, WhetherHasFamInst)
unusedInjTvsInRHS DynFlags
dflags TyCon
fam_tc [Type]
lhs Type
rhs
inj_tvs_unused :: WhetherHasFamInst
inj_tvs_unused = WhetherHasFamInst -> WhetherHasFamInst
not forall a b. (a -> b) -> a -> b
$ TyVarSet -> WhetherHasFamInst
isEmptyVarSet TyVarSet
unused_inj_tvs
tf_headed :: WhetherHasFamInst
tf_headed = Type -> WhetherHasFamInst
isTFHeaded Type
rhs
bare_variables :: [Type]
bare_variables = [Type] -> Type -> [Type]
bareTvInRHSViolated [Type]
lhs Type
rhs
wrong_bare_rhs :: WhetherHasFamInst
wrong_bare_rhs = WhetherHasFamInst -> WhetherHasFamInst
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> WhetherHasFamInst
null [Type]
bare_variables
forall (f :: * -> *).
Applicative f =>
WhetherHasFamInst -> f () -> f ()
when WhetherHasFamInst
inj_tvs_unused forall a b. (a -> b) -> a -> b
$ TyCon
-> TyVarSet
-> WhetherHasFamInst
-> WhetherHasFamInst
-> CoAxBranch
-> TcM ()
reportUnusedInjectiveVarsErr TyCon
fam_tc TyVarSet
unused_inj_tvs
WhetherHasFamInst
unused_vis WhetherHasFamInst
undec_inst_flag CoAxBranch
axiom
forall (f :: * -> *).
Applicative f =>
WhetherHasFamInst -> f () -> f ()
when WhetherHasFamInst
tf_headed forall a b. (a -> b) -> a -> b
$ TyCon -> CoAxBranch -> TcM ()
reportTfHeadedErr TyCon
fam_tc CoAxBranch
axiom
forall (f :: * -> *).
Applicative f =>
WhetherHasFamInst -> f () -> f ()
when WhetherHasFamInst
wrong_bare_rhs forall a b. (a -> b) -> a -> b
$ TyCon -> [Type] -> CoAxBranch -> TcM ()
reportBareVariableInRHSErr TyCon
fam_tc [Type]
bare_variables CoAxBranch
axiom
isTFHeaded :: Type -> Bool
isTFHeaded :: Type -> WhetherHasFamInst
isTFHeaded Type
ty | Just Type
ty' <- Type -> Maybe Type
coreView Type
ty
= Type -> WhetherHasFamInst
isTFHeaded Type
ty'
isTFHeaded Type
ty | (TyConApp TyCon
tc [Type]
args) <- Type
ty
, TyCon -> WhetherHasFamInst
isTypeFamilyTyCon TyCon
tc
= [Type]
args forall a. [a] -> Int -> WhetherHasFamInst
`lengthIs` TyCon -> Int
tyConArity TyCon
tc
isTFHeaded Type
_ = WhetherHasFamInst
False
bareTvInRHSViolated :: [Type] -> Type -> [Type]
bareTvInRHSViolated :: [Type] -> Type -> [Type]
bareTvInRHSViolated [Type]
pats Type
rhs | Type -> WhetherHasFamInst
isTyVarTy Type
rhs
= forall a. (a -> WhetherHasFamInst) -> [a] -> [a]
filter (WhetherHasFamInst -> WhetherHasFamInst
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> WhetherHasFamInst
isTyVarTy) [Type]
pats
bareTvInRHSViolated [Type]
_ Type
_ = []
unusedInjTvsInRHS :: DynFlags
-> TyCon
-> [Type]
-> Type
-> ( TyVarSet
, Bool
, Bool )
unusedInjTvsInRHS :: DynFlags
-> TyCon
-> [Type]
-> Type
-> (TyVarSet, WhetherHasFamInst, WhetherHasFamInst)
unusedInjTvsInRHS DynFlags
dflags tycon :: TyCon
tycon@(TyCon -> Injectivity
tyConInjectivityInfo -> Injective [WhetherHasFamInst]
inj_list) [Type]
lhs Type
rhs =
(TyVarSet
bad_vars, WhetherHasFamInst
any_invisible, WhetherHasFamInst
suggest_undec)
where
undec_inst :: WhetherHasFamInst
undec_inst = Extension -> DynFlags -> WhetherHasFamInst
xopt Extension
LangExt.UndecidableInstances DynFlags
dflags
inj_lhs :: [Type]
inj_lhs = forall a. [WhetherHasFamInst] -> [a] -> [a]
filterByList [WhetherHasFamInst]
inj_list [Type]
lhs
lhs_vars :: TyVarSet
lhs_vars = [Type] -> TyVarSet
tyCoVarsOfTypes [Type]
inj_lhs
rhs_inj_vars :: TyVarSet
rhs_inj_vars = FV -> TyVarSet
fvVarSet forall a b. (a -> b) -> a -> b
$ WhetherHasFamInst -> Type -> FV
injectiveVarsOfType WhetherHasFamInst
undec_inst Type
rhs
bad_vars :: TyVarSet
bad_vars = TyVarSet
lhs_vars TyVarSet -> TyVarSet -> TyVarSet
`minusVarSet` TyVarSet
rhs_inj_vars
any_bad :: WhetherHasFamInst
any_bad = WhetherHasFamInst -> WhetherHasFamInst
not forall a b. (a -> b) -> a -> b
$ TyVarSet -> WhetherHasFamInst
isEmptyVarSet TyVarSet
bad_vars
invis_vars :: TyVarSet
invis_vars = FV -> TyVarSet
fvVarSet forall a b. (a -> b) -> a -> b
$ [Type] -> FV
invisibleVarsOfTypes [TyCon -> [Type] -> Type
mkTyConApp TyCon
tycon [Type]
lhs, Type
rhs]
any_invisible :: WhetherHasFamInst
any_invisible = WhetherHasFamInst
any_bad WhetherHasFamInst -> WhetherHasFamInst -> WhetherHasFamInst
&& (TyVarSet
bad_vars TyVarSet -> TyVarSet -> WhetherHasFamInst
`intersectsVarSet` TyVarSet
invis_vars)
suggest_undec :: WhetherHasFamInst
suggest_undec = WhetherHasFamInst
any_bad WhetherHasFamInst -> WhetherHasFamInst -> WhetherHasFamInst
&&
WhetherHasFamInst -> WhetherHasFamInst
not WhetherHasFamInst
undec_inst WhetherHasFamInst -> WhetherHasFamInst -> WhetherHasFamInst
&&
(TyVarSet
lhs_vars TyVarSet -> TyVarSet -> WhetherHasFamInst
`subVarSet` FV -> TyVarSet
fvVarSet (WhetherHasFamInst -> Type -> FV
injectiveVarsOfType WhetherHasFamInst
True Type
rhs))
unusedInjTvsInRHS DynFlags
_ TyCon
_ [Type]
_ Type
_ = (TyVarSet
emptyVarSet, WhetherHasFamInst
False, WhetherHasFamInst
False)
reportConflictingInjectivityErrs :: TyCon -> [CoAxBranch] -> CoAxBranch -> TcM ()
reportConflictingInjectivityErrs :: TyCon -> [CoAxBranch] -> CoAxBranch -> TcM ()
reportConflictingInjectivityErrs TyCon
_ [] CoAxBranch
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
reportConflictingInjectivityErrs TyCon
fam_tc (CoAxBranch
confEqn1:[CoAxBranch]
_) CoAxBranch
tyfamEqn
= [(SrcSpan, SDoc)] -> TcM ()
addErrs [TyCon -> SDoc -> NonEmpty CoAxBranch -> (SrcSpan, SDoc)
buildInjectivityError TyCon
fam_tc SDoc
herald (CoAxBranch
confEqn1 forall a. a -> [a] -> NonEmpty a
:| [CoAxBranch
tyfamEqn])]
where
herald :: SDoc
herald = String -> SDoc
text String
"Type family equation right-hand sides overlap; this violates" SDoc -> SDoc -> SDoc
$$
String -> SDoc
text String
"the family's injectivity annotation:"
injectivityErrorHerald :: SDoc
injectivityErrorHerald :: SDoc
injectivityErrorHerald =
String -> SDoc
text String
"Type family equation violates the family's injectivity annotation."
reportUnusedInjectiveVarsErr :: TyCon
-> TyVarSet
-> Bool
-> Bool
-> CoAxBranch
-> TcM ()
reportUnusedInjectiveVarsErr :: TyCon
-> TyVarSet
-> WhetherHasFamInst
-> WhetherHasFamInst
-> CoAxBranch
-> TcM ()
reportUnusedInjectiveVarsErr TyCon
fam_tc TyVarSet
tvs WhetherHasFamInst
has_kinds WhetherHasFamInst
undec_inst CoAxBranch
tyfamEqn
= let (SrcSpan
loc, SDoc
doc) = TyCon -> SDoc -> NonEmpty CoAxBranch -> (SrcSpan, SDoc)
buildInjectivityError TyCon
fam_tc
(SDoc
injectivityErrorHerald SDoc -> SDoc -> SDoc
$$
SDoc
herald SDoc -> SDoc -> SDoc
$$
String -> SDoc
text String
"In the type family equation:")
(CoAxBranch
tyfamEqn forall a. a -> [a] -> NonEmpty a
:| [])
in SrcSpan -> SDoc -> TcM ()
addErrAt SrcSpan
loc (WhetherHasFamInst -> SDoc -> SDoc
pprWithExplicitKindsWhen WhetherHasFamInst
has_kinds SDoc
doc)
where
herald :: SDoc
herald = [SDoc] -> SDoc
sep [ SDoc
what SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"variable" SDoc -> SDoc -> SDoc
<>
TyVarSet -> SDoc
pluralVarSet TyVarSet
tvs SDoc -> SDoc -> SDoc
<+> TyVarSet -> ([TyCoVar] -> SDoc) -> SDoc
pprVarSet TyVarSet
tvs (forall a. Outputable a => [a] -> SDoc
pprQuotedList forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TyCoVar] -> [TyCoVar]
scopedSort)
, String -> SDoc
text String
"cannot be inferred from the right-hand side." ]
SDoc -> SDoc -> SDoc
$$ SDoc
extra
what :: SDoc
what | WhetherHasFamInst
has_kinds = String -> SDoc
text String
"Type/kind"
| WhetherHasFamInst
otherwise = String -> SDoc
text String
"Type"
extra :: SDoc
extra | WhetherHasFamInst
undec_inst = String -> SDoc
text String
"Using UndecidableInstances might help"
| WhetherHasFamInst
otherwise = SDoc
empty
reportTfHeadedErr :: TyCon -> CoAxBranch -> TcM ()
reportTfHeadedErr :: TyCon -> CoAxBranch -> TcM ()
reportTfHeadedErr TyCon
fam_tc CoAxBranch
branch
= [(SrcSpan, SDoc)] -> TcM ()
addErrs [TyCon -> SDoc -> NonEmpty CoAxBranch -> (SrcSpan, SDoc)
buildInjectivityError TyCon
fam_tc
(SDoc
injectivityErrorHerald SDoc -> SDoc -> SDoc
$$
String -> SDoc
text String
"RHS of injective type family equation cannot" SDoc -> SDoc -> SDoc
<+>
String -> SDoc
text String
"be a type family:")
(CoAxBranch
branch forall a. a -> [a] -> NonEmpty a
:| [])]
reportBareVariableInRHSErr :: TyCon -> [Type] -> CoAxBranch -> TcM ()
reportBareVariableInRHSErr :: TyCon -> [Type] -> CoAxBranch -> TcM ()
reportBareVariableInRHSErr TyCon
fam_tc [Type]
tys CoAxBranch
branch
= [(SrcSpan, SDoc)] -> TcM ()
addErrs [TyCon -> SDoc -> NonEmpty CoAxBranch -> (SrcSpan, SDoc)
buildInjectivityError TyCon
fam_tc
(SDoc
injectivityErrorHerald SDoc -> SDoc -> SDoc
$$
String -> SDoc
text String
"RHS of injective type family equation is a bare" SDoc -> SDoc -> SDoc
<+>
String -> SDoc
text String
"type variable" SDoc -> SDoc -> SDoc
$$
String -> SDoc
text String
"but these LHS type and kind patterns are not bare" SDoc -> SDoc -> SDoc
<+>
String -> SDoc
text String
"variables:" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => [a] -> SDoc
pprQuotedList [Type]
tys)
(CoAxBranch
branch forall a. a -> [a] -> NonEmpty a
:| [])]
buildInjectivityError :: TyCon -> SDoc -> NonEmpty CoAxBranch -> (SrcSpan, SDoc)
buildInjectivityError :: TyCon -> SDoc -> NonEmpty CoAxBranch -> (SrcSpan, SDoc)
buildInjectivityError TyCon
fam_tc SDoc
herald (CoAxBranch
eqn1 :| [CoAxBranch]
rest_eqns)
= ( CoAxBranch -> SrcSpan
coAxBranchSpan CoAxBranch
eqn1
, SDoc -> Int -> SDoc -> SDoc
hang SDoc
herald
Int
2 ([SDoc] -> SDoc
vcat (forall a b. (a -> b) -> [a] -> [b]
map (TyCon -> CoAxBranch -> SDoc
pprCoAxBranchUser TyCon
fam_tc) (CoAxBranch
eqn1 forall a. a -> [a] -> [a]
: [CoAxBranch]
rest_eqns))) )
reportConflictInstErr :: FamInst -> [FamInstMatch] -> TcRn ()
reportConflictInstErr :: FamInst -> [FamInstMatch] -> TcM ()
reportConflictInstErr FamInst
_ []
= forall (m :: * -> *) a. Monad m => a -> m a
return ()
reportConflictInstErr FamInst
fam_inst (FamInstMatch
match1 : [FamInstMatch]
_)
| FamInstMatch { fim_instance :: FamInstMatch -> FamInst
fim_instance = FamInst
conf_inst } <- FamInstMatch
match1
, let sorted :: [FamInst]
sorted = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (SrcSpan -> SrcSpan -> Ordering
SrcLoc.leftmost_smallest forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` FamInst -> SrcSpan
getSpan) [FamInst
fam_inst, FamInst
conf_inst]
fi1 :: FamInst
fi1 = forall a. [a] -> a
head [FamInst]
sorted
span :: SrcSpan
span = CoAxBranch -> SrcSpan
coAxBranchSpan (CoAxiom Unbranched -> CoAxBranch
coAxiomSingleBranch (FamInst -> CoAxiom Unbranched
famInstAxiom FamInst
fi1))
= forall a. SrcSpan -> TcRn a -> TcRn a
setSrcSpan SrcSpan
span forall a b. (a -> b) -> a -> b
$ SDoc -> TcM ()
addErr forall a b. (a -> b) -> a -> b
$
SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"Conflicting family instance declarations:")
Int
2 ([SDoc] -> SDoc
vcat [ TyCon -> CoAxBranch -> SDoc
pprCoAxBranchUser (forall (br :: BranchFlag). CoAxiom br -> TyCon
coAxiomTyCon CoAxiom Unbranched
ax) (CoAxiom Unbranched -> CoAxBranch
coAxiomSingleBranch CoAxiom Unbranched
ax)
| FamInst
fi <- [FamInst]
sorted
, let ax :: CoAxiom Unbranched
ax = FamInst -> CoAxiom Unbranched
famInstAxiom FamInst
fi ])
where
getSpan :: FamInst -> SrcSpan
getSpan = forall a. NamedThing a => a -> SrcSpan
getSrcSpan forall b c a. (b -> c) -> (a -> b) -> a -> c
. FamInst -> CoAxiom Unbranched
famInstAxiom
tcGetFamInstEnvs :: TcM FamInstEnvs
tcGetFamInstEnvs :: TcM (FamInstEnv, FamInstEnv)
tcGetFamInstEnvs
= do { ExternalPackageState
eps <- forall gbl lcl. TcRnIf gbl lcl ExternalPackageState
getEps; TcGblEnv
env <- forall gbl lcl. TcRnIf gbl lcl gbl
getGblEnv
; forall (m :: * -> *) a. Monad m => a -> m a
return (ExternalPackageState -> FamInstEnv
eps_fam_inst_env ExternalPackageState
eps, TcGblEnv -> FamInstEnv
tcg_fam_inst_env TcGblEnv
env) }