diff options
Diffstat (limited to 'compiler/ilxGen/tests/test17.hs')
-rw-r--r-- | compiler/ilxGen/tests/test17.hs | 44 |
1 files changed, 44 insertions, 0 deletions
diff --git a/compiler/ilxGen/tests/test17.hs b/compiler/ilxGen/tests/test17.hs new file mode 100644 index 0000000000..5e551b2dcd --- /dev/null +++ b/compiler/ilxGen/tests/test17.hs @@ -0,0 +1,44 @@ +{-# OPTIONS -fno-implicit-prelude #-} + +module Test17 where + +import PrelGHC +import PrelBase + +data Exception = IOException IOError | OtherExc + +data IOError + = IOError + String + +tthrow :: Exception -> a + +tthrow exception = raise# exception +ccatchException (IO m) k = IO (\s -> catch# m (\ex -> unIO (k ex)) s) + + +ccatch :: IO a -> (IOError -> IO a) -> IO a +ccatch m k = ccatchException m handler + where handler (IOException err) = k err + handler other = tthrow other + +ccatchNonIO :: IO a -> (Exception -> IO a) -> IO a +ccatchNonIO m k = ccatchException m handler + where handler (IOException err) = ioError err + handler other = k other + +newtype IO a = IO (State# RealWorld -> (# State# RealWorld, a #)) + +unIO :: IO a -> (State# RealWorld -> (# State# RealWorld, a #)) +unIO (IO a) = a + +ioError :: IOError -> IO a +ioError err = IO (\s -> tthrow (IOException err) s) + + + +blockAsyncExceptions :: IO a -> IO a +blockAsyncExceptions (IO io) = IO (blockAsyncExceptions# io) + +unblockAsyncExceptions :: IO a -> IO a +unblockAsyncExceptions (IO io) = IO (unblockAsyncExceptions# io) |