summaryrefslogtreecommitdiff
path: root/compiler/ilxGen/tests/test17.hs
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/ilxGen/tests/test17.hs')
-rw-r--r--compiler/ilxGen/tests/test17.hs44
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)