X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcRnDriver.lhs;h=6850846950419426b1013b8ba204d5809691240e;hp=2542ad3b3d35e7b305d257a8de8f4e4601c48893;hb=HEAD;hpb=d7fb8d371d3228774331a67db8da805b2d68f1c4 diff --git a/compiler/typecheck/TcRnDriver.lhs b/compiler/typecheck/TcRnDriver.lhs index 2542ad3..6850846 100644 --- a/compiler/typecheck/TcRnDriver.lhs +++ b/compiler/typecheck/TcRnDriver.lhs @@ -245,9 +245,8 @@ tcRnImports hsc_env this_mod import_decls -- interfaces, so that their rules and instance decls will be -- found. ; loadOrphanModules (imp_orphs imports) False - ; loadOrphanModules (imp_finsts imports) True - -- Check type-familily consistency + -- Check type-family consistency ; traceRn (text "rn1: checking family instance consistency") ; let { dir_imp_mods = moduleEnvKeys . imp_mods @@ -299,7 +298,7 @@ tcRnExtCore hsc_env (HsExtCore this_mod decls src_binds) -- any mutually recursive types are done right -- Just discard the auxiliary bindings; they are generated -- only for Haskell source code, and should already be in Core - (tcg_env, _aux_binds, _dm_ids, _) <- tcTyAndClassDecls emptyModDetails rn_decls ; + (tcg_env, _aux_binds) <- tcTyAndClassDecls emptyModDetails rn_decls ; setGblEnv tcg_env $ do { -- Make the new type env available to stuff slurped from interface files @@ -500,10 +499,9 @@ tcRnHsBootDecls decls -- Typecheck type/class decls ; traceTc "Tc2" empty - ; (tcg_env, aux_binds, dm_ids, _) + ; (tcg_env, aux_binds) <- tcTyAndClassDecls emptyModDetails tycl_decls - ; setGblEnv tcg_env $ - tcExtendIdEnv dm_ids $ do { + ; setGblEnv tcg_env $ do { -- Typecheck instance decls -- Family instance declarations are rejected here @@ -837,11 +835,10 @@ tcTopSrcDecls boot_details -- The latter come in via tycl_decls traceTc "Tc2" empty ; - (tcg_env, aux_binds, dm_ids, kc_decls) <- tcTyAndClassDecls boot_details tycl_decls ; + (tcg_env, aux_binds) <- tcTyAndClassDecls boot_details tycl_decls ; -- If there are any errors, tcTyAndClassDecls fails here - setGblEnv tcg_env $ - tcExtendIdEnv dm_ids $ do { + setGblEnv tcg_env $ do { -- Source-language instances, including derivings, -- and import the supporting declarations @@ -877,7 +874,7 @@ tcTopSrcDecls boot_details -- Second pass over class and instance declarations, -- now using the kind-checked decls traceTc "Tc6" empty ; - inst_binds <- tcInstDecls2 kc_decls inst_infos ; + inst_binds <- tcInstDecls2 (concat tycl_decls) inst_infos ; -- Foreign exports traceTc "Tc7" empty ; @@ -1369,29 +1366,20 @@ tcRnType hsc_env ictxt rdr_type -- could not be found. getModuleExports :: HscEnv -> Module -> IO (Messages, Maybe [AvailInfo]) getModuleExports hsc_env mod - = let - ic = hsc_IC hsc_env - checkMods = ic_toplev_scope ic ++ map fst (ic_exports ic) - in - initTc hsc_env HsSrcFile False iNTERACTIVE (tcGetModuleExports mod checkMods) + = initTc hsc_env HsSrcFile False iNTERACTIVE (tcGetModuleExports mod) -- Get the export avail info and also load all orphan and family-instance -- modules. Finally, check that the family instances of all modules in the -- interactive context are consistent (these modules are in the second -- argument). -tcGetModuleExports :: Module -> [Module] -> TcM [AvailInfo] -tcGetModuleExports mod directlyImpMods +tcGetModuleExports :: Module -> TcM [AvailInfo] +tcGetModuleExports mod = do { let doc = ptext (sLit "context for compiling statements") ; iface <- initIfaceTcRn $ loadSysInterface doc mod -- Load any orphan-module and family instance-module -- interfaces, so their instances are visible. ; loadOrphanModules (dep_orphs (mi_deps iface)) False - ; loadOrphanModules (dep_finsts (mi_deps iface)) True - - -- Check that the family instances of all directly loaded - -- modules are consistent. - ; checkFamInstConsistency (dep_finsts (mi_deps iface)) directlyImpMods ; ifaceExportNames (mi_exports iface) }