From: Simon Marlow Date: Thu, 25 Nov 2010 10:25:20 +0000 (+0000) Subject: Encode immediately in hPutStr and hPutChar X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=5522b142e24b9dbba21a9036746db20e78cf8f43;hp=85ed71ab833a40f5acfeb4610a0aa3c3c3e1a35b;p=ghc-base.git Encode immediately in hPutStr and hPutChar This means that decoding errors will be detected accurately, and can be caught and handled. Overall the implementation is simpler this way too. It does impose a performance hit on small hPutStrs, although larger hPutStrs seem to be unaffected. To compensate somewhat, I optimised hPutStrLn. --- diff --git a/GHC/IO/Handle.hs b/GHC/IO/Handle.hs index 10b7004..bb45b15 100644 --- a/GHC/IO/Handle.hs +++ b/GHC/IO/Handle.hs @@ -206,32 +206,12 @@ hSetBuffering handle mode = _ -> do if mode == haBufferMode then return handle_ else do - {- Note: - - we flush the old buffer regardless of whether - the new buffer could fit the contents of the old buffer - or not. - - allow a handle's buffering to change even if IO has - occurred (ANSI C spec. does not allow this, nor did - the previous implementation of IO.hSetBuffering). - - a non-standard extension is to allow the buffering - of semi-closed handles to change [sof 6/98] - -} - flushCharBuffer handle_ - - let state = initBufferState haType - reading = not (isWritableHandleType haType) - - new_buf <- - case mode of - -- See [note Buffer Sizing], GHC.IO.Handle.Types - NoBuffering | reading -> newCharBuffer dEFAULT_CHAR_BUFFER_SIZE state - | otherwise -> newCharBuffer 1 state - LineBuffering -> newCharBuffer dEFAULT_CHAR_BUFFER_SIZE state - BlockBuffering Nothing -> newCharBuffer dEFAULT_CHAR_BUFFER_SIZE state - BlockBuffering (Just n) | n <= 0 -> ioe_bufsiz n - | otherwise -> newCharBuffer n state + -- See [note Buffer Sizing] in GHC.IO.Handle.Types - writeIORef haCharBuffer new_buf + -- check for errors: + case mode of + BlockBuffering (Just n) | n <= 0 -> ioe_bufsiz n + _ -> return () -- for input terminals we need to put the terminal into -- cooked or raw mode depending on the type of buffering. diff --git a/GHC/IO/Handle/Internals.hs b/GHC/IO/Handle/Internals.hs index 4dde4a9..1e48e8b 100644 --- a/GHC/IO/Handle/Internals.hs +++ b/GHC/IO/Handle/Internals.hs @@ -30,10 +30,10 @@ module GHC.IO.Handle.Internals ( openTextEncoding, closeTextCodecs, initBufferState, dEFAULT_CHAR_BUFFER_SIZE, - flushBuffer, flushWriteBuffer, flushWriteBuffer_, flushCharReadBuffer, - flushCharBuffer, flushByteReadBuffer, + flushBuffer, flushWriteBuffer, flushCharReadBuffer, + flushCharBuffer, flushByteReadBuffer, flushByteWriteBuffer, - readTextDevice, writeTextDevice, readTextDeviceNonBlocking, + readTextDevice, writeCharBuffer, readTextDeviceNonBlocking, decodeByteBuf, augmentIOError, @@ -275,9 +275,10 @@ checkReadableHandle act h_@Handle__{..} = ReadWriteHandle -> do -- a read/write handle and we want to read from it. We must -- flush all buffered write data first. - cbuf <- readIORef haCharBuffer - when (isWriteBuffer cbuf) $ do - cbuf' <- flushWriteBuffer_ h_ cbuf + bbuf <- readIORef haByteBuffer + when (isWriteBuffer bbuf) $ do + when (not (isEmptyBuffer bbuf)) $ flushByteWriteBuffer h_ + cbuf' <- readIORef haCharBuffer writeIORef haCharBuffer cbuf'{ bufState = ReadBuffer } bbuf <- readIORef haByteBuffer writeIORef haByteBuffer bbuf{ bufState = ReadBuffer } @@ -402,9 +403,8 @@ getCharBuffer dev state = do mkUnBuffer :: BufferState -> IO (IORef CharBuffer, BufferMode) mkUnBuffer state = do - buffer <- case state of -- See [note Buffer Sizing], GHC.IO.Handle.Types - ReadBuffer -> newCharBuffer dEFAULT_CHAR_BUFFER_SIZE state - WriteBuffer -> newCharBuffer 1 state + buffer <- newCharBuffer dEFAULT_CHAR_BUFFER_SIZE state + -- See [note Buffer Sizing], GHC.IO.Handle.Types ref <- newIORef buffer return (ref, NoBuffering) @@ -422,20 +422,18 @@ flushBuffer h_@Handle__{..} = do flushCharReadBuffer h_ flushByteReadBuffer h_ WriteBuffer -> do - buf' <- flushWriteBuffer_ h_ buf - writeIORef haCharBuffer buf' + flushByteWriteBuffer h_ --- | flushes at least the Char buffer, and the byte buffer for a write --- Handle. Works on all Handles. +-- | flushes the Char buffer only. Works on all Handles. flushCharBuffer :: Handle__ -> IO () flushCharBuffer h_@Handle__{..} = do - buf <- readIORef haCharBuffer - case bufState buf of + cbuf <- readIORef haCharBuffer + case bufState cbuf of ReadBuffer -> do flushCharReadBuffer h_ - WriteBuffer -> do - buf' <- flushWriteBuffer_ h_ buf - writeIORef haCharBuffer buf' + WriteBuffer -> + when (not (isEmptyBuffer cbuf)) $ + error "internal IO library error: Char buffer non-empty" -- ----------------------------------------------------------------------------- -- Writing data (flushing write buffers) @@ -445,19 +443,52 @@ flushCharBuffer h_@Handle__{..} = do -- empty. flushWriteBuffer :: Handle__ -> IO () flushWriteBuffer h_@Handle__{..} = do - buf <- readIORef haCharBuffer - if isWriteBuffer buf - then do buf' <- flushWriteBuffer_ h_ buf - writeIORef haCharBuffer buf' - else return () + buf <- readIORef haByteBuffer + when (isWriteBuffer buf) $ flushByteWriteBuffer h_ -flushWriteBuffer_ :: Handle__ -> CharBuffer -> IO CharBuffer -flushWriteBuffer_ h_@Handle__{..} cbuf = do +flushByteWriteBuffer :: Handle__ -> IO () +flushByteWriteBuffer h_@Handle__{..} = do + bbuf <- readIORef haByteBuffer + when (not (isEmptyBuffer bbuf)) $ do + bbuf' <- Buffered.flushWriteBuffer haDevice bbuf + writeIORef haByteBuffer bbuf' + +-- write the contents of the CharBuffer to the Handle__. +-- The data will be encoded and pushed to the byte buffer, +-- flushing if the buffer becomes full. +writeCharBuffer :: Handle__ -> CharBuffer -> IO () +writeCharBuffer h_@Handle__{..} !cbuf = do + -- bbuf <- readIORef haByteBuffer - if not (isEmptyBuffer cbuf) || not (isEmptyBuffer bbuf) - then do writeTextDevice h_ cbuf - return cbuf{ bufL=0, bufR=0 } - else return cbuf + + debugIO ("writeCharBuffer: cbuf=" ++ summaryBuffer cbuf ++ + " bbuf=" ++ summaryBuffer bbuf) + + (cbuf',bbuf') <- case haEncoder of + Nothing -> latin1_encode cbuf bbuf + Just encoder -> (encode encoder) cbuf bbuf + + debugIO ("writeCharBuffer after encoding: cbuf=" ++ summaryBuffer cbuf' ++ + " bbuf=" ++ summaryBuffer bbuf') + + -- flush if the write buffer is full + if isFullBuffer bbuf' + -- or we made no progress + || not (isEmptyBuffer cbuf') && bufL cbuf' == bufL cbuf + -- or the byte buffer has more elements than the user wanted buffered + || (case haBufferMode of + BlockBuffering (Just s) -> bufferElems bbuf' >= s + NoBuffering -> True + _other -> False) + then do + bbuf'' <- Buffered.flushWriteBuffer haDevice bbuf' + writeIORef haByteBuffer bbuf'' + else + writeIORef haByteBuffer bbuf' + + if not (isEmptyBuffer cbuf') + then writeCharBuffer h_ cbuf' + else return () -- ----------------------------------------------------------------------------- -- Flushing read buffers @@ -732,29 +763,6 @@ debugIO s -- ---------------------------------------------------------------------------- -- Text input/output --- Write the contents of the supplied Char buffer to the device, return --- only when all the data has been written. -writeTextDevice :: Handle__ -> CharBuffer -> IO () -writeTextDevice h_@Handle__{..} cbuf = do - -- - bbuf <- readIORef haByteBuffer - - debugIO ("writeTextDevice: cbuf=" ++ summaryBuffer cbuf ++ - " bbuf=" ++ summaryBuffer bbuf) - - (cbuf',bbuf') <- case haEncoder of - Nothing -> latin1_encode cbuf bbuf - Just encoder -> (encode encoder) cbuf bbuf - - debugIO ("writeTextDevice after encoding: cbuf=" ++ summaryBuffer cbuf' ++ - " bbuf=" ++ summaryBuffer bbuf') - - bbuf' <- Buffered.flushWriteBuffer haDevice bbuf' - writeIORef haByteBuffer bbuf' - if not (isEmptyBuffer cbuf') - then writeTextDevice h_ cbuf' - else return () - -- Read characters into the provided buffer. Return when any -- characters are available; raise an exception if the end of -- file is reached. diff --git a/GHC/IO/Handle/Text.hs b/GHC/IO/Handle/Text.hs index 47cc307..1e41a7b 100644 --- a/GHC/IO/Handle/Text.hs +++ b/GHC/IO/Handle/Text.hs @@ -22,7 +22,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 @@ -439,12 +439,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 +451,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 +497,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 +517,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 +547,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 +570,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 + 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 +593,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 (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 +688,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 diff --git a/GHC/IO/Handle/Types.hs b/GHC/IO/Handle/Types.hs index c8b6b79..766c027 100644 --- a/GHC/IO/Handle/Types.hs +++ b/GHC/IO/Handle/Types.hs @@ -41,6 +41,9 @@ import GHC.Read import GHC.Word import GHC.IO.Device import Data.Typeable +#ifdef DEBUG +import Control.Monad +#endif -- --------------------------------------------------------------------------- -- Handle type @@ -179,6 +182,13 @@ checkHandleInvariants h_ = do checkBuffer bbuf cbuf <- readIORef (haCharBuffer h_) checkBuffer cbuf + when (isWriteBuffer cbuf && not (isEmptyBuffer cbuf)) $ + error ("checkHandleInvariants: char write buffer non-empty: " ++ + summaryBuffer bbuf ++ ", " ++ summaryBuffer cbuf) + when (isWriteBuffer bbuf /= isWriteBuffer cbuf) $ + error ("checkHandleInvariants: buffer modes differ: " ++ + summaryBuffer bbuf ++ ", " ++ summaryBuffer cbuf) + #else checkHandleInvariants _ = return () #endif @@ -257,25 +267,46 @@ buffer, and then provide it immediately to the caller. [note Buffered Writing] -Characters are written into the Char buffer by e.g. hPutStr. When the -buffer is full, we call writeTextDevice, which encodes the Char buffer -into the byte buffer, and then immediately writes it all out to the -underlying device. The Char buffer will always be empty afterward. -This might require multiple decoding/writing cycles. +Characters are written into the Char buffer by e.g. hPutStr. At the +end of the operation, or when the char buffer is full, the buffer is +decoded to the byte buffer (see writeCharBuffer). This is so that we +can detect encoding errors at the right point. + +Hence, the Char buffer is always empty between Handle operations. [note Buffer Sizing] -Since the buffer mode makes no difference when reading, we can just -use the default buffer size for both the byte and the Char buffer. -Ineed, we must have room for at least one Char in the Char buffer, -because we have to implement hLookAhead, which requires caching a Char -in the Handle. Furthermore, when doing newline translation, we need -room for at least two Chars in the read buffer, so we can spot the -\r\n sequence. +The char buffer is always a default size (dEFAULT_CHAR_BUFFER_SIZE). +The byte buffer size is chosen by the underlying device (via its +IODevice.newBuffer). Hence the size of these buffers is not under +user control. + +There are certain minimum sizes for these buffers imposed by the +library (but not checked): + + - we must be able to buffer at least one character, so that + hLookAhead can work + + - the byte buffer must be able to store at least one encoded + character in the current encoding (6 bytes?) + + - when reading, the char buffer must have room for two characters, so + that we can spot the \r\n sequence. + +How do we implement hSetBuffering? + +For reading, we have never used the user-supplied buffer size, because +there's no point: we always pass all available data to the reader +immediately. Buffering would imply waiting until a certain amount of +data is available, which has no advantages. So hSetBuffering is +essentially a no-op for read handles, except that it turns on/off raw +mode for the underlying device if necessary. -For writing, however, when the buffer mode is NoBuffering, we use a -1-element Char buffer to force flushing of the buffer after each Char -is read. +For writing, the buffering mode is handled by the write operations +themselves (hPutChar and hPutStr). Every write ends with +writeCharBuffer, which checks whether the buffer should be flushed +according to the current buffering mode. Additionally, we look for +newlines and flush if the mode is LineBuffering. [note Buffer Flushing] @@ -284,8 +315,7 @@ is read. We must be able to flush the Char buffer, in order to implement hSetEncoding, and things like hGetBuf which want to read raw bytes. -Flushing the Char buffer on a write Handle is easy: just call -writeTextDevice to encode and write the date. +Flushing the Char buffer on a write Handle is easy: it is always empty. Flushing the Char buffer on a read Handle involves rewinding the byte buffer to the point representing the next Char in the Char buffer. diff --git a/System/IO.hs b/System/IO.hs index c12fcea..d52c2c9 100644 --- a/System/IO.hs +++ b/System/IO.hs @@ -249,7 +249,7 @@ import GHC.IO.IOMode import GHC.IO.Handle.FD import qualified GHC.IO.FD as FD import GHC.IO.Handle -import GHC.IO.Handle.Text ( hGetBufSome ) +import GHC.IO.Handle.Text ( hGetBufSome, hPutStrLn ) import GHC.IORef import GHC.IO.Exception ( userError ) import GHC.IO.Encoding @@ -325,8 +325,7 @@ putStr s = hPutStr stdout s -- | The same as 'putStr', but adds a newline character. putStrLn :: String -> IO () -putStrLn s = do putStr s - putChar '\n' +putStrLn s = hPutStrLn stdout s -- | The 'print' function outputs a value of any printable type to the -- standard output device. @@ -424,13 +423,6 @@ readIO s = case (do { (x,t) <- reads s ; hReady :: Handle -> IO Bool hReady h = hWaitForInput h 0 --- | The same as 'hPutStr', but adds a newline character. - -hPutStrLn :: Handle -> String -> IO () -hPutStrLn hndl str = do - hPutStr hndl str - hPutChar hndl '\n' - -- | Computation 'hPrint' @hdl t@ writes the string representation of @t@ -- given by the 'shows' function to the file or channel managed by @hdl@ -- and appends a newline.