-{-# OPTIONS_GHC -XNoImplicitPrelude #-}
+{-# LANGUAGE CPP, NoImplicitPrelude, MagicHash #-}
#include "Typeable.h"
-- * Asynchronous Exceptions
-- ** Asynchronous exception control
+ mask,
+#ifndef __NHC__
+ mask_,
+ uninterruptibleMask,
+ uninterruptibleMask_,
+ MaskingState(..),
+ getMaskingState,
+#endif
+
+ -- ** (deprecated) Asynchronous exception control
block,
unblock,
-- * Calls for GHC runtime
recSelError, recConError, irrefutPatError, runtimeError,
nonExhaustiveGuardsError, patError, noMethodBindingError,
+ absentError,
nonTermination, nestedAtomically,
#endif
) where
import GHC.Exception
import GHC.Show
-- import GHC.Exception hiding ( Exception )
-import GHC.Conc
+import GHC.Conc.Sync
#endif
#ifdef __HUGS__
assert True x = x
assert False _ = throw (toException (UserError "" "Assertion failed"))
+mask :: ((IO a-> IO a) -> IO a) -> IO a
+mask action = action restore
+ where restore act = act
+
#endif
#ifdef __HUGS__
-- Note that we have to give a type signature to @e@, or the program
-- will not typecheck as the type is ambiguous. While it is possible
-- to catch exceptions of any type, see the previous section \"Catching all
--- exceptions \" for an explanation of the problems with doing so.
+-- exceptions\" for an explanation of the problems with doing so.
--
-- For catching exceptions in pure (non-'IO') expressions, see the
-- function 'evaluate'.
-> IO a
catchJust p a handler = catch a handler'
where handler' e = case p e of
- Nothing -> throw e
+ Nothing -> throwIO e
Just b -> handler b
-- | A version of 'catch' with the arguments swapped around; useful in
mapException :: (Exception e1, Exception e2) => (e1 -> e2) -> a -> a
mapException f v = unsafePerformIO (catch (evaluate v)
- (\x -> throw (f x)))
+ (\x -> throwIO (f x)))
-----------------------------------------------------------------------------
-- 'try' and variations.
case r of
Right v -> return (Right v)
Left e -> case p e of
- Nothing -> throw e
+ Nothing -> throwIO e
Just b -> return (Left b)
-- | Like 'finally', but only performs the final action if there was an
-- exception raised by the computation.
onException :: IO a -> IO b -> IO a
onException io what = io `catch` \e -> do _ <- what
- throw (e :: SomeException)
+ throwIO (e :: SomeException)
-----------------------------------------------------------------------------
-- Some Useful Functions
-> (a -> IO c) -- ^ computation to run in-between
-> IO c -- returns the value from the in-between computation
bracket before after thing =
- block (do
+ mask $ \restore -> do
a <- before
- r <- unblock (thing a) `onException` after a
+ r <- restore (thing a) `onException` after a
_ <- after a
return r
- )
#endif
-- | A specialised variant of 'bracket' with just a computation to run
-- was raised)
-> IO a -- returns the value from the first computation
a `finally` sequel =
- block (do
- r <- unblock a `onException` sequel
+ mask $ \restore -> do
+ r <- restore a `onException` sequel
_ <- sequel
return r
- )
-- | A variant of 'bracket' where the return value from the first computation
-- is not required.
-> (a -> IO c) -- ^ computation to run in-between
-> IO c -- returns the value from the in-between computation
bracketOnError before after thing =
- block (do
+ mask $ \restore -> do
a <- before
- unblock (thing a) `onException` after a
- )
+ restore (thing a) `onException` after a
#if !(__GLASGOW_HASKELL__ || __NHC__)
assert :: Bool -> a -> a
#ifdef __GLASGOW_HASKELL__
recSelError, recConError, irrefutPatError, runtimeError,
- nonExhaustiveGuardsError, patError, noMethodBindingError
+ nonExhaustiveGuardsError, patError, noMethodBindingError,
+ absentError
:: Addr# -> a -- All take a UTF8-encoded C string
recSelError s = throw (RecSelError ("No match in record selector "
++ unpackCStringUtf8# s)) -- No location info unfortunately
runtimeError s = error (unpackCStringUtf8# s) -- No location info unfortunately
+absentError s = error ("Oops! Entered absent arg " ++ unpackCStringUtf8# s)
nonExhaustiveGuardsError s = throw (PatternMatchFail (untangle s "Non-exhaustive guards in"))
irrefutPatError s = throw (PatternMatchFail (untangle s "Irrefutable pattern failed for pattern"))