X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Control%2FException.hs;h=83f37cb23970c0aebbe710410bcb009133f7de37;hb=99a329d9b272925dcdf474ce2369e9421b51e51c;hp=e4e037eaa4f6345f0a6149ebd38d7800006a4737;hpb=ed813264145aa7d96c44375c8d92c93e3b1a4539;p=ghc-base.git diff --git a/Control/Exception.hs b/Control/Exception.hs index e4e037e..83f37cb 100644 --- a/Control/Exception.hs +++ b/Control/Exception.hs @@ -116,16 +116,15 @@ module Control.Exception ( import GHC.Base ( assert ) import GHC.Exception as ExceptionBase hiding (catch) import GHC.Conc ( throwTo, ThreadId ) -import GHC.IOBase ( IO(..), IORef(..), newIORef, readIORef, writeIORef ) -import GHC.Handle ( stdout, hFlush ) +import Data.IORef ( IORef, newIORef, readIORef, writeIORef ) +import Foreign.C.String ( CString, withCString ) +import System.IO ( stdout, hFlush ) #endif #ifdef __HUGS__ import Hugs.Exception as ExceptionBase #endif -import Foreign.C.String ( CString, withCStringLen ) - import Prelude hiding ( catch ) import System.IO.Error hiding ( catch, try ) import System.IO.Unsafe (unsafePerformIO) @@ -170,13 +169,12 @@ INSTANCE_TYPEABLE0(AsyncException,asyncExceptionTc,"AsyncException") -- might be a 'ThreadKilled', for example). In this case it is usually better -- to use 'catchJust' and select the kinds of exceptions to catch. -- --- Also note that The "Prelude" also exports a --- function called 'catch' which has the same type as --- 'Control.Exception.catch', the difference being that the --- "Prelude" version only catches the IO and user +-- Also note that the "Prelude" also exports a function called +-- 'Prelude.catch' with a similar type to 'Control.Exception.catch', +-- except that the "Prelude" version only catches the IO and user -- families of exceptions (as required by Haskell 98). We recommend -- either hiding the "Prelude" version of --- 'catch' when importing +-- 'Prelude.catch' when importing -- "Control.Exception", or importing -- "Control.Exception" qualified, to avoid name-clashes. @@ -221,25 +219,6 @@ handleJust :: (Exception -> Maybe b) -> (b -> IO a) -> IO a -> IO a handleJust p = flip (catchJust p) ----------------------------------------------------------------------------- --- evaluate - --- | Forces its argument to be evaluated, and returns the result in --- the 'IO' monad. It can be used to order evaluation with respect to --- other 'IO' operations; its semantics are given by --- --- > evaluate undefined `seq` return () ==> return () --- > catch (evaluate undefined) (\e -> return ()) ==> return () --- --- NOTE: @(evaluate a)@ is /not/ the same as @(a \`seq\` return a)@. -#ifdef __GLASGOW_HASKELL__ -evaluate :: a -> IO a -evaluate a = IO $ \s -> case a `seq` () of () -> (# s, a #) - -- NB. can't write - -- a `seq` (# s, a #) - -- because we can't have an unboxed tuple as a function argument -#endif - ------------------------------------------------------------------------------ -- 'mapException' -- | This function maps one exception into another as proposed in the @@ -255,7 +234,7 @@ mapException f v = unsafePerformIO (catch (evaluate v) -- 'try' and variations. -- | Similar to 'catch', but returns an 'Either' result which is --- @(Right a)@ if no exception was raised, or @(Left e)@ if an +-- @('Right' a)@ if no exception was raised, or @('Left' e)@ if an -- exception was raised and its value is @e@. -- -- > try a = catch (Right \`liftM\` a) (return . Left) @@ -264,6 +243,11 @@ mapException f v = unsafePerformIO (catch (evaluate v) -- to re-throw the exception after performing whatever cleanup is needed. -- Otherwise, 'tryJust' is generally considered to be better. -- +-- Also note that "System.IO.Error" also exports a function called +-- 'System.IO.Error.try' with a similar type to 'Control.Exception.try', +-- except that it catches only the IO and user families of exceptions +-- (as required by the Haskell 98 @IO@ module). + try :: IO a -> IO (Either Exception a) try a = catch (a >>= \ v -> return (Right v)) (\e -> return (Left e)) @@ -526,10 +510,11 @@ uncaughtExceptionHandler = unsafePerformIO (newIORef defaultHandler) Deadlock -> "no threads to run: infinite loop or deadlock?" ErrorCall s -> s other -> showsPrec 0 other "\n" - withCStringLen ("Fail: "++msg) $ \(cstr,len) -> writeErrString cstr len - -foreign import ccall unsafe "writeErrString__" - writeErrString :: CString -> Int -> IO () + withCString "%s" $ \cfmt -> + withCString msg $ \cmsg -> + errorBelch cfmt cmsg + +foreign import ccall unsafe errorBelch :: CString -> CString -> IO () setUncaughtExceptionHandler :: (Exception -> IO ()) -> IO () setUncaughtExceptionHandler = writeIORef uncaughtExceptionHandler