compiler/ilxGen/tests/test17.hs

   1 {-# OPTIONS -fno-implicit-prelude #-}
   2
   3 module Test17 where
   4
   5 import PrelGHC
   6 import PrelBase
   7
   8 data Exception = IOException IOError | OtherExc
   9
  10 data IOError
  11  = IOError
  12      String
  13
  14 tthrow :: Exception -> a
  15
  16 tthrow exception = raise# exception
  17 ccatchException (IO m) k =  IO (\s -> catch# m (\ex -> unIO (k ex)) s)
  18
  19
  20 ccatch           :: IO a -> (IOError -> IO a) -> IO a
  21 ccatch m k      =  ccatchException m handler
  22   where handler (IOException err) = k err
  23         handler other             = tthrow other
  24
  25 ccatchNonIO      :: IO a -> (Exception -> IO a) -> IO a
  26 ccatchNonIO m k =  ccatchException m handler
  27   where handler (IOException err) = ioError err
  28         handler other             = k other
  29
  30 newtype IO a = IO (State# RealWorld -> (# State# RealWorld, a #))
  31
  32 unIO :: IO a -> (State# RealWorld -> (# State# RealWorld, a #))
  33 unIO (IO a) = a
  34
  35 ioError         :: IOError -> IO a
  36 ioError err     =  IO (\s -> tthrow (IOException err) s)
  37
  38
  39
  40 blockAsyncExceptions :: IO a -> IO a
  41 blockAsyncExceptions (IO io) = IO (blockAsyncExceptions# io)
  42
  43 unblockAsyncExceptions :: IO a -> IO a
  44 unblockAsyncExceptions (IO io) = IO (unblockAsyncExceptions# io)