X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fiface%2FIfaceEnv.lhs;h=ab1f9057e2ddbfa3d1bf0e083af1c8eddeaaf8c0;hb=48b625149fdcf14a91422d4dfdb44d096dde5bb0;hp=ecfd2bc5bc03efed3c07c8acec33c84c25a893ab;hpb=fbb4683ec21a94a9614191db5d1bf458b489b6c7;p=ghc-hetmet.git diff --git a/compiler/iface/IfaceEnv.lhs b/compiler/iface/IfaceEnv.lhs index ecfd2bc..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 @@ -193,7 +200,8 @@ newIPName occ_name_ip = do \begin{code} lookupOrigNameCache :: OrigNameCache -> Module -> OccName -> Maybe Name lookupOrigNameCache _ mod occ - | mod == dATA_TUP || mod == gHC_PRIM, -- Boxed tuples from one, + -- XXX Why is gHC_UNIT not mentioned here? + | mod == gHC_TUPLE || mod == gHC_PRIM, -- Boxed tuples from one, Just tup_info <- isTupleOcc_maybe occ -- unboxed from the other = -- Special case for tuples; there are too many -- of them to pre-populate the original-name cache @@ -211,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 @@ -273,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