GHC/TopHandler.lhs

   1 \begin{code}
   2 -----------------------------------------------------------------------------
   3 -- |
   4 -- Module      :  GHC.TopHandler
   5 -- Copyright   :  (c) The University of Glasgow, 2001-2002
   6 -- License     :  see libraries/base/LICENSE
   7 --
   8 -- Maintainer  :  cvs-ghc@haskell.org
   9 -- Stability   :  internal
  10 -- Portability :  non-portable (GHC Extensions)
  11 --
  12 -- Support for catching exceptions raised during top-level computations
  13 -- (e.g. @Main.main@, 'Control.Concurrent.forkIO', and foreign exports)
  14 --
  15 -----------------------------------------------------------------------------
  16
  17 module GHC.TopHandler (
  18    runMainIO, runIO, runNonIO, reportStackOverflow, reportError
  19   ) where
  20
  21 import Prelude
  22
  23 import System.IO
  24 import Control.Exception
  25
  26 import GHC.IOBase
  27 import GHC.Exception
  28 import GHC.Prim (unsafeCoerce#)
  29
  30 -- | 'runMainIO' is wrapped around 'Main.main' (or whatever main is
  31 -- called in the program).  It catches otherwise uncaught exceptions,
  32 -- and also flushes stdout\/stderr before exiting.
  33 runMainIO :: IO a -> IO a
  34 runMainIO main = (do a <- main; cleanUp; return a) `catchException` topHandler
  35
  36 -- | 'runIO' is wrapped around every @foreign export@ and @foreign
  37 -- import \"wrapper\"@ to mop up any uncaught exceptions.  Thus, the
  38 -- result of running 'System.Exit.exitWith' in a foreign-exported
  39 -- function is the same as in the main thread: it terminates the
  40 -- program.
  41 --
  42 runIO :: IO a -> IO a
  43 runIO main = catchException main topHandler
  44
  45 -- | The same as 'runIO', but for non-IO computations.  Used for
  46 -- wrapping @foreign export@ and @foreign import \"wrapper\"@ when these
  47 -- are used to export Haskell functions with non-IO types.
  48 --
  49 runNonIO :: a -> IO a
  50 runNonIO a = catchException (a `seq` return a) topHandler
  51
  52 topHandler :: Exception -> IO a
  53 topHandler err = catchException (real_handler err) topHandler
  54
  55 -- Make sure we handle errors while reporting the error!
  56 -- (e.g. evaluating the string passed to 'error' might generate
  57 --  another error, etc.)
  58 --
  59 real_handler :: Exception -> IO a
  60 real_handler ex =
  61   case ex of
  62         AsyncException StackOverflow -> do
  63            reportStackOverflow
  64            safeExit 2
  65
  66         -- only the main thread gets ExitException exceptions
  67         ExitException ExitSuccess     -> safeExit 0
  68         ExitException (ExitFailure n) -> safeExit n
  69
  70         other -> do
  71            reportError other
  72            safeExit 1
  73
  74
  75 reportStackOverflow :: IO a
  76 reportStackOverflow = do callStackOverflowHook; return undefined
  77
  78 reportError :: Exception -> IO a
  79 reportError ex = do
  80    handler <- getUncaughtExceptionHandler
  81    handler ex
  82    return undefined
  83
  84 -- SUP: Are the hooks allowed to re-enter Haskell land?  If so, remove
  85 -- the unsafe below.
  86 foreign import ccall unsafe "stackOverflow"
  87         callStackOverflowHook :: IO ()
  88
  89 -- try to flush stdout/stderr, but don't worry if we fail
  90 -- (these handles might have errors, and we don't want to go into
  91 -- an infinite loop).
  92 cleanUp :: IO ()
  93 cleanUp = do
  94   hFlush stdout `catchException` \_ -> return ()
  95   hFlush stderr `catchException` \_ -> return ()
  96
  97 cleanUpAndExit :: Int -> IO a
  98 cleanUpAndExit r = do cleanUp; safeExit r
  99
 100 -- we have to use unsafeCoerce# to get the 'IO a' result type, since the
 101 -- compiler doesn't let us declare that as the result type of a foreign export.
 102 safeExit :: Int -> IO a
 103 safeExit r = unsafeCoerce# (shutdownHaskellAndExit r)
 104
 105 -- NOTE: shutdownHaskellAndExit must be called "safe", because it *can*
 106 -- re-enter Haskell land through finalizers.
 107 foreign import ccall "shutdownHaskellAndExit"
 108   shutdownHaskellAndExit :: Int -> IO ()
 109 \end{code}