diff --git a/Changelog.md b/Changelog.md --- a/Changelog.md +++ b/Changelog.md @@ -1,3 +1,32 @@ +[0.11.4.0] — January 2023 + +* Bug fixes: + * [Prevent commoning-up of `ShortByteString` literals produced by `TemplateHaskell`](https://github.com/haskell/bytestring/pull/542) + * [Make `Builder` literals demand a sane amount of memory at chunk boundaries](https://github.com/haskell/bytestring/pull/538) +* API additions and behavior changes: + * [Export `unsafeIndex` for `ShortByteString` which had been accidentally removed in v0.11.3.0](https://github.com/haskell/bytestring/pull/532) + * [Make `Data.ByteString.Lazy.Char8.lines` less strict](https://github.com/haskell/bytestring/pull/562) + * [Add `NonEmpty` variants of `inits` and `tails`](https://github.com/haskell/bytestring/pull/557) +* Performance improvements: + * [Speed up `unpack` and folds for `ShortByteString`](https://github.com/haskell/bytestring/pull/526) + * [Speed up `Builder`s for non-host endianness](https://github.com/haskell/bytestring/pull/531) + * [Work around upstream `keepAlive#` performance regressions](https://github.com/haskell/bytestring/pull/536) + * [Improve performance of `uncons` for `LazyByteString`](https://github.com/haskell/bytestring/pull/559) + * [Simplify `useAsCString`](https://github.com/haskell/bytestring/pull/516) + * [Remove redundant comparisons in `Data.ByteString.Short.splitAt`](https://github.com/haskell/bytestring/pull/528) +* Miscellaneous: + * [Document possible interleaving of `hPutStrLn` and friends](https://github.com/haskell/bytestring/pull/518) + * [Documentation tweaks](https://github.com/haskell/bytestring/pull/523) + * [Add lower bound for `tasty-quickcheck`](https://github.com/haskell/bytestring/pull/520) + + +[0.11.4.0]: https://github.com/haskell/bytestring/compare/0.11.3.1...0.11.4.0 + [0.11.3.1] — May 2022 * [Windows: Do not link against `gcc_s`](https://github.com/haskell/bytestring/pull/500) @@ -7,6 +36,8 @@ [0.11.3.1]: https://github.com/haskell/bytestring/compare/0.11.3.0...0.11.3.1 [0.11.3.0] — February 2022 + +Erratum: `unsafeIndex` was accidentally removed from the export list of `Data.ByteString.Short.Internal` in this release. This was corrected in 0.11.4.0. * [Enhance `ShortByteString` API](https://github.com/haskell/bytestring/pull/471) - Add `all`, `any`, `append`, `break`, `breakEnd`, `breakSubstring`, `concat`, `cons`, `count`, `drop`, `dropEnd`, `dropWhile`, `dropWhileEnd`, `elem`, `elemIndex`, `elemIndices`, `filter`, `find`, `findIndex`, `findIndices`, `foldl'`, `foldl`, `foldl1'`, `foldl1`, `foldr'`, `foldr`, `foldr1'`, `foldr1`, `head`, `init`, `intercalate`, `isInfixOf`, `isPrefixOf`, `isSuffixOf`, `last`, `map`, `partition`, `replicate`, `reverse`, `singleton`, `snoc`, `span`, `spanEnd`, `split`, `splitAt`, `splitWith`, `stripPrefix`, `stripSuffix`, `tail`, `take`, `takeEnd`, `takeWhile`, `takeWhileEnd`, `uncons`, `unfoldr`, `unfoldrN`, `unsnoc` to `Data.ByteString.Short`. diff --git a/Data/ByteString.hs b/Data/ByteString.hs --- a/Data/ByteString.hs +++ b/Data/ByteString.hs @@ -130,6 +130,8 @@ groupBy, inits, tails, + initsNE, + tailsNE, stripPrefix, stripSuffix, @@ -230,11 +232,13 @@ import Data.Bits (finiteBitSize, shiftL, (.|.), (.&.)) -import Data.ByteString.Internal +import Data.ByteString.Internal.Type import Data.ByteString.Lazy.Internal (fromStrict, toStrict) import Data.ByteString.Unsafe import qualified Data.List as List +import qualified Data.List.NonEmpty as NE +import Data.List.NonEmpty (NonEmpty(..)) import Data.Word (Word8) @@ -243,7 +247,7 @@ import Foreign.C.String (CString, CStringLen) import Foreign.C.Types (CSize (CSize), CInt (CInt)) -import Foreign.ForeignPtr (ForeignPtr, withForeignPtr, touchForeignPtr) +import Foreign.ForeignPtr (ForeignPtr, touchForeignPtr) import Foreign.ForeignPtr.Unsafe(unsafeForeignPtrToPtr) import Foreign.Marshal.Alloc (allocaBytes) import Foreign.Marshal.Array (allocaArray) @@ -267,7 +271,6 @@ import GHC.Foreign (newCStringLen, peekCStringLen) import GHC.Stack.Types (HasCallStack) import Data.Char (ord) -import Foreign.Marshal.Utils (copyBytes) import GHC.Base (build) import GHC.Word hiding (Word8) @@ -375,20 +378,22 @@ -- | /O(n)/ 'cons' is analogous to (:) for lists, but of different -- complexity, as it requires making a copy. cons :: Word8 -> ByteString -> ByteString -cons c (BS x l) = unsafeCreate (l+1) $ \p -> unsafeWithForeignPtr x $ \f -> do - poke p c - memcpy (p `plusPtr` 1) f l +cons c (BS x l) = unsafeCreateFp (l+1) $ \p -> do + pokeFp p c + memcpyFp (p `plusForeignPtr` 1) x l {-# INLINE cons #-} -- | /O(n)/ Append a byte to the end of a 'ByteString' snoc :: ByteString -> Word8 -> ByteString -snoc (BS x l) c = unsafeCreate (l+1) $ \p -> unsafeWithForeignPtr x $ \f -> do - memcpy p f l - poke (p `plusPtr` l) c +snoc (BS x l) c = unsafeCreateFp (l+1) $ \p -> do + memcpyFp p x l + pokeFp (p `plusForeignPtr` l) c {-# INLINE snoc #-} -- | /O(1)/ Extract the first element of a ByteString, which must be non-empty. -- An exception will be thrown in the case of an empty ByteString. +-- +-- This is a partial function, consider using 'uncons' instead. head :: HasCallStack => ByteString -> Word8 head (BS x l) | l <= 0 = errorEmptyList "head" @@ -397,13 +402,15 @@ -- | /O(1)/ Extract the elements after the head of a ByteString, which must be non-empty. -- An exception will be thrown in the case of an empty ByteString. +-- +-- This is a partial function, consider using 'uncons' instead. tail :: HasCallStack => ByteString -> ByteString tail (BS p l) | l <= 0 = errorEmptyList "tail" | otherwise = BS (plusForeignPtr p 1) (l-1) {-# INLINE tail #-} --- | /O(1)/ Extract the head and tail of a ByteString, returning Nothing +-- | /O(1)/ Extract the 'head' and 'tail' of a ByteString, returning 'Nothing' -- if it is empty. uncons :: ByteString -> Maybe (Word8, ByteString) uncons (BS x l) @@ -415,6 +422,8 @@ -- | /O(1)/ Extract the last element of a ByteString, which must be finite and non-empty. -- An exception will be thrown in the case of an empty ByteString. +-- +-- This is a partial function, consider using 'unsnoc' instead. last :: HasCallStack => ByteString -> Word8 last ps@(BS x l) | null ps = errorEmptyList "last" @@ -422,15 +431,17 @@ unsafeWithForeignPtr x $ \p -> peekByteOff p (l-1) {-# INLINE last #-} --- | /O(1)/ Return all the elements of a 'ByteString' except the last one. +-- | /O(1)/ Returns all the elements of a 'ByteString' except the last one. -- An exception will be thrown in the case of an empty ByteString. +-- +-- This is a partial function, consider using 'unsnoc' instead. init :: HasCallStack => ByteString -> ByteString init ps@(BS p l) | null ps = errorEmptyList "init" | otherwise = BS p (l-1) {-# INLINE init #-} --- | /O(1)/ Extract the 'init' and 'last' of a ByteString, returning Nothing +-- | /O(1)/ Extract the 'init' and 'last' of a ByteString, returning 'Nothing' -- if it is empty. unsnoc :: ByteString -> Maybe (ByteString, Word8) unsnoc (BS x l) @@ -451,8 +462,7 @@ -- | /O(n)/ 'map' @f xs@ is the ByteString obtained by applying @f@ to each -- element of @xs@. map :: (Word8 -> Word8) -> ByteString -> ByteString -map f (BS fp len) = unsafeDupablePerformIO $ unsafeWithForeignPtr fp $ \srcPtr -> - create len $ \dstPtr -> m srcPtr dstPtr +map f (BS srcPtr len) = unsafeCreateFp len $ \dstPtr -> m srcPtr dstPtr where m !p1 !p2 = map_ 0 where @@ -460,15 +470,17 @@ map_ !n | n >= len = return () | otherwise = do - x <- peekByteOff p1 n - pokeByteOff p2 n (f x) + x <- peekFpByteOff p1 n + pokeFpByteOff p2 n (f x) map_ (n+1) {-# INLINE map #-} -- | /O(n)/ 'reverse' @xs@ efficiently returns the elements of @xs@ in reverse order. reverse :: ByteString -> ByteString -reverse (BS x l) = unsafeCreate l $ \p -> unsafeWithForeignPtr x $ \f -> - c_reverse p f (fromIntegral l) +reverse (BS x l) = unsafeCreateFp l $ \fp -> + unsafeWithForeignPtr fp $ \p -> + unsafeWithForeignPtr x $ \f -> + c_reverse p f (fromIntegral l) -- | /O(n)/ The 'intersperse' function takes a 'Word8' and a -- 'ByteString' and \`intersperses\' that byte between the elements of @@ -477,8 +489,10 @@ intersperse :: Word8 -> ByteString -> ByteString intersperse c ps@(BS x l) | length ps < 2 = ps - | otherwise = unsafeCreate (2*l-1) $ \p -> unsafeWithForeignPtr x $ \f -> - c_intersperse p f (fromIntegral l) c + | otherwise = unsafeCreateFp (2*l-1) $ \fp -> + unsafeWithForeignPtr fp $ \p -> + unsafeWithForeignPtr x $ \f -> + c_intersperse p f (fromIntegral l) c -- | The 'transpose' function transposes the rows and columns of its -- 'ByteString' argument. @@ -525,13 +539,13 @@ let g ptr = go v ptr where - end = ptr `plusPtr` len + end = ptr `plusForeignPtr` len -- tail recursive; traverses array left to right go !z !p | p == end = return z - | otherwise = do x <- peek p - go (f z x) (p `plusPtr` 1) + | otherwise = do x <- peekFp p + go (f z x) (p `plusForeignPtr` 1) in - accursedUnutterablePerformIO $ unsafeWithForeignPtr fp g + accursedUnutterablePerformIO $ g fp {-# INLINE foldl' #-} -- | 'foldr', applied to a binary operator, a starting value @@ -559,15 +573,15 @@ foldr' k v = \(BS fp len) -> -- see fold inlining let - g ptr = go v (end `plusPtr` len) + g ptr = go v (end `plusForeignPtr` len) where - end = ptr `plusPtr` (-1) + end = ptr `plusForeignPtr` (-1) -- tail recursive; traverses array right to left go !z !p | p == end = return z - | otherwise = do x <- peek p - go (k x z) (p `plusPtr` (-1)) + | otherwise = do x <- peekFp p + go (k x z) (p `plusForeignPtr` (-1)) in - accursedUnutterablePerformIO $ unsafeWithForeignPtr fp g + accursedUnutterablePerformIO $ g fp {-# INLINE foldr' #-} @@ -622,15 +636,15 @@ -- any element of the 'ByteString' satisfies the predicate. any :: (Word8 -> Bool) -> ByteString -> Bool any _ (BS _ 0) = False -any f (BS x len) = accursedUnutterablePerformIO $ unsafeWithForeignPtr x g +any f (BS x len) = accursedUnutterablePerformIO $ g x where g ptr = go ptr where - end = ptr `plusPtr` len + end = ptr `plusForeignPtr` len go !p | p == end = return False - | otherwise = do c <- peek p + | otherwise = do c <- peekFp p if f c then return True - else go (p `plusPtr` 1) + else go (p `plusForeignPtr` 1) {-# INLINE [1] any #-} {-# RULES @@ -651,15 +665,15 @@ -- if all elements of the 'ByteString' satisfy the predicate. all :: (Word8 -> Bool) -> ByteString -> Bool all _ (BS _ 0) = True -all f (BS x len) = accursedUnutterablePerformIO $ unsafeWithForeignPtr x g +all f (BS x len) = accursedUnutterablePerformIO $ g x where g ptr = go ptr where - end = ptr `plusPtr` len + end = ptr `plusForeignPtr` len go !p | p == end = return True -- end of list - | otherwise = do c <- peek p + | otherwise = do c <- peekFp p if f c - then go (p `plusPtr` 1) + then go (p `plusForeignPtr` 1) else return False {-# INLINE [1] all #-} @@ -697,7 +711,7 @@ -- passing an accumulating parameter from left to right, and returning a -- final value of this accumulator together with the new ByteString. mapAccumL :: (acc -> Word8 -> (acc, Word8)) -> acc -> ByteString -> (acc, ByteString) -mapAccumL f acc = \(BS fp len) -> unsafeDupablePerformIO $ unsafeWithForeignPtr fp $ \a -> do +mapAccumL f acc = \(BS a len) -> unsafeDupablePerformIO $ do -- see fold inlining gp <- mallocByteString len let @@ -706,11 +720,11 @@ mapAccumL_ !s !n | n >= len = return s | otherwise = do - x <- peekByteOff src n + x <- peekFpByteOff src n let (s', y) = f s x - pokeByteOff dst n y + pokeFpByteOff dst n y mapAccumL_ s' (n+1) - acc' <- unsafeWithForeignPtr gp (go a) + acc' <- go a gp return (acc', BS gp len) {-# INLINE mapAccumL #-} @@ -719,7 +733,7 @@ -- passing an accumulating parameter from right to left, and returning a -- final value of this accumulator together with the new ByteString. mapAccumR :: (acc -> Word8 -> (acc, Word8)) -> acc -> ByteString -> (acc, ByteString) -mapAccumR f acc = \(BS fp len) -> unsafeDupablePerformIO $ unsafeWithForeignPtr fp $ \a -> do +mapAccumR f acc = \(BS a len) -> unsafeDupablePerformIO $ do -- see fold inlining gp <- mallocByteString len let @@ -727,11 +741,11 @@ where mapAccumR_ !s (-1) = return s mapAccumR_ !s !n = do - x <- peekByteOff src n + x <- peekFpByteOff src n let (s', y) = f s x - pokeByteOff dst n y + pokeFpByteOff dst n y mapAccumR_ s' (n-1) - acc' <- unsafeWithForeignPtr gp (go a) + acc' <- go a gp return (acc', BS gp len) {-# INLINE mapAccumR #-} @@ -757,21 +771,20 @@ -- ^ input of length n -> ByteString -- ^ output of length n+1 -scanl f v = \(BS fp len) -> unsafeDupablePerformIO $ unsafeWithForeignPtr fp $ \a -> +scanl f v = \(BS a len) -> unsafeCreateFp (len+1) $ \q -> do -- see fold inlining - create (len+1) $ \q -> do - poke q v + pokeFp q v let go src dst = scanl_ v 0 where scanl_ !z !n | n >= len = return () | otherwise = do - x <- peekByteOff src n + x <- peekFpByteOff src n let z' = f z x - pokeByteOff dst n z' + pokeFpByteOff dst n z' scanl_ z' (n+1) - go a (q `plusPtr` 1) + go a (q `plusForeignPtr` 1) {-# INLINE scanl #-} -- | 'scanl1' is a variant of 'scanl' that has no starting value argument. @@ -802,19 +815,18 @@ -- ^ input of length n -> ByteString -- ^ output of length n+1 -scanr f v = \(BS fp len) -> unsafeDupablePerformIO $ unsafeWithForeignPtr fp $ \a -> +scanr f v = \(BS a len) -> unsafeCreateFp (len+1) $ \b -> do -- see fold inlining - create (len+1) $ \b -> do - poke (b `plusPtr` len) v + pokeFpByteOff b len v let go p q = scanr_ v (len-1) where scanr_ !z !n | n < 0 = return () | otherwise = do - x <- peekByteOff p n + x <- peekFpByteOff p n let z' = f x z - pokeByteOff q n z' + pokeFpByteOff q n z' scanr_ z' (n-1) go a b {-# INLINE scanr #-} @@ -838,7 +850,8 @@ replicate :: Int -> Word8 -> ByteString replicate w c | w <= 0 = empty - | otherwise = unsafeCreate w $ \ptr -> + | otherwise = unsafeCreateFp w $ \fptr -> + unsafeWithForeignPtr fptr $ \ptr -> void $ memset ptr c (fromIntegral w) {-# INLINE replicate #-} @@ -874,7 +887,7 @@ unfoldrN :: Int -> (a -> Maybe (Word8, a)) -> a -> (ByteString, Maybe a) unfoldrN i f x0 | i < 0 = (empty, Just x0) - | otherwise = unsafePerformIO $ createAndTrim' i $ \p -> go p x0 0 + | otherwise = unsafePerformIO $ createFpAndTrim' i $ \p -> go p x0 0 where go !p !x !n = go' x n where @@ -882,7 +895,7 @@ | n' == i = return (0, n', Just x') | otherwise = case f x' of Nothing -> return (0, n', Nothing) - Just (w,x'') -> do pokeByteOff p n' w + Just (w,x'') -> do pokeFpByteOff p n' w go' x'' (n'+1) {-# INLINE unfoldrN #-} @@ -1122,10 +1135,9 @@ splitWith predicate (BS fp len) = splitWith0 0 len fp where splitWith0 !off' !len' !fp' = accursedUnutterablePerformIO $ - unsafeWithForeignPtr fp $ \p -> - splitLoop p 0 off' len' fp' + splitLoop fp 0 off' len' fp' - splitLoop :: Ptr Word8 + splitLoop :: ForeignPtr Word8 -> Int -> Int -> Int -> ForeignPtr Word8 -> IO [ByteString] @@ -1134,7 +1146,7 @@ go idx' | idx' >= len' = return [BS (plusForeignPtr fp' off') idx'] | otherwise = do - w <- peekElemOff p (off'+idx') + w <- peekFpByteOff p (off'+idx') if predicate w then return (BS (plusForeignPtr fp' off') idx' : splitWith0 (off'+idx'+1) (len'-idx'-1) fp') @@ -1205,19 +1217,16 @@ intercalate :: ByteString -> [ByteString] -> ByteString intercalate _ [] = mempty intercalate _ [x] = x -- This branch exists for laziness, not speed -intercalate (BS fSepPtr sepLen) (BS fhPtr hLen : t) = - unsafeCreate totalLen $ \dstPtr0 -> - unsafeWithForeignPtr fSepPtr $ \sepPtr -> do - unsafeWithForeignPtr fhPtr $ \hPtr -> - memcpy dstPtr0 hPtr hLen +intercalate (BS sepPtr sepLen) (BS hPtr hLen : t) = + unsafeCreateFp totalLen $ \dstPtr0 -> do + memcpyFp dstPtr0 hPtr hLen let go _ [] = pure () - go dstPtr (BS fChunkPtr chunkLen : chunks) = do - memcpy dstPtr sepPtr sepLen - let destPtr' = dstPtr `plusPtr` sepLen - unsafeWithForeignPtr fChunkPtr $ \chunkPtr -> - memcpy destPtr' chunkPtr chunkLen - go (destPtr' `plusPtr` chunkLen) chunks - go (dstPtr0 `plusPtr` hLen) t + go dstPtr (BS chunkPtr chunkLen : chunks) = do + memcpyFp dstPtr sepPtr sepLen + let destPtr' = dstPtr `plusForeignPtr` sepLen + memcpyFp destPtr' chunkPtr chunkLen + go (destPtr' `plusForeignPtr` chunkLen) chunks + go (dstPtr0 `plusForeignPtr` hLen) t where totalLen = List.foldl' (\acc (BS _ chunkLen) -> acc + chunkLen + sepLen) hLen t {-# INLINE intercalate #-} @@ -1226,6 +1235,8 @@ -- Indexing ByteStrings -- | /O(1)/ 'ByteString' index (subscript) operator, starting from 0. +-- +-- This is a partial function, consider using 'indexMaybe' instead. index :: HasCallStack => ByteString -> Int -> Word8 index ps n | n < 0 = moduleError "index" ("negative index: " ++ show n) @@ -1306,12 +1317,12 @@ -- returns the index of the first element in the ByteString -- satisfying the predicate. findIndex :: (Word8 -> Bool) -> ByteString -> Maybe Int -findIndex k (BS x l) = accursedUnutterablePerformIO $ unsafeWithForeignPtr x g +findIndex k (BS x l) = accursedUnutterablePerformIO $ g x where g !ptr = go 0 where go !n | n >= l = return Nothing - | otherwise = do w <- peek $ ptr `plusPtr` n + | otherwise = do w <- peekFp $ ptr `plusForeignPtr` n if k w then return (Just n) else go (n+1) @@ -1323,12 +1334,12 @@ -- -- @since 0.10.12.0 findIndexEnd :: (Word8 -> Bool) -> ByteString -> Maybe Int -findIndexEnd k (BS x l) = accursedUnutterablePerformIO $ unsafeWithForeignPtr x g +findIndexEnd k (BS x l) = accursedUnutterablePerformIO $ g x where g !ptr = go (l-1) where go !n | n < 0 = return Nothing - | otherwise = do w <- peekByteOff ptr n + | otherwise = do w <- peekFpByteOff ptr n if k w then return (Just n) else go (n-1) @@ -1371,24 +1382,25 @@ -- returns a ByteString containing those characters that satisfy the -- predicate. filter :: (Word8 -> Bool) -> ByteString -> ByteString -filter k = \ps@(BS x l) -> +filter k = \ps@(BS pIn l) -> -- see fold inlining. if null ps then ps else - unsafePerformIO $ createAndTrim l $ \pOut -> unsafeWithForeignPtr x $ \pIn -> do + unsafeDupablePerformIO $ createFpAndTrim l $ \pOut -> do let go' pf pt = go pf pt where - end = pf `plusPtr` l + end = pf `plusForeignPtr` l go !f !t | f == end = return t | otherwise = do - w <- peek f + w <- peekFp f if k w - then poke t w >> go (f `plusPtr` 1) (t `plusPtr` 1) - else go (f `plusPtr` 1) t + then pokeFp t w + >> go (f `plusForeignPtr` 1) (t `plusForeignPtr` 1) + else go (f `plusForeignPtr` 1) t t <- go' pIn pOut - return $! t `minusPtr` pOut -- actual length + return $! t `minusForeignPtr` pOut -- actual length {-# INLINE filter #-} {- @@ -1434,34 +1446,33 @@ -- partition :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString) partition f s = unsafeDupablePerformIO $ - do fp' <- mallocByteString len - unsafeWithForeignPtr fp' $ \p -> - do let end = p `plusPtr` (len - 1) + do p <- mallocByteString len + let end = p `plusForeignPtr` (len - 1) mid <- sep 0 p end rev mid end - let i = mid `minusPtr` p - return (BS fp' i, - BS (plusForeignPtr fp' i) (len - i)) + let i = mid `minusForeignPtr` p + return (BS p i, + BS (p `plusForeignPtr` i) (len - i)) where len = length s - incr = (`plusPtr` 1) - decr = (`plusPtr` (-1)) + incr = (`plusForeignPtr` 1) + decr = (`plusForeignPtr` (-1)) sep !i !p1 !p2 | i == len = return p1 - | f w = do poke p1 w + | f w = do pokeFp p1 w sep (i + 1) (incr p1) p2 - | otherwise = do poke p2 w + | otherwise = do pokeFp p2 w sep (i + 1) p1 (decr p2) where w = s `unsafeIndex` i - rev !p1 !p2 + rev !p1 !p2 -- fixme: surely there are faster ways to do this | p1 >= p2 = return () - | otherwise = do a <- peek p1 - b <- peek p2 - poke p1 b - poke p2 a + | otherwise = do a <- peekFp p1 + b <- peekFp p2 + pokeFp p1 b + pokeFp p2 a rev (incr p1) (decr p2) -- -------------------------------------------------------------------- @@ -1652,20 +1663,18 @@ -- -- @since 0.11.1.0 packZipWith :: (Word8 -> Word8 -> Word8) -> ByteString -> ByteString -> ByteString -packZipWith f (BS fp l) (BS fq m) = unsafeDupablePerformIO $ - unsafeWithForeignPtr fp $ \a -> - unsafeWithForeignPtr fq $ \b -> - create len $ go a b +packZipWith f (BS a l) (BS b m) = unsafeDupablePerformIO $ + createFp len $ go a b where go p1 p2 = zipWith_ 0 where - zipWith_ :: Int -> Ptr Word8 -> IO () + zipWith_ :: Int -> ForeignPtr Word8 -> IO () zipWith_ !n !r | n >= len = return () | otherwise = do - x <- peekByteOff p1 n - y <- peekByteOff p2 n - pokeByteOff r n (f x y) + x <- peekFpByteOff p1 n + y <- peekFpByteOff p2 n + pokeFpByteOff r n (f x y) zipWith_ (n+1) r len = min l m @@ -1685,17 +1694,47 @@ -- --------------------------------------------------------------------- -- Special lists --- | /O(n)/ Return all initial segments of the given 'ByteString', shortest first. +-- | /O(n)/ Returns all initial segments of the given 'ByteString', shortest first. inits :: ByteString -> [ByteString] -inits (BS x l) = [BS x n | n <- [0..l]] +-- see Note [Avoid NonEmpty combinators] +inits bs = NE.toList $! initsNE bs --- | /O(n)/ Return all final segments of the given 'ByteString', longest first. +-- | /O(n)/ Returns all initial segments of the given 'ByteString', shortest first. +-- +-- @since 0.11.4.0 +initsNE :: ByteString -> NonEmpty ByteString +-- see Note [Avoid NonEmpty combinators] +initsNE (BS x len) = empty :| [BS x n | n <- [1..len]] + +-- | /O(n)/ Returns all final segments of the given 'ByteString', longest first. tails :: ByteString -> [ByteString] -tails p | null p = [empty] - | otherwise = p : tails (unsafeTail p) +-- see Note [Avoid NonEmpty combinators] +tails bs = NE.toList $! tailsNE bs +-- | /O(n)/ Returns all final segments of the given 'ByteString', longest first. +-- +-- @since 0.11.4.0 +tailsNE :: ByteString -> NonEmpty ByteString +-- see Note [Avoid NonEmpty combinators] +tailsNE p | null p = empty :| [] + | otherwise = p :| tails (unsafeTail p) + -- less efficent spacewise: tails (BS x l) = [BS (plusForeignPtr x n) (l-n) | n <- [0..l]] +{- +Note [Avoid NonEmpty combinators] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +As of base-4.17, most of the NonEmpty API is surprisingly lazy. +Using it without forcing the arguments yourself is just begging GHC +to make your code waste time allocating useless selector thunks. +This may change in the future. See also this CLC issue: + https://github.com/haskell/core-libraries-committee/issues/107 +But until then, "refactor" with care! +-} + + + -- --------------------------------------------------------------------- -- ** Ordered 'ByteString's @@ -1703,10 +1742,10 @@ sort :: ByteString -> ByteString sort (BS input l) -- qsort outperforms counting sort for small arrays - | l <= 20 = unsafeCreate l $ \ptr -> unsafeWithForeignPtr input $ \inp -> do - memcpy ptr inp l - c_sort ptr (fromIntegral l) - | otherwise = unsafeCreate l $ \p -> allocaArray 256 $ \arr -> do + | l <= 20 = unsafeCreateFp l $ \destFP -> do + memcpyFp destFP input l + unsafeWithForeignPtr destFP $ \dest -> c_sort dest (fromIntegral l) + | otherwise = unsafeCreateFp l $ \p -> allocaArray 256 $ \arr -> do _ <- memset (castPtr arr) 0 (256 * fromIntegral (sizeOf (undefined :: CSize))) unsafeWithForeignPtr input (\x -> countOccurrences arr x l) @@ -1715,7 +1754,7 @@ go i !ptr = do n <- peekElemOff arr i when (n /= 0) $ void $ memset ptr (fromIntegral i) n go (i + 1) (ptr `plusPtr` fromIntegral n) - go 0 p + unsafeWithForeignPtr p (go 0) where -- Count the number of occurrences of each byte. -- Used by 'sort' @@ -1738,12 +1777,10 @@ -- subcomputation finishes. useAsCString :: ByteString -> (CString -> IO a) -> IO a useAsCString (BS fp l) action = - allocaBytes (l+1) $ \buf -> - -- Cannot use unsafeWithForeignPtr, because action can diverge - withForeignPtr fp $ \p -> do - memcpy buf p l - pokeByteOff buf l (0::Word8) - action (castPtr buf) + allocaBytes (l+1) $ \buf -> do + unsafeWithForeignPtr fp $ \p -> memcpy buf p l + pokeByteOff buf l (0::Word8) + action (castPtr buf) -- | /O(n) construction/ Use a @ByteString@ with a function requiring a @CStringLen@. -- As for @useAsCString@ this function makes a copy of the original @ByteString@. @@ -1767,8 +1804,8 @@ -- The @ByteString@ is a normal Haskell value and will be managed on the -- Haskell heap. packCStringLen :: CStringLen -> IO ByteString -packCStringLen (cstr, len) | len >= 0 = create len $ \p -> - memcpy p (castPtr cstr) len +packCStringLen (cstr, len) | len >= 0 = createFp len $ \fp -> + unsafeWithForeignPtr fp $ \p -> memcpy p (castPtr cstr) len packCStringLen (_, len) = moduleErrorIO "packCStringLen" ("negative length: " ++ show len) @@ -1781,8 +1818,7 @@ -- is needed in the rest of the program. -- copy :: ByteString -> ByteString -copy (BS x l) = unsafeCreate l $ \p -> unsafeWithForeignPtr x $ \f -> - memcpy p f l +copy (BS x l) = unsafeCreateFp l $ \p -> memcpyFp p x l -- --------------------------------------------------------------------- -- Line IO @@ -1841,8 +1877,7 @@ mkPS :: RawBuffer Word8 -> Int -> Int -> IO ByteString mkPS buf start end = - create len $ \p -> - withRawBuffer buf $ \pbuf -> copyBytes p (pbuf `plusPtr` start) len + createFp len $ \fp -> memcpyFp fp (buf `plusForeignPtr` start) len where len = end - start @@ -1871,11 +1906,11 @@ bytesWritten <- unsafeWithForeignPtr ps $ \p-> hPutBufNonBlocking h p l return $! drop bytesWritten bs --- | A synonym for @hPut@, for compatibility +-- | A synonym for 'hPut', for compatibility hPutStr :: Handle -> ByteString -> IO () hPutStr = hPut --- | Write a ByteString to stdout +-- | Write a ByteString to 'stdout'. putStr :: ByteString -> IO () putStr = hPut stdout @@ -1895,7 +1930,8 @@ -- hGet :: Handle -> Int -> IO ByteString hGet h i - | i > 0 = createAndTrim i $ \p -> hGetBuf h p i + | i > 0 = createFpAndTrim i $ \fp -> + unsafeWithForeignPtr fp $ \p -> hGetBuf h p i | i == 0 = return empty | otherwise = illegalBufferSize h "hGet" i @@ -1909,7 +1945,8 @@ -- hGetNonBlocking :: Handle -> Int -> IO ByteString hGetNonBlocking h i - | i > 0 = createAndTrim i $ \p -> hGetBufNonBlocking h p i + | i > 0 = createFpAndTrim i $ \fp -> + unsafeWithForeignPtr fp $ \p -> hGetBufNonBlocking h p i | i == 0 = return empty | otherwise = illegalBufferSize h "hGetNonBlocking" i @@ -1920,7 +1957,8 @@ -- hGetSome :: Handle -> Int -> IO ByteString hGetSome hh i - | i > 0 = createAndTrim i $ \p -> hGetBufSome hh p i + | i > 0 = createFpAndTrim i $ \fp -> + unsafeWithForeignPtr fp $ \p -> hGetBufSome hh p i | i == 0 = return empty | otherwise = illegalBufferSize hh "hGetSome" i diff --git a/Data/ByteString/Builder/Internal.hs b/Data/ByteString/Builder/Internal.hs --- a/Data/ByteString/Builder/Internal.hs +++ b/Data/ByteString/Builder/Internal.hs @@ -133,7 +133,7 @@ #endif import qualified Data.ByteString as S -import qualified Data.ByteString.Internal as S +import qualified Data.ByteString.Internal.Type as S import qualified Data.ByteString.Lazy.Internal as L import qualified Data.ByteString.Short.Internal as Sh @@ -1099,8 +1099,8 @@ wrapChunk !op' mkCIOS | chunkSize == 0 = mkCIOS True | trim chunkSize size = do - bs <- S.create chunkSize $ \pbuf' -> - copyBytes pbuf' pbuf chunkSize + bs <- S.createFp chunkSize $ \fpbuf' -> + S.memcpyFp fpbuf' fpbuf chunkSize -- FIXME: We could reuse the trimmed buffer here. return $ Yield1 bs (mkCIOS False) | otherwise = diff --git a/Data/ByteString/Builder/Prim.hs b/Data/ByteString/Builder/Prim.hs --- a/Data/ByteString/Builder/Prim.hs +++ b/Data/ByteString/Builder/Prim.hs @@ -679,7 +679,7 @@ step !addr !k br@(BufferRange op0@(Ptr op0#) ope) | W8# ch == 0 = k br | op0 == ope = - return $ bufferFull defaultChunkSize op0 (step addr k) + return $ bufferFull 1 op0 (step addr k) | otherwise = do IO $ \s -> case writeWord8OffAddr# op0# 0# ch s of s' -> (# s', () #) @@ -700,7 +700,7 @@ step !addr !k br@(BufferRange op0@(Ptr op0#) ope) | W8# ch == 0 = k br | op0 == ope = - return $ bufferFull defaultChunkSize op0 (step addr k) + return $ bufferFull 1 op0 (step addr k) -- NULL is encoded as 0xc0 0x80 | W8# ch == 0xc0 , W8# (indexWord8OffAddr# addr 1#) == 0x80 = do diff --git a/Data/ByteString/Builder/Prim/Binary.hs b/Data/ByteString/Builder/Prim/Binary.hs --- a/Data/ByteString/Builder/Prim/Binary.hs +++ b/Data/ByteString/Builder/Prim/Binary.hs @@ -83,18 +83,14 @@ #ifdef WORDS_BIGENDIAN word16BE = word16Host #else -word16BE = fixedPrim 2 $ \w p -> do - poke p (fromIntegral (shiftR w 8) :: Word8) - poke (p `plusPtr` 1) (fromIntegral w :: Word8) +word16BE = byteSwap16 >$< word16Host #endif -- | Encoding 'Word16's in little endian format. {-# INLINE word16LE #-} word16LE :: FixedPrim Word16 #ifdef WORDS_BIGENDIAN -word16LE = fixedPrim 2 $ \w p -> do - poke p (fromIntegral w :: Word8) - poke (p `plusPtr` 1) (fromIntegral (shiftR w 8) :: Word8) +word16LE = byteSwap16 >$< word16Host #else word16LE = word16Host #endif @@ -105,22 +101,14 @@ #ifdef WORDS_BIGENDIAN word32BE = word32Host #else -word32BE = fixedPrim 4 $ \w p -> do - poke p (fromIntegral (shiftR w 24) :: Word8) - poke (p `plusPtr` 1) (fromIntegral (shiftR w 16) :: Word8) - poke (p `plusPtr` 2) (fromIntegral (shiftR w 8) :: Word8) - poke (p `plusPtr` 3) (fromIntegral w :: Word8) +word32BE = byteSwap32 >$< word32Host #endif -- | Encoding 'Word32's in little endian format. {-# INLINE word32LE #-} word32LE :: FixedPrim Word32 #ifdef WORDS_BIGENDIAN -word32LE = fixedPrim 4 $ \w p -> do - poke p (fromIntegral w :: Word8) - poke (p `plusPtr` 1) (fromIntegral (shiftR w 8) :: Word8) - poke (p `plusPtr` 2) (fromIntegral (shiftR w 16) :: Word8) - poke (p `plusPtr` 3) (fromIntegral (shiftR w 24) :: Word8) +word32LE = byteSwap32 >$< word32Host #else word32LE = word32Host #endif @@ -134,64 +122,14 @@ #ifdef WORDS_BIGENDIAN word64BE = word64Host #else -#if WORD_SIZE_IN_BITS < 64 --- --- To avoid expensive 64 bit shifts on 32 bit machines, we cast to --- Word32, and write that --- -word64BE = - fixedPrim 8 $ \w p -> do - let a = fromIntegral (shiftR w 32) :: Word32 - b = fromIntegral w :: Word32 - poke p (fromIntegral (shiftR a 24) :: Word8) - poke (p `plusPtr` 1) (fromIntegral (shiftR a 16) :: Word8) - poke (p `plusPtr` 2) (fromIntegral (shiftR a 8) :: Word8) - poke (p `plusPtr` 3) (fromIntegral a :: Word8) - poke (p `plusPtr` 4) (fromIntegral (shiftR b 24) :: Word8) - poke (p `plusPtr` 5) (fromIntegral (shiftR b 16) :: Word8) - poke (p `plusPtr` 6) (fromIntegral (shiftR b 8) :: Word8) - poke (p `plusPtr` 7) (fromIntegral b :: Word8) -#else -word64BE = fixedPrim 8 $ \w p -> do - poke p (fromIntegral (shiftR w 56) :: Word8) - poke (p `plusPtr` 1) (fromIntegral (shiftR w 48) :: Word8) - poke (p `plusPtr` 2) (fromIntegral (shiftR w 40) :: Word8) - poke (p `plusPtr` 3) (fromIntegral (shiftR w 32) :: Word8) - poke (p `plusPtr` 4) (fromIntegral (shiftR w 24) :: Word8) - poke (p `plusPtr` 5) (fromIntegral (shiftR w 16) :: Word8) - poke (p `plusPtr` 6) (fromIntegral (shiftR w 8) :: Word8) - poke (p `plusPtr` 7) (fromIntegral w :: Word8) -#endif +word64BE = byteSwap64 >$< word64Host #endif -- | Encoding 'Word64's in little endian format. {-# INLINE word64LE #-} word64LE :: FixedPrim Word64 #ifdef WORDS_BIGENDIAN -#if WORD_SIZE_IN_BITS < 64 -word64LE = - fixedPrim 8 $ \w p -> do - let b = fromIntegral (shiftR w 32) :: Word32 - a = fromIntegral w :: Word32 - poke (p) (fromIntegral a :: Word8) - poke (p `plusPtr` 1) (fromIntegral (shiftR a 8) :: Word8) - poke (p `plusPtr` 2) (fromIntegral (shiftR a 16) :: Word8) - poke (p `plusPtr` 3) (fromIntegral (shiftR a 24) :: Word8) - poke (p `plusPtr` 4) (fromIntegral b :: Word8) - poke (p `plusPtr` 5) (fromIntegral (shiftR b 8) :: Word8) - poke (p `plusPtr` 6) (fromIntegral (shiftR b 16) :: Word8) - poke (p `plusPtr` 7) (fromIntegral (shiftR b 24) :: Word8) -#else -word64LE = fixedPrim 8 $ \w p -> do - poke p (fromIntegral w :: Word8) - poke (p `plusPtr` 1) (fromIntegral (shiftR w 8) :: Word8) - poke (p `plusPtr` 2) (fromIntegral (shiftR w 16) :: Word8) - poke (p `plusPtr` 3) (fromIntegral (shiftR w 24) :: Word8) - poke (p `plusPtr` 4) (fromIntegral (shiftR w 32) :: Word8) - poke (p `plusPtr` 5) (fromIntegral (shiftR w 40) :: Word8) - poke (p `plusPtr` 6) (fromIntegral (shiftR w 48) :: Word8) - poke (p `plusPtr` 7) (fromIntegral (shiftR w 56) :: Word8) -#endif +word64LE = byteSwap64 >$< word64Host #else word64LE = word64Host #endif diff --git a/Data/ByteString/Char8.hs b/Data/ByteString/Char8.hs --- a/Data/ByteString/Char8.hs +++ b/Data/ByteString/Char8.hs @@ -129,6 +129,8 @@ groupBy, inits, tails, + initsNE, + tailsNE, strip, stripPrefix, stripSuffix, @@ -249,7 +251,7 @@ -- Listy functions transparently exported import Data.ByteString (null,length,tail,init,append - ,inits,tails,reverse,transpose + ,inits,tails,initsNE,tailsNE,reverse,transpose ,concat,take,takeEnd,drop,dropEnd,splitAt ,intercalate,sort,isPrefixOf,isSuffixOf ,isInfixOf,stripPrefix,stripSuffix @@ -263,7 +265,7 @@ ,useAsCString,useAsCStringLen ) -import Data.ByteString.Internal +import Data.ByteString.Internal.Type import Data.Char ( isSpace ) -- See bytestring #70 @@ -969,11 +971,11 @@ (+!) = checkedAdd "Char8.unlines" go [] _ = pure () - go (BS srcFP len : srcs) dest = do - unsafeWithForeignPtr srcFP $ \src -> memcpy dest src len - pokeElemOff dest len (c2w '\n') - go srcs $ dest `plusPtr` (len + 1) - in unsafeCreate totLen (go li) + go (BS src len : srcs) dest = do + memcpyFp dest src len + pokeFpByteOff dest len (c2w '\n') + go srcs $ dest `plusForeignPtr` (len + 1) + in unsafeCreateFp totLen (go li) -- | 'words' breaks a ByteString up into a list of words, which -- were delimited by Chars representing white space. @@ -1065,12 +1067,20 @@ ------------------------------------------------------------------------ -- For non-binary text processing: --- | Write a ByteString to a handle, appending a newline byte +-- | Write a ByteString to a handle, appending a newline byte. +-- +-- Unlike 'hPutStr', this is not atomic: other threads might write +-- to the handle between writing of the bytestring and the newline. +-- hPutStrLn :: Handle -> ByteString -> IO () hPutStrLn h ps | length ps < 1024 = hPut h (ps `B.snoc` 0x0a) | otherwise = hPut h ps >> hPut h (B.singleton 0x0a) -- don't copy --- | Write a ByteString to stdout, appending a newline byte +-- | Write a ByteString to 'stdout', appending a newline byte. +-- +-- Unlike 'putStr', this is not atomic: other threads might write +-- to 'stdout' between writing of the bytestring and the newline. +-- putStrLn :: ByteString -> IO () putStrLn = hPutStrLn stdout diff --git a/Data/ByteString/Internal.hs b/Data/ByteString/Internal.hs --- a/Data/ByteString/Internal.hs +++ b/Data/ByteString/Internal.hs @@ -1,11 +1,3 @@ -{-# LANGUAGE CPP, ForeignFunctionInterface, BangPatterns #-} -{-# LANGUAGE UnliftedFFITypes, MagicHash, - UnboxedTuples, DeriveDataTypeable #-} -{-# LANGUAGE TupleSections #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE PatternSynonyms, ViewPatterns #-} -{-# LANGUAGE Unsafe #-} -{-# LANGUAGE TemplateHaskellQuotes #-} {-# OPTIONS_HADDOCK not-home #-} -- | @@ -96,791 +88,4 @@ unsafeWithForeignPtr ) where -import Prelude hiding (concat, null) -import qualified Data.List as List - -import Control.Monad (void) - -import Foreign.ForeignPtr (ForeignPtr, withForeignPtr) -import Foreign.Ptr (Ptr, FunPtr, plusPtr, minusPtr) -import Foreign.Storable (Storable(..)) -import Foreign.C.Types (CInt(..), CSize(..)) -import Foreign.C.String (CString) - -#if MIN_VERSION_base(4,13,0) -import Data.Semigroup (Semigroup (sconcat, stimes)) -#else -import Data.Semigroup (Semigroup ((<>), sconcat, stimes)) -#endif -import Data.List.NonEmpty (NonEmpty ((:|))) - -import Control.DeepSeq (NFData(rnf)) - -import Data.String (IsString(..)) - -import Control.Exception (assert) - -import Data.Bits ((.&.)) -import Data.Char (ord) -import Data.Word - -import Data.Typeable (Typeable) -import Data.Data (Data(..), mkNoRepType) - -import GHC.Base (nullAddr#,realWorld#,unsafeChr) -import GHC.Exts (IsList(..)) -import GHC.CString (unpackCString#) -import GHC.Prim (Addr#) -import GHC.IO (IO(IO),unsafeDupablePerformIO) -import GHC.ForeignPtr (ForeignPtr(ForeignPtr) -#if __GLASGOW_HASKELL__ < 900 - , newForeignPtr_ -#endif - , mallocPlainForeignPtrBytes) - -#if MIN_VERSION_base(4,10,0) -import GHC.ForeignPtr (plusForeignPtr) -#else -import GHC.Prim (plusAddr#) -#endif - -#if __GLASGOW_HASKELL__ >= 811 -import GHC.CString (cstringLength#) -import GHC.ForeignPtr (ForeignPtrContents(FinalPtr)) -#else -import GHC.Ptr (Ptr(..)) -#endif - -#if (__GLASGOW_HASKELL__ < 802) || (__GLASGOW_HASKELL__ >= 811) -import GHC.Types (Int (..)) -#endif - -#if MIN_VERSION_base(4,15,0) -import GHC.ForeignPtr (unsafeWithForeignPtr) -#endif - -import qualified Language.Haskell.TH.Lib as TH -import qualified Language.Haskell.TH.Syntax as TH - -#if !MIN_VERSION_base(4,15,0) -unsafeWithForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b -unsafeWithForeignPtr = withForeignPtr -#endif - --- CFILES stuff is Hugs only -{-# CFILES cbits/fpstring.c #-} - -#if !MIN_VERSION_base(4,10,0) --- |Advances the given address by the given offset in bytes. --- --- The new 'ForeignPtr' shares the finalizer of the original, --- equivalent from a finalization standpoint to just creating another --- reference to the original. That is, the finalizer will not be --- called before the new 'ForeignPtr' is unreachable, nor will it be --- called an additional time due to this call, and the finalizer will --- be called with the same address that it would have had this call --- not happened, *not* the new address. -plusForeignPtr :: ForeignPtr a -> Int -> ForeignPtr b -plusForeignPtr (ForeignPtr addr guts) (I# offset) = ForeignPtr (plusAddr# addr offset) guts -{-# INLINE [0] plusForeignPtr #-} -{-# RULES -"ByteString plusForeignPtr/0" forall fp . - plusForeignPtr fp 0 = fp - #-} -#endif - --- ----------------------------------------------------------------------------- - --- | A space-efficient representation of a 'Word8' vector, supporting many --- efficient operations. --- --- A 'ByteString' contains 8-bit bytes, or by using the operations from --- "Data.ByteString.Char8" it can be interpreted as containing 8-bit --- characters. --- -data ByteString = BS {-# UNPACK #-} !(ForeignPtr Word8) -- payload - {-# UNPACK #-} !Int -- length - -- ^ @since 0.11.0.0 - deriving (Typeable) - --- | Type synonym for the strict flavour of 'ByteString'. --- --- @since 0.11.2.0 -type StrictByteString = ByteString - --- | --- @'PS' foreignPtr offset length@ represents a 'ByteString' with data --- backed by a given @foreignPtr@, starting at a given @offset@ in bytes --- and of a specified @length@. --- --- This pattern is used to emulate the legacy 'ByteString' data --- constructor, so that pre-existing code generally doesn't need to --- change to benefit from the simplified 'BS' constructor and can --- continue to function unchanged. --- --- /Note:/ Matching with this constructor will always be given a 0 offset, --- as the base will be manipulated by 'plusForeignPtr' instead. --- -pattern PS :: ForeignPtr Word8 -> Int -> Int -> ByteString -pattern PS fp zero len <- BS fp ((0,) -> (zero, len)) where - PS fp o len = BS (plusForeignPtr fp o) len -#if __GLASGOW_HASKELL__ >= 802 -{-# COMPLETE PS #-} -#endif - -instance Eq ByteString where - (==) = eq - -instance Ord ByteString where - compare = compareBytes - -instance Semigroup ByteString where - (<>) = append - sconcat (b:|bs) = concat (b:bs) - stimes = times - -instance Monoid ByteString where - mempty = empty - mappend = (<>) - mconcat = concat - -instance NFData ByteString where - rnf BS{} = () - -instance Show ByteString where - showsPrec p ps r = showsPrec p (unpackChars ps) r - -instance Read ByteString where - readsPrec p str = [ (packChars x, y) | (x, y) <- readsPrec p str ] - --- | @since 0.10.12.0 -instance IsList ByteString where - type Item ByteString = Word8 - fromList = packBytes - toList = unpackBytes - --- | Beware: 'fromString' truncates multi-byte characters to octets. --- e.g. "枯朶に烏のとまりけり秋の暮" becomes �6k�nh~�Q��n� -instance IsString ByteString where - {-# INLINE fromString #-} - fromString = packChars - -instance Data ByteString where - gfoldl f z txt = z packBytes `f` unpackBytes txt - toConstr _ = error "Data.ByteString.ByteString.toConstr" - gunfold _ _ = error "Data.ByteString.ByteString.gunfold" - dataTypeOf _ = mkNoRepType "Data.ByteString.ByteString" - --- | @since 0.11.2.0 -instance TH.Lift ByteString where -#if MIN_VERSION_template_haskell(2,16,0) - lift (BS ptr len) = [| unsafePackLenLiteral |] - `TH.appE` TH.litE (TH.integerL (fromIntegral len)) - `TH.appE` TH.litE (TH.BytesPrimL $ TH.Bytes ptr 0 (fromIntegral len)) -#else - lift bs@(BS _ len) = [| unsafePackLenLiteral |] - `TH.appE` TH.litE (TH.integerL (fromIntegral len)) - `TH.appE` TH.litE (TH.StringPrimL $ unpackBytes bs) -#endif - -#if MIN_VERSION_template_haskell(2,17,0) - liftTyped = TH.unsafeCodeCoerce . TH.lift -#elif MIN_VERSION_template_haskell(2,16,0) - liftTyped = TH.unsafeTExpCoerce . TH.lift -#endif - ------------------------------------------------------------------------- --- Internal indexing - --- | 'findIndexOrLength' is a variant of findIndex, that returns the length --- of the string if no element is found, rather than Nothing. -findIndexOrLength :: (Word8 -> Bool) -> ByteString -> Int -findIndexOrLength k (BS x l) = - accursedUnutterablePerformIO $ unsafeWithForeignPtr x g - where - g ptr = go 0 - where - go !n | n >= l = return l - | otherwise = do w <- peek $ ptr `plusPtr` n - if k w - then return n - else go (n+1) -{-# INLINE findIndexOrLength #-} - ------------------------------------------------------------------------- --- Packing and unpacking from lists - -packBytes :: [Word8] -> ByteString -packBytes ws = unsafePackLenBytes (List.length ws) ws - -packChars :: [Char] -> ByteString -packChars cs = unsafePackLenChars (List.length cs) cs - -{-# INLINE [0] packChars #-} - -{-# RULES -"ByteString packChars/packAddress" forall s . - packChars (unpackCString# s) = unsafePackLiteral s - #-} - -unsafePackLenBytes :: Int -> [Word8] -> ByteString -unsafePackLenBytes len xs0 = - unsafeCreate len $ \p -> go p xs0 - where - go !_ [] = return () - go !p (x:xs) = poke p x >> go (p `plusPtr` 1) xs - -unsafePackLenChars :: Int -> [Char] -> ByteString -unsafePackLenChars len cs0 = - unsafeCreate len $ \p -> go p cs0 - where - go !_ [] = return () - go !p (c:cs) = poke p (c2w c) >> go (p `plusPtr` 1) cs - - --- | /O(n)/ Pack a null-terminated sequence of bytes, pointed to by an --- Addr\# (an arbitrary machine address assumed to point outside the --- garbage-collected heap) into a @ByteString@. A much faster way to --- create an 'Addr#' is with an unboxed string literal, than to pack a --- boxed string. A unboxed string literal is compiled to a static @char --- []@ by GHC. Establishing the length of the string requires a call to --- @strlen(3)@, so the 'Addr#' must point to a null-terminated buffer (as --- is the case with @\"string\"\#@ literals in GHC). Use 'Data.ByteString.Unsafe.unsafePackAddressLen' --- if you know the length of the string statically. --- --- An example: --- --- > literalFS = unsafePackAddress "literal"# --- --- This function is /unsafe/. If you modify the buffer pointed to by the --- original 'Addr#' this modification will be reflected in the resulting --- @ByteString@, breaking referential transparency. --- --- Note this also won't work if your 'Addr#' has embedded @\'\\0\'@ characters in --- the string, as @strlen@ will return too short a length. --- -unsafePackAddress :: Addr# -> IO ByteString -unsafePackAddress addr# = do -#if __GLASGOW_HASKELL__ >= 811 - unsafePackLenAddress (I# (cstringLength# addr#)) addr# -#else - l <- c_strlen (Ptr addr#) - unsafePackLenAddress (fromIntegral l) addr# -#endif -{-# INLINE unsafePackAddress #-} - --- | See 'unsafePackAddress'. This function is similar, --- but takes an additional length argument rather then computing --- it with @strlen@. --- Therefore embedding @\'\\0\'@ characters is possible. --- --- @since 0.11.2.0 -unsafePackLenAddress :: Int -> Addr# -> IO ByteString -unsafePackLenAddress len addr# = do -#if __GLASGOW_HASKELL__ >= 811 - return (BS (ForeignPtr addr# FinalPtr) len) -#else - p <- newForeignPtr_ (Ptr addr#) - return $ BS p len -#endif -{-# INLINE unsafePackLenAddress #-} - --- | See 'unsafePackAddress'. This function has similar behavior. Prefer --- this function when the address in known to be an @Addr#@ literal. In --- that context, there is no need for the sequencing guarantees that 'IO' --- provides. On GHC 9.0 and up, this function uses the @FinalPtr@ data --- constructor for @ForeignPtrContents@. --- --- @since 0.11.1.0 -unsafePackLiteral :: Addr# -> ByteString -unsafePackLiteral addr# = -#if __GLASGOW_HASKELL__ >= 811 - unsafePackLenLiteral (I# (cstringLength# addr#)) addr# -#else - let len = accursedUnutterablePerformIO (c_strlen (Ptr addr#)) - in unsafePackLenLiteral (fromIntegral len) addr# -#endif -{-# INLINE unsafePackLiteral #-} - - --- | See 'unsafePackLiteral'. This function is similar, --- but takes an additional length argument rather then computing --- it with @strlen@. --- Therefore embedding @\'\\0\'@ characters is possible. --- --- @since 0.11.2.0 -unsafePackLenLiteral :: Int -> Addr# -> ByteString -unsafePackLenLiteral len addr# = -#if __GLASGOW_HASKELL__ >= 811 - BS (ForeignPtr addr# FinalPtr) len -#else - BS (accursedUnutterablePerformIO (newForeignPtr_ (Ptr addr#))) len -#endif -{-# INLINE unsafePackLenLiteral #-} - -packUptoLenBytes :: Int -> [Word8] -> (ByteString, [Word8]) -packUptoLenBytes len xs0 = - unsafeCreateUptoN' len $ \p0 -> - let p_end = plusPtr p0 len - go !p [] = return (p `minusPtr` p0, []) - go !p xs | p == p_end = return (len, xs) - go !p (x:xs) = poke p x >> go (p `plusPtr` 1) xs - in go p0 xs0 - -packUptoLenChars :: Int -> [Char] -> (ByteString, [Char]) -packUptoLenChars len cs0 = - unsafeCreateUptoN' len $ \p0 -> - let p_end = plusPtr p0 len - go !p [] = return (p `minusPtr` p0, []) - go !p cs | p == p_end = return (len, cs) - go !p (c:cs) = poke p (c2w c) >> go (p `plusPtr` 1) cs - in go p0 cs0 - --- Unpacking bytestrings into lists efficiently is a tradeoff: on the one hand --- we would like to write a tight loop that just blasts the list into memory, on --- the other hand we want it to be unpacked lazily so we don't end up with a --- massive list data structure in memory. --- --- Our strategy is to combine both: we will unpack lazily in reasonable sized --- chunks, where each chunk is unpacked strictly. --- --- unpackBytes and unpackChars do the lazy loop, while unpackAppendBytes and --- unpackAppendChars do the chunks strictly. - -unpackBytes :: ByteString -> [Word8] -unpackBytes bs = unpackAppendBytesLazy bs [] - -unpackChars :: ByteString -> [Char] -unpackChars bs = unpackAppendCharsLazy bs [] - -unpackAppendBytesLazy :: ByteString -> [Word8] -> [Word8] -unpackAppendBytesLazy (BS fp len) xs - | len <= 100 = unpackAppendBytesStrict (BS fp len) xs - | otherwise = unpackAppendBytesStrict (BS fp 100) remainder - where - remainder = unpackAppendBytesLazy (BS (plusForeignPtr fp 100) (len-100)) xs - - -- Why 100 bytes you ask? Because on a 64bit machine the list we allocate - -- takes just shy of 4k which seems like a reasonable amount. - -- (5 words per list element, 8 bytes per word, 100 elements = 4000 bytes) - -unpackAppendCharsLazy :: ByteString -> [Char] -> [Char] -unpackAppendCharsLazy (BS fp len) cs - | len <= 100 = unpackAppendCharsStrict (BS fp len) cs - | otherwise = unpackAppendCharsStrict (BS fp 100) remainder - where - remainder = unpackAppendCharsLazy (BS (plusForeignPtr fp 100) (len-100)) cs - --- For these unpack functions, since we're unpacking the whole list strictly we --- build up the result list in an accumulator. This means we have to build up --- the list starting at the end. So our traversal starts at the end of the --- buffer and loops down until we hit the sentinal: - -unpackAppendBytesStrict :: ByteString -> [Word8] -> [Word8] -unpackAppendBytesStrict (BS fp len) xs = - accursedUnutterablePerformIO $ unsafeWithForeignPtr fp $ \base -> - loop (base `plusPtr` (-1)) (base `plusPtr` (-1+len)) xs - where - loop !sentinal !p acc - | p == sentinal = return acc - | otherwise = do x <- peek p - loop sentinal (p `plusPtr` (-1)) (x:acc) - -unpackAppendCharsStrict :: ByteString -> [Char] -> [Char] -unpackAppendCharsStrict (BS fp len) xs = - accursedUnutterablePerformIO $ unsafeWithForeignPtr fp $ \base -> - loop (base `plusPtr` (-1)) (base `plusPtr` (-1+len)) xs - where - loop !sentinal !p acc - | p == sentinal = return acc - | otherwise = do x <- peek p - loop sentinal (p `plusPtr` (-1)) (w2c x:acc) - ------------------------------------------------------------------------- - --- | The 0 pointer. Used to indicate the empty Bytestring. -nullForeignPtr :: ForeignPtr Word8 -#if __GLASGOW_HASKELL__ >= 811 -nullForeignPtr = ForeignPtr nullAddr# FinalPtr -#else -nullForeignPtr = ForeignPtr nullAddr# (error "nullForeignPtr") -#endif - --- --------------------------------------------------------------------- --- Low level constructors - --- | /O(1)/ Build a ByteString from a ForeignPtr. --- --- If you do not need the offset parameter then you should be using --- 'Data.ByteString.Unsafe.unsafePackCStringLen' or --- 'Data.ByteString.Unsafe.unsafePackCStringFinalizer' instead. --- -fromForeignPtr :: ForeignPtr Word8 - -> Int -- ^ Offset - -> Int -- ^ Length - -> ByteString -fromForeignPtr fp o = BS (plusForeignPtr fp o) -{-# INLINE fromForeignPtr #-} - --- | @since 0.11.0.0 -fromForeignPtr0 :: ForeignPtr Word8 - -> Int -- ^ Length - -> ByteString -fromForeignPtr0 = BS -{-# INLINE fromForeignPtr0 #-} - --- | /O(1)/ Deconstruct a ForeignPtr from a ByteString -toForeignPtr :: ByteString -> (ForeignPtr Word8, Int, Int) -- ^ (ptr, offset, length) -toForeignPtr (BS ps l) = (ps, 0, l) -{-# INLINE toForeignPtr #-} - --- | /O(1)/ Deconstruct a ForeignPtr from a ByteString --- --- @since 0.11.0.0 -toForeignPtr0 :: ByteString -> (ForeignPtr Word8, Int) -- ^ (ptr, length) -toForeignPtr0 (BS ps l) = (ps, l) -{-# INLINE toForeignPtr0 #-} - --- | A way of creating ByteStrings outside the IO monad. The @Int@ --- argument gives the final size of the ByteString. -unsafeCreate :: Int -> (Ptr Word8 -> IO ()) -> ByteString -unsafeCreate l f = unsafeDupablePerformIO (create l f) -{-# INLINE unsafeCreate #-} - --- | Like 'unsafeCreate' but instead of giving the final size of the --- ByteString, it is just an upper bound. The inner action returns --- the actual size. Unlike 'createAndTrim' the ByteString is not --- reallocated if the final size is less than the estimated size. -unsafeCreateUptoN :: Int -> (Ptr Word8 -> IO Int) -> ByteString -unsafeCreateUptoN l f = unsafeDupablePerformIO (createUptoN l f) -{-# INLINE unsafeCreateUptoN #-} - --- | @since 0.10.12.0 -unsafeCreateUptoN' :: Int -> (Ptr Word8 -> IO (Int, a)) -> (ByteString, a) -unsafeCreateUptoN' l f = unsafeDupablePerformIO (createUptoN' l f) -{-# INLINE unsafeCreateUptoN' #-} - --- | Create ByteString of size @l@ and use action @f@ to fill its contents. -create :: Int -> (Ptr Word8 -> IO ()) -> IO ByteString -create l action = do - fp <- mallocByteString l - -- Cannot use unsafeWithForeignPtr, because action can diverge - withForeignPtr fp $ \p -> action p - return $! BS fp l -{-# INLINE create #-} - --- | Given a maximum size @l@ and an action @f@ that fills the 'ByteString' --- starting at the given 'Ptr' and returns the actual utilized length, --- @`createUptoN'` l f@ returns the filled 'ByteString'. -createUptoN :: Int -> (Ptr Word8 -> IO Int) -> IO ByteString -createUptoN l action = do - fp <- mallocByteString l - -- Cannot use unsafeWithForeignPtr, because action can diverge - l' <- withForeignPtr fp $ \p -> action p - assert (l' <= l) $ return $! BS fp l' -{-# INLINE createUptoN #-} - --- | Like 'createUptoN', but also returns an additional value created by the --- action. --- --- @since 0.10.12.0 -createUptoN' :: Int -> (Ptr Word8 -> IO (Int, a)) -> IO (ByteString, a) -createUptoN' l action = do - fp <- mallocByteString l - -- Cannot use unsafeWithForeignPtr, because action can diverge - (l', res) <- withForeignPtr fp $ \p -> action p - assert (l' <= l) $ return (BS fp l', res) -{-# INLINE createUptoN' #-} - --- | Given the maximum size needed and a function to make the contents --- of a ByteString, createAndTrim makes the 'ByteString'. The generating --- function is required to return the actual final size (<= the maximum --- size), and the resulting byte array is reallocated to this size. --- --- createAndTrim is the main mechanism for creating custom, efficient --- ByteString functions, using Haskell or C functions to fill the space. --- -createAndTrim :: Int -> (Ptr Word8 -> IO Int) -> IO ByteString -createAndTrim l action = do - fp <- mallocByteString l - -- Cannot use unsafeWithForeignPtr, because action can diverge - withForeignPtr fp $ \p -> do - l' <- action p - if assert (l' <= l) $ l' >= l - then return $! BS fp l - else create l' $ \p' -> memcpy p' p l' -{-# INLINE createAndTrim #-} - -createAndTrim' :: Int -> (Ptr Word8 -> IO (Int, Int, a)) -> IO (ByteString, a) -createAndTrim' l action = do - fp <- mallocByteString l - -- Cannot use unsafeWithForeignPtr, because action can diverge - withForeignPtr fp $ \p -> do - (off, l', res) <- action p - if assert (l' <= l) $ l' >= l - then return (BS fp l, res) - else do ps <- create l' $ \p' -> - memcpy p' (p `plusPtr` off) l' - return (ps, res) -{-# INLINE createAndTrim' #-} - --- | Wrapper of 'Foreign.ForeignPtr.mallocForeignPtrBytes' with faster implementation for GHC --- -mallocByteString :: Int -> IO (ForeignPtr a) -mallocByteString = mallocPlainForeignPtrBytes -{-# INLINE mallocByteString #-} - ------------------------------------------------------------------------- --- Implementations for Eq, Ord and Monoid instances - -eq :: ByteString -> ByteString -> Bool -eq a@(BS fp len) b@(BS fp' len') - | len /= len' = False -- short cut on length - | fp == fp' = True -- short cut for the same string - | otherwise = compareBytes a b == EQ -{-# INLINE eq #-} --- ^ still needed - -compareBytes :: ByteString -> ByteString -> Ordering -compareBytes (BS _ 0) (BS _ 0) = EQ -- short cut for empty strings -compareBytes (BS fp1 len1) (BS fp2 len2) = - accursedUnutterablePerformIO $ - unsafeWithForeignPtr fp1 $ \p1 -> - unsafeWithForeignPtr fp2 $ \p2 -> do - i <- memcmp p1 p2 (min len1 len2) - return $! case i `compare` 0 of - EQ -> len1 `compare` len2 - x -> x - - --- | /O(1)/ The empty 'ByteString' -empty :: ByteString --- This enables bypassing #457 by not using (polymorphic) mempty in --- any definitions used by the (Monoid ByteString) instance -empty = BS nullForeignPtr 0 - -append :: ByteString -> ByteString -> ByteString -append (BS _ 0) b = b -append a (BS _ 0) = a -append (BS fp1 len1) (BS fp2 len2) = - unsafeCreate (len1+len2) $ \destptr1 -> do - let destptr2 = destptr1 `plusPtr` len1 - unsafeWithForeignPtr fp1 $ \p1 -> memcpy destptr1 p1 len1 - unsafeWithForeignPtr fp2 $ \p2 -> memcpy destptr2 p2 len2 - -concat :: [ByteString] -> ByteString -concat = \bss0 -> goLen0 bss0 bss0 - -- The idea here is we first do a pass over the input list to determine: - -- - -- 1. is a copy necessary? e.g. @concat []@, @concat [mempty, "hello"]@, - -- and @concat ["hello", mempty, mempty]@ can all be handled without - -- copying. - -- 2. if a copy is necessary, how large is the result going to be? - -- - -- If a copy is necessary then we create a buffer of the appropriate size - -- and do another pass over the input list, copying the chunks into the - -- buffer. Also, since foreign calls aren't entirely free we skip over - -- empty chunks while copying. - -- - -- We pass the original [ByteString] (bss0) through as an argument through - -- goLen0, goLen1, and goLen since we will need it again in goCopy. Passing - -- it as an explicit argument avoids capturing it in these functions' - -- closures which would result in unnecessary closure allocation. - where - -- It's still possible that the result is empty - goLen0 _ [] = empty - goLen0 bss0 (BS _ 0 :bss) = goLen0 bss0 bss - goLen0 bss0 (bs :bss) = goLen1 bss0 bs bss - - -- It's still possible that the result is a single chunk - goLen1 _ bs [] = bs - goLen1 bss0 bs (BS _ 0 :bss) = goLen1 bss0 bs bss - goLen1 bss0 bs (BS _ len:bss) = goLen bss0 (checkedAdd "concat" len' len) bss - where BS _ len' = bs - - -- General case, just find the total length we'll need - goLen bss0 !total (BS _ len:bss) = goLen bss0 total' bss - where total' = checkedAdd "concat" total len - goLen bss0 total [] = - unsafeCreate total $ \ptr -> goCopy bss0 ptr - - -- Copy the data - goCopy [] !_ = return () - goCopy (BS _ 0 :bss) !ptr = goCopy bss ptr - goCopy (BS fp len:bss) !ptr = do - unsafeWithForeignPtr fp $ \p -> memcpy ptr p len - goCopy bss (ptr `plusPtr` len) -{-# NOINLINE concat #-} - -{-# RULES -"ByteString concat [] -> empty" - concat [] = empty -"ByteString concat [bs] -> bs" forall x. - concat [x] = x - #-} - --- | /O(log n)/ Repeats the given ByteString n times. -times :: Integral a => a -> ByteString -> ByteString -times n (BS fp len) - | n < 0 = error "stimes: non-negative multiplier expected" - | n == 0 = empty - | n == 1 = BS fp len - | len == 0 = empty - | len == 1 = unsafeCreate size $ \destptr -> - unsafeWithForeignPtr fp $ \p -> do - byte <- peek p - void $ memset destptr byte (fromIntegral size) - | otherwise = unsafeCreate size $ \destptr -> - unsafeWithForeignPtr fp $ \p -> do - memcpy destptr p len - fillFrom destptr len - where - size = len * fromIntegral n - - fillFrom :: Ptr Word8 -> Int -> IO () - fillFrom destptr copied - | 2 * copied < size = do - memcpy (destptr `plusPtr` copied) destptr copied - fillFrom destptr (copied * 2) - | otherwise = memcpy (destptr `plusPtr` copied) destptr (size - copied) - --- | Add two non-negative numbers. Errors out on overflow. -checkedAdd :: String -> Int -> Int -> Int -checkedAdd fun x y - | r >= 0 = r - | otherwise = overflowError fun - where r = x + y -{-# INLINE checkedAdd #-} - ------------------------------------------------------------------------- - --- | Conversion between 'Word8' and 'Char'. Should compile to a no-op. -w2c :: Word8 -> Char -w2c = unsafeChr . fromIntegral -{-# INLINE w2c #-} - --- | Unsafe conversion between 'Char' and 'Word8'. This is a no-op and --- silently truncates to 8 bits Chars > '\255'. It is provided as --- convenience for ByteString construction. -c2w :: Char -> Word8 -c2w = fromIntegral . ord -{-# INLINE c2w #-} - --- | Selects words corresponding to white-space characters in the Latin-1 range -isSpaceWord8 :: Word8 -> Bool -isSpaceWord8 w8 = - -- Avoid the cost of narrowing arithmetic results to Word8, - -- the conversion from Word8 to Word is free. - let w :: Word - !w = fromIntegral w8 - in w .&. 0x50 == 0 -- Quick non-whitespace filter - && w - 0x21 > 0x7e -- Second non-whitespace filter - && ( w == 0x20 -- SP - || w == 0xa0 -- NBSP - || w - 0x09 < 5) -- HT, NL, VT, FF, CR -{-# INLINE isSpaceWord8 #-} - --- | Selects white-space characters in the Latin-1 range -isSpaceChar8 :: Char -> Bool -isSpaceChar8 = isSpaceWord8 . c2w -{-# INLINE isSpaceChar8 #-} - -overflowError :: String -> a -overflowError fun = error $ "Data.ByteString." ++ fun ++ ": size overflow" - ------------------------------------------------------------------------- - --- | This \"function\" has a superficial similarity to 'System.IO.Unsafe.unsafePerformIO' but --- it is in fact a malevolent agent of chaos. It unpicks the seams of reality --- (and the 'IO' monad) so that the normal rules no longer apply. It lulls you --- into thinking it is reasonable, but when you are not looking it stabs you --- in the back and aliases all of your mutable buffers. The carcass of many a --- seasoned Haskell programmer lie strewn at its feet. --- --- Witness the trail of destruction: --- --- * --- --- * --- --- * --- --- * --- --- * --- --- Do not talk about \"safe\"! You do not know what is safe! --- --- Yield not to its blasphemous call! Flee traveller! Flee or you will be --- corrupted and devoured! --- -{-# INLINE accursedUnutterablePerformIO #-} -accursedUnutterablePerformIO :: IO a -> a -accursedUnutterablePerformIO (IO m) = case m realWorld# of (# _, r #) -> r - --- --------------------------------------------------------------------- --- --- Standard C functions --- - -foreign import ccall unsafe "string.h strlen" c_strlen - :: CString -> IO CSize - -foreign import ccall unsafe "static stdlib.h &free" c_free_finalizer - :: FunPtr (Ptr Word8 -> IO ()) - -foreign import ccall unsafe "string.h memchr" c_memchr - :: Ptr Word8 -> CInt -> CSize -> IO (Ptr Word8) - -memchr :: Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8) -memchr p w = c_memchr p (fromIntegral w) - -foreign import ccall unsafe "string.h memcmp" c_memcmp - :: Ptr Word8 -> Ptr Word8 -> CSize -> IO CInt - -memcmp :: Ptr Word8 -> Ptr Word8 -> Int -> IO CInt -memcmp p q s = c_memcmp p q (fromIntegral s) - -foreign import ccall unsafe "string.h memcpy" c_memcpy - :: Ptr Word8 -> Ptr Word8 -> CSize -> IO (Ptr Word8) - -memcpy :: Ptr Word8 -> Ptr Word8 -> Int -> IO () -memcpy p q s = void $ c_memcpy p q (fromIntegral s) - -{- -foreign import ccall unsafe "string.h memmove" c_memmove - :: Ptr Word8 -> Ptr Word8 -> CSize -> IO (Ptr Word8) - -memmove :: Ptr Word8 -> Ptr Word8 -> CSize -> IO () -memmove p q s = do c_memmove p q s - return () --} - -foreign import ccall unsafe "string.h memset" c_memset - :: Ptr Word8 -> CInt -> CSize -> IO (Ptr Word8) - -memset :: Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8) -memset p w = c_memset p (fromIntegral w) - --- --------------------------------------------------------------------- --- --- Uses our C code --- - -foreign import ccall unsafe "static fpstring.h fps_reverse" c_reverse - :: Ptr Word8 -> Ptr Word8 -> CSize -> IO () - -foreign import ccall unsafe "static fpstring.h fps_intersperse" c_intersperse - :: Ptr Word8 -> Ptr Word8 -> CSize -> Word8 -> IO () - -foreign import ccall unsafe "static fpstring.h fps_maximum" c_maximum - :: Ptr Word8 -> CSize -> IO Word8 - -foreign import ccall unsafe "static fpstring.h fps_minimum" c_minimum - :: Ptr Word8 -> CSize -> IO Word8 - -foreign import ccall unsafe "static fpstring.h fps_count" c_count - :: Ptr Word8 -> CSize -> Word8 -> IO CSize - -foreign import ccall unsafe "static fpstring.h fps_sort" c_sort - :: Ptr Word8 -> CSize -> IO () +import Data.ByteString.Internal.Type diff --git a/Data/ByteString/Internal/Type.hs b/Data/ByteString/Internal/Type.hs new file mode 100644 --- /dev/null +++ b/Data/ByteString/Internal/Type.hs @@ -0,0 +1,973 @@ +{-# LANGUAGE CPP, ForeignFunctionInterface, BangPatterns #-} +{-# LANGUAGE UnliftedFFITypes, MagicHash, + UnboxedTuples, DeriveDataTypeable #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE PatternSynonyms, ViewPatterns #-} +{-# LANGUAGE Unsafe #-} +{-# LANGUAGE TemplateHaskellQuotes #-} +{-# OPTIONS_HADDOCK not-home #-} + +-- | +-- Module : Data.ByteString.Internal.Type +-- Copyright : (c) Don Stewart 2006-2008 +-- (c) Duncan Coutts 2006-2012 +-- License : BSD-style +-- Maintainer : dons00@gmail.com, duncan@community.haskell.org +-- Stability : unstable +-- Portability : non-portable +-- +-- The 'ByteString' type, its instances, and whatever related +-- utilities the bytestring developers see fit to use internally. +-- +module Data.ByteString.Internal.Type ( + + -- * The @ByteString@ type and representation + ByteString + ( BS + , PS -- backwards compatibility shim + ), + + StrictByteString, + + -- * Internal indexing + findIndexOrLength, + + -- * Conversion with lists: packing and unpacking + packBytes, packUptoLenBytes, unsafePackLenBytes, + packChars, packUptoLenChars, unsafePackLenChars, + unpackBytes, unpackAppendBytesLazy, unpackAppendBytesStrict, + unpackChars, unpackAppendCharsLazy, unpackAppendCharsStrict, + unsafePackAddress, unsafePackLenAddress, + unsafePackLiteral, unsafePackLenLiteral, + + -- * Low level imperative construction + empty, + createFp, + createFpUptoN, + createFpUptoN', + createFpAndTrim, + createFpAndTrim', + unsafeCreateFp, + unsafeCreateFpUptoN, + unsafeCreateFpUptoN', + create, + createUptoN, + createUptoN', + createAndTrim, + createAndTrim', + unsafeCreate, + unsafeCreateUptoN, + unsafeCreateUptoN', + mallocByteString, + + -- * Conversion to and from ForeignPtrs + fromForeignPtr, + toForeignPtr, + fromForeignPtr0, + toForeignPtr0, + + -- * Utilities + nullForeignPtr, + peekFp, + pokeFp, + peekFpByteOff, + pokeFpByteOff, + minusForeignPtr, + memcpyFp, + checkedAdd, + + -- * Standard C Functions + c_strlen, + c_free_finalizer, + + memchr, + memcmp, + memcpy, + memset, + + -- * cbits functions + c_reverse, + c_intersperse, + c_maximum, + c_minimum, + c_count, + c_sort, + + -- * Chars + w2c, c2w, isSpaceWord8, isSpaceChar8, + + -- * Deprecated and unmentionable + accursedUnutterablePerformIO, + + -- * Exported compatibility shim + plusForeignPtr, + unsafeWithForeignPtr + ) where + +import Prelude hiding (concat, null) +import qualified Data.List as List + +import Control.Monad (void) + +import Foreign.ForeignPtr (ForeignPtr, withForeignPtr) +import Foreign.Ptr (Ptr, FunPtr, plusPtr) +import Foreign.Storable (Storable(..)) +import Foreign.C.Types (CInt(..), CSize(..)) +import Foreign.C.String (CString) + +#if MIN_VERSION_base(4,13,0) +import Data.Semigroup (Semigroup (sconcat, stimes)) +#else +import Data.Semigroup (Semigroup ((<>), sconcat, stimes)) +#endif +import Data.List.NonEmpty (NonEmpty ((:|))) + +import Control.DeepSeq (NFData(rnf)) + +import Data.String (IsString(..)) + +import Control.Exception (assert) + +import Data.Bits ((.&.)) +import Data.Char (ord) +import Data.Word + +import Data.Typeable (Typeable) +import Data.Data (Data(..), mkNoRepType) + +import GHC.Base (nullAddr#,realWorld#,unsafeChr) +import GHC.Exts (IsList(..)) +import GHC.CString (unpackCString#) +import GHC.Exts (Addr#, minusAddr#) + +import GHC.IO (IO(IO),unsafeDupablePerformIO) +import GHC.ForeignPtr (ForeignPtr(ForeignPtr) +#if __GLASGOW_HASKELL__ < 900 + , newForeignPtr_ +#endif + , mallocPlainForeignPtrBytes) + +#if MIN_VERSION_base(4,10,0) +import GHC.ForeignPtr (plusForeignPtr) +#else +import GHC.Prim (plusAddr#) +#endif + +#if __GLASGOW_HASKELL__ >= 811 +import GHC.CString (cstringLength#) +import GHC.ForeignPtr (ForeignPtrContents(FinalPtr)) +#else +import GHC.Ptr (Ptr(..)) +#endif + +import GHC.Types (Int (..)) + +#if MIN_VERSION_base(4,15,0) +import GHC.ForeignPtr (unsafeWithForeignPtr) +#endif + +import qualified Language.Haskell.TH.Lib as TH +import qualified Language.Haskell.TH.Syntax as TH + +#if !MIN_VERSION_base(4,15,0) +unsafeWithForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b +unsafeWithForeignPtr = withForeignPtr +#endif + +-- CFILES stuff is Hugs only +{-# CFILES cbits/fpstring.c #-} + +#if !MIN_VERSION_base(4,10,0) +-- |Advances the given address by the given offset in bytes. +-- +-- The new 'ForeignPtr' shares the finalizer of the original, +-- equivalent from a finalization standpoint to just creating another +-- reference to the original. That is, the finalizer will not be +-- called before the new 'ForeignPtr' is unreachable, nor will it be +-- called an additional time due to this call, and the finalizer will +-- be called with the same address that it would have had this call +-- not happened, *not* the new address. +plusForeignPtr :: ForeignPtr a -> Int -> ForeignPtr b +plusForeignPtr (ForeignPtr addr guts) (I# offset) = ForeignPtr (plusAddr# addr offset) guts +{-# INLINE [0] plusForeignPtr #-} +{-# RULES +"ByteString plusForeignPtr/0" forall fp . + plusForeignPtr fp 0 = fp + #-} +#endif + +minusForeignPtr :: ForeignPtr a -> ForeignPtr b -> Int +minusForeignPtr (ForeignPtr addr1 _) (ForeignPtr addr2 _) + = I# (minusAddr# addr1 addr2) + +peekFp :: Storable a => ForeignPtr a -> IO a +peekFp fp = unsafeWithForeignPtr fp peek + +pokeFp :: Storable a => ForeignPtr a -> a -> IO () +pokeFp fp val = unsafeWithForeignPtr fp $ \p -> poke p val + +peekFpByteOff :: Storable a => ForeignPtr a -> Int -> IO a +peekFpByteOff fp off = unsafeWithForeignPtr fp $ \p -> + peekByteOff p off + +pokeFpByteOff :: Storable a => ForeignPtr b -> Int -> a -> IO () +pokeFpByteOff fp off val = unsafeWithForeignPtr fp $ \p -> + pokeByteOff p off val + +-- ----------------------------------------------------------------------------- + +-- | A space-efficient representation of a 'Word8' vector, supporting many +-- efficient operations. +-- +-- A 'ByteString' contains 8-bit bytes, or by using the operations from +-- "Data.ByteString.Char8" it can be interpreted as containing 8-bit +-- characters. +-- +data ByteString = BS {-# UNPACK #-} !(ForeignPtr Word8) -- payload + {-# UNPACK #-} !Int -- length + -- ^ @since 0.11.0.0 + deriving (Typeable) + +-- | Type synonym for the strict flavour of 'ByteString'. +-- +-- @since 0.11.2.0 +type StrictByteString = ByteString + +-- | +-- @'PS' foreignPtr offset length@ represents a 'ByteString' with data +-- backed by a given @foreignPtr@, starting at a given @offset@ in bytes +-- and of a specified @length@. +-- +-- This pattern is used to emulate the legacy 'ByteString' data +-- constructor, so that pre-existing code generally doesn't need to +-- change to benefit from the simplified 'BS' constructor and can +-- continue to function unchanged. +-- +-- /Note:/ Matching with this constructor will always be given a 0 offset, +-- as the base will be manipulated by 'plusForeignPtr' instead. +-- +pattern PS :: ForeignPtr Word8 -> Int -> Int -> ByteString +pattern PS fp zero len <- BS fp ((0,) -> (zero, len)) where + PS fp o len = BS (plusForeignPtr fp o) len +#if __GLASGOW_HASKELL__ >= 802 +{-# COMPLETE PS #-} +#endif + +instance Eq ByteString where + (==) = eq + +instance Ord ByteString where + compare = compareBytes + +instance Semigroup ByteString where + (<>) = append + sconcat (b:|bs) = concat (b:bs) + stimes = times + +instance Monoid ByteString where + mempty = empty + mappend = (<>) + mconcat = concat + +instance NFData ByteString where + rnf BS{} = () + +instance Show ByteString where + showsPrec p ps r = showsPrec p (unpackChars ps) r + +instance Read ByteString where + readsPrec p str = [ (packChars x, y) | (x, y) <- readsPrec p str ] + +-- | @since 0.10.12.0 +instance IsList ByteString where + type Item ByteString = Word8 + fromList = packBytes + toList = unpackBytes + +-- | Beware: 'fromString' truncates multi-byte characters to octets. +-- e.g. "枯朶に烏のとまりけり秋の暮" becomes �6k�nh~�Q��n� +instance IsString ByteString where + {-# INLINE fromString #-} + fromString = packChars + +instance Data ByteString where + gfoldl f z txt = z packBytes `f` unpackBytes txt + toConstr _ = error "Data.ByteString.ByteString.toConstr" + gunfold _ _ = error "Data.ByteString.ByteString.gunfold" + dataTypeOf _ = mkNoRepType "Data.ByteString.ByteString" + +-- | @since 0.11.2.0 +instance TH.Lift ByteString where +#if MIN_VERSION_template_haskell(2,16,0) + lift (BS ptr len) = [| unsafePackLenLiteral |] + `TH.appE` TH.litE (TH.integerL (fromIntegral len)) + `TH.appE` TH.litE (TH.BytesPrimL $ TH.Bytes ptr 0 (fromIntegral len)) +#else + lift bs@(BS _ len) = [| unsafePackLenLiteral |] + `TH.appE` TH.litE (TH.integerL (fromIntegral len)) + `TH.appE` TH.litE (TH.StringPrimL $ unpackBytes bs) +#endif + +#if MIN_VERSION_template_haskell(2,17,0) + liftTyped = TH.unsafeCodeCoerce . TH.lift +#elif MIN_VERSION_template_haskell(2,16,0) + liftTyped = TH.unsafeTExpCoerce . TH.lift +#endif + +------------------------------------------------------------------------ +-- Internal indexing + +-- | 'findIndexOrLength' is a variant of findIndex, that returns the length +-- of the string if no element is found, rather than Nothing. +findIndexOrLength :: (Word8 -> Bool) -> ByteString -> Int +findIndexOrLength k (BS x l) = + accursedUnutterablePerformIO $ g x + where + g ptr = go 0 + where + go !n | n >= l = return l + | otherwise = do w <- peekFp $ ptr `plusForeignPtr` n + if k w + then return n + else go (n+1) +{-# INLINE findIndexOrLength #-} + +------------------------------------------------------------------------ +-- Packing and unpacking from lists + +packBytes :: [Word8] -> ByteString +packBytes ws = unsafePackLenBytes (List.length ws) ws + +packChars :: [Char] -> ByteString +packChars cs = unsafePackLenChars (List.length cs) cs + +{-# INLINE [0] packChars #-} + +{-# RULES +"ByteString packChars/packAddress" forall s . + packChars (unpackCString# s) = unsafePackLiteral s + #-} + +unsafePackLenBytes :: Int -> [Word8] -> ByteString +unsafePackLenBytes len xs0 = + unsafeCreateFp len $ \p -> go p xs0 + where + go !_ [] = return () + go !p (x:xs) = pokeFp p x >> go (p `plusForeignPtr` 1) xs + +unsafePackLenChars :: Int -> [Char] -> ByteString +unsafePackLenChars len cs0 = + unsafeCreateFp len $ \p -> go p cs0 + where + go !_ [] = return () + go !p (c:cs) = pokeFp p (c2w c) >> go (p `plusForeignPtr` 1) cs + + +-- | /O(n)/ Pack a null-terminated sequence of bytes, pointed to by an +-- Addr\# (an arbitrary machine address assumed to point outside the +-- garbage-collected heap) into a @ByteString@. A much faster way to +-- create an 'Addr#' is with an unboxed string literal, than to pack a +-- boxed string. A unboxed string literal is compiled to a static @char +-- []@ by GHC. Establishing the length of the string requires a call to +-- @strlen(3)@, so the 'Addr#' must point to a null-terminated buffer (as +-- is the case with @\"string\"\#@ literals in GHC). Use 'Data.ByteString.Unsafe.unsafePackAddressLen' +-- if you know the length of the string statically. +-- +-- An example: +-- +-- > literalFS = unsafePackAddress "literal"# +-- +-- This function is /unsafe/. If you modify the buffer pointed to by the +-- original 'Addr#' this modification will be reflected in the resulting +-- @ByteString@, breaking referential transparency. +-- +-- Note this also won't work if your 'Addr#' has embedded @\'\\0\'@ characters in +-- the string, as @strlen@ will return too short a length. +-- +unsafePackAddress :: Addr# -> IO ByteString +unsafePackAddress addr# = do +#if __GLASGOW_HASKELL__ >= 811 + unsafePackLenAddress (I# (cstringLength# addr#)) addr# +#else + l <- c_strlen (Ptr addr#) + unsafePackLenAddress (fromIntegral l) addr# +#endif +{-# INLINE unsafePackAddress #-} + +-- | See 'unsafePackAddress'. This function is similar, +-- but takes an additional length argument rather then computing +-- it with @strlen@. +-- Therefore embedding @\'\\0\'@ characters is possible. +-- +-- @since 0.11.2.0 +unsafePackLenAddress :: Int -> Addr# -> IO ByteString +unsafePackLenAddress len addr# = do +#if __GLASGOW_HASKELL__ >= 811 + return (BS (ForeignPtr addr# FinalPtr) len) +#else + p <- newForeignPtr_ (Ptr addr#) + return $ BS p len +#endif +{-# INLINE unsafePackLenAddress #-} + +-- | See 'unsafePackAddress'. This function has similar behavior. Prefer +-- this function when the address in known to be an @Addr#@ literal. In +-- that context, there is no need for the sequencing guarantees that 'IO' +-- provides. On GHC 9.0 and up, this function uses the @FinalPtr@ data +-- constructor for @ForeignPtrContents@. +-- +-- @since 0.11.1.0 +unsafePackLiteral :: Addr# -> ByteString +unsafePackLiteral addr# = +#if __GLASGOW_HASKELL__ >= 811 + unsafePackLenLiteral (I# (cstringLength# addr#)) addr# +#else + let len = accursedUnutterablePerformIO (c_strlen (Ptr addr#)) + in unsafePackLenLiteral (fromIntegral len) addr# +#endif +{-# INLINE unsafePackLiteral #-} + + +-- | See 'unsafePackLiteral'. This function is similar, +-- but takes an additional length argument rather then computing +-- it with @strlen@. +-- Therefore embedding @\'\\0\'@ characters is possible. +-- +-- @since 0.11.2.0 +unsafePackLenLiteral :: Int -> Addr# -> ByteString +unsafePackLenLiteral len addr# = +#if __GLASGOW_HASKELL__ >= 811 + BS (ForeignPtr addr# FinalPtr) len +#else + -- newForeignPtr_ allocates a MutVar# internally. If that MutVar# + -- gets commoned up with the MutVar# of some unrelated ForeignPtr, + -- it may prevent automatic finalization for that other ForeignPtr. + -- So we avoid accursedUnutterablePerformIO here. + BS (unsafeDupablePerformIO (newForeignPtr_ (Ptr addr#))) len +#endif +{-# INLINE unsafePackLenLiteral #-} + +packUptoLenBytes :: Int -> [Word8] -> (ByteString, [Word8]) +packUptoLenBytes len xs0 = + unsafeCreateFpUptoN' len $ \p0 -> + let p_end = plusForeignPtr p0 len + go !p [] = return (p `minusForeignPtr` p0, []) + go !p xs | p == p_end = return (len, xs) + go !p (x:xs) = pokeFp p x >> go (p `plusForeignPtr` 1) xs + in go p0 xs0 + +packUptoLenChars :: Int -> [Char] -> (ByteString, [Char]) +packUptoLenChars len cs0 = + unsafeCreateFpUptoN' len $ \p0 -> + let p_end = plusForeignPtr p0 len + go !p [] = return (p `minusForeignPtr` p0, []) + go !p cs | p == p_end = return (len, cs) + go !p (c:cs) = pokeFp p (c2w c) >> go (p `plusForeignPtr` 1) cs + in go p0 cs0 + +-- Unpacking bytestrings into lists efficiently is a tradeoff: on the one hand +-- we would like to write a tight loop that just blasts the list into memory, on +-- the other hand we want it to be unpacked lazily so we don't end up with a +-- massive list data structure in memory. +-- +-- Our strategy is to combine both: we will unpack lazily in reasonable sized +-- chunks, where each chunk is unpacked strictly. +-- +-- unpackBytes and unpackChars do the lazy loop, while unpackAppendBytes and +-- unpackAppendChars do the chunks strictly. + +unpackBytes :: ByteString -> [Word8] +unpackBytes bs = unpackAppendBytesLazy bs [] + +unpackChars :: ByteString -> [Char] +unpackChars bs = unpackAppendCharsLazy bs [] + +unpackAppendBytesLazy :: ByteString -> [Word8] -> [Word8] +unpackAppendBytesLazy (BS fp len) xs + | len <= 100 = unpackAppendBytesStrict (BS fp len) xs + | otherwise = unpackAppendBytesStrict (BS fp 100) remainder + where + remainder = unpackAppendBytesLazy (BS (plusForeignPtr fp 100) (len-100)) xs + + -- Why 100 bytes you ask? Because on a 64bit machine the list we allocate + -- takes just shy of 4k which seems like a reasonable amount. + -- (5 words per list element, 8 bytes per word, 100 elements = 4000 bytes) + +unpackAppendCharsLazy :: ByteString -> [Char] -> [Char] +unpackAppendCharsLazy (BS fp len) cs + | len <= 100 = unpackAppendCharsStrict (BS fp len) cs + | otherwise = unpackAppendCharsStrict (BS fp 100) remainder + where + remainder = unpackAppendCharsLazy (BS (plusForeignPtr fp 100) (len-100)) cs + +-- For these unpack functions, since we're unpacking the whole list strictly we +-- build up the result list in an accumulator. This means we have to build up +-- the list starting at the end. So our traversal starts at the end of the +-- buffer and loops down until we hit the sentinal: + +unpackAppendBytesStrict :: ByteString -> [Word8] -> [Word8] +unpackAppendBytesStrict (BS fp len) xs = + accursedUnutterablePerformIO $ unsafeWithForeignPtr fp $ \base -> + loop (base `plusPtr` (-1)) (base `plusPtr` (-1+len)) xs + where + loop !sentinal !p acc + | p == sentinal = return acc + | otherwise = do x <- peek p + loop sentinal (p `plusPtr` (-1)) (x:acc) + +unpackAppendCharsStrict :: ByteString -> [Char] -> [Char] +unpackAppendCharsStrict (BS fp len) xs = + accursedUnutterablePerformIO $ unsafeWithForeignPtr fp $ \base -> + loop (base `plusPtr` (-1)) (base `plusPtr` (-1+len)) xs + where + loop !sentinal !p acc + | p == sentinal = return acc + | otherwise = do x <- peek p + loop sentinal (p `plusPtr` (-1)) (w2c x:acc) + +------------------------------------------------------------------------ + +-- | The 0 pointer. Used to indicate the empty Bytestring. +nullForeignPtr :: ForeignPtr Word8 +#if __GLASGOW_HASKELL__ >= 811 +nullForeignPtr = ForeignPtr nullAddr# FinalPtr +#else +nullForeignPtr = ForeignPtr nullAddr# (error "nullForeignPtr") +#endif + +-- --------------------------------------------------------------------- +-- Low level constructors + +-- | /O(1)/ Build a ByteString from a ForeignPtr. +-- +-- If you do not need the offset parameter then you should be using +-- 'Data.ByteString.Unsafe.unsafePackCStringLen' or +-- 'Data.ByteString.Unsafe.unsafePackCStringFinalizer' instead. +-- +fromForeignPtr :: ForeignPtr Word8 + -> Int -- ^ Offset + -> Int -- ^ Length + -> ByteString +fromForeignPtr fp o = BS (plusForeignPtr fp o) +{-# INLINE fromForeignPtr #-} + +-- | @since 0.11.0.0 +fromForeignPtr0 :: ForeignPtr Word8 + -> Int -- ^ Length + -> ByteString +fromForeignPtr0 = BS +{-# INLINE fromForeignPtr0 #-} + +-- | /O(1)/ Deconstruct a ForeignPtr from a ByteString +toForeignPtr :: ByteString -> (ForeignPtr Word8, Int, Int) -- ^ (ptr, offset, length) +toForeignPtr (BS ps l) = (ps, 0, l) +{-# INLINE toForeignPtr #-} + +-- | /O(1)/ Deconstruct a ForeignPtr from a ByteString +-- +-- @since 0.11.0.0 +toForeignPtr0 :: ByteString -> (ForeignPtr Word8, Int) -- ^ (ptr, length) +toForeignPtr0 (BS ps l) = (ps, l) +{-# INLINE toForeignPtr0 #-} + +-- | A way of creating ByteStrings outside the IO monad. The @Int@ +-- argument gives the final size of the ByteString. +unsafeCreateFp :: Int -> (ForeignPtr Word8 -> IO ()) -> ByteString +unsafeCreateFp l f = unsafeDupablePerformIO (createFp l f) +{-# INLINE unsafeCreateFp #-} + +-- | Like 'unsafeCreateFp' but instead of giving the final size of the +-- ByteString, it is just an upper bound. The inner action returns +-- the actual size. Unlike 'createFpAndTrim' the ByteString is not +-- reallocated if the final size is less than the estimated size. +unsafeCreateFpUptoN :: Int -> (ForeignPtr Word8 -> IO Int) -> ByteString +unsafeCreateFpUptoN l f = unsafeDupablePerformIO (createFpUptoN l f) +{-# INLINE unsafeCreateFpUptoN #-} + +unsafeCreateFpUptoN' + :: Int -> (ForeignPtr Word8 -> IO (Int, a)) -> (ByteString, a) +unsafeCreateFpUptoN' l f = unsafeDupablePerformIO (createFpUptoN' l f) +{-# INLINE unsafeCreateFpUptoN' #-} + +-- | Create ByteString of size @l@ and use action @f@ to fill its contents. +createFp :: Int -> (ForeignPtr Word8 -> IO ()) -> IO ByteString +createFp l action = do + fp <- mallocByteString l + action fp + return $! BS fp l +{-# INLINE createFp #-} + +-- | Given a maximum size @l@ and an action @f@ that fills the 'ByteString' +-- starting at the given 'Ptr' and returns the actual utilized length, +-- @`createFpUptoN'` l f@ returns the filled 'ByteString'. +createFpUptoN :: Int -> (ForeignPtr Word8 -> IO Int) -> IO ByteString +createFpUptoN l action = do + fp <- mallocByteString l + l' <- action fp + assert (l' <= l) $ return $! BS fp l' +{-# INLINE createFpUptoN #-} + +-- | Like 'createFpUptoN', but also returns an additional value created by the +-- action. +createFpUptoN' :: Int -> (ForeignPtr Word8 -> IO (Int, a)) -> IO (ByteString, a) +createFpUptoN' l action = do + fp <- mallocByteString l + (l', res) <- action fp + assert (l' <= l) $ return (BS fp l', res) +{-# INLINE createFpUptoN' #-} + +-- | Given the maximum size needed and a function to make the contents +-- of a ByteString, createFpAndTrim makes the 'ByteString'. The generating +-- function is required to return the actual final size (<= the maximum +-- size), and the resulting byte array is reallocated to this size. +-- +-- createFpAndTrim is the main mechanism for creating custom, efficient +-- ByteString functions, using Haskell or C functions to fill the space. +-- +createFpAndTrim :: Int -> (ForeignPtr Word8 -> IO Int) -> IO ByteString +createFpAndTrim l action = do + fp <- mallocByteString l + l' <- action fp + if assert (0 <= l' && l' <= l) $ l' >= l + then return $! BS fp l + else createFp l' $ \fp' -> memcpyFp fp' fp l' +{-# INLINE createFpAndTrim #-} + +createFpAndTrim' :: Int -> (ForeignPtr Word8 -> IO (Int, Int, a)) -> IO (ByteString, a) +createFpAndTrim' l action = do + fp <- mallocByteString l + (off, l', res) <- action fp + if assert (0 <= l' && l' <= l) $ l' >= l + then return (BS fp l, res) + else do ps <- createFp l' $ \fp' -> + memcpyFp fp' (fp `plusForeignPtr` off) l' + return (ps, res) +{-# INLINE createFpAndTrim' #-} + + +wrapAction :: (Ptr Word8 -> IO res) -> ForeignPtr Word8 -> IO res +wrapAction = flip withForeignPtr + -- Cannot use unsafeWithForeignPtr, because action can diverge + +-- | A way of creating ByteStrings outside the IO monad. The @Int@ +-- argument gives the final size of the ByteString. +unsafeCreate :: Int -> (Ptr Word8 -> IO ()) -> ByteString +unsafeCreate l f = unsafeCreateFp l (wrapAction f) +{-# INLINE unsafeCreate #-} + +-- | Like 'unsafeCreate' but instead of giving the final size of the +-- ByteString, it is just an upper bound. The inner action returns +-- the actual size. Unlike 'createAndTrim' the ByteString is not +-- reallocated if the final size is less than the estimated size. +unsafeCreateUptoN :: Int -> (Ptr Word8 -> IO Int) -> ByteString +unsafeCreateUptoN l f = unsafeCreateFpUptoN l (wrapAction f) +{-# INLINE unsafeCreateUptoN #-} + +-- | @since 0.10.12.0 +unsafeCreateUptoN' :: Int -> (Ptr Word8 -> IO (Int, a)) -> (ByteString, a) +unsafeCreateUptoN' l f = unsafeCreateFpUptoN' l (wrapAction f) +{-# INLINE unsafeCreateUptoN' #-} + +-- | Create ByteString of size @l@ and use action @f@ to fill its contents. +create :: Int -> (Ptr Word8 -> IO ()) -> IO ByteString +create l action = createFp l (wrapAction action) +{-# INLINE create #-} + +-- | Given a maximum size @l@ and an action @f@ that fills the 'ByteString' +-- starting at the given 'Ptr' and returns the actual utilized length, +-- @`createUptoN'` l f@ returns the filled 'ByteString'. +createUptoN :: Int -> (Ptr Word8 -> IO Int) -> IO ByteString +createUptoN l action = createFpUptoN l (wrapAction action) +{-# INLINE createUptoN #-} + +-- | Like 'createUptoN', but also returns an additional value created by the +-- action. +-- +-- @since 0.10.12.0 +createUptoN' :: Int -> (Ptr Word8 -> IO (Int, a)) -> IO (ByteString, a) +createUptoN' l action = createFpUptoN' l (wrapAction action) +{-# INLINE createUptoN' #-} + +-- | Given the maximum size needed and a function to make the contents +-- of a ByteString, createAndTrim makes the 'ByteString'. The generating +-- function is required to return the actual final size (<= the maximum +-- size), and the resulting byte array is reallocated to this size. +-- +-- createAndTrim is the main mechanism for creating custom, efficient +-- ByteString functions, using Haskell or C functions to fill the space. +-- +createAndTrim :: Int -> (Ptr Word8 -> IO Int) -> IO ByteString +createAndTrim l action = createFpAndTrim l (wrapAction action) +{-# INLINE createAndTrim #-} + +createAndTrim' :: Int -> (Ptr Word8 -> IO (Int, Int, a)) -> IO (ByteString, a) +createAndTrim' l action = createFpAndTrim' l (wrapAction action) +{-# INLINE createAndTrim' #-} + + +-- | Wrapper of 'Foreign.ForeignPtr.mallocForeignPtrBytes' with faster implementation for GHC +-- +mallocByteString :: Int -> IO (ForeignPtr a) +mallocByteString = mallocPlainForeignPtrBytes +{-# INLINE mallocByteString #-} + +------------------------------------------------------------------------ +-- Implementations for Eq, Ord and Monoid instances + +eq :: ByteString -> ByteString -> Bool +eq a@(BS fp len) b@(BS fp' len') + | len /= len' = False -- short cut on length + | fp == fp' = True -- short cut for the same string + | otherwise = compareBytes a b == EQ +{-# INLINE eq #-} +-- ^ still needed + +compareBytes :: ByteString -> ByteString -> Ordering +compareBytes (BS _ 0) (BS _ 0) = EQ -- short cut for empty strings +compareBytes (BS fp1 len1) (BS fp2 len2) = + accursedUnutterablePerformIO $ + unsafeWithForeignPtr fp1 $ \p1 -> + unsafeWithForeignPtr fp2 $ \p2 -> do + i <- memcmp p1 p2 (min len1 len2) + return $! case i `compare` 0 of + EQ -> len1 `compare` len2 + x -> x + + +-- | /O(1)/ The empty 'ByteString' +empty :: ByteString +-- This enables bypassing #457 by not using (polymorphic) mempty in +-- any definitions used by the (Monoid ByteString) instance +empty = BS nullForeignPtr 0 + +append :: ByteString -> ByteString -> ByteString +append (BS _ 0) b = b +append a (BS _ 0) = a +append (BS fp1 len1) (BS fp2 len2) = + unsafeCreateFp (len1+len2) $ \destptr1 -> do + let destptr2 = destptr1 `plusForeignPtr` len1 + memcpyFp destptr1 fp1 len1 + memcpyFp destptr2 fp2 len2 + +concat :: [ByteString] -> ByteString +concat = \bss0 -> goLen0 bss0 bss0 + -- The idea here is we first do a pass over the input list to determine: + -- + -- 1. is a copy necessary? e.g. @concat []@, @concat [mempty, "hello"]@, + -- and @concat ["hello", mempty, mempty]@ can all be handled without + -- copying. + -- 2. if a copy is necessary, how large is the result going to be? + -- + -- If a copy is necessary then we create a buffer of the appropriate size + -- and do another pass over the input list, copying the chunks into the + -- buffer. Also, since foreign calls aren't entirely free we skip over + -- empty chunks while copying. + -- + -- We pass the original [ByteString] (bss0) through as an argument through + -- goLen0, goLen1, and goLen since we will need it again in goCopy. Passing + -- it as an explicit argument avoids capturing it in these functions' + -- closures which would result in unnecessary closure allocation. + where + -- It's still possible that the result is empty + goLen0 _ [] = empty + goLen0 bss0 (BS _ 0 :bss) = goLen0 bss0 bss + goLen0 bss0 (bs :bss) = goLen1 bss0 bs bss + + -- It's still possible that the result is a single chunk + goLen1 _ bs [] = bs + goLen1 bss0 bs (BS _ 0 :bss) = goLen1 bss0 bs bss + goLen1 bss0 bs (BS _ len:bss) = goLen bss0 (checkedAdd "concat" len' len) bss + where BS _ len' = bs + + -- General case, just find the total length we'll need + goLen bss0 !total (BS _ len:bss) = goLen bss0 total' bss + where total' = checkedAdd "concat" total len + goLen bss0 total [] = + unsafeCreateFp total $ \ptr -> goCopy bss0 ptr + + -- Copy the data + goCopy [] !_ = return () + goCopy (BS _ 0 :bss) !ptr = goCopy bss ptr + goCopy (BS fp len:bss) !ptr = do + memcpyFp ptr fp len + goCopy bss (ptr `plusForeignPtr` len) +{-# NOINLINE concat #-} + +{-# RULES +"ByteString concat [] -> empty" + concat [] = empty +"ByteString concat [bs] -> bs" forall x. + concat [x] = x + #-} + +-- | /O(log n)/ Repeats the given ByteString n times. +times :: Integral a => a -> ByteString -> ByteString +times n (BS fp len) + | n < 0 = error "stimes: non-negative multiplier expected" + | n == 0 = empty + | n == 1 = BS fp len + | len == 0 = empty + | len == 1 = unsafeCreateFp size $ \destfptr -> do + byte <- peekFp fp + void $ unsafeWithForeignPtr destfptr $ \destptr -> + memset destptr byte (fromIntegral n) + | otherwise = unsafeCreateFp size $ \destptr -> do + memcpyFp destptr fp len + fillFrom destptr len + where + size = len * fromIntegral n + + fillFrom :: ForeignPtr Word8 -> Int -> IO () + fillFrom destptr copied + | 2 * copied <= size = do + memcpyFp (destptr `plusForeignPtr` copied) destptr copied + fillFrom destptr (copied * 2) + | otherwise = memcpyFp (destptr `plusForeignPtr` copied) destptr (size - copied) + +-- | Add two non-negative numbers. Errors out on overflow. ... +checkedAdd :: String -> Int -> Int -> Int +checkedAdd fun x y + | r >= 0 = r + | otherwise = overflowError fun + where r = x + y +{-# INLINE checkedAdd #-} + +------------------------------------------------------------------------ + +-- | Conversion between 'Word8' and 'Char'. Should compile to a no-op. +w2c :: Word8 -> Char +w2c = unsafeChr . fromIntegral +{-# INLINE w2c #-} + +-- | Unsafe conversion between 'Char' and 'Word8'. This is a no-op and +-- silently truncates to 8 bits Chars > '\255'. It is provided as +-- convenience for ByteString construction. +c2w :: Char -> Word8 +c2w = fromIntegral . ord +{-# INLINE c2w #-} + +-- | Selects words corresponding to white-space characters in the Latin-1 range +isSpaceWord8 :: Word8 -> Bool +isSpaceWord8 w8 = + -- Avoid the cost of narrowing arithmetic results to Word8, + -- the conversion from Word8 to Word is free. + let w :: Word + !w = fromIntegral w8 + in w .&. 0x50 == 0 -- Quick non-whitespace filter + && w - 0x21 > 0x7e -- Second non-whitespace filter + && ( w == 0x20 -- SP + || w == 0xa0 -- NBSP + || w - 0x09 < 5) -- HT, NL, VT, FF, CR +{-# INLINE isSpaceWord8 #-} + +-- | Selects white-space characters in the Latin-1 range +isSpaceChar8 :: Char -> Bool +isSpaceChar8 = isSpaceWord8 . c2w +{-# INLINE isSpaceChar8 #-} + +overflowError :: String -> a +overflowError fun = error $ "Data.ByteString." ++ fun ++ ": size overflow" + +------------------------------------------------------------------------ + +-- | This \"function\" has a superficial similarity to 'System.IO.Unsafe.unsafePerformIO' but +-- it is in fact a malevolent agent of chaos. It unpicks the seams of reality +-- (and the 'IO' monad) so that the normal rules no longer apply. It lulls you +-- into thinking it is reasonable, but when you are not looking it stabs you +-- in the back and aliases all of your mutable buffers. The carcass of many a +-- seasoned Haskell programmer lie strewn at its feet. +-- +-- Witness the trail of destruction: +-- +-- * +-- +-- * +-- +-- * +-- +-- * +-- +-- * +-- +-- * +-- +-- Do not talk about \"safe\"! You do not know what is safe! +-- +-- Yield not to its blasphemous call! Flee traveller! Flee or you will be +-- corrupted and devoured! +-- +{-# INLINE accursedUnutterablePerformIO #-} +accursedUnutterablePerformIO :: IO a -> a +accursedUnutterablePerformIO (IO m) = case m realWorld# of (# _, r #) -> r + +-- --------------------------------------------------------------------- +-- +-- Standard C functions +-- + +foreign import ccall unsafe "string.h strlen" c_strlen + :: CString -> IO CSize + +foreign import ccall unsafe "static stdlib.h &free" c_free_finalizer + :: FunPtr (Ptr Word8 -> IO ()) + +foreign import ccall unsafe "string.h memchr" c_memchr + :: Ptr Word8 -> CInt -> CSize -> IO (Ptr Word8) + +memchr :: Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8) +memchr p w = c_memchr p (fromIntegral w) + +foreign import ccall unsafe "string.h memcmp" c_memcmp + :: Ptr Word8 -> Ptr Word8 -> CSize -> IO CInt + +memcmp :: Ptr Word8 -> Ptr Word8 -> Int -> IO CInt +memcmp p q s = c_memcmp p q (fromIntegral s) + +foreign import ccall unsafe "string.h memcpy" c_memcpy + :: Ptr Word8 -> Ptr Word8 -> CSize -> IO (Ptr Word8) + +memcpy :: Ptr Word8 -> Ptr Word8 -> Int -> IO () +memcpy p q s = void $ c_memcpy p q (fromIntegral s) + +memcpyFp :: ForeignPtr Word8 -> ForeignPtr Word8 -> Int -> IO () +memcpyFp fp fq s = unsafeWithForeignPtr fp $ \p -> + unsafeWithForeignPtr fq $ \q -> memcpy p q s + +{- +foreign import ccall unsafe "string.h memmove" c_memmove + :: Ptr Word8 -> Ptr Word8 -> CSize -> IO (Ptr Word8) + +memmove :: Ptr Word8 -> Ptr Word8 -> CSize -> IO () +memmove p q s = do c_memmove p q s + return () +-} + +foreign import ccall unsafe "string.h memset" c_memset + :: Ptr Word8 -> CInt -> CSize -> IO (Ptr Word8) + +memset :: Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8) +memset p w = c_memset p (fromIntegral w) + +-- --------------------------------------------------------------------- +-- +-- Uses our C code +-- + +foreign import ccall unsafe "static fpstring.h fps_reverse" c_reverse + :: Ptr Word8 -> Ptr Word8 -> CSize -> IO () + +foreign import ccall unsafe "static fpstring.h fps_intersperse" c_intersperse + :: Ptr Word8 -> Ptr Word8 -> CSize -> Word8 -> IO () + +foreign import ccall unsafe "static fpstring.h fps_maximum" c_maximum + :: Ptr Word8 -> CSize -> IO Word8 + +foreign import ccall unsafe "static fpstring.h fps_minimum" c_minimum + :: Ptr Word8 -> CSize -> IO Word8 + +foreign import ccall unsafe "static fpstring.h fps_count" c_count + :: Ptr Word8 -> CSize -> Word8 -> IO CSize + +foreign import ccall unsafe "static fpstring.h fps_sort" c_sort + :: Ptr Word8 -> CSize -> IO () diff --git a/Data/ByteString/Lazy.hs b/Data/ByteString/Lazy.hs --- a/Data/ByteString/Lazy.hs +++ b/Data/ByteString/Lazy.hs @@ -145,6 +145,8 @@ groupBy, inits, tails, + initsNE, + tailsNE, stripPrefix, stripSuffix, @@ -228,10 +230,12 @@ ,getContents,getLine,putStr,putStrLn ,zip,zipWith,unzip,notElem) import qualified Data.List as List +import qualified Data.List.NonEmpty as NE +import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.Bifunctor as BF import qualified Data.ByteString as P (ByteString) -- type name only import qualified Data.ByteString as S -- S for strict (hmm...) -import qualified Data.ByteString.Internal as S +import qualified Data.ByteString.Internal.Type as S import qualified Data.ByteString.Unsafe as S import qualified Data.ByteString.Lazy.Internal.Deque as D import Data.ByteString.Lazy.Internal @@ -342,22 +346,30 @@ {-# INLINE snoc #-} -- | /O(1)/ Extract the first element of a ByteString, which must be non-empty. +-- +-- This is a partial function, consider using 'uncons' instead. head :: HasCallStack => ByteString -> Word8 head Empty = errorEmptyList "head" head (Chunk c _) = S.unsafeHead c {-# INLINE head #-} --- | /O(1)/ Extract the head and tail of a ByteString, returning Nothing +-- | /O(1)/ Extract the 'head' and 'tail' of a ByteString, returning 'Nothing' -- if it is empty. uncons :: ByteString -> Maybe (Word8, ByteString) uncons Empty = Nothing -uncons (Chunk c cs) - = Just (S.unsafeHead c, - if S.length c == 1 then cs else Chunk (S.unsafeTail c) cs) +uncons (Chunk c cs) = case S.length c of + -- Don't move this test inside of the Just or (,). + -- We don't want to allocate a thunk to put inside of the tuple! + -- And if "let !tl = ... in Just (..., tl)" seems more appealing, + -- remember that this function must remain lazy in cs. + 1 -> Just (S.unsafeHead c, cs) + _ -> Just (S.unsafeHead c, Chunk (S.unsafeTail c) cs) {-# INLINE uncons #-} -- | /O(1)/ Extract the elements after the head of a ByteString, which must be -- non-empty. +-- +-- This is a partial function, consider using 'uncons' instead. tail :: HasCallStack => ByteString -> ByteString tail Empty = errorEmptyList "tail" tail (Chunk c cs) @@ -367,6 +379,8 @@ -- | /O(n\/c)/ Extract the last element of a ByteString, which must be finite -- and non-empty. +-- +-- This is a partial function, consider using 'unsnoc' instead. last :: HasCallStack => ByteString -> Word8 last Empty = errorEmptyList "last" last (Chunk c0 cs0) = go c0 cs0 @@ -374,7 +388,9 @@ go _ (Chunk c cs) = go c cs -- XXX Don't inline this. Something breaks with 6.8.2 (haven't investigated yet) --- | /O(n\/c)/ Return all the elements of a 'ByteString' except the last one. +-- | /O(n\/c)/ Returns all the elements of a 'ByteString' except the last one. +-- +-- This is a partial function, consider using 'unsnoc' instead. init :: HasCallStack => ByteString -> ByteString init Empty = errorEmptyList "init" init (Chunk c0 cs0) = go c0 cs0 @@ -382,7 +398,7 @@ | otherwise = Chunk (S.unsafeInit c) Empty go c (Chunk c' cs) = Chunk c (go c' cs) --- | /O(n\/c)/ Extract the 'init' and 'last' of a ByteString, returning Nothing +-- | /O(n\/c)/ Extract the 'init' and 'last' of a ByteString, returning 'Nothing' -- if it is empty. -- -- * It is no faster than using 'init' and 'last' @@ -426,9 +442,11 @@ (foldrChunks (Chunk . intersperse') Empty cs) where intersperse' :: P.ByteString -> P.ByteString intersperse' (S.BS fp l) = - S.unsafeCreate (2*l) $ \p' -> S.unsafeWithForeignPtr fp $ \p -> do - poke p' w - S.c_intersperse (p' `plusPtr` 1) p (fromIntegral l) w + S.unsafeCreateFp (2*l) $ \fp' -> + S.unsafeWithForeignPtr fp' $ \p' -> + S.unsafeWithForeignPtr fp $ \p -> do + poke p' w + S.c_intersperse (p' `plusPtr` 1) p (fromIntegral l) w -- | The 'transpose' function transposes the rows and columns of its -- 'ByteString' argument. @@ -1123,6 +1141,8 @@ -- Indexing ByteStrings -- | /O(c)/ 'ByteString' index (subscript) operator, starting from 0. +-- +-- This is a partial function, consider using 'indexMaybe' instead. index :: HasCallStack => ByteString -> Int64 -> Word8 index _ i | i < 0 = moduleError "index" ("negative index: " ++ show i) index cs0 i = index' cs0 i @@ -1417,20 +1437,40 @@ -- --------------------------------------------------------------------- -- Special lists --- | /O(n)/ Return all initial segments of the given 'ByteString', shortest first. +-- | Returns all initial segments of the given 'ByteString', shortest first. inits :: ByteString -> [ByteString] -inits = (Empty :) . inits' - where inits' Empty = [] - inits' (Chunk c cs) = List.map (`Chunk` Empty) (List.tail (S.inits c)) - ++ List.map (Chunk c) (inits' cs) +-- see Note [Avoid NonEmpty combinators] in Data.ByteString +inits bs = NE.toList $! initsNE bs --- | /O(n)/ Return all final segments of the given 'ByteString', longest first. +-- | Returns all initial segments of the given 'ByteString', shortest first. +-- +-- @since 0.11.4.0 +initsNE :: ByteString -> NonEmpty ByteString +-- see Note [Avoid NonEmpty combinators] in Data.ByteString +initsNE = (Empty :|) . inits' id + where + inits' :: (ByteString -> ByteString) -> ByteString -> [ByteString] + -- inits' f bs === map f (tail (inits bs)) + inits' _ Empty = [] + inits' f (Chunk c@(S.BS x len) cs) + = [f (S.BS x n `Chunk` Empty) | n <- [1..len]] + ++ inits' (f . Chunk c) cs + +-- | /O(n)/ Returns all final segments of the given 'ByteString', longest first. tails :: ByteString -> [ByteString] -tails Empty = [Empty] -tails cs@(Chunk c cs') - | S.length c == 1 = cs : tails cs' - | otherwise = cs : tails (Chunk (S.unsafeTail c) cs') +-- see Note [Avoid NonEmpty combinators] in Data.ByteString +tails bs = NE.toList $! tailsNE bs +-- | /O(n)/ Returns all final segments of the given 'ByteString', longest first. +-- +-- @since 0.11.4.0 +tailsNE :: ByteString -> NonEmpty ByteString +-- see Note [Avoid NonEmpty combinators] in Data.ByteString +tailsNE bs = case uncons bs of + Nothing -> Empty :| [] + Just (_, tl) -> bs :| tails tl + + -- --------------------------------------------------------------------- -- Low level constructors @@ -1568,10 +1608,12 @@ getContents :: IO ByteString getContents = hGetContents stdin --- | Outputs a 'ByteString' to the specified 'Handle'. The chunks will be --- written one at a time. Other threads might write to the 'Handle' between the --- writes, and hence 'hPut' alone might not be suitable for concurrent writes. +-- | Outputs a 'ByteString' to the specified 'Handle'. -- +-- The chunks will be +-- written one at a time. Other threads might write to the 'Handle' in between, +-- and hence 'hPut' alone is not suitable for concurrent writes. +-- hPut :: Handle -> ByteString -> IO () hPut h = foldrChunks (\c rest -> S.hPut h c >> rest) (return ()) @@ -1592,12 +1634,17 @@ 0 -> return bs _ -> return (Chunk c' cs) --- | A synonym for @hPut@, for compatibility +-- | A synonym for 'hPut', for compatibility -- hPutStr :: Handle -> ByteString -> IO () hPutStr = hPut --- | Write a ByteString to stdout +-- | Write a ByteString to 'stdout'. +-- +-- The chunks will be +-- written one at a time. Other threads might write to the 'stdout' in between, +-- and hence 'putStr' alone is not suitable for concurrent writes. +-- putStr :: ByteString -> IO () putStr = hPut stdout diff --git a/Data/ByteString/Lazy/Char8.hs b/Data/ByteString/Lazy/Char8.hs --- a/Data/ByteString/Lazy/Char8.hs +++ b/Data/ByteString/Lazy/Char8.hs @@ -123,6 +123,8 @@ groupBy, inits, tails, + initsNE, + tailsNE, stripPrefix, stripSuffix, @@ -212,7 +214,7 @@ (fromChunks, toChunks ,empty,null,length,tail,init,append,reverse,transpose,cycle ,concat,take,takeEnd,drop,dropEnd,splitAt,intercalate - ,isPrefixOf,isSuffixOf,group,inits,tails,copy + ,isPrefixOf,isSuffixOf,group,inits,tails,initsNE,tailsNE,copy ,stripPrefix,stripSuffix ,hGetContents, hGet, hPut, getContents ,hGetNonBlocking, hPutNonBlocking @@ -224,6 +226,7 @@ import qualified Data.ByteString as S (ByteString) -- typename only import qualified Data.ByteString as B import qualified Data.ByteString.Unsafe as B +import Data.List.NonEmpty (NonEmpty(..)) import Data.ByteString.Lazy.Internal import Data.ByteString.Internal (w2c, c2w, isSpaceWord8) @@ -831,59 +834,50 @@ unzip ls = (pack (fmap fst ls), pack (fmap snd ls)) {-# INLINE unzip #-} --- | 'lines' breaks a ByteString up into a list of ByteStrings at +-- | 'lines' lazily splits a ByteString into a list of ByteStrings at -- newline Chars (@'\\n'@). The resulting strings do not contain newlines. --- --- As of bytestring 0.9.0.3, this function is stricter than its --- list cousin. +-- The first chunk of the result is only strict in the first chunk of the +-- input. -- -- Note that it __does not__ regard CR (@'\\r'@) as a newline character. -- lines :: ByteString -> [ByteString] lines Empty = [] -lines (Chunk c0 cs0) = loop0 c0 cs0 - where - -- this is a really performance sensitive function but the - -- chunked representation makes the general case a bit expensive - -- however assuming a large chunk size and normalish line lengths - -- we will find line endings much more frequently than chunk - -- endings so it makes sense to optimise for that common case. - -- So we partition into two special cases depending on whether we - -- are keeping back a list of chunks that will eventually be output - -- once we get to the end of the current line. - - -- the common special case where we have no existing chunks of - -- the current line - loop0 :: S.ByteString -> ByteString -> [ByteString] - loop0 c cs = - case B.elemIndex (c2w '\n') c of - Nothing -> case cs of - Empty | B.null c -> [] - | otherwise -> [Chunk c Empty] - (Chunk c' cs') - | B.null c -> loop0 c' cs' - | otherwise -> loop c' [c] cs' - - Just n | n /= 0 -> Chunk (B.unsafeTake n c) Empty - : loop0 (B.unsafeDrop (n+1) c) cs - | otherwise -> Empty - : loop0 (B.unsafeTail c) cs +lines (Chunk c0 cs0) = unNE $! go c0 cs0 + where + -- Natural NonEmpty -> List + unNE :: NonEmpty a -> [a] + unNE (a :| b) = a : b - -- the general case when we are building a list of chunks that are - -- part of the same line - loop :: S.ByteString -> [S.ByteString] -> ByteString -> [ByteString] - loop c line cs = - case B.elemIndex (c2w '\n') c of - Nothing -> - case cs of - Empty -> let !c' = revChunks (c : line) - in [c'] + -- Strict in the first argument, lazy in the second. + consNE :: ByteString -> NonEmpty ByteString -> NonEmpty ByteString + consNE !a b = a :| (unNE $! b) - (Chunk c' cs') -> loop c' (c : line) cs' + -- Note invariant: The initial chunk is non-empty on input, and we + -- need to be sure to maintain this in internal recursive calls. + go :: S.ByteString -> ByteString -> NonEmpty ByteString + go c cs = case B.elemIndex (c2w '\n') c of + Just n + | n1 <- n + 1 + , n1 < B.length c -> consNE c' $ go (B.unsafeDrop n1 c) cs + -- 'c' was a multi-line chunk + | otherwise -> c' :| lines cs + -- 'c' was a single-line chunk + where + !c' = chunk (B.unsafeTake n c) Empty - Just n -> - let !c' = revChunks (B.unsafeTake n c : line) - in c' : loop0 (B.unsafeDrop (n+1) c) cs + -- Initial chunk with no new line becomes first chunk of + -- first line of result, with the rest of the result lazy! + -- In particular, we don't strictly pattern match on 'cs'. + -- + -- We can form `Chunk c ...` because the invariant is maintained + -- here and also by using `chunk` in the defintion of `c'` above. + Nothing -> let ~(l:|ls) = lazyRest cs + in Chunk c l :| ls + where + lazyRest :: ByteString -> NonEmpty ByteString + lazyRest (Chunk c' cs') = go c' cs' + lazyRest Empty = Empty :| [] -- | 'unlines' joins lines, appending a terminating newline after each. -- @@ -996,19 +990,22 @@ in (n, c') --- | Write a ByteString to a handle, appending a newline byte +-- | Write a ByteString to a handle, appending a newline byte. -- +-- The chunks will be +-- written one at a time, followed by a newline. +-- Other threads might write to the 'Handle' in between, +-- and hence 'hPutStrLn' alone is not suitable for concurrent writes. +-- hPutStrLn :: Handle -> ByteString -> IO () hPutStrLn h ps = hPut h ps >> hPut h (L.singleton 0x0a) --- | Write a ByteString to stdout, appending a newline byte +-- | Write a ByteString to 'stdout', appending a newline byte. -- +-- The chunks will be +-- written one at a time, followed by a newline. +-- Other threads might write to the 'stdout' in between, +-- and hence 'putStrLn' alone is not suitable for concurrent writes. +-- putStrLn :: ByteString -> IO () putStrLn = hPutStrLn stdout - --- --------------------------------------------------------------------- --- Internal utilities - --- reverse a list of possibly-empty chunks into a lazy ByteString -revChunks :: [S.ByteString] -> ByteString -revChunks = List.foldl' (flip chunk) Empty diff --git a/Data/ByteString/Lazy/Internal.hs b/Data/ByteString/Lazy/Internal.hs --- a/Data/ByteString/Lazy/Internal.hs +++ b/Data/ByteString/Lazy/Internal.hs @@ -49,10 +49,9 @@ import Prelude hiding (concat) -import qualified Data.ByteString.Internal as S +import qualified Data.ByteString.Internal.Type as S import Data.Word (Word8) -import Foreign.Ptr (plusPtr) import Foreign.Storable (Storable(sizeOf)) #if MIN_VERSION_base(4,13,0) @@ -313,14 +312,13 @@ goLen cs0 !total (Chunk (S.BS _ cl) cs) = goLen cs0 (S.checkedAdd "Lazy.concat" total cl) cs goLen cs0 total Empty = - S.unsafeCreate total $ \ptr -> goCopy cs0 ptr + S.unsafeCreateFp total $ \ptr -> goCopy cs0 ptr -- Copy the data goCopy Empty !_ = return () goCopy (Chunk (S.BS _ 0 ) cs) !ptr = goCopy cs ptr - goCopy (Chunk (S.BS fp len) cs) !ptr = - S.unsafeWithForeignPtr fp $ \p -> do - S.memcpy ptr p len - goCopy cs (ptr `plusPtr` len) + goCopy (Chunk (S.BS fp len) cs) !ptr = do + S.memcpyFp ptr fp len + goCopy cs (ptr `S.plusForeignPtr` len) -- See the comment on Data.ByteString.Internal.concat for some background on -- this implementation. diff --git a/Data/ByteString/Lazy/Internal/Deque.hs b/Data/ByteString/Lazy/Internal/Deque.hs --- a/Data/ByteString/Lazy/Internal/Deque.hs +++ b/Data/ByteString/Lazy/Internal/Deque.hs @@ -13,7 +13,7 @@ import qualified Data.ByteString as S import Data.Int (Int64) -import Prelude hiding (head, length, null) +import Prelude hiding (head, tail, length, null) -- A `S.ByteString` Deque used as an accumulator for lazy -- Bytestring operations diff --git a/Data/ByteString/Short/Internal.hs b/Data/ByteString/Short/Internal.hs --- a/Data/ByteString/Short/Internal.hs +++ b/Data/ByteString/Short/Internal.hs @@ -13,10 +13,11 @@ {-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE UnliftedFFITypes #-} {-# LANGUAGE Unsafe #-} +{-# LANGUAGE ViewPatterns #-} -{-# OPTIONS_GHC -fno-warn-name-shadowing -fexpose-all-unfoldings #-} {-# OPTIONS_HADDOCK not-home #-} +{-# OPTIONS_GHC -fexpose-all-unfoldings #-} -- Not all architectures are forgiving of unaligned accesses; whitelist ones -- which are known not to trap (either to the kernel for emulation, or crash). #if defined(i386_HOST_ARCH) || defined(x86_64_HOST_ARCH) \ @@ -85,7 +86,7 @@ any, concat, - -- ** Generating and unfolding ByteStrings + -- ** Generating and unfolding ShortByteStrings replicate, unfoldr, unfoldrN, @@ -138,6 +139,7 @@ count, findIndex, findIndices, + unsafeIndex, -- * Low level operations createFromPtr, @@ -267,7 +269,6 @@ import qualified Data.ByteString.Internal as BS -import qualified Data.Foldable as Foldable import qualified Data.List as List import qualified GHC.Exts import qualified Language.Haskell.TH.Lib as TH @@ -280,12 +281,6 @@ -- 'ByteString' (at the cost of copying the string data). It supports very few -- other operations. -- --- It is suitable for use as an internal representation for code that needs --- to keep many short strings in memory, but it /should not/ be used as an --- interchange type. That is, it should not generally be used in public APIs. --- The 'ByteString' type is usually more suitable for use in interfaces; it is --- more flexible and it supports a wide range of operations. --- data ShortByteString = SBS ByteArray# deriving Typeable @@ -344,7 +339,7 @@ instance GHC.Exts.IsList ShortByteString where type Item ShortByteString = Word8 fromList = packBytes - toList = unpackBytes + toList = unpack -- | Beware: 'fromString' truncates multi-byte characters to octets. -- e.g. "枯朶に烏のとまりけり秋の暮" becomes �6k�nh~�Q��n� @@ -352,7 +347,7 @@ fromString = packChars instance Data ShortByteString where - gfoldl f z txt = z packBytes `f` unpackBytes txt + gfoldl f z txt = z packBytes `f` unpack txt toConstr _ = error "Data.ByteString.Short.ShortByteString.toConstr" gunfold _ _ = error "Data.ByteString.Short.ShortByteString.gunfold" dataTypeOf _ = mkNoRepType "Data.ByteString.Short.ShortByteString" @@ -366,13 +361,15 @@ -- | /O(1)/ The length of a 'ShortByteString'. length :: ShortByteString -> Int -length (SBS barr#) = I# (sizeofByteArray# barr#) +length (unSBS -> barr#) = I# (sizeofByteArray# barr#) -- | /O(1)/ Test whether a 'ShortByteString' is empty. null :: ShortByteString -> Bool null sbs = length sbs == 0 -- | /O(1)/ 'ShortByteString' index (subscript) operator, starting from 0. +-- +-- This is a partial function, consider using 'indexMaybe' instead. index :: HasCallStack => ShortByteString -> Int -> Word8 index sbs i | i >= 0 && i < length sbs = unsafeIndex sbs i @@ -398,6 +395,7 @@ (!?) = indexMaybe {-# INLINE (!?) #-} +-- | /O(1)/ Unsafe indexing without bounds checking. unsafeIndex :: ShortByteString -> Int -> Word8 unsafeIndex sbs = indexWord8Array (asBA sbs) @@ -409,14 +407,18 @@ -- | @since 0.11.2.0 unsafePackLenLiteral :: Int -> Addr# -> ShortByteString unsafePackLenLiteral len addr# = - accursedUnutterablePerformIO $ createFromPtr (Ptr addr#) len + -- createFromPtr allocates, so accursedUnutterablePerformIO is wrong + unsafeDupablePerformIO $ createFromPtr (Ptr addr#) len ------------------------------------------------------------------------ -- Internal utils asBA :: ShortByteString -> BA -asBA (SBS ba#) = BA# ba# +asBA (unSBS -> ba#) = BA# ba# +unSBS :: ShortByteString -> ByteArray# +unSBS (SBS ba#) = ba# + create :: Int -> (forall s. MBA s -> ST s ()) -> ShortByteString create len fill = runST $ do @@ -515,7 +517,7 @@ -- | /O(n)/. Convert a 'ShortByteString' into a 'ByteString'. -- fromShort :: ShortByteString -> ByteString -fromShort (SBS b#) +fromShort (unSBS -> b#) | isPinned b# = BS fp len where addr# = byteArrayContents# b# @@ -547,8 +549,21 @@ -- | /O(n)/. Convert a 'ShortByteString' into a list. unpack :: ShortByteString -> [Word8] -unpack = unpackBytes +unpack sbs = GHC.Exts.build (unpackFoldr sbs) +{-# INLINE unpack #-} +-- +-- Have unpack fuse with good list consumers +-- +unpackFoldr :: ShortByteString -> (Word8 -> a -> a) -> a -> a +unpackFoldr sbs k z = foldr k z sbs +{-# INLINE [0] unpackFoldr #-} + +{-# RULES +"ShortByteString unpack-list" [1] forall bs . + unpackFoldr bs (:) [] = unpackBytes bs + #-} + packChars :: [Char] -> ShortByteString packChars = \cs -> packLenBytes (List.length cs) (List.map BS.c2w cs) @@ -582,6 +597,7 @@ unpackBytes :: ShortByteString -> [Word8] unpackBytes sbs = unpackAppendBytesLazy sbs [] + -- Why 100 bytes you ask? Because on a 64bit machine the list we allocate -- takes just shy of 4k which seems like a reasonable amount. -- (5 words per list element, 8 bytes per word, 100 elements = 4000 bytes) @@ -614,7 +630,7 @@ unpackAppendCharsStrict :: ShortByteString -> Int -> Int -> [Char] -> [Char] unpackAppendCharsStrict !sbs off len = go (off-1) (off-1 + len) where - go !sentinal !i !acc + go !sentinal !i acc | i == sentinal = acc | otherwise = let !c = indexCharArray (asBA sbs) i in go sentinal (i-1) (c:acc) @@ -622,7 +638,7 @@ unpackAppendBytesStrict :: ShortByteString -> Int -> Int -> [Word8] -> [Word8] unpackAppendBytesStrict !sbs off len = go (off-1) (off-1 + len) where - go !sentinal !i !acc + go !sentinal !i acc | i == sentinal = acc | otherwise = let !w = indexWord8Array (asBA sbs) i in go sentinal (i-1) (w:acc) @@ -733,7 +749,7 @@ True -> errorEmptySBS "tail" False -> create nl $ \mba -> copyByteArray (asBA sbs) 1 mba 0 nl --- | /O(n)/ Extract the head and tail of a ByteString, returning Nothing +-- | /O(n)/ Extract the 'head' and 'tail' of a ShortByteString, returning 'Nothing' -- if it is empty. -- -- @since 0.11.3.0 @@ -773,7 +789,7 @@ True -> errorEmptySBS "init" False -> create nl $ \mba -> copyByteArray (asBA sbs) 0 mba 0 nl --- | /O(n)/ Extract the 'init' and 'last' of a ByteString, returning Nothing +-- | /O(n)/ Extract the 'init' and 'last' of a ShortByteString, returning 'Nothing' -- if it is empty. -- -- @since 0.11.3.0 @@ -891,7 +907,7 @@ -- --------------------------------------------------------------------- --- Reducing 'ByteString's +-- Reducing 'ShortByteString's -- | 'foldl', applied to a binary operator, a starting value (typically -- the left-identity of the operator), and a ShortByteString, reduces the @@ -913,13 +929,27 @@ -- -- @since 0.11.3.0 foldr :: (Word8 -> a -> a) -> a -> ShortByteString -> a -foldr f v = List.foldr f v . unpack +foldr k v = \sbs -> + let l = length sbs + ba = asBA sbs + w = indexWord8Array ba + go !n | n >= l = v + | otherwise = k (w n) (go (n + 1)) + in go 0 +{-# INLINE foldr #-} -- | 'foldr'' is like 'foldr', but strict in the accumulator. -- -- @since 0.11.3.0 foldr' :: (Word8 -> a -> a) -> a -> ShortByteString -> a -foldr' k v = Foldable.foldr' k v . unpack +foldr' k v = \sbs -> + let l = length sbs + ba = asBA sbs + w = indexWord8Array ba + go !ix !v' | ix < 0 = v' + | otherwise = go (ix - 1) (k (w ix) v') + in go (l - 1) v +{-# INLINE foldr' #-} -- | 'foldl1' is a variant of 'foldl' that has no starting value -- argument, and thus must be applied to non-empty 'ShortByteString's. @@ -970,8 +1000,8 @@ in go 0 --- | /O(n)/ Applied to a predicate and a ByteString, 'any' determines if --- any element of the 'ByteString' satisfies the predicate. +-- | /O(n)/ Applied to a predicate and a 'ShortByteString', 'any' determines if +-- any element of the 'ShortByteString' satisfies the predicate. -- -- @since 0.11.3.0 any :: (Word8 -> Bool) -> ShortByteString -> Bool @@ -1105,7 +1135,8 @@ -- -- @since 0.11.3.0 break :: (Word8 -> Bool) -> ShortByteString -> (ShortByteString, ShortByteString) -break = \p -> \sbs -> case findIndexOrLength p sbs of n -> (take n sbs, drop n sbs) +break p = \sbs -> case findIndexOrLength p sbs of n -> (take n sbs, drop n sbs) +{-# INLINE break #-} -- | Similar to 'Prelude.span', -- returns the longest (possibly empty) prefix of elements @@ -1146,11 +1177,10 @@ | n <= 0 -> (empty, sbs) | otherwise -> let slen = length sbs - in if | n >= length sbs -> (sbs, empty) + in if | n >= slen -> (sbs, empty) | otherwise -> - let llen = min slen (max 0 n) - rlen = max 0 (slen - max 0 n) - lsbs = create llen $ \mba -> copyByteArray (asBA sbs) 0 mba 0 llen + let rlen = slen - n + lsbs = create n $ \mba -> copyByteArray (asBA sbs) 0 mba 0 n rsbs = create rlen $ \mba -> copyByteArray (asBA sbs) n mba 0 rlen in (lsbs, rsbs) @@ -1234,7 +1264,7 @@ -- Unfolds and replicates --- | /O(n)/ 'replicate' @n x@ is a ByteString of length @n@ with @x@ +-- | /O(n)/ 'replicate' @n x@ is a ShortByteString of length @n@ with @x@ -- the value of every element. The following holds: -- -- > replicate w c = unfoldr w (\u -> Just (u,u)) c @@ -1299,6 +1329,7 @@ Just (w, x'') -> do writeWord8Array mba n' w go' x'' (n'+1) +{-# INLINE unfoldrN #-} @@ -1429,8 +1460,8 @@ elem :: Word8 -> ShortByteString -> Bool elem c = \sbs -> case elemIndex c sbs of Nothing -> False ; _ -> True --- | /O(n)/ 'filter', applied to a predicate and a ByteString, --- returns a ByteString containing those characters that satisfy the +-- | /O(n)/ 'filter', applied to a predicate and a ShortByteString, +-- returns a ShortByteString containing those characters that satisfy the -- predicate. -- -- @since 0.11.3.0 @@ -1458,8 +1489,9 @@ go' (br+1) (bw+1) else go' (br+1) bw +{-# INLINE filter #-} --- | /O(n)/ The 'find' function takes a predicate and a ByteString, +-- | /O(n)/ The 'find' function takes a predicate and a ShortByteString, -- and returns the first element in matching the predicate, or 'Nothing' -- if there is no such element. -- @@ -1470,9 +1502,10 @@ find f = \sbs -> case findIndex f sbs of Just n -> Just (sbs `index` n) _ -> Nothing +{-# INLINE find #-} --- | /O(n)/ The 'partition' function takes a predicate a ByteString and returns --- the pair of ByteStrings with elements which do and do not satisfy the +-- | /O(n)/ The 'partition' function takes a predicate a ShortByteString and returns +-- the pair of ShortByteStrings with elements which do and do not satisfy the -- predicate, respectively; i.e., -- -- > partition p bs == (filter p sbs, filter (not . p) sbs) @@ -1516,7 +1549,7 @@ -- -- @since 0.11.3.0 elemIndex :: Word8 -> ShortByteString -> Maybe Int -elemIndex c = \sbs@(SBS ba#) -> do +elemIndex c = \sbs@(unSBS -> ba#) -> do let l = length sbs accursedUnutterablePerformIO $ do !s <- c_elem_index ba# c (fromIntegral l) @@ -1534,11 +1567,11 @@ -- -- @since 0.11.3.0 count :: Word8 -> ShortByteString -> Int -count w = \sbs@(SBS ba#) -> accursedUnutterablePerformIO $ +count w = \sbs@(unSBS -> ba#) -> accursedUnutterablePerformIO $ fromIntegral <$> c_count ba# (fromIntegral $ length sbs) w -- | /O(n)/ The 'findIndex' function takes a predicate and a 'ShortByteString' and --- returns the index of the first element in the ByteString +-- returns the index of the first element in the ShortByteString -- satisfying the predicate. -- -- @since 0.11.3.0 @@ -1551,6 +1584,7 @@ | k (w n) = Just n | otherwise = go (n + 1) in go 0 +{-# INLINE findIndex #-} -- | /O(n)/ The 'findIndices' function extends 'findIndex', by returning the @@ -1612,54 +1646,54 @@ newByteArray :: Int -> ST s (MBA s) newByteArray (I# len#) = ST $ \s -> case newByteArray# len# s of - (# s, mba# #) -> (# s, MBA# mba# #) + (# s', mba# #) -> (# s', MBA# mba# #) newPinnedByteArray :: Int -> ST s (MBA s) newPinnedByteArray (I# len#) = ST $ \s -> case newPinnedByteArray# len# s of - (# s, mba# #) -> (# s, MBA# mba# #) + (# s', mba# #) -> (# s', MBA# mba# #) unsafeFreezeByteArray :: MBA s -> ST s BA unsafeFreezeByteArray (MBA# mba#) = ST $ \s -> case unsafeFreezeByteArray# mba# s of - (# s, ba# #) -> (# s, BA# ba# #) + (# s', ba# #) -> (# s', BA# ba# #) writeWord8Array :: MBA s -> Int -> Word8 -> ST s () writeWord8Array (MBA# mba#) (I# i#) (W8# w#) = ST $ \s -> case writeWord8Array# mba# i# w# s of - s -> (# s, () #) + s' -> (# s', () #) #if MIN_VERSION_base(4,12,0) && defined(SAFE_UNALIGNED) writeWord64Array :: MBA s -> Int -> Word64 -> ST s () writeWord64Array (MBA# mba#) (I# i#) (W64# w#) = ST $ \s -> case writeWord64Array# mba# i# w# s of - s -> (# s, () #) + s' -> (# s', () #) #endif copyAddrToByteArray :: Ptr a -> MBA RealWorld -> Int -> Int -> ST RealWorld () copyAddrToByteArray (Ptr src#) (MBA# dst#) (I# dst_off#) (I# len#) = ST $ \s -> case copyAddrToByteArray# src# dst# dst_off# len# s of - s -> (# s, () #) + s' -> (# s', () #) copyByteArrayToAddr :: BA -> Int -> Ptr a -> Int -> ST RealWorld () copyByteArrayToAddr (BA# src#) (I# src_off#) (Ptr dst#) (I# len#) = ST $ \s -> case copyByteArrayToAddr# src# src_off# dst# len# s of - s -> (# s, () #) + s' -> (# s', () #) copyByteArray :: BA -> Int -> MBA s -> Int -> Int -> ST s () copyByteArray (BA# src#) (I# src_off#) (MBA# dst#) (I# dst_off#) (I# len#) = ST $ \s -> case copyByteArray# src# src_off# dst# dst_off# len# s of - s -> (# s, () #) + s' -> (# s', () #) setByteArray :: MBA s -> Int -> Int -> Int -> ST s () setByteArray (MBA# dst#) (I# off#) (I# len#) (I# c#) = ST $ \s -> case setByteArray# dst# off# len# c# s of - s -> (# s, () #) + s' -> (# s', () #) 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, () #) + s' -> (# s', () #) ------------------------------------------------------------------------ @@ -1774,7 +1808,7 @@ -- -- @since 0.11.3.0 isValidUtf8 :: ShortByteString -> Bool -isValidUtf8 sbs@(SBS ba#) = accursedUnutterablePerformIO $ do +isValidUtf8 sbs@(unSBS -> ba#) = accursedUnutterablePerformIO $ do let n = length sbs -- Use a safe FFI call for large inputs to avoid GC synchronization pauses -- in multithreaded contexts. diff --git a/bench/BenchAll.hs b/bench/BenchAll.hs --- a/bench/BenchAll.hs +++ b/bench/BenchAll.hs @@ -95,6 +95,12 @@ lazyByteStringData = case S.splitAt (nRepl `div` 2) byteStringData of (bs1, bs2) -> L.fromChunks [bs1, bs2] +{-# NOINLINE smallChunksData #-} +smallChunksData :: L.ByteString +smallChunksData + = L.fromChunks [S.take sz (S.drop n byteStringData) + | let sz = 48, n <- [0, sz .. S.length byteStringData]] + {-# NOINLINE byteStringChunksData #-} byteStringChunksData :: [S.ByteString] byteStringChunksData = map (S.pack . replicate (4 ) . fromIntegral) intData @@ -266,14 +272,11 @@ P.primMapLazyByteStringFixed P.word8 ] , bgroup "ByteString insertion" $ - let dataName = " byteStringChunks" ++ - show (S.length (head byteStringChunksData)) ++ "Data" - in - [ benchB ("foldMap byteStringInsert" ++ dataName) byteStringChunksData + [ benchB "foldMap byteStringInsert" byteStringChunksData (foldMap byteStringInsert) - , benchB ("foldMap byteString" ++ dataName) byteStringChunksData + , benchB "foldMap byteString" byteStringChunksData (foldMap byteString) - , benchB ("foldMap byteStringCopy" ++ dataName) byteStringChunksData + , benchB "foldMap byteStringCopy" byteStringChunksData (foldMap byteStringCopy) ] @@ -404,6 +407,15 @@ , bench "mostlyFalseSlow" $ partitionLazy (\x -> hashWord8 x < w 10) , bench "balancedSlow" $ partitionLazy (\x -> hashWord8 x < w 128) ] + ] + , bgroup "inits" + [ bench "strict" $ nf S.inits byteStringData + , bench "lazy" $ nf L.inits lazyByteStringData + , bench "lazy (small chunks)" $ nf L.inits smallChunksData + ] + , bgroup "tails" + [ bench "strict" $ nf S.tails byteStringData + , bench "lazy" $ nf L.tails lazyByteStringData ] , bgroup "sort" $ map (\s -> bench (S8.unpack s) $ nf S.sort s) sortInputs , bgroup "words" diff --git a/bench/BenchIndices.hs b/bench/BenchIndices.hs --- a/bench/BenchIndices.hs +++ b/bench/BenchIndices.hs @@ -15,7 +15,7 @@ import Data.Monoid import Data.String import Test.Tasty.Bench -import Prelude hiding (words) +import Prelude hiding (words, head, tail) import Data.Word (Word8) import qualified Data.ByteString as S @@ -54,8 +54,8 @@ , bench "ElemIndex" $ nf (S.elemIndex nl) absurdlong ] , bgroup "ByteString strict second index" $ - [ bench "FindIndices" $ nf (listToMaybe . tail . S.findIndices (== nl)) absurdlong - , bench "ElemIndices" $ nf (listToMaybe . tail . S.elemIndices nl) absurdlong + [ bench "FindIndices" $ nf (listToMaybe . drop 1 . S.findIndices (== nl)) absurdlong + , bench "ElemIndices" $ nf (listToMaybe . drop 1 . S.elemIndices nl) absurdlong , bench "FindIndex" $ nf bench_find_index_second absurdlong , bench "ElemIndex" $ nf bench_elem_index_second absurdlong ] diff --git a/bench/BenchShort.hs b/bench/BenchShort.hs --- a/bench/BenchShort.hs +++ b/bench/BenchShort.hs @@ -6,12 +6,13 @@ module BenchShort (benchShort) where +import Control.DeepSeq (force) import Data.Foldable (foldMap) import Data.Maybe (listToMaybe) import Data.Monoid import Data.String import Test.Tasty.Bench -import Prelude hiding (words) +import Prelude hiding (words, head, tail) import Data.ByteString.Short (ShortByteString) import qualified Data.ByteString.Short as S @@ -107,6 +108,9 @@ hashWord8 :: Word8 -> Word8 hashWord8 = fromIntegral . hashInt . fromIntegral +foldInputs' :: [[Word8]] +foldInputs' = force (S.unpack <$> foldInputs) + foldInputs :: [S.ShortByteString] foldInputs = map (\k -> S.pack $ if k <= 6 then take (2 ^ k) [32..95] else concat (replicate (2 ^ (k - 6)) [32..95])) [0..16] @@ -188,8 +192,12 @@ ] , bgroup "folds" [ bgroup "strict" - [ bgroup "foldl'" $ map (\s -> bench (show $ S.length s) $ + [ bgroup "foldl" $ map (\s -> bench (show $ S.length s) $ + nf (S.foldl (\acc x -> acc + fromIntegral x) (0 :: Int)) s) foldInputs + , bgroup "foldl'" $ map (\s -> bench (show $ S.length s) $ nf (S.foldl' (\acc x -> acc + fromIntegral x) (0 :: Int)) s) foldInputs + , bgroup "foldr" $ map (\s -> bench (show $ S.length s) $ + nf (S.foldr (\x acc -> fromIntegral x + acc) (0 :: Int)) s) foldInputs , bgroup "foldr'" $ map (\s -> bench (show $ S.length s) $ nf (S.foldr' (\x acc -> fromIntegral x + acc) (0 :: Int)) s) foldInputs , bgroup "foldr1'" $ map (\s -> bench (show $ S.length s) $ @@ -220,8 +228,8 @@ , bench "ElemIndex" $ nf (S.elemIndex nl) absurdlong ] , bgroup "ShortByteString strict second index" $ - [ bench "FindIndices" $ nf (listToMaybe . tail . S.findIndices (== nl)) absurdlong - , bench "ElemIndices" $ nf (listToMaybe . tail . S.elemIndices nl) absurdlong + [ bench "FindIndices" $ nf (listToMaybe . drop 1 . S.findIndices (== nl)) absurdlong + , bench "ElemIndices" $ nf (listToMaybe . drop 1 . S.elemIndices nl) absurdlong , bench "FindIndex" $ nf bench_find_index_second absurdlong , bench "ElemIndex" $ nf bench_elem_index_second absurdlong ] @@ -231,5 +239,12 @@ , bench "FindIndex/inlined" $ nf (S.findIndex (== nl)) absurdlong , bench "FindIndex/non-inlined" $ nf (S.findIndex (nilEq nl)) absurdlong ] + , bgroup "ShortByteString conversions" $ + [ bgroup "unpack" $ map (\s -> bench (show $ S.length s) $ + nf (\x -> S.unpack x) s) foldInputs + , bgroup "pack" $ map (\s -> bench (show $ length s) $ + nf S.pack s) foldInputs' + , bench "unpack and get last element" $ nf (\x -> last . S.unpack $ x) absurdlong + , bench "unpack and get first 120 elements" $ nf (\x -> take 120 . S.unpack $ x) absurdlong + ] ] - diff --git a/bytestring.cabal b/bytestring.cabal --- a/bytestring.cabal +++ b/bytestring.cabal @@ -1,5 +1,5 @@ Name: bytestring -Version: 0.11.3.1 +Version: 0.11.4.0 Synopsis: Fast, compact, strict and lazy byte strings with a list interface Description: An efficient compact, immutable byte string type (both strict and lazy) @@ -54,8 +54,10 @@ Maintainer: Haskell Bytestring Team , Core Libraries Committee Homepage: https://github.com/haskell/bytestring Bug-reports: https://github.com/haskell/bytestring/issues -Tested-With: GHC==9.0.1, - GHC==8.10.4, +Tested-With: GHC==9.4.1, + GHC==9.2.4, + GHC==9.0.2, + GHC==8.10.7, GHC==8.8.4, GHC==8.6.5, GHC==8.4.4, @@ -99,6 +101,7 @@ Data.ByteString.Builder.RealFloat.D2S Data.ByteString.Builder.RealFloat.Internal Data.ByteString.Builder.RealFloat.TableGenerator + Data.ByteString.Internal.Type Data.ByteString.Lazy.Internal.Deque default-language: Haskell2010 @@ -113,7 +116,7 @@ RankNTypes NamedFieldPuns - ghc-options: -Wall -fwarn-tabs + ghc-options: -Wall -fwarn-tabs -Wincomplete-uni-patterns -O2 -fmax-simplifier-iterations=10 -fdicts-cheap @@ -165,7 +168,7 @@ ghc-prim, QuickCheck, tasty, - tasty-quickcheck, + tasty-quickcheck >= 0.8.1, template-haskell, transformers >= 0.3 ghc-options: -fwarn-unused-binds diff --git a/tests/Properties.hs b/tests/Properties.hs --- a/tests/Properties.hs +++ b/tests/Properties.hs @@ -4,6 +4,7 @@ module Properties (testSuite) where +import Prelude hiding (head, tail) import Foreign.C.String (withCString) import Foreign.Storable import Foreign.ForeignPtr @@ -66,21 +67,34 @@ prop_bijectionBB (Char8 c) = (P.w2c . P.c2w) c == id c prop_bijectionBB' w = (P.c2w . P.w2c) w == id w -prop_head2BB xs = (not (null xs)) ==> head xs == (P.unsafeHead . P.pack) xs - -prop_tail1BB xs = (not (null xs)) ==> tail xs == (P.unpack . P.unsafeTail. P.pack) xs +prop_unsafeHead xs = not (P.null xs) ==> P.head xs === P.unsafeHead xs +prop_unsafeTail xs = not (P.null xs) ==> P.tail xs === P.unsafeTail xs +prop_unsafeLast xs = not (P.null xs) ==> P.last xs === P.unsafeLast xs +prop_unsafeInit xs = not (P.null xs) ==> P.init xs === P.unsafeInit xs -prop_last1BB xs = (not (null xs)) ==> last xs == (P.unsafeLast . P.pack) xs +prop_lines_empty_invariant = + True === case LC.lines (LC.pack "\nfoo\n") of + Empty : _ -> True + _ -> False -prop_init1BB xs = - (not (null xs)) ==> - init xs == (P.unpack . P.unsafeInit . P.pack) xs +prop_lines_lazy = + take 2 (LC.lines (LC.append (LC.pack "a\nb\n") undefined)) === [LC.pack "a", LC.pack "b"] -prop_lines_lazy1 = - head (LC.lines (LC.append (LC.pack "a\nb\n") undefined)) == LC.pack "a" prop_lines_lazy2 = - head (tail (LC.lines (LC.append (LC.pack "a\nb\n") undefined))) == LC.pack "b" + c === case LC.lines (Chunk c undefined) of + Chunk c _ : _ -> c + _ -> P.empty + where + c = C.pack "etc..." +prop_lines_lazy3 = + c === case LC.lines d of + Chunk c _ : _ -> c + _ -> P.empty + where + c = C.pack "etc..." + d = Chunk c d + prop_strip x = C.strip x == (C.dropSpace . C.reverse . C.dropSpace . C.reverse) x -- Ensure that readInt and readInteger over lazy ByteStrings are not @@ -448,14 +462,16 @@ , testProperty "w2c . c2w" prop_bijectionBB , testProperty "c2w . w2c" prop_bijectionBB' - , testProperty "unsafeHead" prop_head2BB - , testProperty "unsafeTail" prop_tail1BB - , testProperty "unsafeLast" prop_last1BB - , testProperty "unsafeInit" prop_init1BB + , testProperty "unsafeHead" prop_unsafeHead + , testProperty "unsafeTail" prop_unsafeTail + , testProperty "unsafeLast" prop_unsafeLast + , testProperty "unsafeInit" prop_unsafeInit , testProperty "unsafeIndex" prop_unsafeIndexBB - , testProperty "lines_lazy1" prop_lines_lazy1 + , testProperty "lines_lazy" prop_lines_lazy , testProperty "lines_lazy2" prop_lines_lazy2 + , testProperty "lines_lazy3" prop_lines_lazy3 + , testProperty "lines_invar" prop_lines_empty_invariant , testProperty "strip" prop_strip , testProperty "isSpace" prop_isSpaceWord8 @@ -478,7 +494,7 @@ , testProperty "scanl is lazy" $ \ xs -> L.take (L.length xs + 1) (L.scanl (+) 0 (explosiveTail (xs <> L.singleton 1))) === (L.pack . fmap (L.foldr (+) 0) . L.inits) xs , testProperty "scanl1 is lazy" $ \ xs -> L.length xs > 0 ==> - L.take (L.length xs) (L.scanl1 (+) (explosiveTail (xs <> L.singleton 1))) === (L.pack . fmap (L.foldr1 (+)) . tail . L.inits) xs + L.take (L.length xs) (L.scanl1 (+) (explosiveTail (xs <> L.singleton 1))) === (L.pack . fmap (L.foldr1 (+)) . drop 1 . L.inits) xs ] , testGroup "Lazy Char" [ testProperty "foldr is lazy" $ \ xs -> @@ -492,7 +508,7 @@ , testProperty "scanl is lazy" $ \ xs -> let char1 +. char2 = toEnum (fromEnum char1 + fromEnum char2) in D.take (D.length xs + 1) (D.scanl (+.) '\NUL' (explosiveTail (xs <> D.singleton '\SOH'))) === (D.pack . fmap (D.foldr (+.) '\NUL') . D.inits) xs , testProperty "scanl1 is lazy" $ \ xs -> D.length xs > 0 ==> let char1 +. char2 = toEnum (fromEnum char1 + fromEnum char2) in - D.take (D.length xs) (D.scanl1 (+.) (explosiveTail (xs <> D.singleton '\SOH'))) === (D.pack . fmap (D.foldr1 (+.)) . tail . D.inits) xs + D.take (D.length xs) (D.scanl1 (+.) (explosiveTail (xs <> D.singleton '\SOH'))) === (D.pack . fmap (D.foldr1 (+.)) . drop 1 . D.inits) xs , testProperty "unlines is lazy" $ \ xs -> D.take (D.length xs + 1) (D.unlines (xs : error "Tail of this list is undefined!")) === xs `D.snoc` '\n' ] ] diff --git a/tests/Properties/ByteString.hs b/tests/Properties/ByteString.hs --- a/tests/Properties/ByteString.hs +++ b/tests/Properties/ByteString.hs @@ -56,10 +56,12 @@ #endif +import Prelude hiding (head, tail) import Control.Arrow import Data.Char import Data.Foldable import qualified Data.List as List +import qualified Data.List.NonEmpty as NE import Data.Semigroup import Data.String import Data.Tuple @@ -102,8 +104,9 @@ -- but if it is ASCII, we should not generate Unicode filenames. enc <- getFileSystemEncoding pure $ case textEncodingName enc of - "ASCII" -> property (prop . getASCIIString) - _ -> property prop + "ASCII" -> property (prop . getASCIIString) + "ANSI_X3.4-1968" -> property (prop . getASCIIString) + _ -> property prop #endif , testProperty "==" $ @@ -183,6 +186,10 @@ \x -> map B.unpack (B.inits x) === List.inits (B.unpack x) , testProperty "tails" $ \x -> map B.unpack (B.tails x) === List.tails (B.unpack x) + , testProperty "initsNE" $ + \x -> NE.map B.unpack (B.initsNE x) === NE.inits (B.unpack x) + , testProperty "tailsNE" $ + \x -> NE.map B.unpack (B.tailsNE x) === NE.tails (B.unpack x) #endif , testProperty "all" $ \f x -> B.all f x === all f (B.unpack x) @@ -427,11 +434,15 @@ \x -> let n = 2^31 in (B.unpack *** B.unpack) (B.splitAt n x) === List.genericSplitAt n (B.unpack x) , testProperty "head" $ - \x -> not (B.null x) ==> B.head x === head (B.unpack x) + \x -> case B.unpack x of + [] -> property True + hd : _ -> B.head x === hd , testProperty "last" $ \x -> not (B.null x) ==> B.last x === last (B.unpack x) , testProperty "tail" $ - \x -> not (B.null x) ==> B.unpack (B.tail x) === tail (B.unpack x) + \x -> case B.unpack x of + [] -> property True + _ : tl -> B.unpack (B.tail x) === tl , testProperty "tail length" $ \x -> not (B.null x) ==> B.length x === 1 + B.length (B.tail x) , testProperty "init" $ diff --git a/tests/QuickCheckUtils.hs b/tests/QuickCheckUtils.hs --- a/tests/QuickCheckUtils.hs +++ b/tests/QuickCheckUtils.hs @@ -114,4 +114,3 @@ instance CoArbitrary SB.ShortByteString where coarbitrary s = coarbitrary (SB.unpack s) -