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