ghc/lib/std/PrelMain.lhs

   1 % ------------------------------------------------------------------------------
   2 % $Id: PrelMain.lhs,v 1.8 2001/05/18 16:54:05 simonmar Exp $
   3 %
   4 % (c) The University of Glasgow, 1994-2000
   5 %
   6
   7 \section[PrelMain]{Module @PrelMain@}
   8
   9 \begin{code}
  10 module PrelMain( mainIO, reportStackOverflow, reportError ) where
  11
  12 import Prelude
  13 import {-# SOURCE #-} qualified Main    -- for type of "Main.main"
  14
  15 import IO
  16 import PrelCString
  17 import PrelPtr
  18 import PrelException
  19 \end{code}
  20
  21 \begin{code}
  22 mainIO :: IO ()         -- It must be of type (IO t) because that's what
  23                         -- the RTS expects.  GHC doesn't check this, so
  24                         -- make sure this type signature stays!
  25 mainIO = catchException Main.main topHandler
  26
  27 -- 'Top-level' IO actions want to catch exceptions (e.g., forkIO and
  28 -- PrelMain.mainIO) and report them - topHandler is the exception
  29 -- handler they should use for this:
  30
  31 -- make sure we handle errors while reporting the error!
  32 -- (e.g. evaluating the string passed to 'error' might generate
  33 --  another error, etc.)
  34 topHandler :: Exception -> IO ()
  35 topHandler err = catchException (real_handler err) topHandler
  36
  37 real_handler :: Exception -> IO ()
  38 real_handler ex =
  39   case ex of
  40         AsyncException StackOverflow -> reportStackOverflow True
  41         ErrorCall s -> reportError True s
  42         other       -> reportError True (showsPrec 0 other "\n")
  43
  44 reportStackOverflow :: Bool -> IO ()
  45 reportStackOverflow bombOut = do
  46    (hFlush stdout) `catchException` (\ _ -> return ())
  47    callStackOverflowHook
  48    if bombOut then
  49      stg_exit 2
  50     else
  51      return ()
  52
  53 reportError :: Bool -> String -> IO ()
  54 reportError bombOut str = do
  55    (hFlush stdout) `catchException` (\ _ -> return ())
  56    withCStringLen str $ \(cstr,len) -> do
  57      writeErrString addrOf_ErrorHdrHook cstr len
  58      if bombOut
  59         then stg_exit 1
  60         else return ()
  61
  62 foreign import ccall "addrOf_ErrorHdrHook" unsafe
  63         addrOf_ErrorHdrHook :: Ptr ()
  64
  65 foreign import ccall "writeErrString__" unsafe
  66         writeErrString :: Ptr () -> CString -> Int -> IO ()
  67
  68 -- SUP: Are the hooks allowed to re-enter Haskell land?  If so, remove
  69 -- the unsafe below.
  70 foreign import ccall "stackOverflow" unsafe
  71         callStackOverflowHook :: IO ()
  72
  73 foreign import ccall "stg_exit" unsafe
  74         stg_exit :: Int -> IO ()
  75 \end{code}