bytestring 0.11.3.1 → 0.11.4.0

raw patch · 20 files changed

+1519/−1192 lines, 20 filesdep ~tasty-quickchecknew-uploaderPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: tasty-quickcheck

API changes (from Hackage documentation)

Files

• Changelog.md +31/−0
• Data/ByteString.hs +174/−136
• Data/ByteString/Builder/Internal.hs +3/−3
• Data/ByteString/Builder/Prim.hs +2/−2
• Data/ByteString/Builder/Prim/Binary.hs +6/−68
• Data/ByteString/Char8.hs +19/−9
• Data/ByteString/Internal.hs +1/−796
• Data/ByteString/Internal/Type.hs +973/−0
• Data/ByteString/Lazy.hs +72/−25
• Data/ByteString/Lazy/Char8.hs +51/−54
• Data/ByteString/Lazy/Internal.hs +5/−7
• Data/ByteString/Lazy/Internal/Deque.hs +1/−1
• Data/ByteString/Short/Internal.hs +84/−50
• bench/BenchAll.hs +18/−6
• bench/BenchIndices.hs +3/−3
• bench/BenchShort.hs +20/−5
• bytestring.cabal +8/−5
• tests/Properties.hs +33/−17
• tests/Properties/ByteString.hs +15/−4
• tests/QuickCheckUtils.hs +0/−1

@@ -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)+<!--+* Internal stuff:+  * Various CI tweaks ([1](https://github.com/haskell/bytestring/pull/539), [2](https://github.com/haskell/bytestring/pull/550), [3](https://github.com/haskell/bytestring/pull/551), [4](https://github.com/haskell/bytestring/pull/563), [5](https://github.com/haskell/bytestring/pull/566), [6](https://github.com/haskell/bytestring/pull/568))+  * [Avoid pattern-matching with `SBS`, for consistency with master](https://github.com/haskell/bytestring/pull/556)+  * [Avoid `Prelude.head` and `Prelude.tail`](https://github.com/haskell/bytestring/pull/553)+-->++[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`.

@@ -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 

@@ -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            =

@@ -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

@@ -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

@@ -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

@@ -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:------ * <https://github.com/haskell/bytestring/commit/71c4b438c675aa360c79d79acc9a491e7bbc26e7>------ * <https://github.com/haskell/bytestring/commit/210c656390ae617d9ee3b8bcff5c88dd17cef8da>------ * <https://ghc.haskell.org/trac/ghc/ticket/3486>------ * <https://ghc.haskell.org/trac/ghc/ticket/3487>------ * <https://ghc.haskell.org/trac/ghc/ticket/7270>------ 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

@@ -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:+--+-- * <https://github.com/haskell/bytestring/commit/71c4b438c675aa360c79d79acc9a491e7bbc26e7>+--+-- * <https://github.com/haskell/bytestring/commit/210c656390ae617d9ee3b8bcff5c88dd17cef8da>+--+-- * <https://ghc.haskell.org/trac/ghc/ticket/3486>+--+-- * <https://ghc.haskell.org/trac/ghc/ticket/3487>+--+-- * <https://ghc.haskell.org/trac/ghc/ticket/7270>+--+-- * <https://gitlab.haskell.org/ghc/ghc/-/issues/22204>+--+-- 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 ()

@@ -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 

@@ -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

@@ -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.

@@ -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

@@ -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.

@@ -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"

@@ -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         ]

@@ -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+        ]     ]-

@@ -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 <andrew.lelechenko@gmail.com>, 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

@@ -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'     ]   ]

@@ -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" $

@@ -114,4 +114,3 @@  instance CoArbitrary SB.ShortByteString where   coarbitrary s = coarbitrary (SB.unpack s)-