X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcRnMonad.lhs;h=68db3a273cc991dad06bd69b5411a6665e5f9702;hb=06f6f35dadc461336675e6d2b8a2192b1f518a1b;hp=c7c51ed605d9e68f8c6a55f9ae2ffc64d1cfe2ca;hpb=421819753b3eb4940a26e578ef0e4c5cd31761fa;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcRnMonad.lhs b/compiler/typecheck/TcRnMonad.lhs
index c7c51ed..68db3a2 100644
--- a/compiler/typecheck/TcRnMonad.lhs
+++ b/compiler/typecheck/TcRnMonad.lhs
@@ -44,6 +44,7 @@ import Bag
 import Outputable
 import UniqSupply
 import Unique
+import UniqFM
 import DynFlags
 import StaticFlags
 import FastString
@@ -560,6 +561,19 @@ recoverM recover thing
 	   Left exn  -> recover
 	   Right res -> returnM res }
 
+
+-----------------------
+mapAndRecoverM :: (a -> TcRn b) -> [a] -> TcRn [b]
+-- Drop elements of the input that fail, so the result
+-- list can be shorter than the argument list
+mapAndRecoverM f []     = return []
+mapAndRecoverM f (x:xs) = do { mb_r <- tryM (f x)
+			     ; rs <- mapAndRecoverM f xs
+			     ; return (case mb_r of
+					  Left _  -> rs
+					  Right r -> r:rs) }
+			
+
 -----------------------
 tryTc :: TcRn a -> TcRn (Messages, Maybe a)
 -- (tryTc m) executes m, and returns
@@ -874,9 +888,11 @@ setLclTypeEnv lcl_env thing_inside
 recordThUse :: TcM ()
 recordThUse = do { env <- getGblEnv; writeMutVar (tcg_th_used env) True }
 
-keepAliveTc :: Name -> TcM ()  	-- Record the name in the keep-alive set
-keepAliveTc n = do { env <- getGblEnv; 
-		   ; updMutVar (tcg_keep env) (`addOneToNameSet` n) }
+keepAliveTc :: Id -> TcM ()  	-- Record the name in the keep-alive set
+keepAliveTc id 
+  | isLocalId id = do { env <- getGblEnv; 
+		      ; updMutVar (tcg_keep env) (`addOneToNameSet` idName id) }
+  | otherwise = return ()
 
 keepAliveSetTc :: NameSet -> TcM ()  	-- Record the name in the keep-alive set
 keepAliveSetTc ns = do { env <- getGblEnv; 
@@ -916,8 +932,8 @@ setLocalRdrEnv rdr_env thing_inside
 mkIfLclEnv :: Module -> SDoc -> IfLclEnv
 mkIfLclEnv mod loc = IfLclEnv { if_mod     = mod,
 			        if_loc     = loc,
-			        if_tv_env  = emptyOccEnv,
-			        if_id_env  = emptyOccEnv }
+			        if_tv_env  = emptyUFM,
+			        if_id_env  = emptyUFM }
 
 initIfaceTcRn :: IfG a -> TcRn a
 initIfaceTcRn thing_inside