X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcRnMonad.lhs;h=11036f4cceaaae354cdf8e0e1b929b800c1ea613;hp=2b7e567b83f372c1d147cd2208dd5d4c29079e97;hb=d7b36bbbcd56ee14656223d02e32f5a1f52ea17b;hpb=7b9ccfe6947e4ef514057668d6f6673c3fedc10d diff --git a/compiler/typecheck/TcRnMonad.lhs b/compiler/typecheck/TcRnMonad.lhs index 2b7e567..11036f4 100644 --- a/compiler/typecheck/TcRnMonad.lhs +++ b/compiler/typecheck/TcRnMonad.lhs @@ -40,7 +40,6 @@ import StaticFlags import FastString import Panic import Util -import Exception import System.IO import Data.IORef @@ -148,11 +147,10 @@ initTcPrintErrors -- Used from the interactive loop only :: HscEnv -> Module -> TcM r - -> IO (Maybe r) + -> IO (Messages, Maybe r) initTcPrintErrors env mod todo = do (msgs, res) <- initTc env HsSrcFile False mod todo - printErrorsAndWarnings (hsc_dflags env) msgs - return res + return (msgs, res) \end{code} %************************************************************************ @@ -412,11 +410,6 @@ extendFixityEnv new_bit getRecFieldEnv :: TcRn RecFieldEnv getRecFieldEnv = do { env <- getGblEnv; return (tcg_field_env env) } -extendRecFieldEnv :: RecFieldEnv -> RnM a -> RnM a -extendRecFieldEnv new_bit - = updGblEnv (\env@(TcGblEnv { tcg_field_env = old_env }) -> - env {tcg_field_env = old_env `plusNameEnv` new_bit}) - getDeclaredDefaultTys :: TcRn (Maybe [Type]) getDeclaredDefaultTys = do { env <- getGblEnv; return (tcg_default env) } \end{code} @@ -544,11 +537,7 @@ discardWarnings thing_inside \begin{code} -#if __GLASGOW_HASKELL__ < 609 -try_m :: TcRn r -> TcRn (Either Exception r) -#else -try_m :: TcRn r -> TcRn (Either ErrorCall r) -#endif +try_m :: TcRn r -> TcRn (Either IOEnvFailure r) -- Does try_m, with a debug-trace on failure try_m thing = do { mb_r <- tryM thing ; @@ -575,7 +564,7 @@ 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 _ [] = return [] -mapAndRecoverM f (x:xs) = do { mb_r <- tryM (f x) +mapAndRecoverM f (x:xs) = do { mb_r <- try_m (f x) ; rs <- mapAndRecoverM f xs ; return (case mb_r of Left _ -> rs