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         ErrorCall s -> reportError s
  38         other       -> hPutStr stderr (showsPrec 0 other "\n") >>
  39                        _ccall_ stg_exit (1::Int)
  40
  41 -- calls to 'error' are treated slightly differently...
  42
  43 reportError :: String -> IO ()
  44 reportError str = do
  45    (hFlush stdout) `catchException` (\ _ -> return ())
  46    let bs@(ByteArray (_,len) _) = packString str
  47    _ccall_ writeErrString__ (``&ErrorHdrHook''::Addr) bs len
  48    _ccall_ stg_exit (1::Int)
  49
  50 \end{code}