Commit 74da1264 authored by chak@cse.unsw.edu.au.'s avatar chak@cse.unsw.edu.au.
Browse files

Extend hptInstances to also cover family instances

parent 7fa861d2
...@@ -286,16 +286,19 @@ lookupIfaceByModule dflags hpt pit mod ...@@ -286,16 +286,19 @@ lookupIfaceByModule dflags hpt pit mod
\begin{code} \begin{code}
hptInstances :: HscEnv -> (ModuleName -> Bool) -> [Instance] hptInstances :: HscEnv -> (ModuleName -> Bool) -> ([Instance], [FamInst])
-- Find all the instance declarations that are in modules imported -- Find all the instance declarations (of classes and families) that are in
-- by this one, directly or indirectly, and are in the Home Package Table -- modules imported by this one, directly or indirectly, and are in the Home
-- This ensures that we don't see instances from modules --make compiled -- Package Table. This ensures that we don't see instances from modules --make
-- before this one, but which are not below this one -- compiled before this one, but which are not below this one.
hptInstances hsc_env want_this_module hptInstances hsc_env want_this_module
= [ ispec = let (insts, famInsts) = unzip
| mod_info <- eltsUFM (hsc_HPT hsc_env) [ (md_insts details, md_fam_insts details)
, want_this_module (moduleName (mi_module (hm_iface mod_info))) | mod_info <- eltsUFM (hsc_HPT hsc_env)
, ispec <- md_insts (hm_details mod_info) ] , 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] hptRules :: HscEnv -> [(ModuleName, IsBootInterface)] -> [CoreRule]
-- Get rules from modules "below" this one (in the dependency sense) -- Get rules from modules "below" this one (in the dependency sense)
......
...@@ -210,7 +210,8 @@ tcRnImports hsc_env this_mod import_decls ...@@ -210,7 +210,8 @@ tcRnImports hsc_env this_mod import_decls
; want_instances :: ModuleName -> Bool ; want_instances :: ModuleName -> Bool
; want_instances mod = mod `elemUFM` dep_mods ; want_instances mod = mod `elemUFM` dep_mods
&& mod /= moduleName this_mod && 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 -- Record boot-file info in the EPS, so that it's
...@@ -220,11 +221,14 @@ tcRnImports hsc_env this_mod import_decls ...@@ -220,11 +221,14 @@ tcRnImports hsc_env this_mod import_decls
-- Update the gbl env -- Update the gbl env
; updGblEnv ( \ gbl -> ; updGblEnv ( \ gbl ->
gbl { tcg_rdr_env = plusOccEnv (tcg_rdr_env gbl) rdr_env, gbl {
tcg_imports = tcg_imports gbl `plusImportAvails` imports, tcg_rdr_env = plusOccEnv (tcg_rdr_env gbl) rdr_env,
tcg_rn_imports = fmap (const rn_imports) (tcg_rn_imports gbl), tcg_imports = tcg_imports gbl `plusImportAvails` imports,
tcg_inst_env = extendInstEnvList (tcg_inst_env gbl) home_insts tcg_rn_imports = fmap (const rn_imports) (tcg_rn_imports gbl),
}) $ do { 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)) ; traceRn (text "rn1" <+> ppr (imp_dep_mods imports))
-- Fail if there are any errors so far -- Fail if there are any errors so far
...@@ -826,7 +830,7 @@ setInteractiveContext hsc_env icxt thing_inside ...@@ -826,7 +830,7 @@ setInteractiveContext hsc_env icxt thing_inside
-- Initialise the tcg_inst_env with instances -- Initialise the tcg_inst_env with instances
-- from all home modules. This mimics the more selective -- from all home modules. This mimics the more selective
-- call to hptInstances in tcRnModule -- call to hptInstances in tcRnModule
dfuns = hptInstances hsc_env (\mod -> True) dfuns = fst (hptInstances hsc_env (\mod -> True))
in in
updGblEnv (\env -> env { updGblEnv (\env -> env {
tcg_rdr_env = ic_rn_gbl_env icxt, tcg_rdr_env = ic_rn_gbl_env icxt,
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment