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