[project @ 2003-11-05 15:05:12 by ross]
[packages/random.git] / 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
25 import Foreign.C.String
26 import Foreign.Ptr
27 import GHC.IOBase
28 import GHC.Exception
29 import GHC.Prim (unsafeCoerce#)
30
31 -- | 'runIO' is wrapped around @Main.main@ by @TcModule@.  It is also wrapped
32 -- around every @foreign export@ and @foreign import \"wrapper\"@ to mop up
33 -- any uncaught exceptions.  Thus, the result of running
34 -- 'System.Exit.exitWith' in a foreign-exported function is the same as
35 -- in the main thread: it terminates the program.
36 --
37 runIO :: IO a -> IO a
38 runIO main = catchException main topHandler
39
40 -- | The same as 'runIO', but for non-IO computations.  Used for
41 -- wrapping @foreign export@ and @foreign import \"wrapper\"@ when these
42 -- are used to export Haskell functions with non-IO types.
43 --
44 runNonIO :: a -> IO a
45 runNonIO a = catchException (a `seq` return a) topHandler
46
47 topHandler :: Exception -> IO a
48 topHandler err = catchException (real_handler err) topHandler
49
50 -- Make sure we handle errors while reporting the error!
51 -- (e.g. evaluating the string passed to 'error' might generate
52 --  another error, etc.)
53 --
54 real_handler :: Exception -> IO a
55 real_handler ex =
56   case ex of
57         AsyncException StackOverflow -> reportStackOverflow True
58
59         -- only the main thread gets ExitException exceptions
60         ExitException ExitSuccess     -> safe_exit 0
61         ExitException (ExitFailure n) -> safe_exit n
62
63         Deadlock    -> reportError True 
64                         "no threads to run:  infinite loop or deadlock?"
65   
66         ErrorCall s -> reportError True s
67         other       -> reportError True (showsPrec 0 other "\n")
68
69 reportStackOverflow :: Bool -> IO a
70 reportStackOverflow bombOut = do
71    (hFlush stdout) `catchException` (\ _ -> return ())
72    callStackOverflowHook
73    if bombOut 
74         then exit 2
75         else return undefined
76
77 reportError :: Bool -> String -> IO a
78 reportError bombOut str = do
79    (hFlush stdout) `catchException` (\ _ -> return ())
80    withCStringLen str $ \(cstr,len) -> do
81      writeErrString errorHdrHook cstr len
82      if bombOut 
83         then exit 1
84         else return undefined
85
86 #ifndef ILX
87 foreign import ccall "&ErrorHdrHook" errorHdrHook :: Ptr ()
88 #else
89 foreign import ccall "ErrorHdrHook" errorHdrHook :: Ptr ()
90 #endif
91
92 foreign import ccall unsafe "writeErrString__"
93         writeErrString :: Ptr () -> CString -> Int -> IO ()
94
95 -- SUP: Are the hooks allowed to re-enter Haskell land?  If so, remove
96 -- the unsafe below.
97 foreign import ccall unsafe "stackOverflow"
98         callStackOverflowHook :: IO ()
99
100 foreign import ccall unsafe "stg_exit"
101         stg_exit :: Int -> IO ()
102
103 exit :: Int -> IO a
104 exit r = unsafeCoerce# (stg_exit 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
111 -- we have to use unsafeCoerce# to get the 'IO a' result type, since the
112 -- compiler doesn't let us declare that as the result type of a foreign export.
113 safe_exit :: Int -> IO a
114 safe_exit r = unsafeCoerce# (shutdownHaskellAndExit r)
115 \end{code}