Control/Exception/Base.hs

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