Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Fixed off by one for writeBlocksRaw #590

Merged
merged 7 commits into from
May 29, 2024
Merged

Fixed off by one for writeBlocksRaw #590

Changes from all commits
Commits
Show all changes
7 commits
Select commit Hold shift + click to select a range
45d7d13
Fixed off by one for writeBlocksRaw
BebeSparkelSparkel Apr 28, 2024
047971a
has error! do not pull
BebeSparkelSparkel Apr 30, 2024
e780821
added a bounds assert for writeCharBuff in hPutStr
BebeSparkelSparkel Apr 30, 2024
75246e8
combined writeBlocks and writeBlocksCLRF, has same performance
BebeSparkelSparkel May 23, 2024
e631f71
fixed overflow
BebeSparkelSparkel May 23, 2024
2aa9b26
revert buffer field renaming and commit buffer arguments
BebeSparkelSparkel May 29, 2024
9f3bc7f
reordered writeBlocks Yield conditions
BebeSparkelSparkel May 29, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
52 changes: 21 additions & 31 deletions src/Data/Text/IO.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -54,9 +54,9 @@ import qualified Data.Text as T
import Data.Text.Internal.Fusion (stream)
import Data.Text.Internal.Fusion.Types (Step(..), Stream(..))
import Data.Text.Internal.IO (hGetLineWith, readChunk)
import GHC.IO.Buffer (Buffer(..), BufferState(..), CharBufElem, CharBuffer,
RawCharBuffer, emptyBuffer, isEmptyBuffer, newCharBuffer,
writeCharBuf)
import GHC.IO.Buffer (Buffer(..), BufferState(..), RawCharBuffer, CharBuffer,
emptyBuffer, isEmptyBuffer, newCharBuffer)
import qualified GHC.IO.Buffer
import GHC.IO.Exception (IOException(ioe_type), IOErrorType(InappropriateType))
import GHC.IO.Handle.Internals (augmentIOError, hClose_help, wantReadableHandle,
wantWritableHandle)
Expand Down Expand Up @@ -184,9 +184,7 @@ hPutStr h t = do
case buffer_mode of
(NoBuffering, _) -> hPutChars h str
(LineBuffering, buf) -> writeLines h nl buf str
(BlockBuffering _, buf)
| nl == CRLF -> writeBlocksCRLF h buf str
| otherwise -> writeBlocksRaw h buf str
(BlockBuffering _, buf) -> writeBlocks (nl == CRLF) h buf str

hPutChars :: Handle -> Stream Char -> IO ()
hPutChars h (Stream next0 s0 _len) = loop s0
Expand All @@ -206,7 +204,7 @@ hPutChars h (Stream next0 s0 _len) = loop s0
-- performance improvement. Lifting out the raw/cooked newline
-- handling gave a few more percent on top.

writeLines :: Handle -> Newline -> Buffer CharBufElem -> Stream Char -> IO ()
writeLines :: Handle -> Newline -> CharBuffer -> Stream Char -> IO ()
writeLines h nl buf0 (Stream next0 s0 _len) = outer s0 buf0
where
outer s1 Buffer{bufRaw=raw, bufSize=len} = inner s1 (0::Int)
Expand All @@ -219,15 +217,15 @@ writeLines h nl buf0 (Stream next0 s0 _len) = outer s0 buf0
| n + 1 >= len -> commit n True{-needs flush-} False >>= outer s
| x == '\n' -> do
n' <- if nl == CRLF
then do n1 <- writeCharBuf raw n '\r'
BebeSparkelSparkel marked this conversation as resolved.
Show resolved Hide resolved
writeCharBuf raw n1 '\n'
else writeCharBuf raw n x
then do n1 <- writeCharBuf raw len n '\r'
writeCharBuf raw len n1 '\n'
else writeCharBuf raw len n x
commit n' True{-needs flush-} False >>= outer s'
| otherwise -> writeCharBuf raw n x >>= inner s'
| otherwise -> writeCharBuf raw len n x >>= inner s'
commit = commitBuffer h raw len

writeBlocksCRLF :: Handle -> Buffer CharBufElem -> Stream Char -> IO ()
writeBlocksCRLF h buf0 (Stream next0 s0 _len) = outer s0 buf0
writeBlocks :: Bool -> Handle -> CharBuffer -> Stream Char -> IO ()
writeBlocks isCRLF h buf0 (Stream next0 s0 _len) = outer s0 buf0
where
outer s1 Buffer{bufRaw=raw, bufSize=len} = inner s1 (0::Int)
where
Expand All @@ -236,25 +234,17 @@ writeBlocksCRLF h buf0 (Stream next0 s0 _len) = outer s0 buf0
Done -> commit n False{-no flush-} True{-release-} >> return ()
Skip s' -> inner s' n
Yield x s'
| n + 1 >= len -> commit n True{-needs flush-} False >>= outer s
| x == '\n' -> do n1 <- writeCharBuf raw n '\r'
writeCharBuf raw n1 '\n' >>= inner s'
| otherwise -> writeCharBuf raw n x >>= inner s'
| isCRLF && x == '\n' && n + 1 < len -> do
n1 <- writeCharBuf raw len n '\r'
writeCharBuf raw len n1 '\n' >>= inner s'
| n < len -> writeCharBuf raw len n x >>= inner s'
| otherwise -> commit n True{-needs flush-} False >>= outer s
commit = commitBuffer h raw len

writeBlocksRaw :: Handle -> Buffer CharBufElem -> Stream Char -> IO ()
writeBlocksRaw h buf0 (Stream next0 s0 _len) = outer s0 buf0
where
outer s1 Buffer{bufRaw=raw, bufSize=len} = inner s1 (0::Int)
where
inner !s !n =
case next0 s of
Done -> commit n False{-no flush-} True{-release-} >> return ()
Skip s' -> inner s' n
Yield x s'
| n + 1 >= len -> commit n True{-needs flush-} False >>= outer s
| otherwise -> writeCharBuf raw n x >>= inner s'
commit = commitBuffer h raw len
-- | Only modifies the raw buffer and not the buffer attributes
writeCharBuf :: RawCharBuffer -> Int -> Int -> Char -> IO Int
writeCharBuf bufRaw bufSize n c = E.assert (n >= 0 && n < bufSize) $
GHC.IO.Buffer.writeCharBuf bufRaw n c

-- This function is completely lifted from GHC.IO.Handle.Text.
getSpareBuffer :: Handle__ -> IO (BufferMode, CharBuffer)
Expand All @@ -276,7 +266,7 @@ getSpareBuffer Handle__{haCharBuffer=ref,
return (mode, new_buf)


-- This function is completely lifted from GHC.IO.Handle.Text.
-- This function is modified from GHC.Internal.IO.Handle.Text.
commitBuffer :: Handle -> RawCharBuffer -> Int -> Int -> Bool -> Bool
-> IO CharBuffer
commitBuffer hdl !raw !sz !count flush release =
Expand Down
Loading