+ ; let { -- Fetch the iface of a given module. Must succeed as
+ -- all imported modules must already have been loaded.
+ modIface mod =
+ case lookupIfaceByModule dflags hpt (eps_PIT eps) mod of
+ Nothing -> panic "FamInst.checkFamInstConsistency"
+ Just iface -> iface
+
+ ; hmiModule = mi_module . hm_iface
+ ; hmiFamInstEnv = mkFamInstEnv . md_fam_insts . hm_details
+ ; mkFamInstEnv = extendFamInstEnvList emptyFamInstEnv
+ ; hptModInsts = [ (hmiModule hmi, hmiFamInstEnv hmi)
+ | hmi <- eltsUFM hpt]
+ ; modInstsEnv = eps_mod_fam_inst_env eps -- external modules
+ `extendModuleEnvList` -- plus
+ hptModInsts -- home package modules
+ ; groups = map (dep_finsts . mi_deps . modIface)
+ directlyImpMods
+ ; okPairs = listToSet $ concatMap allPairs groups
+ -- instances of okPairs are consistent
+ ; criticalPairs = listToSet $ allPairs famInstMods
+ -- all pairs that we need to consider
+ ; toCheckPairs = keysFM $ criticalPairs `minusFM` okPairs
+ -- the difference gives us the pairs we need to check now
+ }
+
+ ; mapM_ (check modInstsEnv) toCheckPairs
+ }
+ where
+ allPairs [] = []
+ allPairs (m:ms) = map (ModulePair m) ms ++ allPairs ms
+
+ -- The modules are guaranteed to be in the environment, as they are either
+ -- already loaded in the EPS or they are in the HPT.
+ --
+ check modInstsEnv (ModulePair m1 m2)
+ = let { instEnv1 = fromJust . lookupModuleEnv modInstsEnv $ m1
+ ; instEnv2 = fromJust . lookupModuleEnv modInstsEnv $ m2
+ ; insts1 = famInstEnvElts instEnv1
+ }
+ in
+ mapM_ (checkForConflicts (emptyFamInstEnv, instEnv2)) insts1
+\end{code}
+
+%************************************************************************
+%* *
+ Extending the family instance environment
+%* *
+%************************************************************************
+
+\begin{code}