ghc/lib/std/PrelMain.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1994-1997
   3 %
   4
   5 \section[PrelMain]{Module @PrelMain@}
   6
   7 \begin{code}
   8 {-# OPTIONS -#include "cbits/stgio.h" #-}
   9
  10 module PrelMain( mainIO ) where
  11
  12 import Prelude
  13 import {-# SOURCE #-} qualified Main    -- for type of "Main.main"
  14 import IO               ( hFlush, hPutStr, stdout, stderr )
  15 import PrelAddr         ( Addr )
  16 import PrelException
  17 import PrelPack     ( packString )
  18 import PrelArr      ( ByteArray(..) )
  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 handler
  26
  27 -- make sure we handle errors while reporting the error!
  28 -- (e.g. evaluating the string passed to 'error' might generate
  29 --  another error, etc.)
  30
  31 handler :: Exception -> IO ()
  32 handler err = catchException (real_handler err) handler
  33
  34 real_handler :: Exception -> IO ()
  35 real_handler ex =
  36   case ex of
  37         AsyncException StackOverflow -> reportStackOverflow
  38         ErrorCall s -> reportError s
  39         other       -> reportError (showsPrec 0 other "\n")
  40
  41 reportStackOverflow :: IO ()
  42 reportStackOverflow = do
  43    (hFlush stdout) `catchException` (\ _ -> return ())
  44    callStackOverflowHook
  45    stg_exit 2
  46
  47 reportError :: String -> IO ()
  48 reportError str = do
  49    (hFlush stdout) `catchException` (\ _ -> return ())
  50    let bs@(ByteArray (_,len) _) = packString str
  51    writeErrString (``&ErrorHdrHook''::Addr) bs len
  52    stg_exit 1
  53
  54 foreign import ccall "writeErrString__"
  55         writeErrString :: Addr -> ByteArray Int -> Int -> IO ()
  56
  57 foreign import ccall "stackOverflow"
  58         callStackOverflowHook :: IO ()
  59
  60 foreign import ccall "stg_exit"
  61         stg_exit :: Int -> IO ()
  62
  63 \end{code}