bytestring 0.12.1.0 → 0.12.2.0
raw patch · 44 files changed
+538/−437 lines, 44 filesdep ~QuickCheckdep ~basePVP ok
version bump matches the API change (PVP)
Dependency ranges changed: QuickCheck, base
API changes (from Hackage documentation)
+ Data.ByteString.Builder.Internal: instance Control.DeepSeq.NFData Data.ByteString.Builder.Internal.Buffer
+ Data.ByteString.Builder.Internal: instance Control.DeepSeq.NFData Data.ByteString.Builder.Internal.BufferRange
+ Data.ByteString.Builder.Internal: instance GHC.IsList.IsList Data.ByteString.Builder.Internal.Builder
+ Data.ByteString.Builder.Internal: toLazyByteString :: Builder -> LazyByteString
Files
- Changelog.md +26/−0
- Data/ByteString.hs +3/−8
- Data/ByteString/Builder.hs +4/−12
- Data/ByteString/Builder/Extra.hs +1/−1
- Data/ByteString/Builder/Internal.hs +126/−44
- Data/ByteString/Builder/Prim.hs +3/−8
- Data/ByteString/Builder/Prim/ASCII.hs +0/−1
- Data/ByteString/Builder/Prim/Binary.hs +0/−2
- Data/ByteString/Builder/Prim/Internal.hs +3/−1
- Data/ByteString/Builder/Prim/Internal/Base16.hs +1/−1
- Data/ByteString/Builder/RealFloat/D2S.hs +1/−3
- Data/ByteString/Builder/RealFloat/F2S.hs +1/−2
- Data/ByteString/Builder/RealFloat/Internal.hs +2/−2
- Data/ByteString/Builder/RealFloat/TableGenerator.hs +0/−4
- Data/ByteString/Char8.hs +4/−3
- Data/ByteString/Internal/Pure.hs +0/−4
- Data/ByteString/Internal/Type.hs +24/−55
- Data/ByteString/Lazy.hs +20/−16
- Data/ByteString/Lazy/Char8.hs +1/−2
- Data/ByteString/Lazy/Internal.hs +3/−14
- Data/ByteString/Lazy/ReadInt.hs +0/−5
- Data/ByteString/Lazy/ReadNat.hs +0/−5
- Data/ByteString/Short/Internal.hs +9/−60
- Data/ByteString/Unsafe.hs +2/−4
- Data/ByteString/Utils/ByteOrder.hs +3/−5
- Data/ByteString/Utils/UnalignedAccess.hs +4/−7
- README.md +2/−2
- bench/BenchAll.hs +87/−24
- bench/BenchBoundsCheckFusion.hs +0/−2
- bench/BenchCSV.hs +2/−3
- bench/BenchIndices.hs +0/−2
- bench/BenchReadInt.hs +2/−8
- bench/BenchShort.hs +0/−4
- bytestring.cabal +87/−64
- cbits/shortbytestring.c +0/−15
- include/bytestring-cpp-macros.h +8/−3
- tests/IsValidUtf8.hs +0/−2
- tests/Lift.hs +7/−1
- tests/Properties.hs +8/−14
- tests/Properties/ByteString.hs +39/−8
- tests/QuickCheckUtils.hs +8/−4
- tests/builder/Data/ByteString/Builder/Prim/TestUtils.hs +1/−1
- tests/builder/Data/ByteString/Builder/Prim/Tests.hs +0/−2
- tests/builder/Data/ByteString/Builder/Tests.hs +46/−9
Changelog.md view
@@ -1,3 +1,29 @@+[0.12.2.0] — December 2024++* Bug fixes:+ * [`Builder`: avoid unsound buffer reuse, introduced in `bytestring-0.11.5.0`](https://github.com/haskell/bytestring/pull/691)+ * [Fix several bugs around the `byteString` family of `Builders`](https://github.com/haskell/bytestring/pull/671)+ * [Make `Data.ByteString.Lazy.zipWith` properly lazy](https://github.com/haskell/bytestring/pull/668)+* API additions:+ * [Add `instance IsList Builder`](https://github.com/haskell/bytestring/pull/672)+ * [Add `instance NFData BufferRange` and `instance NFData Buffer`](https://github.com/haskell/bytestring/pull/680)+ * [Export `toLazyByteString` from `Data.ByteString.Builder.Internal`](https://github.com/haskell/bytestring/pull/672)+* Performance improvements:+ * [Remove another dead branch from `toStrict`](https://github.com/haskell/bytestring/pull/663)+* Miscellaneous:+ * [Remove support for GHC < 8.4](https://github.com/haskell/bytestring/pull/682)+ * Various documentation improvements ([1](https://github.com/haskell/bytestring/pull/683), [2](https://github.com/haskell/bytestring/pull/692))+<!--+* Internal stuff:+ * Various CI tweaks ([1](https://github.com/haskell/bytestring/pull/670), [2](https://github.com/haskell/bytestring/pull/681), [3](https://github.com/haskell/bytestring/pull/686), [4](https://github.com/haskell/bytestring/pull/656), [5](https://github.com/haskell/bytestring/pull/693), [6](https://github.com/haskell/bytestring/pull/699), [7](https://github.com/haskell/bytestring/pull/700))+ * [Use `default-extensions` to tidy up a bit](https://github.com/haskell/bytestring/pull/669)+ * [Remove `includes` from Cabal file](https://github.com/haskell/bytestring/pull/685)+ * [Improve benchmarks for small `Builders`](https://github.com/haskell/bytestring/pull/680)+ * [Add a constraint reflecting](https://github.com/haskell/bytestring/pull/698) [#665](https://github.com/haskell/bytestring/issues/665) [to the package description](https://github.com/haskell/bytestring/pull/698)+-->++[0.12.2.0]: https://github.com/haskell/bytestring/compare/0.12.1.0...0.12.2.0+ [0.12.1.0] — February 2024 * [Provisional support has been added for using `bytestring` with GHC's JavaScript back-end.](https://github.com/haskell/bytestring/pull/631)
Data/ByteString.hs view
@@ -1,11 +1,6 @@-{-# OPTIONS_HADDOCK prune #-} {-# LANGUAGE Trustworthy #-} -{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE TupleSections #-}-{-# LANGUAGE TypeApplications #-}+{-# OPTIONS_HADDOCK prune #-} -- | -- Module : Data.ByteString@@ -1077,7 +1072,7 @@ -- | Returns the longest (possibly empty) suffix of elements which __do not__ -- satisfy the predicate and the remainder of the string. ----- 'breakEnd' @p@ is equivalent to @'spanEnd' (not . p)@ and to @('takeWhileEnd' (not . p) &&& 'dropWhileEnd' (not . p))@.+-- 'breakEnd' @p@ is equivalent to @'spanEnd' (not . p)@ and to @('dropWhileEnd' (not . p) &&& 'takeWhileEnd' (not . p))@. -- breakEnd :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString) breakEnd p ps = splitAt (findFromEndUntil p ps) ps@@ -1122,7 +1117,7 @@ -- | Returns the longest (possibly empty) suffix of elements -- satisfying the predicate and the remainder of the string. ----- 'spanEnd' @p@ is equivalent to @'breakEnd' (not . p)@ and to @('takeWhileEnd' p &&& 'dropWhileEnd' p)@.+-- 'spanEnd' @p@ is equivalent to @'breakEnd' (not . p)@ and to @('dropWhileEnd' p &&& 'takeWhileEnd' p)@. -- -- We have --
Data/ByteString/Builder.hs view
@@ -1,7 +1,8 @@-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE BangPatterns #-} {-# LANGUAGE Trustworthy #-}-{-# OPTIONS_GHC -fno-warn-unused-imports -fno-warn-orphans #-}++{-# OPTIONS_GHC -fno-warn-orphans #-}+ --instance Show Builder, instance IsString Builder+ {- | Copyright : (c) 2010 Jasper Van der Jeugt (c) 2010 - 2011 Simon Meier License : BSD3-style (see LICENSE)@@ -254,7 +255,6 @@ import Data.ByteString.Builder.Internal import qualified Data.ByteString.Builder.Prim as P-import qualified Data.ByteString.Lazy.Internal as L import Data.ByteString.Builder.ASCII import Data.ByteString.Builder.RealFloat @@ -263,14 +263,6 @@ import Foreign import GHC.Base (unpackCString#, unpackCStringUtf8#, unpackFoldrCString#, build)---- | Execute a 'Builder' and return the generated chunks as a 'L.LazyByteString'.--- The work is performed lazy, i.e., only when a chunk of the 'L.LazyByteString'--- is forced.-{-# NOINLINE toLazyByteString #-} -- ensure code is shared-toLazyByteString :: Builder -> L.LazyByteString-toLazyByteString = toLazyByteStringWith- (safeStrategy L.smallChunkSize L.defaultChunkSize) L.Empty {- Not yet stable enough. See note on 'hPut' in Data.ByteString.Builder.Internal
Data/ByteString/Builder/Extra.hs view
@@ -1,5 +1,5 @@-{-# LANGUAGE BangPatterns #-} {-# LANGUAGE Trustworthy #-}+ ----------------------------------------------------------------------------- -- | Copyright : (c) 2010 Jasper Van der Jeugt -- (c) 2010-2011 Simon Meier
Data/ByteString/Builder/Internal.hs view
@@ -1,6 +1,9 @@-{-# LANGUAGE ScopedTypeVariables, CPP, BangPatterns, RankNTypes, TupleSections #-} {-# LANGUAGE Unsafe #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE NoMonoLocalBinds #-}+ {-# OPTIONS_HADDOCK not-home #-}+ -- | Copyright : (c) 2010 - 2011 Simon Meier -- License : BSD3-style (see LICENSE) --@@ -98,6 +101,7 @@ , lazyByteString -- ** Execution+ , toLazyByteString , toLazyByteStringWith , AllocationStrategy , safeStrategy@@ -127,11 +131,14 @@ ) where import Control.Arrow (second)+import Control.DeepSeq (NFData(..))+import GHC.Exts (IsList(..)) import Data.Semigroup (Semigroup(..)) import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.ByteString as S+import qualified Data.ByteString.Unsafe 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@@ -154,11 +161,22 @@ data BufferRange = BufferRange {-# UNPACK #-} !(Ptr Word8) -- First byte of range {-# UNPACK #-} !(Ptr Word8) -- First byte /after/ range +-- | @since 0.12.2.0+instance NFData BufferRange where+ rnf !_ = ()+ -- | A 'Buffer' together with the 'BufferRange' of free bytes. The filled -- space starts at offset 0 and ends at the first free byte. data Buffer = Buffer {-# UNPACK #-} !(ForeignPtr Word8) {-# UNPACK #-} !BufferRange +-- | Like the @NFData@ instance for @StrictByteString@,+-- this does not force the @ForeignPtrContents@ field+-- of the underlying @ForeignPtr@.+--+-- @since 0.12.2.0+instance NFData Buffer where+ rnf !_ = () -- | Combined size of the filled and free space in the buffer. {-# INLINE bufferSize #-}@@ -413,6 +431,13 @@ {-# INLINE mconcat #-} mconcat = foldr mappend mempty +-- | For long or infinite lists use 'fromList' because it uses 'LazyByteString' otherwise use 'fromListN' which uses 'StrictByteString'.+instance IsList Builder where+ type Item Builder = Word8+ fromList = lazyByteString . fromList+ fromListN n = byteString . fromListN n+ toList = toList . toLazyByteString+ -- | Flush the current buffer. This introduces a chunk boundary. {-# INLINE flush #-} flush :: Builder@@ -795,24 +820,24 @@ | ope `minusPtr` op < minFree = return $ bufferFull minFree op k | otherwise = k br --- | Copy the bytes from a 'BufferRange' into the output stream.-wrappedBytesCopyStep :: BufferRange -- ^ Input 'BufferRange'.+-- | Copy the bytes from a 'S.StrictByteString' into the output stream.+wrappedBytesCopyStep :: S.StrictByteString -- ^ Input 'S.StrictByteString'. -> BuildStep a -> BuildStep a-wrappedBytesCopyStep (BufferRange ip0 ipe) k =- go ip0+-- See Note [byteStringCopyStep and wrappedBytesCopyStep]+wrappedBytesCopyStep bs0 k =+ go bs0 where- go !ip (BufferRange op ope)+ go !bs@(S.BS ifp inpRemaining) (BufferRange op ope) | inpRemaining <= outRemaining = do- copyBytes op ip inpRemaining+ S.unsafeWithForeignPtr ifp $ \ip -> copyBytes op ip inpRemaining let !br' = BufferRange (op `plusPtr` inpRemaining) ope k br' | otherwise = do- copyBytes op ip outRemaining- let !ip' = ip `plusPtr` outRemaining- return $ bufferFull 1 ope (go ip')+ S.unsafeWithForeignPtr ifp $ \ip -> copyBytes op ip outRemaining+ let !bs' = S.unsafeDrop outRemaining bs+ return $ bufferFull 1 ope (go bs') where outRemaining = ope `minusPtr` op- inpRemaining = ipe `minusPtr` ip -- Strict ByteStrings@@ -833,7 +858,7 @@ byteStringThreshold maxCopySize = \bs -> builder $ step bs where- step bs@(S.BS _ len) !k br@(BufferRange !op _)+ step bs@(S.BS _ len) k br@(BufferRange !op _) | len <= maxCopySize = byteStringCopyStep bs k br | otherwise = return $ insertChunk op bs k @@ -847,21 +872,69 @@ byteStringCopy :: S.StrictByteString -> Builder byteStringCopy = \bs -> builder $ byteStringCopyStep bs +{-+Note [byteStringCopyStep and wrappedBytesCopyStep]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+A Builder that copies the contents of an arbitrary ByteString needs a+recursive loop, since the bytes to be copied might not fit into the+first few chunk buffers provided by the driver. That loop is+implemented in 'wrappedBytesCopyStep'. But we also have a+non-recursive wrapper, 'byteStringCopyStep', which performs exactly+the first iteration of that loop, falling back to 'wrappedBytesCopyStep'+if a chunk boundary is reached before the entire ByteString is copied.++This is very strange! Why do we do this? Perhaps mostly for+historical reasons. But sadly, changing this to use a single+recursive loop regresses the benchmark 'foldMap byteStringCopy' by+about 30% as of 2024, in one of two ways:++ 1. If the continuation 'k' is taken as an argument of the+ inner copying loop, it remains an unknown function call.+ So for each bytestring copied, that continuation must be+ entered later via a gen-apply function, which incurs dozens+ of cycles of extra overhead.+ 2. If the continuation 'k' is lifted out of the inner copying+ loop, it becomes a free variable. And after a bit of+ inlining, there will be no unknown function call. But, if+ the continuation function has any free variables, these+ become free variables of the inner copying loop, which+ prevent the loop from floating out. (In the actual+ benchmark, the tail of the list of bytestrings to copy is+ such a free variable of the continuation.) As a result,+ the inner copying loop becomes a function closure object+ rather than a top-level function. And that means a new+ inner-copying-loop function-closure-object must be+ allocated on the heap for every bytestring copied, which+ is expensive.++ In theory, GHC's late-lambda-lifting pass can clean this up by+ abstracting over the problematic free variables. But for some+ unknown reason (perhaps a bug in ghc-9.10.1) this optimization+ does not fire on the relevant benchmark code, even with a+ sufficiently high value of -fstg-lift-lams-rec-args.++++Alternatively, it is possible to avoid recursion altogether by+requesting that the next chunk be large enough to accommodate the+entire remainder of the input when a chunk boundary is reached.+But:+ * For very large ByteStrings, this may incur unwanted latency.+ * Large next-chunk-size requests have caused breakage downstream+ in the past. See also https://github.com/yesodweb/wai/issues/894+-}+ {-# INLINE byteStringCopyStep #-} byteStringCopyStep :: S.StrictByteString -> BuildStep a -> BuildStep a-byteStringCopyStep (S.BS ifp isize) !k0 br0@(BufferRange op ope)- -- Ensure that the common case is not recursive and therefore yields- -- better code.- | op' <= ope = do copyBytes op ip isize- touchForeignPtr ifp- k0 (BufferRange op' ope)- | otherwise = wrappedBytesCopyStep (BufferRange ip ipe) k br0+-- See Note [byteStringCopyStep and wrappedBytesCopyStep]+byteStringCopyStep bs@(S.BS ifp isize) k br@(BufferRange op ope)+ | isize <= osize = do+ S.unsafeWithForeignPtr ifp $ \ip -> copyBytes op ip isize+ k (BufferRange op' ope)+ | otherwise = wrappedBytesCopyStep bs k br where+ osize = ope `minusPtr` op op' = op `plusPtr` isize- ip = unsafeForeignPtrToPtr ifp- ipe = ip `plusPtr` isize- k br = do touchForeignPtr ifp -- input consumed: OK to release here- k0 br -- | Construct a 'Builder' that always inserts the 'S.StrictByteString' -- directly as a chunk.@@ -969,14 +1042,6 @@ ------------------------------------------------------------------------------ -- | A buffer allocation strategy for executing 'Builder's.---- The strategy------ > 'AllocationStrategy' firstBufSize bufSize trim------ states that the first buffer is of size @firstBufSize@, all following buffers--- are of size @bufSize@, and a buffer of size @n@ filled with @k@ bytes should--- be trimmed iff @trim k n@ is 'True'. data AllocationStrategy = AllocationStrategy (Maybe (Buffer, Int) -> IO Buffer) {-# UNPACK #-} !Int@@ -987,11 +1052,20 @@ {-# INLINE customStrategy #-} customStrategy :: (Maybe (Buffer, Int) -> IO Buffer)- -- ^ Buffer allocation function. If 'Nothing' is given, then a new first- -- buffer should be allocated. If @'Just' (oldBuf, minSize)@ is given,- -- then a buffer with minimal size @minSize@ must be returned. The- -- strategy may reuse the @oldBuf@, if it can guarantee that this- -- referentially transparent and @oldBuf@ is large enough.+ -- ^ Buffer allocation function.+ --+ -- * If 'Nothing' is given, then a new first buffer should be allocated.+ --+ -- * If @'Just' (oldBuf, minSize)@ is given, then a buffer with minimal+ -- size @minSize@ must be returned. The strategy may reuse @oldBuf@ only if+ -- @oldBuf@ is large enough and the consumer can guarantee that this will+ -- not result in a violation of referential transparency.+ --+ -- /Warning:/ for multithreaded programs, it is generally unsafe to reuse+ -- buffers when using the consumers of 'Builder' in this package. For+ -- example, if 'toLazyByteStringWith' is called with an+ -- 'AllocationStrategy' that reuses buffers, evaluating the result by+ -- multiple threads simultaneously may lead to corrupted output. -> Int -- ^ Default buffer size. -> (Int -> Int -> Bool)@@ -1039,19 +1113,27 @@ nextBuffer Nothing = newBuffer $ sanitize firstSize nextBuffer (Just (_, minSize)) = newBuffer minSize +-- | Execute a 'Builder' and return the generated chunks as a 'L.LazyByteString'.+-- The work is performed lazy, i.e., only when a chunk of the 'L.LazyByteString'+-- is forced.+{-# NOINLINE toLazyByteString #-} -- ensure code is shared+toLazyByteString :: Builder -> L.LazyByteString+toLazyByteString = toLazyByteStringWith+ (safeStrategy L.smallChunkSize L.defaultChunkSize) L.Empty+ -- | /Heavy inlining./ Execute a 'Builder' with custom execution parameters. -- -- This function is inlined despite its heavy code-size to allow fusing with -- the allocation strategy. For example, the default 'Builder' execution--- function 'Data.ByteString.Builder.toLazyByteString' is defined as follows.+-- function 'Data.ByteString.Builder.Internal.toLazyByteString' is defined as follows. -- -- @ -- {-\# NOINLINE toLazyByteString \#-} -- toLazyByteString =--- toLazyByteStringWith ('safeStrategy' 'L.smallChunkSize' 'L.defaultChunkSize') L.empty+-- toLazyByteStringWith ('safeStrategy' 'L.smallChunkSize' 'L.defaultChunkSize') L.Empty -- @ ----- where @L.empty@ is the zero-length 'L.LazyByteString'.+-- where @L.Empty@ is the zero-length 'L.LazyByteString'. -- -- In most cases, the parameters used by 'Data.ByteString.Builder.toLazyByteString' give good -- performance. A sub-performing case of 'Data.ByteString.Builder.toLazyByteString' is executing short@@ -1059,7 +1141,7 @@ -- 4kb buffer and the trimming cost dominate the cost of executing the -- 'Builder'. You can avoid this problem using ----- >toLazyByteStringWith (safeStrategy 128 smallChunkSize) L.empty+-- >toLazyByteStringWith (safeStrategy 128 smallChunkSize) L.Empty -- -- This reduces the allocation and trimming overhead, as all generated -- 'L.LazyByteString's fit into the first buffer and there is no trimming@@ -1115,7 +1197,7 @@ -- Checking for empty case avoids allocating 'n-1' empty -- buffers for 'n' insertChunkH right after each other. if isEmpty- then fill nextStep (Buffer fpbuf (BufferRange pbuf pe))+ then fill nextStep buf else do buf' <- nextBuffer (Just (buf, bufSize)) fill nextStep buf' @@ -1127,9 +1209,9 @@ | trim chunkSize size = do bs <- S.createFp chunkSize $ \fpbuf' -> S.memcpyFp fpbuf' fpbuf chunkSize- -- Instead of allocating a new buffer after trimming,- -- we re-use the old buffer and consider it empty.- return $ Yield1 bs (mkCIOS True)+ -- It is not safe to re-use the old buffer (see #690),+ -- so we allocate a new buffer after trimming.+ return $ Yield1 bs (mkCIOS False) | otherwise = return $ Yield1 (S.BS fpbuf chunkSize) (mkCIOS False) where
Data/ByteString/Builder/Prim.hs view
@@ -1,7 +1,5 @@-{-# LANGUAGE BangPatterns, ScopedTypeVariables #-}-{-# LANGUAGE MagicHash, UnboxedTuples, PatternGuards #-}-{-# OPTIONS_GHC -fno-warn-unused-imports #-} {-# LANGUAGE Trustworthy #-}+ {- | Copyright : (c) 2010-2011 Simon Meier (c) 2010 Jasper van der Jeugt License : BSD3-style (see LICENSE)@@ -457,17 +455,14 @@ import qualified Data.ByteString.Internal as S import qualified Data.ByteString.Lazy.Internal as L -import Data.Monoid-import Data.Char (chr, ord)-import Control.Monad ((<=<), unless)+import Data.Char (ord) import Data.ByteString.Builder.Prim.Internal hiding (size, sizeBound)-import qualified Data.ByteString.Builder.Prim.Internal as I (size, sizeBound)+import qualified Data.ByteString.Builder.Prim.Internal as I import Data.ByteString.Builder.Prim.Binary import Data.ByteString.Builder.Prim.ASCII import Foreign-import Foreign.C.Types import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr) import GHC.Word (Word8 (..)) import GHC.Exts
Data/ByteString/Builder/Prim/ASCII.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE ScopedTypeVariables #-} -- | Copyright : (c) 2010 Jasper Van der Jeugt -- (c) 2010 - 2011 Simon Meier -- License : BSD3-style (see LICENSE)
Data/ByteString/Builder/Prim/Binary.hs view
@@ -1,7 +1,5 @@ {-# LANGUAGE Trustworthy #-} -{-# LANGUAGE TypeApplications #-}- -- | Copyright : (c) 2010-2011 Simon Meier -- License : BSD3-style (see LICENSE) --
Data/ByteString/Builder/Prim/Internal.hs view
@@ -1,6 +1,8 @@-{-# LANGUAGE ScopedTypeVariables, CPP #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE Unsafe #-}+ {-# OPTIONS_HADDOCK not-home #-}+ -- | -- Copyright : 2010-2011 Simon Meier, 2010 Jasper van der Jeugt -- License : BSD3-style (see LICENSE)
Data/ByteString/Builder/Prim/Internal/Base16.hs view
@@ -1,5 +1,5 @@-{-# LANGUAGE MagicHash #-} {-# LANGUAGE CPP #-}+ -- | -- Copyright : (c) 2011 Simon Meier -- License : BSD3-style (see LICENSE)
Data/ByteString/Builder/RealFloat/D2S.hs view
@@ -1,7 +1,5 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE ScopedTypeVariables #-}+ -- | -- Module : Data.ByteString.Builder.RealFloat.D2S -- Copyright : (c) Lawrence Wu 2021
Data/ByteString/Builder/RealFloat/F2S.hs view
@@ -1,6 +1,5 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE BangPatterns, MagicHash #-}+ -- | -- Module : Data.ByteString.Builder.RealFloat.F2S -- Copyright : (c) Lawrence Wu 2021
Data/ByteString/Builder/RealFloat/Internal.hs view
@@ -1,7 +1,7 @@-{-# LANGUAGE ScopedTypeVariables, ExplicitForAll #-}-{-# LANGUAGE BangPatterns, MagicHash, UnboxedTuples #-} {-# LANGUAGE CPP #-}+ {-# LANGUAGE RecordWildCards #-}+ -- | -- Module : Data.ByteString.Builder.RealFloat.Internal -- Copyright : (c) Lawrence Wu 2021
Data/ByteString/Builder/RealFloat/TableGenerator.hs view
@@ -1,7 +1,3 @@-{-# LANGUAGE ExplicitForAll #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE BangPatterns, MagicHash, UnboxedTuples #-} -- | -- Module : Data.ByteString.Builder.RealFloat.TableGenerator -- Copyright : (c) Lawrence Wu 2021
Data/ByteString/Char8.hs view
@@ -1,8 +1,9 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE MagicHash #-}-{-# OPTIONS_HADDOCK prune #-} {-# LANGUAGE Trustworthy #-}++{-# OPTIONS_HADDOCK prune #-} {-# OPTIONS_GHC -Wno-deprecations #-}+ -- We use the deprecated Data.ByteString.{hGetLine,getLine} to+ -- define the not-deprecated Char8 versions of the same functions. -- | -- Module : Data.ByteString.Char8
Data/ByteString/Internal/Pure.hs view
@@ -1,7 +1,3 @@-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE MultiWayIf #-}- -- Enable yields to make `isValidUtf8` safe to use on large inputs. {-# OPTIONS_GHC -fno-omit-yields #-}
Data/ByteString/Internal/Type.hs view
@@ -1,17 +1,14 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE Unsafe #-} -{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE PatternSynonyms #-}+{-# OPTIONS_HADDOCK not-home #-}+ {-# LANGUAGE TemplateHaskellQuotes #-}-{-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE UnliftedFFITypes #-} {-# LANGUAGE ViewPatterns #-} -{-# OPTIONS_HADDOCK not-home #-}+#include "bytestring-cpp-macros.h" -- | -- Module : Data.ByteString.Internal.Type@@ -148,10 +145,7 @@ import Control.Monad ((<$!>)) #endif -#if !MIN_VERSION_base(4,13,0)-import Data.Semigroup (Semigroup ((<>)))-#endif-import Data.Semigroup (Semigroup (sconcat, stimes))+import Data.Semigroup (Semigroup (..)) import Data.List.NonEmpty (NonEmpty ((:|))) import Control.DeepSeq (NFData(rnf))@@ -166,16 +160,13 @@ import Data.Data (Data(..), mkConstr, mkNoRepType, Constr, DataType, Fixity(Prefix), constrIndex) -import GHC.Base (nullAddr#,realWorld#,unsafeChr)-import GHC.Exts (IsList(..), Addr#, minusAddr#, ByteArray#)-import GHC.CString (unpackCString#)-import GHC.Magic (runRW#, lazy)+import GHC.Base (nullAddr#,realWorld#,unsafeChr,unpackCString#)+import GHC.Exts (IsList(..), Addr#, minusAddr#, ByteArray#, runRW#, lazy) -#define TIMES_INT_2_AVAILABLE MIN_VERSION_ghc_prim(0,7,0)-#if TIMES_INT_2_AVAILABLE-import GHC.Prim (timesInt2#)+#if HS_timesInt2_PRIMOP_AVAILABLE+import GHC.Exts (timesInt2#) #else-import GHC.Prim ( timesWord2#+import GHC.Exts ( timesWord2# , or# , uncheckedShiftRL# , int2Word#@@ -186,34 +177,30 @@ import GHC.IO (IO(IO)) import GHC.ForeignPtr (ForeignPtr(ForeignPtr)-#if __GLASGOW_HASKELL__ < 900+#if !HS_cstringLength_AND_FinalPtr_AVAILABLE , 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#)+#if HS_cstringLength_AND_FinalPtr_AVAILABLE+import GHC.Exts (cstringLength#) import GHC.ForeignPtr (ForeignPtrContents(FinalPtr)) #else import GHC.Ptr (Ptr(..)) #endif -import GHC.Types (Int (..))+import GHC.Int (Int (..)) -#if MIN_VERSION_base(4,15,0)+#if HS_unsafeWithForeignPtr_AVAILABLE 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)+#if !HS_unsafeWithForeignPtr_AVAILABLE unsafeWithForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b unsafeWithForeignPtr = withForeignPtr #endif@@ -221,25 +208,6 @@ -- 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)@@ -337,9 +305,7 @@ 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@@ -396,6 +362,7 @@ -- | @since 0.11.2.0 instance TH.Lift ByteString where #if MIN_VERSION_template_haskell(2,16,0)+-- template-haskell-2.16 first ships with ghc-8.10 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))@@ -406,8 +373,10 @@ #endif #if MIN_VERSION_template_haskell(2,17,0)+-- template-haskell-2.17 first ships with ghc-9.0 liftTyped = TH.unsafeCodeCoerce . TH.lift #elif MIN_VERSION_template_haskell(2,16,0)+-- template-haskell-2.16 first ships with ghc-8.10 liftTyped = TH.unsafeTExpCoerce . TH.lift #endif @@ -483,7 +452,7 @@ -- unsafePackAddress :: Addr# -> IO ByteString unsafePackAddress addr# = do-#if __GLASGOW_HASKELL__ >= 811+#if HS_cstringLength_AND_FinalPtr_AVAILABLE unsafePackLenAddress (I# (cstringLength# addr#)) addr# #else l <- c_strlen (Ptr addr#)@@ -499,7 +468,7 @@ -- @since 0.11.2.0 unsafePackLenAddress :: Int -> Addr# -> IO ByteString unsafePackLenAddress len addr# = do-#if __GLASGOW_HASKELL__ >= 811+#if HS_cstringLength_AND_FinalPtr_AVAILABLE return (BS (ForeignPtr addr# FinalPtr) len) #else p <- newForeignPtr_ (Ptr addr#)@@ -516,7 +485,7 @@ -- @since 0.11.1.0 unsafePackLiteral :: Addr# -> ByteString unsafePackLiteral addr# =-#if __GLASGOW_HASKELL__ >= 811+#if HS_cstringLength_AND_FinalPtr_AVAILABLE unsafePackLenLiteral (I# (cstringLength# addr#)) addr# #else let len = accursedUnutterablePerformIO (c_strlen (Ptr addr#))@@ -533,7 +502,7 @@ -- @since 0.11.2.0 unsafePackLenLiteral :: Int -> Addr# -> ByteString unsafePackLenLiteral len addr# =-#if __GLASGOW_HASKELL__ >= 811+#if HS_cstringLength_AND_FinalPtr_AVAILABLE BS (ForeignPtr addr# FinalPtr) len #else -- newForeignPtr_ allocates a MutVar# internally. If that MutVar#@@ -626,7 +595,7 @@ -- | The 0 pointer. Used to indicate the empty Bytestring. nullForeignPtr :: ForeignPtr Word8-#if __GLASGOW_HASKELL__ >= 811+#if HS_cstringLength_AND_FinalPtr_AVAILABLE nullForeignPtr = ForeignPtr nullAddr# FinalPtr #else nullForeignPtr = ForeignPtr nullAddr# (error "nullForeignPtr")@@ -1044,7 +1013,7 @@ checkedMultiply :: String -> Int -> Int -> Int {-# INLINE checkedMultiply #-} checkedMultiply fun !x@(I# x#) !y@(I# y#) = assert (min x y >= 0) $-#if TIMES_INT_2_AVAILABLE+#if HS_timesInt2_PRIMOP_AVAILABLE case timesInt2# x# y# of (# 0#, _, result #) -> I# result _ -> overflowError fun
Data/ByteString/Lazy.hs view
@@ -1,10 +1,6 @@-{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}-{-# OPTIONS_HADDOCK prune #-} {-# LANGUAGE Trustworthy #-} -{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_HADDOCK prune #-} -- | -- Module : Data.ByteString.Lazy@@ -993,7 +989,7 @@ -- | Returns the longest (possibly empty) suffix of elements which __do not__ -- satisfy the predicate and the remainder of the string. ----- 'breakEnd' @p@ is equivalent to @'spanEnd' (not . p)@ and to @('takeWhileEnd' (not . p) &&& 'dropWhileEnd' (not . p))@.+-- 'breakEnd' @p@ is equivalent to @'spanEnd' (not . p)@ and to @('dropWhileEnd' (not . p) &&& 'takeWhileEnd' (not . p))@. -- -- @since 0.11.2.0 breakEnd :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)@@ -1063,7 +1059,7 @@ -- | Returns the longest (possibly empty) suffix of elements -- satisfying the predicate and the remainder of the string. ----- 'spanEnd' @p@ is equivalent to @'breakEnd' (not . p)@ and to @('takeWhileEnd' p &&& 'dropWhileEnd' p)@.+-- 'spanEnd' @p@ is equivalent to @'breakEnd' (not . p)@ and to @('dropWhileEnd' p &&& 'takeWhileEnd' p)@. -- -- We have --@@ -1095,6 +1091,7 @@ comb acc [s] Empty = [revChunks (s:acc)] comb acc [s] (Chunk c cs) = comb (s:acc) (S.splitWith p c) cs comb acc (s:ss) cs = revChunks (s:acc) : comb [] ss cs+ comb _ [] _ = error "Strict splitWith returned [] for nonempty input" {-# INLINE splitWith #-} -- | /O(n)/ Break a 'ByteString' into pieces separated by the byte@@ -1122,6 +1119,7 @@ comb acc [s] Empty = [revChunks (s:acc)] comb acc [s] (Chunk c cs) = comb (s:acc) (S.split w c) cs comb acc (s:ss) cs = revChunks (s:acc) : comb [] ss cs+ comb _ [] _ = error "Strict split returned [] for nonempty input" {-# INLINE split #-} -- | The 'group' function takes a ByteString and returns a list of@@ -1441,16 +1439,22 @@ zipWith _ _ Empty = [] zipWith f (Chunk a as) (Chunk b bs) = go a as b bs where- go x xs y ys = f (S.unsafeHead x) (S.unsafeHead y)- : to (S.unsafeTail x) xs (S.unsafeTail y) ys+ -- This loop is written in a slightly awkward way but ensures we+ -- don't have to allocate any 'Chunk' objects to pass to a recursive+ -- call. We have in some sense performed SpecConstr manually.+ go !x xs !y ys = let+ -- Creating a thunk for reading one byte would+ -- be wasteful, so we evaluate these eagerly.+ -- See also #558 for a similar issue with uncons.+ !xHead = S.unsafeHead x+ !yHead = S.unsafeHead y+ in f xHead yHead : to (S.unsafeTail x) xs (S.unsafeTail y) ys - to x Empty _ _ | S.null x = []- to _ _ y Empty | S.null y = []- to x xs y ys | not (S.null x)- && not (S.null y) = go x xs y ys- to x xs _ (Chunk y' ys) | not (S.null x) = go x xs y' ys- to _ (Chunk x' xs) y ys | not (S.null y) = go x' xs y ys- to _ (Chunk x' xs) _ (Chunk y' ys) = go x' xs y' ys+ to !x xs !y ys+ | Chunk x' xs' <- chunk x xs+ , Chunk y' ys' <- chunk y ys+ = go x' xs' y' ys'+ | otherwise = [] -- | A specialised version of `zipWith` for the common case of a -- simultaneous map over two ByteStrings, to build a 3rd.
Data/ByteString/Lazy/Char8.hs view
@@ -1,6 +1,5 @@-{-# LANGUAGE BangPatterns #-} {-# LANGUAGE Trustworthy #-}-{-# LANGUAGE TypeApplications #-}+ {-# OPTIONS_HADDOCK prune #-} -- |
Data/ByteString/Lazy/Internal.hs view
@@ -1,16 +1,10 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE DeriveLift #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE Unsafe #-} -#ifdef HS_BYTESTRING_ASSERTIONS-{-# LANGUAGE PatternSynonyms #-}-#endif- {-# OPTIONS_HADDOCK not-home #-} +{-# LANGUAGE TypeFamilies #-}+ -- | -- Module : Data.ByteString.Lazy.Internal -- Copyright : (c) Don Stewart 2006-2008@@ -59,11 +53,7 @@ import Data.Word (Word8) import Foreign.Storable (Storable(sizeOf)) -#if MIN_VERSION_base(4,13,0)-import Data.Semigroup (Semigroup (sconcat, stimes))-#else-import Data.Semigroup (Semigroup ((<>), sconcat, stimes))-#endif+import Data.Semigroup (Semigroup (..)) import Data.List.NonEmpty (NonEmpty ((:|))) import Control.DeepSeq (NFData, rnf) @@ -355,7 +345,6 @@ -- Copy the data goCopy Empty !_ = return ()- goCopy (Chunk (S.BS _ 0 ) cs) !ptr = goCopy cs ptr goCopy (Chunk (S.BS fp len) cs) !ptr = do S.memcpyFp ptr fp len goCopy cs (ptr `S.plusForeignPtr` len)
Data/ByteString/Lazy/ReadInt.hs view
@@ -1,9 +1,4 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE MultiWayIf #-}-{-# LANGUAGE PatternSynonyms #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-} -- This file is also included by "Data.ByteString.ReadInt", after defining -- "BYTESTRING_STRICT". The two modules share much of their code, but
Data/ByteString/Lazy/ReadNat.hs view
@@ -1,9 +1,4 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE MultiWayIf #-}-{-# LANGUAGE PatternSynonyms #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-} -- This file is included by "Data.ByteString.ReadInt", after defining -- "BYTESTRING_STRICT". The two modules are largely identical, except for the
Data/ByteString/Short/Internal.hs view
@@ -1,27 +1,13 @@-{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DeriveLift #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE MultiWayIf #-}-{-# LANGUAGE PatternSynonyms #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TemplateHaskellQuotes #-}-{-# LANGUAGE TupleSections #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE UnboxedTuples #-}-{-# LANGUAGE UnliftedFFITypes #-} {-# LANGUAGE Unsafe #-}-{-# LANGUAGE ViewPatterns #-} {-# OPTIONS_HADDOCK not-home #-}- {-# OPTIONS_GHC -fexpose-all-unfoldings #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UnliftedFFITypes #-}+ #include "bytestring-cpp-macros.h" -- |@@ -197,12 +183,6 @@ ( CString , CStringLen )-#if !HS_compareByteArrays_PRIMOP_AVAILABLE && !PURE_HASKELL-import Foreign.C.Types- ( CSize(..)- , CInt(..)- )-#endif import Foreign.Marshal.Alloc ( allocaBytes ) import Foreign.Storable@@ -215,13 +195,9 @@ , byteArrayContents# , unsafeCoerce# , copyMutableByteArray#-#if HS_isByteArrayPinned_PRIMOP_AVAILABLE , isByteArrayPinned# , isTrue#-#endif-#if HS_compareByteArrays_PRIMOP_AVAILABLE , compareByteArrays#-#endif , sizeofByteArray# , indexWord8Array#, indexCharArray# , writeWord8Array#@@ -290,11 +266,7 @@ -- but now it is a bundled pattern synonym, provided as a compatibility shim. pattern SBS :: ByteArray# -> ShortByteString pattern SBS x = ShortByteString (ByteArray x)-#if __GLASGOW_HASKELL__ >= 802 {-# COMPLETE SBS #-}--- To avoid spurious warnings from CI with ghc-8.0, we internally--- use view patterns like (unSBS -> ba#) instead of using (SBS ba#)-#endif -- | Lexicographic order. instance Ord ShortByteString where@@ -344,7 +316,7 @@ -- | /O(1)/ The length of a 'ShortByteString'. length :: ShortByteString -> Int-length (unSBS -> barr#) = I# (sizeofByteArray# barr#)+length (SBS barr#) = I# (sizeofByteArray# barr#) -- | /O(1)/ Test whether a 'ShortByteString' is empty. null :: ShortByteString -> Bool@@ -393,9 +365,6 @@ asBA :: ShortByteString -> ByteArray asBA (ShortByteString ba) = ba -unSBS :: ShortByteString -> ByteArray#-unSBS (ShortByteString (ByteArray ba#)) = ba#- create :: Int -> (forall s. MutableByteArray s -> ST s ()) -> ShortByteString create len fill = assert (len >= 0) $ runST $ do@@ -462,11 +431,7 @@ {-# INLINE createAndTrim2 #-} isPinned :: ByteArray# -> Bool-#if HS_isByteArrayPinned_PRIMOP_AVAILABLE isPinned ba# = isTrue# (isByteArrayPinned# ba#)-#else-isPinned _ = False-#endif ------------------------------------------------------------------------ -- Conversion to and from ByteString@@ -488,7 +453,7 @@ -- | /O(n)/. Convert a 'ShortByteString' into a 'ByteString'. -- fromShort :: ShortByteString -> ByteString-fromShort sbs@(unSBS -> b#)+fromShort sbs@(SBS b#) | isPinned b# = BS inPlaceFp len | otherwise = BS.unsafeCreateFp len $ \fp -> BS.unsafeWithForeignPtr fp $ \p -> copyToPtr sbs 0 p len@@ -1505,7 +1470,7 @@ -- -- @since 0.11.3.0 elemIndex :: Word8 -> ShortByteString -> Maybe Int-elemIndex c = \sbs@(unSBS -> ba#) -> do+elemIndex c = \sbs@(SBS ba#) -> do let l = length sbs accursedUnutterablePerformIO $ do !s <- c_elem_index ba# c (fromIntegral l)@@ -1523,7 +1488,7 @@ -- -- @since 0.11.3.0 count :: Word8 -> ShortByteString -> Int-count w = \sbs@(unSBS -> ba#) -> accursedUnutterablePerformIO $+count w = \sbs@(SBS ba#) -> accursedUnutterablePerformIO $ fromIntegral <$> BS.c_count_ba ba# (fromIntegral $ length sbs) w -- | /O(n)/ The 'findIndex' function takes a predicate and a 'ShortByteString' and@@ -1654,25 +1619,9 @@ -> Int -- ^ offset for array 2 -> Int -- ^ length to compare -> Int -- ^ like memcmp-#if HS_compareByteArrays_PRIMOP_AVAILABLE compareByteArraysOff (ByteArray ba1#) (I# ba1off#) (ByteArray ba2#) (I# ba2off#) (I# len#) = I# (compareByteArrays# ba1# ba1off# ba2# ba2off# len#)-#else-compareByteArraysOff (ByteArray ba1#) ba1off (ByteArray ba2#) ba2off len =- assert (ba1off + len <= (I# (sizeofByteArray# ba1#)))- $ assert (ba2off + len <= (I# (sizeofByteArray# ba2#)))- $ fromIntegral $ accursedUnutterablePerformIO $- c_memcmp_ByteArray ba1#- ba1off- ba2#- ba2off- (fromIntegral len) --foreign import ccall unsafe "static sbs_memcmp_off"- c_memcmp_ByteArray :: ByteArray# -> Int -> ByteArray# -> Int -> CSize -> IO CInt-#endif- ------------------------------------------------------------------------ -- Primop replacements @@ -1751,7 +1700,7 @@ -- -- @since 0.11.3.0 isValidUtf8 :: ShortByteString -> Bool-isValidUtf8 sbs@(unSBS -> ba#) = accursedUnutterablePerformIO $ do+isValidUtf8 sbs@(SBS ba#) = accursedUnutterablePerformIO $ do let n = length sbs -- Use a safe FFI call for large inputs to avoid GC synchronization pauses -- in multithreaded contexts.
Data/ByteString/Unsafe.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE MagicHash #-} {-# LANGUAGE Unsafe #-} -- |@@ -48,7 +47,6 @@ import Data.ByteString.Internal import Foreign.ForeignPtr (newForeignPtr_, newForeignPtr, withForeignPtr)-import Foreign.Ptr (Ptr, castPtr) import Foreign.Storable (Storable(..)) import Foreign.C.String (CString, CStringLen)@@ -60,8 +58,8 @@ import qualified Foreign.ForeignPtr as FC (finalizeForeignPtr) import qualified Foreign.Concurrent as FC (newForeignPtr) -import GHC.Prim (Addr#)-import GHC.Ptr (Ptr(..))+import GHC.Exts (Addr#)+import GHC.Ptr (Ptr(..), castPtr) -- --------------------------------------------------------------------- --
Data/ByteString/Utils/ByteOrder.hs view
@@ -1,13 +1,13 @@ {-# LANGUAGE CPP #-} +#include "MachDeps.h"+ -- | Why does this module exist? There is "GHC.ByteOrder" in base. -- But that module is /broken/ until base-4.14/ghc-8.10, so we -- can't rely on it until we drop support for older ghcs. -- See https://gitlab.haskell.org/ghc/ghc/-/issues/20338 -- and https://gitlab.haskell.org/ghc/ghc/-/issues/18445 -#include "MachDeps.h"- module Data.ByteString.Utils.ByteOrder ( ByteOrder(..) , hostByteOrder@@ -15,9 +15,7 @@ , whenBigEndian ) where -data ByteOrder- = LittleEndian- | BigEndian+import GHC.ByteOrder (ByteOrder(..)) hostByteOrder :: ByteOrder hostByteOrder =
Data/ByteString/Utils/UnalignedAccess.hs view
@@ -1,3 +1,7 @@+{-# LANGUAGE CPP #-}++#include "bytestring-cpp-macros.h"+ -- | -- Module : Data.ByteString.Utils.UnalignedAccess -- Copyright : (c) Matthew Craven 2023-2024@@ -7,13 +11,6 @@ -- Portability : non-portable -- -- Primitives for reading and writing at potentially-unaligned memory locations--{-# LANGUAGE CPP #-}--{-# LANGUAGE MagicHash #-}-{-# LANGUAGE UnboxedTuples #-}--#include "bytestring-cpp-macros.h" module Data.ByteString.Utils.UnalignedAccess ( unalignedWriteU16
README.md view
@@ -15,8 +15,8 @@ Requirements: - * Cabal 1.10 or greater- * GHC 8.0 or greater+ * Cabal 2.2 or greater+ * GHC 8.4 or greater ### Authors
bench/BenchAll.hs view
@@ -7,11 +7,6 @@ -- Portability : tested on GHC only -- -{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE PackageImports #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE MagicHash #-}- module Main (main) where import Data.Foldable (foldMap)@@ -19,9 +14,11 @@ import Data.Semigroup import Data.String import Test.Tasty.Bench+ import Prelude hiding (words) import qualified Data.List as List import Control.DeepSeq+import Control.Exception import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as S8@@ -29,16 +26,17 @@ import qualified Data.ByteString.Lazy.Char8 as L8 import Data.ByteString.Builder-import Data.ByteString.Builder.Extra (byteStringCopy,- byteStringInsert,- intHost)-import Data.ByteString.Builder.Internal (ensureFree)+import qualified Data.ByteString.Builder.Extra as Extra+import qualified Data.ByteString.Builder.Internal as BI import Data.ByteString.Builder.Prim (BoundedPrim, FixedPrim, (>$<)) import qualified Data.ByteString.Builder.Prim as P import qualified Data.ByteString.Builder.Prim.Internal as PI import Foreign+import Foreign.ForeignPtr+import qualified GHC.Exts as Exts+import GHC.Ptr (Ptr(..)) import System.Random @@ -126,16 +124,46 @@ -- benchmark wrappers --------------------- -{-# INLINE benchB #-} benchB :: String -> a -> (a -> Builder) -> Benchmark-benchB name x b =- bench (name ++" (" ++ show nRepl ++ ")") $- whnf (L.length . toLazyByteString . b) x+{-# INLINE benchB #-}+benchB name x b = benchB' (name ++" (" ++ show nRepl ++ ")") x b -{-# INLINE benchB' #-} benchB' :: String -> a -> (a -> Builder) -> Benchmark-benchB' name x b = bench name $ whnf (L.length . toLazyByteString . b) x+{-# INLINE benchB' #-}+benchB' name x mkB =+ env (BI.newBuffer BI.defaultChunkSize) $ \buf ->+ bench name $ whnfAppIO (runBuildStepOn buf . BI.runBuilder . mkB) x +benchB'_ :: String -> Builder -> Benchmark+{-# INLINE benchB'_ #-}+benchB'_ name b =+ env (BI.newBuffer BI.defaultChunkSize) $ \buf ->+ bench name $ whnfIO (runBuildStepOn buf (BI.runBuilder b))++-- | @runBuilderOn@ runs a @BuildStep@'s actions all on the same @Buffer@.+-- It is used to avoid measuring driver allocation overhead.+runBuildStepOn :: BI.Buffer -> BI.BuildStep () -> IO ()+{-# NOINLINE runBuildStepOn #-}+runBuildStepOn (BI.Buffer fp br@(BI.BufferRange op ope)) b = go b+ where+ !len = ope `minusPtr` op++ go :: BI.BuildStep () -> IO ()+ go bs = BI.fillWithBuildStep bs doneH fullH insertChunkH br++ doneH :: Ptr Word8 -> () -> IO ()+ doneH _ _ = touchForeignPtr fp+ -- 'touchForeignPtr' is adequate because the given BuildStep+ -- will always terminate. (We won't measure an infinite loop!)++ fullH :: Ptr Word8 -> Int -> BI.BuildStep () -> IO ()+ fullH _ minLen nextStep+ | len < minLen = throwIO (ErrorCall "runBuilderOn: action expects too long of a BufferRange")+ | otherwise = go nextStep++ insertChunkH :: Ptr Word8 -> S.ByteString -> BI.BuildStep () -> IO ()+ insertChunkH _ _ nextStep = go nextStep+ {-# INLINE benchBInts #-} benchBInts :: String -> ([Int] -> Builder) -> Benchmark benchBInts name = benchB name intData@@ -252,18 +280,53 @@ smallTraversalInput :: S.ByteString smallTraversalInput = S8.pack "The quick brown fox" +asciiBuf, utf8Buf, halfNullBuf, allNullBuf :: Ptr Word8+asciiBuf = Ptr "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"#+utf8Buf = Ptr "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx\xc0\x80xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"#+halfNullBuf = Ptr "\xc0\x80xx\xc0\x80x\xc0\x80\xc0\x80x\xc0\x80\xc0\x80xx\xc0\x80\xc0\x80xxx\xc0\x80x\xc0\x80x\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80xxx\xc0\x80x\xc0\x80xx\xc0\x80\xc0\x80xxxxxxxxxx\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80x\xc0\x80\xc0\x80x\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80xxx"#+allNullBuf = Ptr "\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80\xc0\x80"#++asciiLit, utf8Lit :: Ptr Word8 -> Builder+asciiLit (Ptr p#) = P.cstring p#+utf8Lit (Ptr p#) = P.cstringUtf8 p#++asciiStr, utf8Str :: String+asciiStr = "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"+utf8Str = "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx\0xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"+ main :: IO () main = do defaultMain [ bgroup "Data.ByteString.Builder" [ bgroup "Small payload"- [ benchB' "mempty" () (const mempty)- , benchB' "ensureFree 8" () (const (ensureFree 8))- , benchB' "intHost 1" 1 intHost- , benchB' "UTF-8 String (naive)" "hello world\0" fromString- , benchB' "UTF-8 String" () $ \() -> P.cstringUtf8 "hello world\0"#- , benchB' "String (naive)" "hello world!" fromString- , benchB' "String" () $ \() -> P.cstring "hello world!"#+ [ benchB'_ "mempty" mempty+ , bench "toLazyByteString mempty" $ nf toLazyByteString mempty+ , benchB'_ "empty (10000 times)" $+ stimes (10000 :: Int) (Exts.lazy BI.empty)+ , benchB'_ "ensureFree 8" (BI.ensureFree 8)+ , benchB' "intHost 1" 1 Extra.intHost+ , benchB' "UTF-8 String (12B, naive)" "hello world\0" fromString+ , benchB'_ "UTF-8 String (12B)" $ utf8Lit (Ptr "hello world\xc0\x80"#)+ , benchB' "UTF-8 String (64B, naive)" utf8Str fromString+ , benchB'_ "UTF-8 String (64B, one null)" $ utf8Lit utf8Buf+ , benchB'+ "UTF-8 String (64B, one null, no shared work)"+ utf8Buf+ utf8Lit+ , benchB'_ "UTF-8 String (64B, half nulls)" $ utf8Lit halfNullBuf+ , benchB'_ "UTF-8 String (64B, all nulls)" $ utf8Lit allNullBuf+ , benchB'+ "UTF-8 String (64B, all nulls, no shared work)"+ allNullBuf+ utf8Lit+ , benchB'+ "UTF-8 String (1 byte, no shared work)"+ (Ptr "\xc0\x80"#)+ utf8Lit+ , benchB' "ASCII String (12B, naive)" "hello world!" fromString+ , benchB'_ "ASCII String (12B)" $ asciiLit (Ptr "hello wurld!"#)+ , benchB' "ASCII String (64B, naive)" asciiStr fromString+ , benchB'_ "ASCII String (64B)" $ asciiLit asciiBuf ] , bgroup "Encoding wrappers"@@ -280,11 +343,11 @@ ] , bgroup "ByteString insertion" $ [ benchB "foldMap byteStringInsert" byteStringChunksData- (foldMap byteStringInsert)+ (foldMap Extra.byteStringInsert) , benchB "foldMap byteString" byteStringChunksData (foldMap byteString) , benchB "foldMap byteStringCopy" byteStringChunksData- (foldMap byteStringCopy)+ (foldMap Extra.byteStringCopy) ] , bgroup "Non-bounded encodings"
bench/BenchBoundsCheckFusion.hs view
@@ -8,8 +8,6 @@ -- -- Benchmark that the bounds checks fuse. -{-# LANGUAGE PackageImports, ScopedTypeVariables, BangPatterns #-}- module BenchBoundsCheckFusion (benchBoundsCheckFusion) where import Prelude hiding (words)
bench/BenchCSV.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE CPP #-}+ -- | -- Copyright : (c) 2010-2011 Simon Meier -- License : BSD3-style (see LICENSE)@@ -8,9 +10,6 @@ -- -- Running example for documentation of Data.ByteString.Builder ----{-# LANGUAGE CPP #-}-{-# LANGUAGE OverloadedStrings #-} module BenchCSV (benchCSV) where
bench/BenchIndices.hs view
@@ -6,8 +6,6 @@ -- -- Benchmark elemIndex, findIndex, elemIndices, and findIndices -{-# LANGUAGE BangPatterns #-}- module BenchIndices (benchIndices) where import Data.Foldable (foldMap)
bench/BenchReadInt.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE CPP #-}+ -- | -- Copyright : (c) 2021 Viktor Dukhovni -- License : BSD3-style (see LICENSE)@@ -6,14 +8,6 @@ -- -- Benchmark readInt and variants, readWord and variants, -- readInteger and readNatural--{-# LANGUAGE- CPP- , BangPatterns- , OverloadedStrings- , TypeApplications- , ScopedTypeVariables- #-} module BenchReadInt (benchReadInt) where
bench/BenchShort.hs view
@@ -1,7 +1,3 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE PackageImports #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE MagicHash #-} {-# LANGUAGE OverloadedStrings #-} module BenchShort (benchShort) where
bytestring.cabal view
@@ -1,5 +1,7 @@+Cabal-Version: 2.2+ Name: bytestring-Version: 0.12.1.0+Version: 0.12.2.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)@@ -41,7 +43,7 @@ . > import qualified Data.ByteString as BS -License: BSD3+License: BSD-3-Clause License-file: LICENSE Category: Data Copyright: Copyright (c) Don Stewart 2005-2009,@@ -55,17 +57,17 @@ 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.4.1,- GHC==9.2.4,+Tested-With: GHC==9.10.1,+ GHC==9.8.2,+ GHC==9.6.5,+ GHC==9.4.8,+ GHC==9.2.8, GHC==9.0.2, GHC==8.10.7, GHC==8.8.4, GHC==8.6.5,- GHC==8.4.4,- GHC==8.2.2,- GHC==8.0.2+ GHC==8.4.4 Build-Type: Simple-Cabal-Version: >= 1.10 extra-source-files: README.md Changelog.md include/bytestring-cpp-macros.h Flag pure-haskell@@ -82,65 +84,77 @@ type: git location: https://github.com/haskell/bytestring ++common language+ default-language: Haskell2010+ default-extensions:+ BangPatterns+ DeriveDataTypeable+ DeriveGeneric+ DeriveLift+ FlexibleContexts+ FlexibleInstances+ LambdaCase+ MagicHash+ MultiWayIf+ NamedFieldPuns+ PatternSynonyms+ RankNTypes+ ScopedTypeVariables+ StandaloneDeriving+ TupleSections+ TypeApplications+ TypeOperators+ UnboxedTuples+ library- build-depends: base >= 4.9 && < 5, ghc-prim, deepseq, template-haskell+ import: language+ build-depends: base >= 4.11 && < 5, ghc-prim, deepseq, template-haskell if impl(ghc < 9.4) build-depends: data-array-byte >= 0.1 && < 0.2 - exposed-modules: Data.ByteString- Data.ByteString.Char8- Data.ByteString.Unsafe- Data.ByteString.Internal- Data.ByteString.Lazy- Data.ByteString.Lazy.Char8- Data.ByteString.Lazy.Internal- Data.ByteString.Short- Data.ByteString.Short.Internal-- Data.ByteString.Builder- Data.ByteString.Builder.Extra- Data.ByteString.Builder.Prim- Data.ByteString.Builder.RealFloat+ exposed-modules: Data.ByteString+ Data.ByteString.Char8+ Data.ByteString.Unsafe+ Data.ByteString.Internal+ Data.ByteString.Lazy+ Data.ByteString.Lazy.Char8+ Data.ByteString.Lazy.Internal+ Data.ByteString.Short+ Data.ByteString.Short.Internal - -- perhaps only exposed temporarily- Data.ByteString.Builder.Internal- Data.ByteString.Builder.Prim.Internal- other-modules: Data.ByteString.Builder.ASCII- Data.ByteString.Builder.Prim.ASCII- Data.ByteString.Builder.Prim.Binary- Data.ByteString.Builder.Prim.Internal.Base16- Data.ByteString.Builder.Prim.Internal.Floating- Data.ByteString.Builder.RealFloat.F2S- Data.ByteString.Builder.RealFloat.D2S- Data.ByteString.Builder.RealFloat.Internal- Data.ByteString.Builder.RealFloat.TableGenerator- Data.ByteString.Internal.Type- Data.ByteString.Lazy.ReadInt- Data.ByteString.Lazy.ReadNat- Data.ByteString.ReadInt- Data.ByteString.ReadNat- Data.ByteString.Utils.ByteOrder- Data.ByteString.Utils.UnalignedAccess+ Data.ByteString.Builder+ Data.ByteString.Builder.Extra+ Data.ByteString.Builder.Prim+ Data.ByteString.Builder.RealFloat - default-language: Haskell2010- other-extensions: CPP,- ForeignFunctionInterface,- BangPatterns- UnliftedFFITypes,- MagicHash,- UnboxedTuples,- DeriveDataTypeable- ScopedTypeVariables- RankNTypes- NamedFieldPuns+ -- perhaps only exposed temporarily+ Data.ByteString.Builder.Internal+ Data.ByteString.Builder.Prim.Internal+ other-modules: Data.ByteString.Builder.ASCII+ Data.ByteString.Builder.Prim.ASCII+ Data.ByteString.Builder.Prim.Binary+ Data.ByteString.Builder.Prim.Internal.Base16+ Data.ByteString.Builder.Prim.Internal.Floating+ Data.ByteString.Builder.RealFloat.F2S+ Data.ByteString.Builder.RealFloat.D2S+ Data.ByteString.Builder.RealFloat.Internal+ Data.ByteString.Builder.RealFloat.TableGenerator+ Data.ByteString.Internal.Type+ Data.ByteString.Lazy.ReadInt+ Data.ByteString.Lazy.ReadNat+ Data.ByteString.ReadInt+ Data.ByteString.ReadNat+ Data.ByteString.Utils.ByteOrder+ Data.ByteString.Utils.UnalignedAccess - ghc-options: -Wall -fwarn-tabs -Wincomplete-uni-patterns- -optP -Wall -optP -Werror=undef- -O2- -fmax-simplifier-iterations=10- -fdicts-cheap- -fspec-constr-count=6+ ghc-options: -Wall -fwarn-tabs -Wincomplete-uni-patterns+ -optP-Wall -optP-Werror=undef+ -O2+ -fmax-simplifier-iterations=10+ -fdicts-cheap+ -fspec-constr-count=6 if arch(javascript) || flag(pure-haskell) cpp-options: -DPURE_HASKELL=1@@ -171,12 +185,19 @@ if os(windows) && impl(ghc < 9.3) extra-libraries: gcc + if arch(aarch64)+ -- The libffi in Apple's darwin toolchain doesn't+ -- play nice with -Wundef. Recent GHCs work around this.+ -- See also https://github.com/haskell/bytestring/issues/665+ -- and https://gitlab.haskell.org/ghc/ghc/-/issues/23568+ build-depends: base (>= 4.17.2 && < 4.18) || >= 4.18.1+ include-dirs: include- includes: fpstring.h install-includes: fpstring.h bytestring-cpp-macros.h test-suite bytestring-tests+ import: language type: exitcode-stdio-1.0 main-is: Main.hs other-modules: Builder@@ -198,18 +219,20 @@ build-depends: base, bytestring, deepseq,- ghc-prim, QuickCheck, tasty, tasty-quickcheck >= 0.8.1, template-haskell, transformers >= 0.3, syb+ ghc-options: -fwarn-unused-binds- -threaded -rtsopts- default-language: Haskell2010+ -rtsopts+ if !arch(wasm32)+ ghc-options: -threaded benchmark bytestring-bench+ import: language main-is: BenchAll.hs other-modules: BenchBoundsCheckFusion BenchCount@@ -219,7 +242,7 @@ BenchShort type: exitcode-stdio-1.0 hs-source-dirs: bench- default-language: Haskell2010+ ghc-options: -O2 "-with-rtsopts=-A32m" if impl(ghc >= 8.6) ghc-options: -fproc-alignment=64
cbits/shortbytestring.c view
@@ -4,21 +4,6 @@ #include <string.h> -int-sbs_memcmp_off(const void *s1,- size_t off1,- const void *s2,- size_t off2,- size_t n)-{- const void *s1o = s1 + off1;- const void *s2o = s2 + off2;-- int r = memcmp(s1o, s2o, n);-- return r;-}- ptrdiff_t sbs_elem_index(const void *s, uint8_t c,
include/bytestring-cpp-macros.h view
@@ -26,7 +26,7 @@ MIN_VERSION_base(4,12,0) \ && (MIN_VERSION_base(4,16,1) || HS_UNALIGNED_POKES_OK) /*-The unaligned ByteArray# primops became available with base-4.12.0,+The unaligned ByteArray# primops became available with base-4.12.0/ghc-8.6, but require an unaligned-friendly host architecture to be safe to use until ghc-9.2.2; see https://gitlab.haskell.org/ghc/ghc/-/issues/21015 */@@ -41,5 +41,10 @@ #define HS_UNALIGNED_ADDR_PRIMOPS_AVAILABLE MIN_VERSION_base(4,20,0) -#define HS_isByteArrayPinned_PRIMOP_AVAILABLE MIN_VERSION_base(4,10,0)-#define HS_compareByteArrays_PRIMOP_AVAILABLE MIN_VERSION_base(4,11,0)+#define HS_timesInt2_PRIMOP_AVAILABLE MIN_VERSION_base(4,15,0)++#define HS_cstringLength_AND_FinalPtr_AVAILABLE MIN_VERSION_base(4,15,0)+ /* These two were added in the same ghc commit and+ both primarily affect how we handle literals */++#define HS_unsafeWithForeignPtr_AVAILABLE MIN_VERSION_base(4,15,0)
tests/IsValidUtf8.hs view
@@ -1,5 +1,3 @@-{-# LANGUAGE LambdaCase #-}- module IsValidUtf8 (testSuite) where import Data.Bits (shiftR, (.&.), shiftL)
tests/Lift.hs view
@@ -1,6 +1,8 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE TemplateHaskell #-}+ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+ module Lift (testSuite) where import Test.Tasty (TestTree, testGroup)@@ -11,6 +13,9 @@ import qualified Language.Haskell.TH.Syntax as TH testSuite :: TestTree+#ifdef wasm32_HOST_ARCH+testSuite = testGroup "Skipped, requires -fexternal-interpreter" []+#else testSuite = testGroup "Lift" [ testGroup "strict" [ testProperty "normal" $@@ -60,3 +65,4 @@ #endif ] ]+#endif
tests/Properties.hs view
@@ -1,10 +1,4 @@ {-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE UnboxedTuples #-}- -- We need @AllowAmbiguousTypes@ in order to be able to use @TypeApplications@ -- to disambiguate the desired instance of class methods whose instance cannot -- be inferred from the caller's context. We would otherwise have to use@@ -456,7 +450,7 @@ P.writeFile fn x y <- P.readFile fn removeFile fn- return (x == y)+ return (x === y) prop_read_write_file_C x = ioProperty $ do (fn, h) <- openTempFile "." "prop-compiled.tmp"@@ -464,7 +458,7 @@ C.writeFile fn x y <- C.readFile fn removeFile fn- return (x == y)+ return (x === y) prop_read_write_file_L x = ioProperty $ do (fn, h) <- openTempFile "." "prop-compiled.tmp"@@ -472,7 +466,7 @@ L.writeFile fn x y <- L.readFile fn L.length y `seq` removeFile fn- return (x == y)+ return (x === y) prop_read_write_file_D x = ioProperty $ do (fn, h) <- openTempFile "." "prop-compiled.tmp"@@ -480,7 +474,7 @@ D.writeFile fn x y <- D.readFile fn D.length y `seq` removeFile fn- return (x == y)+ return (x === y) ------------------------------------------------------------------------ @@ -491,7 +485,7 @@ P.appendFile fn y z <- P.readFile fn removeFile fn- return (z == x `P.append` y)+ return (z === x `P.append` y) prop_append_file_C x y = ioProperty $ do (fn, h) <- openTempFile "." "prop-compiled.tmp"@@ -500,7 +494,7 @@ C.appendFile fn y z <- C.readFile fn removeFile fn- return (z == x `C.append` y)+ return (z === x `C.append` y) prop_append_file_L x y = ioProperty $ do (fn, h) <- openTempFile "." "prop-compiled.tmp"@@ -509,7 +503,7 @@ L.appendFile fn y z <- L.readFile fn L.length y `seq` removeFile fn- return (z == x `L.append` y)+ return (z === x `L.append` y) prop_append_file_D x y = ioProperty $ do (fn, h) <- openTempFile "." "prop-compiled.tmp"@@ -518,7 +512,7 @@ D.appendFile fn y z <- D.readFile fn D.length y `seq` removeFile fn- return (z == x `D.append` y)+ return (z === x `D.append` y) prop_packAddress = C.pack "this is a test" ==
tests/Properties/ByteString.hs view
@@ -4,11 +4,9 @@ -- License : BSD-style {-# LANGUAGE CPP #-}+ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE ViewPatterns #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}- -- We need @AllowAmbiguousTypes@ in order to be able to use @TypeApplications@ -- to disambiguate the desired instance of class methods whose instance cannot -- be inferred from the caller's context. We would otherwise have to use@@ -369,7 +367,7 @@ , testProperty "toChunks . fromChunks" $ \xs -> B.toChunks (B.fromChunks xs) === filter (/= mempty) xs , testProperty "append lazy" $- \(toElem -> c) -> B.head (B.singleton c <> undefined) === c+ \(toElem -> c) -> B.head (B.singleton c <> tooStrictErr) === c , testProperty "compareLength 1" $ \x -> B.compareLength x (B.length x) === EQ , testProperty "compareLength 2" $@@ -381,13 +379,13 @@ , testProperty "compareLength 5" $ \x (intToIndexTy -> n) -> B.compareLength x n === compare (B.length x) n , testProperty "dropEnd lazy" $- \(toElem -> c) -> B.take 1 (B.dropEnd 1 (B.singleton c <> B.singleton c <> B.singleton c <> undefined)) === B.singleton c+ \(toElem -> c) -> B.take 1 (B.dropEnd 1 (B.singleton c <> B.singleton c <> B.singleton c <> tooStrictErr)) === B.singleton c , testProperty "dropWhileEnd lazy" $- \(toElem -> c) -> B.take 1 (B.dropWhileEnd (const False) (B.singleton c <> undefined)) === B.singleton c+ \(toElem -> c) -> B.take 1 (B.dropWhileEnd (const False) (B.singleton c <> tooStrictErr)) === B.singleton c , testProperty "breakEnd lazy" $- \(toElem -> c) -> B.take 1 (fst $ B.breakEnd (const True) (B.singleton c <> undefined)) === B.singleton c+ \(toElem -> c) -> B.take 1 (fst $ B.breakEnd (const True) (B.singleton c <> tooStrictErr)) === B.singleton c , testProperty "spanEnd lazy" $- \(toElem -> c) -> B.take 1 (fst $ B.spanEnd (const False) (B.singleton c <> undefined)) === B.singleton c+ \(toElem -> c) -> B.take 1 (fst $ B.spanEnd (const False) (B.singleton c <> tooStrictErr)) === B.singleton c #endif , testProperty "length" $@@ -603,6 +601,25 @@ \f x y -> (B.zipWith f x y :: [Int]) === zipWith f (B.unpack x) (B.unpack y) , testProperty "packZipWith" $ \f x y -> B.unpack (B.packZipWith ((toElem .) . f) x y) === zipWith ((toElem .) . f) (B.unpack x) (B.unpack y)+# ifdef BYTESTRING_LAZY+ -- Don't use (===) in these laziness tests:+ -- We don't want printing the test case to fail!+ , testProperty "zip is lazy in the longer input" $ zipLazyInLongerInputTest $+ \x y -> B.zip x y == zip (B.unpack x) (B.unpack y)+ , testProperty "zipWith is lazy in the longer input" $+ \f -> zipLazyInLongerInputTest $+ \x y -> (B.zipWith f x y :: [Int]) == zipWith f (B.unpack x) (B.unpack y)+ , testProperty "packZipWith is lazy in the longer input" $+ \f -> zipLazyInLongerInputTest $+ \x y -> B.unpack (B.packZipWith ((toElem .) . f) x y) == zipWith ((toElem .) . f) (B.unpack x) (B.unpack y)+ , testProperty "zip is maximally lazy" $ \x y ->+ zip (B.unpack x) (B.unpack y) `List.isPrefixOf`+ B.zip (x <> tooStrictErr) (y <> tooStrictErr)+ , testProperty "zipWith is maximally lazy" $ \f x y ->+ zipWith f (B.unpack x) (B.unpack y) `List.isPrefixOf`+ B.zipWith @Int f (x <> tooStrictErr) (y <> tooStrictErr)+ -- (It's not clear if packZipWith is required to be maximally lazy.)+# endif , testProperty "unzip" $ \(fmap (toElem *** toElem) -> xs) -> (B.unpack *** B.unpack) (B.unzip xs) === unzip xs #endif@@ -796,4 +813,18 @@ otherwise -> Nothing where (ys, zs) = span isDigit xs+#endif++#ifdef BYTESTRING_LAZY+zipLazyInLongerInputTest+ :: Testable prop+ => (BYTESTRING_TYPE -> BYTESTRING_TYPE -> prop)+ -> BYTESTRING_TYPE -> BYTESTRING_TYPE -> Property+zipLazyInLongerInputTest fun = \x0 y0 -> let+ msg = "Input chunks are: " ++ show (B.toChunks x0, B.toChunks y0)+ (x, y) | B.length x0 <= B.length y0+ = (x0, y0 <> tooStrictErr)+ | otherwise+ = (x0 <> tooStrictErr, y0)+ in counterexample msg (fun x y) #endif
tests/QuickCheckUtils.hs view
@@ -1,8 +1,4 @@ {-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} module QuickCheckUtils@@ -11,6 +7,7 @@ , CByteString(..) , Sqrt(..) , int64OK+ , tooStrictErr ) where import Test.Tasty.QuickCheck@@ -23,6 +20,7 @@ import System.IO import Foreign.C (CChar) import GHC.TypeLits (TypeError, ErrorMessage(..))+import GHC.Stack (withFrozenCallStack, HasCallStack) import qualified Data.ByteString.Short as SB import qualified Data.ByteString as P@@ -56,6 +54,8 @@ (sizedByteString (n `div` numChunks)) + shrink = map L.fromChunks . shrink . L.toChunks+ instance CoArbitrary L.ByteString where coarbitrary s = coarbitrary (L.unpack s) @@ -136,3 +136,7 @@ -- defined in "QuickCheckUtils". int64OK :: (Arbitrary a, Show a, Testable b) => (a -> b) -> Property int64OK f = propertyForAllShrinkShow arbitrary shrink (\v -> [show v]) f++tooStrictErr :: forall a. HasCallStack => a+tooStrictErr = withFrozenCallStack $+ error "A lazy sub-expression was unexpectedly evaluated"
tests/builder/Data/ByteString/Builder/Prim/TestUtils.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE ScopedTypeVariables #-}+ -- | -- Copyright : (c) 2011 Simon Meier -- License : BSD3-style (see LICENSE)
tests/builder/Data/ByteString/Builder/Prim/Tests.hs view
@@ -1,5 +1,3 @@-{-# LANGUAGE MagicHash #-}- -- | -- Copyright : (c) 2011 Simon Meier -- License : BSD3-style (see LICENSE)
tests/builder/Data/ByteString/Builder/Tests.hs view
@@ -1,8 +1,3 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE CPP #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}- -- | -- Copyright : (c) 2011 Simon Meier -- License : BSD3-style (see LICENSE)@@ -23,7 +18,7 @@ import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Writer (WriterT, execWriterT, tell) -import Foreign (minusPtr)+import Foreign (minusPtr, castPtr, ForeignPtr, withForeignPtr, Int64) import Data.Char (chr) import Data.Bits ((.|.), shiftL)@@ -45,7 +40,6 @@ import Control.Exception (evaluate) import System.IO (openTempFile, hPutStr, hClose, hSetBinaryMode, hSetEncoding, utf8, hSetNewlineMode, noNewlineTranslation)-import Foreign (ForeignPtr, withForeignPtr, castPtr) import Foreign.C.String (withCString) import Numeric (showFFloat) import System.Posix.Internals (c_unlink)@@ -55,7 +49,8 @@ ( Arbitrary(..), oneof, choose, listOf, elements , counterexample, ioProperty, Property, testProperty , (===), (.&&.), conjoin, forAll, forAllShrink- , UnicodeString(..), NonNegative(..)+ , UnicodeString(..), NonNegative(..), Positive(..)+ , mapSize, (==>) ) import QuickCheckUtils @@ -75,7 +70,8 @@ testsASCII ++ testsFloating ++ testsChar8 ++- testsUtf8+ testsUtf8 +++ [testLaziness] ------------------------------------------------------------------------------@@ -985,4 +981,45 @@ testsUtf8 = [ testBuilderConstr "charUtf8" charUtf8_list charUtf8 , testBuilderConstr "stringUtf8" (foldMap charUtf8_list) stringUtf8+ ]++testLaziness :: TestTree+testLaziness = testGroup "Builder laziness"+ [ testProperty "byteString" $ mapSize (+ 10) $+ \bs (Positive chunkSize) ->+ let strategy = safeStrategy chunkSize chunkSize+ lbs = toLazyByteStringWith strategy L.empty+ (byteString bs <> tooStrictErr)+ in (S.length bs > max chunkSize 8) ==> L.head lbs == S.head bs+ , testProperty "byteStringCopy" $ mapSize (+ 10) $+ \bs (Positive chunkSize) ->+ let strategy = safeStrategy chunkSize chunkSize+ lbs = toLazyByteStringWith strategy L.empty+ (byteStringCopy bs <> tooStrictErr)+ in (S.length bs > max chunkSize 8) ==> L.head lbs == S.head bs+ , testProperty "byteStringInsert" $ mapSize (+ 10) $+ \bs (Positive chunkSize) ->+ let strategy = safeStrategy chunkSize chunkSize+ lbs = toLazyByteStringWith strategy L.empty+ (byteStringInsert bs <> tooStrictErr)+ in L.take (fromIntegral @Int @Int64 (S.length bs)) lbs+ == L.fromStrict bs+ , testProperty "lazyByteString" $ mapSize (+ 10) $+ \bs (Positive chunkSize) ->+ let strategy = safeStrategy chunkSize chunkSize+ lbs = toLazyByteStringWith strategy L.empty+ (lazyByteString bs <> tooStrictErr)+ in (L.length bs > fromIntegral @Int @Int64 (max chunkSize 8))+ ==> L.head lbs == L.head bs+ , testProperty "shortByteString" $ mapSize (+ 10) $+ \bs (Positive chunkSize) ->+ let strategy = safeStrategy chunkSize chunkSize+ lbs = toLazyByteStringWith strategy L.empty+ (shortByteString bs <> tooStrictErr)+ in (Sh.length bs > max chunkSize 8) ==> L.head lbs == Sh.head bs+ , testProperty "flush" $ \recipe -> let+ !(b, toLBS) = recipeComponents recipe+ !lbs1 = toLazyByteString b+ !lbs2 = L.take (L.length lbs1) (toLBS $ b <> flush <> tooStrictErr)+ in lbs1 == lbs2 ]