From 601e8739f2af25f946a8a1b4273172b491c5bced Mon Sep 17 00:00:00 2001 From: Manuel M T Chakravarty Date: Thu, 7 Dec 2006 01:41:18 +0000 Subject: [PATCH] Fix family instance consistency check for home package modules * So far, family instance modules was only available for external modules. * This fixes the "Over" test in the testsuite under indexed-types/ --- compiler/typecheck/FamInst.lhs | 14 ++++++++++++-- compiler/typecheck/TcRnDriver.lhs | 1 + 2 files changed, 13 insertions(+), 2 deletions(-) diff --git a/compiler/typecheck/FamInst.lhs b/compiler/typecheck/FamInst.lhs index 9c5b597..9a34943 100644 --- a/compiler/typecheck/FamInst.lhs +++ b/compiler/typecheck/FamInst.lhs @@ -18,6 +18,7 @@ import Name import Module import SrcLoc import Outputable +import UniqFM import FiniteMap import Maybe @@ -78,7 +79,14 @@ checkFamInstConsistency famInstMods directlyImpMods Nothing -> panic "FamInst.checkFamInstConsistency" Just iface -> iface - ; modInstsEnv = eps_mod_fam_inst_env eps + ; 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 @@ -95,7 +103,9 @@ checkFamInstConsistency famInstMods directlyImpMods allPairs [] = [] allPairs (m:ms) = map (ModulePair m) ms ++ allPairs ms - -- Check the consistency of the family instances of the two modules. + -- 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 diff --git a/compiler/typecheck/TcRnDriver.lhs b/compiler/typecheck/TcRnDriver.lhs index f20de55..88dfe81 100644 --- a/compiler/typecheck/TcRnDriver.lhs +++ b/compiler/typecheck/TcRnDriver.lhs @@ -173,6 +173,7 @@ tcRnModule hsc_env hsc_src save_rn_syntax loadOrphanModules (imp_orphs imports) False ; loadOrphanModules (imp_finsts imports) True ; + traceRn (text "rn1: checking family instance consistency") ; let { directlyImpMods = map (\(mod, _, _) -> mod) . moduleEnvElts . imp_mods -- 1.7.10.4