X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcRnDriver.lhs;h=6dfae4447869900e01153d26e25065d802d4a573;hp=c41367e8905b108b47923226e9d0c6dc9a38653a;hb=5ad61e1470db6dbc8279569c5ad1cc093f753ac0;hpb=311b1cdfc9b1c311cc53482c461c18cba8885b2a diff --git a/compiler/typecheck/TcRnDriver.lhs b/compiler/typecheck/TcRnDriver.lhs index c41367e..6dfae44 100644 --- a/compiler/typecheck/TcRnDriver.lhs +++ b/compiler/typecheck/TcRnDriver.lhs @@ -482,7 +482,7 @@ checkHiBootIface :: TcGblEnv -> ModDetails -> TcM (LHsBinds Id) checkHiBootIface (TcGblEnv { tcg_insts = local_insts, tcg_fam_insts = local_fam_insts, - tcg_type_env = local_type_env, tcg_imports = imports }) + tcg_type_env = local_type_env }) (ModDetails { md_insts = boot_insts, md_fam_insts = boot_fam_insts, md_types = boot_type_env }) = do { traceTc (text "checkHiBootIface" <+> (ppr boot_type_env $$ ppr boot_insts)) ; @@ -497,8 +497,11 @@ checkHiBootIface ; return (unionManyBags dfun_binds) } where check_one boot_thing - | no_check name - = return () + | isImplicitTyThing boot_thing = return () + | name `elem` dfun_names = return () + | isWiredInName name = return () -- No checking for wired-in names. In particular, + -- 'error' is handled by a rather gross hack + -- (see comments in GHC.Err.hs-boot) | Just real_thing <- lookupTypeEnv local_type_env name = do { let boot_decl = tyThingToIfaceDecl boot_thing real_decl = tyThingToIfaceDecl real_thing @@ -511,17 +514,6 @@ checkHiBootIface where name = getName boot_thing - avail_env = imp_parent imports - is_implicit name = case lookupNameEnv avail_env name of - Just (AvailTC tc _) | tc /= name -> True - _otherwise -> False - - no_check name = isWiredInName name -- No checking for wired-in names. In particular, - -- 'error' is handled by a rather gross hack - -- (see comments in GHC.Err.hs-boot) - || name `elem` dfun_names - || is_implicit name -- Has a parent, which we'll check - dfun_names = map getName boot_insts check_inst boot_inst