X-Git-Url: http://git.megacz.com/?p=ghc-base.git;a=blobdiff_plain;f=GHC%2FIO%2FHandle%2FText.hs;h=0d0e05b4d5fc93119730580e0f434ba9b1db505e;hp=e74371e7b1770ba37a9c68853df59fa0710cb0bf;hb=HEAD;hpb=26821e09c7f50cb850e9682e013a3f0cb4238f1c diff --git a/GHC/IO/Handle/Text.hs b/GHC/IO/Handle/Text.hs index e74371e..0d0e05b 100644 --- a/GHC/IO/Handle/Text.hs +++ b/GHC/IO/Handle/Text.hs @@ -1,5 +1,12 @@ -{-# OPTIONS_GHC -XNoImplicitPrelude -#include "HsBase.h" #-} -{-# OPTIONS_GHC -XRecordWildCards -XBangPatterns #-} +{-# LANGUAGE CPP + , NoImplicitPrelude + , RecordWildCards + , BangPatterns + , PatternGuards + , NondecreasingIndentation + , MagicHash + , ForeignFunctionInterface + #-} {-# OPTIONS_GHC -fno-warn-name-shadowing #-} {-# OPTIONS_GHC -fno-warn-unused-matches #-} {-# OPTIONS_HADDOCK hide #-} @@ -23,7 +30,7 @@ module GHC.IO.Handle.Text ( hWaitForInput, hGetChar, hGetLine, hGetContents, hPutChar, hPutStr, commitBuffer', -- hack, see below hGetBuf, hGetBufSome, hGetBufNonBlocking, hPutBuf, hPutBufNonBlocking, - memcpy, + memcpy, hPutStrLn, ) where import GHC.IO @@ -31,6 +38,7 @@ import GHC.IO.FD import GHC.IO.Buffer import qualified GHC.IO.BufferedIO as Buffered import GHC.IO.Exception +import GHC.IO.Encoding.Failure (surrogatifyRoundtripCharacter, desurrogatifyRoundtripCharacter) import GHC.Exception import GHC.IO.Handle.Types import GHC.IO.Handle.Internals @@ -40,6 +48,7 @@ import qualified GHC.IO.Device as RawIO import Foreign import Foreign.C +import qualified Control.Exception as Exception import Data.Typeable import System.IO.Error import Data.Maybe @@ -73,6 +82,7 @@ import GHC.List -- This operation may fail with: -- -- * 'isEOFError' if the end of file has been reached. +-- -- * a decoding error, if the input begins with an invalid byte sequence -- in this Handle's encoding. -- @@ -240,12 +250,12 @@ hGetLineBufferedLoop handle_@Handle__{..} maybeFillReadBuffer :: Handle__ -> CharBuffer -> IO (Maybe CharBuffer) maybeFillReadBuffer handle_ buf - = catch + = Exception.catch (do buf' <- getSomeCharacters handle_ buf return (Just buf') ) - (\e -> do if isEOFError e - then return Nothing + (\e -> do if isEOFError e + then return Nothing else ioError e) -- See GHC.IO.Buffer @@ -270,10 +280,10 @@ unpack !buf !r !w acc0 else do c1 <- peekElemOff pbuf (i-1) let c = (fromIntegral c1 - 0xd800) * 0x400 + (fromIntegral c2 - 0xdc00) + 0x10000 - unpackRB (unsafeChr c : acc) (i-2) + unpackRB (desurrogatifyRoundtripCharacter (unsafeChr c) : acc) (i-2) #else c <- peekElemOff pbuf i - unpackRB (c:acc) (i-1) + unpackRB (desurrogatifyRoundtripCharacter c:acc) (i-1) #endif in unpackRB acc0 (w-1) @@ -296,7 +306,7 @@ unpack_nl !buf !r !w acc0 then unpackRB ('\n':acc) (i-2) else unpackRB ('\n':acc) (i-1) else do - unpackRB (c:acc) (i-1) + unpackRB (desurrogatifyRoundtripCharacter c:acc) (i-1) in do c <- peekElemOff pbuf (w-1) if (c == '\r') @@ -370,8 +380,8 @@ lazyRead handle = lazyReadBuffered :: Handle -> Handle__ -> IO (Handle__, [Char]) lazyReadBuffered h handle_@Handle__{..} = do buf <- readIORef haCharBuffer - catch - (do + Exception.catch + (do buf'@Buffer{..} <- getSomeCharacters handle_ buf lazy_rest <- lazyRead h (s,r) <- if haInputNL == CRLF @@ -439,12 +449,10 @@ hPutChar :: Handle -> Char -> IO () hPutChar handle c = do c `seq` return () wantWritableHandle "hPutChar" handle $ \ handle_ -> do - case haBufferMode handle_ of - LineBuffering -> hPutcBuffered handle_ True c - _other -> hPutcBuffered handle_ False c + hPutcBuffered handle_ c -hPutcBuffered :: Handle__ -> Bool -> Char -> IO () -hPutcBuffered handle_@Handle__{..} is_line c = do +hPutcBuffered :: Handle__ -> Char -> IO () +hPutcBuffered handle_@Handle__{..} c = do buf <- readIORef haCharBuffer if c == '\n' then do buf1 <- if haOutputNL == CRLF @@ -453,23 +461,21 @@ hPutcBuffered handle_@Handle__{..} is_line c = do putc buf1 '\n' else do putc buf '\n' - if is_line - then do - flushed_buf <- flushWriteBuffer_ handle_ buf1 - writeIORef haCharBuffer flushed_buf - else - writeIORef haCharBuffer buf1 + writeCharBuffer handle_ buf1 + when is_line $ flushByteWriteBuffer handle_ else do buf1 <- putc buf c - writeIORef haCharBuffer buf1 + writeCharBuffer handle_ buf1 + return () where + is_line = case haBufferMode of + LineBuffering -> True + _ -> False + putc buf@Buffer{ bufRaw=raw, bufR=w } c = do debugIO ("putc: " ++ summaryBuffer buf) w' <- writeCharBuf raw w c - let buf' = buf{ bufR = w' } - if isFullCharBuffer buf' - then flushWriteBuffer_ handle_ buf' - else return buf' + return buf{ bufR = w' } -- --------------------------------------------------------------------------- -- hPutStr @@ -501,8 +507,19 @@ hPutcBuffered handle_@Handle__{..} is_line c = do -- * 'isPermissionError' if another system resource limit would be exceeded. hPutStr :: Handle -> String -> IO () -hPutStr handle str = do - (buffer_mode, nl) <- +hPutStr handle str = hPutStr' handle str False + +-- | The same as 'hPutStr', but adds a newline character. +hPutStrLn :: Handle -> String -> IO () +hPutStrLn handle str = hPutStr' handle str True + -- An optimisation: we treat hPutStrLn specially, to avoid the + -- overhead of a single putChar '\n', which is quite high now that we + -- have to encode eagerly. + +hPutStr' :: Handle -> String -> Bool -> IO () +hPutStr' handle str add_nl = + do + (buffer_mode, nl) <- wantWritableHandle "hPutStr" handle $ \h_ -> do bmode <- getSpareBuffer h_ return (bmode, haOutputNL h_) @@ -510,10 +527,11 @@ hPutStr handle str = do case buffer_mode of (NoBuffering, _) -> do hPutChars handle str -- v. slow, but we don't care + when add_nl $ hPutChar handle '\n' (LineBuffering, buf) -> do - writeBlocks handle True nl buf str + writeBlocks handle True add_nl nl buf str (BlockBuffering _, buf) -> do - writeBlocks handle False nl buf str + writeBlocks handle False add_nl nl buf str hPutChars :: Handle -> [Char] -> IO () hPutChars _ [] = return () @@ -539,19 +557,20 @@ getSpareBuffer Handle__{haCharBuffer=ref, -- NB. performance-critical code: eyeball the Core. -writeBlocks :: Handle -> Bool -> Newline -> Buffer CharBufElem -> String -> IO () -writeBlocks hdl line_buffered nl +writeBlocks :: Handle -> Bool -> Bool -> Newline -> Buffer CharBufElem -> String -> IO () +writeBlocks hdl line_buffered add_nl nl buf@Buffer{ bufRaw=raw, bufSize=len } s = let - shoveString :: Int -> [Char] -> IO () - shoveString !n [] = do - _ <- commitBuffer hdl raw len n False{-no flush-} True{-release-} - return () - shoveString !n (c:cs) + shoveString :: Int -> [Char] -> [Char] -> IO () + shoveString !n [] [] = do + commitBuffer hdl raw len n False{-no flush-} True{-release-} + shoveString !n [] rest = do + shoveString n rest [] + shoveString !n (c:cs) rest -- n+1 so we have enough room to write '\r\n' if necessary | n + 1 >= len = do - new_buf <- commitBuffer hdl raw len n True{-needs flush-} False - writeBlocks hdl line_buffered nl new_buf (c:cs) + commitBuffer hdl raw len n False{-flush-} False + shoveString 0 (c:cs) rest | c == '\n' = do n' <- if nl == CRLF then do @@ -561,36 +580,22 @@ writeBlocks hdl line_buffered nl writeCharBuf raw n c if line_buffered then do - new_buf <- commitBuffer hdl raw len n' True{-needs flush-} False - writeBlocks hdl line_buffered nl new_buf cs + -- end of line, so write and flush + commitBuffer hdl raw len n' True{-flush-} False + shoveString 0 cs rest else do - shoveString n' cs + shoveString n' cs rest | otherwise = do - n' <- writeCharBuf raw n c - shoveString n' cs + n' <- writeCharBuf raw n (surrogatifyRoundtripCharacter c) + shoveString n' cs rest in - shoveString 0 s + shoveString 0 s (if add_nl then "\n" else "") -- ----------------------------------------------------------------------------- -- 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 @@ -598,93 +603,52 @@ commitBuffer -> Int -- number of bytes of data in buffer -> Bool -- True <=> flush the handle afterward -> Bool -- release the buffer? - -> IO CharBuffer + -> IO () commitBuffer hdl !raw !sz !count flush release = - wantWritableHandle "commitAndReleaseBuffer" hdl $ - commitBuffer' raw sz count flush release -{-# NOINLINE commitBuffer #-} - --- 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 --- + wantWritableHandle "commitBuffer" hdl $ \h_@Handle__{..} -> do + debugIO ("commitBuffer: sz=" ++ show sz ++ ", count=" ++ show count + ++ ", flush=" ++ show flush ++ ", release=" ++ show release) + + writeCharBuffer h_ Buffer{ bufRaw=raw, bufState=WriteBuffer, + bufL=0, bufR=count, bufSize=sz } + + when flush $ flushByteWriteBuffer h_ + + -- release the buffer if necessary + when release $ do + -- find size of current buffer + old_buf@Buffer{ bufSize=size } <- readIORef haCharBuffer + when (sz == size) $ do + spare_bufs <- readIORef haBuffers + writeIORef haBuffers (BufferListCons raw spare_bufs) + + return () + +-- backwards compatibility; the text package uses this commitBuffer' :: RawCharBuffer -> Int -> Int -> Bool -> Bool -> Handle__ -> IO CharBuffer -commitBuffer' raw sz@(I# _) count@(I# _) flush release - handle_@Handle__{ haCharBuffer=ref, haBuffers=spare_buf_ref } = do - +commitBuffer' raw sz@(I# _) count@(I# _) flush release h_@Handle__{..} + = do debugIO ("commitBuffer: sz=" ++ show sz ++ ", count=" ++ show count ++ ", flush=" ++ show flush ++ ", release=" ++ show release) - old_buf@Buffer{ bufRaw=old_raw, bufR=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 bufR. - then do withRawBuffer raw $ \praw -> - copyToRawBuffer old_raw (w*charSize) - praw (fromIntegral (count*charSize)) - writeIORef ref old_buf{ bufR = w + count } - return (emptyBuffer raw sz WriteBuffer) - - -- else, we have to flush - else do flushed_buf <- flushWriteBuffer_ handle_ old_buf - - let this_buf = - Buffer{ bufRaw=raw, bufState=WriteBuffer, - bufL=0, bufR=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 - -- We're aren't going to use this buffer again - -- so we ignore the result of flushWriteBuffer_ - _ <- flushWriteBuffer_ 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 (emptyBuffer raw sz WriteBuffer) - else newCharBuffer size WriteBuffer + let this_buf = Buffer{ bufRaw=raw, bufState=WriteBuffer, + bufL=0, bufR=count, bufSize=sz } + + writeCharBuffer h_ this_buf + + when flush $ flushByteWriteBuffer h_ -- release the buffer if necessary - case buf_ret of - Buffer{ bufSize=buf_ret_sz, bufRaw=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 + when release $ do + -- find size of current buffer + old_buf@Buffer{ bufSize=size } <- readIORef haCharBuffer + when (sz == size) $ do + spare_bufs <- readIORef haBuffers + writeIORef haBuffers (BufferListCons raw spare_bufs) + + return this_buf -- --------------------------------------------------------------------------- -- Reading/writing sequences of bytes. @@ -734,10 +698,6 @@ hPutBuf' handle ptr count can_block wantWritableHandle "hPutBuf" handle $ \ h_@Handle__{..} -> do debugIO ("hPutBuf count=" ++ show count) - -- first flush the Char buffer if it is non-empty, then we - -- can work directly with the byte buffer - cbuf <- readIORef haCharBuffer - when (not (isEmptyBuffer cbuf)) $ flushWriteBuffer h_ r <- bufWrite h_ (castPtr ptr) count can_block @@ -760,7 +720,7 @@ bufWrite h_@Handle__{..} ptr count can_block = -- There's enough room in the buffer: -- just copy the data in and update bufR. then do debugIO ("hPutBuf: copying to buffer, w=" ++ show w) - copyToRawBuffer old_raw w ptr (fromIntegral count) + copyToRawBuffer old_raw w ptr count writeIORef haByteBuffer old_buf{ bufR = w + count } return count @@ -810,34 +770,24 @@ hGetBuf h ptr count | count == 0 = return 0 | count < 0 = illegalBufferSize h "hGetBuf" count | otherwise = - wantReadableHandle_ "hGetBuf" h $ \ h_ -> do + wantReadableHandle_ "hGetBuf" h $ \ h_@Handle__{..} -> do flushCharReadBuffer h_ - bufRead h_ (castPtr ptr) 0 count + buf@Buffer{ bufRaw=raw, bufR=w, bufL=r, bufSize=sz } + <- readIORef haByteBuffer + if isEmptyBuffer buf + then bufReadEmpty h_ buf (castPtr ptr) 0 count + else bufReadNonEmpty h_ buf (castPtr 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 :: Handle__ -> Ptr Word8 -> Int -> Int -> IO Int -bufRead h_@Handle__{..} ptr so_far count = - seq so_far $ seq count $ do -- strictness hack - buf@Buffer{ bufRaw=raw, bufR=w, bufL=r, bufSize=sz } <- readIORef haByteBuffer - if isEmptyBuffer buf - then if count > sz -- small read? - then do rest <- readChunk h_ ptr count - return (so_far + rest) - else do (r,buf') <- Buffered.fillReadBuffer haDevice buf - if r == 0 - then return so_far - else do writeIORef haByteBuffer buf' - bufRead h_ ptr so_far count - else do + +bufReadNonEmpty :: Handle__ -> Buffer Word8 -> Ptr Word8 -> Int -> Int -> IO Int +bufReadNonEmpty h_@Handle__{..} + buf@Buffer{ bufRaw=raw, bufR=w, bufL=r, bufSize=sz } + ptr !so_far !count + = do let avail = w - r - if (count == avail) - then do - copyFromRawBuffer ptr raw r count - writeIORef haByteBuffer buf{ bufR=0, bufL=0 } - return (so_far + count) - else do if (count < avail) then do copyFromRawBuffer ptr raw r count @@ -845,30 +795,36 @@ bufRead h_@Handle__{..} ptr so_far count = return (so_far + count) else do - copyFromRawBuffer ptr raw (fromIntegral r) (fromIntegral avail) - writeIORef haByteBuffer buf{ bufR=0, bufL=0 } + copyFromRawBuffer ptr raw r avail + let buf' = buf{ bufR=0, bufL=0 } + writeIORef haByteBuffer buf' let remaining = count - avail so_far' = so_far + avail ptr' = ptr `plusPtr` avail - if remaining < sz - then bufRead h_ ptr' so_far' remaining - else do - - rest <- readChunk h_ ptr' remaining - return (so_far' + rest) - -readChunk :: Handle__ -> Ptr a -> Int -> IO Int -readChunk h_@Handle__{..} ptr bytes - | Just fd <- cast haDevice = loop fd 0 bytes - | otherwise = error "ToDo: hGetBuf" + if remaining == 0 + then return so_far' + else bufReadEmpty h_ buf' ptr' so_far' remaining + + +bufReadEmpty :: Handle__ -> Buffer Word8 -> Ptr Word8 -> Int -> Int -> IO Int +bufReadEmpty h_@Handle__{..} + buf@Buffer{ bufRaw=raw, bufR=w, bufL=r, bufSize=sz } + ptr so_far count + | count > sz, Just fd <- cast haDevice = loop fd 0 count + | otherwise = do + (r,buf') <- Buffered.fillReadBuffer haDevice buf + if r == 0 + then return so_far + else do writeIORef haByteBuffer buf' + bufReadNonEmpty h_ buf' ptr so_far count where loop :: FD -> Int -> Int -> IO Int - loop fd off bytes | bytes <= 0 = return off + loop fd off bytes | bytes <= 0 = return (so_far + off) loop fd off bytes = do - r <- RawIO.read (fd::FD) (ptr `plusPtr` off) (fromIntegral bytes) + r <- RawIO.read (fd::FD) (ptr `plusPtr` off) bytes if r == 0 - then return off + then return (so_far + off) else loop fd (off + r) (bytes - r) -- --------------------------------------------------------------------------- @@ -894,9 +850,9 @@ readChunk h_@Handle__{..} ptr bytes hGetBufSome :: Handle -> Ptr a -> Int -> IO Int hGetBufSome h ptr count | count == 0 = return 0 - | count < 0 = illegalBufferSize h "hGetBuf" count + | count < 0 = illegalBufferSize h "hGetBufSome" count | otherwise = - wantReadableHandle_ "hGetBuf" h $ \ h_@Handle__{..} -> do + wantReadableHandle_ "hGetBufSome" h $ \ h_@Handle__{..} -> do flushCharReadBuffer h_ buf@Buffer{ bufSize=sz } <- readIORef haByteBuffer if isEmptyBuffer buf @@ -906,9 +862,12 @@ hGetBufSome h ptr count if r == 0 then return 0 else do writeIORef haByteBuffer buf' - bufReadNBNonEmpty h_ buf' (castPtr ptr) 0 count + bufReadNBNonEmpty h_ buf' (castPtr ptr) 0 (min r count) + -- new count is (min r count), so + -- that bufReadNBNonEmpty will not + -- issue another read. else - bufReadNBEmpty h_ buf (castPtr ptr) 0 count + bufReadNBNonEmpty h_ buf (castPtr ptr) 0 count haFD :: Handle__ -> FD haFD h_@Handle__{..} = @@ -940,49 +899,46 @@ hGetBufNonBlocking h ptr count | count == 0 = return 0 | count < 0 = illegalBufferSize h "hGetBufNonBlocking" count | otherwise = - wantReadableHandle_ "hGetBufNonBlocking" h $ \ h_ -> do + wantReadableHandle_ "hGetBufNonBlocking" h $ \ h_@Handle__{..} -> do flushCharReadBuffer h_ - bufReadNonBlocking h_ (castPtr ptr) 0 count - -bufReadNonBlocking :: Handle__ -> Ptr Word8 -> Int -> Int -> IO Int -bufReadNonBlocking h_@Handle__{..} ptr so_far count = - seq so_far $ seq count $ do -- strictness hack - buf@Buffer{ bufRaw=raw, bufR=w, bufL=r, bufSize=sz } <- readIORef haByteBuffer - if isEmptyBuffer buf - then bufReadNBEmpty h_ buf ptr so_far count - else bufReadNBNonEmpty h_ buf ptr so_far count + buf@Buffer{ bufRaw=raw, bufR=w, bufL=r, bufSize=sz } + <- readIORef haByteBuffer + if isEmptyBuffer buf + then bufReadNBEmpty h_ buf (castPtr ptr) 0 count + else bufReadNBNonEmpty h_ buf (castPtr ptr) 0 count bufReadNBEmpty :: Handle__ -> Buffer Word8 -> Ptr Word8 -> Int -> Int -> IO Int bufReadNBEmpty h_@Handle__{..} buf@Buffer{ bufRaw=raw, bufR=w, bufL=r, bufSize=sz } ptr so_far count - = if count > sz -- large read? - then do rest <- readChunkNonBlocking h_ ptr count - return (so_far + rest) - else do (r,buf') <- Buffered.fillReadBuffer0 haDevice buf - case r of - Nothing -> return so_far - Just 0 -> return so_far - Just r -> do - writeIORef haByteBuffer buf' - bufReadNBNonEmpty h_ buf' ptr so_far (min count r) - -- NOTE: new count is min count w' + | count > sz, + Just fd <- cast haDevice = do + m <- RawIO.readNonBlocking (fd::FD) ptr count + case m of + Nothing -> return so_far + Just n -> return (so_far + n) + + | otherwise = do + buf <- readIORef haByteBuffer + (r,buf') <- Buffered.fillReadBuffer0 haDevice buf + case r of + Nothing -> return so_far + Just 0 -> return so_far + Just r -> do + writeIORef haByteBuffer buf' + bufReadNBNonEmpty h_ buf' ptr so_far (min count r) + -- NOTE: new count is min count r -- so we will just copy the contents of the -- buffer in the recursive call, and not -- loop again. + bufReadNBNonEmpty :: Handle__ -> Buffer Word8 -> Ptr Word8 -> Int -> Int -> IO Int bufReadNBNonEmpty h_@Handle__{..} buf@Buffer{ bufRaw=raw, bufR=w, bufL=r, bufSize=sz } ptr so_far count = do let avail = w - r - if (count == avail) - then do - copyFromRawBuffer ptr raw r count - writeIORef haByteBuffer buf{ bufR=0, bufL=0 } - return (so_far + count) - else do if (count < avail) then do copyFromRawBuffer ptr raw r count @@ -990,24 +946,16 @@ bufReadNBNonEmpty h_@Handle__{..} return (so_far + count) else do - copyFromRawBuffer ptr raw (fromIntegral r) (fromIntegral avail) + copyFromRawBuffer ptr raw r avail let buf' = buf{ bufR=0, bufL=0 } writeIORef haByteBuffer buf' let remaining = count - avail so_far' = so_far + avail ptr' = ptr `plusPtr` avail - bufReadNBEmpty h_ buf' ptr' so_far' remaining - - -readChunkNonBlocking :: Handle__ -> Ptr Word8 -> Int -> IO Int -readChunkNonBlocking h_@Handle__{..} ptr bytes - | Just fd <- cast haDevice = do - m <- RawIO.readNonBlocking (fd::FD) ptr bytes - case m of - Nothing -> return 0 - Just n -> return n - | otherwise = error "ToDo: hGetBuf" + if remaining == 0 + then return so_far' + else bufReadNBEmpty h_ buf' ptr' so_far' remaining -- --------------------------------------------------------------------------- -- memcpy wrappers