blob: 5e551b2dcdcb22c132a082989c4d43df7c39e0b6 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
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)
|
