lookupIfaceTop, lookupIfaceExt,
lookupOrig, lookupIfaceTc,
newIfaceName, newIfaceNames,
- extendIfaceIdEnv, extendIfaceTyVarEnv, refineIfaceIdEnv,
+ extendIfaceIdEnv, extendIfaceTyVarEnv,
tcIfaceLclId, tcIfaceTyVar,
lookupAvail, ifaceExportNames,
import TysWiredIn ( tupleTyCon, tupleCon )
import HscTypes ( NameCache(..), HscEnv(..), GenAvailInfo(..),
IfaceExport, OrigNameCache )
-import Type ( mkOpenTvSubst, substTy )
import TyCon ( TyCon, tyConName )
-import Unify ( TypeRefinement )
import DataCon ( dataConWorkId, dataConName )
-import Var ( TyVar, Id, varName, setIdType, idType )
+import Var ( TyVar, Id, varName )
import Name ( Name, nameUnique, nameModule,
nameOccName, nameSrcLoc,
getOccName, nameParent_maybe,
isWiredInName, mkIPName,
mkExternalName, mkInternalName )
import NameSet ( NameSet, emptyNameSet, addListToNameSet )
-import OccName ( OccName, isTupleOcc_maybe, tcName, dataName, mapOccEnv, occNameFS,
- lookupOccEnv, unitOccEnv, extendOccEnv, extendOccEnvList )
-import PrelNames ( gHC_PRIM, pREL_TUP )
-import Module ( Module, emptyModuleEnv,
- lookupModuleEnv, extendModuleEnv_C )
+import OccName ( OccName, isTupleOcc_maybe, tcName, dataName, occNameFS,
+ lookupOccEnv, unitOccEnv, extendOccEnv )
+import PrelNames ( gHC_PRIM, dATA_TUP )
+import Module ( Module, emptyModuleEnv, ModuleName, modulePackageId,
+ lookupModuleEnv, extendModuleEnv_C, mkModule )
import UniqFM ( lookupUFM, addListToUFM )
import FastString ( FastString )
import UniqSupply ( UniqSupply, splitUniqSupply, uniqFromSupply, uniqsFromSupply )
\begin{code}
lookupOrigNameCache :: OrigNameCache -> Module -> OccName -> Maybe Name
lookupOrigNameCache nc mod occ
- | mod == pREL_TUP || mod == gHC_PRIM, -- Boxed tuples from one,
+ | mod == dATA_TUP || 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
Nothing -> failIfM (text "Iface id out of scope: " <+> ppr occ)
}
-refineIfaceIdEnv :: TypeRefinement -> IfL a -> IfL a
-refineIfaceIdEnv (tv_subst, _) thing_inside
- = do { env <- getLclEnv
- ; let { id_env' = mapOccEnv refine_id (if_id_env env)
- ; refine_id id = setIdType id (substTy subst (idType id))
- ; subst = mkOpenTvSubst tv_subst }
- ; setLclEnv (env { if_id_env = id_env' }) thing_inside }
-
extendIfaceIdEnv :: [Id] -> IfL a -> IfL a
extendIfaceIdEnv ids thing_inside
= do { env <- getLclEnv
lookupIfaceExt :: IfaceExtName -> IfL Name
lookupIfaceExt (ExtPkg mod occ) = lookupOrig mod occ
-lookupIfaceExt (HomePkg mod occ _) = lookupOrig mod occ
+lookupIfaceExt (HomePkg mod occ _) = lookupHomePackage mod occ
lookupIfaceExt (LocalTop occ) = lookupIfaceTop occ
lookupIfaceExt (LocalTopSub occ _) = lookupIfaceTop occ
lookupIfaceTop occ
= do { env <- getLclEnv; lookupOrig (if_mod env) occ }
+lookupHomePackage :: ModuleName -> OccName -> IfL Name
+lookupHomePackage mod_name occ
+ = do { env <- getLclEnv;
+ ; let this_pkg = modulePackageId (if_mod env)
+ ; lookupOrig (mkModule this_pkg mod_name) occ }
+
newIfaceName :: OccName -> IfL Name
newIfaceName occ
= do { uniq <- newUnique
- ; return (mkInternalName uniq occ noSrcLoc) }
+ ; return $! mkInternalName uniq occ noSrcLoc }
newIfaceNames :: [OccName] -> IfL [Name]
newIfaceNames occs