bytestring 0.11.4.0 → 0.11.5.0

raw patch · 18 files changed

+420/−216 lines, 18 filesdep ~basedep ~deepseqdep ~ghc-primPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base, deepseq, ghc-prim, template-haskell

API changes (from Hackage documentation)

Files

• Changelog.md +26/−0
• Data/ByteString.hs +23/−20
• Data/ByteString/Builder/Internal.hs +12/−4
• Data/ByteString/Char8.hs +5/−5
• Data/ByteString/Internal.hs +2/−0
• Data/ByteString/Internal/Type.hs +78/−38
• Data/ByteString/Lazy.hs +15/−5
• Data/ByteString/Lazy/Char8.hs +3/−3
• Data/ByteString/Lazy/Internal.hs +42/−11
• Data/ByteString/Short/Internal.hs +4/−3
• bench/BenchIndices.hs +3/−3
• bench/BenchShort.hs +3/−3
• bytestring.cabal +4/−1
• cbits/aarch64/is-valid-utf8.c +64/−64
• cbits/is-valid-utf8.c +65/−26
• tests/IsValidUtf8.hs +70/−23
• tests/Properties/ByteString.hs +0/−4
• tests/QuickCheckUtils.hs +1/−3

@@ -1,3 +1,29 @@+[0.11.5.0] — July 2023++* Bug fixes:+  * [Fix multiple bugs with ASCII blocks in the SIMD implementations for `isValidUtf8`](https://github.com/haskell/bytestring/pull/582)+  * [Prevent unsound optimizations with the `Data.ByteString.Internal.create*` family of functions](https://github.com/haskell/bytestring/pull/580)+* API additions:+  * [`Data.ByteString.Internal` now provides `mkDeferredByteString` and `deferForeignPtrAvailability`](https://github.com/haskell/bytestring/pull/580)+* Deprecations:+  * `Data.ByteString.Internal.memcpy`: prefer `Foreign.Marshal.Utils.copyBytes`+  * `Data.ByteString.Internal.memset`: prefer `Foreign.Marshal.Utils.fillBytes`+* Performance improvements:+  * [Many functions returning `StrictByteString` can now return their results unboxed](https://github.com/haskell/bytestring/pull/580)+  * [Dead branches removed from `Lazy.toStrict`](https://github.com/haskell/bytestring/pull/590)+  * [`Builder.toLazyByteString` re-uses under-filled buffers after copying their contents](https://github.com/haskell/bytestring/pull/581)+* Miscellaneous:+  * [Minor benchmarking improvements](https://github.com/haskell/bytestring/pull/577)+<!--+* Internal stuff:+  * Various CI tweaks ([1](https://github.com/haskell/bytestring/pull/571), [2](https://github.com/haskell/bytestring/pull/565), [3](https://github.com/haskell/bytestring/pull/583), [4](https://github.com/haskell/bytestring/pull/584))+  * [`accursedUnutterablePerformIO`'s trail of destruction extended](https://github.com/haskell/bytestring/pull/579)+  * [Add type signatures for subfunction of `buildStepToCIOS`](https://github.com/haskell/bytestring/pull/586)+  * [`foldl'`-related import list tweaks](https://github.com/haskell/bytestring/pull/585)+-->++[0.11.5.0]: https://github.com/haskell/bytestring/compare/0.11.4.0...0.11.5.0+ [0.11.4.0] — January 2023  * Bug fixes:

@@ -1,9 +1,11 @@+{-# OPTIONS_HADDOCK prune #-}+{-# LANGUAGE Trustworthy #-}+ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE TupleSections #-}-{-# OPTIONS_HADDOCK prune #-}-{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE TypeApplications #-}  -- | -- Module      : Data.ByteString@@ -219,11 +221,11 @@   ) where  import qualified Prelude as P-import Prelude hiding           (reverse,head,tail,last,init,null-                                ,length,map,lines,foldl,foldr,unlines+import Prelude hiding           (reverse,head,tail,last,init,Foldable(..)+                                ,map,lines,unlines                                 ,concat,any,take,drop,splitAt,takeWhile-                                ,dropWhile,span,break,elem,filter,maximum-                                ,minimum,all,concatMap,foldl1,foldr1+                                ,dropWhile,span,break,filter+                                ,all,concatMap                                 ,scanl,scanl1,scanr,scanr1                                 ,readFile,writeFile,appendFile,replicate                                 ,getContents,getLine,putStr,putStrLn,interact@@ -243,7 +245,7 @@ import Data.Word                (Word8)  import Control.Exception        (IOException, catch, finally, assert, throwIO)-import Control.Monad            (when, void)+import Control.Monad            (when)  import Foreign.C.String         (CString, CStringLen) import Foreign.C.Types          (CSize (CSize), CInt (CInt))@@ -251,6 +253,7 @@ import Foreign.ForeignPtr.Unsafe(unsafeForeignPtrToPtr) import Foreign.Marshal.Alloc    (allocaBytes) import Foreign.Marshal.Array    (allocaArray)+import Foreign.Marshal.Utils import Foreign.Ptr import Foreign.Storable         (Storable(..)) @@ -267,7 +270,6 @@ import GHC.IO.Buffer import GHC.IO.BufferedIO as Buffered import GHC.IO.Encoding          (getFileSystemEncoding)-import GHC.IO                   (unsafePerformIO, unsafeDupablePerformIO) import GHC.Foreign              (newCStringLen, peekCStringLen) import GHC.Stack.Types          (HasCallStack) import Data.Char                (ord)@@ -844,15 +846,13 @@ -- | /O(n)/ 'replicate' @n x@ is a ByteString of length @n@ with @x@ -- the value of every element. The following holds: ----- > replicate w c = unfoldr w (\u -> Just (u,u)) c------ This implementation uses @memset(3)@+-- > replicate w c = fst (unfoldrN w (\u -> Just (u,u)) c) replicate :: Int -> Word8 -> ByteString replicate w c     | w <= 0    = empty     | otherwise = unsafeCreateFp w $ \fptr ->         unsafeWithForeignPtr fptr $ \ptr ->-                      void $ memset ptr c (fromIntegral w)+                      fillBytes ptr c w {-# INLINE replicate #-}  -- | /O(n)/, where /n/ is the length of the result.  The 'unfoldr'@@ -887,7 +887,7 @@ unfoldrN :: Int -> (a -> Maybe (Word8, a)) -> a -> (ByteString, Maybe a) unfoldrN i f x0     | i < 0     = (empty, Just x0)-    | otherwise = unsafePerformIO $ createFpAndTrim' i $ \p -> go p x0 0+    | otherwise = unsafeDupablePerformIO $ createFpAndTrim' i $ \p -> go p x0 0   where     go !p !x !n = go' x n       where@@ -1725,12 +1725,15 @@ Note [Avoid NonEmpty combinators] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -As of base-4.17, most of the NonEmpty API is surprisingly lazy.+As of base-4.18, 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!++(Even for uses of NonEmpty near lazy ByteStrings, we don't want+the extra laziness of the NonEmpty API.) -}  @@ -1747,18 +1750,18 @@     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)))+    fillBytes (castPtr arr) 0 (256 * sizeOf (undefined :: Int))     unsafeWithForeignPtr input (\x -> countOccurrences arr x l)      let go 256 !_   = return ()         go i   !ptr = do n <- peekElemOff arr i-                         when (n /= 0) $ void $ memset ptr (fromIntegral i) n+                         when (n /= 0) $+                           fillBytes ptr (fromIntegral @Int @Word8 i) n                          go (i + 1) (ptr `plusPtr` fromIntegral n)     unsafeWithForeignPtr p (go 0)   where     -- Count the number of occurrences of each byte.-    -- Used by 'sort'-    countOccurrences :: Ptr CSize -> Ptr Word8 -> Int -> IO ()+    countOccurrences :: Ptr Int -> Ptr Word8 -> Int -> IO ()     countOccurrences !counts !str !len = go 0      where         go !i | i == len    = return ()@@ -1778,7 +1781,7 @@ useAsCString :: ByteString -> (CString -> IO a) -> IO a useAsCString (BS fp l) action =   allocaBytes (l+1) $ \buf -> do-    unsafeWithForeignPtr fp $ \p -> memcpy buf p l+    unsafeWithForeignPtr fp $ \p -> copyBytes buf p l     pokeByteOff buf l (0::Word8)     action (castPtr buf) @@ -1805,7 +1808,7 @@ -- Haskell heap. packCStringLen :: CStringLen -> IO ByteString packCStringLen (cstr, len) | len >= 0 = createFp len $ \fp ->-    unsafeWithForeignPtr fp $ \p -> memcpy p (castPtr cstr) len+    unsafeWithForeignPtr fp $ \p -> copyBytes p (castPtr cstr) len packCStringLen (_, len) =     moduleErrorIO "packCStringLen" ("negative length: " ++ show len) 

@@ -1065,44 +1065,52 @@ -- 'Buffer's allocated according to the given 'AllocationStrategy'. {-# INLINE buildStepToCIOS #-} buildStepToCIOS-    :: AllocationStrategy          -- ^ Buffer allocation strategy to use+    :: forall a.+       AllocationStrategy          -- ^ Buffer allocation strategy to use     -> BuildStep a                 -- ^ 'BuildStep' to execute     -> IO (ChunkIOStream a) buildStepToCIOS (AllocationStrategy nextBuffer bufSize trim) =     \step -> nextBuffer Nothing >>= fill step   where+    fill :: BuildStep a -> Buffer -> IO (ChunkIOStream a)     fill !step buf@(Buffer fpbuf br@(BufferRange _ pe)) = do         res <- fillWithBuildStep step doneH fullH insertChunkH br         touchForeignPtr fpbuf         return res       where+        pbuf :: Ptr Word8         pbuf = unsafeForeignPtrToPtr fpbuf +        doneH :: Ptr Word8 -> a -> IO (ChunkIOStream a)         doneH op' x = return $             Finished (Buffer fpbuf (BufferRange op' pe)) x +        fullH :: Ptr Word8 -> Int -> BuildStep a -> IO (ChunkIOStream a)         fullH op' minSize nextStep =             wrapChunk op' $ const $                 nextBuffer (Just (buf, max minSize bufSize)) >>= fill nextStep +        insertChunkH :: Ptr Word8 -> S.ByteString -> BuildStep a -> IO (ChunkIOStream a)         insertChunkH op' bs nextStep =             wrapChunk op' $ \isEmpty -> yield1 bs $                 -- Checking for empty case avoids allocating 'n-1' empty                 -- buffers for 'n' insertChunkH right after each other.                 if isEmpty-                  then fill nextStep buf+                  then fill nextStep (Buffer fpbuf (BufferRange pbuf pe))                   else do buf' <- nextBuffer (Just (buf, bufSize))                           fill nextStep buf'          -- Wrap and yield a chunk, trimming it if necesary         {-# INLINE wrapChunk #-}+        wrapChunk :: Ptr Word8 -> (Bool -> IO (ChunkIOStream a)) -> IO (ChunkIOStream a)         wrapChunk !op' mkCIOS           | chunkSize == 0      = mkCIOS True           | trim chunkSize size = do               bs <- S.createFp chunkSize $ \fpbuf' ->                         S.memcpyFp fpbuf' fpbuf chunkSize-              -- FIXME: We could reuse the trimmed buffer here.-              return $ Yield1 bs (mkCIOS False)+              -- Instead of allocating a new buffer after trimming,+              -- we re-use the old buffer and consider it empty.+              return $ Yield1 bs (mkCIOS True)           | otherwise            =               return $ Yield1 (S.BS fpbuf chunkSize) (mkCIOS False)           where

@@ -234,14 +234,14 @@   ) where  import qualified Prelude as P-import Prelude hiding           (reverse,head,tail,last,init,null-                                ,length,map,lines,foldl,foldr,unlines+import Prelude hiding           (reverse,head,tail,last,init,Foldable(..)+                                ,map,lines,unlines                                 ,concat,any,take,drop,splitAt,takeWhile-                                ,dropWhile,span,break,elem,filter,unwords-                                ,words,maximum,minimum,all,concatMap+                                ,dropWhile,span,break,filter,unwords+                                ,words,all,concatMap                                 ,scanl,scanl1,scanr,scanr1                                 ,appendFile,readFile,writeFile-                                ,foldl1,foldr1,replicate+                                ,replicate                                 ,getContents,getLine,putStr,putStrLn,interact                                 ,zip,zipWith,unzip,notElem) 

@@ -51,6 +51,7 @@         mallocByteString,          -- * Conversion to and from ForeignPtrs+        mkDeferredByteString,         fromForeignPtr,         toForeignPtr,         fromForeignPtr0,@@ -58,6 +59,7 @@          -- * Utilities         nullForeignPtr,+        deferForeignPtrAvailability,         checkedAdd,          -- * Standard C Functions

@@ -1,6 +1,6 @@ {-# LANGUAGE CPP, ForeignFunctionInterface, BangPatterns #-} {-# LANGUAGE UnliftedFFITypes, MagicHash,-            UnboxedTuples, DeriveDataTypeable #-}+            UnboxedTuples #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE PatternSynonyms, ViewPatterns #-}@@ -62,6 +62,7 @@         mallocByteString,          -- * Conversion to and from ForeignPtrs+        mkDeferredByteString,         fromForeignPtr,         toForeignPtr,         fromForeignPtr0,@@ -75,6 +76,8 @@         pokeFpByteOff,         minusForeignPtr,         memcpyFp,+        deferForeignPtrAvailability,+        unsafeDupablePerformIO,         checkedAdd,          -- * Standard C Functions@@ -108,13 +111,12 @@ 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)+import Foreign.Marshal.Utils  #if MIN_VERSION_base(4,13,0) import Data.Semigroup           (Semigroup (sconcat, stimes))@@ -133,15 +135,14 @@ 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.Exts                 (IsList(..), Addr#, minusAddr#) import GHC.CString              (unpackCString#)-import GHC.Exts                 (Addr#, minusAddr#)+import GHC.Magic                (runRW#, lazy) -import GHC.IO                   (IO(IO),unsafeDupablePerformIO)+import GHC.IO                   (IO(IO)) import GHC.ForeignPtr           (ForeignPtr(ForeignPtr) #if __GLASGOW_HASKELL__ < 900                                 , newForeignPtr_@@ -215,6 +216,51 @@ pokeFpByteOff fp off val = unsafeWithForeignPtr fp $ \p ->   pokeByteOff p off val +-- | Most operations on a 'ByteString' need to read from the buffer+-- given by its @ForeignPtr Word8@ field.  But since most operations+-- on @ByteString@ are (nominally) pure, their implementations cannot+-- see the IO state thread that was used to initialize the contents of+-- that buffer.  This means that under some circumstances, these+-- buffer-reads may be executed before the writes used to initialize+-- the buffer are executed, with unpredictable results.+--+-- 'deferForeignPtrAvailability' exists to help solve this problem.+-- At runtime, a call @'deferForeignPtrAvailability' x@ is equivalent+-- to @pure $! x@, but the former is more opaque to the simplifier, so+-- that reads from the pointer in its result cannot be executed until+-- the @'deferForeignPtrAvailability' x@ call is complete.+--+-- The opaque bits evaporate during CorePrep, so using+-- 'deferForeignPtrAvailability' incurs no direct overhead.+--+-- @since 0.11.5.0+deferForeignPtrAvailability :: ForeignPtr a -> IO (ForeignPtr a)+deferForeignPtrAvailability (ForeignPtr addr0# guts) = IO $ \s0 ->+  case lazy runRW# (\_ -> (# s0, addr0# #)) of+    (# s1, addr1# #) -> (# s1, ForeignPtr addr1# guts #)++-- | Variant of 'fromForeignPtr0' that calls 'deferForeignPtrAvailability'+--+-- @since 0.11.5.0+mkDeferredByteString :: ForeignPtr Word8 -> Int -> IO ByteString+mkDeferredByteString fp len = do+  deferredFp <- deferForeignPtrAvailability fp+  pure $! BS deferredFp len++unsafeDupablePerformIO :: IO a -> a+-- Why does this exist? In base-4.15.1.0 until at least base-4.18.0.0,+-- the version of unsafeDupablePerformIO in base prevents unboxing of+-- its results with an opaque call to GHC.Exts.lazy, for reasons described+-- in Note [unsafePerformIO and strictness] in GHC.IO.Unsafe. (See+-- https://hackage.haskell.org/package/base-4.18.0.0/docs/src/GHC.IO.Unsafe.html#line-30 .)+-- Even if we accept the (very questionable) premise that the sort of+-- function described in that note should work, we expect no such+-- calls to be made in the context of bytestring.  (And we really want+-- unboxing!)+unsafeDupablePerformIO (IO act) = case runRW# act of (# _, res #) -> res+++ -- -----------------------------------------------------------------------------  -- | A space-efficient representation of a 'Word8' vector, supporting many@@ -227,7 +273,6 @@ 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'. --@@ -554,8 +599,8 @@  -- | @since 0.11.0.0 fromForeignPtr0 :: ForeignPtr Word8-               -> Int -- ^ Length-               -> ByteString+                -> Int -- ^ Length+                -> ByteString fromForeignPtr0 = BS {-# INLINE fromForeignPtr0 #-} @@ -595,7 +640,7 @@ createFp l action = do     fp <- mallocByteString l     action fp-    return $! BS fp l+    mkDeferredByteString fp l {-# INLINE createFp #-}  -- | Given a maximum size @l@ and an action @f@ that fills the 'ByteString'@@ -605,7 +650,7 @@ createFpUptoN l action = do     fp <- mallocByteString l     l' <- action fp-    assert (l' <= l) $ return $! BS fp l'+    assert (l' <= l) $ mkDeferredByteString fp l' {-# INLINE createFpUptoN #-}  -- | Like 'createFpUptoN', but also returns an additional value created by the@@ -614,7 +659,8 @@ createFpUptoN' l action = do     fp <- mallocByteString l     (l', res) <- action fp-    assert (l' <= l) $ return (BS fp l', res)+    bs <- mkDeferredByteString fp l'+    assert (l' <= l) $ pure (bs, res) {-# INLINE createFpUptoN' #-}  -- | Given the maximum size needed and a function to make the contents@@ -630,19 +676,19 @@     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'+        then mkDeferredByteString fp l+        else createFp l' $ \dest -> memcpyFp dest 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)+    bs <- if assert (0 <= l' && l' <= l) $ l' >= l+        then mkDeferredByteString fp l -- entire buffer used => offset is zero+        else createFp l' $ \dest ->+               memcpyFp dest (fp `plusForeignPtr` off) l'+    return (bs, res) {-# INLINE createFpAndTrim' #-}  @@ -810,8 +856,8 @@   | len == 0 = empty   | len == 1 = unsafeCreateFp size $ \destfptr -> do       byte <- peekFp fp-      void $ unsafeWithForeignPtr destfptr $ \destptr ->-        memset destptr byte (fromIntegral n)+      unsafeWithForeignPtr destfptr $ \destptr ->+        fillBytes destptr byte (fromIntegral n)   | otherwise = unsafeCreateFp size $ \destptr -> do       memcpyFp destptr fp len       fillFrom destptr len@@ -884,6 +930,8 @@ -- -- * <https://github.com/haskell/bytestring/commit/210c656390ae617d9ee3b8bcff5c88dd17cef8da> --+-- * <https://github.com/haskell/aeson/commit/720b857e2e0acf2edc4f5512f2b217a89449a89d>+-- -- * <https://ghc.haskell.org/trac/ghc/ticket/3486> -- -- * <https://ghc.haskell.org/trac/ghc/ticket/3487>@@ -916,7 +964,7 @@     :: Ptr Word8 -> CInt -> CSize -> IO (Ptr Word8)  memchr :: Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8)-memchr p w = c_memchr p (fromIntegral w)+memchr p w sz = c_memchr p (fromIntegral w) sz  foreign import ccall unsafe "string.h memcmp" c_memcmp     :: Ptr Word8 -> Ptr Word8 -> CSize -> IO CInt@@ -924,30 +972,22 @@ 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)-+{-# DEPRECATED memcpy "Use Foreign.Marshal.Utils.copyBytes instead" #-}+-- | deprecated since @bytestring-0.11.5.0@ memcpy :: Ptr Word8 -> Ptr Word8 -> Int -> IO ()-memcpy p q s = void $ c_memcpy p q (fromIntegral s)+memcpy = copyBytes  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 ()--}+                     unsafeWithForeignPtr fq $ \q -> copyBytes p q s  foreign import ccall unsafe "string.h memset" c_memset     :: Ptr Word8 -> CInt -> CSize -> IO (Ptr Word8) +{-# DEPRECATED memset "Use Foreign.Marshal.Utils.fillBytes instead" #-}+-- | deprecated since @bytestring-0.11.5.0@ memset :: Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8)-memset p w = c_memset p (fromIntegral w)+memset p w sz = c_memset p (fromIntegral w) sz  -- --------------------------------------------------------------------- --

@@ -223,9 +223,9 @@   ) where  import Prelude hiding-    (reverse,head,tail,last,init,null,length,map,lines,foldl,foldr,unlines-    ,concat,any,take,drop,splitAt,takeWhile,dropWhile,span,break,elem,filter,maximum-    ,minimum,all,concatMap,foldl1,foldr1,scanl, scanl1, scanr, scanr1+    (reverse,head,tail,last,init,Foldable(..),map,lines,unlines+    ,concat,any,take,drop,splitAt,takeWhile,dropWhile,span,break,filter+    ,all,concatMap,scanl, scanl1, scanr, scanr1     ,repeat, cycle, interact, iterate,readFile,writeFile,appendFile,replicate     ,getContents,getLine,putStr,putStrLn ,zip,zipWith,unzip,notElem) @@ -495,12 +495,22 @@ -- argument, and thus must be applied to non-empty 'ByteString's. foldl1 :: HasCallStack => (Word8 -> Word8 -> Word8) -> ByteString -> Word8 foldl1 _ Empty        = errorEmptyList "foldl1"-foldl1 f (Chunk c cs) = foldl f (S.unsafeHead c) (Chunk (S.unsafeTail c) cs)+foldl1 f (Chunk c cs) = go (S.unsafeHead c) (S.unsafeTail c) cs+  where+    go v x xs = let v' = S.foldl f v x+      in case xs of+      Empty -> v'+      Chunk x' xs' -> go v' x' xs'  -- | 'foldl1'' is like 'foldl1', but strict in the accumulator. foldl1' :: HasCallStack => (Word8 -> Word8 -> Word8) -> ByteString -> Word8 foldl1' _ Empty        = errorEmptyList "foldl1'"-foldl1' f (Chunk c cs) = foldl' f (S.unsafeHead c) (Chunk (S.unsafeTail c) cs)+foldl1' f (Chunk c cs) = go (S.unsafeHead c) (S.unsafeTail c) cs+  where+    go !v x xs = let v' = S.foldl' f v x+      in case xs of+      Empty -> v'+      Chunk x' xs' -> go v' x' xs'  -- | 'foldr1' is a variant of 'foldr' that has no starting value argument, -- and thus must be applied to non-empty 'ByteString's

@@ -235,9 +235,9 @@ import qualified Data.List as List  import Prelude hiding-        (reverse,head,tail,last,init,null,length,map,lines,foldl,foldr,unlines-        ,concat,any,take,drop,splitAt,takeWhile,dropWhile,span,break,elem,filter-        ,unwords,words,maximum,minimum,all,concatMap,scanl,scanl1,scanr,scanr1,foldl1,foldr1+        (reverse,head,tail,last,init,Foldable(..),map,lines,unlines+        ,concat,any,take,drop,splitAt,takeWhile,dropWhile,span,break,filter+        ,unwords,words,all,concatMap,scanl,scanl1,scanr,scanr1         ,readFile,writeFile,appendFile,replicate,getContents,getLine,putStr,putStrLn         ,zip,zipWith,unzip,notElem,repeat,iterate,interact,cycle) 

@@ -1,9 +1,14 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE BangPatterns #-}-{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveLift #-}+{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE Unsafe #-}++#ifdef HS_BYTESTRING_ASSERTIONS+{-# LANGUAGE PatternSynonyms #-}+#endif+ {-# OPTIONS_HADDOCK not-home #-}  -- |@@ -24,7 +29,7 @@ module Data.ByteString.Lazy.Internal (          -- * The lazy @ByteString@ type and representation-        ByteString(..),+        ByteString(Empty, Chunk),         LazyByteString,         chunk,         foldrChunks,@@ -64,13 +69,17 @@  import Data.String      (IsString(..)) -import Data.Typeable            (Typeable) import Data.Data                (Data(..), mkNoRepType)  import GHC.Exts                 (IsList(..))  import qualified Language.Haskell.TH.Syntax as TH +#ifdef HS_BYTESTRING_ASSERTIONS+import Control.Exception (assert)+#endif++ -- | A space-efficient representation of a 'Word8' vector, supporting many -- efficient operations. --@@ -78,10 +87,28 @@ -- from "Data.ByteString.Lazy.Char8" it can be interpreted as containing -- 8-bit characters. ---data ByteString = Empty | Chunk {-# UNPACK #-} !S.ByteString ByteString-    deriving (Typeable, TH.Lift)--- See 'invariant' function later in this module for internal invariants.+#ifndef HS_BYTESTRING_ASSERTIONS+data ByteString = Empty | Chunk  {-# UNPACK #-} !S.ByteString ByteString+  -- INVARIANT: The S.ByteString field of any Chunk is not empty.+  -- (See also the 'invariant' and 'checkInvariant' functions.) +  -- To make testing of this invariant convenient, we add an+  -- assertion to that effect when the HS_BYTESTRING_ASSERTIONS+  -- preprocessor macro is defined, by renaming the actual constructor+  -- and providing a pattern synonym that does the checking:+#else+data ByteString = Empty | Chunk_ {-# UNPACK #-} !S.ByteString ByteString++pattern Chunk :: S.ByteString -> ByteString -> ByteString+pattern Chunk c cs <- Chunk_ c cs where+  Chunk c@(S.BS _ len) cs = assert (len > 0) Chunk_ c cs++{-# COMPLETE Empty, Chunk #-}+#endif++deriving instance TH.Lift ByteString++ -- | Type synonym for the lazy flavour of 'ByteString'. -- -- @since 0.11.2.0@@ -158,15 +185,21 @@  ------------------------------------------------------------------------ +-- We no longer use these invariant-checking functions internally,+-- preferring an assertion on `Chunk` itself, controlled by the+-- HS_BYTESTRING_ASSERTIONS preprocessor macro.+ -- | The data type invariant:--- Every ByteString is either 'Empty' or consists of non-null 'S.ByteString's.--- All functions must preserve this, and the QC properties must check this.+-- Every ByteString is either 'Empty' or consists of non-null+-- 'S.StrictByteString's. All functions must preserve this. -- invariant :: ByteString -> Bool invariant Empty                     = True invariant (Chunk (S.BS _ len) cs) = len > 0 && invariant cs --- | In a form that checks the invariant lazily.+-- | Lazily checks that the given 'ByteString' satisfies the data type's+-- "no empty chunks" invariant, raising an exception in place of the+-- first chunk that does not satisfy the invariant. checkInvariant :: ByteString -> ByteString checkInvariant Empty = Empty checkInvariant (Chunk c@(S.BS _ len) cs)@@ -299,12 +332,10 @@   where     -- It's still possible that the result is empty     goLen0 _   Empty                 = S.BS S.nullForeignPtr 0-    goLen0 cs0 (Chunk (S.BS _ 0) cs) = goLen0 cs0 cs     goLen0 cs0 (Chunk c cs)          = goLen1 cs0 c cs      -- It's still possible that the result is a single chunk     goLen1 _   bs Empty = bs-    goLen1 cs0 bs (Chunk (S.BS _ 0) cs) = goLen1 cs0 bs cs     goLen1 cs0 (S.BS _ bl) (Chunk (S.BS _ cl) cs) =         goLen cs0 (S.checkedAdd "Lazy.concat" bl cl) cs 

@@ -158,8 +158,9 @@     useAsCStringLen,   ) where -import Data.ByteString.Internal+import Data.ByteString.Internal.Type   ( ByteString(..)+  , unsafeDupablePerformIO   , accursedUnutterablePerformIO   , checkedAdd   )@@ -240,7 +241,7 @@   , writeWord8Array#   , unsafeFreezeByteArray#   , touch# )-import GHC.IO+import GHC.IO hiding ( unsafeDupablePerformIO ) import GHC.ForeignPtr   ( ForeignPtr(ForeignPtr)   , ForeignPtrContents(PlainPtr)@@ -267,7 +268,7 @@   , snd   ) -import qualified Data.ByteString.Internal as BS+import qualified Data.ByteString.Internal.Type as BS  import qualified Data.List as List import qualified GHC.Exts

@@ -38,15 +38,15 @@  -- lines of 200 letters from a to e, followed by repeated letter f absurdlong :: S.ByteString-absurdlong = S.replicate 200 0x61 <> S.singleton nl+absurdlong = (S.replicate 200 0x61 <> S.singleton nl           <> S.replicate 200 0x62 <> S.singleton nl           <> S.replicate 200 0x63 <> S.singleton nl           <> S.replicate 200 0x64 <> S.singleton nl-          <> S.replicate 200 0x65 <> S.singleton nl+          <> S.replicate 200 0x65 <> S.singleton nl)           <> S.replicate 999999 0x66  benchIndices :: Benchmark-benchIndices = bgroup "Indices"+benchIndices = absurdlong `seq` bgroup "Indices"     [ bgroup "ByteString strict first index" $         [ bench "FindIndices" $ nf (listToMaybe . S.findIndices (== nl)) absurdlong         , bench "ElemIndices" $ nf (listToMaybe . S.elemIndices     nl)  absurdlong

@@ -138,11 +138,11 @@  -- lines of 200 letters from a to e, followed by repeated letter f absurdlong :: S.ShortByteString-absurdlong = S.replicate 200 0x61 <> S.singleton nl+absurdlong = (S.replicate 200 0x61 <> S.singleton nl           <> S.replicate 200 0x62 <> S.singleton nl           <> S.replicate 200 0x63 <> S.singleton nl           <> S.replicate 200 0x64 <> S.singleton nl-          <> S.replicate 200 0x65 <> S.singleton nl+          <> S.replicate 200 0x65 <> S.singleton nl)           <> S.replicate 999999 0x66  bench_find_index_second :: ShortByteString -> Maybe Int@@ -166,7 +166,7 @@ -------------  benchShort :: Benchmark-benchShort = bgroup "ShortByteString"+benchShort = absurdlong `seq` bgroup "ShortByteString"     [ bgroup "Small payload"       [ benchB' "mempty"        ()  (const mempty)       , benchB' "UTF-8 String (naive)" "hello world\0" fromString

@@ -1,5 +1,5 @@ Name:                bytestring-Version:             0.11.4.0+Version:             0.11.5.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)@@ -133,6 +133,7 @@      -- DNDEBUG disables asserts in cbits/   cc-options:        -std=c11 -DNDEBUG=1+                     -fno-strict-aliasing     -- No need to link to libgcc on ghc-9.4 and later which uses a clang-based   -- toolchain.@@ -186,6 +187,8 @@   hs-source-dirs:   bench   default-language: Haskell2010   ghc-options:      -O2 "-with-rtsopts=-A32m"+  if impl(ghc >= 8.6)+    ghc-options:    -fproc-alignment=64   build-depends:    base,                     bytestring,                     deepseq,

@@ -29,10 +29,10 @@ */ #pragma GCC push_options #pragma GCC optimize("-O2")+#include <arm_neon.h> #include <stdbool.h>-#include <stdint.h> #include <stddef.h>-#include <arm_neon.h>+#include <stdint.h>  // Fallback (for tails). static inline int is_valid_utf8_fallback(uint8_t const *const src,@@ -102,51 +102,60 @@ }  static uint8_t const first_len_lookup[16] = {-  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 2, 3,+    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 2, 3, };  static uint8_t const first_range_lookup[16] = {-  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 8, 8, 8, 8,+    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 8, 8, 8, 8, };  static uint8_t const range_min_lookup[16] = {-  0x00, 0x80, 0x80, 0x80, 0xA0, 0x80, 0x90, 0x80,-  0xC2, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF,+    0x00, 0x80, 0x80, 0x80, 0xA0, 0x80, 0x90, 0x80,+    0xC2, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, 0xFF, };  static uint8_t const range_max_lookup[16] = {-  0x7F, 0xBF, 0xBF, 0xBF, 0xBF, 0x9F, 0xBF, 0x8F,-  0xF4, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,+    0x7F, 0xBF, 0xBF, 0xBF, 0xBF, 0x9F, 0xBF, 0x8F,+    0xF4, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, };  static uint8_t const range_adjust_lookup[32] = {-  2, 3, 0, 0, 0, 0, 0, 0, 0, 4, 0, 0, 0, 0, 0, 0,-  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0,+    2, 3, 0, 0, 0, 0, 0, 0, 0, 4, 0, 0, 0, 0, 0, 0,+    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, }; -static bool is_ascii (uint8x16_t const * const inputs) {-  uint8x16_t const all_80 = vdupq_n_u8(0x80);-  // A non-ASCII byte will have its highest-order bit set. Since this is-  // preserved by OR, we can OR everything together.-  uint8x16_t ored = vorrq_u8(vorrq_u8(inputs[0], inputs[1]),-                             vorrq_u8(inputs[2], inputs[3]));-  // ANDing with 0x80 retains any set high-order bits. We then check for zeroes.-  uint64x2_t result = vreinterpretq_u64_u8(vandq_u8(ored, all_80));+static bool is_ascii(uint8x16_t const *const inputs,+                     uint8x16_t const prev_first_len) {+  // Check if we have ASCII, and also that we don't have to treat the prior+  // block as special.+  // First, verify that we didn't see any non-ASCII bytes in the first half of+  // the stride.+  uint8x16_t const first_half_clean = vorrq_u8(inputs[0], inputs[1]);+  // Then we do the same for the second half of the stride.+  uint8x16_t const second_half_clean = vorrq_u8(inputs[2], inputs[3]);+  // Check cleanliness of the entire stride.+  uint8x16_t const stride_clean = vorrq_u8(first_half_clean, second_half_clean);+  // Leave only the high-order set bits.+  uint8x16_t const masked = vandq_u8(stride_clean, vdupq_n_u8(0x80));+  // Finally, check that we didn't have any leftover marker bytes in the+  // previous block: these are indicated by non-zeroes in prev_first_len. In+  // order to trigger a failure, we have to have non-zeroes set in the high bit+  // of the lane: we do this by doing a greater-than comparison with a block of+  // zeroes.+  uint8x16_t const no_prior_dirt = vcgtq_u8(prev_first_len, vdupq_n_u8(0x00));+  // Check for all-zero.+  uint64x2_t const result =+      vreinterpretq_u64_u8(vorrq_u8(masked, no_prior_dirt));   return !(vgetq_lane_u64(result, 0) || vgetq_lane_u64(result, 1)); } -static void check_block_neon(uint8x16_t const prev_input,-                             uint8x16_t const prev_first_len,-                             uint8x16_t* errors,-                             uint8x16_t const first_range_tbl,-                             uint8x16_t const range_min_tbl,-                             uint8x16_t const range_max_tbl,-                             uint8x16x2_t const range_adjust_tbl,-                             uint8x16_t const all_ones,-                             uint8x16_t const all_twos,-                             uint8x16_t const all_e0s,-                             uint8x16_t const input,-                             uint8x16_t const first_len) {+static void+check_block_neon(uint8x16_t const prev_input, uint8x16_t const prev_first_len,+                 uint8x16_t *errors, uint8x16_t const first_range_tbl,+                 uint8x16_t const range_min_tbl, uint8x16_t const range_max_tbl,+                 uint8x16x2_t const range_adjust_tbl, uint8x16_t const all_ones,+                 uint8x16_t const all_twos, uint8x16_t const all_e0s,+                 uint8x16_t const input, uint8x16_t const first_len) {   // Get the high 4-bits of the input.   uint8x16_t const high_nibbles = vshrq_n_u8(input, 4);   // Set range index to 8 for bytes in [C0, FF] by lookup (first byte).@@ -182,20 +191,20 @@   errors[1] = vorrq_u8(errors[1], vcgtq_u8(input, maxv)); } -int bytestring_is_valid_utf8(uint8_t const * const src, size_t const len) {+int bytestring_is_valid_utf8(uint8_t const *const src, size_t const len) {   if (len == 0) {     return 1;   }   // We step 64 bytes at a time.   size_t const big_strides = len / 64;   size_t const remaining = len % 64;-  uint8_t const * ptr = (uint8_t const *)src;+  uint8_t const *ptr = (uint8_t const *)src;   // Tracking state   uint8x16_t prev_input = vdupq_n_u8(0);   uint8x16_t prev_first_len = vdupq_n_u8(0);   uint8x16_t errors[2] = {-    vdupq_n_u8(0),-    vdupq_n_u8(0),+      vdupq_n_u8(0),+      vdupq_n_u8(0),   };   // Load our lookup tables.   uint8x16_t const first_len_tbl = vld1q_u8(first_len_lookup);@@ -209,40 +218,33 @@   uint8x16_t const all_e0s = vdupq_n_u8(0xE0);   for (size_t i = 0; i < big_strides; i++) {     // Load 64 bytes-    uint8x16_t const inputs[4] = {-      vld1q_u8(ptr),-      vld1q_u8(ptr + 16),-      vld1q_u8(ptr + 32),-      vld1q_u8(ptr + 48)-    };+    uint8x16_t const inputs[4] = {vld1q_u8(ptr), vld1q_u8(ptr + 16),+                                  vld1q_u8(ptr + 32), vld1q_u8(ptr + 48)};     // Check if we have ASCII-    if (is_ascii(inputs)) {+    if (is_ascii(inputs, prev_first_len)) {       // Prev_first_len cheaply.       prev_first_len = vqtbl1q_u8(first_len_tbl, vshrq_n_u8(inputs[3], 4));     } else {-      uint8x16_t first_len = vqtbl1q_u8(first_len_tbl, vshrq_n_u8(inputs[0], 4));-      check_block_neon(prev_input, prev_first_len, errors,-                       first_range_tbl, range_min_tbl, range_max_tbl,-                       range_adjust_tbl, all_ones, all_twos, all_e0s,-                       inputs[0], first_len);+      uint8x16_t first_len =+          vqtbl1q_u8(first_len_tbl, vshrq_n_u8(inputs[0], 4));+      check_block_neon(prev_input, prev_first_len, errors, first_range_tbl,+                       range_min_tbl, range_max_tbl, range_adjust_tbl, all_ones,+                       all_twos, all_e0s, inputs[0], first_len);       prev_first_len = first_len;       first_len = vqtbl1q_u8(first_len_tbl, vshrq_n_u8(inputs[1], 4));-      check_block_neon(inputs[0], prev_first_len, errors,-                       first_range_tbl, range_min_tbl, range_max_tbl,-                       range_adjust_tbl, all_ones, all_twos, all_e0s,-                       inputs[1], first_len);+      check_block_neon(inputs[0], prev_first_len, errors, first_range_tbl,+                       range_min_tbl, range_max_tbl, range_adjust_tbl, all_ones,+                       all_twos, all_e0s, inputs[1], first_len);       prev_first_len = first_len;       first_len = vqtbl1q_u8(first_len_tbl, vshrq_n_u8(inputs[2], 4));-      check_block_neon(inputs[1], prev_first_len, errors,-                       first_range_tbl, range_min_tbl, range_max_tbl,-                       range_adjust_tbl, all_ones, all_twos, all_e0s,-                       inputs[2], first_len);+      check_block_neon(inputs[1], prev_first_len, errors, first_range_tbl,+                       range_min_tbl, range_max_tbl, range_adjust_tbl, all_ones,+                       all_twos, all_e0s, inputs[2], first_len);       prev_first_len = first_len;       first_len = vqtbl1q_u8(first_len_tbl, vshrq_n_u8(inputs[3], 4));-      check_block_neon(inputs[2], prev_first_len, errors,-                       first_range_tbl, range_min_tbl, range_max_tbl,-                       range_adjust_tbl, all_ones, all_twos, all_e0s,-                       inputs[3], first_len);+      check_block_neon(inputs[2], prev_first_len, errors, first_range_tbl,+                       range_min_tbl, range_max_tbl, range_adjust_tbl, all_ones,+                       all_twos, all_e0s, inputs[3], first_len);       prev_first_len = first_len;     }     // Set prev_input based on last block.@@ -260,19 +262,17 @@   vst1q_lane_u32(&token, vreinterpretq_u32_u8(prev_input), 3);   // We cast this pointer to avoid a redundant check against < 127, as any such   // value would be negative in signed form.-  int8_t const * token_ptr = (int8_t const *)&token;+  int8_t const *token_ptr = (int8_t const *)&token;   ptrdiff_t lookahead = 0;   if (token_ptr[3] > (int8_t)0xBF) {     lookahead = 1;-  }-  else if (token_ptr[2] > (int8_t)0xBF) {+  } else if (token_ptr[2] > (int8_t)0xBF) {     lookahead = 2;-  }-  else if (token_ptr[1] > (int8_t)0xBF) {+  } else if (token_ptr[1] > (int8_t)0xBF) {     lookahead = 3;   }   // Finish the job.-  uint8_t const * const small_ptr = ptr - lookahead;+  uint8_t const *const small_ptr = ptr - lookahead;   size_t const small_len = remaining + lookahead;   return is_valid_utf8_fallback(small_ptr, small_len); }

@@ -35,12 +35,14 @@ #include <string.h>  #ifdef __x86_64__+#include <cpuid.h> #include <emmintrin.h> #include <immintrin.h>-#include <cpuid.h>-#if (__GNUC__ >= 7 || __GNUC__ == 6 && __GNUC_MINOR__ >= 3 || defined(__clang_major__)) && !defined(__STDC_NO_ATOMICS__)-#include <tmmintrin.h>+#if (__GNUC__ >= 7 || __GNUC__ == 6 && __GNUC_MINOR__ >= 3 ||                  \+     defined(__clang_major__)) &&                                              \+    !defined(__STDC_NO_ATOMICS__) #include <stdatomic.h>+#include <tmmintrin.h> #else // This is needed to support CentOS 7, which has a very old GCC. #define CRUFTY_GCC@@ -64,7 +66,8 @@   return r; } -static inline int is_valid_utf8_fallback(uint8_t const *const src, size_t const len) {+static inline int is_valid_utf8_fallback(uint8_t const *const src,+                                         size_t const len) {   uint8_t const *ptr = (uint8_t const *)src;   // This is 'one past the end' to make loop termination and bounds checks   // easier.@@ -83,10 +86,11 @@         // Non-ASCII bytes have a set MSB. Thus, if we AND with 0x80 in every         // 'lane', we will get 0 if everything is ASCII, and something else         // otherwise.-        uint64_t results[4] = {to_little_endian(read_uint64(big_ptr)) & high_bits_mask,-                               to_little_endian(read_uint64((big_ptr + 1))) & high_bits_mask,-                               to_little_endian(read_uint64((big_ptr + 2))) & high_bits_mask,-                               to_little_endian(read_uint64((big_ptr + 3))) & high_bits_mask};+        uint64_t results[4] = {+            to_little_endian(read_uint64(big_ptr)) & high_bits_mask,+            to_little_endian(read_uint64((big_ptr + 1))) & high_bits_mask,+            to_little_endian(read_uint64((big_ptr + 2))) & high_bits_mask,+            to_little_endian(read_uint64((big_ptr + 3))) & high_bits_mask};         if (results[0] == 0) {           ptr += 8;           if (results[1] == 0) {@@ -96,16 +100,16 @@               if (results[3] == 0) {                 ptr += 8;               } else {-                ptr += (__builtin_ctzl(results[3]) / 8);+                ptr += (__builtin_ctzll(results[3]) / 8);               }             } else {-              ptr += (__builtin_ctzl(results[2]) / 8);+              ptr += (__builtin_ctzll(results[2]) / 8);             }           } else {-            ptr += (__builtin_ctzl(results[1]) / 8);+            ptr += (__builtin_ctzll(results[1]) / 8);           }         } else {-          ptr += (__builtin_ctzl(results[0]) / 8);+          ptr += (__builtin_ctzll(results[0]) / 8);         }       }     }@@ -203,16 +207,16 @@               if (result == 0) {                 ptr += 16;               } else {-                ptr += __builtin_ctz(result);+                ptr += __builtin_ctzll(result);               }             } else {-              ptr += __builtin_ctz(result);+              ptr += __builtin_ctzll(result);             }           } else {-            ptr += __builtin_ctz(result);+            ptr += __builtin_ctzll(result);           }         } else {-          ptr += __builtin_ctz(result);+          ptr += __builtin_ctzll(result);         }       }     }@@ -331,10 +335,26 @@ };  __attribute__((target("ssse3"))) static inline bool-is_ascii_sse2(__m128i const *src) {+is_ascii_sse2(__m128i const *src, __m128i const prev_first_len) {+  // Check if we have ASCII, and also that we don't have to treat the prior+  // block as special.+  // First, verify that we didn't see any non-ASCII bytes in the first half of+  // the stride.+  __m128i const first_half_clean = _mm_or_si128(src[0], src[1]);+  // Then do the same for the second half of the stride.+  __m128i const second_half_clean = _mm_or_si128(src[2], src[3]);+  // Check cleanliness of the entire stride.+  __m128i const stride_clean =+      _mm_or_si128(first_half_clean, second_half_clean);+  // Finally, check that we didn't have any leftover marker bytes in the+  // previous block: these are indicated by non-zeroes in prev_first_len. In+  // order to trigger a failure, we have to have non-zeros set the high bit of+  // the lane: we do this by doing a greater-than comparison with a block of+  // zeroes.+  __m128i const no_prior_dirt =+      _mm_cmpgt_epi8(prev_first_len, _mm_setzero_si128());   // OR together everything, then check for a high bit anywhere.-  __m128i const ored =-      _mm_or_si128(_mm_or_si128(src[0], src[1]), _mm_or_si128(src[2], src[3]));+  __m128i const ored = _mm_or_si128(stride_clean, no_prior_dirt);   return (_mm_movemask_epi8(ored) == 0); } @@ -415,7 +435,7 @@         _mm_loadu_si128(big_ptr), _mm_loadu_si128(big_ptr + 1),         _mm_loadu_si128(big_ptr + 2), _mm_loadu_si128(big_ptr + 3)};     // Check if we have ASCII.-    if (is_ascii_sse2(inputs)) {+    if (is_ascii_sse2(inputs, prev_first_len)) {       // Prev_first_len cheaply.       prev_first_len =           _mm_shuffle_epi8(first_len_tbl, high_nibbles_of(inputs[3]));@@ -598,10 +618,26 @@     __m256i const inputs[4] = {         _mm256_loadu_si256(big_ptr), _mm256_loadu_si256(big_ptr + 1),         _mm256_loadu_si256(big_ptr + 2), _mm256_loadu_si256(big_ptr + 3)};-    // Check if we have ASCII.-    bool is_ascii = _mm256_movemask_epi8(_mm256_or_si256(-                        _mm256_or_si256(inputs[0], inputs[1]),-                        _mm256_or_si256(inputs[2], inputs[3]))) == 0;+    // Check if we have ASCII, and also that we don't have to treat the prior+    // block as special.+    // First, verify that we didn't see any non-ASCII bytes in the first half of+    // the stride.+    __m256i const first_half_clean = _mm256_or_si256(inputs[0], inputs[1]);+    // Then do the same for the second half of the stride.+    __m256i const second_half_clean = _mm256_or_si256(inputs[2], inputs[3]);+    // Check cleanliness of the entire stride.+    __m256i const stride_clean =+        _mm256_or_si256(first_half_clean, second_half_clean);+    // Finally, check that we didn't have any leftover marker bytes in the+    // previous block: these are indicated by non-zeroes in prev_first_len.+    // In order to trigger a failure, we have to have non-zeros set the high bit+    // of the lane: we do this by doing a greater-than comparison with a block+    // of zeroes.+    __m256i const no_prior_dirt =+        _mm256_cmpgt_epi8(prev_first_len, _mm256_setzero_si256());+    // Combine all checks together, and check if any high bits are set.+    bool is_ascii =+        _mm256_movemask_epi8(_mm256_or_si256(stride_clean, no_prior_dirt)) == 0;     if (is_ascii) {       // Prev_first_len cheaply       prev_first_len =@@ -683,7 +719,7 @@ } #endif -typedef int (*is_valid_utf8_t) (uint8_t const *const, size_t const);+typedef int (*is_valid_utf8_t)(uint8_t const *const, size_t const);  int bytestring_is_valid_utf8(uint8_t const *const src, size_t const len) {   if (len == 0) {@@ -693,7 +729,10 @@   static _Atomic is_valid_utf8_t s_impl = (is_valid_utf8_t)NULL;   is_valid_utf8_t impl = atomic_load_explicit(&s_impl, memory_order_relaxed);   if (!impl) {-    impl = has_avx2() ? is_valid_utf8_avx2 : (has_ssse3() ? is_valid_utf8_ssse3 : (has_sse2() ? is_valid_utf8_sse2 : is_valid_utf8_fallback));+    impl = has_avx2() ? is_valid_utf8_avx2+                      : (has_ssse3() ? is_valid_utf8_ssse3+                                     : (has_sse2() ? is_valid_utf8_sse2+                                                   : is_valid_utf8_fallback));     atomic_store_explicit(&s_impl, impl, memory_order_relaxed);   }   return (*impl)(src, len);

@@ -8,16 +8,18 @@ import qualified Data.ByteString as B import Data.Char (chr, ord) import Data.Word (Word8)-import GHC.Exts (fromList)-import Test.QuickCheck (Property, forAll, (===))+import Control.Monad (guard)+import Numeric (showHex)+import GHC.Exts (fromList, fromListN, toList)+import Test.QuickCheck (Property, forAll, (===), forAllShrinkShow) import Test.QuickCheck.Arbitrary (Arbitrary (arbitrary, shrink)) import Test.QuickCheck.Gen (oneof, Gen, choose, vectorOf, listOf1, sized, resize,-                            elements)+                            elements, choose) import Test.Tasty (testGroup, adjustOption, TestTree) import Test.Tasty.QuickCheck (testProperty, QuickCheckTests)  testSuite :: TestTree-testSuite = testGroup "UTF-8 validation" $ [+testSuite = testGroup "UTF-8 validation" [   adjustOption (max testCount) . testProperty "Valid UTF-8 ByteString" $ goValidBS,   adjustOption (max testCount) . testProperty "Invalid UTF-8 ByteString" $ goInvalidBS,   adjustOption (max testCount) . testProperty "Valid UTF-8 ShortByteString" $ goValidSBS,@@ -25,24 +27,30 @@   testGroup "Regressions" checkRegressions   ]   where-    goValidBS :: Property-    goValidBS = forAll arbitrary $-      \(ValidUtf8 ss) -> (B.isValidUtf8 . foldMap sequenceToBS $ ss) === True-    goInvalidBS :: Property-    goInvalidBS = forAll arbitrary $-      \inv -> (B.isValidUtf8 . toByteString $ inv) === False-    goValidSBS :: Property-    goValidSBS = forAll arbitrary $-      \(ValidUtf8 ss) -> (SBS.isValidUtf8 . SBS.toShort . foldMap sequenceToBS $ ss) === True-    goInvalidSBS :: Property-    goInvalidSBS = forAll arbitrary $-      \inv -> (SBS.isValidUtf8 . SBS.toShort . toByteString $ inv) === False+    goValidBS :: ValidUtf8 -> Bool+    goValidBS = B.isValidUtf8 . foldMap sequenceToBS . unValidUtf8+    goInvalidBS :: InvalidUtf8 -> Bool+    goInvalidBS = not . B.isValidUtf8 . toByteString+    goValidSBS :: ValidUtf8 -> Bool+    goValidSBS = SBS.isValidUtf8 . SBS.toShort . foldMap sequenceToBS . unValidUtf8+    goInvalidSBS :: InvalidUtf8 -> Bool+    goInvalidSBS = not . SBS.isValidUtf8 . SBS.toShort . toByteString     testCount :: QuickCheckTests     testCount = 1000  checkRegressions :: [TestTree] checkRegressions = [-  testProperty "Too high code point" $ not $ B.isValidUtf8 tooHigh+  testProperty "Too high code point" $+    not $ B.isValidUtf8 tooHigh,+  testProperty "Invalid byte at end of ASCII block" badBlockEnd,+  testProperty "Invalid byte between spaces" $+    not $ B.isValidUtf8 byteBetweenSpaces,+  testProperty "Two invalid bytes between spaces" $+    not $ B.isValidUtf8 twoBytesBetweenSpaces,+  testProperty "Three invalid bytes between spaces" $+    not $ B.isValidUtf8 threeBytesBetweenSpaces,+  testProperty "ASCII stride and invalid multibyte sequence" $+    not $ B.isValidUtf8 asciiAndInvalidMultiByte   ]   where     tooHigh :: ByteString@@ -50,8 +58,46 @@                          [244, 176, 181, 139] ++ -- our invalid sequence too high to be valid                          (take 68 . cycle $ [194, 162]) -- 68 cent symbols +    byteBetweenSpaces :: ByteString+    byteBetweenSpaces = fromList $ replicate 127 32 ++ [216] ++ replicate 128 32++    twoBytesBetweenSpaces :: ByteString+    twoBytesBetweenSpaces = fromList $ replicate 126 32 ++ [235, 167] ++ replicate 128 32++    threeBytesBetweenSpaces :: ByteString+    threeBytesBetweenSpaces = fromList $ replicate 125 32 ++ [242, 134, 159] ++ replicate 128 32++    badBlockEnd :: Property+    badBlockEnd = +      forAllShrinkShow genBadBlock shrinkBadBlock showBadBlock $ \(BadBlock bs) -> +        not . B.isValidUtf8 $ bs++    asciiAndInvalidMultiByte :: ByteString+    asciiAndInvalidMultiByte = fromList $ replicate 32 48 ++ [235, 185]+ -- Helpers +-- A 128-byte sequence with a single bad byte at the end, with the rest being+-- ASCII+newtype BadBlock = BadBlock ByteString++genBadBlock :: Gen BadBlock+genBadBlock = do+  asciiBytes <- vectorOf 127 $ choose (0, 127)+  pure . BadBlock . fromListN 128 $ asciiBytes  ++ [216]++shrinkBadBlock :: BadBlock -> [BadBlock]+shrinkBadBlock (BadBlock bs) = BadBlock <$> do+  let asList = init . toList $ bs+  init' <- fromList <$> traverse shrink asList+  guard (B.length init' == 127)+  pure . B.append init' . B.singleton $ 216++-- Display as hex instead of ASCII-ish+showBadBlock :: BadBlock -> String+showBadBlock (BadBlock bs) = let asList = toList bs in+  foldr showHex "" asList+ data Utf8Sequence =    One Word8 |   Two Word8 Word8 |@@ -155,7 +201,7 @@   Three w1 w2 w3 -> [w1, w2, w3]   Four w1 w2 w3 w4 -> [w1, w2, w3, w4] -newtype ValidUtf8 = ValidUtf8 [Utf8Sequence]+newtype ValidUtf8 = ValidUtf8 { unValidUtf8 :: [Utf8Sequence] }   deriving (Eq)  instance Show ValidUtf8 where@@ -188,8 +234,8 @@     , InvalidUtf8 <$> genValidUtf8 <*> genInvalidUtf8 <*> genValidUtf8     ]   shrink (InvalidUtf8 p i s) = -    (InvalidUtf8 p i <$> shrinkBS s) ++-    ((\p' -> InvalidUtf8 p' i s) <$> shrinkBS p)+    (InvalidUtf8 p i <$> shrinkValidBS s) +++    ((\p' -> InvalidUtf8 p' i s) <$> shrinkValidBS p)  toByteString :: InvalidUtf8 -> ByteString toByteString (InvalidUtf8 p i s) = p `B.append` i `B.append` s@@ -240,7 +286,8 @@     B.append <$> genAscii <*> resize (size `div` 2) genValidUtf8,     B.append <$> gen2Byte <*> resize (size `div` 2) genValidUtf8,     B.append <$> gen3Byte <*> resize (size `div` 2) genValidUtf8,-    B.append <$> gen4Byte <*> resize (size `div` 2) genValidUtf8+    B.append <$> gen4Byte <*> resize (size `div` 2) genValidUtf8,+    B.replicate <$> resize (size * 16) arbitrary <*> elements [0x00 .. 0x7F]     ]   where     genAscii :: Gen ByteString@@ -270,8 +317,8 @@       b4 <- elements [0x80 .. 0xBF]       pure . B.pack $ [b1, b2, b3, b4] -shrinkBS :: ByteString -> [ByteString]-shrinkBS bs = B.pack <$> (shrink . B.unpack $ bs)+shrinkValidBS :: ByteString -> [ByteString]+shrinkValidBS bs = filter B.isValidUtf8 (map B.pack (shrink (B.unpack bs)))  ord2 :: Char -> (Word8, Word8) ord2 c = (x, y)

@@ -34,7 +34,6 @@ module Properties.ByteStringLazy (tests) where #define BYTESTRING_TYPE B.ByteString import qualified Data.ByteString.Lazy as B-import qualified Data.ByteString.Lazy.Internal as B (invariant) #endif  import Data.Word@@ -48,7 +47,6 @@ #else module Properties.ByteStringLazyChar8 (tests) where import qualified Data.ByteString.Lazy.Char8 as B-import qualified Data.ByteString.Lazy.Internal as B (invariant) #define BYTESTRING_TYPE B.ByteString #endif @@ -306,8 +304,6 @@     \f x -> B.takeWhileEnd f x === B.reverse (B.takeWhile f (B.reverse x))  #ifdef BYTESTRING_LAZY-  , testProperty "invariant" $-    \x -> B.invariant x   , testProperty "fromChunks . toChunks" $     \x -> B.fromChunks (B.toChunks x) === x   , testProperty "toChunks . fromChunks" $

@@ -22,7 +22,6 @@ import qualified Data.ByteString.Short as SB import qualified Data.ByteString      as P import qualified Data.ByteString.Lazy as L-import qualified Data.ByteString.Lazy.Internal as L (checkInvariant,ByteString(..))  import qualified Data.ByteString.Char8      as PC import qualified Data.ByteString.Lazy.Char8 as LC@@ -46,8 +45,7 @@   arbitrary = sized $ \n -> do numChunks <- choose (0, n)                                if numChunks == 0                                    then return L.empty-                                   else fmap (L.checkInvariant .-                                              L.fromChunks .+                                   else fmap (L.fromChunks .                                               filter (not . P.null)) $                                             vectorOf numChunks                                                      (sizedByteString