ghc/lib/ghc/Error.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1994-1996
   3 %
   4
   5 \section[Error]{Module @Error@}
   6
   7 \begin{code}
   8 {-# OPTIONS -fno-implicit-prelude #-}
   9
  10 module Error (errorIO, error) where
  11
  12 import PrelBase
  13 import IOBase
  14 import Foreign
  15 import Addr
  16 \end{code}
  17
  18 %*********************************************************
  19 %*                                                      *
  20 \subsection{Error-ish functions}
  21 %*                                                      *
  22 %*********************************************************
  23
  24 \begin{code}
  25 errorIO :: IO () -> a
  26
  27 errorIO (IO io)
  28   = case (errorIO# io) of
  29       _ -> bottom
  30   where
  31     bottom = bottom -- Never evaluated
  32
  33 --errorIO x = (waitRead#, errorIO#, makeForeignObj#, waitWrite#, (+#))
  34
  35 -- error stops execution and displays an error message
  36 error :: String -> a
  37 error s = error__ ( \ x -> _ccall_ ErrorHdrHook x ) s
  38
  39 error__ :: (Addr{-FILE *-} -> IO ()) -> String -> a
  40
  41 error__ msg_hdr s
  42 #ifdef __PARALLEL_HASKELL__
  43   = errorIO (msg_hdr sTDERR{-msg hdr-}  >>
  44              _ccall_ fflush sTDERR      >>
  45              fputs sTDERR s             >>
  46              _ccall_ fflush sTDERR      >>
  47              _ccall_ stg_exit (1::Int)
  48             )
  49 #else
  50   = errorIO (msg_hdr sTDERR{-msg hdr-}  >>
  51              _ccall_ fflush sTDERR      >>
  52              fputs sTDERR s             >>
  53              _ccall_ fflush sTDERR      >>
  54              _ccall_ getErrorHandler    >>= \ errorHandler ->
  55              if errorHandler == (-1::Int) then
  56                 _ccall_ stg_exit (1::Int)
  57              else
  58                 _casm_ ``%r = (StgStablePtr)(%0);'' errorHandler
  59                                                 >>= \ osptr ->
  60                 _ccall_ decrementErrorCount     >>= \ () ->
  61                 deRefStablePtr osptr            >>= \ oact ->
  62                 oact
  63             )
  64 #endif {- !parallel -}
  65   where
  66     sTDERR = (``stderr'' :: Addr)
  67 \end{code}
  68