X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=compiler%2Fiface%2FIfaceEnv.lhs;h=6699a7570879bcab9ad8cd6759b9bf2f3ec5382b;hb=5edf58c10a0144fa8b328e18d0b7fffec2319424;hp=40b7d31f138aefdb9756f7a0766aa8c92af77320;hpb=0065d5ab628975892cea1ec7303f968c3338cbe1;p=ghc-hetmet.git

diff --git a/compiler/iface/IfaceEnv.lhs b/compiler/iface/IfaceEnv.lhs
index 40b7d31..6699a75 100644
--- a/compiler/iface/IfaceEnv.lhs
+++ b/compiler/iface/IfaceEnv.lhs
@@ -33,16 +33,17 @@ import Name		( Name, nameUnique, nameModule,
 		  	  isWiredInName, mkIPName,
 			  mkExternalName, mkInternalName )
 import NameSet		( NameSet, emptyNameSet, addListToNameSet )
-import OccName		( OccName, isTupleOcc_maybe, tcName, dataName, mapOccEnv,
+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 )
 import FiniteMap	( emptyFM, lookupFM, addToFM )
 import BasicTypes	( IPName(..), mapIPName )
 import SrcLoc		( SrcLoc, noSrcLoc )
-import Maybes		( orElse )
 
 import Outputable
 \end{code}
@@ -229,7 +230,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
@@ -285,12 +286,13 @@ initOrigNames names = foldl extendOrigNameCache emptyModuleEnv names
 %************************************************************************
 
 \begin{code}
-tcIfaceLclId :: OccName -> IfL Id
+tcIfaceLclId :: FastString -> IfL Id
 tcIfaceLclId occ
   = do	{ lcl <- getLclEnv
-	; return (lookupOccEnv (if_id_env lcl) occ
-		  `orElse` 
-		  pprPanic "tcIfaceLclId" (ppr occ)) }
+	; case (lookupUFM (if_id_env lcl) occ) of
+            Just ty_var -> return ty_var
+            Nothing     -> failIfM (text "Iface id out of scope: " <+> ppr occ)
+        }
 
 refineIfaceIdEnv :: TypeRefinement -> IfL a -> IfL a
 refineIfaceIdEnv (tv_subst, _) thing_inside
@@ -303,23 +305,24 @@ refineIfaceIdEnv (tv_subst, _) thing_inside
 extendIfaceIdEnv :: [Id] -> IfL a -> IfL a
 extendIfaceIdEnv ids thing_inside
   = do	{ env <- getLclEnv
-	; let { id_env' = extendOccEnvList (if_id_env env) pairs
-	      ;	pairs   = [(getOccName id, id) | id <- ids] }
+	; let { id_env' = addListToUFM (if_id_env env) pairs
+	      ;	pairs   = [(occNameFS (getOccName id), id) | id <- ids] }
 	; setLclEnv (env { if_id_env = id_env' }) thing_inside }
 
 
-tcIfaceTyVar :: OccName -> IfL TyVar
+tcIfaceTyVar :: FastString -> IfL TyVar
 tcIfaceTyVar occ
   = do	{ lcl <- getLclEnv
-	; return (lookupOccEnv (if_tv_env lcl) occ
-		  `orElse`
-		  pprPanic "tcIfaceTyVar" (ppr occ)) }
+	; case (lookupUFM (if_tv_env lcl) occ) of
+            Just ty_var -> return ty_var
+            Nothing     -> failIfM (text "Iface type variable out of scope: " <+> ppr occ)
+        }
 
 extendIfaceTyVarEnv :: [TyVar] -> IfL a -> IfL a
 extendIfaceTyVarEnv tyvars thing_inside
   = do	{ env <- getLclEnv
-	; let { tv_env' = extendOccEnvList (if_tv_env env) pairs
-	      ;	pairs   = [(getOccName tv, tv) | tv <- tyvars] }
+	; let { tv_env' = addListToUFM (if_tv_env env) pairs
+	      ;	pairs   = [(occNameFS (getOccName tv), tv) | tv <- tyvars] }
 	; setLclEnv (env { if_tv_env = tv_env' }) thing_inside }
 \end{code}
 
@@ -337,7 +340,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
 
@@ -346,10 +349,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