Skip to content
Snippets Groups Projects
Commit 5188e4e5 authored by Simon Peyton Jones's avatar Simon Peyton Jones
Browse files

Do not be so eager about loading family-instance modules

when doing the overlap check.  We only need to load the
ones for modules whose family instances we need to compare!

This means that programs that don't use type families are
not penalised, which is important.
parent 8f212ab5
No related merge requests found
...@@ -7,6 +7,7 @@ module FamInst ( ...@@ -7,6 +7,7 @@ module FamInst (
import HscTypes import HscTypes
import FamInstEnv import FamInstEnv
import LoadIface
import TcMType import TcMType
import TcRnMonad import TcRnMonad
import TyCon import TyCon
...@@ -82,20 +83,17 @@ checkFamInstConsistency famInstMods directlyImpMods ...@@ -82,20 +83,17 @@ checkFamInstConsistency famInstMods directlyImpMods
; (eps, hpt) <- getEpsAndHpt ; (eps, hpt) <- getEpsAndHpt
; let { -- Fetch the iface of a given module. Must succeed as ; let { -- Fetch the iface of a given module. Must succeed as
-- all imported modules must already have been loaded. -- all directly imported modules must already have been loaded.
modIface mod = modIface mod =
case lookupIfaceByModule dflags hpt (eps_PIT eps) mod of case lookupIfaceByModule dflags hpt (eps_PIT eps) mod of
Nothing -> panic "FamInst.checkFamInstConsistency" Nothing -> panic "FamInst.checkFamInstConsistency"
Just iface -> iface Just iface -> iface
; hmiModule = mi_module . hm_iface ; hmiModule = mi_module . hm_iface
; hmiFamInstEnv = mkFamInstEnv . md_fam_insts . hm_details ; hmiFamInstEnv = extendFamInstEnvList emptyFamInstEnv
; mkFamInstEnv = extendFamInstEnvList emptyFamInstEnv . md_fam_insts . hm_details
; hptModInsts = [ (hmiModule hmi, hmiFamInstEnv hmi) ; hpt_fam_insts = mkModuleEnv [ (hmiModule hmi, hmiFamInstEnv hmi)
| hmi <- eltsUFM hpt] | 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) ; groups = map (dep_finsts . mi_deps . modIface)
directlyImpMods directlyImpMods
; okPairs = listToSet $ concatMap allPairs groups ; okPairs = listToSet $ concatMap allPairs groups
...@@ -106,22 +104,27 @@ checkFamInstConsistency famInstMods directlyImpMods ...@@ -106,22 +104,27 @@ checkFamInstConsistency famInstMods directlyImpMods
-- the difference gives us the pairs we need to check now -- the difference gives us the pairs we need to check now
} }
; mapM_ (check modInstsEnv) toCheckPairs ; mapM_ (check hpt_fam_insts) toCheckPairs
} }
where where
allPairs [] = [] allPairs [] = []
allPairs (m:ms) = map (ModulePair m) ms ++ allPairs ms allPairs (m:ms) = map (ModulePair m) ms ++ allPairs ms
-- The modules are guaranteed to be in the environment, as they are either check hpt_fam_insts (ModulePair m1 m2)
-- already loaded in the EPS or they are in the HPT. = do { env1 <- getFamInsts hpt_fam_insts m1
-- ; env2 <- getFamInsts hpt_fam_insts m2
check modInstsEnv (ModulePair m1 m2) ; mapM_ (checkForConflicts (emptyFamInstEnv, env2))
= let { instEnv1 = (expectJust "checkFamInstConsistency") . lookupModuleEnv modInstsEnv $ m1 (famInstEnvElts env1) }
; instEnv2 = (expectJust "checkFamInstConsistency") . lookupModuleEnv modInstsEnv $ m2
; insts1 = famInstEnvElts instEnv1 getFamInsts :: ModuleEnv FamInstEnv -> Module -> TcM FamInstEnv
} getFamInsts hpt_fam_insts mod
in | Just env <- lookupModuleEnv hpt_fam_insts mod = return env
mapM_ (checkForConflicts (emptyFamInstEnv, instEnv2)) insts1 | otherwise = do { _ <- initIfaceTcRn (loadSysInterface doc mod)
; eps <- getEps
; return (expectJust "checkFamInstConsistency" $
lookupModuleEnv (eps_mod_fam_inst_env eps) mod) }
where
doc = ppr mod <+> ptext (sLit "is a family-instance module")
\end{code} \end{code}
%************************************************************************ %************************************************************************
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment