X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcRnMonad.lhs;h=ed1dce663a7a69ec3c69fd3928fec89fd501a701;hb=2eb105009654588b2130997509645841800681b9;hp=f118f47ab523785dca713f1e3f78457a5da264e9;hpb=3f1b316d7035c55cd712cd39a9981339bcef2e8c;p=ghc-hetmet.git diff --git a/compiler/typecheck/TcRnMonad.lhs b/compiler/typecheck/TcRnMonad.lhs index f118f47..ed1dce6 100644 --- a/compiler/typecheck/TcRnMonad.lhs +++ b/compiler/typecheck/TcRnMonad.lhs @@ -397,6 +397,9 @@ tcIsHsBoot = do { env <- getGblEnv; return (isHsBoot (tcg_src env)) } getGlobalRdrEnv :: TcRn GlobalRdrEnv getGlobalRdrEnv = do { env <- getGblEnv; return (tcg_rdr_env env) } +getRdrEnvs :: TcRn (GlobalRdrEnv, LocalRdrEnv) +getRdrEnvs = do { (gbl,lcl) <- getEnvs; return (tcg_rdr_env gbl, tcl_rdr lcl) } + getImports :: TcRn ImportAvails getImports = do { env <- getGblEnv; return (tcg_imports env) } @@ -561,6 +564,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