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   cleanUp >>
  62   case ex of
  63         AsyncException StackOverflow -> do
  64            reportStackOverflow
  65            safeExit 2
  66
  67         -- only the main thread gets ExitException exceptions
  68         ExitException ExitSuccess     -> safeExit 0
  69         ExitException (ExitFailure n) -> safeExit n
  70
  71         other -> do
  72            reportError other
  73            safeExit 1
  74
  75
  76 reportStackOverflow :: IO a
  77 reportStackOverflow = do callStackOverflowHook; return undefined
  78
  79 reportError :: Exception -> IO a
  80 reportError ex = do
  81    handler <- getUncaughtExceptionHandler
  82    handler ex
  83    return undefined
  84
  85 -- SUP: Are the hooks allowed to re-enter Haskell land?  If so, remove
  86 -- the unsafe below.
  87 foreign import ccall unsafe "stackOverflow"
  88         callStackOverflowHook :: IO ()
  89
  90 -- try to flush stdout/stderr, but don't worry if we fail
  91 -- (these handles might have errors, and we don't want to go into
  92 -- an infinite loop).
  93 cleanUp :: IO ()
  94 cleanUp = do
  95   hFlush stdout `catchException` \_ -> return ()
  96   hFlush stderr `catchException` \_ -> return ()
  97
  98 cleanUpAndExit :: Int -> IO a
  99 cleanUpAndExit r = do cleanUp; safeExit r
 100
 101 -- we have to use unsafeCoerce# to get the 'IO a' result type, since the
 102 -- compiler doesn't let us declare that as the result type of a foreign export.
 103 safeExit :: Int -> IO a
 104 safeExit r = unsafeCoerce# (shutdownHaskellAndExit r)
 105
 106 -- NOTE: shutdownHaskellAndExit must be called "safe", because it *can*
 107 -- re-enter Haskell land through finalizers.
 108 foreign import ccall "shutdownHaskellAndExit"
 109   shutdownHaskellAndExit :: Int -> IO ()
 110 \end{code}