diff options
| author | Thomas Schilling <nominolo@googlemail.com> | 2008-09-21 08:56:47 +0000 |
|---|---|---|
| committer | Thomas Schilling <nominolo@googlemail.com> | 2008-09-21 08:56:47 +0000 |
| commit | 67ad7f3ba7381ec815faf55be1ca6a4c6a919cb1 (patch) | |
| tree | 007f32f8e39d4f6d3cfdce9fcdc1e67b919afe43 | |
| parent | ca3d9a7b9372ffe844c267c6e5034ee0313c281c (diff) | |
| download | haskell-67ad7f3ba7381ec815faf55be1ca6a4c6a919cb1.tar.gz | |
Generalise type of 'defaultErrorHandler' so it can be used inside a Ghc session.
| -rw-r--r-- | compiler/main/ErrUtils.lhs | 6 | ||||
| -rw-r--r-- | compiler/main/GHC.hs | 13 |
2 files changed, 10 insertions, 9 deletions
diff --git a/compiler/main/ErrUtils.lhs b/compiler/main/ErrUtils.lhs index a0325bf808..7f5914e904 100644 --- a/compiler/main/ErrUtils.lhs +++ b/compiler/main/ErrUtils.lhs @@ -97,11 +97,11 @@ throwErrMsg = throwDyn throwErrMsg = throw #endif -handleErrMsg :: (ErrMsg -> IO a) -> IO a -> IO a +handleErrMsg :: ExceptionMonad m => (ErrMsg -> m a) -> m a -> m a #if __GLASGOW_HASKELL__ < 609 -handleErrMsg = flip catchDyn +handleErrMsg = flip gcatchDyn #else -handleErrMsg = handle +handleErrMsg = ghandle #endif -- So we can throw these things as exceptions diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs index 5256fe4530..b023885f2e 100644 --- a/compiler/main/GHC.hs +++ b/compiler/main/GHC.hs @@ -310,11 +310,11 @@ import Prelude hiding (init) -- Unless you want to handle exceptions yourself, you should wrap this around -- the top level of your program. The default handlers output the error -- message(s) to stderr and exit cleanly. -defaultErrorHandler :: DynFlags -> IO a -> IO a +defaultErrorHandler :: (ExceptionMonad m, MonadIO m) => DynFlags -> m a -> m a defaultErrorHandler dflags inner = -- top-level exception handler: any unrecognised exception is a compiler bug. #if __GLASGOW_HASKELL__ < 609 - handle (\exception -> do + ghandle (\exception -> liftIO $ do hFlush stdout case exception of -- an IO exception probably isn't our fault, so don't panic @@ -328,7 +328,7 @@ defaultErrorHandler dflags inner = exitWith (ExitFailure 1) ) $ #else - handle (\(SomeException exception) -> do + ghandle (\(SomeException exception) -> liftIO $ do hFlush stdout case cast exception of -- an IO exception probably isn't our fault, so don't panic @@ -349,12 +349,13 @@ defaultErrorHandler dflags inner = -- program errors: messages with locations attached. Sometimes it is -- convenient to just throw these as exceptions. handleErrMsg - (\em -> do printBagOfErrors dflags (unitBag em) - exitWith (ExitFailure 1)) $ + (\em -> liftIO $ do + printBagOfErrors dflags (unitBag em) + exitWith (ExitFailure 1)) $ -- error messages propagated as exceptions handleGhcException - (\ge -> do + (\ge -> liftIO $ do hFlush stdout case ge of PhaseFailed _ code -> exitWith code |