Fix comment
[ghc.git] / libraries / base / GHC / IO.hs
index 9467c53..8459db6 100644 (file)
-{-# OPTIONS -fno-implicit-prelude -#include "HsBase.h" #-}
-
-#undef DEBUG_DUMP
+{-# LANGUAGE Unsafe #-}
+{-# LANGUAGE NoImplicitPrelude
+           , BangPatterns
+           , RankNTypes
+           , MagicHash
+           , ScopedTypeVariables
+           , UnboxedTuples
+  #-}
+{-# OPTIONS_GHC -funbox-strict-fields #-}
+{-# OPTIONS_HADDOCK hide #-}
 
 -----------------------------------------------------------------------------
 -- |
 -- 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.
 --
 -----------------------------------------------------------------------------
 
-module GHC.IO ( 
-   hWaitForInput, hGetChar, hGetLine, hGetContents, hPutChar, hPutStr,
-   commitBuffer',      -- hack, see below
-   hGetcBuffered,      -- needed by ghc/compiler/utils/StringBuffer.lhs
-   hGetBuf, hPutBuf, 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 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.Posix
-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.Exception    ( ioError, catch, throw )
-import GHC.Conc
+import GHC.IO.Unsafe
+
+import {-# SOURCE #-} GHC.IO.Exception ( userError, IOError )
 
 -- ---------------------------------------------------------------------------
--- Simple input operations
+-- The IO Monad
 
--- Computation "hReady hdl" indicates whether at least
--- one item is available for input from handle "hdl".
+{-
+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.
 
--- 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.
+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)
 
-  r <- throwErrnoIfMinus1Retry "hWaitForInput"
-         (inputReady (fromIntegral (haFD handle_)) (fromIntegral msecs) (haIsStream handle_))
-  return (r /= 0)
+Prelude   - GHC.IO.hs, and several other places including
+            GHC.Exception.hs.
 
-foreign import ccall unsafe "inputReady"
-  inputReady :: CInt -> CInt -> Bool -> IO CInt
+Libraries - parts of hslibs/lang.
 
--- ---------------------------------------------------------------------------
--- hGetChar
-
--- hGetChar reads the next character from a handle,
--- blocking until a character is available.
-
-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 False (haIsStream handle_) buf
-       hGetcBuffered fd ref new_buf
-    NoBuffering -> do
-       -- make use of the minimal buffer we already have
-       let raw = bufBuf buf
-       r <- throwErrnoIfMinus1RetryMayBlock "hGetChar"
-               (read_off_ba (fromIntegral fd) (haIsStream handle_) raw 0 1)
-               (threadWaitRead fd)
-       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
-
--- If EOF is reached before EOL is encountered, ignore the EOF and
--- return the partial line. Next attempt at calling hGetLine on the
--- handle will yield an EOF IO exception though.
-
--- ToDo: the unbuffered case is wrong: it doesn't lock the handle for
--- the duration.
-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_ = do
-  let ref = haBuffer handle_
-  buf <- readIORef ref
-  hGetLineBufferedLoop handle_ ref buf []
-
-
-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
-       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 -> let str = concat (reverse (xs:xss)) in
-                          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 throw 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 returns the list of characters corresponding to the
--- unread portion of the channel or file managed by the handle, which
--- is made semi-closed.
-
--- hGetContents on a DuplexHandle only affects the read side: you can
--- carry on writing to it afterwards.
-
-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 <- throwErrnoIfMinus1RetryMayBlock "lazyRead"
-               (read_off_ba (fromIntegral fd) (haIsStream handle_) raw 0 1)
-               (threadWaitRead fd)
-       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
-
--- `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'.
-
-hPutChar :: Handle -> Char -> IO ()
-hPutChar handle c = 
-    c `seq` do   -- must evaluate c before grabbing the handle lock
-    wantWritableHandle "hPutChar" handle $ \ handle_  -> do
-    let fd = haFD handle_
-    case haBufferMode handle_ of
-       LineBuffering    -> hPutcBuffered handle_ True  c
-       BlockBuffering _ -> hPutcBuffered handle_ False c
-       NoBuffering      ->
-               withObject (castCharToCChar c) $ \buf ->
-               throwErrnoIfMinus1RetryMayBlock_ "hPutChar"
-                  (write_off (fromIntegral fd) (haIsStream handle_) buf 0 1)
-                  (threadWaitWrite fd)
-
-
-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
-
--- `hPutStr hdl s' writes the string `s' to the file or
--- hannel managed by `hdl', buffering the output if needs be.
-
--- 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.
-
-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
+
+ioToST        :: IO a -> ST RealWorld a
+ioToST (IO m) = (ST m)
+
+-- 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
+
+unsafeSTToIO :: ST s a -> IO a
+unsafeSTToIO (ST m) = IO (unsafeCoerce# 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' hdl 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' hdl 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 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
+-- | 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.
 
--- ---------------------------------------------------------------------------
--- Reading/writing sequences of bytes.
+type FilePath = String
+
+-- -----------------------------------------------------------------------------
+-- Primitive catch and throwIO
 
 {-
-Semantics of hGetBuf:
+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...).
 
-   - hGetBuf reads data into the buffer until either
+Now catch# has type
 
-       (a) EOF is reached
-       (b) the buffer is full
-     
-     It returns the amount of data actually read.  This may
-     be zero in case (a).  hGetBuf never raises
-     an EOF exception, it always returns zero instead.
+    catch# :: IO a -> (b -> IO a) -> IO a
 
-     If the handle is a pipe or socket, and the writing end
-     is closed, hGetBuf will behave as for condition (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).
+-}
 
-Semantics of hPutBuf:
+-- | 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))
 
-    - hPutBuf writes data from the buffer to the handle 
-      until the buffer is empty.  It returns ().
+-- -----------------------------------------------------------------------------
+-- 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
 
-      If the handle is a pipe or socket, and the reading end is
-      closed, hPutBuf will raise a ResourceVanished exception.
-      (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).
--}
+{- $exceptions_and_strictness
 
--- ---------------------------------------------------------------------------
--- hPutBuf
-
-hPutBuf :: Handle                      -- handle to write to
-       -> Ptr a                        -- address of buffer
-       -> Int                          -- number of bytes of data in buffer
-       -> IO ()
-hPutBuf handle ptr count
-  | count == 0 = return ()
-  | count <  0 = illegalBufferSize handle "hPutBuf" count
-  | otherwise = 
-    wantWritableHandle "hPutBuf" handle $ 
-      \ handle_@Handle__{ haFD=fd, haBuffer=ref, haIsStream=is_stream } -> do
-
-        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 w ptr (fromIntegral count)
-                   writeIORef ref old_buf{ bufWPtr = w + count }
-                   return ()
-
-               -- else, we have to flush
-           else do flushed_buf <- flushWriteBuffer fd is_stream old_buf
-                   writeIORef ref flushed_buf
-                   -- ToDo: should just memcpy instead of writing if possible
-                   writeChunk fd ptr count
-
-writeChunk :: FD -> Ptr a -> Int -> IO ()
-writeChunk fd ptr bytes = loop 0 bytes 
- where
-  loop :: Int -> Int -> IO ()
-  loop _   bytes | bytes <= 0 = return ()
-  loop off bytes = do
-    r <- fromIntegral `liftM`
-          throwErrnoIfMinus1RetryMayBlock "writeChunk"
-           (c_write (fromIntegral fd) (ptr `plusPtr` off) (fromIntegral bytes))
-           (threadWaitWrite fd)
-    -- write can't return 0
-    loop (off + r) (bytes - r)
+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:
 
--- ---------------------------------------------------------------------------
--- hGetBuf
-
-hGetBuf :: Handle -> Ptr a -> Int -> IO Int
-hGetBuf handle ptr count
-  | count == 0 = return 0
-  | count <  0 = illegalBufferSize handle "hGetBuf" count
-  | otherwise = 
-      wantReadableHandle "hGetBuf" handle $ 
-       \ handle_@Handle__{ haFD=fd, haBuffer=ref } -> do
-       buf@Buffer{ bufBuf=raw, bufWPtr=w, bufRPtr=r } <- readIORef ref
-       if bufferEmpty buf
-          then readChunk fd ptr count
-          else do 
-               let avail = w - r
-               copied <- if (count >= avail)
-                           then do 
-                               memcpy_ptr_baoff ptr raw r (fromIntegral avail)
-                               writeIORef ref buf{ bufWPtr=0, bufRPtr=0 }
-                               return avail
-                           else do
-                               memcpy_ptr_baoff ptr raw r (fromIntegral count)
-                               writeIORef ref buf{ bufRPtr = r + count }
-                               return count
-
-               let remaining = count - copied
-               if remaining > 0 
-                  then do rest <- readChunk fd (ptr `plusPtr` copied) remaining
-                          return (rest + copied)
-                  else return count
-               
-readChunk :: FD -> Ptr a -> Int -> IO Int
-readChunk fd 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`
-          throwErrnoIfMinus1RetryMayBlock "readChunk"
-           (c_read (fromIntegral fd) (ptr `plusPtr` off) (fromIntegral bytes))
-           (threadWaitRead fd)
-    if r == 0
-       then return off
-       else loop (off + r) (bytes - r)
-
-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)
+> test1 = Control.Exception.catch (error "uh oh") (\(_ :: SomeException) -> putStrLn "it failed")
+>
+> test2 = GHC.IO.catchException (error "uh oh") (\(_ :: SomeException) -> putStrLn "it failed")
 
--- ---------------------------------------------------------------------------
--- memcpy wrappers
+While @test1@ will print "it failed", @test2@ will print "uh oh".
 
-foreign import ccall unsafe "__hscore_memcpy_src_off"
-   memcpy_ba_baoff :: RawBuffer -> RawBuffer -> Int -> CSize -> IO (Ptr ())
-foreign import ccall unsafe "__hscore_memcpy_src_off"
-   memcpy_ptr_baoff :: Ptr a -> RawBuffer -> Int -> CSize -> IO (Ptr ())
-foreign import ccall unsafe "__hscore_memcpy_dst_off"
-   memcpy_baoff_ba :: RawBuffer -> Int -> RawBuffer -> CSize -> IO (Ptr ())
-foreign import ccall unsafe "__hscore_memcpy_dst_off"
-   memcpy_baoff_ptr :: RawBuffer -> Int -> Ptr a -> CSize -> IO (Ptr ())
+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.
 
------------------------------------------------------------------------------
--- Internal Utils
-
-illegalBufferSize :: Handle -> String -> Int -> IO a
-illegalBufferSize handle fn (sz :: Int) = 
-       ioException (IOError (Just handle)
-                           InvalidArgument  fn
-                           ("illegal buffer size " ++ showsPrec 9 sz [])
-                           Nothing)
+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'.
+-}