-{-# 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 #-}
hWaitForInput, hGetChar, hGetLine, hGetContents, hPutChar, hPutStr,
commitBuffer', -- hack, see below
hGetBuf, hGetBufSome, hGetBufNonBlocking, hPutBuf, hPutBufNonBlocking,
- memcpy,
+ memcpy, hPutStrLn,
) where
import GHC.IO
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
import Foreign
import Foreign.C
+import qualified Control.Exception as Exception
import Data.Typeable
import System.IO.Error
import Data.Maybe
-- 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.
--
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
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)
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')
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
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
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
-- * '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_)
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 ()
-- 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
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
-> 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.
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
-- 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
| 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
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)
-- ---------------------------------------------------------------------------
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
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__{..} =
--
-- 'hGetBufNonBlocking' ignores the prevailing 'TextEncoding' and
-- 'NewlineMode' on the 'Handle', and reads bytes directly.
+--
+-- NOTE: on Windows, this function does not work correctly; it
+-- behaves identically to 'hGetBuf'.
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 $ \ 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
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
projects / ghc-base.git / blobdiff