{-# LANGUAGE GADTs, ViewPatterns #-}
module GHC.Tc.Instance.Family (
FamInstEnvs, tcGetFamInstEnvs,
checkFamInstConsistency, tcExtendLocalFamInstEnv,
tcLookupDataFamInst, tcLookupDataFamInst_maybe,
tcInstNewTyCon_maybe, tcTopNormaliseNewTypeTF_maybe,
reportInjectivityErrors, reportConflictingInjectivityErrs
) where
import GHC.Prelude
import GHC.Driver.DynFlags
import GHC.Driver.Env
import GHC.Core.FamInstEnv
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.Iface.Load
import GHC.Tc.Errors.Types
import GHC.Tc.Types.Evidence
import GHC.Tc.Utils.Monad
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.NonEmpty ( NonEmpty(..) )
import qualified Data.List.NonEmpty as NE
import Data.Function ( on )
import qualified GHC.LanguageExtensions as LangExt
import GHC.Unit.Env (unitEnv_hpts)
checkFamInstConsistency :: [Module] -> TcM ()
checkFamInstConsistency :: [Module] -> TcM ()
checkFamInstConsistency [Module]
directlyImpMods
= do { (eps, hug) <- TcRnIf TcGblEnv TcLclEnv (ExternalPackageState, HomeUnitGraph)
forall gbl lcl.
TcRnIf gbl lcl (ExternalPackageState, HomeUnitGraph)
getEpsAndHug
; traceTc "checkFamInstConsistency" (ppr directlyImpMods)
; let {
modIface Module
mod =
case HomeUnitGraph -> PackageIfaceTable -> Module -> Maybe ModIface
lookupIfaceByModule HomeUnitGraph
hug (ExternalPackageState -> PackageIfaceTable
eps_PIT ExternalPackageState
eps) Module
mod of
Maybe ModIface
Nothing -> String -> SDoc -> ModIface
forall a. String -> SDoc -> a
panicDoc String
"FamInst.checkFamInstConsistency"
(Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
mod SDoc -> SDoc -> SDoc
forall doc. IsDoc doc => doc -> doc -> doc
$$ HomeUnitGraph -> SDoc
forall a. Outputable a => a -> SDoc
ppr HomeUnitGraph
hug)
Just ModIface
iface -> ModIface
iface
; modConsistent :: Module -> [Module]
; modConsistent Module
mod =
if ModIfaceBackend -> WhetherHasFamInst
mi_finsts (ModIface -> IfaceBackendExts 'ModIfaceFinal
forall (phase :: ModIfacePhase).
ModIface_ phase -> IfaceBackendExts phase
mi_final_exts (Module -> ModIface
modIface Module
mod)) then Module
modModule -> [Module] -> [Module]
forall a. a -> [a] -> [a]
:[Module]
deps else [Module]
deps
where
deps :: [Module]
deps = Dependencies -> [Module]
dep_finsts (Dependencies -> [Module])
-> (Module -> Dependencies) -> Module -> [Module]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModIface -> Dependencies
forall (phase :: ModIfacePhase). ModIface_ phase -> Dependencies
mi_deps (ModIface -> Dependencies)
-> (Module -> ModIface) -> Module -> Dependencies
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module -> ModIface
modIface (Module -> [Module]) -> Module -> [Module]
forall a b. (a -> b) -> a -> b
$ Module
mod
; hmiModule = ModIface -> Module
forall (phase :: ModIfacePhase). ModIface_ phase -> Module
mi_module (ModIface -> Module)
-> (HomeModInfo -> ModIface) -> HomeModInfo -> Module
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HomeModInfo -> ModIface
hm_iface
; hmiFamInstEnv = FamInstEnv -> [FamInst] -> FamInstEnv
extendFamInstEnvList FamInstEnv
emptyFamInstEnv
([FamInst] -> FamInstEnv)
-> (HomeModInfo -> [FamInst]) -> HomeModInfo -> FamInstEnv
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModDetails -> [FamInst]
md_fam_insts (ModDetails -> [FamInst])
-> (HomeModInfo -> ModDetails) -> HomeModInfo -> [FamInst]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HomeModInfo -> ModDetails
hm_details
; hpt_fam_insts = [(Module, FamInstEnv)] -> ModuleEnv FamInstEnv
forall a. [(Module, a)] -> ModuleEnv a
mkModuleEnv [ (HomeModInfo -> Module
hmiModule HomeModInfo
hmi, HomeModInfo -> FamInstEnv
hmiFamInstEnv HomeModInfo
hmi)
| HomePackageTable
hpt <- HomeUnitGraph -> [HomePackageTable]
unitEnv_hpts HomeUnitGraph
hug
, HomeModInfo
hmi <- HomePackageTable -> [HomeModInfo]
eltsHpt HomePackageTable
hpt ]
}
; checkMany hpt_fam_insts modConsistent 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
_ [] = () -> TcM ()
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
go [Module]
consistent ModuleSet
consistent_set (Module
mod:[Module]
mods) = do
[TcM ()] -> TcM ()
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 [Module] -> [Module] -> [Module]
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 =
(Module -> WhetherHasFamInst) -> [Module] -> [Module]
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 =
(Module -> WhetherHasFamInst) -> [Module] -> [Module]
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 { env1' <- ModuleEnv FamInstEnv -> Module -> TcM FamInstEnv
getFamInsts ModuleEnv FamInstEnv
hpt_fam_insts Module
m1
; env2' <- getFamInsts hpt_fam_insts m2
; let sizeE1 = FamInstEnv -> Int
famInstEnvSize FamInstEnv
env1'
sizeE2 = FamInstEnv -> Int
famInstEnvSize FamInstEnv
env2'
(env1, env2) = if sizeE1 < sizeE2 then (env1', env2')
else (env2', env1')
; let check_now = FamInstEnv -> [FamInst]
famInstEnvElts FamInstEnv
env1
; mapM_ (checkForConflicts (emptyFamInstEnv, env2)) check_now
; mapM_ (checkForInjectivityConflicts (emptyFamInstEnv,env2)) 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 <- ModuleEnv FamInstEnv -> Module -> Maybe FamInstEnv
forall a. ModuleEnv a -> Module -> Maybe a
lookupModuleEnv ModuleEnv FamInstEnv
hpt_fam_insts Module
mod = FamInstEnv -> TcM FamInstEnv
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return FamInstEnv
env
| WhetherHasFamInst
otherwise = do { _ <- IfG ModIface -> TcRn ModIface
forall a. IfG a -> TcRn a
initIfaceTcRn (SDoc -> Module -> IfG ModIface
forall lcl. SDoc -> Module -> IfM lcl ModIface
loadSysInterface SDoc
doc Module
mod)
; eps <- getEps
; return (expectJust "checkFamInstConsistency" $
lookupModuleEnv (eps_mod_fam_inst_env eps) mod) }
where
doc :: SDoc
doc = Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
mod SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"is a family-instance module"
tcInstNewTyCon_maybe :: TyCon -> [TcType] -> Maybe (TcType, TcCoercion)
tcInstNewTyCon_maybe :: TyCon -> [TcType] -> Maybe (TcType, TcCoercion)
tcInstNewTyCon_maybe = TyCon -> [TcType] -> Maybe (TcType, TcCoercion)
instNewTyCon_maybe
tcLookupDataFamInst :: FamInstEnvs -> TyCon -> [TcType]
-> (TyCon, [TcType], Coercion)
tcLookupDataFamInst :: (FamInstEnv, FamInstEnv)
-> TyCon -> [TcType] -> (TyCon, [TcType], TcCoercion)
tcLookupDataFamInst (FamInstEnv, FamInstEnv)
fam_inst_envs TyCon
tc [TcType]
tc_args
| Just (TyCon
rep_tc, [TcType]
rep_args, TcCoercion
co)
<- (FamInstEnv, FamInstEnv)
-> TyCon -> [TcType] -> Maybe (TyCon, [TcType], TcCoercion)
tcLookupDataFamInst_maybe (FamInstEnv, FamInstEnv)
fam_inst_envs TyCon
tc [TcType]
tc_args
= (TyCon
rep_tc, [TcType]
rep_args, TcCoercion
co)
| WhetherHasFamInst
otherwise
= (TyCon
tc, [TcType]
tc_args, TcType -> TcCoercion
mkRepReflCo (TyCon -> [TcType] -> TcType
mkTyConApp TyCon
tc [TcType]
tc_args))
tcLookupDataFamInst_maybe :: FamInstEnvs -> TyCon -> [TcType]
-> Maybe (TyCon, [TcType], Coercion)
tcLookupDataFamInst_maybe :: (FamInstEnv, FamInstEnv)
-> TyCon -> [TcType] -> Maybe (TyCon, [TcType], TcCoercion)
tcLookupDataFamInst_maybe (FamInstEnv, FamInstEnv)
fam_inst_envs TyCon
tc [TcType]
tc_args
| TyCon -> WhetherHasFamInst
isDataFamilyTyCon TyCon
tc
, FamInstMatch
match : [FamInstMatch]
_ <- (FamInstEnv, FamInstEnv) -> TyCon -> [TcType] -> [FamInstMatch]
lookupFamInstEnv (FamInstEnv, FamInstEnv)
fam_inst_envs TyCon
tc [TcType]
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 -> [CoVar]
fi_cvs = [CoVar]
cvs })
, fim_tys :: FamInstMatch -> [TcType]
fim_tys = [TcType]
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 -> [TcType] -> [TcCoercion] -> TcCoercion
mkUnbranchedAxInstCo Role
Representational CoAxiom Unbranched
ax [TcType]
rep_args
([CoVar] -> [TcCoercion]
mkCoVarCos [CoVar]
cvs)
= WhetherHasFamInst
-> Maybe (TyCon, [TcType], TcCoercion)
-> Maybe (TyCon, [TcType], TcCoercion)
forall a. HasCallStack => WhetherHasFamInst -> a -> a
assert ([TcCoercion] -> WhetherHasFamInst
forall a. [a] -> WhetherHasFamInst
forall (t :: * -> *) a. Foldable t => t a -> WhetherHasFamInst
null [TcCoercion]
rep_cos) (Maybe (TyCon, [TcType], TcCoercion)
-> Maybe (TyCon, [TcType], TcCoercion))
-> Maybe (TyCon, [TcType], TcCoercion)
-> Maybe (TyCon, [TcType], TcCoercion)
forall a b. (a -> b) -> a -> b
$
(TyCon, [TcType], TcCoercion)
-> Maybe (TyCon, [TcType], TcCoercion)
forall a. a -> Maybe a
Just (TyCon
rep_tc, [TcType]
rep_args, TcCoercion
co)
| WhetherHasFamInst
otherwise
= Maybe (TyCon, [TcType], TcCoercion)
forall a. Maybe a
Nothing
tcTopNormaliseNewTypeTF_maybe :: FamInstEnvs
-> GlobalRdrEnv
-> Type
-> Maybe ((Bag GlobalRdrElt, TcCoercion), Type)
tcTopNormaliseNewTypeTF_maybe :: (FamInstEnv, FamInstEnv)
-> GlobalRdrEnv
-> TcType
-> Maybe ((Bag (GlobalRdrEltX GREInfo), TcCoercion), TcType)
tcTopNormaliseNewTypeTF_maybe (FamInstEnv, FamInstEnv)
faminsts GlobalRdrEnv
rdr_env TcType
ty
= NormaliseStepper (Bag (GlobalRdrEltX GREInfo), TcCoercion)
-> ((Bag (GlobalRdrEltX GREInfo), TcCoercion)
-> (Bag (GlobalRdrEltX GREInfo), TcCoercion)
-> (Bag (GlobalRdrEltX GREInfo), TcCoercion))
-> TcType
-> Maybe ((Bag (GlobalRdrEltX GREInfo), TcCoercion), TcType)
forall ev.
NormaliseStepper ev
-> (ev -> ev -> ev) -> TcType -> Maybe (ev, TcType)
topNormaliseTypeX NormaliseStepper (Bag (GlobalRdrEltX GREInfo), TcCoercion)
stepper (Bag (GlobalRdrEltX GREInfo), TcCoercion)
-> (Bag (GlobalRdrEltX GREInfo), TcCoercion)
-> (Bag (GlobalRdrEltX GREInfo), TcCoercion)
plus TcType
ty
where
plus :: (Bag GlobalRdrElt, TcCoercion) -> (Bag GlobalRdrElt, TcCoercion)
-> (Bag GlobalRdrElt, TcCoercion)
plus :: (Bag (GlobalRdrEltX GREInfo), TcCoercion)
-> (Bag (GlobalRdrEltX GREInfo), TcCoercion)
-> (Bag (GlobalRdrEltX GREInfo), TcCoercion)
plus (Bag (GlobalRdrEltX GREInfo)
gres1, TcCoercion
co1) (Bag (GlobalRdrEltX GREInfo)
gres2, TcCoercion
co2) = ( Bag (GlobalRdrEltX GREInfo)
gres1 Bag (GlobalRdrEltX GREInfo)
-> Bag (GlobalRdrEltX GREInfo) -> Bag (GlobalRdrEltX GREInfo)
forall a. Bag a -> Bag a -> Bag a
`unionBags` Bag (GlobalRdrEltX GREInfo)
gres2
, TcCoercion
co1 HasDebugCallStack => TcCoercion -> TcCoercion -> TcCoercion
TcCoercion -> TcCoercion -> TcCoercion
`mkTransCo` TcCoercion
co2 )
stepper :: NormaliseStepper (Bag GlobalRdrElt, TcCoercion)
stepper :: NormaliseStepper (Bag (GlobalRdrEltX GREInfo), TcCoercion)
stepper = NormaliseStepper (Bag (GlobalRdrEltX GREInfo), TcCoercion)
unwrap_newtype NormaliseStepper (Bag (GlobalRdrEltX GREInfo), TcCoercion)
-> NormaliseStepper (Bag (GlobalRdrEltX GREInfo), TcCoercion)
-> NormaliseStepper (Bag (GlobalRdrEltX GREInfo), TcCoercion)
forall ev.
NormaliseStepper ev -> NormaliseStepper ev -> NormaliseStepper ev
`composeSteppers` NormaliseStepper (Bag (GlobalRdrEltX GREInfo), TcCoercion)
unwrap_newtype_instance
unwrap_newtype_instance :: NormaliseStepper (Bag (GlobalRdrEltX GREInfo), TcCoercion)
unwrap_newtype_instance RecTcChecker
rec_nts TyCon
tc [TcType]
tys
| Just (TyCon
tc', [TcType]
tys', TcCoercion
co) <- (FamInstEnv, FamInstEnv)
-> TyCon -> [TcType] -> Maybe (TyCon, [TcType], TcCoercion)
tcLookupDataFamInst_maybe (FamInstEnv, FamInstEnv)
faminsts TyCon
tc [TcType]
tys
= (TcCoercion -> TcCoercion)
-> (Bag (GlobalRdrEltX GREInfo), TcCoercion)
-> (Bag (GlobalRdrEltX GREInfo), TcCoercion)
forall a b.
(a -> b)
-> (Bag (GlobalRdrEltX GREInfo), a)
-> (Bag (GlobalRdrEltX GREInfo), b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (HasDebugCallStack => TcCoercion -> TcCoercion -> TcCoercion
TcCoercion -> TcCoercion -> TcCoercion
mkTransCo TcCoercion
co) ((Bag (GlobalRdrEltX GREInfo), TcCoercion)
-> (Bag (GlobalRdrEltX GREInfo), TcCoercion))
-> NormaliseStepResult (Bag (GlobalRdrEltX GREInfo), TcCoercion)
-> NormaliseStepResult (Bag (GlobalRdrEltX GREInfo), TcCoercion)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NormaliseStepper (Bag (GlobalRdrEltX GREInfo), TcCoercion)
unwrap_newtype RecTcChecker
rec_nts TyCon
tc' [TcType]
tys'
| WhetherHasFamInst
otherwise = NormaliseStepResult (Bag (GlobalRdrEltX GREInfo), TcCoercion)
forall ev. NormaliseStepResult ev
NS_Done
unwrap_newtype :: NormaliseStepper (Bag (GlobalRdrEltX GREInfo), TcCoercion)
unwrap_newtype RecTcChecker
rec_nts TyCon
tc [TcType]
tys
| Just DataCon
con <- TyCon -> Maybe DataCon
newTyConDataCon_maybe TyCon
tc
, Just GlobalRdrEltX GREInfo
gre <- GlobalRdrEnv -> Name -> Maybe (GlobalRdrEltX GREInfo)
forall info.
Outputable info =>
GlobalRdrEnvX info -> Name -> Maybe (GlobalRdrEltX info)
lookupGRE_Name GlobalRdrEnv
rdr_env (DataCon -> Name
dataConName DataCon
con)
= (,) (GlobalRdrEltX GREInfo -> Bag (GlobalRdrEltX GREInfo)
forall a. a -> Bag a
unitBag GlobalRdrEltX GREInfo
gre) (TcCoercion -> (Bag (GlobalRdrEltX GREInfo), TcCoercion))
-> NormaliseStepResult TcCoercion
-> NormaliseStepResult (Bag (GlobalRdrEltX GREInfo), TcCoercion)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NormaliseStepper TcCoercion
unwrapNewTypeStepper RecTcChecker
rec_nts TyCon
tc [TcType]
tys
| WhetherHasFamInst
otherwise
= NormaliseStepResult (Bag (GlobalRdrEltX GREInfo), TcCoercion)
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
; env <- TcRnIf TcGblEnv TcLclEnv TcGblEnv
forall gbl lcl. TcRnIf gbl lcl gbl
getGblEnv
; (inst_env', fam_insts') <- foldlM addLocalFamInst
(tcg_fam_inst_env env, tcg_fam_insts env)
fam_insts
; let env' = TcGblEnv
env { tcg_fam_insts = fam_insts'
, tcg_fam_inst_env = inst_env' }
; setGblEnv env' thing_inside
}
loadDependentFamInstModules :: [FamInst] -> TcM ()
loadDependentFamInstModules :: [FamInst] -> TcM ()
loadDependentFamInstModules [FamInst]
fam_insts
= do { env <- TcRnIf TcGblEnv TcLclEnv TcGblEnv
forall gbl lcl. TcRnIf gbl lcl gbl
getGblEnv
; let this_mod = TcGblEnv -> Module
tcg_mod TcGblEnv
env
imports = TcGblEnv -> ImportAvails
tcg_imports TcGblEnv
env
want_module Module
mod
| Module
mod Module -> Module -> WhetherHasFamInst
forall a. Eq a => a -> a -> WhetherHasFamInst
== Module
this_mod = WhetherHasFamInst
False
| WhetherHasFamInst
home_fams_only = Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit Module
mod Unit -> Unit -> WhetherHasFamInst
forall a. Eq a => a -> a -> WhetherHasFamInst
== Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit Module
this_mod
| WhetherHasFamInst
otherwise = WhetherHasFamInst
True
home_fams_only = (FamInst -> WhetherHasFamInst) -> [FamInst] -> WhetherHasFamInst
forall (t :: * -> *) a.
Foldable t =>
(a -> WhetherHasFamInst) -> t a -> WhetherHasFamInst
all (Module -> Name -> WhetherHasFamInst
nameIsHomePackage Module
this_mod (Name -> WhetherHasFamInst)
-> (FamInst -> Name) -> FamInst -> WhetherHasFamInst
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FamInst -> Name
fi_fam) [FamInst]
fam_insts
; loadModuleInterfaces (text "Loading family-instance modules") $
filter want_module (imp_finsts imports) }
addLocalFamInst :: (FamInstEnv,[FamInst])
-> FamInst
-> TcM (FamInstEnv, [FamInst])
addLocalFamInst :: (FamInstEnv, [FamInst])
-> FamInst -> IOEnv (Env TcGblEnv TcLclEnv) (FamInstEnv, [FamInst])
addLocalFamInst (FamInstEnv
home_fie, [FamInst]
my_fis) FamInst
fam_inst
= do { String -> SDoc -> TcM ()
traceTc String
"addLocalFamInst" (FamInst -> SDoc
forall a. Outputable a => a -> SDoc
ppr FamInst
fam_inst)
; mod <- IOEnv (Env TcGblEnv TcLclEnv) Module
forall (m :: * -> *). HasModule m => m Module
getModule
; traceTc "alfi" (ppr mod)
; eps <- getEps
; let inst_envs = (ExternalPackageState -> FamInstEnv
eps_fam_inst_env ExternalPackageState
eps, FamInstEnv
home_fie)
home_fie' = FamInstEnv -> FamInst -> FamInstEnv
extendFamInstEnv FamInstEnv
home_fie FamInst
fam_inst
; ((), no_errs) <- askNoErrs $
do { checkForConflicts inst_envs fam_inst
; checkForInjectivityConflicts inst_envs fam_inst
; checkInjectiveEquation fam_inst
}
; if no_errs then
return (home_fie', fam_inst : my_fis)
else
return (home_fie, my_fis) }
checkForConflicts :: FamInstEnvs -> FamInst -> TcM ()
checkForConflicts :: (FamInstEnv, FamInstEnv) -> FamInst -> TcM ()
checkForConflicts (FamInstEnv, FamInstEnv)
inst_envs FamInst
fam_inst
= do { let conflicts :: [FamInst]
conflicts = (FamInstEnv, FamInstEnv) -> FamInst -> [FamInst]
lookupFamInstEnvConflicts (FamInstEnv, FamInstEnv)
inst_envs FamInst
fam_inst
; String -> SDoc -> TcM ()
traceTc String
"checkForConflicts" (SDoc -> TcM ()) -> SDoc -> TcM ()
forall a b. (a -> b) -> a -> b
$
[SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ [FamInst] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [FamInst]
conflicts
, FamInst -> SDoc
forall a. Outputable a => a -> SDoc
ppr FamInst
fam_inst
]
; FamInst -> [FamInst] -> TcM ()
reportConflictInstErr FamInst
fam_inst [FamInst]
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
= () -> TcM ()
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
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
{ dflags <- IOEnv (Env TcGblEnv TcLclEnv) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
; let axiom = CoAxiom Unbranched -> CoAxBranch
coAxiomSingleBranch CoAxiom Unbranched
fi_ax
; reportInjectivityErrors dflags fi_ax axiom inj
}
| WhetherHasFamInst
otherwise
= () -> TcM ()
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
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
= WhetherHasFamInst -> SDoc -> TcM () -> TcM ()
forall a. HasCallStack => WhetherHasFamInst -> SDoc -> a -> a
assertPpr ((WhetherHasFamInst -> WhetherHasFamInst)
-> [WhetherHasFamInst] -> WhetherHasFamInst
forall (t :: * -> *) a.
Foldable t =>
(a -> WhetherHasFamInst) -> t a -> WhetherHasFamInst
any WhetherHasFamInst -> WhetherHasFamInst
forall a. a -> a
id [WhetherHasFamInst]
inj) (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"No injective type variables") (TcM () -> TcM ()) -> TcM () -> TcM ()
forall a b. (a -> b) -> a -> b
$
do let lhs :: [TcType]
lhs = CoAxBranch -> [TcType]
coAxBranchLHS CoAxBranch
axiom
rhs :: TcType
rhs = CoAxBranch -> TcType
coAxBranchRHS CoAxBranch
axiom
fam_tc :: TyCon
fam_tc = CoAxiom br -> TyCon
forall (br :: BranchFlag). CoAxiom br -> TyCon
coAxiomTyCon CoAxiom br
fi_ax
(TyVarSet
unused_inj_tvs, HasKinds
unused_vis, SuggestUndecidableInstances
undec_inst_flag)
= DynFlags
-> TyCon
-> [TcType]
-> TcType
-> (TyVarSet, HasKinds, SuggestUndecidableInstances)
unusedInjTvsInRHS DynFlags
dflags TyCon
fam_tc [TcType]
lhs TcType
rhs
inj_tvs_unused :: WhetherHasFamInst
inj_tvs_unused = WhetherHasFamInst -> WhetherHasFamInst
not (WhetherHasFamInst -> WhetherHasFamInst)
-> WhetherHasFamInst -> WhetherHasFamInst
forall a b. (a -> b) -> a -> b
$ TyVarSet -> WhetherHasFamInst
isEmptyVarSet TyVarSet
unused_inj_tvs
tf_headed :: WhetherHasFamInst
tf_headed = TcType -> WhetherHasFamInst
isTFHeaded TcType
rhs
bare_variables :: [TcType]
bare_variables = [TcType] -> TcType -> [TcType]
bareTvInRHSViolated [TcType]
lhs TcType
rhs
wrong_bare_rhs :: WhetherHasFamInst
wrong_bare_rhs = WhetherHasFamInst -> WhetherHasFamInst
not (WhetherHasFamInst -> WhetherHasFamInst)
-> WhetherHasFamInst -> WhetherHasFamInst
forall a b. (a -> b) -> a -> b
$ [TcType] -> WhetherHasFamInst
forall a. [a] -> WhetherHasFamInst
forall (t :: * -> *) a. Foldable t => t a -> WhetherHasFamInst
null [TcType]
bare_variables
WhetherHasFamInst -> TcM () -> TcM ()
forall (f :: * -> *).
Applicative f =>
WhetherHasFamInst -> f () -> f ()
when WhetherHasFamInst
inj_tvs_unused (TcM () -> TcM ()) -> TcM () -> TcM ()
forall a b. (a -> b) -> a -> b
$ TyCon
-> TyVarSet
-> HasKinds
-> SuggestUndecidableInstances
-> CoAxBranch
-> TcM ()
reportUnusedInjectiveVarsErr TyCon
fam_tc TyVarSet
unused_inj_tvs
HasKinds
unused_vis SuggestUndecidableInstances
undec_inst_flag CoAxBranch
axiom
WhetherHasFamInst -> TcM () -> TcM ()
forall (f :: * -> *).
Applicative f =>
WhetherHasFamInst -> f () -> f ()
when WhetherHasFamInst
tf_headed (TcM () -> TcM ()) -> TcM () -> TcM ()
forall a b. (a -> b) -> a -> b
$ TyCon -> CoAxBranch -> TcM ()
reportTfHeadedErr TyCon
fam_tc CoAxBranch
axiom
WhetherHasFamInst -> TcM () -> TcM ()
forall (f :: * -> *).
Applicative f =>
WhetherHasFamInst -> f () -> f ()
when WhetherHasFamInst
wrong_bare_rhs (TcM () -> TcM ()) -> TcM () -> TcM ()
forall a b. (a -> b) -> a -> b
$ TyCon -> [TcType] -> CoAxBranch -> TcM ()
reportBareVariableInRHSErr TyCon
fam_tc [TcType]
bare_variables CoAxBranch
axiom
isTFHeaded :: Type -> Bool
isTFHeaded :: TcType -> WhetherHasFamInst
isTFHeaded TcType
ty | Just TcType
ty' <- TcType -> Maybe TcType
coreView TcType
ty
= TcType -> WhetherHasFamInst
isTFHeaded TcType
ty'
isTFHeaded TcType
ty | (TyConApp TyCon
tc [TcType]
args) <- TcType
ty
, TyCon -> WhetherHasFamInst
isTypeFamilyTyCon TyCon
tc
= [TcType]
args [TcType] -> Int -> WhetherHasFamInst
forall a. [a] -> Int -> WhetherHasFamInst
`lengthIs` TyCon -> Int
tyConArity TyCon
tc
isTFHeaded TcType
_ = WhetherHasFamInst
False
bareTvInRHSViolated :: [Type] -> Type -> [Type]
bareTvInRHSViolated :: [TcType] -> TcType -> [TcType]
bareTvInRHSViolated [TcType]
pats TcType
rhs | TcType -> WhetherHasFamInst
isTyVarTy TcType
rhs
= (TcType -> WhetherHasFamInst) -> [TcType] -> [TcType]
forall a. (a -> WhetherHasFamInst) -> [a] -> [a]
filter (WhetherHasFamInst -> WhetherHasFamInst
not (WhetherHasFamInst -> WhetherHasFamInst)
-> (TcType -> WhetherHasFamInst) -> TcType -> WhetherHasFamInst
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TcType -> WhetherHasFamInst
isTyVarTy) [TcType]
pats
bareTvInRHSViolated [TcType]
_ TcType
_ = []
unusedInjTvsInRHS :: DynFlags
-> TyCon
-> [Type]
-> Type
-> ( TyVarSet
, HasKinds
, SuggestUndecidableInstances)
unusedInjTvsInRHS :: DynFlags
-> TyCon
-> [TcType]
-> TcType
-> (TyVarSet, HasKinds, SuggestUndecidableInstances)
unusedInjTvsInRHS DynFlags
dflags tycon :: TyCon
tycon@(TyCon -> Injectivity
tyConInjectivityInfo -> Injective [WhetherHasFamInst]
inj_list) [TcType]
lhs TcType
rhs =
(TyVarSet
bad_vars, WhetherHasFamInst -> HasKinds
hasKinds WhetherHasFamInst
any_invisible, WhetherHasFamInst -> SuggestUndecidableInstances
suggestUndecidableInstances WhetherHasFamInst
suggest_undec)
where
undec_inst :: WhetherHasFamInst
undec_inst = Extension -> DynFlags -> WhetherHasFamInst
xopt Extension
LangExt.UndecidableInstances DynFlags
dflags
inj_lhs :: [TcType]
inj_lhs = [WhetherHasFamInst] -> [TcType] -> [TcType]
forall a. [WhetherHasFamInst] -> [a] -> [a]
filterByList [WhetherHasFamInst]
inj_list [TcType]
lhs
lhs_vars :: TyVarSet
lhs_vars = [TcType] -> TyVarSet
tyCoVarsOfTypes [TcType]
inj_lhs
rhs_inj_vars :: TyVarSet
rhs_inj_vars = FV -> TyVarSet
fvVarSet (FV -> TyVarSet) -> FV -> TyVarSet
forall a b. (a -> b) -> a -> b
$ WhetherHasFamInst -> TcType -> FV
injectiveVarsOfType WhetherHasFamInst
undec_inst TcType
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 (WhetherHasFamInst -> WhetherHasFamInst)
-> WhetherHasFamInst -> WhetherHasFamInst
forall a b. (a -> b) -> a -> b
$ TyVarSet -> WhetherHasFamInst
isEmptyVarSet TyVarSet
bad_vars
invis_vars :: TyVarSet
invis_vars = FV -> TyVarSet
fvVarSet (FV -> TyVarSet) -> FV -> TyVarSet
forall a b. (a -> b) -> a -> b
$ [TcType] -> FV
invisibleVarsOfTypes [TyCon -> [TcType] -> TcType
mkTyConApp TyCon
tycon [TcType]
lhs, TcType
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 -> TcType -> FV
injectiveVarsOfType WhetherHasFamInst
True TcType
rhs))
unusedInjTvsInRHS DynFlags
_ TyCon
_ [TcType]
_ TcType
_ = (TyVarSet
emptyVarSet, HasKinds
NoHasKinds, SuggestUndecidableInstances
NoSuggestUndecidableInstaces)
reportConflictingInjectivityErrs :: TyCon -> [CoAxBranch] -> CoAxBranch -> TcM ()
reportConflictingInjectivityErrs :: TyCon -> [CoAxBranch] -> CoAxBranch -> TcM ()
reportConflictingInjectivityErrs TyCon
_ [] CoAxBranch
_ = () -> TcM ()
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
reportConflictingInjectivityErrs TyCon
fam_tc (CoAxBranch
confEqn1:[CoAxBranch]
_) CoAxBranch
tyfamEqn
= [(SrcSpan, TcRnMessage)] -> TcM ()
addErrs [(TyCon -> NonEmpty CoAxBranch -> TcRnMessage)
-> TyCon -> NonEmpty CoAxBranch -> (SrcSpan, TcRnMessage)
buildInjectivityError (InjectivityErrReason -> TyCon -> NonEmpty CoAxBranch -> TcRnMessage
TcRnFamInstNotInjective InjectivityErrReason
InjErrRhsOverlap)
TyCon
fam_tc
(CoAxBranch
confEqn1 CoAxBranch -> [CoAxBranch] -> NonEmpty CoAxBranch
forall a. a -> [a] -> NonEmpty a
:| [CoAxBranch
tyfamEqn])]
reportUnusedInjectiveVarsErr :: TyCon
-> TyVarSet
-> HasKinds
-> SuggestUndecidableInstances
-> CoAxBranch
-> TcM ()
reportUnusedInjectiveVarsErr :: TyCon
-> TyVarSet
-> HasKinds
-> SuggestUndecidableInstances
-> CoAxBranch
-> TcM ()
reportUnusedInjectiveVarsErr TyCon
fam_tc TyVarSet
tvs HasKinds
has_kinds SuggestUndecidableInstances
undec_inst CoAxBranch
tyfamEqn
= let reason :: InjectivityErrReason
reason = TyVarSet
-> HasKinds -> SuggestUndecidableInstances -> InjectivityErrReason
InjErrCannotInferFromRhs TyVarSet
tvs HasKinds
has_kinds SuggestUndecidableInstances
undec_inst
(SrcSpan
loc, TcRnMessage
dia) = (TyCon -> NonEmpty CoAxBranch -> TcRnMessage)
-> TyCon -> NonEmpty CoAxBranch -> (SrcSpan, TcRnMessage)
buildInjectivityError (InjectivityErrReason -> TyCon -> NonEmpty CoAxBranch -> TcRnMessage
TcRnFamInstNotInjective InjectivityErrReason
reason) TyCon
fam_tc (CoAxBranch
tyfamEqn CoAxBranch -> [CoAxBranch] -> NonEmpty CoAxBranch
forall a. a -> [a] -> NonEmpty a
:| [])
in SrcSpan -> TcRnMessage -> TcM ()
addErrAt SrcSpan
loc TcRnMessage
dia
reportTfHeadedErr :: TyCon -> CoAxBranch -> TcM ()
reportTfHeadedErr :: TyCon -> CoAxBranch -> TcM ()
reportTfHeadedErr TyCon
fam_tc CoAxBranch
branch
= [(SrcSpan, TcRnMessage)] -> TcM ()
addErrs [(TyCon -> NonEmpty CoAxBranch -> TcRnMessage)
-> TyCon -> NonEmpty CoAxBranch -> (SrcSpan, TcRnMessage)
buildInjectivityError (InjectivityErrReason -> TyCon -> NonEmpty CoAxBranch -> TcRnMessage
TcRnFamInstNotInjective InjectivityErrReason
InjErrRhsCannotBeATypeFam)
TyCon
fam_tc
(CoAxBranch
branch CoAxBranch -> [CoAxBranch] -> NonEmpty CoAxBranch
forall a. a -> [a] -> NonEmpty a
:| [])]
reportBareVariableInRHSErr :: TyCon -> [Type] -> CoAxBranch -> TcM ()
reportBareVariableInRHSErr :: TyCon -> [TcType] -> CoAxBranch -> TcM ()
reportBareVariableInRHSErr TyCon
fam_tc [TcType]
tys CoAxBranch
branch
= [(SrcSpan, TcRnMessage)] -> TcM ()
addErrs [(TyCon -> NonEmpty CoAxBranch -> TcRnMessage)
-> TyCon -> NonEmpty CoAxBranch -> (SrcSpan, TcRnMessage)
buildInjectivityError (InjectivityErrReason -> TyCon -> NonEmpty CoAxBranch -> TcRnMessage
TcRnFamInstNotInjective ([TcType] -> InjectivityErrReason
InjErrRhsBareTyVar [TcType]
tys))
TyCon
fam_tc
(CoAxBranch
branch CoAxBranch -> [CoAxBranch] -> NonEmpty CoAxBranch
forall a. a -> [a] -> NonEmpty a
:| [])]
buildInjectivityError :: (TyCon -> NonEmpty CoAxBranch -> TcRnMessage)
-> TyCon
-> NonEmpty CoAxBranch
-> (SrcSpan, TcRnMessage)
buildInjectivityError :: (TyCon -> NonEmpty CoAxBranch -> TcRnMessage)
-> TyCon -> NonEmpty CoAxBranch -> (SrcSpan, TcRnMessage)
buildInjectivityError TyCon -> NonEmpty CoAxBranch -> TcRnMessage
mkErr TyCon
fam_tc NonEmpty CoAxBranch
branches
= ( CoAxBranch -> SrcSpan
coAxBranchSpan (NonEmpty CoAxBranch -> CoAxBranch
forall a. NonEmpty a -> a
NE.head NonEmpty CoAxBranch
branches), TyCon -> NonEmpty CoAxBranch -> TcRnMessage
mkErr TyCon
fam_tc NonEmpty CoAxBranch
branches )
reportConflictInstErr :: FamInst -> [FamInst] -> TcRn ()
reportConflictInstErr :: FamInst -> [FamInst] -> TcM ()
reportConflictInstErr FamInst
_ []
= () -> TcM ()
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
reportConflictInstErr FamInst
fam_inst (FamInst
conf_inst : [FamInst]
_) =
let sorted :: NonEmpty FamInst
sorted = (FamInst -> FamInst -> Ordering)
-> NonEmpty FamInst -> NonEmpty FamInst
forall a. (a -> a -> Ordering) -> NonEmpty a -> NonEmpty a
NE.sortBy (SrcSpan -> SrcSpan -> Ordering
SrcLoc.leftmost_smallest (SrcSpan -> SrcSpan -> Ordering)
-> (FamInst -> SrcSpan) -> FamInst -> FamInst -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` FamInst -> SrcSpan
getSpan) (FamInst
fam_inst FamInst -> [FamInst] -> NonEmpty FamInst
forall a. a -> [a] -> NonEmpty a
NE.:| [FamInst
conf_inst])
fi1 :: FamInst
fi1 = NonEmpty FamInst -> FamInst
forall a. NonEmpty a -> a
NE.head NonEmpty FamInst
sorted
span :: SrcSpan
span = CoAxBranch -> SrcSpan
coAxBranchSpan (CoAxiom Unbranched -> CoAxBranch
coAxiomSingleBranch (FamInst -> CoAxiom Unbranched
famInstAxiom FamInst
fi1))
getSpan :: FamInst -> SrcSpan
getSpan = CoAxiom Unbranched -> SrcSpan
forall a. NamedThing a => a -> SrcSpan
getSrcSpan (CoAxiom Unbranched -> SrcSpan)
-> (FamInst -> CoAxiom Unbranched) -> FamInst -> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FamInst -> CoAxiom Unbranched
famInstAxiom
in SrcSpan -> TcM () -> TcM ()
forall a. SrcSpan -> TcRn a -> TcRn a
setSrcSpan SrcSpan
span (TcM () -> TcM ()) -> TcM () -> TcM ()
forall a b. (a -> b) -> a -> b
$ TcRnMessage -> TcM ()
addErr (TcRnMessage -> TcM ()) -> TcRnMessage -> TcM ()
forall a b. (a -> b) -> a -> b
$ NonEmpty FamInst -> TcRnMessage
TcRnConflictingFamInstDecls NonEmpty FamInst
sorted
tcGetFamInstEnvs :: TcM FamInstEnvs
tcGetFamInstEnvs :: TcM (FamInstEnv, FamInstEnv)
tcGetFamInstEnvs
= do { eps <- TcRnIf TcGblEnv TcLclEnv ExternalPackageState
forall gbl lcl. TcRnIf gbl lcl ExternalPackageState
getEps; env <- getGblEnv
; return (eps_fam_inst_env eps, tcg_fam_inst_env env) }