[project @ 2003-06-19 10:42:26 by simonmar]
[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 -- Top-level IO actions want to catch exceptions (e.g., 'forkIO' and 
13 -- 'GHC.Main.mainIO') and report them - 'topHandler' is the exception
14 -- handler they should use for this.
15 --
16 -----------------------------------------------------------------------------
17
18 module GHC.TopHandler (
19    runIO, runNonIO, reportStackOverflow, reportError 
20   ) where
21
22 import Prelude
23
24 import System.IO
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         Deadlock    -> reportError True 
65                         "no threads to run:  infinite loop or deadlock?"
66   
67         ErrorCall s -> reportError True s
68         other       -> reportError True (showsPrec 0 other "\n")
69
70 reportStackOverflow :: Bool -> IO a
71 reportStackOverflow bombOut = do
72    (hFlush stdout) `catchException` (\ _ -> return ())
73    callStackOverflowHook
74    if bombOut 
75         then exit 2
76         else return undefined
77
78 reportError :: Bool -> String -> IO a
79 reportError bombOut str = do
80    (hFlush stdout) `catchException` (\ _ -> return ())
81    withCStringLen str $ \(cstr,len) -> do
82      writeErrString errorHdrHook cstr len
83      if bombOut 
84         then exit 1
85         else return undefined
86
87 #ifndef ILX
88 foreign import ccall "&ErrorHdrHook" errorHdrHook :: Ptr ()
89 #else
90 foreign import ccall "ErrorHdrHook" errorHdrHook :: Ptr ()
91 #endif
92
93 foreign import ccall unsafe "writeErrString__"
94         writeErrString :: Ptr () -> CString -> Int -> IO ()
95
96 -- SUP: Are the hooks allowed to re-enter Haskell land?  If so, remove
97 -- the unsafe below.
98 foreign import ccall unsafe "stackOverflow"
99         callStackOverflowHook :: IO ()
100
101 foreign import ccall unsafe "stg_exit"
102         stg_exit :: Int -> IO ()
103
104 exit :: Int -> IO a
105 exit r = unsafeCoerce# (stg_exit r)
106
107 -- NOTE: shutdownHaskellAndExit must be called "safe", because it *can*
108 -- re-enter Haskell land through finalizers.
109 foreign import ccall "shutdownHaskellAndExit" 
110   shutdownHaskellAndExit :: Int -> IO ()
111
112 -- we have to use unsafeCoerce# to get the 'IO a' result type, since the
113 -- compiler doesn't let us declare that as the result type of a foreign export.
114 safe_exit :: Int -> IO a
115 safe_exit r = unsafeCoerce# (shutdownHaskellAndExit r)
116 \end{code}