From d50216e913581f889a381835529bd447c4b89bfd Mon Sep 17 00:00:00 2001 From: Brian Shu Date: Thu, 29 Sep 2022 13:02:37 -0400 Subject: [PATCH 1/9] port some ByteString IO functions to ShortByteString --- Data/ByteString/Short/Internal.hs | 129 ++++++++++++++++++++++++++++-- 1 file changed, 121 insertions(+), 8 deletions(-) diff --git a/Data/ByteString/Short/Internal.hs b/Data/ByteString/Short/Internal.hs index 8639a3e36..440220411 100644 --- a/Data/ByteString/Short/Internal.hs +++ b/Data/ByteString/Short/Internal.hs @@ -12,6 +12,7 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE UnliftedFFITypes #-} +{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE Unsafe #-} {-# OPTIONS_HADDOCK not-home #-} @@ -217,27 +218,27 @@ import GHC.Exts , byteArrayContents# , unsafeCoerce# , copyMutableByteArray# -#if MIN_VERSION_base(4,10,0) + , isByteArrayPinned# , isTrue# -#endif -#if MIN_VERSION_base(4,11,0) + + , compareByteArrays# -#endif + , sizeofByteArray# , indexWord8Array#, indexCharArray# , writeWord8Array# , unsafeFreezeByteArray# -#if MIN_VERSION_base(4,12,0) && defined(SAFE_UNALIGNED) + ,writeWord64Array# ,indexWord8ArrayAsWord64# -#endif + , setByteArray# , sizeofByteArray# , indexWord8Array#, indexCharArray# , writeWord8Array# , unsafeFreezeByteArray# - , touch# ) + , touch#, mutableByteArrayContents#, sizeofMutableByteArray#, keepAlive# ) import GHC.IO import GHC.ForeignPtr ( ForeignPtr(ForeignPtr) @@ -263,14 +264,19 @@ import Prelude , Maybe(..) , not , snd + , Monad(..) ) import qualified Data.ByteString.Internal as BS - +import qualified Data.ByteString as BS import qualified Data.List as List import qualified GHC.Exts import qualified Language.Haskell.TH.Lib as TH import qualified Language.Haskell.TH.Syntax as TH +import System.IO (IOMode, Handle) +import Foreign.Ptr (plusPtr) +import qualified System.IO as IO +import Control.Monad ((=<<)) -- | A compact representation of a 'Word8' vector. -- @@ -411,6 +417,30 @@ unsafePackLenLiteral len addr# = ------------------------------------------------------------------------ -- Internal utils +-- | Yields a pinned byte sequence whose contents are identical to those +-- of the original byte sequence. If the @ByteArray@ backing the argument +-- was already pinned, this simply aliases the argument and does not perform +-- any copying. +pin :: ShortByteString -> ShortByteString +pin b@(SBS (BA# -> src)) = case isByteArrayPinned src of + True -> b + False -> + ( runST $ do + let len = sizeofByteArray src + dst <- newPinnedByteArray len + copyByteArray src 0 dst 0 len + (\(BA# res) -> SBS res) <$> unsafeFreezeByteArray dst + ) + +-- | Invariant: @arr@ must be pinned. This is not checked. +withPinnedSBS :: ShortByteString -> (Ptr a -> IO b) -> IO b +withPinnedSBS (SBS (BA# -> arr)) f = IO $ \s -> + case f (byteArrayContents arr) of + IO action# -> keepAlive# arr s action# + +withSBS :: ShortByteString -> (Ptr a -> IO b) -> IO b +withSBS arr f = withPinnedSBS (pin arr) f + asBA :: ShortByteString -> BA asBA (SBS ba#) = BA# ba# @@ -529,6 +559,29 @@ fromShortIO sbs = do (PlainPtr mba#) return (BS fp len) +unsafePlainToShort :: ByteString -> ShortByteString +unsafePlainToShort = unsafeDupablePerformIO . unsafePlainToShortIO + +-- | /O(1)/ zero cost conversion between 'ByteString' and 'ShortByteString'. +-- There are three invariants. +-- The 'ByteString' must also not be used after the function is called because we use `unsafeFreezeByteArray#' internally. +-- The 'ByteString' must be created using the @mallocPlain*@ functions. +-- The 'ByteString' must not be a slice. +-- That is, the 'ForeignPtr' should point to the start of the pinned 'MutableByteArray#' and +-- the length should be equal to @sizeofMutableByteArray# marr#@. +unsafePlainToShortIO :: ByteString -> IO ShortByteString +unsafePlainToShortIO (BS (ForeignPtr addr# fpc) l) = + case fpc of + PlainPtr marr# -> do + (BA# arr#) <- stToIO $ unsafeFreezeByteArray (MBA# marr#) + let baseP = Ptr (mutableByteArrayContents# marr#) + p = Ptr addr# + if baseP == p && l == I# (sizeofMutableByteArray# marr#) + then pure $ SBS arr# + else error "Data.ByteString.Short.Internal: not a slice" + _ -> error "Data.ByteString.Short.Internal: must be PlainPtr" + + -- | /O(1)/ Convert a 'Word8' into a 'ShortByteString' -- -- @since 0.11.3.0 @@ -1649,6 +1702,12 @@ newPinnedByteArray (I# len#) = ST $ \s -> case newPinnedByteArray# len# s of (# s, mba# #) -> (# s, MBA# mba# #) +sizeofByteArray :: BA -> Int +sizeofByteArray (BA# ba#) = I# (sizeofByteArray# ba#) + +byteArrayContents :: BA -> Ptr a +byteArrayContents (BA# ba#) = Ptr (byteArrayContents# ba#) + unsafeFreezeByteArray :: MBA s -> ST s BA unsafeFreezeByteArray (MBA# mba#) = ST $ \s -> case unsafeFreezeByteArray# mba# s of @@ -1690,6 +1749,22 @@ copyMutableByteArray :: MBA s -> Int -> MBA s -> Int -> Int -> ST s () copyMutableByteArray (MBA# src#) (I# src_off#) (MBA# dst#) (I# dst_off#) (I# len#) = ST $ \s -> case copyMutableByteArray# src# src_off# dst# dst_off# len# s of s -> (# s, () #) + +isByteArrayPinned :: BA -> Bool +{-# INLINE isByteArrayPinned #-} +#if __GLASGOW_HASKELL__ >= 802 +-- | Check whether or not the byte array is pinned. Pinned byte arrays cannot +-- be moved by the garbage collector. It is safe to use 'byteArrayContents' on +-- such byte arrays. +-- +-- Caution: This function is only available when compiling with GHC 8.2 or +-- newer. +-- +-- @since 0.6.4.0 +isByteArrayPinned (BA# arr#) = isTrue# (isByteArrayPinned# arr#) +#else +isByteArrayPinned _ = False +#endif ------------------------------------------------------------------------ @@ -1890,3 +1965,41 @@ moduleError :: HasCallStack => String -> String -> a moduleError fun msg = error (moduleErrorMsg fun msg) {-# NOINLINE moduleError #-} +------------------------------------------------------------------------ +-- IO + +-- | Outputs 'ShortByteString' to the specified 'Handle'. This is implemented +-- with 'IO.hPutBuf'. +unsafeHPutOff :: Handle -> ShortByteString -> Int -> Int -> IO () +unsafeHPutOff handle sbs off len = withSBS sbs $ \p -> IO.hPutBuf handle (p `plusPtr` off) len + +hPut :: Handle -> ShortByteString -> IO () +hPut h sbs = unsafeHPutOff h sbs 0 (length sbs) + +-- | Write a ShortByteString to 'stdout'. +putStr :: ShortByteString -> IO () +putStr = hPut IO.stdout + +modifyFile :: IOMode -> FilePath -> ShortByteString -> IO () +modifyFile mode f txt = IO.withBinaryFile f mode (`hPut` txt) + +-- | Write a 'ShortByteString' to a file. +writeFile :: FilePath -> ShortByteString -> IO () +writeFile = modifyFile IO.WriteMode + +-- | Append a 'ShortByteString' to a file. +appendFile :: FilePath -> ShortByteString -> IO () +appendFile = modifyFile IO.AppendMode + +readFile :: FilePath -> IO ShortByteString +readFile path = unsafePlainToShortIO =<< BS.readFile path + +hGetLine :: Handle -> IO ShortByteString +hGetLine h = unsafePlainToShortIO =<< BS.hGetLine h + +-- | Read a line from stdin. +getLine :: IO ShortByteString +getLine = hGetLine IO.stdin + +hGet :: Handle -> Int -> IO ShortByteString +hGet h i = unsafePlainToShortIO =<< BS.hGet h i From 5a0263565701689de7d5cba9acd5810e5d5736f9 Mon Sep 17 00:00:00 2001 From: Brian Shu Date: Thu, 29 Sep 2022 15:36:31 -0400 Subject: [PATCH 2/9] only leave primitive functions --- Data/ByteString/Short/Internal.hs | 66 +++++++++++++++---------------- 1 file changed, 31 insertions(+), 35 deletions(-) diff --git a/Data/ByteString/Short/Internal.hs b/Data/ByteString/Short/Internal.hs index 440220411..1c7734968 100644 --- a/Data/ByteString/Short/Internal.hs +++ b/Data/ByteString/Short/Internal.hs @@ -155,6 +155,15 @@ module Data.ByteString.Short.Internal ( -- ** Using ShortByteStrings as 'Foreign.C.String.CString's useAsCString, useAsCStringLen, + + -- * Low level I\/O with 'ShortByteString's + unsafeHPutOff, + hPut, + readFile, + hGetContents, + hGetLine, + hGet, + hGetSome, ) where import Data.ByteString.Internal @@ -422,15 +431,15 @@ unsafePackLenLiteral len addr# = -- was already pinned, this simply aliases the argument and does not perform -- any copying. pin :: ShortByteString -> ShortByteString -pin b@(SBS (BA# -> src)) = case isByteArrayPinned src of - True -> b - False -> - ( runST $ do - let len = sizeofByteArray src - dst <- newPinnedByteArray len - copyByteArray src 0 dst 0 len - (\(BA# res) -> SBS res) <$> unsafeFreezeByteArray dst - ) +pin b@(SBS (BA# -> src)) = + if isByteArrayPinned src + then b + else runST $ do + let len = sizeofByteArray src + dst <- newPinnedByteArray len + copyByteArray src 0 dst 0 len + (\(BA# res) -> SBS res) <$> unsafeFreezeByteArray dst + -- | Invariant: @arr@ must be pinned. This is not checked. withPinnedSBS :: ShortByteString -> (Ptr a -> IO b) -> IO b @@ -439,7 +448,7 @@ withPinnedSBS (SBS (BA# -> arr)) f = IO $ \s -> IO action# -> keepAlive# arr s action# withSBS :: ShortByteString -> (Ptr a -> IO b) -> IO b -withSBS arr f = withPinnedSBS (pin arr) f +withSBS arr = withPinnedSBS $ pin arr asBA :: ShortByteString -> BA asBA (SBS ba#) = BA# ba# @@ -570,12 +579,11 @@ unsafePlainToShort = unsafeDupablePerformIO . unsafePlainToShortIO -- That is, the 'ForeignPtr' should point to the start of the pinned 'MutableByteArray#' and -- the length should be equal to @sizeofMutableByteArray# marr#@. unsafePlainToShortIO :: ByteString -> IO ShortByteString -unsafePlainToShortIO (BS (ForeignPtr addr# fpc) l) = +unsafePlainToShortIO (BS (ForeignPtr (Ptr -> p) fpc) l) = case fpc of PlainPtr marr# -> do (BA# arr#) <- stToIO $ unsafeFreezeByteArray (MBA# marr#) let baseP = Ptr (mutableByteArrayContents# marr#) - p = Ptr addr# if baseP == p && l == I# (sizeofMutableByteArray# marr#) then pure $ SBS arr# else error "Data.ByteString.Short.Internal: not a slice" @@ -1750,9 +1758,6 @@ copyMutableByteArray (MBA# src#) (I# src_off#) (MBA# dst#) (I# dst_off#) (I# len ST $ \s -> case copyMutableByteArray# src# src_off# dst# dst_off# len# s of s -> (# s, () #) -isByteArrayPinned :: BA -> Bool -{-# INLINE isByteArrayPinned #-} -#if __GLASGOW_HASKELL__ >= 802 -- | Check whether or not the byte array is pinned. Pinned byte arrays cannot -- be moved by the garbage collector. It is safe to use 'byteArrayContents' on -- such byte arrays. @@ -1761,6 +1766,9 @@ isByteArrayPinned :: BA -> Bool -- newer. -- -- @since 0.6.4.0 +isByteArrayPinned :: BA -> Bool +{-# INLINE isByteArrayPinned #-} +#if __GLASGOW_HASKELL__ >= 802 isByteArrayPinned (BA# arr#) = isTrue# (isByteArrayPinned# arr#) #else isByteArrayPinned _ = False @@ -1969,37 +1977,25 @@ moduleError fun msg = error (moduleErrorMsg fun msg) -- IO -- | Outputs 'ShortByteString' to the specified 'Handle'. This is implemented --- with 'IO.hPutBuf'. +-- with 'IO.hPutBuf'. The offset and length are used because we don't have slices of 'ByteArray' yet. +-- The function is unsafe because the offset and length is not checked. unsafeHPutOff :: Handle -> ShortByteString -> Int -> Int -> IO () unsafeHPutOff handle sbs off len = withSBS sbs $ \p -> IO.hPutBuf handle (p `plusPtr` off) len hPut :: Handle -> ShortByteString -> IO () hPut h sbs = unsafeHPutOff h sbs 0 (length sbs) --- | Write a ShortByteString to 'stdout'. -putStr :: ShortByteString -> IO () -putStr = hPut IO.stdout - -modifyFile :: IOMode -> FilePath -> ShortByteString -> IO () -modifyFile mode f txt = IO.withBinaryFile f mode (`hPut` txt) - --- | Write a 'ShortByteString' to a file. -writeFile :: FilePath -> ShortByteString -> IO () -writeFile = modifyFile IO.WriteMode - --- | Append a 'ShortByteString' to a file. -appendFile :: FilePath -> ShortByteString -> IO () -appendFile = modifyFile IO.AppendMode - readFile :: FilePath -> IO ShortByteString readFile path = unsafePlainToShortIO =<< BS.readFile path +hGetContents :: Handle -> IO ShortByteString +hGetContents h = unsafePlainToShortIO =<< BS.hGetContents h + hGetLine :: Handle -> IO ShortByteString hGetLine h = unsafePlainToShortIO =<< BS.hGetLine h --- | Read a line from stdin. -getLine :: IO ShortByteString -getLine = hGetLine IO.stdin - hGet :: Handle -> Int -> IO ShortByteString hGet h i = unsafePlainToShortIO =<< BS.hGet h i + +hGetSome :: Handle -> Int -> IO ShortByteString +hGetSome h i = unsafePlainToShortIO =<< BS.hGetSome h i From 7a874457cfbd9d8b89d8b9d92d6f03d1277a7f79 Mon Sep 17 00:00:00 2001 From: Brian Shu Date: Thu, 29 Sep 2022 15:41:33 -0400 Subject: [PATCH 3/9] rename withSBS --- Data/ByteString.hs | 2 +- Data/ByteString/Short/Internal.hs | 10 +++++----- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/Data/ByteString.hs b/Data/ByteString.hs index dfb015d89..8d91d25f0 100644 --- a/Data/ByteString.hs +++ b/Data/ByteString.hs @@ -1853,7 +1853,7 @@ mkBigPS _ pss = return $! concat (P.reverse pss) -- | Outputs a 'ByteString' to the specified 'Handle'. hPut :: Handle -> ByteString -> IO () hPut _ (BS _ 0) = return () -hPut h (BS ps l) = unsafeWithForeignPtr ps $ \p-> hPutBuf h p l +hPut h (BS ps l) = unsafeWithForeignPtr ps $ \p -> hPutBuf h p l -- | Similar to 'hPut' except that it will never block. Instead it returns -- any tail that did not get written. This tail may be 'empty' in the case that diff --git a/Data/ByteString/Short/Internal.hs b/Data/ByteString/Short/Internal.hs index 1c7734968..6dd335f6f 100644 --- a/Data/ByteString/Short/Internal.hs +++ b/Data/ByteString/Short/Internal.hs @@ -442,13 +442,13 @@ pin b@(SBS (BA# -> src)) = -- | Invariant: @arr@ must be pinned. This is not checked. -withPinnedSBS :: ShortByteString -> (Ptr a -> IO b) -> IO b -withPinnedSBS (SBS (BA# -> arr)) f = IO $ \s -> +withPinnedSBSPtr :: ShortByteString -> (Ptr a -> IO b) -> IO b +withPinnedSBSPtr (SBS (BA# -> arr)) f = IO $ \s -> case f (byteArrayContents arr) of IO action# -> keepAlive# arr s action# -withSBS :: ShortByteString -> (Ptr a -> IO b) -> IO b -withSBS arr = withPinnedSBS $ pin arr +withSBSPtr :: ShortByteString -> (Ptr a -> IO b) -> IO b +withSBSPtr arr = withPinnedSBSPtr $ pin arr asBA :: ShortByteString -> BA asBA (SBS ba#) = BA# ba# @@ -1980,7 +1980,7 @@ moduleError fun msg = error (moduleErrorMsg fun msg) -- with 'IO.hPutBuf'. The offset and length are used because we don't have slices of 'ByteArray' yet. -- The function is unsafe because the offset and length is not checked. unsafeHPutOff :: Handle -> ShortByteString -> Int -> Int -> IO () -unsafeHPutOff handle sbs off len = withSBS sbs $ \p -> IO.hPutBuf handle (p `plusPtr` off) len +unsafeHPutOff handle sbs off len = withSBSPtr sbs $ \p -> IO.hPutBuf handle (p `plusPtr` off) len hPut :: Handle -> ShortByteString -> IO () hPut h sbs = unsafeHPutOff h sbs 0 (length sbs) From 67710ee216aae4ecfb4470e9f746a7059d79e9e9 Mon Sep 17 00:00:00 2001 From: Brian Shu Date: Thu, 29 Sep 2022 15:43:58 -0400 Subject: [PATCH 4/9] fix error message --- Data/ByteString/Short/Internal.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Data/ByteString/Short/Internal.hs b/Data/ByteString/Short/Internal.hs index 6dd335f6f..ccd6e188f 100644 --- a/Data/ByteString/Short/Internal.hs +++ b/Data/ByteString/Short/Internal.hs @@ -586,7 +586,7 @@ unsafePlainToShortIO (BS (ForeignPtr (Ptr -> p) fpc) l) = let baseP = Ptr (mutableByteArrayContents# marr#) if baseP == p && l == I# (sizeofMutableByteArray# marr#) then pure $ SBS arr# - else error "Data.ByteString.Short.Internal: not a slice" + else error "Data.ByteString.Short.Internal: cannot be a slice" _ -> error "Data.ByteString.Short.Internal: must be PlainPtr" From 6e6dd2e29230a287a838aa54252f7bb22c2b198b Mon Sep 17 00:00:00 2001 From: Brian Shu Date: Thu, 29 Sep 2022 15:57:16 -0400 Subject: [PATCH 5/9] rename --- Data/ByteString/Short/Internal.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/Data/ByteString/Short/Internal.hs b/Data/ByteString/Short/Internal.hs index ccd6e188f..f2af26bc1 100644 --- a/Data/ByteString/Short/Internal.hs +++ b/Data/ByteString/Short/Internal.hs @@ -442,13 +442,13 @@ pin b@(SBS (BA# -> src)) = -- | Invariant: @arr@ must be pinned. This is not checked. -withPinnedSBSPtr :: ShortByteString -> (Ptr a -> IO b) -> IO b -withPinnedSBSPtr (SBS (BA# -> arr)) f = IO $ \s -> +pinnedWithPtr :: ShortByteString -> (Ptr a -> IO b) -> IO b +pinnedWithPtr (SBS (BA# -> arr)) f = IO $ \s -> case f (byteArrayContents arr) of IO action# -> keepAlive# arr s action# -withSBSPtr :: ShortByteString -> (Ptr a -> IO b) -> IO b -withSBSPtr arr = withPinnedSBSPtr $ pin arr +withPtr :: ShortByteString -> (Ptr a -> IO b) -> IO b +withPtr arr = pinnedWithPtr $ pin arr asBA :: ShortByteString -> BA asBA (SBS ba#) = BA# ba# @@ -1980,7 +1980,7 @@ moduleError fun msg = error (moduleErrorMsg fun msg) -- with 'IO.hPutBuf'. The offset and length are used because we don't have slices of 'ByteArray' yet. -- The function is unsafe because the offset and length is not checked. unsafeHPutOff :: Handle -> ShortByteString -> Int -> Int -> IO () -unsafeHPutOff handle sbs off len = withSBSPtr sbs $ \p -> IO.hPutBuf handle (p `plusPtr` off) len +unsafeHPutOff handle sbs off len = withPtr sbs $ \p -> IO.hPutBuf handle (p `plusPtr` off) len hPut :: Handle -> ShortByteString -> IO () hPut h sbs = unsafeHPutOff h sbs 0 (length sbs) From d5c0d6b3a05e98fb19f7680238bf99510fc25e6f Mon Sep 17 00:00:00 2001 From: brian Date: Thu, 29 Sep 2022 19:05:32 -0400 Subject: [PATCH 6/9] don't use mutableByteArrayContents# for compat --- Data/ByteString/Short/Internal.hs | 35 +++++++++++++++++++++++++------ 1 file changed, 29 insertions(+), 6 deletions(-) diff --git a/Data/ByteString/Short/Internal.hs b/Data/ByteString/Short/Internal.hs index f2af26bc1..87ec72028 100644 --- a/Data/ByteString/Short/Internal.hs +++ b/Data/ByteString/Short/Internal.hs @@ -247,7 +247,11 @@ import GHC.Exts , indexWord8Array#, indexCharArray# , writeWord8Array# , unsafeFreezeByteArray# - , touch#, mutableByteArrayContents#, sizeofMutableByteArray#, keepAlive# ) + , touch#, mutableByteArrayContents#, sizeofMutableByteArray#, keepAlive# +#if __GLASGOW_HASKELL__ >= 801 + , getSizeofMutableByteArray# +#endif + ) import GHC.IO import GHC.ForeignPtr ( ForeignPtr(ForeignPtr) @@ -580,11 +584,12 @@ unsafePlainToShort = unsafeDupablePerformIO . unsafePlainToShortIO -- the length should be equal to @sizeofMutableByteArray# marr#@. unsafePlainToShortIO :: ByteString -> IO ShortByteString unsafePlainToShortIO (BS (ForeignPtr (Ptr -> p) fpc) l) = - case fpc of - PlainPtr marr# -> do - (BA# arr#) <- stToIO $ unsafeFreezeByteArray (MBA# marr#) - let baseP = Ptr (mutableByteArrayContents# marr#) - if baseP == p && l == I# (sizeofMutableByteArray# marr#) + case fpc of + PlainPtr (MBA# -> marr) -> do + (BA# arr#) <- stToIO $ unsafeFreezeByteArray marr + let baseP = mutableByteArrayContents marr + marrSize <- stToIO $ getSizeofMutableByteArray marr + if baseP == p && l == marrSize then pure $ SBS arr# else error "Data.ByteString.Short.Internal: cannot be a slice" _ -> error "Data.ByteString.Short.Internal: must be PlainPtr" @@ -1757,6 +1762,24 @@ copyMutableByteArray :: MBA s -> Int -> MBA s -> Int -> Int -> ST s () copyMutableByteArray (MBA# src#) (I# src_off#) (MBA# dst#) (I# dst_off#) (I# len#) = ST $ \s -> case copyMutableByteArray# src# src_off# dst# dst_off# len# s of s -> (# s, () #) + +-- | Yield a pointer to the array's data. This operation is only safe on +-- /pinned/ byte arrays allocated by 'newPinnedByteArray' or +-- 'newAlignedPinnedByteArray'. +mutableByteArrayContents :: MBA s -> Ptr Word8 +mutableByteArrayContents (MBA# arr#) = Ptr (byteArrayContents# (unsafeCoerce# arr#)) + +-- | Get the size of a byte array in bytes. Unlike 'sizeofMutableByteArray', +-- this function ensures sequencing in the presence of resizing. +getSizeofMutableByteArray :: MBA s -> ST s Int +{-# INLINE getSizeofMutableByteArray #-} +#if __GLASGOW_HASKELL__ >= 801 +getSizeofMutableByteArray (MBA# arr#) = + ST (\s# -> case getSizeofMutableByteArray# arr# s# of (# s'#, n# #) -> (# s'#, I# n# #)) +#else +getSizeofMutableByteArray arr + = return (sizeofMutableByteArray arr) +#endif -- | Check whether or not the byte array is pinned. Pinned byte arrays cannot -- be moved by the garbage collector. It is safe to use 'byteArrayContents' on From 6b3cab5b38f3f005ffca3ae461e02301a9977389 Mon Sep 17 00:00:00 2001 From: brian Date: Thu, 29 Sep 2022 19:21:39 -0400 Subject: [PATCH 7/9] fix compat --- Data/ByteString/Short/Internal.hs | 17 ++++++++++++++--- 1 file changed, 14 insertions(+), 3 deletions(-) diff --git a/Data/ByteString/Short/Internal.hs b/Data/ByteString/Short/Internal.hs index 87ec72028..191d46b20 100644 --- a/Data/ByteString/Short/Internal.hs +++ b/Data/ByteString/Short/Internal.hs @@ -247,7 +247,10 @@ import GHC.Exts , indexWord8Array#, indexCharArray# , writeWord8Array# , unsafeFreezeByteArray# - , touch#, mutableByteArrayContents#, sizeofMutableByteArray#, keepAlive# + , touch# +#if __GLASGOW_HASKELL__ >= 901 + , keepAlive# +#endif #if __GLASGOW_HASKELL__ >= 801 , getSizeofMutableByteArray# #endif @@ -447,9 +450,16 @@ pin b@(SBS (BA# -> src)) = -- | Invariant: @arr@ must be pinned. This is not checked. pinnedWithPtr :: ShortByteString -> (Ptr a -> IO b) -> IO b +#if __GLASGOW_HASKELL__ >= 901 pinnedWithPtr (SBS (BA# -> arr)) f = IO $ \s -> case f (byteArrayContents arr) of IO action# -> keepAlive# arr s action# +#else +pinnedWithPtr (SBS (BA# -> arr)) f = do + x <- f (byteArrayContents arr) + touchByteArrayIO arr + pure x +#endif withPtr :: ShortByteString -> (Ptr a -> IO b) -> IO b withPtr arr = pinnedWithPtr $ pin arr @@ -1772,7 +1782,6 @@ mutableByteArrayContents (MBA# arr#) = Ptr (byteArrayContents# (unsafeCoerce# ar -- | Get the size of a byte array in bytes. Unlike 'sizeofMutableByteArray', -- this function ensures sequencing in the presence of resizing. getSizeofMutableByteArray :: MBA s -> ST s Int -{-# INLINE getSizeofMutableByteArray #-} #if __GLASGOW_HASKELL__ >= 801 getSizeofMutableByteArray (MBA# arr#) = ST (\s# -> case getSizeofMutableByteArray# arr# s# of (# s'#, n# #) -> (# s'#, I# n# #)) @@ -1790,13 +1799,15 @@ getSizeofMutableByteArray arr -- -- @since 0.6.4.0 isByteArrayPinned :: BA -> Bool -{-# INLINE isByteArrayPinned #-} #if __GLASGOW_HASKELL__ >= 802 isByteArrayPinned (BA# arr#) = isTrue# (isByteArrayPinned# arr#) #else isByteArrayPinned _ = False #endif +touchByteArrayIO :: BA -> IO () +touchByteArrayIO (BA# arr) = IO $ \s -> case touch# arr s of + s -> (# s, () #) ------------------------------------------------------------------------ -- FFI imports From a8825ea8c82d41b69a32d4d337eb1ddf88d095ad Mon Sep 17 00:00:00 2001 From: Brian Shu Date: Fri, 30 Sep 2022 11:43:07 -0400 Subject: [PATCH 8/9] fix removed cpp --- Data/ByteString/Short/Internal.hs | 14 ++++++-------- 1 file changed, 6 insertions(+), 8 deletions(-) diff --git a/Data/ByteString/Short/Internal.hs b/Data/ByteString/Short/Internal.hs index 191d46b20..635ff97ae 100644 --- a/Data/ByteString/Short/Internal.hs +++ b/Data/ByteString/Short/Internal.hs @@ -199,8 +199,6 @@ import Control.DeepSeq ( NFData(..) ) import Control.Exception ( assert ) -import Control.Monad - ( (>>) ) import Foreign.C.String ( CString , CStringLen @@ -227,21 +225,21 @@ import GHC.Exts , byteArrayContents# , unsafeCoerce# , copyMutableByteArray# - +#if MIN_VERSION_base(4,10,0) , isByteArrayPinned# , isTrue# - - +#endif +#if MIN_VERSION_base(4,11,0) , compareByteArrays# - +#endif , sizeofByteArray# , indexWord8Array#, indexCharArray# , writeWord8Array# , unsafeFreezeByteArray# - +#if MIN_VERSION_base(4,12,0) && defined(SAFE_UNALIGNED) ,writeWord64Array# ,indexWord8ArrayAsWord64# - +#endif , setByteArray# , sizeofByteArray# , indexWord8Array#, indexCharArray# From b8390ca19be7dec6ca0ae84f276a71ce0044fa6e Mon Sep 17 00:00:00 2001 From: Brian Shu Date: Fri, 30 Sep 2022 11:57:33 -0400 Subject: [PATCH 9/9] fix --- Data/ByteString/Short/Internal.hs | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/Data/ByteString/Short/Internal.hs b/Data/ByteString/Short/Internal.hs index 635ff97ae..ef95a7fb9 100644 --- a/Data/ByteString/Short/Internal.hs +++ b/Data/ByteString/Short/Internal.hs @@ -251,6 +251,8 @@ import GHC.Exts #endif #if __GLASGOW_HASKELL__ >= 801 , getSizeofMutableByteArray# +#else + , sizeofMutableByteArray# #endif ) import GHC.IO @@ -287,7 +289,6 @@ import qualified Data.List as List import qualified GHC.Exts import qualified Language.Haskell.TH.Lib as TH import qualified Language.Haskell.TH.Syntax as TH -import System.IO (IOMode, Handle) import Foreign.Ptr (plusPtr) import qualified System.IO as IO import Control.Monad ((=<<)) @@ -1784,8 +1785,7 @@ getSizeofMutableByteArray :: MBA s -> ST s Int getSizeofMutableByteArray (MBA# arr#) = ST (\s# -> case getSizeofMutableByteArray# arr# s# of (# s'#, n# #) -> (# s'#, I# n# #)) #else -getSizeofMutableByteArray arr - = return (sizeofMutableByteArray arr) +getSizeofMutableByteArray (MBA# arr#) = pure (I# (sizeofMutableByteArray# arr#)) #endif -- | Check whether or not the byte array is pinned. Pinned byte arrays cannot @@ -2011,23 +2011,23 @@ moduleError fun msg = error (moduleErrorMsg fun msg) -- | Outputs 'ShortByteString' to the specified 'Handle'. This is implemented -- with 'IO.hPutBuf'. The offset and length are used because we don't have slices of 'ByteArray' yet. -- The function is unsafe because the offset and length is not checked. -unsafeHPutOff :: Handle -> ShortByteString -> Int -> Int -> IO () +unsafeHPutOff :: IO.Handle -> ShortByteString -> Int -> Int -> IO () unsafeHPutOff handle sbs off len = withPtr sbs $ \p -> IO.hPutBuf handle (p `plusPtr` off) len -hPut :: Handle -> ShortByteString -> IO () +hPut :: IO.Handle -> ShortByteString -> IO () hPut h sbs = unsafeHPutOff h sbs 0 (length sbs) readFile :: FilePath -> IO ShortByteString readFile path = unsafePlainToShortIO =<< BS.readFile path -hGetContents :: Handle -> IO ShortByteString +hGetContents :: IO.Handle -> IO ShortByteString hGetContents h = unsafePlainToShortIO =<< BS.hGetContents h -hGetLine :: Handle -> IO ShortByteString +hGetLine :: IO.Handle -> IO ShortByteString hGetLine h = unsafePlainToShortIO =<< BS.hGetLine h -hGet :: Handle -> Int -> IO ShortByteString +hGet :: IO.Handle -> Int -> IO ShortByteString hGet h i = unsafePlainToShortIO =<< BS.hGet h i -hGetSome :: Handle -> Int -> IO ShortByteString +hGetSome :: IO.Handle -> Int -> IO ShortByteString hGetSome h i = unsafePlainToShortIO =<< BS.hGetSome h i