ArrayException(..), -- instance Eq, Ord, Show, Typeable
AssertionFailed(..),
AsyncException(..), -- instance Eq, Ord, Show, Typeable
+
+#ifdef __GLASGOW_HASKELL__
NonTermination(..), nonTermination,
+ NestedAtomically(..), nestedAtomically,
+#endif
+
BlockedOnDeadMVar(..),
BlockedIndefinitely(..),
- NestedAtomically(..), nestedAtomically,
Deadlock(..),
NoMethodError(..),
PatternMatchFail(..),
-- ** The @catch@ functions
catch, -- :: IO a -> (Exception -> IO a) -> IO a
+#ifdef __GLASGOW_HASKELL__
catches, Handler(..),
- catchAny,
catchJust, -- :: (Exception -> Maybe b) -> IO a -> (b -> IO a) -> IO a
+#endif
-- ** The @handle@ functions
handle, -- :: (Exception -> IO a) -> IO a -> IO a
- handleAny,
handleJust,-- :: (Exception -> Maybe b) -> (b -> IO a) -> IO a -> IO a
-- ** The @try@ functions
try, -- :: IO a -> IO (Either Exception a)
tryJust, -- :: (Exception -> Maybe b) -> a -> IO (Either b a)
- ignoreExceptions,
onException,
-- ** The @evaluate@ function
finally, -- :: IO a -> IO b -> IO a
+#ifdef __GLASGOW_HASKELL__
recSelError, recConError, irrefutPatError, runtimeError,
nonExhaustiveGuardsError, patError, noMethodBindingError,
assertError,
+#endif
) where
#ifdef __GLASGOW_HASKELL__
import GHC.Base
import GHC.IOBase
import GHC.List
-import GHC.Num
import GHC.Show
import GHC.IOBase as ExceptionBase
import GHC.Exception hiding ( Exception )
-import GHC.Conc ( ThreadId(ThreadId) )
-import Foreign.C.String ( CString, withCString )
+import GHC.Conc
#endif
#ifdef __HUGS__
import IO (bracket)
import DIOError -- defn of IOError type
import System (ExitCode())
+import System.IO.Unsafe (unsafePerformIO)
+import Unsafe.Coerce (unsafeCoerce)
-- minimum needed for nhc98 to pretend it has Exceptions
+
+{-
data Exception = IOException IOException
| ArithException ArithException
| ArrayException ArrayException
| AsyncException AsyncException
| ExitException ExitCode
deriving Show
+-}
+class ({-Typeable e,-} Show e) => Exception e where
+ toException :: e -> SomeException
+ fromException :: SomeException -> Maybe e
+
+data SomeException = forall e . Exception e => SomeException e
+
+INSTANCE_TYPEABLE0(SomeException,someExceptionTc,"SomeException")
+
+instance Show SomeException where
+ showsPrec p (SomeException e) = showsPrec p e
+instance Exception SomeException where
+ toException se = se
+ fromException = Just
+
type IOException = IOError
+instance Exception IOError where
+ toException = SomeException
+ fromException (SomeException e) = Just (unsafeCoerce e)
+
data ArithException
data ArrayException
data AsyncException
+data AssertionFailed
+data PatternMatchFail
+data NoMethodError
+data Deadlock
+data BlockedOnDeadMVar
+data BlockedIndefinitely
+data ErrorCall
+data RecConError
+data RecSelError
+data RecUpdError
instance Show ArithException
instance Show ArrayException
instance Show AsyncException
+instance Show AssertionFailed
+instance Show PatternMatchFail
+instance Show NoMethodError
+instance Show Deadlock
+instance Show BlockedOnDeadMVar
+instance Show BlockedIndefinitely
+instance Show ErrorCall
+instance Show RecConError
+instance Show RecSelError
+instance Show RecUpdError
+
+catch :: Exception e
+ => IO a -- ^ The computation to run
+ -> (e -> IO a) -- ^ Handler to invoke if an exception is raised
+ -> IO a
+catch io h = H'98.catch io (h . fromJust . fromException . toException)
-catch :: IO a -> (Exception -> IO a) -> IO a
-a `catch` b = a `H'98.catch` (b . IOException)
+throwIO :: Exception e => e -> IO a
+throwIO = ioError . fromJust . fromException . toException
-throwIO :: Exception -> IO a
-throwIO (IOException e) = ioError e
-throwIO _ = ioError (UserError "Control.Exception.throwIO"
- "unknown exception")
-throw :: Exception -> a
+throw :: Exception e => e -> a
throw = unsafePerformIO . throwIO
evaluate :: a -> IO a
assert :: Bool -> a -> a
assert True x = x
-assert False _ = throw (IOException (UserError "" "Assertion failed"))
+assert False _ = throw (toException (UserError "" "Assertion failed"))
+
#endif
#ifndef __GLASGOW_HASKELL__
-> (e -> IO a) -- ^ Handler to invoke if an exception is raised
-> IO a
catch = ExceptionBase.catchException
+#endif
catches :: IO a -> [Handler a] -> IO a
catches io handlers = io `catch` catchesHandler handlers
Nothing -> res
data Handler a = forall e . Exception e => Handler (e -> IO a)
-#endif
-- | The function 'catchJust' is like 'catch', but it takes an extra
-- argument which is an /exception predicate/, a function which
-- selects which type of exceptions we\'re interested in.
handle :: Exception e => (e -> IO a) -> IO a -> IO a
handle = flip catch
-handleAny :: (forall e . Exception e => e -> IO a) -> IO a -> IO a
-handleAny = flip catchAny
-
-- | A version of 'catchJust' with the arguments swapped around (see
-- 'handle').
handleJust :: Exception e => (e -> Maybe b) -> (b -> IO a) -> IO a -> IO a
Nothing -> throw e
Just b -> return (Left b)
-ignoreExceptions :: IO () -> IO ()
-ignoreExceptions io = io `catchAny` \_ -> return ()
-
-onException :: IO a -> IO () -> IO a
+onException :: IO a -> IO b -> IO a
onException io what = io `catch` \e -> do what
throw (e :: SomeException)
bracket before after thing =
block (do
a <- before
- r <- catchAny
- (unblock (thing a))
- (\e -> do { after a; throw e })
+ r <- unblock (thing a) `onException` after a
after a
return r
)
-> IO a -- returns the value from the first computation
a `finally` sequel =
block (do
- r <- catchAny
- (unblock a)
- (\e -> do { sequel; throw e })
+ r <- unblock a `onException` sequel
sequel
return r
)
bracketOnError before after thing =
block (do
a <- before
- catchAny
- (unblock (thing a))
- (\e -> do { after a; throw e })
- )
+ unblock (thing a) `onException` after a
+ )
-- -----------------------------------------------------------------------------
-- Asynchronous exceptions
assert False _ = throw (AssertionFailed "")
#endif
+#ifndef __NHC__
recSelError, recConError, irrefutPatError, runtimeError,
nonExhaustiveGuardsError, patError, noMethodBindingError
:: Addr# -> a -- All take a UTF8-encoded C string
-----
-data AssertionFailed = AssertionFailed String
-INSTANCE_TYPEABLE0(AssertionFailed,assertionFailedTc,"AssertionFailed")
-
-instance Exception AssertionFailed
-
-instance Show AssertionFailed where
- showsPrec _ (AssertionFailed err) = showString err
-
------
-
data NonTermination = NonTermination
INSTANCE_TYPEABLE0(NonTermination,nonTerminationTc,"NonTermination")
instance Exception Dynamic
------
-
-assertError :: Addr# -> Bool -> a -> a
-assertError str pred v
- | pred = v
- | otherwise = throw (AssertionFailed (untangle str "Assertion failed"))
-
-{-
-(untangle coded message) expects "coded" to be of the form
- "location|details"
-It prints
- location message details
--}
-untangle :: Addr# -> String -> String
-untangle coded message
- = location
- ++ ": "
- ++ message
- ++ details
- ++ "\n"
- where
- coded_str = unpackCStringUtf8# coded
-
- (location, details)
- = case (span not_bar coded_str) of { (loc, rest) ->
- case rest of
- ('|':det) -> (loc, ' ' : det)
- _ -> (loc, "")
- }
- not_bar c = c /= '|'
-
--- XXX From GHC.Conc
-throwTo :: Exception e => ThreadId -> e -> IO ()
-throwTo (ThreadId id) ex = IO $ \ s ->
- case (killThread# id (toException ex) s) of s1 -> (# s1, () #)
+#endif
projects / ghc-base.git / blobdiff