Hugs now uses most of Control.Exception.
import Hugs.ConcBase ( MVar, newEmptyMVar, newMVar, takeMVar, putMVar,
tryTakeMVar, tryPutMVar, isEmptyMVar,
)
import Hugs.ConcBase ( MVar, newEmptyMVar, newMVar, takeMVar, putMVar,
tryTakeMVar, tryPutMVar, isEmptyMVar,
)
-import Hugs.Exception ( throwIO )
#endif
#ifdef __GLASGOW_HASKELL__
#endif
#ifdef __GLASGOW_HASKELL__
import Prelude
import Control.Exception as Exception
import Prelude
import Control.Exception as Exception
-#ifdef __HUGS__
--- This is as close as Hugs gets to providing throw
-throw :: Exception -> IO a
-throw = throwIO
-#endif
-
{-|
This is a combination of 'takeMVar' and 'putMVar'; ie. it takes the value
from the 'MVar', puts it back, and also returns it.
{-|
This is a combination of 'takeMVar' and 'putMVar'; ie. it takes the value
from the 'MVar', puts it back, and also returns it.
-- * The Exception type
Exception(..), -- instance Eq, Ord, Show, Typeable
-- * The Exception type
Exception(..), -- instance Eq, Ord, Show, Typeable
-#ifdef __GLASGOW_HASKELL__
IOException, -- instance Eq, Ord, Show, Typeable
ArithException(..), -- instance Eq, Ord, Show, Typeable
ArrayException(..), -- instance Eq, Ord, Show, Typeable
AsyncException(..), -- instance Eq, Ord, Show, Typeable
IOException, -- instance Eq, Ord, Show, Typeable
ArithException(..), -- instance Eq, Ord, Show, Typeable
ArrayException(..), -- instance Eq, Ord, Show, Typeable
AsyncException(..), -- instance Eq, Ord, Show, Typeable
-- * Throwing exceptions
throwIO, -- :: Exception -> IO a
-- * Throwing exceptions
throwIO, -- :: Exception -> IO a
throw, -- :: Exception -> a
throw, -- :: Exception -> a
ioError, -- :: IOError -> IO a
ioError, -- :: IOError -> IO a
+#ifdef __GLASGOW_HASKELL__
throwTo, -- :: ThreadId -> Exception -> a
#endif
throwTo, -- :: ThreadId -> Exception -> a
#endif
-- $preds
ioErrors, -- :: Exception -> Maybe IOError
-- $preds
ioErrors, -- :: Exception -> Maybe IOError
arithExceptions, -- :: Exception -> Maybe ArithException
errorCalls, -- :: Exception -> Maybe String
dynExceptions, -- :: Exception -> Maybe Dynamic
assertions, -- :: Exception -> Maybe String
asyncExceptions, -- :: Exception -> Maybe AsyncException
arithExceptions, -- :: Exception -> Maybe ArithException
errorCalls, -- :: Exception -> Maybe String
dynExceptions, -- :: Exception -> Maybe Dynamic
assertions, -- :: Exception -> Maybe String
asyncExceptions, -- :: Exception -> Maybe AsyncException
userErrors, -- :: Exception -> Maybe String
userErrors, -- :: Exception -> Maybe String
-#ifdef __GLASGOW_HASKELL__
-- * Dynamic exceptions
-- $dynamic
throwDyn, -- :: Typeable ex => ex -> b
-- * Dynamic exceptions
-- $dynamic
throwDyn, -- :: Typeable ex => ex -> b
+#ifdef __GLASGOW_HASKELL__
throwDynTo, -- :: Typeable ex => ThreadId -> ex -> b
throwDynTo, -- :: Typeable ex => ThreadId -> ex -> b
- catchDyn, -- :: Typeable ex => IO a -> (ex -> IO a) -> IO a
+ catchDyn, -- :: Typeable ex => IO a -> (ex -> IO a) -> IO a
-- * Asynchronous Exceptions
-- * Asynchronous Exceptions
#include "Dynamic.h"
INSTANCE_TYPEABLE0(Exception,exceptionTc,"Exception")
#include "Dynamic.h"
INSTANCE_TYPEABLE0(Exception,exceptionTc,"Exception")
-#ifdef __GLASGOW_HASKELL__
INSTANCE_TYPEABLE0(IOException,ioExceptionTc,"IOException")
INSTANCE_TYPEABLE0(ArithException,arithExceptionTc,"ArithException")
INSTANCE_TYPEABLE0(ArrayException,arrayExceptionTc,"ArrayException")
INSTANCE_TYPEABLE0(AsyncException,asyncExceptionTc,"AsyncException")
INSTANCE_TYPEABLE0(IOException,ioExceptionTc,"IOException")
INSTANCE_TYPEABLE0(ArithException,arithExceptionTc,"ArithException")
INSTANCE_TYPEABLE0(ArrayException,arrayExceptionTc,"ArrayException")
INSTANCE_TYPEABLE0(AsyncException,asyncExceptionTc,"AsyncException")
-#endif
-
-#ifdef __HUGS__
--- This is as close as Hugs gets to providing throw
-throw :: Exception -> IO a
-throw = throwIO
-#endif
-----------------------------------------------------------------------------
-- Catching exceptions
-----------------------------------------------------------------------------
-- Catching exceptions
Nothing -> throw e
Just b -> return (Left b)
Nothing -> throw e
Just b -> return (Left b)
-#ifdef __GLASGOW_HASKELL__
-----------------------------------------------------------------------------
-- Dynamic exceptions
-----------------------------------------------------------------------------
-- Dynamic exceptions
throwDyn :: Typeable exception => exception -> b
throwDyn exception = throw (DynException (toDyn exception))
throwDyn :: Typeable exception => exception -> b
throwDyn exception = throw (DynException (toDyn exception))
+#ifdef __GLASGOW_HASKELL__
-- | A variant of 'throwDyn' that throws the dynamic exception to an
-- arbitrary thread (c.f. 'throwTo').
throwDynTo :: Typeable exception => ThreadId -> exception -> IO ()
throwDynTo t exception = throwTo t (DynException (toDyn exception))
-- | A variant of 'throwDyn' that throws the dynamic exception to an
-- arbitrary thread (c.f. 'throwTo').
throwDynTo :: Typeable exception => ThreadId -> exception -> IO ()
throwDynTo t exception = throwTo t (DynException (toDyn exception))
+#endif /* __GLASGOW_HASKELL__ */
-- | Catch dynamic exceptions of the required type. All other
-- exceptions are re-thrown, including dynamic exceptions of the wrong
-- | Catch dynamic exceptions of the required type. All other
-- exceptions are re-thrown, including dynamic exceptions of the wrong
Just exception -> k exception
Nothing -> throw ex
_ -> throw ex
Just exception -> k exception
Nothing -> throw ex
_ -> throw ex
-#endif /* __GLASGOW_HASKELL__ */
-----------------------------------------------------------------------------
-- Exception Predicates
-----------------------------------------------------------------------------
-- Exception Predicates
-- 'catchJust', 'tryJust', or 'handleJust' to select certain common
-- classes of exceptions.
-- 'catchJust', 'tryJust', or 'handleJust' to select certain common
-- classes of exceptions.
-#ifdef __GLASGOW_HASKELL__
ioErrors :: Exception -> Maybe IOError
arithExceptions :: Exception -> Maybe ArithException
errorCalls :: Exception -> Maybe String
ioErrors :: Exception -> Maybe IOError
arithExceptions :: Exception -> Maybe ArithException
errorCalls :: Exception -> Maybe String
-dynExceptions :: Exception -> Maybe Dynamic
assertions :: Exception -> Maybe String
assertions :: Exception -> Maybe String
+dynExceptions :: Exception -> Maybe Dynamic
asyncExceptions :: Exception -> Maybe AsyncException
userErrors :: Exception -> Maybe String
asyncExceptions :: Exception -> Maybe AsyncException
userErrors :: Exception -> Maybe String
-#endif /* __GLASGOW_HASKELL__ */
-#ifdef __GLASGOW_HASKELL__
ioErrors (IOException e) = Just e
ioErrors _ = Nothing
ioErrors (IOException e) = Just e
ioErrors _ = Nothing
userErrors (IOException e) | isUserError e = Just (ioeGetErrorString e)
userErrors _ = Nothing
userErrors (IOException e) | isUserError e = Just (ioeGetErrorString e)
userErrors _ = Nothing
-#endif /* __GLASGOW_HASKELL__ */
-----------------------------------------------------------------------------
-- Some Useful Functions
-----------------------------------------------------------------------------
-- Some Useful Functions
#ifndef __GLASGOW_HASKELL__
assert :: Bool -> a -> a
assert True x = x
#ifndef __GLASGOW_HASKELL__
assert :: Bool -> a -> a
assert True x = x
-assert False _ = error "Assertion failure"
+assert False _ = throw (AssertionFailed "")
import Hugs.IO
import Hugs.IORef
import Hugs.IOExts
import Hugs.IO
import Hugs.IORef
import Hugs.IOExts
'Show'ing a value of type 'Dynamic' returns a pretty-printed representation
of the object\'s type; useful for debugging.
-}
'Show'ing a value of type 'Dynamic' returns a pretty-printed representation
of the object\'s type; useful for debugging.
-}
data Dynamic = Dynamic TypeRep Obj
data Dynamic = Dynamic TypeRep Obj
instance Show Dynamic where
-- the instance just prints the type representation.
instance Show Dynamic where
-- the instance just prints the type representation.
-- the other hand, if we use a polymorphic type, GHC will use
-- a fallback convention for evaluating it that works for all types.
-- (using a function type here would also work).
-- the other hand, if we use a polymorphic type, GHC will use
-- a fallback convention for evaluating it that works for all types.
-- (using a function type here would also work).
+#elif !defined(__HUGS__)
data Obj = Obj
#endif
-- | A concrete representation of a (monomorphic) type. 'TypeRep'
-- supports reasonably efficient equality.
data Obj = Obj
#endif
-- | A concrete representation of a (monomorphic) type. 'TypeRep'
-- supports reasonably efficient equality.
data TypeRep
= App TyCon [TypeRep]
| Fun TypeRep TypeRep
deriving ( Eq )
data TypeRep
= App TyCon [TypeRep]
| Fun TypeRep TypeRep
deriving ( Eq )
instance Show TypeRep where
showsPrec p (App tycon tys) =
instance Show TypeRep where
showsPrec p (App tycon tys) =
-- | An abstract representation of a type constructor. 'TyCon' objects can
-- be built using 'mkTyCon'.
-- | An abstract representation of a type constructor. 'TyCon' objects can
-- be built using 'mkTyCon'.
data TyCon = TyCon Int String
instance Eq TyCon where
(TyCon t1 _) == (TyCon t2 _) = t1 == t2
data TyCon = TyCon Int String
instance Eq TyCon where
(TyCon t1 _) == (TyCon t2 _) = t1 == t2
instance Show TyCon where
showsPrec _ (TyCon _ s) = showString s
instance Show TyCon where
showsPrec _ (TyCon _ s) = showString s
-- program's caller. Before it terminates, any open or semi-closed
-- handles are first closed.
-- program's caller. Before it terminates, any open or semi-closed
-- handles are first closed.
-#ifdef __GLASGOW_HASKELL__
exitWith :: ExitCode -> IO a
exitWith ExitSuccess = throw (ExitException ExitSuccess)
exitWith :: ExitCode -> IO a
exitWith ExitSuccess = throw (ExitException ExitSuccess)
-exitWith code@(ExitFailure n)
- | n == 0 = ioException (IOError Nothing InvalidArgument "exitWith" "ExitFailure 0" Nothing)
- | otherwise = throw (ExitException code)
-#endif /* __GLASGOW_HASKELL__ */
+exitWith code@(ExitFailure n)
+ | n /= 0 = throw (ExitException code)
+#ifdef __GLASGOW_HASKELL__
+ | otherwise = ioError (IOError Nothing InvalidArgument "exitWith" "ExitFailure 0" Nothing)
+#endif
+#endif /* ! __NHC__ */
exitFailure :: IO a
exitFailure = exitWith (ExitFailure 1)
exitFailure :: IO a
exitFailure = exitWith (ExitFailure 1)