From 74da1264ba27c992e331b821c27b5d048c8d33cb Mon Sep 17 00:00:00 2001 From: Manuel M T Chakravarty Date: Sun, 6 May 2007 07:59:59 +0000 Subject: [PATCH] Extend hptInstances to also cover family instances --- compiler/main/HscTypes.lhs | 21 ++++++++++++--------- compiler/typecheck/TcRnDriver.lhs | 18 +++++++++++------- 2 files changed, 23 insertions(+), 16 deletions(-) diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs index 4797770..eeea9d9 100644 --- a/compiler/main/HscTypes.lhs +++ b/compiler/main/HscTypes.lhs @@ -286,16 +286,19 @@ lookupIfaceByModule dflags hpt pit mod \begin{code} -hptInstances :: HscEnv -> (ModuleName -> Bool) -> [Instance] --- Find all the instance declarations that are in modules imported --- by this one, directly or indirectly, and are in the Home Package Table --- This ensures that we don't see instances from modules --make compiled --- before this one, but which are not below this one +hptInstances :: HscEnv -> (ModuleName -> Bool) -> ([Instance], [FamInst]) +-- Find all the instance declarations (of classes and families) that are in +-- modules imported by this one, directly or indirectly, and are in the Home +-- Package Table. This ensures that we don't see instances from modules --make +-- compiled before this one, but which are not below this one. hptInstances hsc_env want_this_module - = [ ispec - | mod_info <- eltsUFM (hsc_HPT hsc_env) - , want_this_module (moduleName (mi_module (hm_iface mod_info))) - , ispec <- md_insts (hm_details mod_info) ] + = let (insts, famInsts) = unzip + [ (md_insts details, md_fam_insts details) + | mod_info <- eltsUFM (hsc_HPT hsc_env) + , want_this_module (moduleName (mi_module (hm_iface mod_info))) + , let details = hm_details mod_info ] + in + (concat insts, concat famInsts) hptRules :: HscEnv -> [(ModuleName, IsBootInterface)] -> [CoreRule] -- Get rules from modules "below" this one (in the dependency sense) diff --git a/compiler/typecheck/TcRnDriver.lhs b/compiler/typecheck/TcRnDriver.lhs index ce98772..6c55a62 100644 --- a/compiler/typecheck/TcRnDriver.lhs +++ b/compiler/typecheck/TcRnDriver.lhs @@ -210,7 +210,8 @@ tcRnImports hsc_env this_mod import_decls ; want_instances :: ModuleName -> Bool ; want_instances mod = mod `elemUFM` dep_mods && mod /= moduleName this_mod - ; home_insts = hptInstances hsc_env want_instances + ; (home_insts, home_fam_insts) = hptInstances hsc_env + want_instances } ; -- Record boot-file info in the EPS, so that it's @@ -220,11 +221,14 @@ tcRnImports hsc_env this_mod import_decls -- Update the gbl env ; updGblEnv ( \ gbl -> - gbl { tcg_rdr_env = plusOccEnv (tcg_rdr_env gbl) rdr_env, - tcg_imports = tcg_imports gbl `plusImportAvails` imports, - tcg_rn_imports = fmap (const rn_imports) (tcg_rn_imports gbl), - tcg_inst_env = extendInstEnvList (tcg_inst_env gbl) home_insts - }) $ do { + gbl { + tcg_rdr_env = plusOccEnv (tcg_rdr_env gbl) rdr_env, + tcg_imports = tcg_imports gbl `plusImportAvails` imports, + tcg_rn_imports = fmap (const rn_imports) (tcg_rn_imports gbl), + tcg_inst_env = extendInstEnvList (tcg_inst_env gbl) home_insts, + tcg_fam_inst_env = extendFamInstEnvList (tcg_fam_inst_env gbl) + home_fam_insts + }) $ do { ; traceRn (text "rn1" <+> ppr (imp_dep_mods imports)) -- Fail if there are any errors so far @@ -826,7 +830,7 @@ setInteractiveContext hsc_env icxt thing_inside -- Initialise the tcg_inst_env with instances -- from all home modules. This mimics the more selective -- call to hptInstances in tcRnModule - dfuns = hptInstances hsc_env (\mod -> True) + dfuns = fst (hptInstances hsc_env (\mod -> True)) in updGblEnv (\env -> env { tcg_rdr_env = ic_rn_gbl_env icxt, -- 1.7.10.4