Control/Exception/Base.hs

   1 {-# LANGUAGE CPP, NoImplicitPrelude, MagicHash #-}
   2 #ifdef __GLASGOW_HASKELL__
   3 {-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}
   4 #endif
   5
   6 #include "Typeable.h"
   7
   8 -----------------------------------------------------------------------------
   9 -- |
  10 -- Module      :  Control.Exception.Base
  11 -- Copyright   :  (c) The University of Glasgow 2001
  12 -- License     :  BSD-style (see the file libraries/base/LICENSE)
  13 --
  14 -- Maintainer  :  libraries@haskell.org
  15 -- Stability   :  experimental
  16 -- Portability :  non-portable (extended exceptions)
  17 --
  18 -- Extensible exceptions, except for multiple handlers.
  19 --
  20 -----------------------------------------------------------------------------
  21
  22 module Control.Exception.Base (
  23
  24         -- * The Exception type
  25 #ifdef __HUGS__
  26         SomeException,
  27 #else
  28         SomeException(..),
  29 #endif
  30         Exception(..),
  31         IOException,
  32         ArithException(..),
  33         ArrayException(..),
  34         AssertionFailed(..),
  35         AsyncException(..),
  36
  37 #if __GLASGOW_HASKELL__ || __HUGS__
  38         NonTermination(..),
  39         NestedAtomically(..),
  40 #endif
  41
  42         BlockedIndefinitelyOnMVar(..),
  43         BlockedIndefinitelyOnSTM(..),
  44         Deadlock(..),
  45         NoMethodError(..),
  46         PatternMatchFail(..),
  47         RecConError(..),
  48         RecSelError(..),
  49         RecUpdError(..),
  50         ErrorCall(..),
  51
  52         -- * Throwing exceptions
  53         throwIO,
  54         throw,
  55         ioError,
  56 #ifdef __GLASGOW_HASKELL__
  57         throwTo,
  58 #endif
  59
  60         -- * Catching Exceptions
  61
  62         -- ** The @catch@ functions
  63         catch,
  64         catchJust,
  65
  66         -- ** The @handle@ functions
  67         handle,
  68         handleJust,
  69
  70         -- ** The @try@ functions
  71         try,
  72         tryJust,
  73         onException,
  74
  75         -- ** The @evaluate@ function
  76         evaluate,
  77
  78         -- ** The @mapException@ function
  79         mapException,
  80
  81         -- * Asynchronous Exceptions
  82
  83         -- ** Asynchronous exception control
  84         mask,
  85 #ifndef __NHC__
  86         mask_,
  87         uninterruptibleMask,
  88         uninterruptibleMask_,
  89         MaskingState(..),
  90         getMaskingState,
  91 #endif
  92
  93         -- ** (deprecated) Asynchronous exception control
  94
  95         block,
  96         unblock,
  97         blocked,
  98
  99         -- * Assertions
 100
 101         assert,
 102
 103         -- * Utilities
 104
 105         bracket,
 106         bracket_,
 107         bracketOnError,
 108
 109         finally,
 110
 111 #ifdef __GLASGOW_HASKELL__
 112         -- * Calls for GHC runtime
 113         recSelError, recConError, irrefutPatError, runtimeError,
 114         nonExhaustiveGuardsError, patError, noMethodBindingError,
 115         absentError,
 116         nonTermination, nestedAtomically,
 117 #endif
 118   ) where
 119
 120 #ifdef __GLASGOW_HASKELL__
 121 import GHC.Base
 122 import GHC.IO hiding (finally,onException)
 123 import GHC.IO.Exception
 124 import GHC.Exception
 125 import GHC.Show
 126 -- import GHC.Exception hiding ( Exception )
 127 import GHC.Conc.Sync
 128 #endif
 129
 130 #ifdef __HUGS__
 131 import Prelude hiding (catch)
 132 import Hugs.Prelude (ExitCode(..))
 133 import Hugs.IOExts (unsafePerformIO)
 134 import Hugs.Exception (SomeException(DynamicException, IOException,
 135                                      ArithException, ArrayException, ExitException),
 136                        evaluate, IOException, ArithException, ArrayException)
 137 import qualified Hugs.Exception
 138 #endif
 139
 140 import Data.Dynamic
 141 import Data.Either
 142 import Data.Maybe
 143
 144 #ifdef __NHC__
 145 import qualified IO as H'98 (catch)
 146 import IO              (bracket,ioError)
 147 import DIOError         -- defn of IOError type
 148 import System          (ExitCode())
 149 import System.IO.Unsafe (unsafePerformIO)
 150 import Unsafe.Coerce    (unsafeCoerce)
 151
 152 -- minimum needed for nhc98 to pretend it has Exceptions
 153
 154 {-
 155 data Exception   = IOException    IOException
 156                  | ArithException ArithException
 157                  | ArrayException ArrayException
 158                  | AsyncException AsyncException
 159                  | ExitException  ExitCode
 160                  deriving Show
 161 -}
 162 class ({-Typeable e,-} Show e) => Exception e where
 163     toException   :: e -> SomeException
 164     fromException :: SomeException -> Maybe e
 165
 166 data SomeException = forall e . Exception e => SomeException e
 167
 168 INSTANCE_TYPEABLE0(SomeException,someExceptionTc,"SomeException")
 169
 170 instance Show SomeException where
 171     showsPrec p (SomeException e) = showsPrec p e
 172 instance Exception SomeException where
 173     toException se = se
 174     fromException = Just
 175
 176 type IOException = IOError
 177 instance Exception IOError where
 178     toException                     = SomeException
 179     fromException (SomeException e) = Just (unsafeCoerce e)
 180
 181 instance Exception ExitCode where
 182     toException                     = SomeException
 183     fromException (SomeException e) = Just (unsafeCoerce e)
 184
 185 data ArithException
 186 data ArrayException
 187 data AsyncException
 188 data AssertionFailed
 189 data PatternMatchFail
 190 data NoMethodError
 191 data Deadlock
 192 data BlockedIndefinitelyOnMVar
 193 data BlockedIndefinitelyOnSTM
 194 data ErrorCall
 195 data RecConError
 196 data RecSelError
 197 data RecUpdError
 198 instance Show ArithException
 199 instance Show ArrayException
 200 instance Show AsyncException
 201 instance Show AssertionFailed
 202 instance Show PatternMatchFail
 203 instance Show NoMethodError
 204 instance Show Deadlock
 205 instance Show BlockedIndefinitelyOnMVar
 206 instance Show BlockedIndefinitelyOnSTM
 207 instance Show ErrorCall
 208 instance Show RecConError
 209 instance Show RecSelError
 210 instance Show RecUpdError
 211
 212 catch   :: Exception e
 213         => IO a         -- ^ The computation to run
 214         -> (e -> IO a)  -- ^ Handler to invoke if an exception is raised
 215         -> IO a
 216 catch io h = H'98.catch  io  (h . fromJust . fromException . toException)
 217
 218 throwIO  :: Exception e => e -> IO a
 219 throwIO   = ioError . fromJust . fromException . toException
 220
 221 throw    :: Exception e => e -> a
 222 throw     = unsafePerformIO . throwIO
 223
 224 evaluate :: a -> IO a
 225 evaluate x = x `seq` return x
 226
 227 assert :: Bool -> a -> a
 228 assert True  x = x
 229 assert False _ = throw (toException (UserError "" "Assertion failed"))
 230
 231 mask   :: ((IO a-> IO a) -> IO a) -> IO a
 232 mask action = action restore
 233     where restore act = act
 234
 235 #endif
 236
 237 #ifdef __HUGS__
 238 class (Typeable e, Show e) => Exception e where
 239     toException   :: e -> SomeException
 240     fromException :: SomeException -> Maybe e
 241
 242     toException e = DynamicException (toDyn e) (flip showsPrec e)
 243     fromException (DynamicException dyn _) = fromDynamic dyn
 244     fromException _ = Nothing
 245
 246 INSTANCE_TYPEABLE0(SomeException,someExceptionTc,"SomeException")
 247 INSTANCE_TYPEABLE0(IOException,iOExceptionTc,"IOException")
 248 INSTANCE_TYPEABLE0(ArithException,arithExceptionTc,"ArithException")
 249 INSTANCE_TYPEABLE0(ArrayException,arrayExceptionTc,"ArrayException")
 250 INSTANCE_TYPEABLE0(ExitCode,exitCodeTc,"ExitCode")
 251 INSTANCE_TYPEABLE0(ErrorCall,errorCallTc,"ErrorCall")
 252 INSTANCE_TYPEABLE0(AssertionFailed,assertionFailedTc,"AssertionFailed")
 253 INSTANCE_TYPEABLE0(AsyncException,asyncExceptionTc,"AsyncException")
 254 INSTANCE_TYPEABLE0(BlockedIndefinitelyOnMVar,blockedIndefinitelyOnMVarTc,"BlockedIndefinitelyOnMVar")
 255 INSTANCE_TYPEABLE0(BlockedIndefinitelyOnSTM,blockedIndefinitelyOnSTM,"BlockedIndefinitelyOnSTM")
 256 INSTANCE_TYPEABLE0(Deadlock,deadlockTc,"Deadlock")
 257
 258 instance Exception SomeException where
 259     toException se = se
 260     fromException = Just
 261
 262 instance Exception IOException where
 263     toException = IOException
 264     fromException (IOException e) = Just e
 265     fromException _ = Nothing
 266
 267 instance Exception ArrayException where
 268     toException = ArrayException
 269     fromException (ArrayException e) = Just e
 270     fromException _ = Nothing
 271
 272 instance Exception ArithException where
 273     toException = ArithException
 274     fromException (ArithException e) = Just e
 275     fromException _ = Nothing
 276
 277 instance Exception ExitCode where
 278     toException = ExitException
 279     fromException (ExitException e) = Just e
 280     fromException _ = Nothing
 281
 282 data ErrorCall = ErrorCall String
 283
 284 instance Show ErrorCall where
 285     showsPrec _ (ErrorCall err) = showString err
 286
 287 instance Exception ErrorCall where
 288     toException (ErrorCall s) = Hugs.Exception.ErrorCall s
 289     fromException (Hugs.Exception.ErrorCall s) = Just (ErrorCall s)
 290     fromException _ = Nothing
 291
 292 data BlockedIndefinitelyOnMVar = BlockedIndefinitelyOnMVar
 293 data BlockedIndefinitelyOnSTM = BlockedIndefinitelyOnSTM
 294 data Deadlock = Deadlock
 295 data AssertionFailed = AssertionFailed String
 296 data AsyncException
 297   = StackOverflow
 298   | HeapOverflow
 299   | ThreadKilled
 300   | UserInterrupt
 301   deriving (Eq, Ord)
 302
 303 instance Show BlockedIndefinitelyOnMVar where
 304     showsPrec _ BlockedIndefinitelyOnMVar = showString "thread blocked indefinitely"
 305
 306 instance Show BlockedIndefinitely where
 307     showsPrec _ BlockedIndefinitely = showString "thread blocked indefinitely"
 308
 309 instance Show Deadlock where
 310     showsPrec _ Deadlock = showString "<<deadlock>>"
 311
 312 instance Show AssertionFailed where
 313     showsPrec _ (AssertionFailed err) = showString err
 314
 315 instance Show AsyncException where
 316     showsPrec _ StackOverflow   = showString "stack overflow"
 317     showsPrec _ HeapOverflow    = showString "heap overflow"
 318     showsPrec _ ThreadKilled    = showString "thread killed"
 319     showsPrec _ UserInterrupt   = showString "user interrupt"
 320
 321 instance Exception BlockedOnDeadMVar
 322 instance Exception BlockedIndefinitely
 323 instance Exception Deadlock
 324 instance Exception AssertionFailed
 325 instance Exception AsyncException
 326
 327 throw :: Exception e => e -> a
 328 throw e = Hugs.Exception.throw (toException e)
 329
 330 throwIO :: Exception e => e -> IO a
 331 throwIO e = Hugs.Exception.throwIO (toException e)
 332 #endif
 333
 334 #ifndef __GLASGOW_HASKELL__
 335 -- Dummy definitions for implementations lacking asynchonous exceptions
 336
 337 block   :: IO a -> IO a
 338 block    = id
 339 unblock :: IO a -> IO a
 340 unblock  = id
 341 blocked :: IO Bool
 342 blocked  = return False
 343 #endif
 344
 345 -----------------------------------------------------------------------------
 346 -- Catching exceptions
 347
 348 -- |This is the simplest of the exception-catching functions.  It
 349 -- takes a single argument, runs it, and if an exception is raised
 350 -- the \"handler\" is executed, with the value of the exception passed as an
 351 -- argument.  Otherwise, the result is returned as normal.  For example:
 352 --
 353 -- >   catch (readFile f)
 354 -- >         (\e -> do let err = show (e :: IOException)
 355 -- >                   hPutStr stderr ("Warning: Couldn't open " ++ f ++ ": " ++ err)
 356 -- >                   return "")
 357 --
 358 -- Note that we have to give a type signature to @e@, or the program
 359 -- will not typecheck as the type is ambiguous. While it is possible
 360 -- to catch exceptions of any type, see the previous section \"Catching all
 361 -- exceptions\" for an explanation of the problems with doing so.
 362 --
 363 -- For catching exceptions in pure (non-'IO') expressions, see the
 364 -- function 'evaluate'.
 365 --
 366 -- Note that due to Haskell\'s unspecified evaluation order, an
 367 -- expression may throw one of several possible exceptions: consider
 368 -- the expression @(error \"urk\") + (1 \`div\` 0)@.  Does
 369 -- the expression throw
 370 -- @ErrorCall \"urk\"@, or @DivideByZero@?
 371 --
 372 -- The answer is \"it might throw either\"; the choice is
 373 -- non-deterministic. If you are catching any type of exception then you
 374 -- might catch either. If you are calling @catch@ with type
 375 -- @IO Int -> (ArithException -> IO Int) -> IO Int@ then the handler may
 376 -- get run with @DivideByZero@ as an argument, or an @ErrorCall \"urk\"@
 377 -- exception may be propogated further up. If you call it again, you
 378 -- might get a the opposite behaviour. This is ok, because 'catch' is an
 379 -- 'IO' computation.
 380 --
 381 -- Note that the "Prelude" also exports a function called
 382 -- 'Prelude.catch' with a similar type to 'Control.Exception.catch',
 383 -- except that the "Prelude" version only catches the IO and user
 384 -- families of exceptions (as required by Haskell 98).
 385 --
 386 -- We recommend either hiding the "Prelude" version of 'Prelude.catch'
 387 -- when importing "Control.Exception":
 388 --
 389 -- > import Prelude hiding (catch)
 390 --
 391 -- or importing "Control.Exception" qualified, to avoid name-clashes:
 392 --
 393 -- > import qualified Control.Exception as C
 394 --
 395 -- and then using @C.catch@
 396 --
 397 #ifndef __NHC__
 398 catch   :: Exception e
 399         => IO a         -- ^ The computation to run
 400         -> (e -> IO a)  -- ^ Handler to invoke if an exception is raised
 401         -> IO a
 402 #if __GLASGOW_HASKELL__
 403 catch = GHC.IO.catchException
 404 #elif __HUGS__
 405 catch m h = Hugs.Exception.catchException m h'
 406   where h' e = case fromException e of
 407             Just e' -> h e'
 408             Nothing -> throwIO e
 409 #endif
 410 #endif
 411
 412 -- | The function 'catchJust' is like 'catch', but it takes an extra
 413 -- argument which is an /exception predicate/, a function which
 414 -- selects which type of exceptions we\'re interested in.
 415 --
 416 -- > catchJust (\e -> if isDoesNotExistErrorType (ioeGetErrorType e) then Just () else Nothing)
 417 -- >           (readFile f)
 418 -- >           (\_ -> do hPutStrLn stderr ("No such file: " ++ show f)
 419 -- >                     return "")
 420 --
 421 -- Any other exceptions which are not matched by the predicate
 422 -- are re-raised, and may be caught by an enclosing
 423 -- 'catch', 'catchJust', etc.
 424 catchJust
 425         :: Exception e
 426         => (e -> Maybe b)         -- ^ Predicate to select exceptions
 427         -> IO a                   -- ^ Computation to run
 428         -> (b -> IO a)            -- ^ Handler
 429         -> IO a
 430 catchJust p a handler = catch a handler'
 431   where handler' e = case p e of
 432                         Nothing -> throwIO e
 433                         Just b  -> handler b
 434
 435 -- | A version of 'catch' with the arguments swapped around; useful in
 436 -- situations where the code for the handler is shorter.  For example:
 437 --
 438 -- >   do handle (\NonTermination -> exitWith (ExitFailure 1)) $
 439 -- >      ...
 440 handle     :: Exception e => (e -> IO a) -> IO a -> IO a
 441 handle     =  flip catch
 442
 443 -- | A version of 'catchJust' with the arguments swapped around (see
 444 -- 'handle').
 445 handleJust :: Exception e => (e -> Maybe b) -> (b -> IO a) -> IO a -> IO a
 446 handleJust p =  flip (catchJust p)
 447
 448 -----------------------------------------------------------------------------
 449 -- 'mapException'
 450
 451 -- | This function maps one exception into another as proposed in the
 452 -- paper \"A semantics for imprecise exceptions\".
 453
 454 -- Notice that the usage of 'unsafePerformIO' is safe here.
 455
 456 mapException :: (Exception e1, Exception e2) => (e1 -> e2) -> a -> a
 457 mapException f v = unsafePerformIO (catch (evaluate v)
 458                                           (\x -> throwIO (f x)))
 459
 460 -----------------------------------------------------------------------------
 461 -- 'try' and variations.
 462
 463 -- | Similar to 'catch', but returns an 'Either' result which is
 464 -- @('Right' a)@ if no exception of type @e@ was raised, or @('Left' ex)@
 465 -- if an exception of type @e@ was raised and its value is @ex@.
 466 -- If any other type of exception is raised than it will be propogated
 467 -- up to the next enclosing exception handler.
 468 --
 469 -- >  try a = catch (Right `liftM` a) (return . Left)
 470 --
 471 -- Note that "System.IO.Error" also exports a function called
 472 -- 'System.IO.Error.try' with a similar type to 'Control.Exception.try',
 473 -- except that it catches only the IO and user families of exceptions
 474 -- (as required by the Haskell 98 @IO@ module).
 475
 476 try :: Exception e => IO a -> IO (Either e a)
 477 try a = catch (a >>= \ v -> return (Right v)) (\e -> return (Left e))
 478
 479 -- | A variant of 'try' that takes an exception predicate to select
 480 -- which exceptions are caught (c.f. 'catchJust').  If the exception
 481 -- does not match the predicate, it is re-thrown.
 482 tryJust :: Exception e => (e -> Maybe b) -> IO a -> IO (Either b a)
 483 tryJust p a = do
 484   r <- try a
 485   case r of
 486         Right v -> return (Right v)
 487         Left  e -> case p e of
 488                         Nothing -> throwIO e
 489                         Just b  -> return (Left b)
 490
 491 -- | Like 'finally', but only performs the final action if there was an
 492 -- exception raised by the computation.
 493 onException :: IO a -> IO b -> IO a
 494 onException io what = io `catch` \e -> do _ <- what
 495                                           throwIO (e :: SomeException)
 496
 497 -----------------------------------------------------------------------------
 498 -- Some Useful Functions
 499
 500 -- | When you want to acquire a resource, do some work with it, and
 501 -- then release the resource, it is a good idea to use 'bracket',
 502 -- because 'bracket' will install the necessary exception handler to
 503 -- release the resource in the event that an exception is raised
 504 -- during the computation.  If an exception is raised, then 'bracket' will
 505 -- re-raise the exception (after performing the release).
 506 --
 507 -- A common example is opening a file:
 508 --
 509 -- > bracket
 510 -- >   (openFile "filename" ReadMode)
 511 -- >   (hClose)
 512 -- >   (\fileHandle -> do { ... })
 513 --
 514 -- The arguments to 'bracket' are in this order so that we can partially apply
 515 -- it, e.g.:
 516 --
 517 -- > withFile name mode = bracket (openFile name mode) hClose
 518 --
 519 #ifndef __NHC__
 520 bracket
 521         :: IO a         -- ^ computation to run first (\"acquire resource\")
 522         -> (a -> IO b)  -- ^ computation to run last (\"release resource\")
 523         -> (a -> IO c)  -- ^ computation to run in-between
 524         -> IO c         -- returns the value from the in-between computation
 525 bracket before after thing =
 526   mask $ \restore -> do
 527     a <- before
 528     r <- restore (thing a) `onException` after a
 529     _ <- after a
 530     return r
 531 #endif
 532
 533 -- | A specialised variant of 'bracket' with just a computation to run
 534 -- afterward.
 535 --
 536 finally :: IO a         -- ^ computation to run first
 537         -> IO b         -- ^ computation to run afterward (even if an exception
 538                         -- was raised)
 539         -> IO a         -- returns the value from the first computation
 540 a `finally` sequel =
 541   mask $ \restore -> do
 542     r <- restore a `onException` sequel
 543     _ <- sequel
 544     return r
 545
 546 -- | A variant of 'bracket' where the return value from the first computation
 547 -- is not required.
 548 bracket_ :: IO a -> IO b -> IO c -> IO c
 549 bracket_ before after thing = bracket before (const after) (const thing)
 550
 551 -- | Like 'bracket', but only performs the final action if there was an
 552 -- exception raised by the in-between computation.
 553 bracketOnError
 554         :: IO a         -- ^ computation to run first (\"acquire resource\")
 555         -> (a -> IO b)  -- ^ computation to run last (\"release resource\")
 556         -> (a -> IO c)  -- ^ computation to run in-between
 557         -> IO c         -- returns the value from the in-between computation
 558 bracketOnError before after thing =
 559   mask $ \restore -> do
 560     a <- before
 561     restore (thing a) `onException` after a
 562
 563 #if !(__GLASGOW_HASKELL__ || __NHC__)
 564 assert :: Bool -> a -> a
 565 assert True x = x
 566 assert False _ = throw (AssertionFailed "")
 567 #endif
 568
 569 -----
 570
 571 #if __GLASGOW_HASKELL__ || __HUGS__
 572 -- |A pattern match failed. The @String@ gives information about the
 573 -- source location of the pattern.
 574 data PatternMatchFail = PatternMatchFail String
 575 INSTANCE_TYPEABLE0(PatternMatchFail,patternMatchFailTc,"PatternMatchFail")
 576
 577 instance Show PatternMatchFail where
 578     showsPrec _ (PatternMatchFail err) = showString err
 579
 580 #ifdef __HUGS__
 581 instance Exception PatternMatchFail where
 582     toException (PatternMatchFail err) = Hugs.Exception.PatternMatchFail err
 583     fromException (Hugs.Exception.PatternMatchFail err) = Just (PatternMatchFail err)
 584     fromException _ = Nothing
 585 #else
 586 instance Exception PatternMatchFail
 587 #endif
 588
 589 -----
 590
 591 -- |A record selector was applied to a constructor without the
 592 -- appropriate field. This can only happen with a datatype with
 593 -- multiple constructors, where some fields are in one constructor
 594 -- but not another. The @String@ gives information about the source
 595 -- location of the record selector.
 596 data RecSelError = RecSelError String
 597 INSTANCE_TYPEABLE0(RecSelError,recSelErrorTc,"RecSelError")
 598
 599 instance Show RecSelError where
 600     showsPrec _ (RecSelError err) = showString err
 601
 602 #ifdef __HUGS__
 603 instance Exception RecSelError where
 604     toException (RecSelError err) = Hugs.Exception.RecSelError err
 605     fromException (Hugs.Exception.RecSelError err) = Just (RecSelError err)
 606     fromException _ = Nothing
 607 #else
 608 instance Exception RecSelError
 609 #endif
 610
 611 -----
 612
 613 -- |An uninitialised record field was used. The @String@ gives
 614 -- information about the source location where the record was
 615 -- constructed.
 616 data RecConError = RecConError String
 617 INSTANCE_TYPEABLE0(RecConError,recConErrorTc,"RecConError")
 618
 619 instance Show RecConError where
 620     showsPrec _ (RecConError err) = showString err
 621
 622 #ifdef __HUGS__
 623 instance Exception RecConError where
 624     toException (RecConError err) = Hugs.Exception.RecConError err
 625     fromException (Hugs.Exception.RecConError err) = Just (RecConError err)
 626     fromException _ = Nothing
 627 #else
 628 instance Exception RecConError
 629 #endif
 630
 631 -----
 632
 633 -- |A record update was performed on a constructor without the
 634 -- appropriate field. This can only happen with a datatype with
 635 -- multiple constructors, where some fields are in one constructor
 636 -- but not another. The @String@ gives information about the source
 637 -- location of the record update.
 638 data RecUpdError = RecUpdError String
 639 INSTANCE_TYPEABLE0(RecUpdError,recUpdErrorTc,"RecUpdError")
 640
 641 instance Show RecUpdError where
 642     showsPrec _ (RecUpdError err) = showString err
 643
 644 #ifdef __HUGS__
 645 instance Exception RecUpdError where
 646     toException (RecUpdError err) = Hugs.Exception.RecUpdError err
 647     fromException (Hugs.Exception.RecUpdError err) = Just (RecUpdError err)
 648     fromException _ = Nothing
 649 #else
 650 instance Exception RecUpdError
 651 #endif
 652
 653 -----
 654
 655 -- |A class method without a definition (neither a default definition,
 656 -- nor a definition in the appropriate instance) was called. The
 657 -- @String@ gives information about which method it was.
 658 data NoMethodError = NoMethodError String
 659 INSTANCE_TYPEABLE0(NoMethodError,noMethodErrorTc,"NoMethodError")
 660
 661 instance Show NoMethodError where
 662     showsPrec _ (NoMethodError err) = showString err
 663
 664 #ifdef __HUGS__
 665 instance Exception NoMethodError where
 666     toException (NoMethodError err) = Hugs.Exception.NoMethodError err
 667     fromException (Hugs.Exception.NoMethodError err) = Just (NoMethodError err)
 668     fromException _ = Nothing
 669 #else
 670 instance Exception NoMethodError
 671 #endif
 672
 673 -----
 674
 675 -- |Thrown when the runtime system detects that the computation is
 676 -- guaranteed not to terminate. Note that there is no guarantee that
 677 -- the runtime system will notice whether any given computation is
 678 -- guaranteed to terminate or not.
 679 data NonTermination = NonTermination
 680 INSTANCE_TYPEABLE0(NonTermination,nonTerminationTc,"NonTermination")
 681
 682 instance Show NonTermination where
 683     showsPrec _ NonTermination = showString "<<loop>>"
 684
 685 #ifdef __HUGS__
 686 instance Exception NonTermination where
 687     toException NonTermination = Hugs.Exception.NonTermination
 688     fromException Hugs.Exception.NonTermination = Just NonTermination
 689     fromException _ = Nothing
 690 #else
 691 instance Exception NonTermination
 692 #endif
 693
 694 -----
 695
 696 -- |Thrown when the program attempts to call @atomically@, from the @stm@
 697 -- package, inside another call to @atomically@.
 698 data NestedAtomically = NestedAtomically
 699 INSTANCE_TYPEABLE0(NestedAtomically,nestedAtomicallyTc,"NestedAtomically")
 700
 701 instance Show NestedAtomically where
 702     showsPrec _ NestedAtomically = showString "Control.Concurrent.STM.atomically was nested"
 703
 704 instance Exception NestedAtomically
 705
 706 -----
 707
 708 #endif /* __GLASGOW_HASKELL__ || __HUGS__ */
 709
 710 #ifdef __GLASGOW_HASKELL__
 711 recSelError, recConError, irrefutPatError, runtimeError,
 712   nonExhaustiveGuardsError, patError, noMethodBindingError,
 713   absentError
 714         :: Addr# -> a   -- All take a UTF8-encoded C string
 715
 716 recSelError              s = throw (RecSelError ("No match in record selector "
 717                                                  ++ unpackCStringUtf8# s))  -- No location info unfortunately
 718 runtimeError             s = error (unpackCStringUtf8# s)                   -- No location info unfortunately
 719 absentError              s = error ("Oops!  Entered absent arg " ++ unpackCStringUtf8# s)
 720
 721 nonExhaustiveGuardsError s = throw (PatternMatchFail (untangle s "Non-exhaustive guards in"))
 722 irrefutPatError          s = throw (PatternMatchFail (untangle s "Irrefutable pattern failed for pattern"))
 723 recConError              s = throw (RecConError      (untangle s "Missing field in record construction"))
 724 noMethodBindingError     s = throw (NoMethodError    (untangle s "No instance nor default method for class operation"))
 725 patError                 s = throw (PatternMatchFail (untangle s "Non-exhaustive patterns in"))
 726
 727 -- GHC's RTS calls this
 728 nonTermination :: SomeException
 729 nonTermination = toException NonTermination
 730
 731 -- GHC's RTS calls this
 732 nestedAtomically :: SomeException
 733 nestedAtomically = toException NestedAtomically
 734 #endif