Fix comment
[ghc.git] / libraries / base / GHC / IO.hs
index 7ca3e6e..8459db6 100644 (file)
-{-# OPTIONS_GHC -XNoImplicitPrelude -#include "HsBase.h" #-}
+{-# LANGUAGE Unsafe #-}
+{-# LANGUAGE NoImplicitPrelude
+           , BangPatterns
+           , RankNTypes
+           , MagicHash
+           , ScopedTypeVariables
+           , UnboxedTuples
+  #-}
+{-# OPTIONS_GHC -funbox-strict-fields #-}
 {-# OPTIONS_HADDOCK hide #-}
 
-#undef DEBUG_DUMP
-
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  GHC.IO
--- Copyright   :  (c) The University of Glasgow, 1992-2001
+-- Copyright   :  (c) The University of Glasgow 1994-2002
 -- License     :  see libraries/base/LICENSE
--- 
--- Maintainer  :  libraries@haskell.org
+--
+-- Maintainer  :  cvs-ghc@haskell.org
 -- Stability   :  internal
--- Portability :  non-portable
+-- Portability :  non-portable (GHC Extensions)
 --
--- String I\/O functions
+-- Definitions for the 'IO' monad and its friends.
 --
 -----------------------------------------------------------------------------
 
--- #hide
-module GHC.IO ( 
-   hWaitForInput, hGetChar, hGetLine, hGetContents, hPutChar, hPutStr,
-   commitBuffer',       -- hack, see below
-   hGetcBuffered,       -- needed by ghc/compiler/utils/StringBuffer.lhs
-   hGetBuf, hGetBufNonBlocking, hPutBuf, hPutBufNonBlocking, slurpFile,
-   memcpy_ba_baoff,
-   memcpy_ptr_baoff,
-   memcpy_baoff_ba,
-   memcpy_baoff_ptr,
- ) where
-
-import Foreign
-import Foreign.C
-
-import System.IO.Error
-import Data.Maybe
-import Control.Monad
-import System.Posix.Internals
-
-import GHC.Enum
+module GHC.IO (
+        IO(..), unIO, failIO, liftIO, mplusIO,
+        unsafePerformIO, unsafeInterleaveIO,
+        unsafeDupablePerformIO, unsafeDupableInterleaveIO,
+        noDuplicate,
+
+        -- To and from from ST
+        stToIO, ioToST, unsafeIOToST, unsafeSTToIO,
+
+        FilePath,
+
+        catch, catchException, catchAny, throwIO,
+        mask, mask_, uninterruptibleMask, uninterruptibleMask_,
+        MaskingState(..), getMaskingState,
+        unsafeUnmask, interruptible,
+        onException, bracket, finally, evaluate
+    ) where
+
 import GHC.Base
-import GHC.IOBase
-import GHC.Handle       -- much of the real stuff is in here
-import GHC.Real
-import GHC.Num
+import GHC.ST
+import GHC.Exception
 import GHC.Show
-import GHC.List
+import GHC.IO.Unsafe
 
-#ifdef mingw32_HOST_OS
-import GHC.Conc
-#endif
+import {-# SOURCE #-} GHC.IO.Exception ( userError, IOError )
 
 -- ---------------------------------------------------------------------------
--- Simple input operations
+-- The IO Monad
 
--- If hWaitForInput finds anything in the Handle's buffer, it
--- immediately returns.  If not, it tries to read from the underlying
--- OS handle. Notice that for buffered Handles connected to terminals
--- this means waiting until a complete line is available.
+{-
+The IO Monad is just an instance of the ST monad, where the state is
+the real world.  We use the exception mechanism (in GHC.Exception) to
+implement IO exceptions.
 
--- | Computation 'hWaitForInput' @hdl t@
--- waits until input is available on handle @hdl@.
--- It returns 'True' as soon as input is available on @hdl@,
--- or 'False' if no input is available within @t@ milliseconds.
---
--- If @t@ is less than zero, then @hWaitForInput@ waits indefinitely.
---
--- This operation may fail with:
---
---  * 'isEOFError' if the end of file has been reached.
---
--- NOTE for GHC users: unless you use the @-threaded@ flag,
--- @hWaitForInput t@ where @t >= 0@ will block all other Haskell
--- threads for the duration of the call.  It behaves like a
--- @safe@ foreign call in this respect.
+NOTE: The IO representation is deeply wired in to various parts of the
+system.  The following list may or may not be exhaustive:
 
-hWaitForInput :: Handle -> Int -> IO Bool
-hWaitForInput h msecs = do
-  wantReadableHandle "hWaitForInput" h $ \ handle_ -> do
-  let ref = haBuffer handle_
-  buf <- readIORef ref
+Compiler  - types of various primitives in PrimOp.hs
 
-  if not (bufferEmpty buf)
-        then return True
-        else do
+RTS       - forceIO (StgStartup.cmm)
+          - catchzh_fast, (un)?blockAsyncExceptionszh_fast, raisezh_fast
+            (Exception.cmm)
+          - raiseAsync (RaiseAsync.c)
 
-  if msecs < 0 
-        then do buf' <- fillReadBuffer (haFD handle_) True 
-                                (haIsStream handle_) buf
-                writeIORef ref buf'
-                return True
-        else do r <- throwErrnoIfMinus1Retry "hWaitForInput" $
-                     fdReady (haFD handle_) 0 {- read -}
-                                (fromIntegral msecs)
-                                (fromIntegral $ fromEnum $ haIsStream handle_)
-                return (r /= 0)
+Prelude   - GHC.IO.hs, and several other places including
+            GHC.Exception.hs.
 
-foreign import ccall safe "fdReady"
-  fdReady :: CInt -> CInt -> CInt -> CInt -> IO CInt
+Libraries - parts of hslibs/lang.
 
--- ---------------------------------------------------------------------------
--- hGetChar
-
--- | Computation 'hGetChar' @hdl@ reads a character from the file or
--- channel managed by @hdl@, blocking until a character is available.
---
--- This operation may fail with:
---
---  * 'isEOFError' if the end of file has been reached.
-
-hGetChar :: Handle -> IO Char
-hGetChar handle =
-  wantReadableHandle "hGetChar" handle $ \handle_ -> do
-
-  let fd = haFD handle_
-      ref = haBuffer handle_
-
-  buf <- readIORef ref
-  if not (bufferEmpty buf)
-        then hGetcBuffered fd ref buf
-        else do
-
-  -- buffer is empty.
-  case haBufferMode handle_ of
-    LineBuffering    -> do
-        new_buf <- fillReadBuffer fd True (haIsStream handle_) buf
-        hGetcBuffered fd ref new_buf
-    BlockBuffering _ -> do
-        new_buf <- fillReadBuffer fd True (haIsStream handle_) buf
-                --                   ^^^^
-                -- don't wait for a completely full buffer.
-        hGetcBuffered fd ref new_buf
-    NoBuffering -> do
-        -- make use of the minimal buffer we already have
-        let raw = bufBuf buf
-        r <- readRawBuffer "hGetChar" fd (haIsStream handle_) raw 0 1
-        if r == 0
-           then ioe_EOF
-           else do (c,_) <- readCharFromBuffer raw 0
-                   return c
-
-hGetcBuffered fd ref buf@Buffer{ bufBuf=b, bufRPtr=r, bufWPtr=w }
- = do (c,r) <- readCharFromBuffer b r
-      let new_buf | r == w    = buf{ bufRPtr=0, bufWPtr=0 }
-                  | otherwise = buf{ bufRPtr=r }
-      writeIORef ref new_buf
-      return c
+--SDM
+-}
 
--- ---------------------------------------------------------------------------
--- hGetLine
-
--- ToDo: the unbuffered case is wrong: it doesn't lock the handle for
--- the duration.
-
--- | Computation 'hGetLine' @hdl@ reads a line from the file or
--- channel managed by @hdl@.
---
--- This operation may fail with:
---
---  * 'isEOFError' if the end of file is encountered when reading
---    the /first/ character of the line.
---
--- If 'hGetLine' encounters end-of-file at any other point while reading
--- in a line, it is treated as a line terminator and the (partial)
--- line is returned.
-
-hGetLine :: Handle -> IO String
-hGetLine h = do
-  m <- wantReadableHandle "hGetLine" h $ \ handle_ -> do
-        case haBufferMode handle_ of
-           NoBuffering      -> return Nothing
-           LineBuffering    -> do
-              l <- hGetLineBuffered handle_
-              return (Just l)
-           BlockBuffering _ -> do 
-              l <- hGetLineBuffered handle_
-              return (Just l)
-  case m of
-        Nothing -> hGetLineUnBuffered h
-        Just l  -> return l
-
-hGetLineBuffered :: Handle__ -> IO String
-hGetLineBuffered handle_ = do
-  let ref = haBuffer handle_
-  buf <- readIORef ref
-  hGetLineBufferedLoop handle_ ref buf []
-
-hGetLineBufferedLoop :: Handle__ -> IORef Buffer -> Buffer -> [String]
-                     -> IO String
-hGetLineBufferedLoop handle_ ref
-        buf@Buffer{ bufRPtr=r, bufWPtr=w, bufBuf=raw } xss =
-  let
-        -- find the end-of-line character, if there is one
-        loop raw r
-           | r == w = return (False, w)
-           | otherwise =  do
-                (c,r') <- readCharFromBuffer raw r
-                if c == '\n'
-                   then return (True, r) -- NB. not r': don't include the '\n'
-                   else loop raw r'
-  in do
-  (eol, off) <- loop raw r
-
-#ifdef DEBUG_DUMP
-  puts ("hGetLineBufferedLoop: r=" ++ show r ++ ", w=" ++ show w ++ ", off=" ++ show off ++ "\n")
-#endif
-
-  xs <- unpack raw r off
-
-  -- if eol == True, then off is the offset of the '\n'
-  -- otherwise off == w and the buffer is now empty.
-  if eol
-        then do if (w == off + 1)
-                        then writeIORef ref buf{ bufRPtr=0, bufWPtr=0 }
-                        else writeIORef ref buf{ bufRPtr = off + 1 }
-                return (concat (reverse (xs:xss)))
-        else do
-             maybe_buf <- maybeFillReadBuffer (haFD handle_) True (haIsStream handle_)
-                                buf{ bufWPtr=0, bufRPtr=0 }
-             case maybe_buf of
-                -- Nothing indicates we caught an EOF, and we may have a
-                -- partial line to return.
-                Nothing -> do
-                     writeIORef ref buf{ bufRPtr=0, bufWPtr=0 }
-                     let str = concat (reverse (xs:xss))
-                     if not (null str)
-                        then return str
-                        else ioe_EOF
-                Just new_buf ->
-                     hGetLineBufferedLoop handle_ ref new_buf (xs:xss)
-
-
-maybeFillReadBuffer fd is_line is_stream buf
-  = catch 
-     (do buf <- fillReadBuffer fd is_line is_stream buf
-         return (Just buf)
-     )
-     (\e -> do if isEOFError e 
-                  then return Nothing 
-                  else ioError e)
-
-
-unpack :: RawBuffer -> Int -> Int -> IO [Char]
-unpack buf r 0   = return ""
-unpack buf (I# r) (I# len) = IO $ \s -> unpack [] (len -# 1#) s
-   where
-    unpack acc i s
-     | i <# r  = (# s, acc #)
-     | otherwise = 
-          case readCharArray# buf i s of
-            (# s, ch #) -> unpack (C# ch : acc) (i -# 1#) s
-
-
-hGetLineUnBuffered :: Handle -> IO String
-hGetLineUnBuffered h = do
-  c <- hGetChar h
-  if c == '\n' then
-     return ""
-   else do
-    l <- getRest
-    return (c:l)
- where
-  getRest = do
-    c <- 
-      catch 
-        (hGetChar h)
-        (\ err -> do
-          if isEOFError err then
-             return '\n'
-           else
-             ioError err)
-    if c == '\n' then
-       return ""
-     else do
-       s <- getRest
-       return (c:s)
+liftIO :: IO a -> State# RealWorld -> STret RealWorld a
+liftIO (IO m) = \s -> case m s of (# s', r #) -> STret s' r
 
--- -----------------------------------------------------------------------------
--- hGetContents
-
--- hGetContents on a DuplexHandle only affects the read side: you can
--- carry on writing to it afterwards.
-
--- | Computation 'hGetContents' @hdl@ returns the list of characters
--- corresponding to the unread portion of the channel or file managed
--- by @hdl@, which is put into an intermediate state, /semi-closed/.
--- In this state, @hdl@ is effectively closed,
--- but items are read from @hdl@ on demand and accumulated in a special
--- list returned by 'hGetContents' @hdl@.
---
--- Any operation that fails because a handle is closed,
--- also fails if a handle is semi-closed.  The only exception is 'hClose'.
--- A semi-closed handle becomes closed:
---
---  * if 'hClose' is applied to it;
---
---  * if an I\/O error occurs when reading an item from the handle;
---
---  * or once the entire contents of the handle has been read.
---
--- Once a semi-closed handle becomes closed, the contents of the
--- associated list becomes fixed.  The contents of this final list is
--- only partially specified: it will contain at least all the items of
--- the stream that were evaluated prior to the handle becoming closed.
---
--- Any I\/O errors encountered while a handle is semi-closed are simply
--- discarded.
---
--- This operation may fail with:
---
---  * 'isEOFError' if the end of file has been reached.
-
-hGetContents :: Handle -> IO String
-hGetContents handle = 
-    withHandle "hGetContents" handle $ \handle_ ->
-    case haType handle_ of 
-      ClosedHandle         -> ioe_closedHandle
-      SemiClosedHandle     -> ioe_closedHandle
-      AppendHandle         -> ioe_notReadable
-      WriteHandle          -> ioe_notReadable
-      _ -> do xs <- lazyRead handle
-              return (handle_{ haType=SemiClosedHandle}, xs )
-
--- Note that someone may close the semi-closed handle (or change its
--- buffering), so each time these lazy read functions are pulled on,
--- they have to check whether the handle has indeed been closed.
-
-lazyRead :: Handle -> IO String
-lazyRead handle = 
-   unsafeInterleaveIO $
-        withHandle "lazyRead" handle $ \ handle_ -> do
-        case haType handle_ of
-          ClosedHandle     -> return (handle_, "")
-          SemiClosedHandle -> lazyRead' handle handle_
-          _ -> ioException 
-                  (IOError (Just handle) IllegalOperation "lazyRead"
-                        "illegal handle type" Nothing)
-
-lazyRead' h handle_ = do
-  let ref = haBuffer handle_
-      fd  = haFD handle_
-
-  -- even a NoBuffering handle can have a char in the buffer... 
-  -- (see hLookAhead)
-  buf <- readIORef ref
-  if not (bufferEmpty buf)
-        then lazyReadHaveBuffer h handle_ fd ref buf
-        else do
-
-  case haBufferMode handle_ of
-     NoBuffering      -> do
-        -- make use of the minimal buffer we already have
-        let raw = bufBuf buf
-        r <- readRawBuffer "lazyRead" fd (haIsStream handle_) raw 0 1
-        if r == 0
-           then do (handle_,_) <- hClose_help handle_ 
-                   return (handle_, "")
-           else do (c,_) <- readCharFromBuffer raw 0
-                   rest <- lazyRead h
-                   return (handle_, c : rest)
-
-     LineBuffering    -> lazyReadBuffered h handle_ fd ref buf
-     BlockBuffering _ -> lazyReadBuffered h handle_ fd ref buf
-
--- we never want to block during the read, so we call fillReadBuffer with
--- is_line==True, which tells it to "just read what there is".
-lazyReadBuffered h handle_ fd ref buf = do
-   catch 
-        (do buf <- fillReadBuffer fd True{-is_line-} (haIsStream handle_) buf
-            lazyReadHaveBuffer h handle_ fd ref buf
-        )
-        -- all I/O errors are discarded.  Additionally, we close the handle.
-        (\e -> do (handle_,_) <- hClose_help handle_
-                  return (handle_, "")
-        )
-
-lazyReadHaveBuffer h handle_ fd ref buf = do
-   more <- lazyRead h
-   writeIORef ref buf{ bufRPtr=0, bufWPtr=0 }
-   s <- unpackAcc (bufBuf buf) (bufRPtr buf) (bufWPtr buf) more
-   return (handle_, s)
-
-
-unpackAcc :: RawBuffer -> Int -> Int -> [Char] -> IO [Char]
-unpackAcc buf r 0 acc  = return acc
-unpackAcc buf (I# r) (I# len) acc = IO $ \s -> unpack acc (len -# 1#) s
-   where
-    unpack acc i s
-     | i <# r  = (# s, acc #)
-     | otherwise = 
-          case readCharArray# buf i s of
-            (# s, ch #) -> unpack (C# ch : acc) (i -# 1#) s
+failIO :: String -> IO a
+failIO s = IO (raiseIO# (toException (userError s)))
 
 -- ---------------------------------------------------------------------------
--- hPutChar
-
--- | Computation 'hPutChar' @hdl ch@ writes the character @ch@ to the
--- file or channel managed by @hdl@.  Characters may be buffered if
--- buffering is enabled for @hdl@.
---
--- This operation may fail with:
---
---  * 'isFullError' if the device is full; or
---
---  * 'isPermissionError' if another system resource limit would be exceeded.
-
-hPutChar :: Handle -> Char -> IO ()
-hPutChar handle c = do
-    c `seq` return ()
-    wantWritableHandle "hPutChar" handle $ \ handle_  -> do
-    let fd = haFD handle_
-    case haBufferMode handle_ of
-        LineBuffering    -> hPutcBuffered handle_ True  c
-        BlockBuffering _ -> hPutcBuffered handle_ False c
-        NoBuffering      ->
-                with (castCharToCChar c) $ \buf -> do
-                  writeRawBufferPtr "hPutChar" fd (haIsStream handle_) buf 0 1
-                  return ()
-
-hPutcBuffered handle_ is_line c = do
-  let ref = haBuffer handle_
-  buf <- readIORef ref
-  let w = bufWPtr buf
-  w'  <- writeCharIntoBuffer (bufBuf buf) w c
-  let new_buf = buf{ bufWPtr = w' }
-  if bufferFull new_buf || is_line && c == '\n'
-     then do 
-        flushed_buf <- flushWriteBuffer (haFD handle_) (haIsStream handle_) new_buf
-        writeIORef ref flushed_buf
-     else do 
-        writeIORef ref new_buf
-
-
-hPutChars :: Handle -> [Char] -> IO ()
-hPutChars handle [] = return ()
-hPutChars handle (c:cs) = hPutChar handle c >> hPutChars handle cs
+-- Coercions between IO and ST
 
--- ---------------------------------------------------------------------------
--- hPutStr
-
--- We go to some trouble to avoid keeping the handle locked while we're
--- evaluating the string argument to hPutStr, in case doing so triggers another
--- I/O operation on the same handle which would lead to deadlock.  The classic
--- case is
---
---              putStr (trace "hello" "world")
---
--- so the basic scheme is this:
---
---      * copy the string into a fresh buffer,
---      * "commit" the buffer to the handle.
---
--- Committing may involve simply copying the contents of the new
--- buffer into the handle's buffer, flushing one or both buffers, or
--- maybe just swapping the buffers over (if the handle's buffer was
--- empty).  See commitBuffer below.
-
--- | Computation 'hPutStr' @hdl s@ writes the string
--- @s@ to the file or channel managed by @hdl@.
---
--- This operation may fail with:
---
---  * 'isFullError' if the device is full; or
---
---  * 'isPermissionError' if another system resource limit would be exceeded.
-
-hPutStr :: Handle -> String -> IO ()
-hPutStr handle str = do
-    buffer_mode <- wantWritableHandle "hPutStr" handle 
-                        (\ handle_ -> do getSpareBuffer handle_)
-    case buffer_mode of
-       (NoBuffering, _) -> do
-            hPutChars handle str        -- v. slow, but we don't care
-       (LineBuffering, buf) -> do
-            writeLines handle buf str
-       (BlockBuffering _, buf) -> do
-            writeBlocks handle buf str
-
-
-getSpareBuffer :: Handle__ -> IO (BufferMode, Buffer)
-getSpareBuffer Handle__{haBuffer=ref, 
-                        haBuffers=spare_ref,
-                        haBufferMode=mode}
- = do
-   case mode of
-     NoBuffering -> return (mode, error "no buffer!")
-     _ -> do
-          bufs <- readIORef spare_ref
-          buf  <- readIORef ref
-          case bufs of
-            BufferListCons b rest -> do
-                writeIORef spare_ref rest
-                return ( mode, newEmptyBuffer b WriteBuffer (bufSize buf))
-            BufferListNil -> do
-                new_buf <- allocateBuffer (bufSize buf) WriteBuffer
-                return (mode, new_buf)
-
-
-writeLines :: Handle -> Buffer -> String -> IO ()
-writeLines hdl Buffer{ bufBuf=raw, bufSize=len } s =
-  let
-   shoveString :: Int -> [Char] -> IO ()
-        -- check n == len first, to ensure that shoveString is strict in n.
-   shoveString n cs | n == len = do
-        new_buf <- commitBuffer hdl raw len n True{-needs flush-} False
-        writeLines hdl new_buf cs
-   shoveString n [] = do
-        commitBuffer hdl raw len n False{-no flush-} True{-release-}
-        return ()
-   shoveString n (c:cs) = do
-        n' <- writeCharIntoBuffer raw n c
-        if (c == '\n') 
-         then do 
-              new_buf <- commitBuffer hdl raw len n' True{-needs flush-} False
-              writeLines hdl new_buf cs
-         else 
-              shoveString n' cs
-  in
-  shoveString 0 s
-
-writeBlocks :: Handle -> Buffer -> String -> IO ()
-writeBlocks hdl Buffer{ bufBuf=raw, bufSize=len } s =
-  let
-   shoveString :: Int -> [Char] -> IO ()
-        -- check n == len first, to ensure that shoveString is strict in n.
-   shoveString n cs | n == len = do
-        new_buf <- commitBuffer hdl raw len n True{-needs flush-} False
-        writeBlocks hdl new_buf cs
-   shoveString n [] = do
-        commitBuffer hdl raw len n False{-no flush-} True{-release-}
-        return ()
-   shoveString n (c:cs) = do
-        n' <- writeCharIntoBuffer raw n c
-        shoveString n' cs
-  in
-  shoveString 0 s
+-- | A monad transformer embedding strict state transformers in the 'IO'
+-- monad.  The 'RealWorld' parameter indicates that the internal state
+-- used by the 'ST' computation is a special one supplied by the 'IO'
+-- monad, and thus distinct from those used by invocations of 'runST'.
+stToIO        :: ST RealWorld a -> IO a
+stToIO (ST m) = IO m
 
--- -----------------------------------------------------------------------------
--- commitBuffer handle buf sz count flush release
--- 
--- Write the contents of the buffer 'buf' ('sz' bytes long, containing
--- 'count' bytes of data) to handle (handle must be block or line buffered).
--- 
--- Implementation:
--- 
---    for block/line buffering,
---       1. If there isn't room in the handle buffer, flush the handle
---          buffer.
--- 
---       2. If the handle buffer is empty,
---               if flush, 
---                   then write buf directly to the device.
---                   else swap the handle buffer with buf.
--- 
---       3. If the handle buffer is non-empty, copy buf into the
---          handle buffer.  Then, if flush != 0, flush
---          the buffer.
-
-commitBuffer
-        :: Handle                       -- handle to commit to
-        -> RawBuffer -> Int             -- address and size (in bytes) of buffer
-        -> Int                          -- number of bytes of data in buffer
-        -> Bool                         -- True <=> flush the handle afterward
-        -> Bool                         -- release the buffer?
-        -> IO Buffer
-
-commitBuffer hdl raw sz@(I# _) count@(I# _) flush release = do
-  wantWritableHandle "commitAndReleaseBuffer" hdl $
-     commitBuffer' raw sz count flush release
-
--- Explicitly lambda-lift this function to subvert GHC's full laziness
--- optimisations, which otherwise tends to float out subexpressions
--- past the \handle, which is really a pessimisation in this case because
--- that lambda is a one-shot lambda.
---
--- Don't forget to export the function, to stop it being inlined too
--- (this appears to be better than NOINLINE, because the strictness
--- analyser still gets to worker-wrapper it).
---
--- This hack is a fairly big win for hPutStr performance.  --SDM 18/9/2001
---
-commitBuffer' raw sz@(I# _) count@(I# _) flush release
-  handle_@Handle__{ haFD=fd, haBuffer=ref, haBuffers=spare_buf_ref } = do
-
-#ifdef DEBUG_DUMP
-      puts ("commitBuffer: sz=" ++ show sz ++ ", count=" ++ show count
-            ++ ", flush=" ++ show flush ++ ", release=" ++ show release ++"\n")
-#endif
-
-      old_buf@Buffer{ bufBuf=old_raw, bufRPtr=r, bufWPtr=w, bufSize=size }
-          <- readIORef ref
-
-      buf_ret <-
-        -- enough room in handle buffer?
-         if (not flush && (size - w > count))
-                -- The > is to be sure that we never exactly fill
-                -- up the buffer, which would require a flush.  So
-                -- if copying the new data into the buffer would
-                -- make the buffer full, we just flush the existing
-                -- buffer and the new data immediately, rather than
-                -- copying before flushing.
-
-                -- not flushing, and there's enough room in the buffer:
-                -- just copy the data in and update bufWPtr.
-            then do memcpy_baoff_ba old_raw (fromIntegral w) raw (fromIntegral count)
-                    writeIORef ref old_buf{ bufWPtr = w + count }
-                    return (newEmptyBuffer raw WriteBuffer sz)
-
-                -- else, we have to flush
-            else do flushed_buf <- flushWriteBuffer fd (haIsStream handle_) old_buf
-
-                    let this_buf = 
-                            Buffer{ bufBuf=raw, bufState=WriteBuffer, 
-                                    bufRPtr=0, bufWPtr=count, bufSize=sz }
-
-                        -- if:  (a) we don't have to flush, and
-                        --      (b) size(new buffer) == size(old buffer), and
-                        --      (c) new buffer is not full,
-                        -- we can just just swap them over...
-                    if (not flush && sz == size && count /= sz)
-                        then do 
-                          writeIORef ref this_buf
-                          return flushed_buf                         
-
-                        -- otherwise, we have to flush the new data too,
-                        -- and start with a fresh buffer
-                        else do
-                          flushWriteBuffer fd (haIsStream handle_) this_buf
-                          writeIORef ref flushed_buf
-                            -- if the sizes were different, then allocate
-                            -- a new buffer of the correct size.
-                          if sz == size
-                             then return (newEmptyBuffer raw WriteBuffer sz)
-                             else allocateBuffer size WriteBuffer
-
-      -- release the buffer if necessary
-      case buf_ret of
-        Buffer{ bufSize=buf_ret_sz, bufBuf=buf_ret_raw } -> do
-          if release && buf_ret_sz == size
-            then do
-              spare_bufs <- readIORef spare_buf_ref
-              writeIORef spare_buf_ref 
-                (BufferListCons buf_ret_raw spare_bufs)
-              return buf_ret
-            else
-              return buf_ret
+ioToST        :: IO a -> ST RealWorld a
+ioToST (IO m) = (ST m)
 
--- ---------------------------------------------------------------------------
--- Reading/writing sequences of bytes.
+-- This relies on IO and ST having the same representation modulo the
+-- constraint on the type of the state
+--
+unsafeIOToST        :: IO a -> ST s a
+unsafeIOToST (IO io) = ST $ \ s -> (unsafeCoerce# io) s
 
--- ---------------------------------------------------------------------------
--- hPutBuf
-
--- | 'hPutBuf' @hdl buf count@ writes @count@ 8-bit bytes from the
--- buffer @buf@ to the handle @hdl@.  It returns ().
---
--- This operation may fail with:
---
---  * 'ResourceVanished' if the handle is a pipe or socket, and the
---    reading end is closed.  (If this is a POSIX system, and the program
---    has not asked to ignore SIGPIPE, then a SIGPIPE may be delivered
---    instead, whose default action is to terminate the program).
-
-hPutBuf :: Handle                       -- handle to write to
-        -> Ptr a                        -- address of buffer
-        -> Int                          -- number of bytes of data in buffer
-        -> IO ()
-hPutBuf h ptr count = do hPutBuf' h ptr count True; return ()
-
-hPutBufNonBlocking
-        :: Handle                       -- handle to write to
-        -> Ptr a                        -- address of buffer
-        -> Int                          -- number of bytes of data in buffer
-        -> IO Int                       -- returns: number of bytes written
-hPutBufNonBlocking h ptr count = hPutBuf' h ptr count False
-
-hPutBuf':: Handle                       -- handle to write to
-        -> Ptr a                        -- address of buffer
-        -> Int                          -- number of bytes of data in buffer
-        -> Bool                         -- allow blocking?
-        -> IO Int
-hPutBuf' handle ptr count can_block
-  | count == 0 = return 0
-  | count <  0 = illegalBufferSize handle "hPutBuf" count
-  | otherwise = 
-    wantWritableHandle "hPutBuf" handle $ 
-      \ handle_@Handle__{ haFD=fd, haBuffer=ref, haIsStream=is_stream } -> 
-          bufWrite fd ref is_stream ptr count can_block
-
-bufWrite fd ref is_stream ptr count can_block =
-  seq count $ seq fd $ do  -- strictness hack
-  old_buf@Buffer{ bufBuf=old_raw, bufRPtr=r, bufWPtr=w, bufSize=size }
-     <- readIORef ref
-
-  -- enough room in handle buffer?
-  if (size - w > count)
-        -- There's enough room in the buffer:
-        -- just copy the data in and update bufWPtr.
-        then do memcpy_baoff_ptr old_raw (fromIntegral w) ptr (fromIntegral count)
-                writeIORef ref old_buf{ bufWPtr = w + count }
-                return count
-
-        -- else, we have to flush
-        else do flushed_buf <- flushWriteBuffer fd is_stream old_buf
-                        -- TODO: we should do a non-blocking flush here
-                writeIORef ref flushed_buf
-                -- if we can fit in the buffer, then just loop  
-                if count < size
-                   then bufWrite fd ref is_stream ptr count can_block
-                   else if can_block
-                           then do writeChunk fd is_stream (castPtr ptr) count
-                                   return count
-                           else writeChunkNonBlocking fd is_stream ptr count
-
-writeChunk :: FD -> Bool -> Ptr CChar -> Int -> IO ()
-writeChunk fd is_stream ptr bytes = loop 0 bytes 
- where
-  loop :: Int -> Int -> IO ()
-  loop _   bytes | bytes <= 0 = return ()
-  loop off bytes = do
-    r <- fromIntegral `liftM`
-           writeRawBufferPtr "writeChunk" fd is_stream ptr
-                             off (fromIntegral bytes)
-    -- write can't return 0
-    loop (off + r) (bytes - r)
-
-writeChunkNonBlocking :: FD -> Bool -> Ptr a -> Int -> IO Int
-writeChunkNonBlocking fd is_stream ptr bytes = loop 0 bytes 
- where
-  loop :: Int -> Int -> IO Int
-  loop off bytes | bytes <= 0 = return off
-  loop off bytes = do
-#ifndef mingw32_HOST_OS
-    ssize <- c_write fd (ptr `plusPtr` off) (fromIntegral bytes)
-    let r = fromIntegral ssize :: Int
-    if (r == -1)
-      then do errno <- getErrno
-              if (errno == eAGAIN || errno == eWOULDBLOCK)
-                 then return off
-                 else throwErrno "writeChunk"
-      else loop (off + r) (bytes - r)
-#else
-    (ssize, rc) <- asyncWrite (fromIntegral fd)
-                              (fromIntegral $ fromEnum is_stream)
-                                 (fromIntegral bytes)
-                                 (ptr `plusPtr` off)
-    let r = fromIntegral ssize :: Int
-    if r == (-1)
-      then ioError (errnoToIOError "hPutBufNonBlocking" (Errno (fromIntegral rc)) Nothing Nothing)
-      else loop (off + r) (bytes - r)
-#endif
+unsafeSTToIO :: ST s a -> IO a
+unsafeSTToIO (ST m) = IO (unsafeCoerce# m)
 
--- ---------------------------------------------------------------------------
--- hGetBuf
-
--- | 'hGetBuf' @hdl buf count@ reads data from the handle @hdl@
--- into the buffer @buf@ until either EOF is reached or
--- @count@ 8-bit bytes have been read.
--- It returns the number of bytes actually read.  This may be zero if
--- EOF was reached before any data was read (or if @count@ is zero).
---
--- 'hGetBuf' never raises an EOF exception, instead it returns a value
--- smaller than @count@.
---
--- If the handle is a pipe or socket, and the writing end
--- is closed, 'hGetBuf' will behave as if EOF was reached.
-
-hGetBuf :: Handle -> Ptr a -> Int -> IO Int
-hGetBuf h ptr count
-  | count == 0 = return 0
-  | count <  0 = illegalBufferSize h "hGetBuf" count
-  | otherwise = 
-      wantReadableHandle "hGetBuf" h $ 
-        \ handle_@Handle__{ haFD=fd, haBuffer=ref, haIsStream=is_stream } -> do
-            bufRead fd ref is_stream ptr 0 count
-
--- small reads go through the buffer, large reads are satisfied by
--- taking data first from the buffer and then direct from the file
--- descriptor.
-bufRead fd ref is_stream ptr so_far count =
-  seq fd $ seq so_far $ seq count $ do -- strictness hack
-  buf@Buffer{ bufBuf=raw, bufWPtr=w, bufRPtr=r, bufSize=sz } <- readIORef ref
-  if bufferEmpty buf
-     then if count > sz  -- small read?
-                then do rest <- readChunk fd is_stream ptr count
-                        return (so_far + rest)
-                else do mb_buf <- maybeFillReadBuffer fd True is_stream buf
-                        case mb_buf of
-                          Nothing -> return so_far -- got nothing, we're done
-                          Just buf' -> do
-                                writeIORef ref buf'
-                                bufRead fd ref is_stream ptr so_far count
-     else do 
-        let avail = w - r
-        if (count == avail)
-           then do 
-                memcpy_ptr_baoff ptr raw (fromIntegral r) (fromIntegral count)
-                writeIORef ref buf{ bufWPtr=0, bufRPtr=0 }
-                return (so_far + count)
-           else do
-        if (count < avail)
-           then do 
-                memcpy_ptr_baoff ptr raw (fromIntegral r) (fromIntegral count)
-                writeIORef ref buf{ bufRPtr = r + count }
-                return (so_far + count)
-           else do
-  
-        memcpy_ptr_baoff ptr raw (fromIntegral r) (fromIntegral avail)
-        writeIORef ref buf{ bufWPtr=0, bufRPtr=0 }
-        let remaining = count - avail
-            so_far' = so_far + avail
-            ptr' = ptr `plusPtr` avail
-
-        if remaining < sz
-           then bufRead fd ref is_stream ptr' so_far' remaining
-           else do 
-
-        rest <- readChunk fd is_stream ptr' remaining
-        return (so_far' + rest)
-
-readChunk :: FD -> Bool -> Ptr a -> Int -> IO Int
-readChunk fd is_stream ptr bytes = loop 0 bytes 
- where
-  loop :: Int -> Int -> IO Int
-  loop off bytes | bytes <= 0 = return off
-  loop off bytes = do
-    r <- fromIntegral `liftM`
-           readRawBufferPtr "readChunk" fd is_stream 
-                            (castPtr ptr) off (fromIntegral bytes)
-    if r == 0
-        then return off
-        else loop (off + r) (bytes - r)
-
-
--- | 'hGetBufNonBlocking' @hdl buf count@ reads data from the handle @hdl@
--- into the buffer @buf@ until either EOF is reached, or
--- @count@ 8-bit bytes have been read, or there is no more data available
--- to read immediately.
---
--- 'hGetBufNonBlocking' is identical to 'hGetBuf', except that it will
--- never block waiting for data to become available, instead it returns
--- only whatever data is available.  To wait for data to arrive before
--- calling 'hGetBufNonBlocking', use 'hWaitForInput'.
---
--- If the handle is a pipe or socket, and the writing end
--- is closed, 'hGetBufNonBlocking' will behave as if EOF was reached.
---
-hGetBufNonBlocking :: Handle -> Ptr a -> Int -> IO Int
-hGetBufNonBlocking h ptr count
-  | count == 0 = return 0
-  | count <  0 = illegalBufferSize h "hGetBufNonBlocking" count
-  | otherwise = 
-      wantReadableHandle "hGetBufNonBlocking" h $ 
-        \ handle_@Handle__{ haFD=fd, haBuffer=ref, haIsStream=is_stream } -> do
-            bufReadNonBlocking fd ref is_stream ptr 0 count
-
-bufReadNonBlocking fd ref is_stream ptr so_far count =
-  seq fd $ seq so_far $ seq count $ do -- strictness hack
-  buf@Buffer{ bufBuf=raw, bufWPtr=w, bufRPtr=r, bufSize=sz } <- readIORef ref
-  if bufferEmpty buf
-     then if count > sz  -- large read?
-                then do rest <- readChunkNonBlocking fd is_stream ptr count
-                        return (so_far + rest)
-                else do buf' <- fillReadBufferWithoutBlocking fd is_stream buf
-                        case buf' of { Buffer{ bufWPtr=w }  ->
-                        if (w == 0) 
-                           then return so_far
-                           else do writeIORef ref buf'
-                                   bufReadNonBlocking fd ref is_stream ptr
-                                         so_far (min count w)
-                                  -- NOTE: new count is 'min count w'
-                                  -- so we will just copy the contents of the
-                                  -- buffer in the recursive call, and not
-                                  -- loop again.
-                        }
-     else do
-        let avail = w - r
-        if (count == avail)
-           then do 
-                memcpy_ptr_baoff ptr raw (fromIntegral r) (fromIntegral count)
-                writeIORef ref buf{ bufWPtr=0, bufRPtr=0 }
-                return (so_far + count)
-           else do
-        if (count < avail)
-           then do 
-                memcpy_ptr_baoff ptr raw (fromIntegral r) (fromIntegral count)
-                writeIORef ref buf{ bufRPtr = r + count }
-                return (so_far + count)
-           else do
-
-        memcpy_ptr_baoff ptr raw (fromIntegral r) (fromIntegral avail)
-        writeIORef ref buf{ bufWPtr=0, bufRPtr=0 }
-        let remaining = count - avail
-            so_far' = so_far + avail
-            ptr' = ptr `plusPtr` avail
-
-        -- we haven't attempted to read anything yet if we get to here.
-        if remaining < sz
-           then bufReadNonBlocking fd ref is_stream ptr' so_far' remaining
-           else do 
-
-        rest <- readChunkNonBlocking fd is_stream ptr' remaining
-        return (so_far' + rest)
-
-
-readChunkNonBlocking :: FD -> Bool -> Ptr a -> Int -> IO Int
-readChunkNonBlocking fd is_stream ptr bytes = do
-    fromIntegral `liftM`
-        readRawBufferPtrNoBlock "readChunkNonBlocking" fd is_stream 
-                            (castPtr ptr) 0 (fromIntegral bytes)
-
-    -- we don't have non-blocking read support on Windows, so just invoke
-    -- the ordinary low-level read which will block until data is available,
-    -- but won't wait for the whole buffer to fill.
-
-slurpFile :: FilePath -> IO (Ptr (), Int)
-slurpFile fname = do
-  handle <- openFile fname ReadMode
-  sz     <- hFileSize handle
-  if sz > fromIntegral (maxBound::Int) then 
-    ioError (userError "slurpFile: file too big")
-   else do
-    let sz_i = fromIntegral sz
-    if sz_i == 0 then return (nullPtr, 0) else do
-    chunk <- mallocBytes sz_i
-    r <- hGetBuf handle chunk sz_i
-    hClose handle
-    return (chunk, r)
+-- -----------------------------------------------------------------------------
+-- | File and directory names are values of type 'String', whose precise
+-- meaning is operating system dependent. Files can be opened, yielding a
+-- handle which can then be used to operate on the contents of that file.
 
--- ---------------------------------------------------------------------------
--- memcpy wrappers
+type FilePath = String
 
-foreign import ccall unsafe "__hscore_memcpy_src_off"
-   memcpy_ba_baoff :: RawBuffer -> RawBuffer -> CInt -> CSize -> IO (Ptr ())
-foreign import ccall unsafe "__hscore_memcpy_src_off"
-   memcpy_ptr_baoff :: Ptr a -> RawBuffer -> CInt -> CSize -> IO (Ptr ())
-foreign import ccall unsafe "__hscore_memcpy_dst_off"
-   memcpy_baoff_ba :: RawBuffer -> CInt -> RawBuffer -> CSize -> IO (Ptr ())
-foreign import ccall unsafe "__hscore_memcpy_dst_off"
-   memcpy_baoff_ptr :: RawBuffer -> CInt -> Ptr a -> CSize -> IO (Ptr ())
+-- -----------------------------------------------------------------------------
+-- Primitive catch and throwIO
+
+{-
+catchException/catch used to handle the passing around of the state to the
+action and the handler.  This turned out to be a bad idea - it meant
+that we had to wrap both arguments in thunks so they could be entered
+as normal (remember IO returns an unboxed pair...).
+
+Now catch# has type
+
+    catch# :: IO a -> (b -> IO a) -> IO a
+
+(well almost; the compiler doesn't know about the IO newtype so we
+have to work around that in the definition of catch below).
+-}
+
+-- | Catch an exception in the 'IO' monad.
+--
+-- Note that this function is /strict/ in the action. That is,
+-- @catchException undefined b == _|_@. See #exceptions_and_strictness#
+-- for details.
+catchException :: Exception e => IO a -> (e -> IO a) -> IO a
+catchException !io handler = catch io handler
+
+-- | This is the simplest of the exception-catching functions.  It
+-- takes a single argument, runs it, and if an exception is raised
+-- the \"handler\" is executed, with the value of the exception passed as an
+-- argument.  Otherwise, the result is returned as normal.  For example:
+--
+-- >   catch (readFile f)
+-- >         (\e -> do let err = show (e :: IOException)
+-- >                   hPutStr stderr ("Warning: Couldn't open " ++ f ++ ": " ++ err)
+-- >                   return "")
+--
+-- Note that we have to give a type signature to @e@, or the program
+-- will not typecheck as the type is ambiguous. While it is possible
+-- to catch exceptions of any type, see the section \"Catching all
+-- exceptions\" (in "Control.Exception") for an explanation of the problems with doing so.
+--
+-- For catching exceptions in pure (non-'IO') expressions, see the
+-- function 'evaluate'.
+--
+-- Note that due to Haskell\'s unspecified evaluation order, an
+-- expression may throw one of several possible exceptions: consider
+-- the expression @(error \"urk\") + (1 \`div\` 0)@.  Does
+-- the expression throw
+-- @ErrorCall \"urk\"@, or @DivideByZero@?
+--
+-- The answer is \"it might throw either\"; the choice is
+-- non-deterministic. If you are catching any type of exception then you
+-- might catch either. If you are calling @catch@ with type
+-- @IO Int -> (ArithException -> IO Int) -> IO Int@ then the handler may
+-- get run with @DivideByZero@ as an argument, or an @ErrorCall \"urk\"@
+-- exception may be propogated further up. If you call it again, you
+-- might get a the opposite behaviour. This is ok, because 'catch' is an
+-- 'IO' computation.
+--
+catch   :: Exception e
+        => IO a         -- ^ The computation to run
+        -> (e -> IO a)  -- ^ Handler to invoke if an exception is raised
+        -> IO a
+-- See #exceptions_and_strictness#.
+catch (IO io) handler = IO $ catch# io handler'
+    where handler' e = case fromException e of
+                       Just e' -> unIO (handler e')
+                       Nothing -> raiseIO# e
+
+
+-- | Catch any 'Exception' type in the 'IO' monad.
+--
+-- Note that this function is /strict/ in the action. That is,
+-- @catchAny undefined b == _|_@. See #exceptions_and_strictness# for
+-- details.
+catchAny :: IO a -> (forall e . Exception e => e -> IO a) -> IO a
+catchAny !(IO io) handler = IO $ catch# io handler'
+    where handler' (SomeException e) = unIO (handler e)
+
+-- Using catchException here means that if `m` throws an
+-- 'IOError' /as an imprecise exception/, we will not catch
+-- it. No one should really be doing that anyway.
+mplusIO :: IO a -> IO a -> IO a
+mplusIO m n = m `catchException` \ (_ :: IOError) -> n
+
+-- | A variant of 'throw' that can only be used within the 'IO' monad.
+--
+-- Although 'throwIO' has a type that is an instance of the type of 'throw', the
+-- two functions are subtly different:
+--
+-- > throw e   `seq` x  ===> throw e
+-- > throwIO e `seq` x  ===> x
+--
+-- The first example will cause the exception @e@ to be raised,
+-- whereas the second one won\'t.  In fact, 'throwIO' will only cause
+-- an exception to be raised when it is used within the 'IO' monad.
+-- The 'throwIO' variant should be used in preference to 'throw' to
+-- raise an exception within the 'IO' monad because it guarantees
+-- ordering with respect to other 'IO' operations, whereas 'throw'
+-- does not.
+throwIO :: Exception e => e -> IO a
+throwIO e = IO (raiseIO# (toException e))
 
------------------------------------------------------------------------------
--- Internal Utils
-
-illegalBufferSize :: Handle -> String -> Int -> IO a
-illegalBufferSize handle fn sz =
-        ioException (IOError (Just handle)
-                            InvalidArgument  fn
-                            ("illegal buffer size " ++ showsPrec 9 sz [])
-                            Nothing)
+-- -----------------------------------------------------------------------------
+-- Controlling asynchronous exception delivery
+
+-- Applying 'block' to a computation will
+-- execute that computation with asynchronous exceptions
+-- /blocked/.  That is, any thread which
+-- attempts to raise an exception in the current thread with 'Control.Exception.throwTo' will be
+-- blocked until asynchronous exceptions are unblocked again.  There\'s
+-- no need to worry about re-enabling asynchronous exceptions; that is
+-- done automatically on exiting the scope of
+-- 'block'.
+--
+-- Threads created by 'Control.Concurrent.forkIO' inherit the blocked
+-- state from the parent; that is, to start a thread in blocked mode,
+-- use @block $ forkIO ...@.  This is particularly useful if you need to
+-- establish an exception handler in the forked thread before any
+-- asynchronous exceptions are received.
+block :: IO a -> IO a
+block (IO io) = IO $ maskAsyncExceptions# io
+
+-- To re-enable asynchronous exceptions inside the scope of
+-- 'block', 'unblock' can be
+-- used.  It scopes in exactly the same way, so on exit from
+-- 'unblock' asynchronous exception delivery will
+-- be disabled again.
+unblock :: IO a -> IO a
+unblock = unsafeUnmask
+
+unsafeUnmask :: IO a -> IO a
+unsafeUnmask (IO io) = IO $ unmaskAsyncExceptions# io
+
+-- | Allow asynchronous exceptions to be raised even inside 'mask', making
+-- the operation interruptible (see the discussion of "Interruptible operations"
+-- in 'Control.Exception').
+--
+-- When called outside 'mask', or inside 'uninterruptibleMask', this
+-- function has no effect.
+--
+-- @since 4.9.0.0
+interruptible :: IO a -> IO a
+interruptible act = do
+  st <- getMaskingState
+  case st of
+    Unmasked              -> act
+    MaskedInterruptible   -> unsafeUnmask act
+    MaskedUninterruptible -> act
+
+blockUninterruptible :: IO a -> IO a
+blockUninterruptible (IO io) = IO $ maskUninterruptible# io
+
+-- | Describes the behaviour of a thread when an asynchronous
+-- exception is received.
+data MaskingState
+  = Unmasked -- ^ asynchronous exceptions are unmasked (the normal state)
+  | MaskedInterruptible
+      -- ^ the state during 'mask': asynchronous exceptions are masked, but blocking operations may still be interrupted
+  | MaskedUninterruptible
+      -- ^ the state during 'uninterruptibleMask': asynchronous exceptions are masked, and blocking operations may not be interrupted
+ deriving (Eq,Show)
+
+-- | Returns the 'MaskingState' for the current thread.
+getMaskingState :: IO MaskingState
+getMaskingState  = IO $ \s ->
+  case getMaskingState# s of
+     (# s', i #) -> (# s', case i of
+                             0# -> Unmasked
+                             1# -> MaskedUninterruptible
+                             _  -> MaskedInterruptible #)
+
+onException :: IO a -> IO b -> IO a
+onException io what = io `catchException` \e -> do _ <- what
+                                                   throwIO (e :: SomeException)
+
+-- | Executes an IO computation with asynchronous
+-- exceptions /masked/.  That is, any thread which attempts to raise
+-- an exception in the current thread with 'Control.Exception.throwTo'
+-- will be blocked until asynchronous exceptions are unmasked again.
+--
+-- The argument passed to 'mask' is a function that takes as its
+-- argument another function, which can be used to restore the
+-- prevailing masking state within the context of the masked
+-- computation.  For example, a common way to use 'mask' is to protect
+-- the acquisition of a resource:
+--
+-- > mask $ \restore -> do
+-- >     x <- acquire
+-- >     restore (do_something_with x) `onException` release
+-- >     release
+--
+-- This code guarantees that @acquire@ is paired with @release@, by masking
+-- asynchronous exceptions for the critical parts. (Rather than write
+-- this code yourself, it would be better to use
+-- 'Control.Exception.bracket' which abstracts the general pattern).
+--
+-- Note that the @restore@ action passed to the argument to 'mask'
+-- does not necessarily unmask asynchronous exceptions, it just
+-- restores the masking state to that of the enclosing context.  Thus
+-- if asynchronous exceptions are already masked, 'mask' cannot be used
+-- to unmask exceptions again.  This is so that if you call a library function
+-- with exceptions masked, you can be sure that the library call will not be
+-- able to unmask exceptions again.  If you are writing library code and need
+-- to use asynchronous exceptions, the only way is to create a new thread;
+-- see 'Control.Concurrent.forkIOWithUnmask'.
+--
+-- Asynchronous exceptions may still be received while in the masked
+-- state if the masked thread /blocks/ in certain ways; see
+-- "Control.Exception#interruptible".
+--
+-- Threads created by 'Control.Concurrent.forkIO' inherit the
+-- 'MaskingState' from the parent; that is, to start a thread in the
+-- 'MaskedInterruptible' state,
+-- use @mask_ $ forkIO ...@.  This is particularly useful if you need
+-- to establish an exception handler in the forked thread before any
+-- asynchronous exceptions are received.  To create a a new thread in
+-- an unmasked state use 'Control.Concurrent.forkIOUnmasked'.
+--
+mask  :: ((forall a. IO a -> IO a) -> IO b) -> IO b
+
+-- | Like 'mask', but does not pass a @restore@ action to the argument.
+mask_ :: IO a -> IO a
+
+-- | Like 'mask', but the masked computation is not interruptible (see
+-- "Control.Exception#interruptible").  THIS SHOULD BE USED WITH
+-- GREAT CARE, because if a thread executing in 'uninterruptibleMask'
+-- blocks for any reason, then the thread (and possibly the program,
+-- if this is the main thread) will be unresponsive and unkillable.
+-- This function should only be necessary if you need to mask
+-- exceptions around an interruptible operation, and you can guarantee
+-- that the interruptible operation will only block for a short period
+-- of time.
+--
+uninterruptibleMask :: ((forall a. IO a -> IO a) -> IO b) -> IO b
+
+-- | Like 'uninterruptibleMask', but does not pass a @restore@ action
+-- to the argument.
+uninterruptibleMask_ :: IO a -> IO a
+
+mask_ io = mask $ \_ -> io
+
+mask io = do
+  b <- getMaskingState
+  case b of
+    Unmasked              -> block $ io unblock
+    MaskedInterruptible   -> io block
+    MaskedUninterruptible -> io blockUninterruptible
+
+uninterruptibleMask_ io = uninterruptibleMask $ \_ -> io
+
+uninterruptibleMask io = do
+  b <- getMaskingState
+  case b of
+    Unmasked              -> blockUninterruptible $ io unblock
+    MaskedInterruptible   -> blockUninterruptible $ io block
+    MaskedUninterruptible -> io blockUninterruptible
+
+bracket
+        :: IO a         -- ^ computation to run first (\"acquire resource\")
+        -> (a -> IO b)  -- ^ computation to run last (\"release resource\")
+        -> (a -> IO c)  -- ^ computation to run in-between
+        -> IO c         -- returns the value from the in-between computation
+bracket before after thing =
+  mask $ \restore -> do
+    a <- before
+    r <- restore (thing a) `onException` after a
+    _ <- after a
+    return r
+
+finally :: IO a         -- ^ computation to run first
+        -> IO b         -- ^ computation to run afterward (even if an exception
+                        -- was raised)
+        -> IO a         -- returns the value from the first computation
+a `finally` sequel =
+  mask $ \restore -> do
+    r <- restore a `onException` sequel
+    _ <- sequel
+    return r
+
+-- | Evaluate the argument to weak head normal form.
+--
+-- 'evaluate' is typically used to uncover any exceptions that a lazy value
+-- may contain, and possibly handle them.
+--
+-- 'evaluate' only evaluates to /weak head normal form/. If deeper
+-- evaluation is needed, the @force@ function from @Control.DeepSeq@
+-- may be handy:
+--
+-- > evaluate $ force x
+--
+-- There is a subtle difference between @'evaluate' x@ and @'return' '$!' x@,
+-- analogous to the difference between 'throwIO' and 'throw'. If the lazy
+-- value @x@ throws an exception, @'return' '$!' x@ will fail to return an
+-- 'IO' action and will throw an exception instead. @'evaluate' x@, on the
+-- other hand, always produces an 'IO' action; that action will throw an
+-- exception upon /execution/ iff @x@ throws an exception upon /evaluation/.
+--
+-- The practical implication of this difference is that due to the
+-- /imprecise exceptions/ semantics,
+--
+-- > (return $! error "foo") >> error "bar"
+--
+-- may throw either @"foo"@ or @"bar"@, depending on the optimizations
+-- performed by the compiler. On the other hand,
+--
+-- > evaluate (error "foo") >> error "bar"
+--
+-- is guaranteed to throw @"foo"@.
+--
+-- The rule of thumb is to use 'evaluate' to force or handle exceptions in
+-- lazy values. If, on the other hand, you are forcing a lazy value for
+-- efficiency reasons only and do not care about exceptions, you may
+-- use @'return' '$!' x@.
+evaluate :: a -> IO a
+evaluate a = IO $ \s -> seq# a s -- NB. see #2273, #5129
+
+{- $exceptions_and_strictness
+
+Laziness can interact with @catch@-like operations in non-obvious ways (see,
+e.g. GHC Trac #11555 and #13330). For instance, consider these subtly-different
+examples:
+
+> test1 = Control.Exception.catch (error "uh oh") (\(_ :: SomeException) -> putStrLn "it failed")
+>
+> test2 = GHC.IO.catchException (error "uh oh") (\(_ :: SomeException) -> putStrLn "it failed")
+
+While @test1@ will print "it failed", @test2@ will print "uh oh".
+
+When using 'catchException', exceptions thrown while evaluating the
+action-to-be-executed will not be caught; only exceptions thrown during
+execution of the action will be handled by the exception handler.
+
+Since this strictness is a small optimization and may lead to surprising
+results, all of the @catch@ and @handle@ variants offered by "Control.Exception"
+use 'catch' rather than 'catchException'.
+-}