X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fiface%2FIfaceEnv.lhs;h=ab1f9057e2ddbfa3d1bf0e083af1c8eddeaaf8c0;hb=25ea332f16464c3f9b0f45bd37cfd418dde5fe92;hp=5dcab1e73ee9e093a2a3a0a1af42e27be462b688;hpb=7a7cb61b0de4a82d959fa3e8f2a3befba21ac0f8;p=ghc-hetmet.git diff --git a/compiler/iface/IfaceEnv.lhs b/compiler/iface/IfaceEnv.lhs index 5dcab1e..ab1f905 100644 --- a/compiler/iface/IfaceEnv.lhs +++ b/compiler/iface/IfaceEnv.lhs @@ -7,7 +7,7 @@ module IfaceEnv ( lookupOrig, lookupOrigNameCache, extendNameCache, newIfaceName, newIfaceNames, extendIfaceIdEnv, extendIfaceTyVarEnv, - tcIfaceLclId, tcIfaceTyVar, + tcIfaceLclId, tcIfaceTyVar, lookupIfaceTyVar, tcIfaceTick, ifaceExportNames, @@ -114,9 +114,16 @@ newImplicitBinder :: Name -- Base name -- For source type/class decls, this is the first occurrence -- For iface ones, the LoadIface has alrady allocated a suitable name in the cache newImplicitBinder base_name mk_sys_occ - = newGlobalBinder (nameModule base_name) - (mk_sys_occ (nameOccName base_name)) - (nameSrcSpan base_name) + | Just mod <- nameModule_maybe base_name + = newGlobalBinder mod occ loc + | otherwise -- When typechecking a [d| decl bracket |], + -- TH generates types, classes etc with Internal names, + -- so we follow suit for the implicit binders + = do { uniq <- newUnique + ; return (mkInternalName uniq occ loc) } + where + occ = mk_sys_occ (nameOccName base_name) + loc = nameSrcSpan base_name ifaceExportNames :: [IfaceExport] -> TcRnIf gbl lcl [AvailInfo] ifaceExportNames exports = do @@ -212,7 +219,8 @@ lookupOrigNameCache nc mod occ -- The normal case extendOrigNameCache :: OrigNameCache -> Name -> OrigNameCache extendOrigNameCache nc name - = extendNameCache nc (nameModule name) (nameOccName name) name + = ASSERT2( isExternalName name, ppr name ) + extendNameCache nc (nameModule name) (nameOccName name) name extendNameCache :: OrigNameCache -> Module -> OccName -> Name -> OrigNameCache extendNameCache nc mod occ name @@ -274,6 +282,11 @@ tcIfaceTyVar occ Nothing -> failIfM (text "Iface type variable out of scope: " <+> ppr occ) } +lookupIfaceTyVar :: FastString -> IfL (Maybe TyVar) +lookupIfaceTyVar occ + = do { lcl <- getLclEnv + ; return (lookupUFM (if_tv_env lcl) occ) } + extendIfaceTyVarEnv :: [TyVar] -> IfL a -> IfL a extendIfaceTyVarEnv tyvars thing_inside = do { env <- getLclEnv