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    runIO, runNonIO, reportStackOverflow, reportError
  19   ) where
  20
  21 import Prelude
  22
  23 import System.IO
  24 import Control.Exception
  25
  26 import Foreign.C.String
  27 import Foreign.Ptr
  28 import GHC.IOBase
  29 import GHC.Exception
  30 import GHC.Prim (unsafeCoerce#)
  31
  32 -- | 'runIO' is wrapped around @Main.main@ by @TcModule@.  It is also wrapped
  33 -- around every @foreign export@ and @foreign import \"wrapper\"@ to mop up
  34 -- any uncaught exceptions.  Thus, the result of running
  35 -- 'System.Exit.exitWith' in a foreign-exported function is the same as
  36 -- in the main thread: it terminates the program.
  37 --
  38 runIO :: IO a -> IO a
  39 runIO main = catchException main topHandler
  40
  41 -- | The same as 'runIO', but for non-IO computations.  Used for
  42 -- wrapping @foreign export@ and @foreign import \"wrapper\"@ when these
  43 -- are used to export Haskell functions with non-IO types.
  44 --
  45 runNonIO :: a -> IO a
  46 runNonIO a = catchException (a `seq` return a) topHandler
  47
  48 topHandler :: Exception -> IO a
  49 topHandler err = catchException (real_handler err) topHandler
  50
  51 -- Make sure we handle errors while reporting the error!
  52 -- (e.g. evaluating the string passed to 'error' might generate
  53 --  another error, etc.)
  54 --
  55 real_handler :: Exception -> IO a
  56 real_handler ex =
  57   case ex of
  58         AsyncException StackOverflow -> reportStackOverflow True
  59
  60         -- only the main thread gets ExitException exceptions
  61         ExitException ExitSuccess     -> safe_exit 0
  62         ExitException (ExitFailure n) -> safe_exit n
  63
  64         other       -> reportError True other
  65
  66
  67 reportStackOverflow :: Bool -> IO a
  68 reportStackOverflow bombOut = do
  69    (hFlush stdout) `catchException` (\ _ -> return ())
  70    callStackOverflowHook
  71    if bombOut
  72         then exit 2
  73         else return undefined
  74
  75 reportError :: Bool -> Exception -> IO a
  76 reportError bombOut ex = do
  77    handler <- getUncaughtExceptionHandler
  78    handler ex
  79    if bombOut
  80       then exit 1
  81       else return undefined
  82
  83 -- SUP: Are the hooks allowed to re-enter Haskell land?  If so, remove
  84 -- the unsafe below.
  85 foreign import ccall unsafe "stackOverflow"
  86         callStackOverflowHook :: IO ()
  87
  88 foreign import ccall unsafe "stg_exit"
  89         stg_exit :: Int -> IO ()
  90
  91 exit :: Int -> IO a
  92 exit r = unsafeCoerce# (stg_exit r)
  93
  94 -- NOTE: shutdownHaskellAndExit must be called "safe", because it *can*
  95 -- re-enter Haskell land through finalizers.
  96 foreign import ccall "shutdownHaskellAndExit"
  97   shutdownHaskellAndExit :: Int -> IO ()
  98
  99 -- we have to use unsafeCoerce# to get the 'IO a' result type, since the
 100 -- compiler doesn't let us declare that as the result type of a foreign export.
 101 safe_exit :: Int -> IO a
 102 safe_exit r = unsafeCoerce# (shutdownHaskellAndExit r)
 103 \end{code}