X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FException.lhs;h=4707a0ca3b58bec1f74b4badbc06d3c2064f4b31;hb=86ab0d63460af5d4dfa9cbe4e7cb759218a6fecb;hp=08f5e97703cdde8c30437676983b8854cfce50fc;hpb=1172e0e4b9640aa96095e31bcdc854cc55b54e34;p=ghc-base.git

diff --git a/GHC/Exception.lhs b/GHC/Exception.lhs
index 08f5e97..4707a0c 100644
--- a/GHC/Exception.lhs
+++ b/GHC/Exception.lhs
@@ -1,5 +1,6 @@
 \begin{code}
-{-# OPTIONS -fno-implicit-prelude #-}
+{-# OPTIONS_GHC -XNoImplicitPrelude #-}
+{-# OPTIONS_HADDOCK hide #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  GHC.Exception
@@ -14,90 +15,80 @@
 -- 
 -----------------------------------------------------------------------------
 
-module GHC.Exception 
-	( module GHC.Exception, 
-	  Exception(..), AsyncException(..), 
-	  IOException(..), ArithException(..), ArrayException(..),
-	  throw, throwIO, ioError ) 
-  where
+-- #hide
+module GHC.Exception where
 
+import Data.Maybe
+import {-# SOURCE #-} Data.Typeable
 import GHC.Base
-import GHC.IOBase
+import GHC.Show
 \end{code}
 
 %*********************************************************
-%*							*
-\subsection{Primitive catch}
-%*							*
+%*                                                      *
+\subsection{Exceptions}
+%*                                                      *
 %*********************************************************
 
-catchException used to handle the passing around of the state to the
-action and the handler.  This turned out to be a bad idea - it meant
-that we had to wrap both arguments in thunks so they could be entered
-as normal (remember IO returns an unboxed pair...).
+\begin{code}
+data SomeException = forall e . Exception e => SomeException e
+    deriving Typeable
 
-Now catch# has type
+instance Show SomeException where
+    showsPrec p (SomeException e) = showsPrec p e
 
-    catch# :: IO a -> (b -> IO a) -> IO a
+class (Typeable e, Show e) => Exception e where
+    toException   :: e -> SomeException
+    fromException :: SomeException -> Maybe e
 
-(well almost; the compiler doesn't know about the IO newtype so we
-have to work around that in the definition of catchException below).
+    toException = SomeException
+    fromException (SomeException e) = cast e
 
-\begin{code}
-catchException :: IO a -> (Exception -> IO a) -> IO a
-catchException (IO m) k =  IO $ \s -> catch# m (\ex -> unIO (k ex)) s
-
--- | The 'catch' function establishes a handler that receives any 'IOError'
--- raised in the action protected by 'catch'.  An 'IOError' is caught by
--- the most recent handler established by 'catch'.  These handlers are
--- not selective: all 'IOError's are caught.  Exception propagation
--- must be explicitly provided in a handler by re-raising any unwanted
--- exceptions.  For example, in
---
--- > f = catch g (\e -> if IO.isEOFError e then return [] else ioError e)
---
--- the function @f@ returns @[]@ when an end-of-file exception
--- (cf. 'System.IO.Error.isEOFError') occurs in @g@; otherwise, the
--- exception is propagated to the next outer handler.
---
--- When an exception propagates outside the main program, the Haskell
--- system prints the associated 'IOError' value and exits the program.
---
--- Non-I\/O exceptions are not caught by this variant; to catch all
--- exceptions, use 'Control.Exception.catch' from "Control.Exception".
-catch           :: IO a -> (IOError -> IO a) -> IO a 
-catch m k	=  catchException m handler
-  where handler (IOException err)   = k err
-	handler other               = throw other
+instance Exception SomeException where
+    toException se = se
+    fromException = Just
 \end{code}
 
-
 %*********************************************************
-%*							*
-\subsection{Controlling asynchronous exception delivery}
-%*							*
+%*                                                      *
+\subsection{Primitive throw}
+%*                                                      *
 %*********************************************************
 
 \begin{code}
--- | Applying 'block' to a computation will
--- execute that computation with asynchronous exceptions
--- /blocked/.  That is, any thread which
--- attempts to raise an exception in the current thread will be
--- blocked until asynchronous exceptions are enabled again.  There\'s
--- no need to worry about re-enabling asynchronous exceptions; that is
--- done automatically on exiting the scope of
--- 'block'.
-block :: IO a -> IO a
-
--- | To re-enable asynchronous exceptions inside the scope of
--- 'block', 'unblock' can be
--- used.  It scopes in exactly the same way, so on exit from
--- 'unblock' asynchronous exception delivery will
--- be disabled again.
-unblock :: IO a -> IO a
-
-block (IO io) = IO $ blockAsyncExceptions# io
-unblock (IO io) = IO $ unblockAsyncExceptions# io
+-- | Throw an exception.  Exceptions may be thrown from purely
+-- functional code, but may only be caught within the 'IO' monad.
+throw :: Exception e => e -> a
+throw e = raise# (toException e)
 \end{code}
 
+\begin{code}
+data ErrorCall = ErrorCall String
+    deriving Typeable
 
+instance Exception ErrorCall
+
+instance Show ErrorCall where
+    showsPrec _ (ErrorCall err) = showString err
+
+-----
+
+-- |The type of arithmetic exceptions
+data ArithException
+  = Overflow
+  | Underflow
+  | LossOfPrecision
+  | DivideByZero
+  | Denormal
+  deriving (Eq, Ord, Typeable)
+
+instance Exception ArithException
+
+instance Show ArithException where
+  showsPrec _ Overflow        = showString "arithmetic overflow"
+  showsPrec _ Underflow       = showString "arithmetic underflow"
+  showsPrec _ LossOfPrecision = showString "loss of precision"
+  showsPrec _ DivideByZero    = showString "divide by zero"
+  showsPrec _ Denormal        = showString "denormal"
+
+\end{code}