X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fiface%2FIfaceEnv.lhs;h=cea950873f89f0248daa80147bd4a3801020ed58;hb=17434e5beb213f1e8971d1ce8ffbf40a0848bb3a;hp=c7e78b3d4552932e5bd37142c78b8075b057d762;hpb=ff911658b60a6efd6000b33cfa922b79511ee719;p=ghc-hetmet.git

diff --git a/compiler/iface/IfaceEnv.lhs b/compiler/iface/IfaceEnv.lhs
index c7e78b3..cea9508 100644
--- a/compiler/iface/IfaceEnv.lhs
+++ b/compiler/iface/IfaceEnv.lhs
@@ -6,7 +6,7 @@ module IfaceEnv (
 	lookupIfaceTop, lookupIfaceExt,
 	lookupOrig, lookupIfaceTc,
 	newIfaceName, newIfaceNames,
-	extendIfaceIdEnv, extendIfaceTyVarEnv, refineIfaceIdEnv,
+	extendIfaceIdEnv, extendIfaceTyVarEnv, 
 	tcIfaceLclId,     tcIfaceTyVar, 
 
 	lookupAvail, ifaceExportNames,
@@ -24,7 +24,6 @@ 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 Name		( Name, nameUnique, nameModule, 
@@ -35,9 +34,9 @@ import Name		( Name, nameUnique, nameModule,
 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 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 )
@@ -230,7 +229,7 @@ newIPName occ_name_ip
 \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
@@ -294,14 +293,6 @@ tcIfaceLclId occ
             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
@@ -340,7 +331,7 @@ lookupIfaceTc other_tc	    = return (ifaceTyConName other_tc)
 
 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
 
@@ -349,10 +340,16 @@ lookupIfaceTop :: OccName -> IfL Name
 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