bytestring 0.11.2.0 → 0.12.2.0
raw patch · 56 files changed
Files
- Changelog.md +215/−0
- Data/ByteString.hs +266/−216
- Data/ByteString/Builder.hs +16/−30
- Data/ByteString/Builder/ASCII.hs +16/−30
- Data/ByteString/Builder/Extra.hs +4/−4
- Data/ByteString/Builder/Internal.hs +222/−113
- Data/ByteString/Builder/Prim.hs +23/−28
- Data/ByteString/Builder/Prim/ASCII.hs +6/−23
- Data/ByteString/Builder/Prim/Binary.hs +23/−107
- Data/ByteString/Builder/Prim/Internal.hs +8/−8
- Data/ByteString/Builder/Prim/Internal/Base16.hs +19/−22
- Data/ByteString/Builder/Prim/Internal/Floating.hs +60/−28
- Data/ByteString/Builder/RealFloat/D2S.hs +743/−731
- Data/ByteString/Builder/RealFloat/F2S.hs +104/−58
- Data/ByteString/Builder/RealFloat/Internal.hs +63/−104
- Data/ByteString/Builder/RealFloat/TableGenerator.hs +53/−35
- Data/ByteString/Char8.hs +67/−108
- Data/ByteString/Internal.hs +7/−789
- Data/ByteString/Internal/Pure.hs +418/−0
- Data/ByteString/Internal/Type.hs +1298/−0
- Data/ByteString/Lazy.hs +198/−106
- Data/ByteString/Lazy/Char8.hs +85/−156
- Data/ByteString/Lazy/Internal.hs +69/−43
- Data/ByteString/Lazy/Internal/Deque.hs +0/−65
- Data/ByteString/Lazy/ReadInt.hs +259/−0
- Data/ByteString/Lazy/ReadNat.hs +252/−0
- Data/ByteString/ReadInt.hs +3/−0
- Data/ByteString/ReadNat.hs +3/−0
- Data/ByteString/Short.hs +104/−14
- Data/ByteString/Short/Internal.hs +1777/−610
- Data/ByteString/Unsafe.hs +2/−4
- Data/ByteString/Utils/ByteOrder.hs +40/−0
- Data/ByteString/Utils/UnalignedAccess.hs +93/−0
- README.md +3/−3
- bench/BenchAll.hs +143/−30
- bench/BenchBoundsCheckFusion.hs +0/−2
- bench/BenchCSV.hs +4/−5
- bench/BenchIndices.hs +6/−8
- bench/BenchReadInt.hs +138/−0
- bench/BenchShort.hs +246/−0
- bytestring.cabal +142/−76
- cbits/aarch64/is-valid-utf8.c +76/−72
- cbits/aligned-static-hs-data.c +756/−0
- cbits/fpstring.c +37/−5
- cbits/is-valid-utf8.c +134/−48
- cbits/shortbytestring.c +21/−0
- include/bytestring-cpp-macros.h +50/−0
- tests/IsValidUtf8.hs +108/−45
- tests/Lift.hs +7/−1
- tests/Properties.hs +295/−43
- tests/Properties/ByteString.hs +251/−43
- tests/Properties/ShortByteString.hs +5/−0
- tests/QuickCheckUtils.hs +45/−6
- 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 +69/−34
Changelog.md view
@@ -1,3 +1,218 @@+[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)+ * This support is relatively un-tested and un-optimised. There may be bugs! Please report any you discover to [`bytestring`'s issue tracker](https://github.com/haskell/bytestring/issues).+ * The JavaScript back-end's limited support for the Haskell-C foreign function interface would previously result in many operations failing with errors like `ReferenceError: h$fps_count is not defined`.+ * The new `pure-haskell` package flag allows the new fallback Haskell implementations (used to support the JavaScript backend) to be used on most other platforms as well.+* Bug fixes:+ * [`stimes 0 sbs :: ShortByteString` now returns the empty `ShortByteString` instead of throwing an exception](https://github.com/haskell/bytestring/pull/611)+ * [`stimes 0 b :: Builder` now returns the empty `Builder` instead of throwing an exception](https://github.com/haskell/bytestring/pull/611)+ * [Several alignment-related bug fixes](https://github.com/haskell/bytestring/pull/587)+ * [Fix a bug in `isValidUtf8`](https://github.com/haskell/bytestring/pull/621)+ * [`sconcat @ShortByteString` is no longer terribly inefficient](https://github.com/haskell/bytestring/pull/650)+ * [Fix the type on the foreign import used for `Data.ByteString.Short.elemIndex`](https://github.com/haskell/bytestring/pull/661)+ * [Ensure that the result of `fromShort` is protected by `mkDeferredByteString`](https://github.com/haskell/bytestring/pull/662)+* Behavior changes:+ * [The `Data.Data.Data` instances for `StrictByteString` and `LazyByteString` have been changed:](https://github.com/haskell/bytestring/pull/614)+ * `toConstr` now returns the a `pack` pseudo-constructor instead of throwing an exception.+ * Due to this pseudo-constructor, `gunfold` can now be meaningfully used at these types. (Previously, it would always raise an exception.)+ * These changes allow `syb:Data.Generics.Text.gshow` to be meaningfully used at types containing `ByteString`s.+ * [A derived `instance Generic ShortByteString` has been added.](https://github.com/haskell/bytestring/pull/662)+ * [`sconcat @Builder` is now lazy in the tail of its input](https://github.com/haskell/bytestring/pull/650)+* Deprecations:+ * [`Data.ByteString.Builder.Prim.Internal.storableToF`](https://github.com/haskell/bytestring/pull/649)+* Performance improvements:+ * Various raw-binary `Builder` primitives like `intHost` or `word32BE` are much less inefficient on architectures not known to support unaligned writes. ([1](https://github.com/haskell/bytestring/pull/587), [2](https://github.com/haskell/bytestring/pull/645))+ * [Hexadecimal encoding suffers one indirection fewer](https://github.com/haskell/bytestring/pull/624)+ * [`Data.ByteString.Lazy.takeEnd` is somewhat faster](https://github.com/haskell/bytestring/pull/629)+ * [`Data.ByteString.Lazy.dropEnd` is much faster](https://github.com/haskell/bytestring/pull/629)+* Miscellaneous:+ * Various documentation improvements ([1](https://github.com/haskell/bytestring/pull/628), [2](https://github.com/haskell/bytestring/pull/609), [3](https://github.com/haskell/bytestring/pull/612), [4](https://github.com/haskell/bytestring/pull/623), [5](https://github.com/haskell/bytestring/pull/654))+ * [Eta-expand `Data.ByteString.Builder.Internal.empty`](https://github.com/haskell/bytestring/pull/616)+ * This can variously help or hurt performance; it undoes the performance changes caused by [CLC proposal 132](https://github.com/haskell/core-libraries-committee/issues/132) with ghc-9.8 and restores the baseline performance seen with older GHCs.+<!--+* Internal stuff:+ * [Delete cabal.project](https://github.com/haskell/bytestring/pull/613)+ * Remove some non-exposed data declarations from internal modules:+ * [`Data.ByteString.Short.Internal.BA`](https://github.com/haskell/bytestring/pull/615)+ * [`Data.ByteString.Short.Internal.MBA`](https://github.com/haskell/bytestring/pull/617)+ * Various CI tweaks ([1](https://github.com/haskell/bytestring/pull/626), [2](https://github.com/haskell/bytestring/pull/651))+ * [Use `NonEmpty` to prune dead code in `integerDec`](https://github.com/haskell/bytestring/pull/655)+ * This might have a performance impact due to result unboxing (CPR).+ * [Consolidate internal CPP for byte-order/endianness](https://github.com/haskell/bytestring/pull/659)+ * [Remove remaining uses of FFI under -fpure-haskell](https://github.com/haskell/bytestring/pull/660)+ * Doesn't warrant a separate visible changelog entry from #631.+-->++[0.12.1.0]: https://github.com/haskell/bytestring/compare/0.12.0.2...0.12.1.0++[0.12.0.2] — August 2023++* Bug fixes:+ * [Fix `clockid_t`-related build failures on some platforms](https://github.com/haskell/bytestring/pull/607)++[0.12.0.2]: https://github.com/haskell/bytestring/compare/0.12.0.1...0.12.0.2++[0.12.0.1] — August 2023++* Bug fixes:+ * [Work around a GHC runtime linker issue on i386/PowerPC](https://github.com/haskell/bytestring/pull/604)++[0.12.0.1]: https://github.com/haskell/bytestring/compare/0.12.0.0...0.12.0.1++[0.12.0.0] — July 2023++* __Breaking Changes__:+ * [`readInt` returns `Nothing`, if the sequence of digits cannot be represented by an `Int`, instead of overflowing silently](https://github.com/haskell/bytestring/pull/309)+ * [Remove `zipWith` rewrite rule](https://github.com/haskell/bytestring/pull/387)+ * [`ShortByteString` is now a wrapper around `Data.Array.Byte.ByteArray` instead of `ByteArray#` directly](https://github.com/haskell/bytestring/pull/410)+ * As a compatibility measure, `SBS` remains available as a pattern synonym.+ * The compatibility package `data-array-byte` is used when `base` does not provide `Data.Array.Byte`.+ * [`fromListN` from `instance IsList ShortByteString` now throws an exception if the first argument does not match the length of the second](https://github.com/haskell/bytestring/pull/410)+ * Previously, it would ignore the first argument entirely.+* Bug fixes:+ * Size-related calculations are more resistant to `Int` overflow in the following places:+ * [`Data.ByteString.intercalate`](https://github.com/haskell/bytestring/pull/468)+ * [`stimes @StrictByteString`](https://github.com/haskell/bytestring/pull/443)+ * [`Data.ByteString.Short.concat`](https://github.com/haskell/bytestring/pull/443)+ * [`Data.ByteString.Short.append`](https://github.com/haskell/bytestring/pull/443)+ * [`Data.ByteString.Short.snoc`](https://github.com/haskell/bytestring/pull/599)+ * [`Data.ByteString.Short.cons`](https://github.com/haskell/bytestring/pull/599)+* API additions:+ * [New sized and/or unsigned variants of `readInt` and `readInteger`](https://github.com/haskell/bytestring/pull/438)+ * [`Data.ByteString.Internal` now provides `SizeOverflowException`, `overflowError`, and `checkedMultiply`](https://github.com/haskell/bytestring/pull/443)+* Deprecations:+ * `Data.ByteString.getLine`: prefer `Data.ByteString.Char8.getLine`+ * `Data.ByteString.hGetLine`: prefer `Data.ByteString.Char8.hGetLine`+++[0.12.0.0]: https://github.com/haskell/bytestring/compare/0.11.5.0...0.12.0.0++[0.11.5.3] — October 2023++* Bug fixes:+ * [Fix a bug in `isValidUtf8`](https://github.com/haskell/bytestring/pull/621)++[0.11.5.3]: https://github.com/haskell/bytestring/compare/0.11.5.2...0.11.5.3++[0.11.5.2] — August 2023++* Bug fixes:+ * [Fix `clockid_t`-related build failures on some platforms](https://github.com/haskell/bytestring/pull/607)++[0.11.5.2]: https://github.com/haskell/bytestring/compare/0.11.5.1...0.11.5.2++[0.11.5.1] — August 2023++* Bug fixes:+ * [Work around a GHC runtime linker issue on i386/PowerPC](https://github.com/haskell/bytestring/pull/604)++[0.11.5.1]: https://github.com/haskell/bytestring/compare/0.11.5.0...0.11.5.1++[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:+ * [Prevent commoning-up of `ShortByteString` literals produced by `TemplateHaskell`](https://github.com/haskell/bytestring/pull/542)+ * [Make `Builder` literals demand a sane amount of memory at chunk boundaries](https://github.com/haskell/bytestring/pull/538)+* API additions and behavior changes:+ * [Export `unsafeIndex` for `ShortByteString` which had been accidentally removed in v0.11.3.0](https://github.com/haskell/bytestring/pull/532)+ * [Make `Data.ByteString.Lazy.Char8.lines` less strict](https://github.com/haskell/bytestring/pull/562)+ * [Add `NonEmpty` variants of `inits` and `tails`](https://github.com/haskell/bytestring/pull/557)+* Performance improvements:+ * [Speed up `unpack` and folds for `ShortByteString`](https://github.com/haskell/bytestring/pull/526)+ * [Speed up `Builder`s for non-host endianness](https://github.com/haskell/bytestring/pull/531)+ * [Work around upstream `keepAlive#` performance regressions](https://github.com/haskell/bytestring/pull/536)+ * [Improve performance of `uncons` for `LazyByteString`](https://github.com/haskell/bytestring/pull/559)+ * [Simplify `useAsCString`](https://github.com/haskell/bytestring/pull/516)+ * [Remove redundant comparisons in `Data.ByteString.Short.splitAt`](https://github.com/haskell/bytestring/pull/528)+* Miscellaneous:+ * [Document possible interleaving of `hPutStrLn` and friends](https://github.com/haskell/bytestring/pull/518)+ * [Documentation tweaks](https://github.com/haskell/bytestring/pull/523)+ * [Add lower bound for `tasty-quickcheck`](https://github.com/haskell/bytestring/pull/520)+<!--+* Internal stuff:+ * Various CI tweaks ([1](https://github.com/haskell/bytestring/pull/539), [2](https://github.com/haskell/bytestring/pull/550), [3](https://github.com/haskell/bytestring/pull/551), [4](https://github.com/haskell/bytestring/pull/563), [5](https://github.com/haskell/bytestring/pull/566), [6](https://github.com/haskell/bytestring/pull/568))+ * [Avoid pattern-matching with `SBS`, for consistency with master](https://github.com/haskell/bytestring/pull/556)+ * [Avoid `Prelude.head` and `Prelude.tail`](https://github.com/haskell/bytestring/pull/553)+-->++[0.11.4.0]: https://github.com/haskell/bytestring/compare/0.11.3.1...0.11.4.0++[0.11.3.1] — May 2022++* [Windows: Do not link against `gcc_s`](https://github.com/haskell/bytestring/pull/500)+* [Windows: Do not link against `gcc` when GHC >= 9.4](https://github.com/haskell/bytestring/pull/512)+* [Refine CPP for obsolete versions of `gcc`](https://github.com/haskell/bytestring/pull/505)++[0.11.3.1]: https://github.com/haskell/bytestring/compare/0.11.3.0...0.11.3.1++[0.11.3.0] — February 2022++Erratum: `unsafeIndex` was accidentally removed from the export list of `Data.ByteString.Short.Internal` in this release. This was corrected in 0.11.4.0.++* [Enhance `ShortByteString` API](https://github.com/haskell/bytestring/pull/471)+ - Add `all`, `any`, `append`, `break`, `breakEnd`, `breakSubstring`, `concat`, `cons`, `count`, `drop`, `dropEnd`, `dropWhile`, `dropWhileEnd`, `elem`, `elemIndex`, `elemIndices`, `filter`, `find`, `findIndex`, `findIndices`, `foldl'`, `foldl`, `foldl1'`, `foldl1`, `foldr'`, `foldr`, `foldr1'`, `foldr1`, `head`, `init`, `intercalate`, `isInfixOf`, `isPrefixOf`, `isSuffixOf`, `last`, `map`, `partition`, `replicate`, `reverse`, `singleton`, `snoc`, `span`, `spanEnd`, `split`, `splitAt`, `splitWith`, `stripPrefix`, `stripSuffix`, `tail`, `take`, `takeEnd`, `takeWhile`, `takeWhileEnd`, `uncons`, `unfoldr`, `unfoldrN`, `unsnoc` to `Data.ByteString.Short`.+* [Add `Data.ByteString.Short.isValidUtf8`](https://github.com/haskell/bytestring/pull/450)+* [Use safe `isValidUtf8` for large inputs](https://github.com/haskell/bytestring/pull/470)+* [Make `unlines` lazier](https://github.com/haskell/bytestring/pull/477)+* [Improve performance of `unlines`](https://github.com/haskell/bytestring/pull/479)+* [Make `singleton` return a slice of a static buffer](https://github.com/haskell/bytestring/pull/480)+* [Improve performance of `intercalate`](https://github.com/haskell/bytestring/pull/459)++[0.11.3.0]: https://github.com/haskell/bytestring/compare/0.11.2.0...0.11.3.0+ [0.11.2.0] — December 2021 * [Add `Data.ByteString.isValidUtf8`](https://github.com/haskell/bytestring/pull/423)
Data/ByteString.hs view
@@ -1,9 +1,7 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE TupleSections #-}-{-# OPTIONS_HADDOCK prune #-} {-# LANGUAGE Trustworthy #-} +{-# OPTIONS_HADDOCK prune #-}+ -- | -- Module : Data.ByteString -- Copyright : (c) The University of Glasgow 2001,@@ -44,6 +42,22 @@ ByteString, StrictByteString, + -- ** Heap fragmentation+ -- | With GHC, the 'ByteString' representation uses /pinned memory/,+ -- meaning it cannot be moved by GC. While this is ideal for use with+ -- the foreign function interface and is usually efficient, this+ -- representation may lead to issues with heap fragmentation and wasted+ -- space if the program selectively retains a fraction of many small+ -- 'ByteString's, keeping them live in memory over long durations.+ --+ -- While 'ByteString' is indispensable when working with large blobs of+ -- data and especially when interfacing with native C libraries, be sure+ -- to also check the 'Data.ByteString.Short.ShortByteString' type.+ -- As a type backed by /unpinned/ memory, @ShortByteString@ behaves+ -- similarly to @Text@ (from the @text@ package) on the heap, completely+ -- avoids fragmentation issues, and in many use-cases may better suit+ -- your bytestring-storage needs.+ -- * Introducing and eliminating 'ByteString's empty, singleton,@@ -129,6 +143,8 @@ groupBy, inits, tails,+ initsNE,+ tailsNE, stripPrefix, stripSuffix, @@ -216,11 +232,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@@ -229,23 +245,25 @@ import Data.Bits (finiteBitSize, shiftL, (.|.), (.&.)) -import Data.ByteString.Internal+import Data.ByteString.Internal.Type import Data.ByteString.Lazy.Internal (fromStrict, toStrict) import Data.ByteString.Unsafe import qualified Data.List as List+import qualified Data.List.NonEmpty as NE+import Data.List.NonEmpty (NonEmpty(..)) import Data.Word (Word8) 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))-import Foreign.ForeignPtr (ForeignPtr, withForeignPtr, touchForeignPtr)+import Foreign.ForeignPtr (ForeignPtr, touchForeignPtr) import Foreign.ForeignPtr.Unsafe(unsafeForeignPtrToPtr) import Foreign.Marshal.Alloc (allocaBytes) import Foreign.Marshal.Array (allocaArray)+import Foreign.Marshal.Utils import Foreign.Ptr import Foreign.Storable (Storable(..)) @@ -262,11 +280,9 @@ 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)-import Foreign.Marshal.Utils (copyBytes) import GHC.Base (build) import GHC.Word hiding (Word8)@@ -274,35 +290,24 @@ -- ----------------------------------------------------------------------------- -- Introducing and eliminating 'ByteString's --- | /O(1)/ The empty 'ByteString'-empty :: ByteString-empty = BS nullForeignPtr 0- -- | /O(1)/ Convert a 'Word8' into a 'ByteString' singleton :: Word8 -> ByteString-singleton c = unsafeCreate 1 $ \p -> poke p c-{-# INLINE [1] singleton #-}---- Inline [1] for intercalate rule+-- Taking a slice of some static data rather than allocating a new+-- buffer for each call is nice for several reasons. Since it doesn't+-- involve any side effects hidden in a 'GHC.Magic.runRW#' call, it+-- can be simplified to a constructor application. This may enable GHC+-- to perform further optimizations after inlining, and also causes a+-- fresh singleton to take only 4 words of heap space instead of 9.+-- (The buffer object itself would take up 3 words: header, size, and+-- 1 word of content. The ForeignPtrContents object used to keep the+-- buffer alive would need two more.)+singleton c = unsafeTake 1 $ unsafeDrop (fromIntegral c) allBytes+{-# INLINE singleton #-} ------ XXX The use of unsafePerformIO in allocating functions (unsafeCreate) is critical!------ Otherwise:------ singleton 255 `compare` singleton 127------ is compiled to:------ case mallocByteString 2 of--- ForeignPtr f internals ->--- case writeWord8OffAddr# f 0 255 of _ ->--- case writeWord8OffAddr# f 0 127 of _ ->--- case eqAddr# f f of--- False -> case compare (GHC.Prim.plusAddr# f 0)--- (GHC.Prim.plusAddr# f 0)------+-- | A static blob of all possible bytes (0x00 to 0xff) in order+allBytes :: ByteString+allBytes = unsafePackLenLiteral 0x100+ "\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0a\x0b\x0c\x0d\x0e\x0f\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f\x20\x21\x22\x23\x24\x25\x26\x27\x28\x29\x2a\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x3a\x3b\x3c\x3d\x3e\x3f\x40\x41\x42\x43\x44\x45\x46\x47\x48\x49\x4a\x4b\x4c\x4d\x4e\x4f\x50\x51\x52\x53\x54\x55\x56\x57\x58\x59\x5a\x5b\x5c\x5d\x5e\x5f\x60\x61\x62\x63\x64\x65\x66\x67\x68\x69\x6a\x6b\x6c\x6d\x6e\x6f\x70\x71\x72\x73\x74\x75\x76\x77\x78\x79\x7a\x7b\x7c\x7d\x7e\x7f\x80\x81\x82\x83\x84\x85\x86\x87\x88\x89\x8a\x8b\x8c\x8d\x8e\x8f\x90\x91\x92\x93\x94\x95\x96\x97\x98\x99\x9a\x9b\x9c\x9d\x9e\x9f\xa0\xa1\xa2\xa3\xa4\xa5\xa6\xa7\xa8\xa9\xaa\xab\xac\xad\xae\xaf\xb0\xb1\xb2\xb3\xb4\xb5\xb6\xb7\xb8\xb9\xba\xbb\xbc\xbd\xbe\xbf\xc0\xc1\xc2\xc3\xc4\xc5\xc6\xc7\xc8\xc9\xca\xcb\xcc\xcd\xce\xcf\xd0\xd1\xd2\xd3\xd4\xd5\xd6\xd7\xd8\xd9\xda\xdb\xdc\xdd\xde\xdf\xe0\xe1\xe2\xe3\xe4\xe5\xe6\xe7\xe8\xe9\xea\xeb\xec\xed\xee\xef\xf0\xf1\xf2\xf3\xf4\xf5\xf6\xf7\xf8\xf9\xfa\xfb\xfc\xfd\xfe\xff"# -- | /O(n)/ Convert a @['Word8']@ into a 'ByteString'. --@@ -385,20 +390,22 @@ -- | /O(n)/ 'cons' is analogous to (:) for lists, but of different -- complexity, as it requires making a copy. cons :: Word8 -> ByteString -> ByteString-cons c (BS x l) = unsafeCreate (l+1) $ \p -> unsafeWithForeignPtr x $ \f -> do- poke p c- memcpy (p `plusPtr` 1) f (fromIntegral l)+cons c (BS x len) = unsafeCreateFp (checkedAdd "cons" len 1) $ \p -> do+ pokeFp p c+ memcpyFp (p `plusForeignPtr` 1) x len {-# INLINE cons #-} -- | /O(n)/ Append a byte to the end of a 'ByteString' snoc :: ByteString -> Word8 -> ByteString-snoc (BS x l) c = unsafeCreate (l+1) $ \p -> unsafeWithForeignPtr x $ \f -> do- memcpy p f (fromIntegral l)- poke (p `plusPtr` l) c+snoc (BS x len) c = unsafeCreateFp (checkedAdd "snoc" len 1) $ \p -> do+ memcpyFp p x len+ pokeFp (p `plusForeignPtr` len) c {-# INLINE snoc #-} -- | /O(1)/ Extract the first element of a ByteString, which must be non-empty. -- An exception will be thrown in the case of an empty ByteString.+--+-- This is a partial function, consider using 'uncons' instead. head :: HasCallStack => ByteString -> Word8 head (BS x l) | l <= 0 = errorEmptyList "head"@@ -407,13 +414,15 @@ -- | /O(1)/ Extract the elements after the head of a ByteString, which must be non-empty. -- An exception will be thrown in the case of an empty ByteString.+--+-- This is a partial function, consider using 'uncons' instead. tail :: HasCallStack => ByteString -> ByteString tail (BS p l) | l <= 0 = errorEmptyList "tail" | otherwise = BS (plusForeignPtr p 1) (l-1) {-# INLINE tail #-} --- | /O(1)/ Extract the head and tail of a ByteString, returning Nothing+-- | /O(1)/ Extract the 'head' and 'tail' of a ByteString, returning 'Nothing' -- if it is empty. uncons :: ByteString -> Maybe (Word8, ByteString) uncons (BS x l)@@ -425,6 +434,8 @@ -- | /O(1)/ Extract the last element of a ByteString, which must be finite and non-empty. -- An exception will be thrown in the case of an empty ByteString.+--+-- This is a partial function, consider using 'unsnoc' instead. last :: HasCallStack => ByteString -> Word8 last ps@(BS x l) | null ps = errorEmptyList "last"@@ -432,15 +443,17 @@ unsafeWithForeignPtr x $ \p -> peekByteOff p (l-1) {-# INLINE last #-} --- | /O(1)/ Return all the elements of a 'ByteString' except the last one.+-- | /O(1)/ Returns all the elements of a 'ByteString' except the last one. -- An exception will be thrown in the case of an empty ByteString.+--+-- This is a partial function, consider using 'unsnoc' instead. init :: HasCallStack => ByteString -> ByteString init ps@(BS p l) | null ps = errorEmptyList "init" | otherwise = BS p (l-1) {-# INLINE init #-} --- | /O(1)/ Extract the 'init' and 'last' of a ByteString, returning Nothing+-- | /O(1)/ Extract the 'init' and 'last' of a ByteString, returning 'Nothing' -- if it is empty. unsnoc :: ByteString -> Maybe (ByteString, Word8) unsnoc (BS x l)@@ -461,8 +474,7 @@ -- | /O(n)/ 'map' @f xs@ is the ByteString obtained by applying @f@ to each -- element of @xs@. map :: (Word8 -> Word8) -> ByteString -> ByteString-map f (BS fp len) = unsafeDupablePerformIO $ unsafeWithForeignPtr fp $ \srcPtr ->- create len $ \dstPtr -> m srcPtr dstPtr+map f (BS srcPtr len) = unsafeCreateFp len $ \dstPtr -> m srcPtr dstPtr where m !p1 !p2 = map_ 0 where@@ -470,15 +482,17 @@ map_ !n | n >= len = return () | otherwise = do- x <- peekByteOff p1 n- pokeByteOff p2 n (f x)+ x <- peekFpByteOff p1 n+ pokeFpByteOff p2 n (f x) map_ (n+1) {-# INLINE map #-} -- | /O(n)/ 'reverse' @xs@ efficiently returns the elements of @xs@ in reverse order. reverse :: ByteString -> ByteString-reverse (BS x l) = unsafeCreate l $ \p -> unsafeWithForeignPtr x $ \f ->- c_reverse p f (fromIntegral l)+reverse (BS x l) = unsafeCreateFp l $ \fp ->+ unsafeWithForeignPtr fp $ \p ->+ unsafeWithForeignPtr x $ \f ->+ c_reverse p f (fromIntegral l) -- | /O(n)/ The 'intersperse' function takes a 'Word8' and a -- 'ByteString' and \`intersperses\' that byte between the elements of@@ -487,8 +501,10 @@ intersperse :: Word8 -> ByteString -> ByteString intersperse c ps@(BS x l) | length ps < 2 = ps- | otherwise = unsafeCreate (2*l-1) $ \p -> unsafeWithForeignPtr x $ \f ->- c_intersperse p f (fromIntegral l) c+ | otherwise = unsafeCreateFp (2*l-1) $ \fp ->+ unsafeWithForeignPtr fp $ \p ->+ unsafeWithForeignPtr x $ \f ->+ c_intersperse p f (fromIntegral l) c -- | The 'transpose' function transposes the rows and columns of its -- 'ByteString' argument.@@ -535,13 +551,13 @@ let g ptr = go v ptr where- end = ptr `plusPtr` len+ end = ptr `plusForeignPtr` len -- tail recursive; traverses array left to right go !z !p | p == end = return z- | otherwise = do x <- peek p- go (f z x) (p `plusPtr` 1)+ | otherwise = do x <- peekFp p+ go (f z x) (p `plusForeignPtr` 1) in- accursedUnutterablePerformIO $ unsafeWithForeignPtr fp g+ accursedUnutterablePerformIO $ g fp {-# INLINE foldl' #-} -- | 'foldr', applied to a binary operator, a starting value@@ -569,15 +585,15 @@ foldr' k v = \(BS fp len) -> -- see fold inlining let- g ptr = go v (end `plusPtr` len)+ g ptr = go v (end `plusForeignPtr` len) where- end = ptr `plusPtr` (-1)+ end = ptr `plusForeignPtr` (-1) -- tail recursive; traverses array right to left go !z !p | p == end = return z- | otherwise = do x <- peek p- go (k x z) (p `plusPtr` (-1))+ | otherwise = do x <- peekFp p+ go (k x z) (p `plusForeignPtr` (-1)) in- accursedUnutterablePerformIO $ unsafeWithForeignPtr fp g+ accursedUnutterablePerformIO $ g fp {-# INLINE foldr' #-} @@ -632,15 +648,15 @@ -- any element of the 'ByteString' satisfies the predicate. any :: (Word8 -> Bool) -> ByteString -> Bool any _ (BS _ 0) = False-any f (BS x len) = accursedUnutterablePerformIO $ unsafeWithForeignPtr x g+any f (BS x len) = accursedUnutterablePerformIO $ g x where g ptr = go ptr where- end = ptr `plusPtr` len+ end = ptr `plusForeignPtr` len go !p | p == end = return False- | otherwise = do c <- peek p+ | otherwise = do c <- peekFp p if f c then return True- else go (p `plusPtr` 1)+ else go (p `plusForeignPtr` 1) {-# INLINE [1] any #-} {-# RULES@@ -661,15 +677,15 @@ -- if all elements of the 'ByteString' satisfy the predicate. all :: (Word8 -> Bool) -> ByteString -> Bool all _ (BS _ 0) = True-all f (BS x len) = accursedUnutterablePerformIO $ unsafeWithForeignPtr x g+all f (BS x len) = accursedUnutterablePerformIO $ g x where g ptr = go ptr where- end = ptr `plusPtr` len+ end = ptr `plusForeignPtr` len go !p | p == end = return True -- end of list- | otherwise = do c <- peek p+ | otherwise = do c <- peekFp p if f c- then go (p `plusPtr` 1)+ then go (p `plusForeignPtr` 1) else return False {-# INLINE [1] all #-} @@ -705,9 +721,9 @@ -- | The 'mapAccumL' function behaves like a combination of 'map' and -- 'foldl'; it applies a function to each element of a ByteString, -- passing an accumulating parameter from left to right, and returning a--- final value of this accumulator together with the new list.+-- final value of this accumulator together with the new ByteString. mapAccumL :: (acc -> Word8 -> (acc, Word8)) -> acc -> ByteString -> (acc, ByteString)-mapAccumL f acc = \(BS fp len) -> unsafeDupablePerformIO $ unsafeWithForeignPtr fp $ \a -> do+mapAccumL f acc = \(BS a len) -> unsafeDupablePerformIO $ do -- see fold inlining gp <- mallocByteString len let@@ -716,11 +732,11 @@ mapAccumL_ !s !n | n >= len = return s | otherwise = do- x <- peekByteOff src n+ x <- peekFpByteOff src n let (s', y) = f s x- pokeByteOff dst n y+ pokeFpByteOff dst n y mapAccumL_ s' (n+1)- acc' <- unsafeWithForeignPtr gp (go a)+ acc' <- go a gp return (acc', BS gp len) {-# INLINE mapAccumL #-} @@ -729,7 +745,7 @@ -- passing an accumulating parameter from right to left, and returning a -- final value of this accumulator together with the new ByteString. mapAccumR :: (acc -> Word8 -> (acc, Word8)) -> acc -> ByteString -> (acc, ByteString)-mapAccumR f acc = \(BS fp len) -> unsafeDupablePerformIO $ unsafeWithForeignPtr fp $ \a -> do+mapAccumR f acc = \(BS a len) -> unsafeDupablePerformIO $ do -- see fold inlining gp <- mallocByteString len let@@ -737,11 +753,11 @@ where mapAccumR_ !s (-1) = return s mapAccumR_ !s !n = do- x <- peekByteOff src n+ x <- peekFpByteOff src n let (s', y) = f s x- pokeByteOff dst n y+ pokeFpByteOff dst n y mapAccumR_ s' (n-1)- acc' <- unsafeWithForeignPtr gp (go a)+ acc' <- go a gp return (acc', BS gp len) {-# INLINE mapAccumR #-} @@ -767,21 +783,20 @@ -- ^ input of length n -> ByteString -- ^ output of length n+1-scanl f v = \(BS fp len) -> unsafeDupablePerformIO $ unsafeWithForeignPtr fp $ \a ->+scanl f v = \(BS a len) -> unsafeCreateFp (checkedAdd "scanl" len 1) $ \q -> do -- see fold inlining- create (len+1) $ \q -> do- poke q v+ pokeFp q v let go src dst = scanl_ v 0 where scanl_ !z !n | n >= len = return () | otherwise = do- x <- peekByteOff src n+ x <- peekFpByteOff src n let z' = f z x- pokeByteOff dst n z'+ pokeFpByteOff dst n z' scanl_ z' (n+1)- go a (q `plusPtr` 1)+ go a (q `plusForeignPtr` 1) {-# INLINE scanl #-} -- | 'scanl1' is a variant of 'scanl' that has no starting value argument.@@ -812,19 +827,18 @@ -- ^ input of length n -> ByteString -- ^ output of length n+1-scanr f v = \(BS fp len) -> unsafeDupablePerformIO $ unsafeWithForeignPtr fp $ \a ->+scanr f v = \(BS a len) -> unsafeCreateFp (checkedAdd "scanr" len 1) $ \b -> do -- see fold inlining- create (len+1) $ \b -> do- poke (b `plusPtr` len) v+ pokeFpByteOff b len v let go p q = scanr_ v (len-1) where scanr_ !z !n | n < 0 = return () | otherwise = do- x <- peekByteOff p n+ x <- peekFpByteOff p n let z' = f x z- pokeByteOff q n z'+ pokeFpByteOff q n z' scanr_ z' (n-1) go a b {-# INLINE scanr #-}@@ -842,14 +856,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 = unsafeCreate w $ \ptr ->- void $ memset ptr c (fromIntegral w)+ | otherwise = unsafeCreateFp w $ \fptr ->+ unsafeWithForeignPtr fptr $ \ptr ->+ fillBytes ptr c w {-# INLINE replicate #-} -- | /O(n)/, where /n/ is the length of the result. The 'unfoldr'@@ -884,7 +897,7 @@ unfoldrN :: Int -> (a -> Maybe (Word8, a)) -> a -> (ByteString, Maybe a) unfoldrN i f x0 | i < 0 = (empty, Just x0)- | otherwise = unsafePerformIO $ createAndTrim' i $ \p -> go p x0 0+ | otherwise = unsafeDupablePerformIO $ createFpAndTrim' i $ \p -> go p x0 0 where go !p !x !n = go' x n where@@ -892,7 +905,7 @@ | n' == i = return (0, n', Just x') | otherwise = case f x' of Nothing -> return (0, n', Nothing)- Just (w,x'') -> do pokeByteOff p n' w+ Just (w,x'') -> do pokeFpByteOff p n' w go' x'' (n'+1) {-# INLINE unfoldrN #-} @@ -927,7 +940,7 @@ {-# INLINE takeEnd #-} -- | /O(1)/ 'drop' @n xs@ returns the suffix of @xs@ after the first @n@--- elements, or @[]@ if @n > 'length' xs@.+-- elements, or 'empty' if @n > 'length' xs@. drop :: Int -> ByteString -> ByteString drop n ps@(BS x l) | n <= 0 = ps@@ -961,7 +974,7 @@ | otherwise = (BS x n, BS (plusForeignPtr x n) (l-n)) {-# INLINE splitAt #-} --- | Similar to 'P.takeWhile',+-- | Similar to 'Prelude.takeWhile', -- returns the longest (possibly empty) prefix of elements -- satisfying the predicate. takeWhile :: (Word8 -> Bool) -> ByteString -> ByteString@@ -989,7 +1002,7 @@ takeWhileEnd f ps = unsafeDrop (findFromEndUntil (not . f) ps) ps {-# INLINE takeWhileEnd #-} --- | Similar to 'P.dropWhile',+-- | Similar to 'Prelude.dropWhile', -- drops the longest (possibly empty) prefix of elements -- satisfying the predicate and returns the remainder. dropWhile :: (Word8 -> Bool) -> ByteString -> ByteString@@ -1007,7 +1020,7 @@ dropWhile (`eqWord8` x) = snd . spanByte x #-} --- | Similar to 'P.dropWhileEnd',+-- | Similar to 'Prelude.dropWhileEnd', -- drops the longest (possibly empty) suffix of elements -- satisfying the predicate and returns the remainder. --@@ -1018,7 +1031,7 @@ dropWhileEnd f ps = unsafeTake (findFromEndUntil (not . f) ps) ps {-# INLINE dropWhileEnd #-} --- | Similar to 'P.break',+-- | Similar to 'Prelude.break', -- returns the longest (possibly empty) prefix of elements which __do not__ -- satisfy the predicate and the remainder of the string. --@@ -1044,7 +1057,7 @@ -- INTERNAL: --- | 'breakByte' breaks its ByteString argument at the first occurence+-- | 'breakByte' breaks its ByteString argument at the first occurrence -- of the specified byte. It is more efficient than 'break' as it is -- implemented with @memchr(3)@. I.e. --@@ -1059,12 +1072,12 @@ -- | 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 --- | Similar to 'P.span',+-- | Similar to 'Prelude.span', -- returns the longest (possibly empty) prefix of elements -- satisfying the predicate and the remainder of the string. --@@ -1075,7 +1088,7 @@ {-# INLINE [1] span #-} -- | 'spanByte' breaks its ByteString argument at the first--- occurence of a byte other than its argument. It is more efficient+-- occurrence of a byte other than its argument. It is more efficient -- than 'span (==)' -- -- > span (==99) "abcd" == spanByte 99 "abcd" -- fromEnum 'c' == 99@@ -1104,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 --@@ -1132,10 +1145,9 @@ splitWith predicate (BS fp len) = splitWith0 0 len fp where splitWith0 !off' !len' !fp' = accursedUnutterablePerformIO $- unsafeWithForeignPtr fp $ \p ->- splitLoop p 0 off' len' fp'+ splitLoop fp 0 off' len' fp' - splitLoop :: Ptr Word8+ splitLoop :: ForeignPtr Word8 -> Int -> Int -> Int -> ForeignPtr Word8 -> IO [ByteString]@@ -1144,7 +1156,7 @@ go idx' | idx' >= len' = return [BS (plusForeignPtr fp' off') idx'] | otherwise = do- w <- peekElemOff p (off'+idx')+ w <- peekFpByteOff p (off'+idx') if predicate w then return (BS (plusForeignPtr fp' off') idx' : splitWith0 (off'+idx'+1) (len'-idx'-1) fp')@@ -1186,7 +1198,7 @@ -- | The 'group' function takes a ByteString and returns a list of -- ByteStrings such that the concatenation of the result is equal to the--- argument. Moreover, each sublist in the result contains only equal+-- argument. Moreover, each string in the result contains only equal -- elements. For example, -- -- > group "Mississippi" = ["M","i","ss","i","ss","i","pp","i"]@@ -1213,32 +1225,29 @@ -- 'ByteString's and concatenates the list after interspersing the first -- argument between each element of the list. intercalate :: ByteString -> [ByteString] -> ByteString-intercalate s = concat . List.intersperse s-{-# INLINE [1] intercalate #-}--{-# RULES-"ByteString specialise intercalate c -> intercalateByte" forall c s1 s2 .- intercalate (singleton c) [s1, s2] = intercalateWithByte c s1 s2- #-}---- | /O(n)/ intercalateWithByte. An efficient way to join to two ByteStrings--- with a char. Around 4 times faster than the generalised join.----intercalateWithByte :: Word8 -> ByteString -> ByteString -> ByteString-intercalateWithByte c f@(BS ffp l) g@(BS fgp m) = unsafeCreate len $ \ptr ->- unsafeWithForeignPtr ffp $ \fp ->- unsafeWithForeignPtr fgp $ \gp -> do- memcpy ptr fp (fromIntegral l)- poke (ptr `plusPtr` l) c- memcpy (ptr `plusPtr` (l + 1)) gp (fromIntegral m)- where- len = length f + length g + 1-{-# INLINE intercalateWithByte #-}+intercalate _ [] = mempty+intercalate _ [x] = x -- This branch exists for laziness, not speed+intercalate (BS sepPtr sepLen) (BS hPtr hLen : t) =+ unsafeCreateFp totalLen $ \dstPtr0 -> do+ memcpyFp dstPtr0 hPtr hLen+ let go _ [] = pure ()+ go dstPtr (BS chunkPtr chunkLen : chunks) = do+ memcpyFp dstPtr sepPtr sepLen+ let destPtr' = dstPtr `plusForeignPtr` sepLen+ memcpyFp destPtr' chunkPtr chunkLen+ go (destPtr' `plusForeignPtr` chunkLen) chunks+ go (dstPtr0 `plusForeignPtr` hLen) t+ where+ totalLen = List.foldl' (\acc chunk -> acc +! sepLen +! length chunk) hLen t+ (+!) = checkedAdd "intercalate"+{-# INLINABLE intercalate #-} -- --------------------------------------------------------------------- -- Indexing ByteStrings -- | /O(1)/ 'ByteString' index (subscript) operator, starting from 0.+--+-- This is a partial function, consider using 'indexMaybe' instead. index :: HasCallStack => ByteString -> Int -> Word8 index ps n | n < 0 = moduleError "index" ("negative index: " ++ show n)@@ -1319,12 +1328,12 @@ -- returns the index of the first element in the ByteString -- satisfying the predicate. findIndex :: (Word8 -> Bool) -> ByteString -> Maybe Int-findIndex k (BS x l) = accursedUnutterablePerformIO $ unsafeWithForeignPtr x g+findIndex k (BS x l) = accursedUnutterablePerformIO $ g x where g !ptr = go 0 where go !n | n >= l = return Nothing- | otherwise = do w <- peek $ ptr `plusPtr` n+ | otherwise = do w <- peekFp $ ptr `plusForeignPtr` n if k w then return (Just n) else go (n+1)@@ -1336,12 +1345,12 @@ -- -- @since 0.10.12.0 findIndexEnd :: (Word8 -> Bool) -> ByteString -> Maybe Int-findIndexEnd k (BS x l) = accursedUnutterablePerformIO $ unsafeWithForeignPtr x g+findIndexEnd k (BS x l) = accursedUnutterablePerformIO $ g x where g !ptr = go (l-1) where go !n | n < 0 = return Nothing- | otherwise = do w <- peekByteOff ptr n+ | otherwise = do w <- peekFpByteOff ptr n if k w then return (Just n) else go (n-1)@@ -1384,24 +1393,25 @@ -- returns a ByteString containing those characters that satisfy the -- predicate. filter :: (Word8 -> Bool) -> ByteString -> ByteString-filter k = \ps@(BS x l) ->+filter k = \ps@(BS pIn l) -> -- see fold inlining. if null ps then ps else- unsafePerformIO $ createAndTrim l $ \pOut -> unsafeWithForeignPtr x $ \pIn -> do+ unsafeDupablePerformIO $ createFpAndTrim l $ \pOut -> do let go' pf pt = go pf pt where- end = pf `plusPtr` l+ end = pf `plusForeignPtr` l go !f !t | f == end = return t | otherwise = do- w <- peek f+ w <- peekFp f if k w- then poke t w >> go (f `plusPtr` 1) (t `plusPtr` 1)- else go (f `plusPtr` 1) t+ then pokeFp t w+ >> go (f `plusForeignPtr` 1) (t `plusForeignPtr` 1)+ else go (f `plusForeignPtr` 1) t t <- go' pIn pOut- return $! t `minusPtr` pOut -- actual length+ return $! t `minusForeignPtr` pOut -- actual length {-# INLINE filter #-} {-@@ -1447,34 +1457,33 @@ -- partition :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString) partition f s = unsafeDupablePerformIO $- do fp' <- mallocByteString len- unsafeWithForeignPtr fp' $ \p ->- do let end = p `plusPtr` (len - 1)+ do p <- mallocByteString len+ let end = p `plusForeignPtr` (len - 1) mid <- sep 0 p end rev mid end- let i = mid `minusPtr` p- return (BS fp' i,- BS (plusForeignPtr fp' i) (len - i))+ let i = mid `minusForeignPtr` p+ return (BS p i,+ BS (p `plusForeignPtr` i) (len - i)) where len = length s- incr = (`plusPtr` 1)- decr = (`plusPtr` (-1))+ incr = (`plusForeignPtr` 1)+ decr = (`plusForeignPtr` (-1)) sep !i !p1 !p2 | i == len = return p1- | f w = do poke p1 w+ | f w = do pokeFp p1 w sep (i + 1) (incr p1) p2- | otherwise = do poke p2 w+ | otherwise = do pokeFp p2 w sep (i + 1) p1 (decr p2) where w = s `unsafeIndex` i - rev !p1 !p2+ rev !p1 !p2 -- fixme: surely there are faster ways to do this | p1 >= p2 = return ()- | otherwise = do a <- peek p1- b <- peek p2- poke p1 b- poke p2 a+ | otherwise = do a <- peekFp p1+ b <- peekFp p2+ pokeFp p1 b+ pokeFp p2 a rev (incr p1) (decr p2) -- --------------------------------------------------------------------@@ -1535,13 +1544,18 @@ -- -- @since 0.11.2.0 isValidUtf8 :: ByteString -> Bool-isValidUtf8 (BS ptr len) = accursedUnutterablePerformIO $ unsafeWithForeignPtr ptr $ \p -> do - i <- cIsValidUtf8 p (fromIntegral len)+isValidUtf8 (BS ptr len) = accursedUnutterablePerformIO $ unsafeWithForeignPtr ptr $ \p -> do+ -- Use a safe FFI call for large inputs to avoid GC synchronization pauses+ -- in multithreaded contexts.+ -- This specific limit was chosen based on results of a simple benchmark, see:+ -- https://github.com/haskell/bytestring/issues/451#issuecomment-991879338+ -- When changing this function, also consider changing the related function:+ -- Data.ByteString.Short.Internal.isValidUtf8+ i <- if len < 1000000+ then cIsValidUtf8 p (fromIntegral len)+ else cIsValidUtf8Safe p (fromIntegral len) pure $ i /= 0 -foreign import ccall unsafe "bytestring_is_valid_utf8" cIsValidUtf8- :: Ptr Word8 -> CSize -> IO CInt- -- | Break a string on a substring, returning a pair of the part of the -- string prior to the match, and the rest of the string. --@@ -1554,7 +1568,7 @@ -- > tokenise x y = h : if null t then [] else tokenise x (drop (length x) t) -- > where (h,t) = breakSubstring x y ----- To skip to the first occurence of a string:+-- To skip to the first occurrence of a string: -- -- > snd (breakSubstring x y) --@@ -1649,30 +1663,23 @@ -- -- @since 0.11.1.0 packZipWith :: (Word8 -> Word8 -> Word8) -> ByteString -> ByteString -> ByteString-packZipWith f (BS fp l) (BS fq m) = unsafeDupablePerformIO $- unsafeWithForeignPtr fp $ \a ->- unsafeWithForeignPtr fq $ \b ->- create len $ go a b+packZipWith f (BS a l) (BS b m) = unsafeDupablePerformIO $+ createFp len $ go a b where go p1 p2 = zipWith_ 0 where- zipWith_ :: Int -> Ptr Word8 -> IO ()+ zipWith_ :: Int -> ForeignPtr Word8 -> IO () zipWith_ !n !r | n >= len = return () | otherwise = do- x <- peekByteOff p1 n- y <- peekByteOff p2 n- pokeByteOff r n (f x y)+ x <- peekFpByteOff p1 n+ y <- peekFpByteOff p2 n+ pokeFpByteOff r n (f x y) zipWith_ (n+1) r len = min l m {-# INLINE packZipWith #-} -{-# RULES-"ByteString specialise zipWith" forall (f :: Word8 -> Word8 -> Word8) p q .- zipWith f p q = unpack (packZipWith f p q)- #-}- -- | /O(n)/ 'unzip' transforms a list of pairs of bytes into a pair of -- ByteStrings. Note that this performs two 'pack' operations. unzip :: [(Word8,Word8)] -> (ByteString,ByteString)@@ -1682,17 +1689,50 @@ -- --------------------------------------------------------------------- -- Special lists --- | /O(n)/ Return all initial segments of the given 'ByteString', shortest first.+-- | /O(n)/ Returns all initial segments of the given 'ByteString', shortest first. inits :: ByteString -> [ByteString]-inits (BS x l) = [BS x n | n <- [0..l]]+-- see Note [Avoid NonEmpty combinators]+inits bs = NE.toList $! initsNE bs --- | /O(n)/ Return all final segments of the given 'ByteString', longest first.+-- | /O(n)/ Returns all initial segments of the given 'ByteString', shortest first.+--+-- @since 0.11.4.0+initsNE :: ByteString -> NonEmpty ByteString+-- see Note [Avoid NonEmpty combinators]+initsNE (BS x len) = empty :| [BS x n | n <- [1..len]]++-- | /O(n)/ Returns all final segments of the given 'ByteString', longest first. tails :: ByteString -> [ByteString]-tails p | null p = [empty]- | otherwise = p : tails (unsafeTail p)+-- see Note [Avoid NonEmpty combinators]+tails bs = NE.toList $! tailsNE bs +-- | /O(n)/ Returns all final segments of the given 'ByteString', longest first.+--+-- @since 0.11.4.0+tailsNE :: ByteString -> NonEmpty ByteString+-- see Note [Avoid NonEmpty combinators]+tailsNE p | null p = empty :| []+ | otherwise = p :| tails (unsafeTail p)+ -- less efficent spacewise: tails (BS x l) = [BS (plusForeignPtr x n) (l-n) | n <- [0..l]] +{-+Note [Avoid NonEmpty combinators]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~++As of base-4.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.)+-}+++ -- --------------------------------------------------------------------- -- ** Ordered 'ByteString's @@ -1700,23 +1740,23 @@ sort :: ByteString -> ByteString sort (BS input l) -- qsort outperforms counting sort for small arrays- | l <= 20 = unsafeCreate l $ \ptr -> unsafeWithForeignPtr input $ \inp -> do- memcpy ptr inp (fromIntegral l)- c_sort ptr (fromIntegral l)- | otherwise = unsafeCreate l $ \p -> allocaArray 256 $ \arr -> do+ | l <= 20 = unsafeCreateFp l $ \destFP -> do+ memcpyFp destFP input l+ unsafeWithForeignPtr destFP $ \dest -> c_sort dest (fromIntegral l)+ | otherwise = unsafeCreateFp l $ \p -> allocaArray 256 $ \arr -> do - _ <- memset (castPtr arr) 0 (256 * fromIntegral (sizeOf (undefined :: CSize)))+ 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)- go 0 p+ 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 ()@@ -1735,16 +1775,18 @@ -- subcomputation finishes. useAsCString :: ByteString -> (CString -> IO a) -> IO a useAsCString (BS fp l) action =- allocaBytes (l+1) $ \buf ->- -- Cannot use unsafeWithForeignPtr, because action can diverge- withForeignPtr fp $ \p -> do- memcpy buf p (fromIntegral l)- pokeByteOff buf l (0::Word8)- action (castPtr buf)+ allocaBytes (l+1) $ \buf -> do+ unsafeWithForeignPtr fp $ \p -> copyBytes buf p l+ pokeByteOff buf l (0::Word8)+ action (castPtr buf) --- | /O(n) construction/ Use a @ByteString@ with a function requiring a @CStringLen@.--- As for @useAsCString@ this function makes a copy of the original @ByteString@.+-- | /O(n) construction/ Use a @ByteString@ with a function requiring a 'CStringLen'.+-- As for 'useAsCString' this function makes a copy of the original @ByteString@. -- It must not be stored or used after the subcomputation finishes.+--+-- Beware that this function is not required to add a terminating @\NUL@ byte at the end of the 'CStringLen' it provides.+-- If you need to construct a pointer to a null-terminated sequence, use 'useAsCString'+-- (and measure length independently if desired). useAsCStringLen :: ByteString -> (CStringLen -> IO a) -> IO a useAsCStringLen p@(BS _ l) f = useAsCString p $ \cstr -> f (cstr,l) @@ -1764,8 +1806,8 @@ -- The @ByteString@ is a normal Haskell value and will be managed on the -- Haskell heap. packCStringLen :: CStringLen -> IO ByteString-packCStringLen (cstr, len) | len >= 0 = create len $ \p ->- memcpy p (castPtr cstr) (fromIntegral len)+packCStringLen (cstr, len) | len >= 0 = createFp len $ \fp ->+ unsafeWithForeignPtr fp $ \p -> copyBytes p (castPtr cstr) len packCStringLen (_, len) = moduleErrorIO "packCStringLen" ("negative length: " ++ show len) @@ -1778,8 +1820,7 @@ -- is needed in the rest of the program. -- copy :: ByteString -> ByteString-copy (BS x l) = unsafeCreate l $ \p -> unsafeWithForeignPtr x $ \f ->- memcpy p f (fromIntegral l)+copy (BS x l) = unsafeCreateFp l $ \p -> memcpyFp p x l -- --------------------------------------------------------------------- -- Line IO@@ -1788,8 +1829,11 @@ getLine :: IO ByteString getLine = hGetLine stdin --- | Read a line from a handle+{-# DEPRECATED getLine+ "Deprecated since @bytestring-0.12@. Use 'Data.ByteString.Char8.getLine' instead. (Functions that rely on ASCII encodings belong in \"Data.ByteString.Char8\")"+ #-} +-- | Read a line from a handle hGetLine :: Handle -> IO ByteString hGetLine h = wantReadableHandle_ "Data.ByteString.hGetLine" h $@@ -1836,10 +1880,13 @@ then return r -- NB. not r+1: don't include the '\n' else findEOL (r+1) w raw +{-# DEPRECATED hGetLine+ "Deprecated since @bytestring-0.12@. Use 'Data.ByteString.Char8.hGetLine' instead. (Functions that rely on ASCII encodings belong in \"Data.ByteString.Char8\")"+ #-}+ mkPS :: RawBuffer Word8 -> Int -> Int -> IO ByteString mkPS buf start end =- create len $ \p ->- withRawBuffer buf $ \pbuf -> copyBytes p (pbuf `plusPtr` start) len+ createFp len $ \fp -> memcpyFp fp (buf `plusForeignPtr` start) len where len = end - start @@ -1868,11 +1915,11 @@ bytesWritten <- unsafeWithForeignPtr ps $ \p-> hPutBufNonBlocking h p l return $! drop bytesWritten bs --- | A synonym for @hPut@, for compatibility+-- | A synonym for 'hPut', for compatibility hPutStr :: Handle -> ByteString -> IO () hPutStr = hPut --- | Write a ByteString to stdout+-- | Write a ByteString to 'stdout'. putStr :: ByteString -> IO () putStr = hPut stdout @@ -1892,7 +1939,8 @@ -- hGet :: Handle -> Int -> IO ByteString hGet h i- | i > 0 = createAndTrim i $ \p -> hGetBuf h p i+ | i > 0 = createFpAndTrim i $ \fp ->+ unsafeWithForeignPtr fp $ \p -> hGetBuf h p i | i == 0 = return empty | otherwise = illegalBufferSize h "hGet" i @@ -1906,7 +1954,8 @@ -- hGetNonBlocking :: Handle -> Int -> IO ByteString hGetNonBlocking h i- | i > 0 = createAndTrim i $ \p -> hGetBufNonBlocking h p i+ | i > 0 = createFpAndTrim i $ \fp ->+ unsafeWithForeignPtr fp $ \p -> hGetBufNonBlocking h p i | i == 0 = return empty | otherwise = illegalBufferSize h "hGetNonBlocking" i @@ -1917,7 +1966,8 @@ -- hGetSome :: Handle -> Int -> IO ByteString hGetSome hh i- | i > 0 = createAndTrim i $ \p -> hGetBufSome hh p i+ | i > 0 = createFpAndTrim i $ \fp ->+ unsafeWithForeignPtr fp $ \p -> hGetBufSome hh p i | i == 0 = return empty | otherwise = illegalBufferSize hh "hGetSome" i
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)@@ -26,10 +27,10 @@ 'Builder's support (a) by providing an /O(1)/ concatentation operation and efficient implementations of basic encodings for 'Char's, 'Int's, and other standard Haskell values.-They support (b) by providing their result as a lazy 'L.ByteString',+They support (b) by providing their result as a 'L.LazyByteString', which is internally just a linked list of pointers to /chunks/ of consecutive raw memory.-Lazy 'L.ByteString's can be efficiently consumed by functions that+'L.LazyByteString's can be efficiently consumed by functions that write them to a file or send them over a network socket. Note that each chunk boundary incurs expensive extra work (e.g., a system call) that must be amortized over the work spent on consuming the chunk body.@@ -51,18 +52,12 @@ >type Row = [Cell] >type Table = [Row] -We use the following imports and abbreviate 'mappend' to simplify reading.+We use the following imports. @ import qualified "Data.ByteString.Lazy" as L import "Data.ByteString.Builder"-import Data.Monoid-import Data.Foldable ('Data.Foldable.foldMap') import Data.List ('Data.List.intersperse')--infixr 4 \<\>-(\<\>) :: 'Monoid' m => m -> m -> m-(\<\>) = 'mappend' @ CSV is a character-based representation of tables. For maximal modularity,@@ -71,15 +66,15 @@ due to the intermediate 'String' representation being built and thrown away right afterwards. We get rid of this intermediate 'String' representation by fixing the character encoding to UTF-8 and using 'Builder's to convert-@Table@s directly to UTF-8 encoded CSV tables represented as lazy-'L.ByteString's.+@Table@s directly to UTF-8 encoded CSV tables represented as+'L.LazyByteString's. @-encodeUtf8CSV :: Table -> L.ByteString+encodeUtf8CSV :: Table -> L.LazyByteString encodeUtf8CSV = 'toLazyByteString' . renderTable renderTable :: Table -> Builder-renderTable rs = 'mconcat' [renderRow r \<\> 'charUtf8' \'\\n\' | r <- rs]+renderTable rs = 'mconcat' [renderRow r '<>' 'charUtf8' \'\\n\' | r <- rs] renderRow :: Row -> Builder renderRow [] = 'mempty'@@ -91,7 +86,7 @@ renderCell (IntC i) = 'intDec' i renderString :: String -> Builder-renderString cs = charUtf8 \'\"\' \<\> foldMap escape cs \<\> charUtf8 \'\"\'+renderString cs = charUtf8 \'\"\' \<\> 'foldMap' escape cs \<\> charUtf8 \'\"\' where escape \'\\\\\' = charUtf8 \'\\\\\' \<\> charUtf8 \'\\\\\' escape \'\\\"\' = charUtf8 \'\\\\\' \<\> charUtf8 \'\\\"\'@@ -120,7 +115,7 @@ @ The expression @encodeUtf8CSV table@ results in the following lazy-'L.ByteString'.+'L.LazyByteString'. >Chunk "\"hello\",\"\\\"1\\\"\",\"\206\187-w\195\182rld\"\n-3,-2,-1,0,1,2,3\n" Empty @@ -143,7 +138,7 @@ > ] On a Core2 Duo 2.20GHz on a 32-bit Linux,- the above code takes 1ms to generate the 22'500 bytes long lazy 'L.ByteString'.+ the above code takes 1ms to generate the 22'500 bytes long 'L.LazyByteString'. Looking again at the definitions above, we see that we took care to avoid intermediate data structures, as otherwise we would sacrifice performance.@@ -154,7 +149,7 @@ >renderRow = mconcat . intersperse (charUtf8 ',') . map renderCell Similarly, using /O(n)/ concatentations like '++' or the equivalent 'Data.ByteString.concat'- operations on strict and lazy 'L.ByteString's should be avoided.+ operations on strict and 'L.LazyByteString's should be avoided. The following definition of @renderString@ is also about 20% slower. >renderString :: String -> Builder@@ -184,7 +179,7 @@ -- signal to the driver telling it that it is either done, has filled the -- current buffer, or wants to directly insert a reference to a chunk of -- memory. In the last two cases, the 'Builder' also returns a- -- continutation 'Builder' that the driver can call to fill the next+ -- continuation 'Builder' that the driver can call to fill the next -- buffer. Here, we provide the two drivers that satisfy almost all use -- cases. See "Data.ByteString.Builder.Extra", for information -- about fine-tuning them.@@ -260,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 @@ -269,14 +263,6 @@ import Foreign import GHC.Base (unpackCString#, unpackCStringUtf8#, unpackFoldrCString#, build)---- | Execute a 'Builder' and return the generated chunks as a lazy 'L.ByteString'.--- The work is performed lazy, i.e., only when a chunk of the lazy 'L.ByteString'--- is forced.-{-# NOINLINE toLazyByteString #-} -- ensure code is shared-toLazyByteString :: Builder -> L.ByteString-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/ASCII.hs view
@@ -1,6 +1,3 @@-{-# LANGUAGE ForeignFunctionInterface #-}-{-# LANGUAGE Trustworthy #-}- {-# OPTIONS_HADDOCK not-home #-} -- | Copyright : (c) 2010 - 2011 Simon Meier@@ -82,9 +79,10 @@ import qualified Data.ByteString.Builder.Prim as P import qualified Data.ByteString.Builder.Prim.Internal as P import Data.ByteString.Builder.RealFloat (floatDec, doubleDec)+import Data.ByteString.Internal.Type (c_int_dec_padded9, c_long_long_int_dec_padded18) import Foreign-import Foreign.C.Types+import Data.List.NonEmpty (NonEmpty(..)) ------------------------------------------------------------------------------ -- Decimal Encoding@@ -240,14 +238,14 @@ doubleHexFixed :: Double -> Builder doubleHexFixed = P.primFixed P.doubleHexFixed --- | Encode each byte of a 'S.ByteString' using its fixed-width hex encoding.+-- | Encode each byte of a 'S.StrictByteString' using its fixed-width hex encoding. {-# NOINLINE byteStringHex #-} -- share code-byteStringHex :: S.ByteString -> Builder+byteStringHex :: S.StrictByteString -> Builder byteStringHex = P.primMapByteStringFixed P.word8HexFixed --- | Encode each byte of a lazy 'L.ByteString' using its fixed-width hex encoding.+-- | Encode each byte of a 'L.LazyByteString' using its fixed-width hex encoding. {-# NOINLINE lazyByteStringHex #-} -- share code-lazyByteStringHex :: L.ByteString -> Builder+lazyByteStringHex :: L.LazyByteString -> Builder lazyByteStringHex = P.primMapLazyByteStringFixed P.word8HexFixed @@ -276,37 +274,31 @@ | i < 0 = P.primFixed P.char8 '-' `mappend` go (-i) | otherwise = go i where- errImpossible fun =- error $ "integerDec: " ++ fun ++ ": the impossible happened."- go :: Integer -> Builder go n | n < maxPow10 = intDec (fromInteger n) | otherwise = case putH (splitf (maxPow10 * maxPow10) n) of- (x:xs) -> intDec x `mappend` P.primMapListBounded intDecPadded xs- [] -> errImpossible "integerDec: go"+ x:|xs -> intDec x `mappend` P.primMapListBounded intDecPadded xs - splitf :: Integer -> Integer -> [Integer]+ splitf :: Integer -> Integer -> NonEmpty Integer splitf pow10 n0- | pow10 > n0 = [n0]+ | pow10 > n0 = n0 :| [] | otherwise = splith (splitf (pow10 * pow10) n0) where- splith [] = errImpossible "splith"- splith (n:ns) =+ splith (n:|ns) = case n `quotRem` pow10 of- (q,r) | q > 0 -> q : r : splitb ns- | otherwise -> r : splitb ns+ (q,r) | q > 0 -> q :| r : splitb ns+ | otherwise -> r :| splitb ns splitb [] = [] splitb (n:ns) = case n `quotRem` pow10 of (q,r) -> q : r : splitb ns - putH :: [Integer] -> [Int]- putH [] = errImpossible "putH"- putH (n:ns) = case n `quotRem` maxPow10 of+ putH :: NonEmpty Integer -> NonEmpty Int+ putH (n:|ns) = case n `quotRem` maxPow10 of (x,y)- | q > 0 -> q : r : putB ns- | otherwise -> r : putB ns+ | q > 0 -> q :| r : putB ns+ | otherwise -> r :| putB ns where q = fromInteger x r = fromInteger y @@ -315,12 +307,6 @@ putB (n:ns) = case n `quotRem` maxPow10 of (q,r) -> fromInteger q : fromInteger r : putB ns --foreign import ccall unsafe "static _hs_bytestring_int_dec_padded9"- c_int_dec_padded9 :: CInt -> Ptr Word8 -> IO ()--foreign import ccall unsafe "static _hs_bytestring_long_long_int_dec_padded18"- c_long_long_int_dec_padded18 :: CLLong -> Ptr Word8 -> IO () {-# INLINE intDecPadded #-} intDecPadded :: P.BoundedPrim Int
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@@ -78,7 +78,7 @@ -- * an IO action for writing the Builder's data into a user-supplied memory -- buffer. ----- * a pre-existing chunks of data represented by a strict 'S.ByteString'+-- * a pre-existing chunks of data represented by a 'S.StrictByteString' -- -- While this is rather low level, it provides you with full flexibility in -- how the data is written out.@@ -107,10 +107,10 @@ -- | In addition to the data that has just been written into your buffer -- by the 'BufferWriter' action, it gives you a pre-existing chunk- -- of data as a 'S.ByteString'. It also gives you the following 'BufferWriter'+ -- of data as a 'S.StrictByteString'. It also gives you the following 'BufferWriter' -- action. It is safe to run this following action using a buffer with as -- much free space as was left by the previous run action.- | Chunk !S.ByteString BufferWriter+ | Chunk !S.StrictByteString BufferWriter -- | Turn a 'Builder' into its initial 'BufferWriter' action. --
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,13 +131,15 @@ ) where import Control.Arrow (second)+import Control.DeepSeq (NFData(..))+import GHC.Exts (IsList(..)) -#if !(MIN_VERSION_base(4,11,0))-import Data.Semigroup (Semigroup((<>)))-#endif+import Data.Semigroup (Semigroup(..))+import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.ByteString as S-import qualified Data.ByteString.Internal 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 @@ -155,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 #-}@@ -175,17 +192,17 @@ let pbuf = unsafeForeignPtrToPtr fpbuf return $! Buffer fpbuf (BufferRange pbuf (pbuf `plusPtr` size)) --- | Convert the filled part of a 'Buffer' to a strict 'S.ByteString'.+-- | Convert the filled part of a 'Buffer' to a 'S.StrictByteString'. {-# INLINE byteStringFromBuffer #-}-byteStringFromBuffer :: Buffer -> S.ByteString+byteStringFromBuffer :: Buffer -> S.StrictByteString byteStringFromBuffer (Buffer fpbuf (BufferRange op _)) = S.BS fpbuf (op `minusPtr` unsafeForeignPtrToPtr fpbuf) --- | Prepend the filled part of a 'Buffer' to a lazy 'L.ByteString'+-- | Prepend the filled part of a 'Buffer' to a 'L.LazyByteString' -- trimming it if necessary. {-# INLINE trimmedChunkFromBuffer #-} trimmedChunkFromBuffer :: AllocationStrategy -> Buffer- -> L.ByteString -> L.ByteString+ -> L.LazyByteString -> L.LazyByteString trimmedChunkFromBuffer (AllocationStrategy _ _ trim) buf k | S.null bs = k | trim (S.length bs) (bufferSize buf) = L.Chunk (S.copy bs) k@@ -206,33 +223,33 @@ data ChunkIOStream a = Finished Buffer a -- ^ The partially filled last buffer together with the result.- | Yield1 S.ByteString (IO (ChunkIOStream a))- -- ^ Yield a /non-empty/ strict 'S.ByteString'.+ | Yield1 S.StrictByteString (IO (ChunkIOStream a))+ -- ^ Yield a /non-empty/ 'S.StrictByteString'. -- | A smart constructor for yielding one chunk that ignores the chunk if -- it is empty. {-# INLINE yield1 #-}-yield1 :: S.ByteString -> IO (ChunkIOStream a) -> IO (ChunkIOStream a)+yield1 :: S.StrictByteString -> IO (ChunkIOStream a) -> IO (ChunkIOStream a) yield1 bs cios | S.null bs = cios | otherwise = return $ Yield1 bs cios --- | Convert a @'ChunkIOStream' ()@ to a lazy 'L.ByteString' using+-- | Convert a @'ChunkIOStream' ()@ to a 'L.LazyByteString' using -- 'unsafeDupablePerformIO'. {-# INLINE ciosUnitToLazyByteString #-} ciosUnitToLazyByteString :: AllocationStrategy- -> L.ByteString -> ChunkIOStream () -> L.ByteString+ -> L.LazyByteString -> ChunkIOStream () -> L.LazyByteString ciosUnitToLazyByteString strategy k = go where go (Finished buf _) = trimmedChunkFromBuffer strategy buf k go (Yield1 bs io) = L.Chunk bs $ unsafeDupablePerformIO (go <$> io) -- | Convert a 'ChunkIOStream' to a lazy tuple of the result and the written--- 'L.ByteString' using 'unsafeDupablePerformIO'.+-- 'L.LazyByteString' using 'unsafeDupablePerformIO'. {-# INLINE ciosToLazyByteString #-} ciosToLazyByteString :: AllocationStrategy- -> (a -> (b, L.ByteString))+ -> (a -> (b, L.LazyByteString)) -> ChunkIOStream a- -> (b, L.ByteString)+ -> (b, L.LazyByteString) ciosToLazyByteString strategy k = go where@@ -258,7 +275,7 @@ (BuildStep a) | InsertChunk {-# UNPACK #-} !(Ptr Word8)- S.ByteString+ S.StrictByteString (BuildStep a) -- | Signal that the current 'BuildStep' is done and has computed a value.@@ -283,11 +300,11 @@ bufferFull = BufferFull --- | Signal that a 'S.ByteString' chunk should be inserted directly.+-- | Signal that a 'S.StrictByteString' chunk should be inserted directly. {-# INLINE insertChunk #-} insertChunk :: Ptr Word8 -- ^ Next free byte in current 'BufferRange'- -> S.ByteString+ -> S.StrictByteString -- ^ Chunk to insert. -> BuildStep a -- ^ 'BuildStep' to run on next 'BufferRange'@@ -304,7 +321,7 @@ -- ^ Handling the 'done' signal -> (Ptr Word8 -> Int -> BuildStep a -> IO b) -- ^ Handling the 'bufferFull' signal- -> (Ptr Word8 -> S.ByteString -> BuildStep a -> IO b)+ -> (Ptr Word8 -> S.StrictByteString -> BuildStep a -> IO b) -- ^ Handling the 'insertChunk' signal -> BufferRange -- ^ Buffer range to fill.@@ -340,7 +357,7 @@ -- multiple times with equally sized 'BufferRange's must result in the -- same sequence of bytes being written. If you need mutable state, -- then you must allocate it anew upon each call of this function.- -- Moroever, this function must call the continuation once its done.+ -- Moreover, this function must call the continuation once its done. -- Otherwise, concatenation of 'Builder's does not work. Finally, this -- function must write to all bytes that it claims it has written. -- Otherwise, the resulting 'Builder' is not guaranteed to be@@ -370,11 +387,14 @@ -- only exported for use in rewriting rules. Use 'mempty' otherwise. {-# INLINE[1] empty #-} empty :: Builder-empty = Builder ($)+empty = Builder (\k br -> k br) -- This eta expansion (hopefully) allows GHC to worker-wrapper the -- 'BufferRange' in the 'empty' base case of loops (since -- worker-wrapper requires (TODO: verify this) that all paths match -- against the wrapped argument.+--+-- Do not use ($), which has arity 1 since base-4.19.+-- See also https://gitlab.haskell.org/ghc/ghc/-/issues/23822 -- | Concatenate two 'Builder's. This function is only exported for use in rewriting -- rules. Use 'mappend' otherwise.@@ -382,9 +402,26 @@ append :: Builder -> Builder -> Builder append (Builder b1) (Builder b2) = Builder $ b1 . b2 +stimesBuilder :: Integral t => t -> Builder -> Builder+{-# INLINABLE stimesBuilder #-}+stimesBuilder n b+ | n >= 0 = go n+ | otherwise = stimesNegativeErr+ where go 0 = empty+ go k = b `append` go (k - 1)++stimesNegativeErr :: Builder+-- See Note [Float error calls out of INLINABLE things]+-- in Data.ByteString.Internal.Type+stimesNegativeErr+ = errorWithoutStackTrace "stimes @Builder: non-negative multiplier expected"+ instance Semigroup Builder where {-# INLINE (<>) #-} (<>) = append+ sconcat (b:|bs) = b <> foldr mappend mempty bs+ {-# INLINE stimes #-}+ stimes = stimesBuilder instance Monoid Builder where {-# INLINE mempty #-}@@ -394,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@@ -417,7 +461,7 @@ -- compression library or the conversion from Base64 encoded data to -- 8-bit data). For a 'Builder', the only way to handle and report such a -- failure is ignore it or call 'error'. In contrast, 'Put' actions are--- expressive enough to allow reportng and handling such a failure in a pure+-- expressive enough to allow reporting and handling such a failure in a pure -- fashion. -- -- @'Put' ()@ actions are isomorphic to 'Builder's. The functions 'putBuilder'@@ -440,7 +484,7 @@ -- multiple times with equally sized 'BufferRange's must result in the -- same sequence of bytes being written and the same value being -- computed. If you need mutable state, then you must allocate it anew- -- upon each call of this function. Moroever, this function must call+ -- upon each call of this function. Moreover, this function must call -- the continuation once its done. Otherwise, monadic sequencing of -- 'Put's does not work. Finally, this function must write to all bytes -- that it claims it has written. Otherwise, the resulting 'Put' is@@ -596,9 +640,9 @@ -- -- 1. GHC.IO.Handle.Internals mentions in "Note [async]" that -- we should never do any side-effecting operations before- -- an interuptible operation that may raise an async. exception+ -- an interruptible operation that may raise an async. exception -- as long as we are inside 'wantWritableHandle' and the like.- -- We possibly run the interuptible 'flushWriteBuffer' right at+ -- We possibly run the interruptible 'flushWriteBuffer' right at -- the start of 'fillHandle', hence entering it a second time is -- not safe, as it could lead to a 'BuildStep' being run twice. --@@ -680,7 +724,7 @@ fillHandle 1 nextStep -- | Execute a 'Put' and return the computed result and the bytes--- written during the computation as a lazy 'L.ByteString'.+-- written during the computation as a 'L.LazyByteString'. -- -- This function is strict in the computed result and lazy in the writing of -- the bytes. For example, given@@ -709,15 +753,15 @@ -- @ --type DecodingState = ... -----decodeBase64 :: 'S.ByteString' -> DecodingState -> 'Put' (Maybe DecodingState)+--decodeBase64 :: 'S.StrictByteString' -> DecodingState -> 'Put' (Maybe DecodingState) --decodeBase64 = ... -- @ ----- The above function takes a strict 'S.ByteString' supposed to represent+-- The above function takes a 'S.StrictByteString' supposed to represent -- Base64 encoded data and the current decoding state. -- It writes the decoded bytes as the side-effect of the 'Put' and returns the--- new decoding state, if the decoding of all data in the 'S.ByteString' was--- successful. The checking if the strict 'S.ByteString' represents Base64+-- new decoding state, if the decoding of all data in the 'S.StrictByteString' was+-- successful. The checking if the 'S.StrictByteString' represents Base64 -- encoded data and the actual decoding are fused. This makes the common case, -- where all data represents Base64 encoded data, more efficient. It also -- implies that all data must be decoded before the final decoding@@ -727,7 +771,7 @@ {-# NOINLINE putToLazyByteString #-} putToLazyByteString :: Put a -- ^ 'Put' to execute- -> (a, L.ByteString) -- ^ Result and lazy 'L.ByteString'+ -> (a, L.LazyByteString) -- ^ Result and 'L.LazyByteString' -- written as its side-effect putToLazyByteString = putToLazyByteStringWith (safeStrategy L.smallChunkSize L.defaultChunkSize) (, L.Empty)@@ -745,13 +789,13 @@ putToLazyByteStringWith :: AllocationStrategy -- ^ Buffer allocation strategy to use- -> (a -> (b, L.ByteString))+ -> (a -> (b, L.LazyByteString)) -- ^ Continuation to use for computing the final result and the tail of -- its side-effect (the written bytes). -> Put a -- ^ 'Put' to execute- -> (b, L.ByteString)- -- ^ Resulting lazy 'L.ByteString'+ -> (b, L.LazyByteString)+ -- ^ Resulting 'L.LazyByteString' putToLazyByteStringWith strategy k p = ciosToLazyByteString strategy k $ unsafeDupablePerformIO $ buildStepToCIOS strategy (runPut p)@@ -776,84 +820,132 @@ | 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 ------------------------------------------------------------------------------ --- | Construct a 'Builder' that copies the strict 'S.ByteString's, if it is+-- | Construct a 'Builder' that copies the 'S.StrictByteString's, if it is -- smaller than the treshold, and inserts it directly otherwise. ----- For example, @byteStringThreshold 1024@ copies strict 'S.ByteString's whose size+-- For example, @byteStringThreshold 1024@ copies 'S.StrictByteString's whose size -- is less or equal to 1kb, and inserts them directly otherwise. This implies--- that the average chunk-size of the generated lazy 'L.ByteString' may be as+-- that the average chunk-size of the generated 'L.LazyByteString' may be as -- low as 513 bytes, as there could always be just a single byte between the--- directly inserted 1025 byte, strict 'S.ByteString's.+-- directly inserted 1025 byte, 'S.StrictByteString's. -- {-# INLINE byteStringThreshold #-}-byteStringThreshold :: Int -> S.ByteString -> Builder+byteStringThreshold :: Int -> S.StrictByteString -> Builder 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 --- | Construct a 'Builder' that copies the strict 'S.ByteString'.+-- | Construct a 'Builder' that copies the 'S.StrictByteString'. -- -- Use this function to create 'Builder's from smallish (@<= 4kb@)--- 'S.ByteString's or if you need to guarantee that the 'S.ByteString' is not+-- 'S.StrictByteString's or if you need to guarantee that the 'S.StrictByteString' is not -- shared with the chunks generated by the 'Builder'. -- {-# INLINE byteStringCopy #-}-byteStringCopy :: S.ByteString -> Builder+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.ByteString -> 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+byteStringCopyStep :: S.StrictByteString -> BuildStep a -> BuildStep a+-- 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 strict 'S.ByteString'+-- | Construct a 'Builder' that always inserts the 'S.StrictByteString' -- directly as a chunk. -- -- This implies flushing the output buffer, even if it contains just -- a single byte. You should therefore use 'byteStringInsert' only for large--- (@> 8kb@) 'S.ByteString's. Otherwise, the generated chunks are too+-- (@> 8kb@) 'S.StrictByteString's. Otherwise, the generated chunks are too -- fragmented to be processed efficiently afterwards. -- {-# INLINE byteStringInsert #-}-byteStringInsert :: S.ByteString -> Builder+byteStringInsert :: S.StrictByteString -> Builder byteStringInsert = \bs -> builder $ \k (BufferRange op _) -> return $ insertChunk op bs k @@ -891,47 +983,47 @@ ------------------------------------------------------------------------------ -- | Construct a 'Builder' that uses the thresholding strategy of 'byteStringThreshold'--- for each chunk of the lazy 'L.ByteString'.+-- for each chunk of the 'L.LazyByteString'. -- {-# INLINE lazyByteStringThreshold #-}-lazyByteStringThreshold :: Int -> L.ByteString -> Builder+lazyByteStringThreshold :: Int -> L.LazyByteString -> Builder lazyByteStringThreshold maxCopySize = L.foldrChunks (\bs b -> byteStringThreshold maxCopySize bs `mappend` b) mempty -- TODO: We could do better here. Currently, Large, Small, Large, leads to -- an unnecessary copy of the 'Small' chunk. --- | Construct a 'Builder' that copies the lazy 'L.ByteString'.+-- | Construct a 'Builder' that copies the 'L.LazyByteString'. -- {-# INLINE lazyByteStringCopy #-}-lazyByteStringCopy :: L.ByteString -> Builder+lazyByteStringCopy :: L.LazyByteString -> Builder lazyByteStringCopy = L.foldrChunks (\bs b -> byteStringCopy bs `mappend` b) mempty --- | Construct a 'Builder' that inserts all chunks of the lazy 'L.ByteString'+-- | Construct a 'Builder' that inserts all chunks of the 'L.LazyByteString' -- directly. -- {-# INLINE lazyByteStringInsert #-}-lazyByteStringInsert :: L.ByteString -> Builder+lazyByteStringInsert :: L.LazyByteString -> Builder lazyByteStringInsert = L.foldrChunks (\bs b -> byteStringInsert bs `mappend` b) mempty --- | Create a 'Builder' denoting the same sequence of bytes as a strict--- 'S.ByteString'.--- The 'Builder' inserts large 'S.ByteString's directly, but copies small ones+-- | Create a 'Builder' denoting the same sequence of bytes as a+-- 'S.StrictByteString'.+-- The 'Builder' inserts large 'S.StrictByteString's directly, but copies small ones -- to ensure that the generated chunks are large on average. -- {-# INLINE byteString #-}-byteString :: S.ByteString -> Builder+byteString :: S.StrictByteString -> Builder byteString = byteStringThreshold maximalCopySize -- | Create a 'Builder' denoting the same sequence of bytes as a lazy--- 'L.ByteString'.--- The 'Builder' inserts large chunks of the lazy 'L.ByteString' directly,+-- 'L.LazyByteString'.+-- The 'Builder' inserts large chunks of the 'L.LazyByteString' directly, -- but copies small ones to ensure that the generated chunks are large on -- average. -- {-# INLINE lazyByteString #-}-lazyByteString :: L.ByteString -> Builder+lazyByteString :: L.LazyByteString -> Builder lazyByteString = lazyByteStringThreshold maximalCopySize -- FIXME: also insert the small chunk for [large,small,large] directly. -- Perhaps it makes even sense to concatenate the small chunks in@@ -939,7 +1031,7 @@ -- unnecessary buffer spilling. Hmm, but that uncontrollably increases latency -- => no good! --- | The maximal size of a 'S.ByteString' that is copied.+-- | The maximal size of a 'S.StrictByteString' that is copied. -- @2 * 'L.smallChunkSize'@ to guarantee that on average a chunk is of -- 'L.smallChunkSize'. maximalCopySize :: Int@@ -950,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@@ -968,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)@@ -986,7 +1079,7 @@ sanitize :: Int -> Int sanitize = max (sizeOf (undefined :: Int)) --- | Use this strategy for generating lazy 'L.ByteString's whose chunks are+-- | Use this strategy for generating 'L.LazyByteString's whose chunks are -- discarded right after they are generated. For example, if you just generate -- them to write them to a network socket. {-# INLINE untrimmedStrategy #-}@@ -1003,7 +1096,7 @@ nextBuffer (Just (_, minSize)) = newBuffer minSize --- | Use this strategy for generating lazy 'L.ByteString's whose chunks are+-- | Use this strategy for generating 'L.LazyByteString's whose chunks are -- likely to survive one garbage collection. This strategy trims buffers -- that are filled less than half in order to avoid spilling too much memory. {-# INLINE safeStrategy #-}@@ -1020,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 lazy 'L.ByteString'.+-- 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@@ -1040,23 +1141,23 @@ -- 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.ByteString's fit into the first buffer and there is no trimming+-- 'L.LazyByteString's fit into the first buffer and there is no trimming -- required, if more than 64 bytes and less than 128 bytes are written. -- {-# INLINE toLazyByteStringWith #-} toLazyByteStringWith :: AllocationStrategy -- ^ Buffer allocation strategy to use- -> L.ByteString- -- ^ Lazy 'L.ByteString' to use as the tail of the generated lazy- -- 'L.ByteString'+ -> L.LazyByteString+ -- ^ 'L.LazyByteString' to use as the tail of the generated lazy+ -- 'L.LazyByteString' -> Builder -- ^ 'Builder' to execute- -> L.ByteString- -- ^ Resulting lazy 'L.ByteString'+ -> L.LazyByteString+ -- ^ Resulting 'L.LazyByteString' toLazyByteStringWith strategy k b = ciosUnitToLazyByteString strategy k $ unsafeDupablePerformIO $ buildStepToCIOS strategy (runBuilder b)@@ -1065,26 +1166,32 @@ -- '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.StrictByteString -> BuildStep a -> IO (ChunkIOStream a) insertChunkH op' bs nextStep = wrapChunk op' $ \isEmpty -> yield1 bs $ -- Checking for empty case avoids allocating 'n-1' empty@@ -1096,12 +1203,14 @@ -- 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.create chunkSize $ \pbuf' ->- copyBytes pbuf' pbuf chunkSize- -- FIXME: We could reuse the trimmed buffer here.+ bs <- S.createFp chunkSize $ \fpbuf' ->+ S.memcpyFp fpbuf' fpbuf chunkSize+ -- 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)
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)@@ -269,9 +267,9 @@ -- > map :: (Word8 -> Word8) -> ByteString -> ByteString -- > map f = toLazyByteString . encodeLazyByteStringWithB (E.word8 E.#. f) ----- Compared to earlier versions of @filter@ and @map@ on lazy 'L.ByteString's,+-- Compared to earlier versions of @filter@ and @map@ on 'L.LazyByteString's, -- these versions use a more efficient inner loop and have the additional--- advantage that they always result in well-chunked 'L.ByteString's; i.e, they+-- advantage that they always result in well-chunked 'L.LazyByteString's; i.e, they -- also perform automatic defragmentation. -- -- We can also use 'E.Encoding's to improve the efficiency of the following@@ -398,7 +396,7 @@ -- which is implemented as follows. -- -- @- -- byteStringHex :: S.ByteString -> Builder+ -- byteStringHex :: S.StrictByteString -> Builder -- byteStringHex = 'primMapByteStringFixed' 'word8HexFixed' -- @ --@@ -439,7 +437,7 @@ {- -- * Testing support -- | The following four functions are intended for testing use- -- only. They are /not/ efficient. Basic encodings are efficently executed by+ -- only. They are /not/ efficient. Basic encodings are efficiently executed by -- creating 'Builder's from them using the @encodeXXX@ functions explained at -- the top of this module. @@ -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@@ -492,24 +487,24 @@ primUnfoldrFixed :: FixedPrim b -> (a -> Maybe (b, a)) -> a -> Builder primUnfoldrFixed = primUnfoldrBounded . toB --- | /Heavy inlining./ Encode all bytes of a strict 'S.ByteString' from+-- | /Heavy inlining./ Encode all bytes of a 'S.StrictByteString' from -- left-to-right with a 'FixedPrim'. This function is quite versatile. For -- example, we can use it to construct a 'Builder' that maps every byte before -- copying it to the buffer to be filled. ----- > mapToBuilder :: (Word8 -> Word8) -> S.ByteString -> Builder+-- > mapToBuilder :: (Word8 -> Word8) -> S.StrictByteString -> Builder -- > mapToBuilder f = primMapByteStringFixed (contramapF f word8) ----- We can also use it to hex-encode a strict 'S.ByteString' as shown by the+-- We can also use it to hex-encode a 'S.StrictByteString' as shown by the -- 'Data.ByteString.Builder.ASCII.byteStringHex' example above. {-# INLINE primMapByteStringFixed #-}-primMapByteStringFixed :: FixedPrim Word8 -> (S.ByteString -> Builder)+primMapByteStringFixed :: FixedPrim Word8 -> (S.StrictByteString -> Builder) primMapByteStringFixed = primMapByteStringBounded . toB --- | /Heavy inlining./ Encode all bytes of a lazy 'L.ByteString' from+-- | /Heavy inlining./ Encode all bytes of a 'L.LazyByteString' from -- left-to-right with a 'FixedPrim'. {-# INLINE primMapLazyByteStringFixed #-}-primMapLazyByteStringFixed :: FixedPrim Word8 -> (L.ByteString -> Builder)+primMapLazyByteStringFixed :: FixedPrim Word8 -> (L.LazyByteString -> Builder) primMapLazyByteStringFixed = primMapLazyByteStringBounded . toB -- IMPLEMENTATION NOTE: Sadly, 'encodeListWith' cannot be used for foldr/build@@ -530,11 +525,11 @@ -- at 8 free bytes, instead of checking twice, if there are 4 free bytes. This -- optimization is not observationally equivalent in a strict sense, as it -- influences the boundaries of the generated chunks. However, for a user of--- this library it is observationally equivalent, as chunk boundaries of a lazy--- 'L.ByteString' can only be observed through the internal interface.--- Morevoer, we expect that all primitives write much fewer than 4kb (the+-- this library it is observationally equivalent, as chunk boundaries of a+-- 'L.LazyByteString' can only be observed through the internal interface.+-- Moreover, we expect that all primitives write much fewer than 4kb (the -- default short buffer size). Hence, it is safe to ignore the additional--- memory spilled due to the more agressive buffer wrapping introduced by this+-- memory spilled due to the more aggressive buffer wrapping introduced by this -- optimization. -- {-# INLINE[1] primBounded #-}@@ -615,16 +610,16 @@ fillWith x' k (BufferRange opNew' opeNew) bound = I.sizeBound w --- | Create a 'Builder' that encodes each 'Word8' of a strict 'S.ByteString'+-- | Create a 'Builder' that encodes each 'Word8' of a 'S.StrictByteString' -- using a 'BoundedPrim'. For example, we can write a 'Builder' that filters--- a strict 'S.ByteString' as follows.+-- a 'S.StrictByteString' as follows. -- -- > import qualified Data.ByteString.Builder.Prim as P -- -- > filterBS p = P.condB p (P.liftFixedToBounded P.word8) P.emptyB -- {-# INLINE primMapByteStringBounded #-}-primMapByteStringBounded :: BoundedPrim Word8 -> S.ByteString -> Builder+primMapByteStringBounded :: BoundedPrim Word8 -> S.StrictByteString -> Builder primMapByteStringBounded w = \bs -> builder $ step bs where@@ -658,7 +653,7 @@ -- | Chunk-wise application of 'primMapByteStringBounded'. {-# INLINE primMapLazyByteStringBounded #-}-primMapLazyByteStringBounded :: BoundedPrim Word8 -> L.ByteString -> Builder+primMapLazyByteStringBounded :: BoundedPrim Word8 -> L.LazyByteString -> Builder primMapLazyByteStringBounded w = L.foldrChunks (\x b -> primMapByteStringBounded w x `mappend` b) mempty @@ -679,7 +674,7 @@ step !addr !k br@(BufferRange op0@(Ptr op0#) ope) | W8# ch == 0 = k br | op0 == ope =- return $ bufferFull defaultChunkSize op0 (step addr k)+ return $ bufferFull 1 op0 (step addr k) | otherwise = do IO $ \s -> case writeWord8OffAddr# op0# 0# ch s of s' -> (# s', () #)@@ -700,7 +695,7 @@ step !addr !k br@(BufferRange op0@(Ptr op0#) ope) | W8# ch == 0 = k br | op0 == ope =- return $ bufferFull defaultChunkSize op0 (step addr k)+ return $ bufferFull 1 op0 (step addr k) -- NULL is encoded as 0xc0 0x80 | W8# ch == 0xc0 , W8# (indexWord8OffAddr# addr 1#) == 0x80 = do
Data/ByteString/Builder/Prim/ASCII.hs view
@@ -1,5 +1,3 @@-{-# LANGUAGE ScopedTypeVariables, ForeignFunctionInterface #-}-{-# LANGUAGE Trustworthy #-} -- | Copyright : (c) 2010 Jasper Van der Jeugt -- (c) 2010 - 2011 Simon Meier -- License : BSD3-style (see LICENSE)@@ -77,15 +75,16 @@ ) where +import Data.ByteString.Internal.Type import Data.ByteString.Builder.Prim.Binary import Data.ByteString.Builder.Prim.Internal import Data.ByteString.Builder.Prim.Internal.Floating import Data.ByteString.Builder.Prim.Internal.Base16+import Data.ByteString.Utils.UnalignedAccess import Data.Char (ord) import Foreign-import Foreign.C.Types -- | Encode the least 7-bits of a 'Char' using the ASCII encoding. {-# INLINE char7 #-}@@ -100,12 +99,6 @@ -- Signed integers ------------------ -foreign import ccall unsafe "static _hs_bytestring_int_dec" c_int_dec- :: CInt -> Ptr Word8 -> IO (Ptr Word8)--foreign import ccall unsafe "static _hs_bytestring_long_long_int_dec" c_long_long_int_dec- :: CLLong -> Ptr Word8 -> IO (Ptr Word8)- {-# INLINE encodeIntDecimal #-} encodeIntDecimal :: Integral a => Int -> BoundedPrim a encodeIntDecimal bound = boundedPrim bound $ c_int_dec . fromIntegral@@ -142,12 +135,6 @@ -- Unsigned integers -------------------- -foreign import ccall unsafe "static _hs_bytestring_uint_dec" c_uint_dec- :: CUInt -> Ptr Word8 -> IO (Ptr Word8)--foreign import ccall unsafe "static _hs_bytestring_long_long_uint_dec" c_long_long_uint_dec- :: CULLong -> Ptr Word8 -> IO (Ptr Word8)- {-# INLINE encodeWordDecimal #-} encodeWordDecimal :: Integral a => Int -> BoundedPrim a encodeWordDecimal bound = boundedPrim bound $ c_uint_dec . fromIntegral@@ -186,12 +173,6 @@ -- without lead --------------- -foreign import ccall unsafe "static _hs_bytestring_uint_hex" c_uint_hex- :: CUInt -> Ptr Word8 -> IO (Ptr Word8)--foreign import ccall unsafe "static _hs_bytestring_long_long_uint_hex" c_long_long_uint_hex- :: CULLong -> Ptr Word8 -> IO (Ptr Word8)- {-# INLINE encodeWordHex #-} encodeWordHex :: forall a. (Storable a, Integral a) => BoundedPrim a encodeWordHex =@@ -231,8 +212,9 @@ -- | Encode a 'Word8' using 2 nibbles (hexadecimal digits). {-# INLINE word8HexFixed #-} word8HexFixed :: FixedPrim Word8-word8HexFixed = fixedPrim 2 $- \x op -> poke (castPtr op) =<< encode8_as_16h lowerTable x+word8HexFixed = fixedPrim 2 $ \x op -> do+ enc <- encode8_as_16h lowerTable x+ unalignedWriteU16 enc op -- | Encode a 'Word16' using 4 nibbles. {-# INLINE word16HexFixed #-}@@ -247,6 +229,7 @@ word32HexFixed = (\x -> (fromIntegral $ x `shiftR` 16, fromIntegral x)) >$< pairF word16HexFixed word16HexFixed+ -- | Encode a 'Word64' using 16 nibbles. {-# INLINE word64HexFixed #-} word64HexFixed :: FixedPrim Word64
Data/ByteString/Builder/Prim/Binary.hs view
@@ -1,5 +1,5 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE Trustworthy #-}+ -- | Copyright : (c) 2010-2011 Simon Meier -- License : BSD3-style (see LICENSE) --@@ -54,11 +54,11 @@ import Data.ByteString.Builder.Prim.Internal import Data.ByteString.Builder.Prim.Internal.Floating+import Data.ByteString.Utils.ByteOrder+import Data.ByteString.Utils.UnalignedAccess import Foreign -#include "MachDeps.h"- ------------------------------------------------------------------------------ -- Binary encoding ------------------------------------------------------------------------------@@ -70,7 +70,7 @@ -- {-# INLINE word8 #-} word8 :: FixedPrim Word8-word8 = storableToF+word8 = fixedPrim 1 (flip poke) -- Word8 is always aligned -- -- We rely on the fromIntegral to do the right masking for us.@@ -80,50 +80,22 @@ -- | Encoding 'Word16's in big endian format. {-# INLINE word16BE #-} word16BE :: FixedPrim Word16-#ifdef WORDS_BIGENDIAN-word16BE = word16Host-#else-word16BE = fixedPrim 2 $ \w p -> do- poke p (fromIntegral (shiftR w 8) :: Word8)- poke (p `plusPtr` 1) (fromIntegral w :: Word8)-#endif+word16BE = whenLittleEndian byteSwap16 >$< word16Host -- | Encoding 'Word16's in little endian format. {-# INLINE word16LE #-} word16LE :: FixedPrim Word16-#ifdef WORDS_BIGENDIAN-word16LE = fixedPrim 2 $ \w p -> do- poke p (fromIntegral w :: Word8)- poke (p `plusPtr` 1) (fromIntegral (shiftR w 8) :: Word8)-#else-word16LE = word16Host-#endif+word16LE = whenBigEndian byteSwap16 >$< word16Host -- | Encoding 'Word32's in big endian format. {-# INLINE word32BE #-} word32BE :: FixedPrim Word32-#ifdef WORDS_BIGENDIAN-word32BE = word32Host-#else-word32BE = fixedPrim 4 $ \w p -> do- poke p (fromIntegral (shiftR w 24) :: Word8)- poke (p `plusPtr` 1) (fromIntegral (shiftR w 16) :: Word8)- poke (p `plusPtr` 2) (fromIntegral (shiftR w 8) :: Word8)- poke (p `plusPtr` 3) (fromIntegral w :: Word8)-#endif+word32BE = whenLittleEndian byteSwap32 >$< word32Host -- | Encoding 'Word32's in little endian format. {-# INLINE word32LE #-} word32LE :: FixedPrim Word32-#ifdef WORDS_BIGENDIAN-word32LE = fixedPrim 4 $ \w p -> do- poke p (fromIntegral w :: Word8)- poke (p `plusPtr` 1) (fromIntegral (shiftR w 8) :: Word8)- poke (p `plusPtr` 2) (fromIntegral (shiftR w 16) :: Word8)- poke (p `plusPtr` 3) (fromIntegral (shiftR w 24) :: Word8)-#else-word32LE = word32Host-#endif+word32LE = whenBigEndian byteSwap32 >$< word32Host -- on a little endian machine: -- word32LE w32 = fixedPrim 4 (\w p -> poke (castPtr p) w32)@@ -131,70 +103,12 @@ -- | Encoding 'Word64's in big endian format. {-# INLINE word64BE #-} word64BE :: FixedPrim Word64-#ifdef WORDS_BIGENDIAN-word64BE = word64Host-#else-#if WORD_SIZE_IN_BITS < 64------ To avoid expensive 64 bit shifts on 32 bit machines, we cast to--- Word32, and write that----word64BE =- fixedPrim 8 $ \w p -> do- let a = fromIntegral (shiftR w 32) :: Word32- b = fromIntegral w :: Word32- poke p (fromIntegral (shiftR a 24) :: Word8)- poke (p `plusPtr` 1) (fromIntegral (shiftR a 16) :: Word8)- poke (p `plusPtr` 2) (fromIntegral (shiftR a 8) :: Word8)- poke (p `plusPtr` 3) (fromIntegral a :: Word8)- poke (p `plusPtr` 4) (fromIntegral (shiftR b 24) :: Word8)- poke (p `plusPtr` 5) (fromIntegral (shiftR b 16) :: Word8)- poke (p `plusPtr` 6) (fromIntegral (shiftR b 8) :: Word8)- poke (p `plusPtr` 7) (fromIntegral b :: Word8)-#else-word64BE = fixedPrim 8 $ \w p -> do- poke p (fromIntegral (shiftR w 56) :: Word8)- poke (p `plusPtr` 1) (fromIntegral (shiftR w 48) :: Word8)- poke (p `plusPtr` 2) (fromIntegral (shiftR w 40) :: Word8)- poke (p `plusPtr` 3) (fromIntegral (shiftR w 32) :: Word8)- poke (p `plusPtr` 4) (fromIntegral (shiftR w 24) :: Word8)- poke (p `plusPtr` 5) (fromIntegral (shiftR w 16) :: Word8)- poke (p `plusPtr` 6) (fromIntegral (shiftR w 8) :: Word8)- poke (p `plusPtr` 7) (fromIntegral w :: Word8)-#endif-#endif+word64BE = whenLittleEndian byteSwap64 >$< word64Host -- | Encoding 'Word64's in little endian format. {-# INLINE word64LE #-} word64LE :: FixedPrim Word64-#ifdef WORDS_BIGENDIAN-#if WORD_SIZE_IN_BITS < 64-word64LE =- fixedPrim 8 $ \w p -> do- let b = fromIntegral (shiftR w 32) :: Word32- a = fromIntegral w :: Word32- poke (p) (fromIntegral a :: Word8)- poke (p `plusPtr` 1) (fromIntegral (shiftR a 8) :: Word8)- poke (p `plusPtr` 2) (fromIntegral (shiftR a 16) :: Word8)- poke (p `plusPtr` 3) (fromIntegral (shiftR a 24) :: Word8)- poke (p `plusPtr` 4) (fromIntegral b :: Word8)- poke (p `plusPtr` 5) (fromIntegral (shiftR b 8) :: Word8)- poke (p `plusPtr` 6) (fromIntegral (shiftR b 16) :: Word8)- poke (p `plusPtr` 7) (fromIntegral (shiftR b 24) :: Word8)-#else-word64LE = fixedPrim 8 $ \w p -> do- poke p (fromIntegral w :: Word8)- poke (p `plusPtr` 1) (fromIntegral (shiftR w 8) :: Word8)- poke (p `plusPtr` 2) (fromIntegral (shiftR w 16) :: Word8)- poke (p `plusPtr` 3) (fromIntegral (shiftR w 24) :: Word8)- poke (p `plusPtr` 4) (fromIntegral (shiftR w 32) :: Word8)- poke (p `plusPtr` 5) (fromIntegral (shiftR w 40) :: Word8)- poke (p `plusPtr` 6) (fromIntegral (shiftR w 48) :: Word8)- poke (p `plusPtr` 7) (fromIntegral (shiftR w 56) :: Word8)-#endif-#else-word64LE = word64Host-#endif+word64LE = whenBigEndian byteSwap64 >$< word64Host -- | Encode a single native machine 'Word'. The 'Word's is encoded in host order,@@ -205,23 +119,25 @@ -- {-# INLINE wordHost #-} wordHost :: FixedPrim Word-wordHost = storableToF+wordHost = case finiteBitSize (0 :: Word) of+ 32 -> fromIntegral @Word @Word32 >$< word32Host+ 64 -> fromIntegral @Word @Word64 >$< word64Host+ _ -> error "Data.ByteString.Builder.Prim.Binary.wordHost: unexpected word size" -- | Encoding 'Word16's in native host order and host endianness. {-# INLINE word16Host #-} word16Host :: FixedPrim Word16-word16Host = storableToF+word16Host = fixedPrim 2 unalignedWriteU16 -- | Encoding 'Word32's in native host order and host endianness. {-# INLINE word32Host #-} word32Host :: FixedPrim Word32-word32Host = storableToF+word32Host = fixedPrim 4 unalignedWriteU32 -- | Encoding 'Word64's in native host order and host endianness. {-# INLINE word64Host #-} word64Host :: FixedPrim Word64-word64Host = storableToF-+word64Host = fixedPrim 8 unalignedWriteU64 ------------------------------------------------------------------------------ -- Int encodings@@ -277,22 +193,22 @@ -- {-# INLINE intHost #-} intHost :: FixedPrim Int-intHost = storableToF+intHost = fromIntegral @Int @Word >$< wordHost -- | Encoding 'Int16's in native host order and host endianness. {-# INLINE int16Host #-} int16Host :: FixedPrim Int16-int16Host = storableToF+int16Host = fromIntegral @Int16 @Word16 >$< word16Host -- | Encoding 'Int32's in native host order and host endianness. {-# INLINE int32Host #-} int32Host :: FixedPrim Int32-int32Host = storableToF+int32Host = fromIntegral @Int32 @Word32 >$< word32Host -- | Encoding 'Int64's in native host order and host endianness. {-# INLINE int64Host #-} int64Host :: FixedPrim Int64-int64Host = storableToF+int64Host = fromIntegral @Int64 @Word64 >$< word64Host -- IEEE Floating Point Numbers ------------------------------@@ -323,9 +239,9 @@ -- {-# INLINE floatHost #-} floatHost :: FixedPrim Float-floatHost = storableToF+floatHost = fixedPrim (sizeOf @Float 0) unalignedWriteFloat -- | Encode a 'Double' in native host order and host endianness. {-# INLINE doubleHost #-} doubleHost :: FixedPrim Double-doubleHost = storableToF+doubleHost = fixedPrim (sizeOf @Double 0) unalignedWriteDouble
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)@@ -73,6 +75,7 @@ import Prelude hiding (maxBound) #include "MachDeps.h"+#include "bytestring-cpp-macros.h" ------------------------------------------------------------------------------ -- Supporting infrastructure@@ -198,14 +201,11 @@ liftFixedToBounded = toB {-# INLINE CONLIKE storableToF #-}+{-# DEPRECATED storableToF+ "Deprecated since @bytestring-0.12.1.0@.\n\nThis function is dangerous in the presence of internal padding\nand makes naive assumptions about alignment.\n\n * For a primitive Haskell type like 'Int64', use the\n corresponding primitive like 'Data.ByteString.Builder.Prim.int64Host'.\n * For other types, it is recommended to manually write a small\n function that performs the necessary unaligned write\n and zeroes or removes any internal padding bits."+ #-} storableToF :: forall a. Storable a => FixedPrim a--- Not all architectures are forgiving of unaligned accesses; whitelist ones--- which are known not to trap (either to the kernel for emulation, or crash).-#if defined(i386_HOST_ARCH) || defined(x86_64_HOST_ARCH) \- || ((defined(arm_HOST_ARCH) || defined(aarch64_HOST_ARCH)) \- && defined(__ARM_FEATURE_UNALIGNED)) \- || defined(powerpc_HOST_ARCH) || defined(powerpc64_HOST_ARCH) \- || defined(powerpc64le_HOST_ARCH)+#if HS_UNALIGNED_POKES_OK storableToF = FP (sizeOf (undefined :: a)) (\x op -> poke (castPtr op) x) #else storableToF = FP (sizeOf (undefined :: a)) $ \x op ->
Data/ByteString/Builder/Prim/Internal/Base16.hs view
@@ -1,5 +1,5 @@-{-# LANGUAGE Trustworthy #-}-{-# LANGUAGE MagicHash #-}+{-# LANGUAGE CPP #-}+ -- | -- Copyright : (c) 2011 Simon Meier -- License : BSD3-style (see LICENSE)@@ -22,8 +22,13 @@ , encode8_as_16h ) where -import Foreign-import GHC.Exts (Addr#, Ptr(..))+import Foreign+import GHC.Exts (Addr#, Ptr(..))+#if PURE_HASKELL+import qualified Data.ByteString.Internal.Pure as Pure+#else+import Foreign.C.Types+#endif -- Creating the encoding table ------------------------------@@ -33,26 +38,18 @@ -- | The encoding table for hexadecimal values with lower-case characters; -- e.g., deadbeef.-{-# NOINLINE lowerTable #-} lowerTable :: EncodingTable-lowerTable = EncodingTable- "000102030405060708090a0b0c0d0e0f\- \101112131415161718191a1b1c1d1e1f\- \202122232425262728292a2b2c2d2e2f\- \303132333435363738393a3b3c3d3e3f\- \404142434445464748494a4b4c4d4e4f\- \505152535455565758595a5b5c5d5e5f\- \606162636465666768696a6b6c6d6e6f\- \707172737475767778797a7b7c7d7e7f\- \808182838485868788898a8b8c8d8e8f\- \909192939495969798999a9b9c9d9e9f\- \a0a1a2a3a4a5a6a7a8a9aaabacadaeaf\- \b0b1b2b3b4b5b6b7b8b9babbbcbdbebf\- \c0c1c2c3c4c5c6c7c8c9cacbcccdcecf\- \d0d1d2d3d4d5d6d7d8d9dadbdcdddedf\- \e0e1e2e3e4e5e6e7e8e9eaebecedeeef\- \f0f1f2f3f4f5f6f7f8f9fafbfcfdfeff"#+lowerTable =+#if PURE_HASKELL+ case Pure.lower_hex_table of+ Ptr p# -> EncodingTable p#+#else+ case c_lower_hex_table of+ Ptr p# -> EncodingTable p# +foreign import ccall "&hs_bytestring_lower_hex_table"+ c_lower_hex_table :: Ptr CChar+#endif -- | Encode an octet as 16bit word comprising both encoded nibbles ordered -- according to the host endianness. Writing these 16bit to memory will write
Data/ByteString/Builder/Prim/Internal/Floating.hs view
@@ -1,5 +1,8 @@-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE CPP #-}++#include "MachDeps.h"+#include "bytestring-cpp-macros.h"+ -- | -- Copyright : (c) 2010 Simon Meier --@@ -12,45 +15,74 @@ -- Conversion of 'Float's and 'Double's to 'Word32's and 'Word64's. -- module Data.ByteString.Builder.Prim.Internal.Floating- (- -- coerceFloatToWord32- -- , coerceDoubleToWord64- encodeFloatViaWord32F+ ( castFloatToWord32+ , castDoubleToWord64+ , encodeFloatViaWord32F , encodeDoubleViaWord64F ) where -import Foreign import Data.ByteString.Builder.Prim.Internal+import Data.Word +#if HS_CAST_FLOAT_WORD_OPS_AVAILABLE+import GHC.Float (castFloatToWord32, castDoubleToWord64)+#else+import Foreign.Marshal.Utils+import Foreign.Storable+import Foreign.Ptr++import Data.ByteString.Internal.Type (unsafeDupablePerformIO) {--We work around ticket http://ghc.haskell.org/trac/ghc/ticket/4092 using the-FFI to store the Float/Double in the buffer and peek it out again from there.+We work around ticket http://ghc.haskell.org/trac/ghc/ticket/4092 by+storing the Float/Double in a temp buffer and peeking it out again from there. -} +-- | Interpret a 'Float' as a 'Word32' as if through a bit-for-bit copy.+-- (fallback if not available through GHC.Float)+--+-- e.g+--+-- > showHex (castFloatToWord32 1.0) [] = "3f800000"+{-# NOINLINE castFloatToWord32 #-}+castFloatToWord32 :: Float -> Word32+#if (SIZEOF_HSFLOAT != SIZEOF_WORD32) || (ALIGNMENT_HSFLOAT < ALIGNMENT_WORD32)+ #error "don't know how to cast Float to Word32"+#endif+castFloatToWord32 x = unsafeDupablePerformIO (with x (peek . castPtr)) --- | Encode a 'Float' using a 'Word32' encoding.+-- | Interpret a 'Double' as a 'Word64' as if through a bit-for-bit copy.+-- (fallback if not available through GHC.Float) ----- PRE: The 'Word32' encoding must have a size of at least 4 bytes.+-- e.g+--+-- > showHex (castDoubleToWord64 1.0) [] = "3ff0000000000000"+{-# NOINLINE castDoubleToWord64 #-}+castDoubleToWord64 :: Double -> Word64+#if (SIZEOF_HSDOUBLE != SIZEOF_WORD64) || (ALIGNMENT_HSDOUBLE < ALIGNMENT_WORD64)+ #error "don't know how to cast Double to Word64"+#endif+castDoubleToWord64 x = unsafeDupablePerformIO (with x (peek . castPtr))+#endif+++-- | Encode a 'Float' using a 'Word32' encoding. {-# INLINE encodeFloatViaWord32F #-} encodeFloatViaWord32F :: FixedPrim Word32 -> FixedPrim Float-encodeFloatViaWord32F w32fe- | size w32fe < sizeOf (undefined :: Float) =- error "encodeFloatViaWord32F: encoding not wide enough"- | otherwise = fixedPrim (size w32fe) $ \x op -> do- poke (castPtr op) x- x' <- peek (castPtr op)- runF w32fe x' op+#if HS_CAST_FLOAT_WORD_OPS_AVAILABLE+encodeFloatViaWord32F = (castFloatToWord32 >$<)+#else+encodeFloatViaWord32F w32fe = fixedPrim (size w32fe) $ \x op -> do+ x' <- with x (peek . castPtr)+ runF w32fe x' op+#endif -- | Encode a 'Double' using a 'Word64' encoding.------ PRE: The 'Word64' encoding must have a size of at least 8 bytes. {-# INLINE encodeDoubleViaWord64F #-} encodeDoubleViaWord64F :: FixedPrim Word64 -> FixedPrim Double-encodeDoubleViaWord64F w64fe- | size w64fe < sizeOf (undefined :: Float) =- error "encodeDoubleViaWord64F: encoding not wide enough"- | otherwise = fixedPrim (size w64fe) $ \x op -> do- poke (castPtr op) x- x' <- peek (castPtr op)- runF w64fe x' op-+#if HS_CAST_FLOAT_WORD_OPS_AVAILABLE+encodeDoubleViaWord64F = (castDoubleToWord64 >$<)+#else+encodeDoubleViaWord64F w64fe = fixedPrim (size w64fe) $ \x op -> do+ x' <- with x (peek . castPtr)+ runF w64fe x' op+#endif
Data/ByteString/Builder/RealFloat/D2S.hs view
@@ -1,734 +1,746 @@-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE BangPatterns, MagicHash #-}--- |--- Module : Data.ByteString.Builder.RealFloat.D2S--- Copyright : (c) Lawrence Wu 2021--- License : BSD-style--- Maintainer : lawrencejwu@gmail.com------ Implementation of double-to-string conversion--module Data.ByteString.Builder.RealFloat.D2S- ( FloatingDecimal(..)- , d2s- , d2Intermediate- ) where--import Control.Arrow (first)-import Data.Bits ((.|.), (.&.), unsafeShiftL, unsafeShiftR)-import Data.ByteString.Builder.Internal (Builder)-import Data.ByteString.Builder.Prim (primBounded)-import Data.ByteString.Builder.RealFloat.Internal-import Data.Maybe (fromMaybe)-import GHC.Int (Int32(..))-import GHC.Word (Word64(..))---- See Data.ByteString.Builder.RealFloat.TableGenerator for a high-level--- explanation of the ryu algorithm---- | Table of 2^k / 5^q + 1--- Byte-swapped version of--- > fmap (finv double_pow5_inv_bitcount) [0..double_max_inv_split]-double_pow5_inv_split :: Addr-double_pow5_inv_split = Addr- "\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\- \\x9a\x99\x99\x99\x99\x99\x99\x99\x99\x99\x99\x99\x99\x99\x99\x19\- \\x15\xae\x47\xe1\x7a\x14\xae\x47\xe1\x7a\x14\xae\x47\xe1\x7a\x14\- \\xde\x24\x06\x81\x95\x43\x8b\x6c\xe7\xfb\xa9\xf1\xd2\x4d\x62\x10\- \\x96\xd4\x09\x68\x22\x6c\x78\x7a\xa5\x2c\x43\x1c\xeb\xe2\x36\x1a\- \\xab\x43\x6e\x86\x1b\xf0\xf9\x61\x84\xf0\x68\xe3\x88\xb5\xf8\x14\- \\x22\x36\x58\x38\x49\xf3\xc7\xb4\x36\x8d\xed\xb5\xa0\xf7\xc6\x10\- \\x6a\x23\x8d\xc0\x0e\x52\xa6\x87\x57\x48\xaf\xbc\x9a\xf2\xd7\x1a\- \\x88\x4f\xd7\x66\xa5\x41\xb8\x9f\xdf\x39\x8c\x30\xe2\x8e\x79\x15\- \\x07\xa6\x12\x1f\x51\x01\x2d\xe6\xb2\x94\xd6\x26\xe8\x0b\x2e\x11\- \\xa4\x09\x51\xcb\x81\x68\xae\xd6\xb7\xba\xbd\xd7\xd9\xdf\x7c\x1b\- \\xea\x3a\xa7\xa2\x34\xed\xf1\xde\x5f\x95\x64\x79\xe1\x7f\xfd\x15\- \\xbb\xc8\x85\xe8\xf6\xf0\x27\x7f\x19\x11\xea\x2d\x81\x99\x97\x11\- \\xf8\x0d\xd6\x40\xbe\xb4\x0c\x65\xc2\x81\x76\x49\x68\xc2\x25\x1c\- \\x93\x71\xde\x33\x98\x90\x70\xea\x01\x9b\x2b\xa1\x86\x9b\x84\x16\- \\x43\xc1\x7e\x29\xe0\xa6\xf3\x21\x9b\x15\x56\xe7\x9e\xaf\x03\x12\- \\x37\x35\x31\x0f\xcd\xd7\x85\x69\x2b\xbc\x89\xd8\x97\xb2\xd2\x1c\- \\xf9\x90\x5a\x3f\xd7\xdf\x37\x21\x89\x96\xd4\x46\x46\xf5\x0e\x17\- \\xfa\x73\x48\xcc\x45\xe6\x5f\xe7\xa0\xab\x43\xd2\xd1\x5d\x72\x12\- \\x5d\x86\x0d\x7a\x3c\x3d\x66\xa5\x34\xac\xd2\xb6\x4f\xc9\x83\x1d\- \\xb1\x9e\xd7\x94\x63\x97\x1e\x51\x5d\x23\x42\x92\x0c\xa1\x9c\x17\- \\xc1\x4b\x79\xdd\x82\xdf\x7e\xda\x7d\x4f\x9b\x0e\x0a\xb4\xe3\x12\- \\x68\xac\x5b\x62\xd1\x98\x64\x2a\x96\xe5\x5e\x17\x10\x20\x39\x1e\- \\x53\xf0\xe2\x81\xa7\xe0\xb6\xee\x44\x51\xb2\x12\x40\xb3\x2d\x18\- \\xa9\x26\x4f\xce\x52\x4d\x92\x58\x6a\xa7\x8e\xa8\x99\xc2\x57\x13\- \\x41\xa4\x7e\xb0\xb7\x7b\x50\x27\xaa\xd8\x7d\xda\xf5\xd0\xf2\x1e\- \\x34\x50\x65\xc0\x5f\xc9\xa6\x52\xbb\x13\xcb\xae\xc4\x40\xc2\x18\- \\x90\xa6\xea\x99\x4c\xd4\xeb\x0e\xc9\x0f\x3c\xf2\x36\x9a\xce\x13\- \\x80\x0a\x11\xc3\xad\x53\x79\xb1\x41\x19\x60\x50\xbe\xf6\xb0\x1f\- \\x67\x08\x74\x02\x8b\xdc\x2d\xc1\x67\x47\xb3\xa6\xfe\x5e\x5a\x19\- \\x52\xa0\x29\x35\x6f\xb0\x24\x34\x86\x9f\xc2\xeb\xfe\x4b\x48\x14\- \\xdb\x19\xee\x90\xf2\x59\x1d\x90\x9e\x7f\x68\x89\x65\xd6\x39\x10\- \\x5f\x29\xb0\xb4\x1d\xc3\xfb\x4c\x97\x32\xa7\xa8\xd5\x23\xf6\x19\- \\xb2\xba\x59\x5d\xb1\x35\x96\x3d\xac\x5b\x1f\xba\x77\xe9\xc4\x14\- \\x28\x62\xe1\x7d\x27\x5e\xab\x97\x56\x49\x4c\xfb\x92\x87\x9d\x10\- \\x0d\x9d\x68\xc9\xd8\xc9\xab\xf2\xf0\x0e\x7a\xf8\xb7\xa5\x95\x1a\- \\x3e\x17\xba\x3a\x7a\xa1\xbc\x5b\x5a\x72\x2e\x2d\x93\x84\x44\x15\- \\xcb\x45\xfb\x2e\xc8\x1a\xca\xaf\xae\x8e\x8b\x8a\x42\x9d\x03\x11\- \\x45\x09\x92\xb1\xa6\xf7\xdc\xb2\x4a\xe4\x78\xaa\x9d\xfb\x38\x1b\- \\x04\xa1\x41\xc1\xeb\x92\x7d\xf5\x6e\x83\x2d\x55\xb1\x2f\xc7\x15\- \\x03\xb4\x67\x67\x89\x75\x64\xc4\x58\x9c\x57\x77\x27\x26\x6c\x11\- \\xd2\xec\xa5\xd8\xdb\x88\x6d\x6d\xf4\xc6\x25\xf2\x0b\x3d\xe0\x1b\- \\xdb\x23\xeb\x46\x16\x07\xbe\x8a\xc3\x38\x1e\x28\xa3\xfd\x4c\x16\- \\x49\xb6\x55\xd2\x11\x6c\xfe\x6e\x9c\x60\x4b\x53\x4f\x31\xd7\x11\- \\x0e\x8a\xef\xb6\x4f\x13\x97\xb1\x60\x67\x45\x85\x18\x82\x8b\x1c\- \\xa5\xa1\xbf\xf8\x72\x0f\xac\x27\x1a\xb9\x6a\x37\xad\x01\xd6\x16\- \\x1e\x4e\x99\x60\xc2\x72\x56\xb9\xe1\x60\x55\x2c\x24\xce\x44\x12\- \\x95\x16\xc2\xcd\x03\x1e\x57\xf5\x35\xce\xbb\x13\x6d\xe3\x3a\x1d\- \\xab\xab\x01\x0b\x03\x18\xac\x2a\x2b\xd8\x2f\x76\x8a\x4f\x62\x17\- \\x56\x89\x34\x6f\x02\xe0\xbc\xbb\x55\x13\xf3\xc4\x6e\x0c\xb5\x12\- \\x89\xa8\xed\xb1\xd0\xcc\xc7\x92\xef\x1e\xb8\xd4\x4a\x7a\xee\x1d\- \\x07\xba\x57\x8e\x40\x0a\xd3\xdb\xf2\x4b\x93\x10\x6f\xfb\xf1\x17\- \\x06\xc8\xdf\x71\x00\xd5\xa8\x7c\xf5\x6f\x0f\xda\x58\xfc\x27\x13\- \\xd6\x0c\x66\xe9\x33\xbb\xa7\xfa\xbb\x4c\xb2\x29\x8e\x60\xa6\x1e\- \\x11\xd7\x84\x87\x29\xfc\x52\x95\xc9\xa3\x8e\x54\x0b\x1a\x85\x18\- \\x0e\xac\xd0\xd2\xba\xc9\xa8\xaa\x07\x83\xd8\x76\x6f\xae\x9d\x13\- \\xe3\xac\x1a\x1e\x5e\xdc\xda\xdd\xa5\xd1\xc0\x57\xb2\xb0\x62\x1f\- \\x4f\x8a\x48\x4b\x4b\xb0\x48\x7e\x51\x41\x9a\xac\x8e\xc0\x1b\x19\- \\xd9\xa1\xd3\xd5\xd5\x59\x6d\xcb\xda\xcd\xe1\x56\xa5\x33\x16\x14\- \\x7b\x81\xdc\x77\x11\x7b\x57\x3c\xe2\xd7\xe7\xab\xea\xc2\x11\x10\- \\x2a\xcf\x60\x59\x82\x5e\xf2\xc6\x36\x26\xa6\xac\xaa\x04\xb6\x19\- \\xbb\xa5\x80\x47\x68\x18\xf5\x6b\xc5\x51\xeb\x56\x55\x9d\x91\x14\- \\x96\x84\x00\x06\xed\x79\x2a\x23\xd1\xa7\x22\xdf\xdd\x7d\x74\x10\- \\x56\x07\x34\xa3\xe1\x8f\xdd\xd1\x81\x0c\xd1\x31\x96\xfc\x53\x1a\- \\x45\x6c\xf6\xe8\x1a\x73\xe4\xa7\x34\x3d\xa7\xf4\x44\xfd\x0f\x15\- \\x9e\x56\xf8\x53\xe2\x28\x1d\x53\x5d\x97\x52\x5d\x6a\x97\xd9\x10\- \\x62\x57\x8d\xb9\x03\xdb\x61\xeb\x2e\xf2\x50\x95\x10\xbf\xf5\x1a\- \\xe8\x45\xa4\xc7\xcf\x48\x4e\xbc\x58\x5b\xda\xdd\xa6\x65\x91\x15\- \\x20\x6b\x83\x6c\xd9\xd3\x71\x63\xad\xe2\xe1\x17\x1f\x1e\x41\x11\- \\xcd\x11\x9f\xad\x28\x86\x1c\x9f\x48\x04\x03\xf3\x64\x63\x9b\x1b\- \\x0b\xdb\x18\xbe\x53\x6b\xb0\xe5\x06\x9d\x35\x8f\x1d\xe9\x15\x16\- \\xa2\x15\x47\xcb\x0f\x89\xf3\xea\x6b\x4a\x91\x72\xe4\x20\xab\x11\- \\x37\xbc\x71\x78\x4c\xdb\xb8\x44\x46\xaa\x1b\x84\x6d\x01\x45\x1c\- \\x5f\x63\xc1\xc6\xd6\x15\xc7\x03\x05\x55\x49\x03\xbe\x9a\x9d\x16\- \\x19\xe9\xcd\x6b\x45\xde\x38\x36\x37\x77\x07\x69\xfe\xae\x17\x12\- \\xc1\x41\x16\x46\xa2\x63\xc1\x56\x58\x58\x72\x0e\x97\xb1\xf2\x1c\- \\xce\x67\xab\xd1\x81\x1c\x01\xdf\x79\x13\xf5\x71\x12\x8e\x28\x17\- \\xa5\xec\x55\x41\xce\x16\x34\x7f\x61\xdc\x90\xc1\x0e\xd8\x86\x12\- \\x6e\x47\x56\x35\x7d\x24\x20\x65\x02\xc7\xe7\x68\xe4\x8c\xa4\x1d\- \\x25\x39\x78\xf7\x30\x1d\x80\xea\x01\x6c\xb9\x20\x1d\xd7\xb6\x17\- \\x84\xfa\x2c\xf9\xf3\xb0\x99\xbb\x34\x23\x61\x4d\x17\xac\xf8\x12\- \\x39\xf7\x47\x28\x53\x4e\x5c\x5f\x54\x38\x68\x15\xf2\xac\x5a\x1e\- \\x2e\x2c\xd3\xb9\x75\x0b\x7d\x7f\x43\x60\x53\x44\x5b\x8a\x48\x18\- \\x58\x23\xdc\xc7\xf7\xd5\x30\x99\xcf\x19\xa9\x36\x7c\x3b\x6d\x13\- \\x26\xd2\xf9\x72\x8c\x89\xb4\x8e\xb2\x8f\x0e\xf1\xf9\x2b\x15\x1f\- \\xb8\x41\x2e\x8f\xa3\x07\x2a\x72\x28\xa6\x0b\xf4\xc7\xbc\xdd\x18\- \\xfa\x9a\xbe\xa5\x4f\x39\xbb\xc1\x86\x1e\xd6\x5c\x06\x97\xe4\x13\- \\xf6\xf7\x30\x09\x19\xc2\x5e\x9c\xd7\x30\xf0\xfa\xd6\x24\xd4\x1f\- \\xf8\x5f\x5a\x07\x14\x68\xe5\x49\x79\x8d\x26\x2f\xdf\x83\x76\x19\- \\x60\xe6\xe1\x05\x10\x20\x51\x6e\xc7\x0a\x52\xbf\xe5\xcf\x5e\x14\- \\x1a\x85\x81\xd1\x0c\x80\xda\xf1\x05\x6f\x0e\x99\x84\xd9\x4b\x10\- \\xf5\xd4\x68\x82\x14\x00\xc4\x4f\xd6\xe4\xe3\xf4\xa0\xf5\x12\x1a\- \\x2b\x77\xed\x01\xaa\x99\x69\xd9\x11\xb7\x1c\xf7\xb3\xf7\xdb\x14\- \\xbc\xc5\x8a\x01\x88\x14\xee\xad\x74\x92\xb0\xc5\x5c\xf9\xaf\x10\- \\x2c\x09\xde\x68\xa6\xed\x7c\x49\x54\xea\x80\x6f\x94\x28\xb3\x1a\- \\x24\xd4\xe4\x53\xb8\x57\xca\x3a\x10\x55\x9a\xbf\x76\x20\x5c\x15\- \\x83\x76\x1d\x43\x60\x79\x3b\x62\x73\xaa\xae\xff\x5e\x80\x16\x11\- \\x9e\xbd\xc8\xd1\x66\xf5\x2b\x9d\xb8\x10\xb1\x32\xcb\x33\x57\x1b\- \\x7f\x64\x6d\x41\x52\xc4\xbc\x7d\x60\x0d\xf4\x8e\xa2\x5c\xdf\x15\- \\xcc\xb6\x8a\x67\xdb\x69\xfd\xca\xe6\x3d\xc3\xd8\x4e\x7d\x7f\x11\- \\xdf\x8a\x77\x72\xc5\x0f\x2f\xab\xd7\x2f\x05\x8e\xe4\x2e\xff\x1b\- \\x80\xd5\x92\x5b\x04\x73\xf2\x88\xac\x8c\x6a\x3e\x1d\xbf\x65\x16\- \\x66\x44\x42\x49\xd0\x28\xf5\xd3\x56\x3d\x55\x98\x4a\xff\xea\x11\- \\xa3\xa0\x03\x42\x4d\x41\x88\xb9\x57\x95\xbb\xf3\x10\x32\xab\x1c\- \\xe9\xe6\x02\x68\xd7\xcd\x39\x61\x79\x77\xfc\xc2\x40\x5b\xef\x16\- \\x54\x52\x02\x20\x79\x71\x61\xe7\x2d\xf9\xc9\x68\xcd\x15\x59\x12\- \\x86\x50\x9d\x99\x8e\xb5\x68\xa5\x7c\x5b\x76\x74\x15\x56\x5b\x1d\- \\xd2\xa6\x4a\xe1\x3e\x91\x20\x51\xfd\x15\xc5\xf6\xdd\x44\x7c\x17\- \\x0e\x1f\xa2\x1a\xff\x40\x4d\xa7\xca\x44\x37\x92\xb1\xd0\xc9\x12\- \\x4a\xcb\x69\xf7\x64\xce\xae\x0b\x11\x6e\x58\x50\x4f\xb4\x0f\x1e\- \\x3b\x3c\xee\xc5\x50\xd8\x8b\x3c\xa7\xf1\x79\x73\x3f\x90\x0c\x18\- \\xc9\xc9\xf1\x37\xda\x79\x09\xca\x85\xf4\xc7\xc2\x32\x40\x3d\x13\- \\xdb\x42\xe9\xbf\xf6\xc2\xa8\xa9\x6f\xba\x0c\x9e\xb7\x66\xc8\x1e\- \\xe3\x9b\xba\xcc\x2b\xcf\x53\x21\x26\x95\x70\x7e\x2c\x52\xa0\x18\- \\x82\x49\x95\x70\x89\x72\xa9\x1a\xb8\xdd\x26\x65\xf0\x74\xb3\x13\- \\x9d\x75\x88\x1a\x0f\x84\x75\xf7\x8c\x2f\x3e\x08\xe7\x87\x85\x1f\- \\x17\x5e\xa0\x7b\x72\x36\x91\x5f\x0a\x26\x98\x06\xec\x9f\x37\x19\- \\xdf\xe4\x19\x96\x5b\xf8\x40\x19\xd5\x84\x46\x05\xf0\x7f\x2c\x14\- \\x4c\xea\x47\xab\xaf\xc6\x00\xe1\x10\x37\x05\xd1\x8c\x99\x23\x10\- \\x47\xdd\x3f\x45\x4c\xa4\x67\xce\xe7\x24\xd5\xb4\x47\x8f\xd2\x19\- \\x06\xb1\xcc\x9d\xd6\xe9\x52\xd8\x1f\xb7\xdd\xc3\x9f\x72\xa8\x14\- \\x38\x27\x0a\x4b\x45\xee\xdb\x79\x19\x2c\x7e\x69\x19\xc2\x86\x10\- \\x59\xd8\xa9\x11\xa2\xe3\x5f\x29\x8f\x46\x30\x0f\x8f\x36\x71\x1a\- \\x7a\x13\xbb\xa7\x81\x1c\xb3\xba\xa5\x6b\xf3\xd8\xd8\x5e\x27\x15\- \\x2f\xa9\x95\xec\x9a\xe3\x28\x62\x51\x89\x8f\xad\xe0\x4b\xec\x10\- \\x17\x75\xef\xe0\xf7\x38\x0e\x9d\xe8\x0e\x4c\xaf\x9a\xac\x13\x1b\- \\x79\x2a\x59\x1a\x93\x2d\xd8\xb0\x53\x72\xd6\x25\xe2\x56\xa9\x15\- \\x2e\x55\x47\x48\x0f\xbe\x79\x8d\xdc\xc1\xde\xb7\x81\x45\x54\x11\- \\x7c\xbb\x0b\xda\x7e\x96\x8f\x15\x94\x9c\x97\x8c\xcf\x08\xba\x1b\- \\x97\x2f\xd6\x14\xff\x11\xa6\x77\x76\xb0\xdf\xd6\x72\x6d\x2e\x16\- \\x79\x8c\xde\x43\xff\xa7\x51\xf9\x91\xf3\xb2\x78\xf5\xbd\xbe\x11\- \\x8e\xad\xfd\xd2\xfe\x3f\x1c\xc2\x1c\xec\xb7\x5a\x22\x63\x64\x1c\- \\xd8\x8a\x64\x42\x32\x33\xb0\x01\x17\xf0\x5f\x15\xb5\xb5\xb6\x16\- \\x46\xa2\x83\x9b\x8e\xc2\x59\x01\xac\x59\xe6\xdd\x90\xc4\x2b\x12\- \\xa3\x03\x39\x5f\x17\x04\xf6\xce\xac\xc2\xa3\xfc\x1a\xd4\x12\x1d\- \\x83\x9c\x2d\x4c\xac\x69\x5e\x72\xbd\x9b\x1c\xca\x48\x43\x42\x17\- \\x9c\xe3\x8a\xd6\x89\x54\x18\xf5\xfd\xe2\x16\x08\x07\x69\x9b\x12\- \\xc6\x05\xab\xbd\x0f\x54\x8d\xee\x2f\x6b\xf1\x0c\xd8\x74\xc5\x1d\- \\x05\x6b\x22\xfe\x72\x76\xd7\xbe\x8c\x22\xc1\x70\x46\x2a\xd1\x17\- \\x04\xbc\x4e\xcb\x28\xc5\x12\xff\xd6\x4e\x67\x8d\x6b\xbb\x0d\x13\- \\xa0\xf9\x7d\x78\x74\x3b\x51\xcb\x24\x7e\xd8\x7b\x12\x5f\x7c\x1e\- \\x4d\x61\xfe\xf9\x29\xc9\x0d\x09\xb7\x31\xad\xfc\x41\x7f\x63\x18\- \\x0a\x81\xcb\x94\x21\xd4\xd7\xa0\xc5\x27\x24\xca\x34\xcc\x82\x13\- \\x77\xce\x78\x54\xcf\xb9\xbf\x67\x6f\x0c\x6d\x43\x21\xad\x37\x1f\- \\xf9\x71\x2d\xdd\xa5\x94\xcc\x1f\x59\x70\x8a\xcf\x4d\x57\xf9\x18\- \\xc7\xf4\xbd\x7d\x51\xdd\xd6\x7f\x7a\xf3\xa1\x3f\x3e\xac\xfa\x13\- \\x0b\xee\x2f\xc9\xe8\x2e\xbe\xff\xc3\xb8\x9c\x32\xfd\x79\xf7\x1f\- \\xd6\x24\xf3\xa0\x20\xbf\x31\x66\x36\xfa\x16\xc2\xfd\xc7\x92\x19\- \\x78\x1d\x5c\x1a\x1a\xcc\x27\xb8\x5e\xfb\xab\x01\xcb\x6c\x75\x14\- \\x60\xe4\x7c\x7b\xae\x09\x53\x93\x18\xc9\xbc\x67\xa2\xf0\x5d\x10\- \\x99\xa0\x94\xc5\xb0\x42\xeb\x1e\xf4\x74\x94\x3f\x6a\xe7\x2f\x1a\- \\xe1\xe6\x76\x04\x27\x02\x89\xe5\x5c\x2a\xdd\x32\x88\x1f\xf3\x14\- \\xe7\xeb\x2b\x9d\x85\xce\xa0\xb7\xb0\xee\xb0\x28\xa0\x7f\xc2\x10\- \\xd8\xdf\xdf\x61\x6f\x4a\x01\x59\xb4\x4a\x4e\x74\x33\xcc\xd0\x1a\- \\xad\x4c\xe6\xe7\x25\xd5\xcd\xe0\x29\xa2\x3e\x90\x8f\xd6\x73\x15\- \\xf1\xd6\x51\x86\x51\x77\x71\x4d\xee\xb4\xcb\xd9\x72\x78\x29\x11\- \\xe8\x57\xe9\xd6\xe8\xbe\xe8\x7b\xb0\x54\xac\x8f\x84\x8d\x75\x1b\- \\x20\x13\x21\xdf\x53\x32\xba\xfc\x59\xdd\x89\x0c\x6a\xa4\xf7\x15\- \\x80\x42\xe7\x18\x43\x28\xc8\x63\xae\x4a\x6e\x70\xee\xe9\x92\x11\- \\x66\x6a\xd8\x27\x38\x0d\x0d\x06\x17\x11\x4a\x1a\x17\x43\x1e\x1c\- \\xeb\x21\xad\xec\x2c\xa4\x3d\x6b\x12\x74\x6e\x7b\x12\x9c\x7e\x16\- \\x56\x4e\x57\xbd\xf0\x1c\xfe\x88\xdb\x5c\x58\xfc\x41\xe3\xfe\x11\- \\x23\x4a\x25\x62\xb4\x94\x96\x41\x5f\x61\x8d\x60\x36\x05\xcb\x1c\- \\xe9\xd4\x1d\xe8\x29\xaa\xab\x67\x7f\xe7\x3d\x4d\xf8\xd0\x08\x17\- \\x87\xdd\x17\x20\xbb\x21\x56\xb9\x32\xb9\x64\xd7\xf9\x73\x6d\x12\- \\xa5\x95\x8c\x66\x2b\x69\x23\xc2\xea\xc1\x3a\xf2\xc2\xec\x7b\x1d\- \\x1d\xde\xd6\x1e\x89\xba\x82\xce\xbb\x34\x62\x5b\x02\x57\x96\x17\- \\x18\x18\xdf\x4b\x07\x62\x35\xa5\xfc\xf6\xb4\xe2\x01\xac\xde\x12\- \\x59\xf3\x64\x79\xd8\x9c\x88\x3b\x94\xf1\x87\x37\x36\x13\x31\x1e\- \\xe1\xf5\x83\xc7\x46\x4a\x6d\xfc\xdc\x5a\x06\xc6\x91\x42\x27\x18\- \\x1a\x2b\x03\x06\x9f\x6e\x57\x30\x17\xaf\x9e\xd1\xa7\x9b\x52\x13\- \\x90\xde\xd1\x3c\xcb\x7d\x25\x1a\x25\x18\x31\x1c\xa6\x92\xea\x1e\- \\x40\xe5\xa7\x30\x3c\xfe\x1d\x48\xb7\x79\x5a\xe3\x84\xa8\xbb\x18\- \\x00\x51\x86\xc0\xc9\x31\x4b\xd3\xc5\xc7\xae\x82\x9d\x53\xc9\x13\- \\xcd\xb4\xa3\xcd\x42\xe9\x11\x52\x09\xa6\x17\xd1\xc8\x85\xa8\x1f\- \\xa4\x90\x1c\x3e\x02\x21\xdb\x74\x07\xb8\xdf\x40\x3a\x9e\x53\x19\- \\x50\x0d\x4a\xcb\x01\xb4\x15\xf7\x05\x60\x19\x67\xfb\xe4\x42\x14\- \\xa7\x0a\x08\x09\x9b\x29\xde\xf8\x37\xb3\x7a\x52\xfc\x83\x35\x10\- \\xd7\xdd\x0c\xa8\x91\x42\x30\x8e\x59\xb8\x2a\xb7\x93\x39\xef\x19\- \\x13\x4b\x0a\x20\x0e\x02\x8d\x3e\xe1\xf9\xee\xf8\x42\x61\xbf\x14\- \\x0f\x3c\x08\x80\x3e\x9b\x3d\x65\xe7\xc7\x58\xfa\x9b\x1a\x99\x10\- \\xe4\x2c\x0d\x00\x64\xf8\xc8\x6e\xa5\x0c\x8e\x90\xf9\x90\x8e\x1a\- \\xea\x23\xa4\x99\xe9\xf9\xd3\x8b\xb7\xa3\x71\x40\x61\xda\x3e\x15\- \\xbb\x1c\x50\xe1\xba\x94\xa9\x3c\xf9\x82\xf4\x99\x1a\x15\xff\x10\- \\x2b\x61\xb3\x9b\xc4\xba\x75\xc7\x8e\xd1\x20\xc3\x5d\xbb\x31\x1b\- \\x89\x1a\x29\x16\x6a\x95\xc4\xd2\x0b\x0e\xe7\x68\xb1\x62\xc1\x15\- \\xa1\x7b\xba\x11\x88\x77\xd0\xdb\x6f\x3e\x1f\x87\x27\x82\x67\x11\- \\x9b\x92\x5d\x1c\x40\xbf\x80\x2c\xe6\x63\x98\x3e\x3f\xd0\xd8\x1b\- \\x49\x75\xe4\x49\x33\xcc\x33\xbd\x51\xb6\x46\x65\xff\x0c\x47\x16\- \\xd4\x5d\x50\x6e\x8f\xd6\x8f\xca\xa7\x5e\x05\x51\xcc\x70\xd2\x11\- \\x53\xc9\xb3\xe3\x4b\x57\x19\x44\xd9\xfd\x6e\x4e\xad\xe7\x83\x1c\- \\xa9\x3a\xf6\x82\x09\x79\x47\x03\xe1\x97\x25\xa5\x8a\xec\xcf\x16\- \\xba\xfb\xc4\x68\xd4\x60\x6c\xcf\x80\x79\x84\xea\x6e\xf0\x3f\x12\- \\x2a\xf9\x07\x0e\x87\x34\x7a\xe5\x9a\xf5\xd3\x10\x4b\x1a\x33\x1d\- \\x22\x94\x39\x0b\x6c\x90\x2e\x51\xe2\x2a\x43\xda\x08\x15\x5c\x17\- \\xb5\xa9\xc7\xd5\xbc\xa6\x8b\xda\x81\x55\xcf\xe1\xd3\x10\xb0\x12\- \\x87\x0f\xd9\x22\x2e\x71\xdf\x90\x9c\x55\xe5\x02\x53\x81\xe6\x1d\- \\x6c\x0c\x14\x4f\x8b\x5a\x4c\xda\x16\xde\x1d\xcf\xa8\x9a\xeb\x17\- \\x8a\xa3\xa9\xa5\xa2\x7b\xa3\xae\x78\x7e\xb1\xa5\x20\xe2\x22\x13\- \\xa9\x05\xa9\xa2\x6a\x5f\xd2\x7d\x27\x97\xb5\xa2\x9a\x36\x9e\x1e\- \\x54\xd1\x20\x82\x88\x7f\xdb\x97\x1f\xac\xf7\x4e\x15\x92\x7e\x18\- \\x77\xa7\x80\xce\x06\x66\x7c\x79\x4c\x23\xc6\xd8\xdd\x74\x98\x13\- \\xf1\x0b\x01\xe4\x0a\x70\x2d\x8f\xad\x6b\xa3\x27\x96\x54\x5a\x1f\- \\x5a\xd6\x00\x50\xa2\x59\x24\x0c\xbe\xef\xb5\x1f\x78\x10\x15\x19\- \\x15\x45\x9a\xd9\x81\x14\x1d\x70\xfe\xf2\xf7\xb2\xf9\xd9\x10\x14\- \\x77\x6a\x7b\x14\x9b\x43\x17\xc0\xfe\x5b\xc6\x28\x2e\x7b\x0d\x10\- \\xf2\x43\x92\xed\xc4\x05\xf2\xcc\xca\x2c\x0a\x0e\x7d\x2b\xaf\x19\- \\xc2\x9c\x0e\xbe\xd0\x37\x5b\x0a\x6f\xbd\xa1\x71\xca\x22\x8c\x14\- \\xce\xe3\x3e\xcb\x73\xf9\x48\x08\x8c\x97\xb4\x27\xd5\x1b\x70\x10\- \\xb0\x9f\x64\x78\xec\x5b\x0e\xda\xac\x25\x54\x0c\x55\xf9\x4c\x1a\- \\xc0\x7f\x50\x60\xf0\xaf\x3e\x7b\xbd\xb7\xa9\xd6\x10\x61\x0a\x15\- \\x33\x66\x40\x80\xf3\xbf\xcb\x95\x97\x2c\xee\xde\x73\x1a\xd5\x10\- \\x52\x70\xcd\x66\x52\x66\xac\xef\x58\x47\xb0\x64\xb9\x90\xee\x1a\- \\xdb\x59\xa4\xb8\x0e\x85\x23\x26\x47\x6c\xf3\xb6\xfa\xa6\x8b\x15\- \\x49\xae\xb6\x93\xd8\xd0\x82\x1e\x6c\x23\x29\x5f\x95\x85\x3c\x11\- \\x75\xb0\x8a\x1f\xf4\x1a\x9e\xfd\xac\x38\xa8\xfe\xee\x08\x94\x1b\- \\xf7\x59\xd5\xb2\x29\xaf\xb1\x97\xbd\x93\x86\x98\x25\x07\x10\x16\- \\x2c\x7b\x77\xf5\xba\x25\x8e\xac\x97\xdc\x9e\x13\x1e\x6c\xa6\x11\- \\x13\xc5\x58\x22\x2b\x09\x7d\x7a\xbf\x2d\xfe\xb8\xc9\x79\x3d\x1c\- \\x76\x6a\xad\x4e\xef\xa0\xfd\x61\xcc\x57\xcb\x60\xa1\x94\x97\x16\- \\xc5\xee\xbd\x0b\x59\x1a\xfe\xe7\x09\x13\x09\xe7\x4d\xdd\x12\x12\- \\x3a\xb1\xfc\x45\x5b\x5d\x63\xa6\xdc\x84\x0e\xd8\xaf\xfb\xea\x1c\- \\xc8\x8d\x30\x6b\xaf\x4a\x1c\x85\xb0\xd0\x3e\x13\xf3\x62\x22\x17\- \\xd4\xd7\x26\xbc\xf2\x6e\xe3\xd0\x26\xda\xcb\x75\xc2\xe8\x81\x12\- \\x86\x8c\xa4\xc6\xea\x17\x9f\xb4\xd7\x29\x46\x89\x9d\xa7\x9c\x1d\- \\x6b\x70\x50\x05\xef\xdf\x18\x2a\x46\xee\x04\xa1\x17\x86\xb0\x17\- \\x89\xf3\xd9\x9d\x25\xb3\xe0\x54\x6b\x8b\x9d\x4d\x79\x9e\xf3\x12\- \\x74\x52\xf6\x62\x6f\xeb\xcd\x87\x78\x45\x2f\x7c\x28\x97\x52\x1e\- \\x5d\xa8\x5e\x82\xbf\x22\x0b\xd3\xc6\x6a\xbf\xc9\x86\x12\x42\x18\- \\xe4\xb9\x4b\x68\xcc\x1b\x3c\x0f\x9f\x88\xff\x3a\xd2\x0e\x68\x13\- \\x6d\x29\x79\x40\x7a\x2c\x60\x18\x98\xda\x98\x91\x83\xe4\x0c\x1f\- \\x24\x21\x94\x33\xc8\x56\xb3\x46\x13\xe2\x13\x0e\x36\x1d\xd7\x18\- \\xb6\x4d\x43\x29\xa0\x78\x8f\x38\xdc\xb4\xdc\xa4\x91\x4a\xdf\x13\- \\x8a\xaf\x6b\xa8\x66\x27\x7f\x5a\x60\x21\x61\xa1\x82\xaa\xcb\x1f\- \\xa2\xbf\xef\xb9\xeb\x85\x32\x15\x4d\xb4\x4d\xb4\x9b\xbb\x6f\x19\- \\x4e\x99\x8c\x61\x89\xd1\x8e\xaa\x3d\x90\xa4\xf6\xe2\x62\x59\x14\- \\x0c\xe1\xd6\x1a\xa1\xa7\xd8\xee\xca\xd9\xb6\x2b\x4f\x82\x47\x10\- \\x45\x9b\x24\x5e\x9b\x72\x27\x7e\x11\xf6\x8a\xdf\xb1\x03\x0c\x1a\- \\x04\x49\x1d\x18\x49\xf5\x85\xfe\x0d\xf8\x3b\x19\x5b\x69\xd6\x14\- \\xd0\xa0\x4a\x13\xd4\x5d\x9e\xcb\xa4\xf9\x2f\x14\x7c\x87\xab\x10\- \\x4d\x01\x11\x52\x53\xc9\x63\xdf\x3a\x5c\xe6\xb9\xf9\x0b\xac\x1a\- \\x71\x67\xda\x74\x0f\xa1\x1c\x19\x2f\xb0\x1e\xfb\xfa\x6f\x56\x15\- \\xc1\x52\x48\x2a\xd9\x80\xb0\xad\x25\xc0\x4b\x2f\x2f\xf3\x11\x11\- \\x34\x51\x0d\xaa\x8e\x34\xe7\x15\x09\xcd\x12\xb2\x7e\xeb\x4f\x1b\- \\xc4\x0d\x71\xee\x3e\x5d\x1f\xab\x6d\x0a\x0f\x28\x32\x89\xd9\x15\- \\x9d\xa4\x8d\x8b\x65\x17\x19\xbc\x57\x08\x0c\x20\x28\xd4\x7a\x11\- \\x94\x3a\x7c\x12\x3c\xf2\xf4\x2c\x59\x0d\xe0\xcc\xd9\xb9\xf7\x1b\- \\x43\x95\x96\xdb\xfc\xf4\xc3\xf0\xe0\x3d\xb3\x70\xe1\xc7\x5f\x16\- \\x03\x11\x12\x16\x97\x5d\x36\x5a\x1a\xcb\xf5\x26\x81\x39\xe6\x11\- \\x04\xe8\x1c\xf0\x24\xfc\x56\x90\x90\xde\x22\x0b\x35\x8f\xa3\x1c\- \\xd0\xec\xe3\x8c\x1d\x30\xdf\xd9\xa6\x4b\x82\xa2\x5d\x3f\xe9\x16\- \\xda\x23\x83\x3d\xb1\x59\x7f\xe1\xeb\xa2\xce\x4e\xb1\x32\x54\x12\- \\x5c\x39\x38\x2f\xb5\xc2\xcb\x68\x79\xd1\x7d\xe4\x4e\x84\x53\x1d\- \\xe3\x2d\x60\xbf\x5d\x35\xd6\x53\x94\xa7\x64\x50\x72\x03\x76\x17\- \\x1c\x8b\xe6\x65\xb1\x2a\x78\xa9\x76\xec\xb6\xa6\x8e\xcf\xc4\x12\- \\xfa\x44\xd7\x6f\xb5\xaa\x26\x0f\xf1\x13\x8b\xd7\x7d\xb2\x07\x1e\- \\x62\x6a\xdf\xbf\x2a\x22\x52\x3f\x27\x43\x6f\xac\x64\x28\x06\x18\- \\x4e\x88\x7f\x99\x88\x4e\xdb\x65\x1f\x9c\xf2\x89\x50\x20\x38\x13\- \\x4a\x0d\xcc\x28\x74\x4a\xc5\x6f\x65\x93\xea\x0f\xb4\x33\xc0\x1e\- \\x3b\xa4\x09\x87\xf6\xa1\x6a\x59\x84\x0f\x22\x73\xf6\xc2\x99\x18\- \\x96\xb6\x07\x6c\xf8\xe7\xee\xad\x36\xd9\xb4\xf5\x91\x35\xae\x13\- \\x56\x57\x0c\xe0\xf3\x3f\x7e\x49\x24\xf5\xba\x22\x83\x22\x7d\x1f\- \\x45\xac\xd6\x4c\xf6\xff\x64\xd4\xe9\x90\x95\xe8\x68\xe8\x30\x19\- \\xd1\x89\x78\x3d\xf8\xff\x83\x43\xee\x73\x44\xed\x53\x20\x27\x14\- \\x74\xa1\x93\x97\xc6\xcc\x9c\xcf\xf1\x8f\x03\xf1\x0f\x4d\x1f\x10\- \\x52\x02\xb9\x25\xa4\x47\x61\x7f\x1c\xb3\x05\xe8\x7f\xae\xcb\x19\- \\x0f\x35\xc7\xb7\xe9\xd2\x4d\xcc\x16\x5c\xd1\xec\xff\xf1\xa2\x14\- \\xd9\x90\xd2\x5f\x21\x0f\x0b\x3d\x12\xb0\xda\x23\x33\x5b\x82\x10\- \\xc1\xe7\x50\x99\x68\x4b\xab\x61\x50\xb3\x2a\x06\x85\x2b\x6a\x1a\- \\x67\xb9\x40\x14\xba\xa2\x22\x4e\x40\x5c\x55\x6b\x6a\xbc\x21\x15\- \\x53\x94\x00\xdd\x94\xe8\x4e\x0b\xcd\x49\x44\xbc\xee\xc9\xe7\x10\- \\x51\xed\x00\xc8\x87\xda\x17\x12\x48\xa9\xd3\xc6\x4a\x76\x0c\x1b\- \\xda\xbd\x00\xa0\x6c\x48\x46\xdb\x6c\x87\xdc\x6b\xd5\x91\xa3\x15\- \\xaf\x64\xcd\x4c\xbd\x06\x05\x49\x8a\x9f\xe3\xef\xdd\xa7\x4f\x11\- \\xb1\x3a\xe2\x7a\xc8\x0a\x08\xa8\x43\xff\x38\xe6\x2f\xa6\xb2\x1b\- \\xf4\x2e\xe8\xfb\x39\xa2\x39\x53\x69\xff\x93\x1e\xf3\x84\x28\x16\- \\x5d\xf2\xec\x2f\xfb\xb4\xc7\x75\x87\xff\x0f\xb2\xf5\x03\xba\x11\- \\x2e\xea\x47\xe6\x91\x21\xd9\x22\x3f\xff\x7f\xb6\x22\xd3\x5c\x1c\- \\xf2\x54\x06\x85\x41\x81\x7a\xb5\x65\xff\xff\x91\xe8\xa8\xb0\x16\- \\xf5\x43\x38\x37\x01\x01\x62\xc4\xb7\x32\x33\xdb\x86\xed\x26\x12\- \\xee\x9f\xf3\xf1\x01\x68\x36\x3a\x59\x84\xeb\x91\xa4\x15\x0b\x1d\- \\x8b\x19\xf6\x27\x9b\xb9\x5e\xfb\xe0\x69\xbc\x74\x50\x11\x3c\x17\- \\xd6\x7a\x5e\x86\xe2\xfa\x7e\x2f\xe7\x87\x63\x5d\x40\x74\x96\x12\- \\x56\x91\xfd\xd6\xd0\xf7\x97\xe5\x71\xd9\x38\x62\xcd\x86\xbd\x1d\- \\xab\xda\xca\x78\x0d\x93\x79\x84\xc1\x7a\x2d\xe8\x3d\xd2\xca\x17\- \\x56\x15\x6f\x2d\x71\x42\x61\xd0\x9a\xc8\x8a\x86\x31\xa8\x08\x13\- \\x22\x22\x18\xaf\x4e\x6a\x68\x4d\x91\xda\xaa\x3d\x4f\x40\x74\x1e\- \\xe8\xb4\x79\xf2\x3e\x88\x53\xa4\xda\xae\x88\x64\x3f\x00\x5d\x18\- \\x87\x5d\x61\x28\xff\x6c\xdc\xe9\xae\x58\x6d\x50\xcc\x99\x7d\x13\- \\xa4\x95\x68\x0d\x65\xae\x60\xa9\xe4\x8d\x48\x1a\x7a\x5c\x2f\x1f\- \\x83\x44\xed\x3d\xb7\xbe\xb3\xba\x83\x71\xa0\xae\x61\xb0\xf2\x18\- \\x36\x9d\x8a\x31\x2c\x32\xf6\x2e\x36\xc1\xe6\xbe\xe7\x59\xf5\x13"#---- | Table of 5^(-e2-q) / 2^k + 1--- Byte-swapped version of--- > fmap (fnorm double_pow5_bitcount) [0..double_max_split]-double_pow5_split :: Addr-double_pow5_split = Addr- "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x10\- \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\- \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\- \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x1f\- \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x88\x13\- \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x6a\x18\- \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\x84\x1e\- \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xd0\x12\x13\- \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x84\xd7\x17\- \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x65\xcd\x1d\- \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x20\x5f\xa0\x12\- \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe8\x76\x48\x17\- \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa2\x94\x1a\x1d\- \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\xe5\x9c\x30\x12\- \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x90\x1e\xc4\xbc\x16\- \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x34\x26\xf5\x6b\x1c\- \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x80\xe0\x37\x79\xc3\x11\- \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa0\xd8\x85\x57\x34\x16\- \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xc8\x4e\x67\x6d\xc1\x1b\- \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3d\x91\x60\xe4\x58\x11\- \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x40\x8c\xb5\x78\x1d\xaf\x15\- \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x50\xef\xe2\xd6\xe4\x1a\x1b\- \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x92\xd5\x4d\x06\xcf\xf0\x10\- \\x00\x00\x00\x00\x00\x00\x00\x00\x80\xf6\x4a\xe1\xc7\x02\x2d\x15\- \\x00\x00\x00\x00\x00\x00\x00\x00\x20\xb4\x9d\xd9\x79\x43\x78\x1a\- \\x00\x00\x00\x00\x00\x00\x00\x00\x94\x90\x02\x28\x2c\x2a\x8b\x10\- \\x00\x00\x00\x00\x00\x00\x00\x00\xb9\x34\x03\x32\xb7\xf4\xad\x14\- \\x00\x00\x00\x00\x00\x00\x00\x40\xe7\x01\x84\xfe\xe4\x71\xd9\x19\- \\x00\x00\x00\x00\x00\x00\x00\x88\x30\x81\x12\x1f\x2f\xe7\x27\x10\- \\x00\x00\x00\x00\x00\x00\x00\xaa\x7c\x21\xd7\xe6\xfa\xe0\x31\x14\- \\x00\x00\x00\x00\x00\x00\x80\xd4\xdb\xe9\x8c\xa0\x39\x59\x3e\x19\- \\x00\x00\x00\x00\x00\x00\xa0\xc9\x52\x24\xb0\x08\x88\xef\x8d\x1f\- \\x00\x00\x00\x00\x00\x00\x04\xbe\xb3\x16\x6e\x05\xb5\xb5\xb8\x13\- \\x00\x00\x00\x00\x00\x00\x85\xad\x60\x9c\xc9\x46\x22\xe3\xa6\x18\- \\x00\x00\x00\x00\x00\x40\xe6\xd8\x78\x03\x7c\xd8\xea\x9b\xd0\x1e\- \\x00\x00\x00\x00\x00\xe8\x8f\x87\x2b\x82\x4d\xc7\x72\x61\x42\x13\- \\x00\x00\x00\x00\x00\xe2\x73\x69\xb6\xe2\x20\x79\xcf\xf9\x12\x18\- \\x00\x00\x00\x00\x80\xda\xd0\x03\x64\x1b\x69\x57\x43\xb8\x17\x1e\- \\x00\x00\x00\x00\x90\x88\x62\x82\x1e\xb1\xa1\x16\x2a\xd3\xce\x12\- \\x00\x00\x00\x00\xb4\x2a\xfb\x22\x66\x1d\x4a\x9c\xf4\x87\x82\x17\- \\x00\x00\x00\x00\x61\xf5\xb9\xab\xbf\xa4\x5c\xc3\xf1\x29\x63\x1d\- \\x00\x00\x00\xa0\x5c\x39\x54\xcb\xf7\xe6\x19\x1a\x37\xfa\x5d\x12\- \\x00\x00\x00\xc8\xb3\x47\x29\xbe\xb5\x60\xa0\xe0\xc4\x78\xf5\x16\- \\x00\x00\x00\xba\xa0\x99\xb3\x2d\xe3\x78\xc8\x18\xf6\xd6\xb2\x1c\- \\x00\x00\x40\x74\x04\x40\x90\xfc\x8d\x4b\x7d\xcf\x59\xc6\xef\x11\- \\x00\x00\x50\x91\x05\x50\xb4\x7b\x71\x9e\x5c\x43\xf0\xb7\x6b\x16\- \\x00\x00\xa4\xf5\x06\x64\xa1\xda\x0d\xc6\x33\x54\xec\xa5\x06\x1c\- \\x00\x80\x86\x59\x84\xde\xa4\xa8\xc8\x5b\xa0\xb4\xb3\x27\x84\x11\- \\x00\x20\xe8\x6f\x25\x16\xce\xd2\xba\x72\xc8\xa1\xa0\x31\xe5\x15\- \\x00\x28\xe2\xcb\xae\x9b\x81\x87\x69\x8f\x3a\xca\x08\x7e\x5e\x1b\- \\x00\x59\x6d\x3f\x4d\x01\xb1\xf4\xa1\x99\x64\x7e\xc5\x0e\x1b\x11\- \\x40\xaf\x48\x8f\xa0\x41\xdd\x71\x0a\xc0\xfd\xdd\x76\xd2\x61\x15\- \\x10\xdb\x1a\xb3\x08\x92\x54\x0e\x0d\x30\x7d\x95\x14\x47\xba\x1a\- \\xea\xc8\xf0\x6f\x45\xdb\xf4\x28\x08\x3e\x6e\xdd\x6c\x6c\xb4\x10\- \\x24\xfb\xec\xcb\x16\x12\x32\x33\x8a\xcd\xc9\x14\x88\x87\xe1\x14\- \\xed\x39\xe8\x7e\x9c\x96\xfe\xbf\xec\x40\xfc\x19\x6a\xe9\x19\x1a\- \\x34\x24\x51\xcf\x21\x1e\xff\xf7\x93\xa8\x3d\x50\xe2\x31\x50\x10\- \\x41\x6d\x25\x43\xaa\xe5\xfe\xf5\xb8\x12\x4d\xe4\x5a\x3e\x64\x14\- \\x92\xc8\xee\xd3\x14\x9f\x7e\x33\x67\x57\x60\x9d\xf1\x4d\x7d\x19\- \\xb6\x7a\xea\x08\xda\x46\x5e\x00\x41\x6d\xb8\x04\x6e\xa1\xdc\x1f\- \\xb2\x8c\x92\x45\x48\xec\x3a\xa0\x48\x44\xf3\xc2\xe4\xe4\xe9\x13\- \\xde\x2f\xf7\x56\x5a\xa7\x49\xc8\x5a\x15\xb0\xf3\x1d\x5e\xe4\x18\- \\xd6\xfb\xb4\xec\x30\x11\x5c\x7a\xb1\x1a\x9c\x70\xa5\x75\x1d\x1f\- \\x65\x1d\xf1\x93\xbe\x8a\x79\xec\xae\x90\x61\x66\x87\x69\x72\x13\- \\xbf\x64\xed\x38\x6e\xed\x97\xa7\xda\xf4\xf9\x3f\xe9\x03\x4f\x18\- \\xef\xbd\x28\xc7\xc9\xe8\x7d\x51\x11\x72\xf8\x8f\xe3\xc4\x62\x1e\- \\xb5\x76\x79\x1c\x7e\xb1\xee\xd2\x4a\x47\xfb\x39\x0e\xbb\xfd\x12\- \\x62\xd4\x97\xa3\xdd\x5d\xaa\x87\x1d\x19\x7a\xc8\xd1\x29\xbd\x17\- \\x7b\xc9\x7d\x0c\x55\xf5\x94\xe9\x64\x9f\x98\x3a\x46\x74\xac\x1d\- \\xed\x9d\xce\x27\x55\x19\xfd\x11\x9f\x63\x9f\xe4\xab\xc8\x8b\x12\- \\x68\x45\xc2\x71\xaa\x5f\x7c\xd6\x86\x3c\xc7\xdd\xd6\xba\x2e\x17\- \\xc2\xd6\x32\x0e\x95\x77\x1b\x8c\xa8\x0b\x39\x95\x8c\x69\xfa\x1c\- \\x39\xc6\xdf\x28\xbd\x2a\x91\x57\x49\xa7\x43\xdd\xf7\x81\x1c\x12\- \\xc8\xb7\x17\x73\x6c\x75\x75\xad\x1b\x91\x94\xd4\x75\xa2\xa3\x16\- \\xba\xa5\xdd\x8f\xc7\xd2\xd2\x98\x62\xb5\xb9\x49\x13\x8b\x4c\x1c\- \\x94\x87\xea\xb9\xbc\xc3\x83\x9f\x5d\x11\x14\x0e\xec\xd6\xaf\x11\- \\x79\x29\x65\xe8\xab\xb4\x64\x07\xb5\x15\x99\x11\xa7\xcc\x1b\x16\- \\xd7\x73\x7e\xe2\xd6\xe1\x3d\x49\x22\x5b\xff\xd5\xd0\xbf\xa2\x1b\- \\x66\x08\x8f\x4d\x26\xad\xc6\x6d\xf5\x98\xbf\x85\xe2\xb7\x45\x11\- \\x80\xca\xf2\xe0\x6f\x58\x38\xc9\x32\x7f\x2f\x27\xdb\x25\x97\x15\- \\x20\x7d\x2f\xd9\x8b\x6e\x86\x7b\xff\x5e\xfb\xf0\x51\xef\xfc\x1a\- \\x34\xae\xbd\x67\x17\x05\x34\xad\x5f\x1b\x9d\x36\x93\x15\xde\x10\- \\xc1\x19\xad\x41\x5d\x06\x81\x98\x37\x62\x44\x04\xf8\x9a\x15\x15\- \\x32\x60\x18\x92\xf4\x47\xa1\x7e\xc5\x7a\x55\x05\xb6\x01\x5b\x1a\- \\x1f\x3c\x4f\xdb\xf8\xcc\x24\x6f\xbb\x6c\x55\xc3\x11\xe1\x78\x10\- \\x27\x0b\x23\x12\x37\x00\xee\x4a\xea\xc7\x2a\x34\x56\x19\x97\x14\- \\xf0\xcd\xab\xd6\x44\x80\xa9\xdd\xe4\x79\x35\xc1\xab\xdf\xbc\x19\- \\xb6\x60\x2b\x06\x2b\xf0\x89\x0a\x2f\x6c\xc1\x58\xcb\x0b\x16\x10\- \\xe4\x38\xb6\xc7\x35\x6c\x2c\xcd\x3a\xc7\xf1\x2e\xbe\x8e\x1b\x14\- \\x1d\xc7\xa3\x39\x43\x87\x77\x80\x09\x39\xae\xba\x6d\x72\x22\x19\- \\xe4\xb8\x0c\x08\x14\x69\x95\xe0\x4b\xc7\x59\x29\x09\x0f\x6b\x1f\- \\x8e\xf3\x07\x85\xac\x61\x5d\x6c\x8f\x1c\xd8\xb9\x65\xe9\xa2\x13\- \\x72\xf0\x49\xa6\x17\xba\x74\x47\xb3\x23\x4e\x28\xbf\xa3\x8b\x18\- \\x8f\x6c\xdc\x8f\x9d\xe8\x51\x19\xa0\xac\x61\xf2\xae\x8c\xae\x1e\- \\xd9\xc3\xe9\x79\x62\x31\xd3\x0f\xe4\x0b\x7d\x57\xed\x17\x2d\x13\- \\xcf\x34\x64\x18\xbb\xfd\xc7\x13\xdd\x4e\x5c\xad\xe8\x5d\xf8\x17\- \\x03\x42\x7d\xde\x29\xfd\xb9\x58\x94\x62\xb3\xd8\x62\x75\xf6\x1d\- \\x42\x49\x0e\x2b\x3a\x3e\x74\xb7\x9c\x1d\x70\xc7\x5d\x09\xba\x12\- \\x92\xdb\xd1\xb5\xc8\x4d\x51\xe5\x03\x25\x4c\x39\xb5\x8b\x68\x17\- \\x77\x52\x46\xe3\x3a\xa1\xa5\xde\x44\x2e\x9f\x87\xa2\xae\x42\x1d\- \\x8a\xf3\x0b\xce\xc4\x84\x27\x0b\xeb\x7c\xc3\x94\x25\xad\x49\x12\- \\x6d\xf0\x8e\x01\xf6\x65\xf1\xcd\x25\x5c\xf4\xf9\x6e\x18\xdc\x16\- \\x88\xac\xf2\x81\x73\xbf\x6d\x41\x2f\x73\x71\xb8\x8a\x1e\x93\x1c\- \\xd5\xab\x37\x31\xa8\x97\xe4\x88\xfd\xe7\x46\xb3\x16\xf3\xdb\x11\- \\xca\x96\x85\x3d\x92\xbd\x1d\xeb\xfc\xa1\x18\x60\xdc\xef\x52\x16\- \\x7d\xfc\xe6\xcc\xf6\x2c\xe5\x25\x7c\xca\x1e\x78\xd3\xab\xe7\x1b\- \\xce\x5d\x10\x40\x1a\x3c\xaf\x97\x8d\x3e\x13\x2b\x64\xcb\x70\x11\- \\x42\x75\x14\xd0\x20\x0b\x9b\xfd\x30\x0e\xd8\x35\x3d\xfe\xcc\x15\- \\x92\x92\x19\x04\xe9\xcd\x01\x3d\xbd\x11\x4e\x83\xcc\x3d\x40\x1b\- \\x9b\xfb\x8f\xa2\xb1\x20\x21\x46\x16\xcb\x10\xd2\x9f\x26\x08\x11\- \\x82\xfa\x33\x0b\xde\x68\xa9\xd7\xdb\xfd\x94\xc6\x47\x30\x4a\x15\- \\x23\xf9\x00\x8e\x15\xc3\x93\xcd\x52\x3d\x3a\xb8\x59\xbc\x9c\x1a\- \\xb6\x9b\xc0\x78\xed\x59\x7c\xc0\x53\x66\x24\x13\xb8\xf5\xa1\x10\- \\xa3\xc2\xf0\xd6\x68\x70\x9b\xb0\xe8\x7f\xed\x17\x26\x73\xca\x14\- \\x4c\xf3\xac\x0c\x83\x4c\xc2\xdc\xe2\xdf\xe8\x9d\xef\x0f\xfd\x19\- \\x0f\x18\xec\xe7\xd1\x6f\xf9\xc9\xed\x8b\xb1\xc2\xf5\x29\x3e\x10\- \\x13\x1e\xe7\x61\xc6\xcb\x77\x3c\xe9\xee\x5d\x33\x73\xb4\x4d\x14\- \\x98\xe5\x60\xfa\xb7\xbe\x95\x8b\xa3\x6a\x35\x00\x90\x21\x61\x19\- \\xfe\x1e\xf9\xf8\x65\x2e\x7b\x6e\x4c\xc5\x42\x00\xf4\x69\xb9\x1f\- \\x5f\xb3\x9b\xbb\xff\xfc\x0c\xc5\x4f\xbb\x29\x80\x38\xe2\xd3\x13\- \\x37\xa0\x82\xaa\x3f\x3c\x50\xb6\x23\x2a\x34\xa0\xc6\xda\xc8\x18\- \\x44\x48\x23\x95\x4f\x4b\xe4\xa3\xac\x34\x41\x48\x78\x11\xfb\x1e\- \\x2b\x0d\x36\xbd\x11\xaf\x6e\xe6\xeb\xc0\x28\x2d\xeb\xea\x5c\x13\- \\x75\x90\x83\x2c\xd6\x5a\x0a\xe0\x26\xf1\x72\xf8\xa5\x25\x34\x18\- \\x93\x74\xa4\xb7\x8b\xf1\x0c\x98\x70\xad\x8f\x76\x0f\x2f\x41\x1e\- \\xdc\xc8\xc6\x52\xf7\x16\x08\x5f\x66\xcc\x19\xaa\x69\xbd\xe8\x12\- \\x13\x7b\x78\x27\xb5\x1c\xca\xf6\x7f\x3f\xa0\x14\xc4\xec\xa2\x17\- \\xd7\x99\x56\x71\xe2\xa3\x7c\xf4\x5f\x4f\xc8\x19\xf5\xa7\x8b\x1d\- \\x26\x20\xd6\x86\x6d\xe6\xcd\xf8\x9b\x31\x1d\x30\xf9\x48\x77\x12\- \\x30\xa8\x8b\xe8\x08\x60\x01\xf7\x02\x7e\x24\x7c\x37\x1b\x15\x17\- \\x3c\x92\xae\x22\x0b\xb8\xc1\xb4\x83\x9d\x2d\x5b\x05\x62\xda\x1c\- \\x65\x1b\xad\xf5\x06\x13\xf9\x50\x72\x82\xfc\x58\x43\x7d\x08\x12\- \\x3f\x62\x18\xb3\xc8\x57\x37\xe5\x0e\xa3\x3b\x2f\x94\x9c\x8a\x16\- \\xcf\x7a\xde\xdf\xba\x2d\x85\x9e\xd2\x8b\x0a\x3b\xb9\x43\x2d\x1c\- \\xc1\x0c\xeb\xcb\x94\x3c\x13\xa3\x63\x97\xe6\xc4\x53\x4a\x9c\x11\- \\xf1\xcf\xe5\xfe\xb9\x0b\xd8\x8b\x3c\x3d\x20\xb6\xe8\x5c\x03\x16\- \\xee\x43\x9f\x7e\xa8\x0e\xce\xae\x8b\x4c\xa8\xe3\x22\x34\x84\x1b\- \\x75\x8a\x23\x4f\x29\xc9\x40\x4d\xd7\x2f\x49\xce\x95\xa0\x32\x11\- \\x12\x6d\xec\xa2\x73\xfb\x90\x20\xcd\x7b\xdb\x41\xbb\x48\x7f\x15\- \\x56\x88\xa7\x8b\x50\x3a\xb5\x68\xc0\x5a\x52\x12\xea\x1a\xdf\x1a\- \\x36\xb5\x48\x57\x72\x44\x71\x41\xb8\x78\x73\x4b\xd2\x70\xcb\x10\- \\x83\xe2\x1a\xed\x8e\x95\xcd\x51\xe6\x56\x50\xde\x06\x4d\xfe\x14\- \\x24\x9b\x61\xa8\xf2\xfa\x40\xe6\x9f\x6c\xe4\x95\x48\xe0\x3d\x1a\- \\xf7\x00\x3d\xa9\xd7\x9c\xe8\xef\xe3\xc3\xae\x5d\x2d\xac\x66\x10\- \\x34\x41\x8c\x93\x0d\xc4\xe2\xeb\xdc\x74\x1a\xb5\x38\x57\x80\x14\- \\x81\x51\x6f\xf8\x10\x75\xdb\x26\x14\x12\x61\xe2\x06\x6d\xa0\x19\- \\xf1\x92\x45\x9b\x2a\x29\x49\x98\x4c\xab\x7c\x4d\x24\x44\x04\x10\- \\xad\xf7\x16\x42\x75\x73\x5b\xbe\x1f\xd6\xdb\x60\x2d\x55\x05\x14\- \\x98\xb5\x9c\x92\x52\x50\xf2\xad\xa7\xcb\x12\xb9\x78\xaa\x06\x19\- \\xff\xe2\x43\x37\x67\xe4\x6e\x99\x91\x7e\x57\xe7\x16\x55\x48\x1f\- \\xdf\x6d\x8a\x82\xc0\x4e\xe5\xff\x1a\xaf\x96\x50\x2e\x35\x8d\x13\- \\x57\x09\x2d\xa3\x70\xa2\xde\xbf\xe1\x5a\xbc\xe4\x79\x82\x70\x18\- \\xad\x4b\xf8\xcb\x0c\x4b\xd6\x2f\x9a\x71\xeb\x5d\x18\xa3\x8c\x1e\- \\x4c\x2f\x7b\xff\xe7\xee\xe5\x5d\x00\x27\xb3\x3a\xef\xe5\x17\x13\- \\x1f\xfb\x59\xff\xa1\x6a\x5f\x75\xc0\xf0\x5f\x09\x6b\xdf\xdd\x17\- \\xe7\x79\x30\x7f\x4a\x45\xb7\x92\xf0\xec\xb7\xcb\x45\x57\xd5\x1d\- \\x30\x4c\x7e\x8f\x4e\x8b\xb2\x5b\x16\xf4\x52\x9f\x8b\x56\xa5\x12\- \\x3c\xdf\x5d\x33\x22\x2e\x9f\xf2\x1b\xb1\x27\x87\x2e\xac\x4e\x17\- \\x0b\x57\x35\xc0\xaa\xf9\x46\xef\x62\x9d\xf1\x28\x3a\x57\x22\x1d\- \\x67\x56\x21\xb8\x0a\x5c\x8c\xd5\x5d\x02\x97\x59\x84\x76\x35\x12\- \\x01\xac\x29\x66\x0d\x73\xef\x4a\xf5\xc2\xfc\x6f\x25\xd4\xc2\x16\- \\x01\x17\xb4\xbf\xd0\x4f\xab\x9d\xb2\xf3\xfb\xcb\x2e\x89\x73\x1c\- \\x60\x8e\xd0\x77\xe2\x11\x8b\xa2\x4f\x78\x7d\x3f\xbd\x35\xc8\x11\- \\xf9\xb1\xc4\x15\x5b\xd6\x2d\x8b\x63\xd6\x5c\x8f\x2c\x43\x3a\x16\- \\x77\xde\x35\xdb\xf1\x4b\xf9\x6d\xfc\x0b\x34\xb3\xf7\xd3\xc8\x1b\- \\x0a\xab\x01\x29\x77\xcf\xbb\xc4\x7d\x87\x00\xd0\x7a\x84\x5d\x11\- \\xcd\x15\x42\xf3\x54\xc3\xea\x35\x5d\xa9\x00\x84\x99\xe5\xb4\x15\- \\x40\x9b\x12\x30\x2a\x74\x65\x83\xb4\xd3\x00\xe5\xff\x1e\x22\x1b\- \\x08\xa1\x0b\x5e\x9a\x68\x1f\xd2\x50\x84\x20\xef\x5f\x53\xf5\x10\- \\x4a\x89\x8e\xf5\xc0\x42\xa7\x06\x65\xa5\xe8\xea\x37\xa8\x32\x15\- \\x9d\x2b\xf2\x32\x71\x13\x51\x48\xbe\xce\xa2\xe5\x45\x52\x7f\x1a\- \\x42\x5b\xd7\xbf\x26\xac\x32\xed\x36\xc1\x85\xaf\x6b\x93\x8f\x10\- \\x12\x32\xcd\x6f\x30\x57\x7f\xa8\x84\x31\x67\x9b\x46\x78\xb3\x14\- \\x97\x7e\xc0\x8b\xfc\x2c\x9f\xd2\xe5\xfd\x40\x42\x58\x56\xe0\x19\- \\x1e\x4f\x58\xd7\x1d\x7c\xa3\xa3\xaf\x9e\x68\x29\xf7\x35\x2c\x10\- \\xe6\x62\x2e\x4d\x25\x5b\x8c\x8c\x5b\xc6\xc2\xf3\x74\x43\x37\x14\- \\x9f\xfb\x79\xa0\xee\x71\xaf\x6f\xf2\x77\xb3\x30\x52\x14\x45\x19\- \\x87\x7a\x98\x48\x6a\x4e\x9b\x0b\xef\x55\xe0\xbc\x66\x59\x96\x1f\- \\x94\x4c\x5f\x6d\x02\x11\x41\x67\xb5\x35\x0c\x36\xe0\xf7\xbd\x13\- \\xba\x1f\xb7\x08\x43\x55\x11\xc1\x22\x43\x8f\x43\xd8\x75\xad\x18\- \\xa8\xe7\xe4\xca\x93\xaa\x55\x71\xeb\x13\x73\x54\x4e\xd3\xd8\x1e\- \\xc9\x10\xcf\x5e\x9c\x8a\xd5\x26\x73\xec\xc7\xf4\x10\x84\x47\x13\- \\xfb\xd4\x82\x76\x43\xed\x8a\xf0\x8f\xe7\xf9\x31\x15\x65\x19\x18\- \\x3a\x8a\x23\x54\x94\xa8\xad\xec\x73\x61\x78\x7e\x5a\xbe\x1f\x1e\- \\x64\x36\x96\xb4\x5c\x89\xec\x73\xe8\x3c\x0b\x8f\xf8\xd6\xd3\x12\- \\xfd\xc3\xbb\xe1\xb3\xab\xe7\x90\x22\x0c\xce\xb2\xb6\xcc\x88\x17\- \\xfd\xb4\x2a\xda\xa0\x96\x21\x35\x2b\x8f\x81\x5f\xe4\xff\x6a\x1d\- \\x1e\xb1\x5a\x88\x24\xfe\x34\x01\x7b\xf9\xb0\xbb\xee\xdf\x62\x12\- \\x65\x5d\x71\xaa\xad\x3d\x82\xc1\xd9\x37\x9d\x6a\xea\x97\xfb\x16\- \\xbf\xb4\x0d\x15\x19\xcd\xe2\x31\xd0\x85\x44\x05\xe5\x7d\xba\x1c\- \\xf7\x90\x28\xad\x2f\xc0\x2d\x1f\xa2\xd3\x4a\x23\xaf\x8e\xf4\x11\- \\x35\xb5\x72\x98\x3b\x30\xf9\xa6\x8a\x88\x1d\xec\x5a\xb2\x71\x16\- \\x82\x62\x8f\x7e\x4a\x7c\xb7\x50\xad\xea\x24\xa7\xf1\x1e\x0e\x1c\- \\x91\x9d\x19\x8f\xae\xad\x72\x52\xac\x12\x77\x08\x57\xd3\x88\x11\- \\xf6\x04\xe0\x32\x1a\x59\x0f\x67\x57\xd7\x94\xca\x2c\x08\xeb\x15\- \\x33\x06\x98\xbf\x60\x2f\xd3\x40\x2d\x0d\x3a\xfd\x37\xca\x65\x1b\- \\xe0\x03\xbf\x77\x9c\xfd\x83\x48\x3c\x48\x44\xfe\x62\x9e\x1f\x11\- \\xd8\xc4\xae\x95\x03\xfd\xa4\x5a\x4b\x5a\xd5\xbd\xfb\x85\x67\x15\- \\x0e\x76\x1a\x7b\x44\x3c\x4e\x31\xde\xb0\x4a\xad\x7a\x67\xc1\x1a\- \\xc9\x89\xf0\xcc\xaa\xe5\xd0\xde\x8a\xae\x4e\xac\xac\xe0\xb8\x10\- \\x3b\xac\x2c\x80\x15\x1f\x85\x96\x2d\x5a\x62\xd7\xd7\x18\xe7\x14\- \\x4a\xd7\x37\xe0\xda\x66\x26\xfc\xb8\xf0\x3a\xcd\x0d\xdf\x20\x1a\- \\x8e\xe6\x22\xcc\x48\x00\x98\x9d\x73\xd6\x44\xa0\x68\x8b\x54\x10\- \\x32\xa0\x2b\xff\x5a\x00\xfe\x84\x10\x0c\x56\xc8\x42\xae\x69\x14\- \\x3e\x88\xf6\xbe\x71\x80\x3d\xa6\x14\x8f\x6b\x7a\xd3\x19\x84\x19\- \\x4e\x2a\xb4\x2e\x8e\xe0\xcc\xcf\xd9\x72\x06\x59\x48\x20\xe5\x1f\- \\x70\x9a\x30\xdd\x58\x0c\xe0\x21\xc8\x07\xa4\x37\x2d\x34\xef\x13\- \\x0d\xc1\x7c\x14\x6f\x0f\x58\x2a\xba\x09\x8d\x85\x38\x01\xeb\x18\- \\x50\xf1\x9b\xd9\x4a\x13\xee\xb4\x28\x4c\xf0\xa6\x86\xc1\x25\x1f\- \\xd2\x76\x01\xc8\x0e\xcc\x14\x71\x99\x2f\x56\x28\xf4\x98\x77\x13\- \\x86\xd4\x01\x7a\x12\xff\x59\xcd\x7f\xbb\x6b\x32\x31\x7f\x55\x18\- \\xa8\x49\x82\x18\xd7\x7e\xb0\xc0\x5f\xaa\x06\x7f\xfd\xde\x6a\x1e\- \\x09\x6e\x51\x6f\x46\x4f\x6e\xd8\x7b\x2a\x64\x6f\x5e\xcb\x02\x13\- \\x8b\xc9\x25\x0b\x18\xe3\x89\xce\x1a\x35\x3d\x0b\x36\x7e\xc3\x17\- \\xee\x3b\xef\x0d\xde\x5b\x2c\x82\x61\x82\x0c\x8e\xc3\x5d\xb4\x1d\- \\x75\x85\xb5\xc8\x6a\xb9\x5b\xf1\x7c\xd1\xc7\x38\x9a\xba\x90\x12\- \\xd2\xe6\xe2\x7a\xc5\xa7\xb2\x2d\xdc\xc5\xf9\xc6\x40\xe9\x34\x17\- \\x86\xa0\x9b\xd9\xb6\x51\x1f\x39\x53\x37\xb8\xf8\x90\x23\x02\x1d\- \\x54\x44\x01\x48\x12\x93\xb3\x03\x94\x22\x73\x9b\x3a\x56\x21\x12\- \\x69\x95\x01\xda\xd6\x77\xa0\x04\x39\xeb\x4f\x42\xc9\xab\xa9\x16\- \\xc3\xfa\x81\x90\xcc\x95\xc8\x45\x07\xe6\xe3\x92\xbb\x16\x54\x1c\- \\xba\x3c\x51\xda\x9f\x5d\x9d\x8b\xc4\x6f\xce\x3b\x35\x8e\xb4\x11\- \\xe8\x8b\xe5\xd0\x07\xb5\x84\xae\xb5\x0b\xc2\x8a\xc2\xb1\x21\x16\- \\xe3\xee\x1e\xc5\x49\xe2\x25\x1a\xa3\x8e\x72\x2d\x33\x1e\xaa\x1b\- \\x4d\x55\x33\x1b\x6e\xad\x57\xf0\x25\x99\x67\xfc\xdf\x52\x4a\x11\- \\xa1\x2a\x00\xa2\xc9\x98\x6d\x6c\x6f\x7f\x81\xfb\x97\xe7\x9c\x15\- \\x49\x35\x80\x0a\xfc\xfe\x88\x47\x4b\xdf\x61\xfa\x7d\x21\x04\x1b\- \\x4e\x21\x90\x86\x5d\x9f\xb5\x0c\x8f\x2b\x7d\xbc\xee\x94\xe2\x10\- \\xa1\x29\x34\xe8\x34\x07\xe3\xcf\x72\x76\x9c\x6b\x2a\x3a\x1b\x15\- \\x0a\x34\x41\x22\x02\xc9\xdb\x83\x0f\x94\x83\x06\xb5\x08\x62\x1a\- \\x86\xc0\x68\x55\xa1\x5d\x69\xb2\x89\x3c\x12\x24\x71\x45\x7d\x10\- \\xa7\xf0\xc2\xaa\x09\xb5\x03\x1f\xac\xcb\x16\x6d\xcd\x96\x9c\x14\- \\xd1\xac\x73\x15\x4c\xa2\xc4\x26\x97\x7e\x5c\xc8\x80\xbc\xc3\x19\- \\x03\x4c\x68\x8d\x6f\xe5\x3a\x78\x1e\xcf\x39\x7d\xd0\x55\x1a\x10\- \\x03\x5f\xc2\x70\xcb\x9e\x49\x16\xe6\x42\x88\x9c\x44\xeb\x20\x14\- \\xc4\xf6\xf2\x4c\x7e\x06\xdc\x9b\x9f\x53\xaa\xc3\x15\x26\x29\x19\- \\x76\xb4\x2f\xe0\x1d\x08\xd3\x82\x87\xe8\x94\x34\x9b\x6f\x73\x1f\- \\xc9\xd0\x1d\xac\x12\xe5\xc3\xb1\x54\x11\xdd\x00\xc1\x25\xa8\x13\- \\xfc\x44\x25\x57\x57\xde\x34\xde\xa9\x55\x14\x41\x31\x2f\x92\x18\- \\x3b\x96\xee\x2c\xed\x15\xc2\x55\x14\x6b\x59\x91\xfd\xba\xb6\x1e\- \\xe5\x1d\x15\x3c\xb4\x4d\x99\xb5\xec\xe2\xd7\x7a\xde\x34\x32\x13\- \\x5e\x65\x1a\x4b\x21\xa1\xff\xe2\xa7\xdb\x8d\x19\x16\xc2\xfe\x17\- \\xb6\xfe\xe0\x9d\x69\x89\xbf\xdb\x91\x52\xf1\x9f\x9b\x72\xfe\x1d\- \\x31\x9f\xac\x02\xe2\xb5\x57\x29\x9b\xd3\xf6\x43\xa1\x07\xbf\x12\- \\xfe\xc6\x57\x83\x5a\xa3\xad\xf3\x81\x88\xf4\x94\x89\xc9\x6e\x17\- \\xbd\xb8\x2d\x24\x31\x0c\x99\x70\xa2\xaa\x31\xfa\xeb\x7b\x4a\x1d\- \\x76\x93\x9c\xb6\x9e\xa7\x5f\x86\xa5\x0a\x5f\x7c\x73\x8d\x4e\x12\- \\x54\xb8\x43\x64\x86\x91\xf7\xe7\x4e\xcd\x76\x5b\xd0\x30\xe2\x16\- \\x69\xa6\x54\xfd\xe7\x75\xf5\xa1\xa2\x80\x54\x72\x04\xbd\x9a\x1c\- \\x01\xe8\x54\xfe\xb0\x69\x39\xa5\x65\xd0\x74\xc7\x22\xb6\xe0\x11\- \\x02\x22\xea\x3d\x1d\xc4\x87\x0e\x7f\x04\x52\x79\xab\xe3\x58\x16\- \\x82\xaa\x64\x8d\x24\xb5\x29\xd2\x9e\x85\xa6\x57\x96\x1c\xef\x1b\- \\x91\xea\x5e\xd8\x36\x11\x5a\x43\x83\x13\xc8\xf6\xdd\x71\x75\x11\- \\x36\xa5\x76\x8e\x84\x95\x30\x14\x64\x18\x7a\x74\x55\xce\xd2\x15\- \\x83\x4e\x14\xb2\xe5\xba\x3c\x19\x7d\x9e\x98\xd1\xea\x81\x47\x1b\- \\x12\xb1\x4c\x8f\xcf\xf4\xc5\x2f\x0e\x63\xff\xc2\x32\xb1\x0c\x11\- \\x56\xdd\x1f\x73\x03\x72\xb7\xbb\xd1\x3b\xbf\x73\x7f\xdd\x4f\x15\- \\xac\xd4\xe7\x4f\x84\x4e\xa5\x2a\xc6\x0a\xaf\x50\xdf\xd4\xa3\x1a\- \\xeb\xe4\xf0\xb1\x12\x51\xa7\xda\xbb\x66\x6d\x92\x0b\x65\xa6\x10\- \\x26\x1e\x6d\x5e\x57\x25\x51\xd1\x6a\xc0\x08\x77\x4e\xfe\xcf\x14\- \\xb0\x65\x08\x36\xad\x6e\xa5\x85\x85\xf0\xca\x14\xe2\xfd\x03\x1a\- \\x8e\x3f\xc5\x41\x2c\x65\x87\x73\x53\xd6\xfe\x4c\xad\x7e\x42\x10\- \\x71\x8f\x36\x52\x77\x3e\x69\x50\xe8\x8b\x3e\xa0\x58\x1e\x53\x14\- \\x4e\x33\xc4\x26\x15\x8e\x83\x64\xe2\x2e\x4e\xc8\xee\xe5\x67\x19\- \\x22\x40\x75\x70\x9a\x71\xa4\xfd\x9a\xba\x61\x7a\x6a\xdf\xc1\x1f\- \\x15\x48\x49\x86\x00\xc7\x86\xde\xa0\x14\x7d\x8c\xa2\x2b\xd9\x13\- \\x1a\x9a\xdb\xa7\xc0\x78\x28\x16\xc9\x59\x9c\x2f\x8b\x76\xcf\x18\- \\xa1\x80\xd2\xd1\xf0\x96\xb2\x5b\x3b\x70\x83\xfb\x2d\x54\x03\x1f\- \\x64\x90\x23\x83\x56\x9e\x4f\x19\x25\x26\x32\xbd\x9c\x14\x62\x13\- \\x7e\x74\xec\x23\xec\x85\xa3\x5f\xae\xaf\x7e\xec\xc3\x99\x3a\x18\- \\x9d\x91\xe7\x2c\x67\x67\x8c\xf7\x99\x5b\x9e\xe7\x34\x40\x49\x1e\- \\x02\xbb\x10\x7c\xa0\xc0\xb7\x3a\x40\xf9\xc2\x10\x21\xc8\xed\x12\- \\xc3\xe9\x14\x9b\xc8\xb0\x65\x49\x90\xb7\xf3\x54\x29\x3a\xa9\x17\- \\x33\x24\xda\xc1\xfa\x1c\xbf\x5b\x74\xa5\x30\xaa\xb3\x88\x93\x1d\- \\xa0\x56\x28\xb9\x1c\x72\x57\xb9\x68\x67\x5e\x4a\x70\x35\x7c\x12\- \\x48\x6c\x72\xe7\xa3\x4e\xad\xe7\x42\x01\xf6\x5c\xcc\x42\x1b\x17\- \\x5a\x07\x4f\xe1\x4c\xa2\x98\xa1\x93\x81\x33\x74\x7f\x13\xe2\x1c\- \\x98\x64\xd1\x0c\x70\x65\xff\x44\xfc\x30\xa0\xa8\x2f\x4c\x0d\x12\- \\xbe\xbd\x05\x10\xcc\x3e\x3f\x56\x3b\x3d\xc8\x92\x3b\x9f\x90\x16\- \\x2e\x2d\x07\x14\x7f\x0e\xcf\x2b\x8a\x4c\x7a\x77\x0a\xc7\x34\x1c\- \\x3d\x7c\x84\x6c\x0f\x69\x61\x5b\xd6\x6f\xac\x8a\x66\xfc\xa0\x11\- \\x4c\x9b\xa5\x47\x53\xc3\x39\xf2\xcb\x8b\x57\x2d\x80\x3b\x09\x16\- \\x1f\x02\x8f\x19\x28\x34\xc8\xee\xbe\x6e\xad\x38\x60\x8a\x8b\x1b\- \\x53\x61\xf9\x0f\x99\x20\x3d\x55\x37\x65\x6c\x23\x7c\x36\x37\x11\- \\xa8\xb9\xf7\x53\xbf\x68\x8c\x2a\x85\x7e\x47\x2c\x1b\x04\x85\x15\- \\x12\xa8\xf5\x28\xef\x82\x2f\x75\x26\x5e\x59\xf7\x21\x45\xe6\x1a\- \\x0b\x89\x99\x79\xd5\xb1\x3d\x09\xd8\xda\x97\x3a\x35\xeb\xcf\x10\- \\x4e\xeb\xff\xd7\x4a\x1e\x8d\x0b\x8e\xd1\x3d\x89\x02\xe6\x03\x15\- \\x22\xe6\xff\x8d\xdd\x65\x70\x8e\xf1\x45\x8d\x2b\x83\xdf\x44\x1a\- \\xd5\xef\xbf\x78\xaa\x3f\x06\xf9\xb6\x4b\x38\xfb\xb1\x0b\x6b\x10\- \\xca\xeb\xef\x16\x95\xcf\x47\xb7\xa4\x5e\x06\x7a\x9e\xce\x85\x14\- \\xbd\xe6\xab\x5c\x7a\xc3\x19\xe5\x4d\xf6\x87\x18\x46\x42\xa7\x19\- \\x36\x70\xeb\x79\x2c\x1a\x30\xaf\xf0\xf9\x54\xcf\x6b\x89\x08\x10\- \\x43\x4c\x66\x98\xb7\x20\xfc\xda\x6c\x38\x2a\xc3\xc6\xab\x0a\x14\- \\x54\xdf\x7f\x7e\xe5\x28\xbb\x11\x88\xc6\xf4\x73\xb8\x56\x0d\x19\- \\x2a\xd7\x1f\xde\x1e\xf3\x29\x16\x2a\xf8\xf1\x90\x66\xac\x50\x1f\- \\x7a\xe6\xd3\x4a\xf3\x37\xda\x4d\x1a\x3b\x97\x1a\xc0\x6b\x92\x13\- \\x19\xe0\x88\x1d\xf0\xc5\x50\xe1\xe0\x09\x3d\x21\xb0\x06\x77\x18\- \\x1f\x18\xeb\x24\x6c\xf7\xa4\x19\x59\x4c\x8c\x29\x5c\xc8\x94\x1e\- \\x13\xef\x12\x97\xa3\x1a\x07\xb0\xb7\xaf\xf7\x99\x39\xfd\x1c\x13\- \\xd8\xaa\xd7\x7c\x4c\xe1\x08\x9c\xa5\x9b\x75\x00\x88\x3c\xe4\x17\- \\x8e\x95\x0d\x9c\x9f\x19\x0b\x03\x8f\x02\x93\x00\xaa\x4b\xdd\x1d\- \\x79\x7d\x88\xc1\x03\xf0\xe6\x61\x99\xe1\x5b\x40\x4a\x4f\xaa\x12\- \\xd7\x9c\xea\xb1\x04\xac\x60\xba\xff\xd9\x72\xd0\x1c\xe3\x54\x17\- \\x0d\x44\x65\xde\x05\xd7\xf8\xa8\x7f\x90\x8f\x04\xe4\x1b\x2a\x1d\- \\x88\x4a\xff\xaa\x63\x86\x9b\xc9\x4f\xba\xd9\x82\x6e\x51\x3a\x12\- \\x2a\x1d\xbf\x95\xfc\x67\x02\xbc\xe3\x28\x90\x23\xca\xe5\xc8\x16\- \\x74\xe4\x2e\xbb\xfb\x01\x03\xab\x1c\x33\x74\xac\x3c\x1f\x7b\x1c\- \\xc9\x4e\xfd\x54\x3d\xe1\xe1\xea\xf1\x9f\xc8\xeb\x85\xf3\xcc\x11\- \\x7b\xa2\x3c\xaa\x8c\x59\x9a\x65\xee\xc7\xba\x66\x67\x30\x40\x16\- \\x1a\xcb\xcb\xd4\xef\xef\x00\xff\xe9\x79\x69\x40\x81\x3c\xd0\x1b\- \\xf0\x5e\xff\xe4\xf5\x95\x60\x3f\x32\xec\x41\xc8\xd0\x25\x62\x11\- \\xac\x36\x3f\x5e\x73\xbb\x38\xcf\x3e\x67\x52\xfa\x44\xaf\xba\x15\- \\x57\x04\xcf\x35\x50\xea\x06\x83\x0e\x01\xe7\x38\x16\x5b\x29\x1b\- \\xb6\x62\xa1\x21\x72\x52\xe4\x11\xa9\x60\x90\xe3\xed\xd8\xf9\x10\- \\x64\xbb\x09\xaa\x0e\x67\x5d\x56\xd3\x78\x74\x5c\x29\x4f\x38\x15\- \\x3d\x2a\x8c\x54\xd2\xc0\xf4\x2b\x08\x97\x91\xb3\xf3\x62\x86\x1a\- \\x66\x9a\xd7\x74\x83\xf8\x78\x1b\x65\xfe\x3a\x50\xd8\xfd\x93\x10\- \\x00\x81\x0d\x52\xa4\x36\x57\x62\xfe\xbd\x49\x64\x4e\xfd\xb8\x14\- \\x40\xe1\x90\x66\x4d\x04\xed\xfa\x7d\x2d\x5c\xfd\xa1\x3c\xe7\x19\- \\xc8\x8c\x1a\x60\xb0\x22\xd4\xbc\x6e\x9c\x59\x3e\xe5\x85\x30\x10\- \\xfa\x2f\x21\x78\x5c\x2b\x09\x6c\x8a\x03\xf0\x8d\x5e\xa7\x3c\x14\- \\xf8\x7b\x29\x96\x33\x76\x0b\x07\x6d\x04\x6c\x31\x36\xd1\x4b\x19\- \\xf6\xda\xb3\x7b\xc0\x53\xce\x48\x88\x05\xc7\xbd\x83\xc5\x9e\x1f\- \\xda\x68\x50\x4d\x58\xf4\x80\x2d\x75\x63\x9c\x56\x72\x3b\xc3\x13\- \\x10\x83\xa4\x60\x6e\x31\xe1\x78\x52\x7c\x43\xec\x4e\x0a\xb4\x18"#---- | Number of mantissa bits of a 64-bit float. The number of significant bits--- (floatDigits (undefined :: Double)) is 53 since we have a leading 1 for--- normal floats and 0 for subnormal floats-double_mantissa_bits :: Int-double_mantissa_bits = 52---- | Number of exponent bits of a 64-bit float-double_exponent_bits :: Int-double_exponent_bits = 11---- | Bias in encoded 64-bit float representation (2^10 - 1)-double_bias :: Int-double_bias = 1023--data FloatingDecimal = FloatingDecimal- { dmantissa :: !Word64- , dexponent :: !Int32- } deriving (Show, Eq)---- | Quick check for small integers-d2dSmallInt :: Word64 -> Word64 -> Maybe FloatingDecimal-d2dSmallInt m e =- let m2 = (1 `unsafeShiftL` double_mantissa_bits) .|. m- e2 = word64ToInt e - (double_bias + double_mantissa_bits)- fraction = m2 .&. mask (-e2)- in case () of- _ -- f = m2 * 2^e2 >= 2^53 is an integer.- -- Ignore this case for now.- | e2 > 0 -> Nothing- -- f < 1- | e2 < -52 -> Nothing- -- Since 2^52 <= m2 < 2^53 and 0 <= -e2 <= 52:- -- 1 <= f = m2 / 2^-e2 < 2^53.- -- Test if the lower -e2 bits of the significand are 0, i.e.- -- whether the fraction is 0.- | fraction /= 0 -> Nothing- -- f is an integer in the range [1, 2^53).- -- Note: mantissa might contain trailing (decimal) 0's.- -- Note: since 2^53 < 10^16, there is no need to adjust decimalLength17().- | otherwise -> Just $ FloatingDecimal (m2 `unsafeShiftR` (-e2)) 0----- | Removes trailing (decimal) zeros for small integers in the range [1, 2^53)-unifySmallTrailing :: FloatingDecimal -> FloatingDecimal-unifySmallTrailing fd@(FloatingDecimal m e) =- let !(q, r) = dquotRem10 m- in if r == 0- then unifySmallTrailing $ FloatingDecimal q (e + 1)- else fd---- TODO: 128-bit intrinsics--- | Multiply a 64-bit number with a 128-bit number while keeping the upper 64--- bits. Then shift by specified amount minus 64-mulShift64 :: Word64 -> (Word64, Word64) -> Int -> Word64-mulShift64 m (factorHi, factorLo) shift =- let !(b0Hi, _ ) = m `timesWord2` factorLo- !(b1Hi, b1Lo) = m `timesWord2` factorHi- total = b0Hi + b1Lo- high = b1Hi + boolToWord64 (total < b0Hi)- dist = shift - 64- in (high `unsafeShiftL` (64 - dist)) .|. (total `unsafeShiftR` dist)---- | Index into the 128-bit word lookup table double_pow5_inv_split-get_double_pow5_inv_split :: Int -> (Word64, Word64)-get_double_pow5_inv_split =- let !(Addr arr) = double_pow5_inv_split- in getWord128At arr---- | Index into the 128-bit word lookup table double_pow5_split-get_double_pow5_split :: Int -> (Word64, Word64)-get_double_pow5_split =- let !(Addr arr) = double_pow5_split- in getWord128At arr+{-# LANGUAGE CPP #-}++-- |+-- Module : Data.ByteString.Builder.RealFloat.D2S+-- Copyright : (c) Lawrence Wu 2021+-- License : BSD-style+-- Maintainer : lawrencejwu@gmail.com+--+-- Implementation of double-to-string conversion++module Data.ByteString.Builder.RealFloat.D2S+ ( FloatingDecimal(..)+ , d2s+ , d2Intermediate+ ) where++import Control.Arrow (first)+import Data.Bits ((.|.), (.&.), unsafeShiftL, unsafeShiftR)+import Data.ByteString.Builder.Internal (Builder)+import Data.ByteString.Builder.Prim (primBounded)+import Data.ByteString.Builder.RealFloat.Internal+import Data.Maybe (fromMaybe)+import GHC.Int (Int32(..))+import GHC.Word (Word64(..))++#if !PURE_HASKELL+import GHC.Ptr (Ptr(..))+#endif++-- See Data.ByteString.Builder.RealFloat.TableGenerator for a high-level+-- explanation of the ryu algorithm++#if !PURE_HASKELL+-- | Table of 2^k / 5^q + 1+--+-- > splitWord128s $ fmap (finv double_pow5_inv_bitcount) [0..double_max_inv_split]+foreign import ccall "&hs_bytestring_double_pow5_inv_split"+ double_pow5_inv_split :: Ptr Word64++-- | Table of 5^(-e2-q) / 2^k + 1+--+-- > splitWord128s $ fmap (fnorm double_pow5_bitcount) [0..double_max_split]+foreign import ccall "&hs_bytestring_double_pow5_split"+ double_pow5_split :: Ptr Word64+#endif++-- | Number of mantissa bits of a 64-bit float. The number of significant bits+-- (floatDigits (undefined :: Double)) is 53 since we have a leading 1 for+-- normal floats and 0 for subnormal floats+double_mantissa_bits :: Int+double_mantissa_bits = 52++-- | Number of exponent bits of a 64-bit float+double_exponent_bits :: Int+double_exponent_bits = 11++-- | Bias in encoded 64-bit float representation (2^10 - 1)+double_bias :: Int+double_bias = 1023++data FloatingDecimal = FloatingDecimal+ { dmantissa :: !Word64+ , dexponent :: !Int32+ } deriving (Show, Eq)++-- | Quick check for small integers+d2dSmallInt :: Word64 -> Word64 -> Maybe FloatingDecimal+d2dSmallInt m e =+ let m2 = (1 `unsafeShiftL` double_mantissa_bits) .|. m+ e2 = word64ToInt e - (double_bias + double_mantissa_bits)+ fraction = m2 .&. mask (-e2)+ in case () of+ _ -- f = m2 * 2^e2 >= 2^53 is an integer.+ -- Ignore this case for now.+ | e2 > 0 -> Nothing+ -- f < 1+ | e2 < -52 -> Nothing+ -- Since 2^52 <= m2 < 2^53 and 0 <= -e2 <= 52:+ -- 1 <= f = m2 / 2^-e2 < 2^53.+ -- Test if the lower -e2 bits of the significand are 0, i.e.+ -- whether the fraction is 0.+ | fraction /= 0 -> Nothing+ -- f is an integer in the range [1, 2^53).+ -- Note: mantissa might contain trailing (decimal) 0's.+ -- Note: since 2^53 < 10^16, there is no need to adjust decimalLength17().+ | otherwise -> Just $ FloatingDecimal (m2 `unsafeShiftR` (-e2)) 0+++-- | Removes trailing (decimal) zeros for small integers in the range [1, 2^53)+unifySmallTrailing :: FloatingDecimal -> FloatingDecimal+unifySmallTrailing fd@(FloatingDecimal m e) =+ let !(q, r) = dquotRem10 m+ in if r == 0+ then unifySmallTrailing $ FloatingDecimal q (e + 1)+ else fd++-- TODO: 128-bit intrinsics+-- | Multiply a 64-bit number with a 128-bit number while keeping the upper 64+-- bits. Then shift by specified amount minus 64+mulShift64 :: Word64 -> (Word64, Word64) -> Int -> Word64+mulShift64 m (factorHi, factorLo) shift =+ let !(b0Hi, _ ) = m `timesWord2` factorLo+ !(b1Hi, b1Lo) = m `timesWord2` factorHi+ total = b0Hi + b1Lo+ high = b1Hi + boolToWord64 (total < b0Hi)+ dist = shift - 64+ in (high `unsafeShiftL` (64 - dist)) .|. (total `unsafeShiftR` dist)++-- | Index into the 128-bit word lookup table double_pow5_inv_split+get_double_pow5_inv_split :: Int -> (Word64, Word64)+#if !PURE_HASKELL+get_double_pow5_inv_split = getWord128At double_pow5_inv_split+#else+-- > putStr $ case128 (finv double_pow5_inv_bitcount) [0..double_max_inv_split]+get_double_pow5_inv_split i = case i of+ 0 -> (0x2000000000000000, 0x1)+ 1 -> (0x1999999999999999, 0x999999999999999a)+ 2 -> (0x147ae147ae147ae1, 0x47ae147ae147ae15)+ 3 -> (0x10624dd2f1a9fbe7, 0x6c8b4395810624de)+ 4 -> (0x1a36e2eb1c432ca5, 0x7a786c226809d496)+ 5 -> (0x14f8b588e368f084, 0x61f9f01b866e43ab)+ 6 -> (0x10c6f7a0b5ed8d36, 0xb4c7f34938583622)+ 7 -> (0x1ad7f29abcaf4857, 0x87a6520ec08d236a)+ 8 -> (0x15798ee2308c39df, 0x9fb841a566d74f88)+ 9 -> (0x112e0be826d694b2, 0xe62d01511f12a607)+ 10 -> (0x1b7cdfd9d7bdbab7, 0xd6ae6881cb5109a4)+ 11 -> (0x15fd7fe17964955f, 0xdef1ed34a2a73aea)+ 12 -> (0x119799812dea1119, 0x7f27f0f6e885c8bb)+ 13 -> (0x1c25c268497681c2, 0x650cb4be40d60df8)+ 14 -> (0x16849b86a12b9b01, 0xea70909833de7193)+ 15 -> (0x1203af9ee756159b, 0x21f3a6e0297ec143)+ 16 -> (0x1cd2b297d889bc2b, 0x6985d7cd0f313537)+ 17 -> (0x170ef54646d49689, 0x2137dfd73f5a90f9)+ 18 -> (0x12725dd1d243aba0, 0xe75fe645cc4873fa)+ 19 -> (0x1d83c94fb6d2ac34, 0xa5663d3c7a0d865d)+ 20 -> (0x179ca10c9242235d, 0x511e976394d79eb1)+ 21 -> (0x12e3b40a0e9b4f7d, 0xda7edf82dd794bc1)+ 22 -> (0x1e392010175ee596, 0x2a6498d1625bac68)+ 23 -> (0x182db34012b25144, 0xeeb6e0a781e2f053)+ 24 -> (0x1357c299a88ea76a, 0x58924d52ce4f26a9)+ 25 -> (0x1ef2d0f5da7dd8aa, 0x27507bb7b07ea441)+ 26 -> (0x18c240c4aecb13bb, 0x52a6c95fc0655034)+ 27 -> (0x13ce9a36f23c0fc9, 0xeebd44c99eaa690)+ 28 -> (0x1fb0f6be50601941, 0xb17953adc3110a80)+ 29 -> (0x195a5efea6b34767, 0xc12ddc8b02740867)+ 30 -> (0x14484bfeebc29f86, 0x3424b06f3529a052)+ 31 -> (0x1039d66589687f9e, 0x901d59f290ee19db)+ 32 -> (0x19f623d5a8a73297, 0x4cfbc31db4b0295f)+ 33 -> (0x14c4e977ba1f5bac, 0x3d9635b15d59bab2)+ 34 -> (0x109d8792fb4c4956, 0x97ab5e277de16228)+ 35 -> (0x1a95a5b7f87a0ef0, 0xf2abc9d8c9689d0d)+ 36 -> (0x154484932d2e725a, 0x5bbca17a3aba173e)+ 37 -> (0x11039d428a8b8eae, 0xafca1ac82efb45cb)+ 38 -> (0x1b38fb9daa78e44a, 0xb2dcf7a6b1920945)+ 39 -> (0x15c72fb1552d836e, 0xf57d92ebc141a104)+ 40 -> (0x116c262777579c58, 0xc46475896767b403)+ 41 -> (0x1be03d0bf225c6f4, 0x6d6d88dbd8a5ecd2)+ 42 -> (0x164cfda3281e38c3, 0x8abe071646eb23db)+ 43 -> (0x11d7314f534b609c, 0x6efe6c11d255b649)+ 44 -> (0x1c8b821885456760, 0xb197134fb6ef8a0e)+ 45 -> (0x16d601ad376ab91a, 0x27ac0f72f8bfa1a5)+ 46 -> (0x1244ce242c5560e1, 0xb95672c260994e1e)+ 47 -> (0x1d3ae36d13bbce35, 0xf5571e03cdc21695)+ 48 -> (0x17624f8a762fd82b, 0x2aac18030b01abab)+ 49 -> (0x12b50c6ec4f31355, 0xbbbce0026f348956)+ 50 -> (0x1dee7a4ad4b81eef, 0x92c7ccd0b1eda889)+ 51 -> (0x17f1fb6f10934bf2, 0xdbd30a408e57ba07)+ 52 -> (0x1327fc58da0f6ff5, 0x7ca8d50071dfc806)+ 53 -> (0x1ea6608e29b24cbb, 0xfaa7bb33e9660cd6)+ 54 -> (0x18851a0b548ea3c9, 0x9552fc298784d711)+ 55 -> (0x139dae6f76d88307, 0xaaa8c9bad2d0ac0e)+ 56 -> (0x1f62b0b257c0d1a5, 0xdddadc5e1e1aace3)+ 57 -> (0x191bc08eac9a4151, 0x7e48b04b4b488a4f)+ 58 -> (0x141633a556e1cdda, 0xcb6d59d5d5d3a1d9)+ 59 -> (0x1011c2eaabe7d7e2, 0x3c577b1177dc817b)+ 60 -> (0x19b604aaaca62636, 0xc6f25e825960cf2a)+ 61 -> (0x14919d5556eb51c5, 0x6bf518684780a5bb)+ 62 -> (0x10747ddddf22a7d1, 0x232a79ed06008496)+ 63 -> (0x1a53fc9631d10c81, 0xd1dd8fe1a3340756)+ 64 -> (0x150ffd44f4a73d34, 0xa7e4731ae8f66c45)+ 65 -> (0x10d9976a5d52975d, 0x531d28e253f8569e)+ 66 -> (0x1af5bf109550f22e, 0xeb61db03b98d5762)+ 67 -> (0x159165a6ddda5b58, 0xbc4e48cfc7a445e8)+ 68 -> (0x11411e1f17e1e2ad, 0x6371d3d96c836b20)+ 69 -> (0x1b9b6364f3030448, 0x9f1c8628ad9f11cd)+ 70 -> (0x1615e91d8f359d06, 0xe5b06b53be18db0b)+ 71 -> (0x11ab20e472914a6b, 0xeaf3890fcb4715a2)+ 72 -> (0x1c45016d841baa46, 0x44b8db4c7871bc37)+ 73 -> (0x169d9abe03495505, 0x3c715d6c6c1635f)+ 74 -> (0x1217aefe69077737, 0x3638de456bcde919)+ 75 -> (0x1cf2b1970e725858, 0x56c163a2461641c1)+ 76 -> (0x17288e1271f51379, 0xdf011c81d1ab67ce)+ 77 -> (0x1286d80ec190dc61, 0x7f3416ce4155eca5)+ 78 -> (0x1da48ce468e7c702, 0x6520247d3556476e)+ 79 -> (0x17b6d71d20b96c01, 0xea801d30f7783925)+ 80 -> (0x12f8ac174d612334, 0xbb99b0f3f92cfa84)+ 81 -> (0x1e5aacf215683854, 0x5f5c4e532847f739)+ 82 -> (0x18488a5b44536043, 0x7f7d0b75b9d32c2e)+ 83 -> (0x136d3b7c36a919cf, 0x9930d5f7c7dc2358)+ 84 -> (0x1f152bf9f10e8fb2, 0x8eb4898c72f9d226)+ 85 -> (0x18ddbcc7f40ba628, 0x722a07a38f2e41b8)+ 86 -> (0x13e497065cd61e86, 0xc1bb394fa5be9afa)+ 87 -> (0x1fd424d6faf030d7, 0x9c5ec2190930f7f6)+ 88 -> (0x197683df2f268d79, 0x49e56814075a5ff8)+ 89 -> (0x145ecfe5bf520ac7, 0x6e51201005e1e660)+ 90 -> (0x104bd984990e6f05, 0xf1da800cd181851a)+ 91 -> (0x1a12f5a0f4e3e4d6, 0x4fc400148268d4f5)+ 92 -> (0x14dbf7b3f71cb711, 0xd96999aa01ed772b)+ 93 -> (0x10aff95cc5b09274, 0xadee1488018ac5bc)+ 94 -> (0x1ab328946f80ea54, 0x497ceda668de092c)+ 95 -> (0x155c2076bf9a5510, 0x3aca57b853e4d424)+ 96 -> (0x1116805effaeaa73, 0x623b7960431d7683)+ 97 -> (0x1b5733cb32b110b8, 0x9d2bf566d1c8bd9e)+ 98 -> (0x15df5ca28ef40d60, 0x7dbcc452416d647f)+ 99 -> (0x117f7d4ed8c33de6, 0xcafd69db678ab6cc)+ 100 -> (0x1bff2ee48e052fd7, 0xab2f0fc572778adf)+ 101 -> (0x1665bf1d3e6a8cac, 0x88f273045b92d580)+ 102 -> (0x11eaff4a98553d56, 0xd3f528d049424466)+ 103 -> (0x1cab3210f3bb9557, 0xb988414d4203a0a3)+ 104 -> (0x16ef5b40c2fc7779, 0x6139cdd76802e6e9)+ 105 -> (0x125915cd68c9f92d, 0xe761717920025254)+ 106 -> (0x1d5b561574765b7c, 0xa568b58e999d5086)+ 107 -> (0x177c44ddf6c515fd, 0x5120913ee14aa6d2)+ 108 -> (0x12c9d0b1923744ca, 0xa74d40ff1aa21f0e)+ 109 -> (0x1e0fb44f50586e11, 0xbaece64f769cb4a)+ 110 -> (0x180c903f7379f1a7, 0x3c8bd850c5ee3c3b)+ 111 -> (0x133d4032c2c7f485, 0xca0979da37f1c9c9)+ 112 -> (0x1ec866b79e0cba6f, 0xa9a8c2f6bfe942db)+ 113 -> (0x18a0522c7e709526, 0x2153cf2bccba9be3)+ 114 -> (0x13b374f06526ddb8, 0x1aa9728970954982)+ 115 -> (0x1f8587e7083e2f8c, 0xf775840f1a88759d)+ 116 -> (0x19379fec0698260a, 0x5f9136727ba05e17)+ 117 -> (0x142c7ff0054684d5, 0x1940f85b9619e4df)+ 118 -> (0x1023998cd1053710, 0xe100c6afab47ea4c)+ 119 -> (0x19d28f47b4d524e7, 0xce67a44c453fdd47)+ 120 -> (0x14a8729fc3ddb71f, 0xd852e9d69dccb106)+ 121 -> (0x1086c219697e2c19, 0x79dbee454b0a2738)+ 122 -> (0x1a71368f0f30468f, 0x295fe3a211a9d859)+ 123 -> (0x15275ed8d8f36ba5, 0xbab31c81a7bb137a)+ 124 -> (0x10ec4be0ad8f8951, 0x6228e39aec95a92f)+ 125 -> (0x1b13ac9aaf4c0ee8, 0x9d0e38f7e0ef7517)+ 126 -> (0x15a956e225d67253, 0xb0d82d931a592a79)+ 127 -> (0x11544581b7dec1dc, 0x8d79be0f4847552e)+ 128 -> (0x1bba08cf8c979c94, 0x158f967eda0bbb7c)+ 129 -> (0x162e6d72d6dfb076, 0x77a611ff14d62f97)+ 130 -> (0x11bebdf578b2f391, 0xf951a7ff43de8c79)+ 131 -> (0x1c6463225ab7ec1c, 0xc21c3ffed2fdad8e)+ 132 -> (0x16b6b5b5155ff017, 0x1b0333242648ad8)+ 133 -> (0x122bc490dde659ac, 0x159c28e9b83a246)+ 134 -> (0x1d12d41afca3c2ac, 0xcef604175f3903a3)+ 135 -> (0x17424348ca1c9bbd, 0x725e69ac4c2d9c83)+ 136 -> (0x129b69070816e2fd, 0xf5185489d68ae39c)+ 137 -> (0x1dc574d80cf16b2f, 0xee8d540fbdab05c6)+ 138 -> (0x17d12a4670c1228c, 0xbed77672fe226b05)+ 139 -> (0x130dbb6b8d674ed6, 0xff12c528cb4ebc04)+ 140 -> (0x1e7c5f127bd87e24, 0xcb513b74787df9a0)+ 141 -> (0x18637f41fcad31b7, 0x90dc929f9fe614d)+ 142 -> (0x1382cc34ca2427c5, 0xa0d7d42194cb810a)+ 143 -> (0x1f37ad21436d0c6f, 0x67bfb9cf5478ce77)+ 144 -> (0x18f9574dcf8a7059, 0x1fcc94a5dd2d71f9)+ 145 -> (0x13faac3e3fa1f37a, 0x7fd6dd517dbdf4c7)+ 146 -> (0x1ff779fd329cb8c3, 0xffbe2ee8c92fee0b)+ 147 -> (0x1992c7fdc216fa36, 0x6631bf20a0f324d6)+ 148 -> (0x14756ccb01abfb5e, 0xb827cc1a1a5c1d78)+ 149 -> (0x105df0a267bcc918, 0x935309ae7b7ce460)+ 150 -> (0x1a2fe76a3f9474f4, 0x1eeb42b0c594a099)+ 151 -> (0x14f31f8832dd2a5c, 0xe58902270476e6e1)+ 152 -> (0x10c27fa028b0eeb0, 0xb7a0ce859d2bebe7)+ 153 -> (0x1ad0cc33744e4ab4, 0x59014a6f61dfdfd8)+ 154 -> (0x1573d68f903ea229, 0xe0cdd525e7e64cad)+ 155 -> (0x11297872d9cbb4ee, 0x4d7177518651d6f1)+ 156 -> (0x1b758d848fac54b0, 0x7be8bee8d6e957e8)+ 157 -> (0x15f7a46a0c89dd59, 0xfcba3253df211320)+ 158 -> (0x1192e9ee706e4aae, 0x63c8284318e74280)+ 159 -> (0x1c1e43171a4a1117, 0x60d0d3827d86a66)+ 160 -> (0x167e9c127b6e7412, 0x6b3da42cecad21eb)+ 161 -> (0x11fee341fc585cdb, 0x88fe1cf0bd574e56)+ 162 -> (0x1ccb0536608d615f, 0x419694b462254a23)+ 163 -> (0x1708d0f84d3de77f, 0x67abaa29e81dd4e9)+ 164 -> (0x126d73f9d764b932, 0xb95621bb2017dd87)+ 165 -> (0x1d7becc2f23ac1ea, 0xc223692b668c95a5)+ 166 -> (0x179657025b6234bb, 0xce82ba891ed6de1d)+ 167 -> (0x12deac01e2b4f6fc, 0xa53562074bdf1818)+ 168 -> (0x1e3113363787f194, 0x3b889cd87964f359)+ 169 -> (0x18274291c6065adc, 0xfc6d4a46c783f5e1)+ 170 -> (0x13529ba7d19eaf17, 0x30576e9f06032b1a)+ 171 -> (0x1eea92a61c311825, 0x1a257dcb3cd1de90)+ 172 -> (0x18bba884e35a79b7, 0x481dfe3c30a7e540)+ 173 -> (0x13c9539d82aec7c5, 0xd34b31c9c0865100)+ 174 -> (0x1fa885c8d117a609, 0x5211e942cda3b4cd)+ 175 -> (0x19539e3a40dfb807, 0x74db21023e1c90a4)+ 176 -> (0x1442e4fb67196005, 0xf715b401cb4a0d50)+ 177 -> (0x103583fc527ab337, 0xf8de299b09080aa7)+ 178 -> (0x19ef3993b72ab859, 0x8e304291a80cddd7)+ 179 -> (0x14bf6142f8eef9e1, 0x3e8d020e200a4b13)+ 180 -> (0x10991a9bfa58c7e7, 0x653d9b3e80083c0f)+ 181 -> (0x1a8e90f9908e0ca5, 0x6ec8f864000d2ce4)+ 182 -> (0x153eda614071a3b7, 0x8bd3f9e999a423ea)+ 183 -> (0x10ff151a99f482f9, 0x3ca994bae1501cbb)+ 184 -> (0x1b31bb5dc320d18e, 0xc775bac49bb3612b)+ 185 -> (0x15c162b168e70e0b, 0xd2c4956a16291a89)+ 186 -> (0x11678227871f3e6f, 0xdbd0778811ba7ba1)+ 187 -> (0x1bd8d03f3e9863e6, 0x2c80bf401c5d929b)+ 188 -> (0x16470cff6546b651, 0xbd33cc3349e47549)+ 189 -> (0x11d270cc51055ea7, 0xca8fd68f6e505dd4)+ 190 -> (0x1c83e7ad4e6efdd9, 0x4419574be3b3c953)+ 191 -> (0x16cfec8aa52597e1, 0x347790982f63aa9)+ 192 -> (0x123ff06eea847980, 0xcf6c60d468c4fbba)+ 193 -> (0x1d331a4b10d3f59a, 0xe57a34870e07f92a)+ 194 -> (0x175c1508da432ae2, 0x512e906c0b399422)+ 195 -> (0x12b010d3e1cf5581, 0xda8ba6bcd5c7a9b5)+ 196 -> (0x1de6815302e5559c, 0x90df712e22d90f87)+ 197 -> (0x17eb9aa8cf1dde16, 0xda4c5a8b4f140c6c)+ 198 -> (0x1322e220a5b17e78, 0xaea37ba2a5a9a38a)+ 199 -> (0x1e9e369aa2b59727, 0x7dd25f6aa2a905a9)+ 200 -> (0x187e92154ef7ac1f, 0x97db7f888220d154)+ 201 -> (0x139874ddd8c6234c, 0x797c6606ce80a777)+ 202 -> (0x1f5a549627a36bad, 0x8f2d700ae4010bf1)+ 203 -> (0x191510781fb5efbe, 0xc2459a25000d65a)+ 204 -> (0x1410d9f9b2f7f2fe, 0x701d1481d99a4515)+ 205 -> (0x100d7b2e28c65bfe, 0xc017439b147b6a77)+ 206 -> (0x19af2b7d0e0a2cca, 0xccf205c4ed9243f2)+ 207 -> (0x148c22ca71a1bd6f, 0xa5b37d0be0e9cc2)+ 208 -> (0x10701bd527b4978c, 0x848f973cb3ee3ce)+ 209 -> (0x1a4cf9550c5425ac, 0xda0e5bec78649fb0)+ 210 -> (0x150a6110d6a9b7bd, 0x7b3eaff060507fc0)+ 211 -> (0x10d51a73deee2c97, 0x95cbbff380406633)+ 212 -> (0x1aee90b964b04758, 0xefac665266cd7052)+ 213 -> (0x158ba6fab6f36c47, 0x2623850eb8a459db)+ 214 -> (0x113c85955f29236c, 0x1e82d0d893b6ae49)+ 215 -> (0x1b9408eefea838ac, 0xfd9e1af41f8ab075)+ 216 -> (0x16100725988693bd, 0x97b1af29b2d559f7)+ 217 -> (0x11a66c1e139edc97, 0xac8e25baf5777b2c)+ 218 -> (0x1c3d79c9b8fe2dbf, 0x7a7d092b2258c513)+ 219 -> (0x169794a160cb57cc, 0x61fda0ef4ead6a76)+ 220 -> (0x1212dd4de7091309, 0xe7fe1a590bbdeec5)+ 221 -> (0x1ceafbafd80e84dc, 0xa6635d5b45fcb13a)+ 222 -> (0x172262f3133ed0b0, 0x851c4aaf6b308dc8)+ 223 -> (0x1281e8c275cbda26, 0xd0e36ef2bc26d7d4)+ 224 -> (0x1d9ca79d894629d7, 0xb49f17eac6a48c86)+ 225 -> (0x17b08617a104ee46, 0x2a18dfef0550706b)+ 226 -> (0x12f39e794d9d8b6b, 0x54e0b3259dd9f389)+ 227 -> (0x1e5297287c2f4578, 0x87cdeb6f62f65274)+ 228 -> (0x18421286c9bf6ac6, 0xd30b22bf825ea85d)+ 229 -> (0x13680ed23aff889f, 0xf3c1bcc684bb9e4)+ 230 -> (0x1f0ce4839198da98, 0x18602c7a4079296d)+ 231 -> (0x18d71d360e13e213, 0x46b356c833942124)+ 232 -> (0x13df4a91a4dcb4dc, 0x388f78a029434db6)+ 233 -> (0x1fcbaa82a1612160, 0x5a7f2766a86baf8a)+ 234 -> (0x196fbb9bb44db44d, 0x153285ebb9efbfa2)+ 235 -> (0x145962e2f6a4903d, 0xaa8ed189618c994e)+ 236 -> (0x1047824f2bb6d9ca, 0xeed8a7a11ad6e10c)+ 237 -> (0x1a0c03b1df8af611, 0x7e27729b5e249b45)+ 238 -> (0x14d6695b193bf80d, 0xfe85f549181d4904)+ 239 -> (0x10ab877c142ff9a4, 0xcb9e5dd4134aa0d0)+ 240 -> (0x1aac0bf9b9e65c3a, 0xdf63c9535211014d)+ 241 -> (0x15566ffafb1eb02f, 0x191ca10f74da6771)+ 242 -> (0x1111f32f2f4bc025, 0xadb080d92a4852c1)+ 243 -> (0x1b4feb7eb212cd09, 0x15e7348eaa0d5134)+ 244 -> (0x15d98932280f0a6d, 0xab1f5d3eee710dc4)+ 245 -> (0x117ad428200c0857, 0xbc1917658b8da49d)+ 246 -> (0x1bf7b9d9cce00d59, 0x2cf4f23c127c3a94)+ 247 -> (0x165fc7e170b33de0, 0xf0c3f4fcdb969543)+ 248 -> (0x11e6398126f5cb1a, 0x5a365d9716121103)+ 249 -> (0x1ca38f350b22de90, 0x9056fc24f01ce804)+ 250 -> (0x16e93f5da2824ba6, 0xd9df301d8ce3ecd0)+ 251 -> (0x125432b14ecea2eb, 0xe17f59b13d8323da)+ 252 -> (0x1d53844ee47dd179, 0x68cbc2b52f38395c)+ 253 -> (0x177603725064a794, 0x53d6355dbf602de3)+ 254 -> (0x12c4cf8ea6b6ec76, 0xa9782ab165e68b1c)+ 255 -> (0x1e07b27dd78b13f1, 0xf26aab56fd744fa)+ 256 -> (0x18062864ac6f4327, 0x3f52222abfdf6a62)+ 257 -> (0x1338205089f29c1f, 0x65db4e88997f884e)+ 258 -> (0x1ec033b40fea9365, 0x6fc54a7428cc0d4a)+ 259 -> (0x1899c2f673220f84, 0x596aa1f68709a43b)+ 260 -> (0x13ae3591f5b4d936, 0xadeee7f86c07b696)+ 261 -> (0x1f7d228322baf524, 0x497e3ff3e00c5756)+ 262 -> (0x1930e868e89590e9, 0xd464fff64cd6ac45)+ 263 -> (0x14272053ed4473ee, 0x4383fff83d7889d1)+ 264 -> (0x101f4d0ff1038ff1, 0xcf9cccc69793a174)+ 265 -> (0x19cbae7fe805b31c, 0x7f6147a425b90252)+ 266 -> (0x14a2f1ffecd15c16, 0xcc4dd2e9b7c7350f)+ 267 -> (0x10825b3323dab012, 0x3d0b0f215fd290d9)+ 268 -> (0x1a6a2b85062ab350, 0x61ab4b689950e7c1)+ 269 -> (0x1521bc6a6b555c40, 0x4e22a2ba1440b967)+ 270 -> (0x10e7c9eebc4449cd, 0xb4ee894dd009453)+ 271 -> (0x1b0c764ac6d3a948, 0x1217da87c800ed51)+ 272 -> (0x15a391d56bdc876c, 0xdb46486ca000bdda)+ 273 -> (0x114fa7ddefe39f8a, 0x490506bd4ccd64af)+ 274 -> (0x1bb2a62fe638ff43, 0xa8080ac87ae23ab1)+ 275 -> (0x162884f31e93ff69, 0x5339a239fbe82ef4)+ 276 -> (0x11ba03f5b20fff87, 0x75c7b4fb2fecf25d)+ 277 -> (0x1c5cd322b67fff3f, 0x22d92191e647ea2e)+ 278 -> (0x16b0a8e891ffff65, 0xb57a8141850654f2)+ 279 -> (0x1226ed86db3332b7, 0xc4620101373843f5)+ 280 -> (0x1d0b15a491eb8459, 0x3a366801f1f39fee)+ 281 -> (0x173c115074bc69e0, 0xfb5eb99b27f6198b)+ 282 -> (0x129674405d6387e7, 0x2f7efae2865e7ad6)+ 283 -> (0x1dbd86cd6238d971, 0xe597f7d0d6fd9156)+ 284 -> (0x17cad23de82d7ac1, 0x8479930d78cadaab)+ 285 -> (0x1308a831868ac89a, 0xd06142712d6f1556)+ 286 -> (0x1e74404f3daada91, 0x4d686a4eaf182222)+ 287 -> (0x185d003f6488aeda, 0xa453883ef279b4e8)+ 288 -> (0x137d99cc506d58ae, 0xe9dc6cff28615d87)+ 289 -> (0x1f2f5c7a1a488de4, 0xa960ae650d6895a4)+ 290 -> (0x18f2b061aea07183, 0xbab3beb73ded4483)+ _ -> (0x13f559e7bee6c136, 0x2ef6322c318a9d36)+#endif++-- | Index into the 128-bit word lookup table double_pow5_split+get_double_pow5_split :: Int -> (Word64, Word64)+#if !PURE_HASKELL+get_double_pow5_split = getWord128At double_pow5_split+#else+-- > putStr $ case128 (fnorm double_pow5_bitcount) [0..double_max_split]+get_double_pow5_split i = case i of+ 0 -> (0x1000000000000000, 0x0)+ 1 -> (0x1400000000000000, 0x0)+ 2 -> (0x1900000000000000, 0x0)+ 3 -> (0x1f40000000000000, 0x0)+ 4 -> (0x1388000000000000, 0x0)+ 5 -> (0x186a000000000000, 0x0)+ 6 -> (0x1e84800000000000, 0x0)+ 7 -> (0x1312d00000000000, 0x0)+ 8 -> (0x17d7840000000000, 0x0)+ 9 -> (0x1dcd650000000000, 0x0)+ 10 -> (0x12a05f2000000000, 0x0)+ 11 -> (0x174876e800000000, 0x0)+ 12 -> (0x1d1a94a200000000, 0x0)+ 13 -> (0x12309ce540000000, 0x0)+ 14 -> (0x16bcc41e90000000, 0x0)+ 15 -> (0x1c6bf52634000000, 0x0)+ 16 -> (0x11c37937e0800000, 0x0)+ 17 -> (0x16345785d8a00000, 0x0)+ 18 -> (0x1bc16d674ec80000, 0x0)+ 19 -> (0x1158e460913d0000, 0x0)+ 20 -> (0x15af1d78b58c4000, 0x0)+ 21 -> (0x1b1ae4d6e2ef5000, 0x0)+ 22 -> (0x10f0cf064dd59200, 0x0)+ 23 -> (0x152d02c7e14af680, 0x0)+ 24 -> (0x1a784379d99db420, 0x0)+ 25 -> (0x108b2a2c28029094, 0x0)+ 26 -> (0x14adf4b7320334b9, 0x0)+ 27 -> (0x19d971e4fe8401e7, 0x4000000000000000)+ 28 -> (0x1027e72f1f128130, 0x8800000000000000)+ 29 -> (0x1431e0fae6d7217c, 0xaa00000000000000)+ 30 -> (0x193e5939a08ce9db, 0xd480000000000000)+ 31 -> (0x1f8def8808b02452, 0xc9a0000000000000)+ 32 -> (0x13b8b5b5056e16b3, 0xbe04000000000000)+ 33 -> (0x18a6e32246c99c60, 0xad85000000000000)+ 34 -> (0x1ed09bead87c0378, 0xd8e6400000000000)+ 35 -> (0x13426172c74d822b, 0x878fe80000000000)+ 36 -> (0x1812f9cf7920e2b6, 0x6973e20000000000)+ 37 -> (0x1e17b84357691b64, 0x3d0da8000000000)+ 38 -> (0x12ced32a16a1b11e, 0x8262889000000000)+ 39 -> (0x178287f49c4a1d66, 0x22fb2ab400000000)+ 40 -> (0x1d6329f1c35ca4bf, 0xabb9f56100000000)+ 41 -> (0x125dfa371a19e6f7, 0xcb54395ca0000000)+ 42 -> (0x16f578c4e0a060b5, 0xbe2947b3c8000000)+ 43 -> (0x1cb2d6f618c878e3, 0x2db399a0ba000000)+ 44 -> (0x11efc659cf7d4b8d, 0xfc90400474400000)+ 45 -> (0x166bb7f0435c9e71, 0x7bb4500591500000)+ 46 -> (0x1c06a5ec5433c60d, 0xdaa16406f5a40000)+ 47 -> (0x118427b3b4a05bc8, 0xa8a4de8459868000)+ 48 -> (0x15e531a0a1c872ba, 0xd2ce16256fe82000)+ 49 -> (0x1b5e7e08ca3a8f69, 0x87819baecbe22800)+ 50 -> (0x111b0ec57e6499a1, 0xf4b1014d3f6d5900)+ 51 -> (0x1561d276ddfdc00a, 0x71dd41a08f48af40)+ 52 -> (0x1aba4714957d300d, 0xe549208b31adb10)+ 53 -> (0x10b46c6cdd6e3e08, 0x28f4db456ff0c8ea)+ 54 -> (0x14e1878814c9cd8a, 0x33321216cbecfb24)+ 55 -> (0x1a19e96a19fc40ec, 0xbffe969c7ee839ed)+ 56 -> (0x105031e2503da893, 0xf7ff1e21cf512434)+ 57 -> (0x14643e5ae44d12b8, 0xf5fee5aa43256d41)+ 58 -> (0x197d4df19d605767, 0x337e9f14d3eec892)+ 59 -> (0x1fdca16e04b86d41, 0x5e46da08ea7ab6)+ 60 -> (0x13e9e4e4c2f34448, 0xa03aec4845928cb2)+ 61 -> (0x18e45e1df3b0155a, 0xc849a75a56f72fde)+ 62 -> (0x1f1d75a5709c1ab1, 0x7a5c1130ecb4fbd6)+ 63 -> (0x13726987666190ae, 0xec798abe93f11d65)+ 64 -> (0x184f03e93ff9f4da, 0xa797ed6e38ed64bf)+ 65 -> (0x1e62c4e38ff87211, 0x517de8c9c728bdef)+ 66 -> (0x12fdbb0e39fb474a, 0xd2eeb17e1c7976b5)+ 67 -> (0x17bd29d1c87a191d, 0x87aa5ddda397d462)+ 68 -> (0x1dac74463a989f64, 0xe994f5550c7dc97b)+ 69 -> (0x128bc8abe49f639f, 0x11fd195527ce9ded)+ 70 -> (0x172ebad6ddc73c86, 0xd67c5faa71c24568)+ 71 -> (0x1cfa698c95390ba8, 0x8c1b77950e32d6c2)+ 72 -> (0x121c81f7dd43a749, 0x57912abd28dfc639)+ 73 -> (0x16a3a275d494911b, 0xad75756c7317b7c8)+ 74 -> (0x1c4c8b1349b9b562, 0x98d2d2c78fdda5ba)+ 75 -> (0x11afd6ec0e14115d, 0x9f83c3bcb9ea8794)+ 76 -> (0x161bcca7119915b5, 0x764b4abe8652979)+ 77 -> (0x1ba2bfd0d5ff5b22, 0x493de1d6e27e73d7)+ 78 -> (0x1145b7e285bf98f5, 0x6dc6ad264d8f0866)+ 79 -> (0x159725db272f7f32, 0xc938586fe0f2ca80)+ 80 -> (0x1afcef51f0fb5eff, 0x7b866e8bd92f7d20)+ 81 -> (0x10de1593369d1b5f, 0xad34051767bdae34)+ 82 -> (0x15159af804446237, 0x9881065d41ad19c1)+ 83 -> (0x1a5b01b605557ac5, 0x7ea147f492186032)+ 84 -> (0x1078e111c3556cbb, 0x6f24ccf8db4f3c1f)+ 85 -> (0x14971956342ac7ea, 0x4aee003712230b27)+ 86 -> (0x19bcdfabc13579e4, 0xdda98044d6abcdf0)+ 87 -> (0x10160bcb58c16c2f, 0xa89f02b062b60b6)+ 88 -> (0x141b8ebe2ef1c73a, 0xcd2c6c35c7b638e4)+ 89 -> (0x1922726dbaae3909, 0x8077874339a3c71d)+ 90 -> (0x1f6b0f092959c74b, 0xe0956914080cb8e4)+ 91 -> (0x13a2e965b9d81c8f, 0x6c5d61ac8507f38e)+ 92 -> (0x188ba3bf284e23b3, 0x4774ba17a649f072)+ 93 -> (0x1eae8caef261aca0, 0x1951e89d8fdc6c8f)+ 94 -> (0x132d17ed577d0be4, 0xfd3316279e9c3d9)+ 95 -> (0x17f85de8ad5c4edd, 0x13c7fdbb186434cf)+ 96 -> (0x1df67562d8b36294, 0x58b9fd29de7d4203)+ 97 -> (0x12ba095dc7701d9c, 0xb7743e3a2b0e4942)+ 98 -> (0x17688bb5394c2503, 0xe5514dc8b5d1db92)+ 99 -> (0x1d42aea2879f2e44, 0xdea5a13ae3465277)+ 100 -> (0x1249ad2594c37ceb, 0xb2784c4ce0bf38a)+ 101 -> (0x16dc186ef9f45c25, 0xcdf165f6018ef06d)+ 102 -> (0x1c931e8ab871732f, 0x416dbf7381f2ac88)+ 103 -> (0x11dbf316b346e7fd, 0x88e497a83137abd5)+ 104 -> (0x1652efdc6018a1fc, 0xeb1dbd923d8596ca)+ 105 -> (0x1be7abd3781eca7c, 0x25e52cf6cce6fc7d)+ 106 -> (0x1170cb642b133e8d, 0x97af3c1a40105dce)+ 107 -> (0x15ccfe3d35d80e30, 0xfd9b0b20d0147542)+ 108 -> (0x1b403dcc834e11bd, 0x3d01cde904199292)+ 109 -> (0x1108269fd210cb16, 0x462120b1a28ffb9b)+ 110 -> (0x154a3047c694fddb, 0xd7a968de0b33fa82)+ 111 -> (0x1a9cbc59b83a3d52, 0xcd93c3158e00f923)+ 112 -> (0x10a1f5b813246653, 0xc07c59ed78c09bb6)+ 113 -> (0x14ca732617ed7fe8, 0xb09b7068d6f0c2a3)+ 114 -> (0x19fd0fef9de8dfe2, 0xdcc24c830cacf34c)+ 115 -> (0x103e29f5c2b18bed, 0xc9f96fd1e7ec180f)+ 116 -> (0x144db473335deee9, 0x3c77cbc661e71e13)+ 117 -> (0x1961219000356aa3, 0x8b95beb7fa60e598)+ 118 -> (0x1fb969f40042c54c, 0x6e7b2e65f8f91efe)+ 119 -> (0x13d3e2388029bb4f, 0xc50cfcffbb9bb35f)+ 120 -> (0x18c8dac6a0342a23, 0xb6503c3faa82a037)+ 121 -> (0x1efb1178484134ac, 0xa3e44b4f95234844)+ 122 -> (0x135ceaeb2d28c0eb, 0xe66eaf11bd360d2b)+ 123 -> (0x183425a5f872f126, 0xe00a5ad62c839075)+ 124 -> (0x1e412f0f768fad70, 0x980cf18bb7a47493)+ 125 -> (0x12e8bd69aa19cc66, 0x5f0816f752c6c8dc)+ 126 -> (0x17a2ecc414a03f7f, 0xf6ca1cb527787b13)+ 127 -> (0x1d8ba7f519c84f5f, 0xf47ca3e2715699d7)+ 128 -> (0x127748f9301d319b, 0xf8cde66d86d62026)+ 129 -> (0x17151b377c247e02, 0xf7016008e88ba830)+ 130 -> (0x1cda62055b2d9d83, 0xb4c1b80b22ae923c)+ 131 -> (0x12087d4358fc8272, 0x50f91306f5ad1b65)+ 132 -> (0x168a9c942f3ba30e, 0xe53757c8b318623f)+ 133 -> (0x1c2d43b93b0a8bd2, 0x9e852dbadfde7acf)+ 134 -> (0x119c4a53c4e69763, 0xa3133c94cbeb0cc1)+ 135 -> (0x16035ce8b6203d3c, 0x8bd80bb9fee5cff1)+ 136 -> (0x1b843422e3a84c8b, 0xaece0ea87e9f43ee)+ 137 -> (0x1132a095ce492fd7, 0x4d40c9294f238a75)+ 138 -> (0x157f48bb41db7bcd, 0x2090fb73a2ec6d12)+ 139 -> (0x1adf1aea12525ac0, 0x68b53a508ba78856)+ 140 -> (0x10cb70d24b7378b8, 0x417144725748b536)+ 141 -> (0x14fe4d06de5056e6, 0x51cd958eed1ae283)+ 142 -> (0x1a3de04895e46c9f, 0xe640faf2a8619b24)+ 143 -> (0x1066ac2d5daec3e3, 0xefe89cd7a93d00f7)+ 144 -> (0x14805738b51a74dc, 0xebe2c40d938c4134)+ 145 -> (0x19a06d06e2611214, 0x26db7510f86f5181)+ 146 -> (0x100444244d7cab4c, 0x9849292a9b4592f1)+ 147 -> (0x1405552d60dbd61f, 0xbe5b73754216f7ad)+ 148 -> (0x1906aa78b912cba7, 0xadf25052929cb598)+ 149 -> (0x1f485516e7577e91, 0x996ee4673743e2ff)+ 150 -> (0x138d352e5096af1a, 0xffe54ec0828a6ddf)+ 151 -> (0x18708279e4bc5ae1, 0xbfdea270a32d0957)+ 152 -> (0x1e8ca3185deb719a, 0x2fd64b0ccbf84bad)+ 153 -> (0x1317e5ef3ab32700, 0x5de5eee7ff7b2f4c)+ 154 -> (0x17dddf6b095ff0c0, 0x755f6aa1ff59fb1f)+ 155 -> (0x1dd55745cbb7ecf0, 0x92b7454a7f3079e7)+ 156 -> (0x12a5568b9f52f416, 0x5bb28b4e8f7e4c30)+ 157 -> (0x174eac2e8727b11b, 0xf29f2e22335ddf3c)+ 158 -> (0x1d22573a28f19d62, 0xef46f9aac035570b)+ 159 -> (0x123576845997025d, 0xd58c5c0ab8215667)+ 160 -> (0x16c2d4256ffcc2f5, 0x4aef730d6629ac01)+ 161 -> (0x1c73892ecbfbf3b2, 0x9dab4fd0bfb41701)+ 162 -> (0x11c835bd3f7d784f, 0xa28b11e277d08e60)+ 163 -> (0x163a432c8f5cd663, 0x8b2dd65b15c4b1f9)+ 164 -> (0x1bc8d3f7b3340bfc, 0x6df94bf1db35de77)+ 165 -> (0x115d847ad000877d, 0xc4bbcf772901ab0a)+ 166 -> (0x15b4e5998400a95d, 0x35eac354f34215cd)+ 167 -> (0x1b221effe500d3b4, 0x8365742a30129b40)+ 168 -> (0x10f5535fef208450, 0xd21f689a5e0ba108)+ 169 -> (0x1532a837eae8a565, 0x6a742c0f58e894a)+ 170 -> (0x1a7f5245e5a2cebe, 0x4851137132f22b9d)+ 171 -> (0x108f936baf85c136, 0xed32ac26bfd75b42)+ 172 -> (0x14b378469b673184, 0xa87f57306fcd3212)+ 173 -> (0x19e056584240fde5, 0xd29f2cfc8bc07e97)+ 174 -> (0x102c35f729689eaf, 0xa3a37c1dd7584f1e)+ 175 -> (0x14374374f3c2c65b, 0x8c8c5b254d2e62e6)+ 176 -> (0x1945145230b377f2, 0x6faf71eea079fb9f)+ 177 -> (0x1f965966bce055ef, 0xb9b4e6a48987a87)+ 178 -> (0x13bdf7e0360c35b5, 0x674111026d5f4c94)+ 179 -> (0x18ad75d8438f4322, 0xc111554308b71fba)+ 180 -> (0x1ed8d34e547313eb, 0x7155aa93cae4e7a8)+ 181 -> (0x13478410f4c7ec73, 0x26d58a9c5ecf10c9)+ 182 -> (0x1819651531f9e78f, 0xf08aed437682d4fb)+ 183 -> (0x1e1fbe5a7e786173, 0xecada89454238a3a)+ 184 -> (0x12d3d6f88f0b3ce8, 0x73ec895cb4963664)+ 185 -> (0x1788ccb6b2ce0c22, 0x90e7abb3e1bbc3fd)+ 186 -> (0x1d6affe45f818f2b, 0x352196a0da2ab4fd)+ 187 -> (0x1262dfeebbb0f97b, 0x134fe24885ab11e)+ 188 -> (0x16fb97ea6a9d37d9, 0xc1823dadaa715d65)+ 189 -> (0x1cba7de5054485d0, 0x31e2cd19150db4bf)+ 190 -> (0x11f48eaf234ad3a2, 0x1f2dc02fad2890f7)+ 191 -> (0x1671b25aec1d888a, 0xa6f9303b9872b535)+ 192 -> (0x1c0e1ef1a724eaad, 0x50b77c4a7e8f6282)+ 193 -> (0x1188d357087712ac, 0x5272adae8f199d91)+ 194 -> (0x15eb082cca94d757, 0x670f591a32e004f6)+ 195 -> (0x1b65ca37fd3a0d2d, 0x40d32f60bf980633)+ 196 -> (0x111f9e62fe44483c, 0x4883fd9c77bf03e0)+ 197 -> (0x156785fbbdd55a4b, 0x5aa4fd0395aec4d8)+ 198 -> (0x1ac1677aad4ab0de, 0x314e3c447b1a760e)+ 199 -> (0x10b8e0acac4eae8a, 0xded0e5aaccf089c9)+ 200 -> (0x14e718d7d7625a2d, 0x96851f15802cac3b)+ 201 -> (0x1a20df0dcd3af0b8, 0xfc2666dae037d74a)+ 202 -> (0x10548b68a044d673, 0x9d980048cc22e68e)+ 203 -> (0x1469ae42c8560c10, 0x84fe005aff2ba032)+ 204 -> (0x198419d37a6b8f14, 0xa63d8071bef6883e)+ 205 -> (0x1fe52048590672d9, 0xcfcce08e2eb42a4e)+ 206 -> (0x13ef342d37a407c8, 0x21e00c58dd309a70)+ 207 -> (0x18eb0138858d09ba, 0x2a580f6f147cc10d)+ 208 -> (0x1f25c186a6f04c28, 0xb4ee134ad99bf150)+ 209 -> (0x137798f428562f99, 0x7114cc0ec80176d2)+ 210 -> (0x18557f31326bbb7f, 0xcd59ff127a01d486)+ 211 -> (0x1e6adefd7f06aa5f, 0xc0b07ed7188249a8)+ 212 -> (0x1302cb5e6f642a7b, 0xd86e4f466f516e09)+ 213 -> (0x17c37e360b3d351a, 0xce89e3180b25c98b)+ 214 -> (0x1db45dc38e0c8261, 0x822c5bde0def3bee)+ 215 -> (0x1290ba9a38c7d17c, 0xf15bb96ac8b58575)+ 216 -> (0x1734e940c6f9c5dc, 0x2db2a7c57ae2e6d2)+ 217 -> (0x1d022390f8b83753, 0x391f51b6d99ba086)+ 218 -> (0x1221563a9b732294, 0x3b3931248014454)+ 219 -> (0x16a9abc9424feb39, 0x4a077d6da019569)+ 220 -> (0x1c5416bb92e3e607, 0x45c895cc9081fac3)+ 221 -> (0x11b48e353bce6fc4, 0x8b9d5d9fda513cba)+ 222 -> (0x1621b1c28ac20bb5, 0xae84b507d0e58be8)+ 223 -> (0x1baa1e332d728ea3, 0x1a25e249c51eeee3)+ 224 -> (0x114a52dffc679925, 0xf057ad6e1b33554d)+ 225 -> (0x159ce797fb817f6f, 0x6c6d98c9a2002aa1)+ 226 -> (0x1b04217dfa61df4b, 0x4788fefc0a803549)+ 227 -> (0x10e294eebc7d2b8f, 0xcb59f5d8690214e)+ 228 -> (0x151b3a2a6b9c7672, 0xcfe30734e83429a1)+ 229 -> (0x1a6208b50683940f, 0x83dbc9022241340a)+ 230 -> (0x107d457124123c89, 0xb2695da15568c086)+ 231 -> (0x149c96cd6d16cbac, 0x1f03b509aac2f0a7)+ 232 -> (0x19c3bc80c85c7e97, 0x26c4a24c1573acd1)+ 233 -> (0x101a55d07d39cf1e, 0x783ae56f8d684c03)+ 234 -> (0x1420eb449c8842e6, 0x16499ecb70c25f03)+ 235 -> (0x19292615c3aa539f, 0x9bdc067e4cf2f6c4)+ 236 -> (0x1f736f9b3494e887, 0x82d3081de02fb476)+ 237 -> (0x13a825c100dd1154, 0xb1c3e512ac1dd0c9)+ 238 -> (0x18922f31411455a9, 0xde34de57572544fc)+ 239 -> (0x1eb6bafd91596b14, 0x55c215ed2cee963b)+ 240 -> (0x133234de7ad7e2ec, 0xb5994db43c151de5)+ 241 -> (0x17fec216198ddba7, 0xe2ffa1214b1a655e)+ 242 -> (0x1dfe729b9ff15291, 0xdbbf89699de0feb6)+ 243 -> (0x12bf07a143f6d39b, 0x2957b5e202ac9f31)+ 244 -> (0x176ec98994f48881, 0xf3ada35a8357c6fe)+ 245 -> (0x1d4a7bebfa31aaa2, 0x70990c31242db8bd)+ 246 -> (0x124e8d737c5f0aa5, 0x865fa79eb69c9376)+ 247 -> (0x16e230d05b76cd4e, 0xe7f791866443b854)+ 248 -> (0x1c9abd04725480a2, 0xa1f575e7fd54a669)+ 249 -> (0x11e0b622c774d065, 0xa53969b0fe54e801)+ 250 -> (0x1658e3ab7952047f, 0xe87c41d3dea2202)+ 251 -> (0x1bef1c9657a6859e, 0xd229b5248d64aa82)+ 252 -> (0x117571ddf6c81383, 0x435a1136d85eea91)+ 253 -> (0x15d2ce55747a1864, 0x143095848e76a536)+ 254 -> (0x1b4781ead1989e7d, 0x193cbae5b2144e83)+ 255 -> (0x110cb132c2ff630e, 0x2fc5f4cf8f4cb112)+ 256 -> (0x154fdd7f73bf3bd1, 0xbbb77203731fdd56)+ 257 -> (0x1aa3d4df50af0ac6, 0x2aa54e844fe7d4ac)+ 258 -> (0x10a6650b926d66bb, 0xdaa75112b1f0e4eb)+ 259 -> (0x14cffe4e7708c06a, 0xd15125575e6d1e26)+ 260 -> (0x1a03fde214caf085, 0x85a56ead360865b0)+ 261 -> (0x10427ead4cfed653, 0x7387652c41c53f8e)+ 262 -> (0x14531e58a03e8be8, 0x50693e7752368f71)+ 263 -> (0x1967e5eec84e2ee2, 0x64838e1526c4334e)+ 264 -> (0x1fc1df6a7a61ba9a, 0xfda4719a70754022)+ 265 -> (0x13d92ba28c7d14a0, 0xde86c70086494815)+ 266 -> (0x18cf768b2f9c59c9, 0x162878c0a7db9a1a)+ 267 -> (0x1f03542dfb83703b, 0x5bb296f0d1d280a1)+ 268 -> (0x1362149cbd322625, 0x194f9e5683239064)+ 269 -> (0x183a99c3ec7eafae, 0x5fa385ec23ec747e)+ 270 -> (0x1e494034e79e5b99, 0xf78c67672ce7919d)+ 271 -> (0x12edc82110c2f940, 0x3ab7c0a07c10bb02)+ 272 -> (0x17a93a2954f3b790, 0x4965b0c89b14e9c3)+ 273 -> (0x1d9388b3aa30a574, 0x5bbf1cfac1da2433)+ 274 -> (0x127c35704a5e6768, 0xb957721cb92856a0)+ 275 -> (0x171b42cc5cf60142, 0xe7ad4ea3e7726c48)+ 276 -> (0x1ce2137f74338193, 0xa198a24ce14f075a)+ 277 -> (0x120d4c2fa8a030fc, 0x44ff65700cd16498)+ 278 -> (0x16909f3b92c83d3b, 0x563f3ecc1005bdbe)+ 279 -> (0x1c34c70a777a4c8a, 0x2bcf0e7f14072d2e)+ 280 -> (0x11a0fc668aac6fd6, 0x5b61690f6c847c3d)+ 281 -> (0x16093b802d578bcb, 0xf239c35347a59b4c)+ 282 -> (0x1b8b8a6038ad6ebe, 0xeec83428198f021f)+ 283 -> (0x1137367c236c6537, 0x553d20990ff96153)+ 284 -> (0x1585041b2c477e85, 0x2a8c68bf53f7b9a8)+ 285 -> (0x1ae64521f7595e26, 0x752f82ef28f5a812)+ 286 -> (0x10cfeb353a97dad8, 0x93db1d57999890b)+ 287 -> (0x1503e602893dd18e, 0xb8d1e4ad7ffeb4e)+ 288 -> (0x1a44df832b8d45f1, 0x8e7065dd8dffe622)+ 289 -> (0x106b0bb1fb384bb6, 0xf9063faa78bfefd5)+ 290 -> (0x1485ce9e7a065ea4, 0xb747cf9516efebca)+ 291 -> (0x19a742461887f64d, 0xe519c37a5cabe6bd)+ 292 -> (0x1008896bcf54f9f0, 0xaf301a2c79eb7036)+ 293 -> (0x140aabc6c32a386c, 0xdafc20b798664c43)+ 294 -> (0x190d56b873f4c688, 0x11bb28e57e7fdf54)+ 295 -> (0x1f50ac6690f1f82a, 0x1629f31ede1fd72a)+ 296 -> (0x13926bc01a973b1a, 0x4dda37f34ad3e67a)+ 297 -> (0x187706b0213d09e0, 0xe150c5f01d88e019)+ 298 -> (0x1e94c85c298c4c59, 0x19a4f76c24eb181f)+ 299 -> (0x131cfd3999f7afb7, 0xb0071aa39712ef13)+ 300 -> (0x17e43c8800759ba5, 0x9c08e14c7cd7aad8)+ 301 -> (0x1ddd4baa0093028f, 0x30b199f9c0d958e)+ 302 -> (0x12aa4f4a405be199, 0x61e6f003c1887d79)+ 303 -> (0x1754e31cd072d9ff, 0xba60ac04b1ea9cd7)+ 304 -> (0x1d2a1be4048f907f, 0xa8f8d705de65440d)+ 305 -> (0x123a516e82d9ba4f, 0xc99b8663aaff4a88)+ 306 -> (0x16c8e5ca239028e3, 0xbc0267fc95bf1d2a)+ 307 -> (0x1c7b1f3cac74331c, 0xab0301fbbb2ee474)+ 308 -> (0x11ccf385ebc89ff1, 0xeae1e13d54fd4ec9)+ 309 -> (0x1640306766bac7ee, 0x659a598caa3ca27b)+ 310 -> (0x1bd03c81406979e9, 0xff00efefd4cbcb1a)+ 311 -> (0x116225d0c841ec32, 0x3f6095f5e4ff5ef0)+ 312 -> (0x15baaf44fa52673e, 0xcf38bb735e3f36ac)+ 313 -> (0x1b295b1638e7010e, 0x8306ea5035cf0457)+ 314 -> (0x10f9d8ede39060a9, 0x11e4527221a162b6)+ 315 -> (0x15384f295c7478d3, 0x565d670eaa09bb64)+ 316 -> (0x1a8662f3b3919708, 0x2bf4c0d2548c2a3d)+ 317 -> (0x1093fdd8503afe65, 0x1b78f88374d79a66)+ 318 -> (0x14b8fd4e6449bdfe, 0x625736a4520d8100)+ 319 -> (0x19e73ca1fd5c2d7d, 0xfaed044d6690e140)+ 320 -> (0x103085e53e599c6e, 0xbcd422b0601a8cc8)+ 321 -> (0x143ca75e8df0038a, 0x6c092b5c78212ffa)+ 322 -> (0x194bd136316c046d, 0x70b763396297bf8)+ 323 -> (0x1f9ec583bdc70588, 0x48ce53c07bb3daf6)+ 324 -> (0x13c33b72569c6375, 0x2d80f4584d5068da)+ _ -> (0x18b40a4eec437c52, 0x78e1316e60a48310)+#endif -- | Take the high bits of m * 5^-e2-q / 2^k / 2^q-k mulPow5DivPow2 :: Word64 -> Int -> Int -> Word64
Data/ByteString/Builder/RealFloat/F2S.hs view
@@ -1,5 +1,5 @@-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE BangPatterns, MagicHash #-}+{-# LANGUAGE CPP #-}+ -- | -- Module : Data.ByteString.Builder.RealFloat.F2S -- Copyright : (c) Lawrence Wu 2021@@ -22,64 +22,26 @@ import GHC.Int (Int32(..)) import GHC.Word (Word32(..), Word64(..)) +#if !PURE_HASKELL+import GHC.Ptr (Ptr(..))+#endif+ -- See Data.ByteString.Builder.RealFloat.TableGenerator for a high-level -- explanation of the ryu algorithm +#if !PURE_HASKELL -- | Table of 2^k / 5^q + 1--- Byte-swapped version of--- > fmap (finv float_pow5_inv_bitcount) [0..float_max_inv_split] ----- Displayed here as 2 Word64 table values per line-float_pow5_inv_split :: Addr-float_pow5_inv_split = Addr- "\x01\x00\x00\x00\x00\x00\x00\x08\x67\x66\x66\x66\x66\x66\x66\x06\- \\xb9\x1e\x85\xeb\x51\xb8\x1e\x05\xfa\x7e\x6a\xbc\x74\x93\x18\x04\- \\x2a\xcb\x10\xc7\xba\xb8\x8d\x06\x22\x3c\xda\x38\x62\x2d\x3e\x05\- \\x4e\x63\x7b\x2d\xe8\xbd\x31\x04\x16\xd2\x2b\xaf\xa6\xfc\xb5\x06\- \\x78\x0e\x23\x8c\xb8\x63\x5e\x05\x2d\xa5\xb5\x09\xfa\x82\x4b\x04\- \\xae\x6e\xef\x75\xf6\x37\xdf\x06\x58\x25\x59\x5e\xf8\x5f\x7f\x05\- \\x47\x84\x7a\x4b\x60\xe6\x65\x04\x71\xa0\x5d\x12\x9a\x70\x09\x07\- \\xc1\xe6\x4a\xa8\xe1\x26\xa1\x05\x67\x85\xd5\xb9\xe7\xeb\x80\x04\- \\x0b\x6f\x22\xf6\xa5\xac\x34\x07\xa3\x25\xb5\x91\x51\xbd\xc3\x05\- \\xe9\xea\x90\x74\x74\x97\x9c\x04\x0e\xab\xb4\xed\x53\xf2\x60\x07\- \\xd8\x88\x90\x24\x43\x28\xe7\x05\xe0\xd3\xa6\x83\x02\xed\xb8\x04\- \\x66\xb9\xd7\x05\x04\x48\x8e\x07\x52\x94\xac\x04\xd0\x6c\x0b\x06\- \\xdb\xa9\x23\x6a\xa6\xf0\xd5\x04\x2b\x76\x9f\x76\x3d\xb4\xbc\x07\- \\xef\xc4\xb2\x2b\x31\x90\x30\x06\xf3\x03\x8f\xbc\x8d\xa6\xf3\x04\- \\x51\x06\x18\x94\xaf\x3d\xec\x07\xda\xd1\xac\xa9\xbf\x97\x56\x06\- \\xe2\xa7\xf0\xba\xff\x12\x12\x05"#+-- > fmap (finv float_pow5_inv_bitcount) [0..float_max_inv_split]+foreign import ccall "&hs_bytestring_float_pow5_inv_split"+ float_pow5_inv_split :: Ptr Word64 -- | Table of 5^(-e2-q) / 2^k + 1--- Byte-swapped version of--- > fmap (fnorm float_pow5_bitcount) [0..float_max_split] ----- Displayed here as 2 Word64 table values per line-float_pow5_split :: Addr-float_pow5_split = Addr- "\x00\x00\x00\x00\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x14\- \\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\x00\x00\x00\x40\x1f\- \\x00\x00\x00\x00\x00\x00\x88\x13\x00\x00\x00\x00\x00\x00\x6a\x18\- \\x00\x00\x00\x00\x00\x80\x84\x1e\x00\x00\x00\x00\x00\xd0\x12\x13\- \\x00\x00\x00\x00\x00\x84\xd7\x17\x00\x00\x00\x00\x00\x65\xcd\x1d\- \\x00\x00\x00\x00\x20\x5f\xa0\x12\x00\x00\x00\x00\xe8\x76\x48\x17\- \\x00\x00\x00\x00\xa2\x94\x1a\x1d\x00\x00\x00\x40\xe5\x9c\x30\x12\- \\x00\x00\x00\x90\x1e\xc4\xbc\x16\x00\x00\x00\x34\x26\xf5\x6b\x1c\- \\x00\x00\x80\xe0\x37\x79\xc3\x11\x00\x00\xa0\xd8\x85\x57\x34\x16\- \\x00\x00\xc8\x4e\x67\x6d\xc1\x1b\x00\x00\x3d\x91\x60\xe4\x58\x11\- \\x00\x40\x8c\xb5\x78\x1d\xaf\x15\x00\x50\xef\xe2\xd6\xe4\x1a\x1b\- \\x00\x92\xd5\x4d\x06\xcf\xf0\x10\x80\xf6\x4a\xe1\xc7\x02\x2d\x15\- \\x20\xb4\x9d\xd9\x79\x43\x78\x1a\x94\x90\x02\x28\x2c\x2a\x8b\x10\- \\xb9\x34\x03\x32\xb7\xf4\xad\x14\xe7\x01\x84\xfe\xe4\x71\xd9\x19\- \\x30\x81\x12\x1f\x2f\xe7\x27\x10\x7c\x21\xd7\xe6\xfa\xe0\x31\x14\- \\xdb\xe9\x8c\xa0\x39\x59\x3e\x19\x52\x24\xb0\x08\x88\xef\x8d\x1f\- \\xb3\x16\x6e\x05\xb5\xb5\xb8\x13\x60\x9c\xc9\x46\x22\xe3\xa6\x18\- \\x78\x03\x7c\xd8\xea\x9b\xd0\x1e\x2b\x82\x4d\xc7\x72\x61\x42\x13\- \\xb6\xe2\x20\x79\xcf\xf9\x12\x18\x64\x1b\x69\x57\x43\xb8\x17\x1e\- \\x1e\xb1\xa1\x16\x2a\xd3\xce\x12\x66\x1d\x4a\x9c\xf4\x87\x82\x17\- \\xbf\xa4\x5c\xc3\xf1\x29\x63\x1d\xf7\xe6\x19\x1a\x37\xfa\x5d\x12\- \\xb5\x60\xa0\xe0\xc4\x78\xf5\x16\xe3\x78\xc8\x18\xf6\xd6\xb2\x1c\- \\x8d\x4b\x7d\xcf\x59\xc6\xef\x11\x71\x9e\x5c\x43\xf0\xb7\x6b\x16\- \\x0d\xc6\x33\x54\xec\xa5\x06\x1c"#+-- > fmap (fnorm float_pow5_bitcount) [0..float_max_split]+foreign import ccall "&hs_bytestring_float_pow5_split"+ float_pow5_split :: Ptr Word64+#endif -- | Number of mantissa bits of a 32-bit float. The number of significant bits -- (floatDigits (undefined :: Float)) is 24 since we have a leading 1 for@@ -113,15 +75,99 @@ -- | Index into the 64-bit word lookup table float_pow5_inv_split get_float_pow5_inv_split :: Int -> Word64-get_float_pow5_inv_split =- let !(Addr arr) = float_pow5_inv_split- in getWord64At arr+#if !PURE_HASKELL+get_float_pow5_inv_split = getWord64At float_pow5_inv_split+#else+-- > putStr $ case64 (finv float_pow5_inv_bitcount) [0..float_max_inv_split]+get_float_pow5_inv_split i = case i of+ 0 -> 0x800000000000001+ 1 -> 0x666666666666667+ 2 -> 0x51eb851eb851eb9+ 3 -> 0x4189374bc6a7efa+ 4 -> 0x68db8bac710cb2a+ 5 -> 0x53e2d6238da3c22+ 6 -> 0x431bde82d7b634e+ 7 -> 0x6b5fca6af2bd216+ 8 -> 0x55e63b88c230e78+ 9 -> 0x44b82fa09b5a52d+ 10 -> 0x6df37f675ef6eae+ 11 -> 0x57f5ff85e592558+ 12 -> 0x465e6604b7a8447+ 13 -> 0x709709a125da071+ 14 -> 0x5a126e1a84ae6c1+ 15 -> 0x480ebe7b9d58567+ 16 -> 0x734aca5f6226f0b+ 17 -> 0x5c3bd5191b525a3+ 18 -> 0x49c97747490eae9+ 19 -> 0x760f253edb4ab0e+ 20 -> 0x5e72843249088d8+ 21 -> 0x4b8ed0283a6d3e0+ 22 -> 0x78e480405d7b966+ 23 -> 0x60b6cd004ac9452+ 24 -> 0x4d5f0a66a23a9db+ 25 -> 0x7bcb43d769f762b+ 26 -> 0x63090312bb2c4ef+ 27 -> 0x4f3a68dbc8f03f3+ 28 -> 0x7ec3daf94180651+ 29 -> 0x65697bfa9acd1da+ _ -> 0x51212ffbaf0a7e2+#endif -- | Index into the 64-bit word lookup table float_pow5_split get_float_pow5_split :: Int -> Word64-get_float_pow5_split =- let !(Addr arr) = float_pow5_split- in getWord64At arr+#if !PURE_HASKELL+get_float_pow5_split = getWord64At float_pow5_split+#else+-- > putStr $ case64 (fnorm float_pow5_bitcount) [0..float_max_split]+get_float_pow5_split i = case i of+ 0 -> 0x1000000000000000+ 1 -> 0x1400000000000000+ 2 -> 0x1900000000000000+ 3 -> 0x1f40000000000000+ 4 -> 0x1388000000000000+ 5 -> 0x186a000000000000+ 6 -> 0x1e84800000000000+ 7 -> 0x1312d00000000000+ 8 -> 0x17d7840000000000+ 9 -> 0x1dcd650000000000+ 10 -> 0x12a05f2000000000+ 11 -> 0x174876e800000000+ 12 -> 0x1d1a94a200000000+ 13 -> 0x12309ce540000000+ 14 -> 0x16bcc41e90000000+ 15 -> 0x1c6bf52634000000+ 16 -> 0x11c37937e0800000+ 17 -> 0x16345785d8a00000+ 18 -> 0x1bc16d674ec80000+ 19 -> 0x1158e460913d0000+ 20 -> 0x15af1d78b58c4000+ 21 -> 0x1b1ae4d6e2ef5000+ 22 -> 0x10f0cf064dd59200+ 23 -> 0x152d02c7e14af680+ 24 -> 0x1a784379d99db420+ 25 -> 0x108b2a2c28029094+ 26 -> 0x14adf4b7320334b9+ 27 -> 0x19d971e4fe8401e7+ 28 -> 0x1027e72f1f128130+ 29 -> 0x1431e0fae6d7217c+ 30 -> 0x193e5939a08ce9db+ 31 -> 0x1f8def8808b02452+ 32 -> 0x13b8b5b5056e16b3+ 33 -> 0x18a6e32246c99c60+ 34 -> 0x1ed09bead87c0378+ 35 -> 0x13426172c74d822b+ 36 -> 0x1812f9cf7920e2b6+ 37 -> 0x1e17b84357691b64+ 38 -> 0x12ced32a16a1b11e+ 39 -> 0x178287f49c4a1d66+ 40 -> 0x1d6329f1c35ca4bf+ 41 -> 0x125dfa371a19e6f7+ 42 -> 0x16f578c4e0a060b5+ 43 -> 0x1cb2d6f618c878e3+ 44 -> 0x11efc659cf7d4b8d+ 45 -> 0x166bb7f0435c9e71+ _ -> 0x1c06a5ec5433c60d+#endif -- | Take the high bits of m * 2^k / 5^q / 2^-e2+q+k mulPow5InvDivPow2 :: Word32 -> Int -> Int -> Word32
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@@ -50,8 +50,6 @@ , dquot100 -- prim-op helpers , timesWord2- , Addr(..)- , ByteArray(..) , castDoubleToWord64 , castFloatToWord32 , getWord64At@@ -74,50 +72,31 @@ import Data.ByteString.Internal (c2w) import Data.ByteString.Builder.Prim.Internal (BoundedPrim, boundedPrim) import Data.ByteString.Builder.RealFloat.TableGenerator+import Data.ByteString.Utils.ByteOrder+import Data.ByteString.Utils.UnalignedAccess+#if PURE_HASKELL+import qualified Data.ByteString.Internal.Pure as Pure+#else+import Foreign.C.Types+#endif import Data.Char (ord) import GHC.Int (Int(..), Int32(..))+import GHC.IO (IO(..), unIO) import GHC.Prim-import GHC.Ptr (Ptr(..), plusPtr)-import GHC.ST (ST(..), runST)+import GHC.Ptr (Ptr(..), plusPtr, castPtr) import GHC.Types (isTrue#)-import GHC.Word (Word8, Word32(..), Word64(..))+import GHC.Word (Word8, Word16(..), Word32(..), Word64(..)) import qualified Foreign.Storable as S (poke) #include <ghcautoconf.h> #include "MachDeps.h" -#if WORD_SIZE_IN_BITS < 64 && __GLASGOW_HASKELL__ < 903+#if WORD_SIZE_IN_BITS < 64 && !MIN_VERSION_ghc_prim(0,8,0) import GHC.IntWord64 #endif -#if __GLASGOW_HASKELL__ >= 804-import GHC.Float (castFloatToWord32, castDoubleToWord64)-#else-import System.IO.Unsafe (unsafePerformIO)-import Foreign.Marshal.Utils (with)-import Foreign.Ptr (castPtr)-import Foreign.Storable (peek)---- | Interpret a 'Float' as a 'Word32' as if through a bit-for-bit copy.--- (fallback if not available through GHC.Float)------ e.g------ > showHex (castFloatToWord32 1.0) [] = "3f800000"-{-# NOINLINE castFloatToWord32 #-}-castFloatToWord32 :: Float -> Word32-castFloatToWord32 x = unsafePerformIO (with x (peek . castPtr))---- | Interpret a 'Double' as a 'Word64' as if through a bit-for-bit copy.--- (fallback if not available through GHC.Float)------ e.g------ > showHex (castDoubleToWord64 1.0) [] = "3ff0000000000000"-{-# NOINLINE castDoubleToWord64 #-}-castDoubleToWord64 :: Double -> Word64-castDoubleToWord64 x = unsafePerformIO (with x (peek . castPtr))-#endif+import Data.ByteString.Builder.Prim.Internal.Floating+ (castFloatToWord32, castDoubleToWord64) -- | Build a full bit-mask of specified length. --@@ -430,25 +409,23 @@ #if WORD_SIZE_IN_BITS == 32 -- | Packs 2 32-bit system words (hi, lo) into a Word64 packWord64 :: Word# -> Word# -> Word64#-packWord64 hi lo =-#if defined(WORDS_BIGENDIAN)+packWord64 hi lo = case hostByteOrder of+ BigEndian -> ((wordToWord64# lo) `uncheckedShiftL64#` 32#) `or64#` (wordToWord64# hi)-#else+ LittleEndian -> ((wordToWord64# hi) `uncheckedShiftL64#` 32#) `or64#` (wordToWord64# lo)-#endif -- | Unpacks a Word64 into 2 32-bit words (hi, lo) unpackWord64 :: Word64# -> (# Word#, Word# #)-unpackWord64 w =-#if defined(WORDS_BIGENDIAN)+unpackWord64 w = case hostByteOrder of+ BigEndian -> (# word64ToWord# w , word64ToWord# (w `uncheckedShiftRL64#` 32#) #)-#else+ LittleEndian -> (# word64ToWord# (w `uncheckedShiftRL64#` 32#) , word64ToWord# w #)-#endif -- | Adds 2 Word64's with 32-bit addition and manual carrying plusWord64 :: Word64# -> Word64# -> Word64#@@ -734,89 +711,71 @@ toAscii :: Word# -> Word# toAscii a = a `plusWord#` asciiRaw asciiZero -data Addr = Addr Addr#- -- | Index into the 64-bit word lookup table provided {-# INLINE getWord64At #-}-getWord64At :: Addr# -> Int -> Word64-getWord64At arr (I# i) =-#if defined(WORDS_BIGENDIAN)- W64# (byteSwap64# (indexWord64OffAddr# arr i))-#else- W64# (indexWord64OffAddr# arr i)-#endif+getWord64At :: Ptr Word64 -> Int -> Word64+getWord64At (Ptr arr) (I# i) = W64# (indexWord64OffAddr# arr i) -- | Index into the 128-bit word lookup table provided -- Return (# high-64-bits , low-64-bits #)--- NB: really just swaps the bytes and doesn't reorder the words+--+-- NB: The lookup tables we use store the low 64 bits in+-- host-byte-order then the high 64 bits in host-byte-order {-# INLINE getWord128At #-}-getWord128At :: Addr# -> Int -> (Word64, Word64)-getWord128At arr (I# i) =-#if defined(WORDS_BIGENDIAN)- ( W64# (byteSwap64# (indexWord64OffAddr# arr (i *# 2# +# 1#)))- , W64# (byteSwap64# (indexWord64OffAddr# arr (i *# 2#)))- )-#else- ( W64# (indexWord64OffAddr# arr (i *# 2# +# 1#))- , W64# (indexWord64OffAddr# arr (i *# 2#))- )-#endif---data ByteArray = ByteArray ByteArray#+getWord128At :: Ptr Word64 -> Int -> (Word64, Word64)+getWord128At (Ptr arr) (I# i) = let+ !hi = W64# (indexWord64OffAddr# arr (i *# 2# +# 1#))+ !lo = W64# (indexWord64OffAddr# arr (i *# 2#))+ in (hi, lo) -- | Packs 2 bytes [lsb, msb] into 16-bit word packWord16 :: Word# -> Word# -> Word#-packWord16 l h =-#if defined(WORDS_BIGENDIAN)+packWord16 l h = case hostByteOrder of+ BigEndian -> (h `uncheckedShiftL#` 8#) `or#` l-#else+ LittleEndian -> (l `uncheckedShiftL#` 8#) `or#` h-#endif -- | Unpacks a 16-bit word into 2 bytes [lsb, msb] unpackWord16 :: Word# -> (# Word#, Word# #)-unpackWord16 w =-#if defined(WORDS_BIGENDIAN)+unpackWord16 w = case hostByteOrder of+ BigEndian -> (# w `and#` 0xff##, w `uncheckedShiftRL#` 8# #)-#else+ LittleEndian -> (# w `uncheckedShiftRL#` 8#, w `and#` 0xff## #)-#endif --- | ByteArray of 2-digit pairs 00..99 for faster ascii rendering-digit_table :: ByteArray-digit_table = runST (ST $ \s1 ->- let !(# s2, marr #) = newByteArray# 200# s1- go y r = \i s ->- let !(h, l) = fquotRem10 y- e' = packWord16 (toAscii (unsafeRaw l)) (toAscii (unsafeRaw h))-#if __GLASGOW_HASKELL__ >= 902- s' = writeWord16Array# marr i (wordToWord16# e') s+-- | Static array of 2-digit pairs 00..99 for faster ascii rendering+digit_table :: Ptr Word16+digit_table =+#if PURE_HASKELL+ castPtr Pure.digit_pairs_table #else- s' = writeWord16Array# marr i e' s+ castPtr c_digit_pairs_table++foreign import ccall "&hs_bytestring_digit_pairs_table"+ c_digit_pairs_table :: Ptr CChar #endif- in if isTrue# (i ==# 99#) then s' else r (i +# 1#) s'- !(# s3, bs #) = unsafeFreezeByteArray# marr (foldr go (\_ s -> s) [0..99] 0# s2)- in (# s3, ByteArray bs #)) --- | Unsafe index a ByteArray for the 16-bit word at the index-unsafeAt :: ByteArray -> Int# -> Word#-unsafeAt (ByteArray bs) i =+-- | Unsafe index a static array for the 16-bit word at the index+unsafeAt :: Ptr Word16 -> Int# -> Word#+unsafeAt (Ptr a) i = #if __GLASGOW_HASKELL__ >= 902- word16ToWord# (indexWord16Array# bs i)+ word16ToWord# (indexWord16OffAddr# a i) #else- indexWord16Array# bs i+ indexWord16OffAddr# a i #endif -- | Write a 16-bit word into the given address-copyWord16 :: Word# -> Addr# -> State# d -> State# d-copyWord16 w a s =+copyWord16 :: Word# -> Addr# -> State# RealWorld -> State# RealWorld+copyWord16 w a s = let #if __GLASGOW_HASKELL__ >= 902- writeWord16OffAddr# a 0# (wordToWord16# w) s+ w16 = wordToWord16# w #else- writeWord16OffAddr# a 0# w s+ w16 = w #endif+ in case unIO (unalignedWriteU16 (W16# w16) (Ptr a)) s of+ (# s', _ #) -> s' -- | Write an 8-bit word into the given address poke :: Addr# -> Word# -> State# d -> State# d@@ -830,9 +789,9 @@ -- | Write the mantissa into the given address. This function attempts to -- optimize this by writing pairs of digits simultaneously when the mantissa is -- large enough-{-# SPECIALIZE writeMantissa :: Addr# -> Int# -> Word32 -> State# d -> (# Addr#, State# d #) #-}-{-# SPECIALIZE writeMantissa :: Addr# -> Int# -> Word64 -> State# d -> (# Addr#, State# d #) #-}-writeMantissa :: forall a d. (Mantissa a) => Addr# -> Int# -> a -> State# d -> (# Addr#, State# d #)+{-# SPECIALIZE writeMantissa :: Addr# -> Int# -> Word32 -> State# RealWorld -> (# Addr#, State# RealWorld #) #-}+{-# SPECIALIZE writeMantissa :: Addr# -> Int# -> Word64 -> State# RealWorld -> (# Addr#, State# RealWorld #) #-}+writeMantissa :: forall a. (Mantissa a) => Addr# -> Int# -> a -> State# RealWorld -> (# Addr#, State# RealWorld #) writeMantissa ptr olength = go (ptr `plusAddr#` olength) where go p mantissa s1@@ -865,7 +824,7 @@ in (# ptr `plusAddr#` 3#, s4 #) -- | Write the exponent into the given address.-writeExponent :: Addr# -> Int32 -> State# d -> (# Addr#, State# d #)+writeExponent :: Addr# -> Int32 -> State# RealWorld -> (# Addr#, State# RealWorld #) writeExponent ptr !expo s1 | expo >= 100 = let !(e1, e0) = fquotRem10 (fromIntegral expo) -- TODO@@ -896,10 +855,10 @@ toCharsScientific !sign !mantissa !expo = boundedPrim maxEncodedLength $ \_ !(Ptr p0)-> do let !olength@(I# ol) = decimalLength mantissa !expo' = expo + intToInt32 olength - 1- return $ runST (ST $ \s1 ->+ IO $ \s1 -> let !(# p1, s2 #) = writeSign p0 sign s1 !(# p2, s3 #) = writeMantissa p1 ol mantissa s2 s4 = poke p2 (asciiRaw ascii_e) s3 !(# p3, s5 #) = writeSign (p2 `plusAddr#` 1#) (expo' < 0) s4 !(# p4, s6 #) = writeExponent p3 (abs expo') s5- in (# s6, (Ptr p4) #))+ in (# s6, (Ptr p4) #)
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@@ -25,11 +21,21 @@ , float_max_inv_split , double_max_split , double_max_inv_split++ , finv+ , fnorm+ , splitWord128s+ , case64+ , case128 ) where import GHC.Float (int2Double) +import Data.Bits+import Data.Word+import Numeric + -- The basic floating point conversion algorithm is as such: -- -- Given floating point@@ -126,40 +132,52 @@ double_pow5_inv_bitcount :: Int double_pow5_inv_bitcount = 125 --- NB: these tables are encoded directly into the source code in F2S and D2S------ -- | Number of bits in a positive integer--- blen :: Integer -> Int--- blen 0 = 0--- blen 1 = 1--- blen n = 1 + blen (n `quot` 2)+-- NB: these tables are encoded directly into the+-- source code in cbits/aligned-static-hs-data.c --- -- | Used for table generation of 2^k / 5^q + 1--- finv :: Int -> Int -> Integer--- finv bitcount i =--- let p = 5^i--- in (1 `shiftL` (blen p - 1 + bitcount)) `div` p + 1+-- | Number of bits in a positive integer+blen :: Integer -> Int+blen 0 = 0+blen 1 = 1+blen n = 1 + blen (n `quot` 2) --- -- | Used for table generation of 5^-e2-q / 2^k--- fnorm :: Int -> Int -> Integer--- fnorm bitcount i =--- let p = 5^i--- s = blen p - bitcount--- in if s < 0 then p `shiftL` (-s) else p `shiftR` s+-- | Used for table generation of 2^k / 5^q + 1+finv :: Int -> Int -> Integer+finv bitcount i =+ let p = 5^i+ in (1 `shiftL` (blen p - 1 + bitcount)) `div` p + 1 --- -- | Generates a compile-time lookup table for floats as Word64--- gen_table_f :: Int -> (Int -> Integer) -> Q Exp--- gen_table_f n f = return $ ListE (fmap (LitE . IntegerL . f) [0..n])------ -- | Generates a compile-time lookup table for doubles as Word128--- gen_table_d :: Int -> (Int -> Integer) -> Q Exp--- gen_table_d n f = return $ ListE (fmap ff [0..n])--- where--- ff :: Int -> Exp--- ff c = let r = f c--- hi = r `shiftR` 64--- lo = r .&. ((1 `shiftL` 64) - 1)--- in AppE (AppE (ConE 'Word128) (LitE . IntegerL $ hi)) (LitE . IntegerL $ lo)+-- | Used for table generation of 5^-e2-q / 2^k+fnorm :: Int -> Int -> Integer+fnorm bitcount i =+ let p = 5^i+ s = blen p - bitcount+ in if s < 0 then p `shiftL` (-s) else p `shiftR` s++-- | Breaks each integer into two Word64s (lowBits, highBits)+splitWord128s :: [Integer] -> [Word64]+splitWord128s li+ = [fromInteger w | x <- li, w <- [x .&. maxWord64, x `shiftR` 64]]+ where maxWord64 = toInteger (maxBound :: Word64)++splitWord128 :: Integer -> (Word64,Word64)+splitWord128 x = (fromInteger (x `shiftR` 64), fromInteger (x .&. maxWord64))+ where maxWord64 = toInteger (maxBound :: Word64)+++-- Helpers to generate case alternatives returning either one Word64 (case64) or+-- two Word64s (case128) for the PURE_HASKELL variant of the tables.+case64 :: (Int -> Integer) -> [Int] -> String+case64 f range = concat+ [ show i ++ " -> 0x" ++ showHex (f i) "\n"+ | i <- range]++case128 :: (Int -> Integer) -> [Int] -> String+case128 f range = concat+ [ show i ++ " -> (0x" ++ showHex hi "" ++ ", 0x" ++ showHex lo ")\n"+ | i <- range+ , let (hi,lo) = splitWord128 (f i)+ ] -- Given a specific floating-point type, determine the range of q for the < 0 -- and >= 0 cases
Data/ByteString/Char8.hs view
@@ -1,8 +1,10 @@-{-# 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 -- Copyright : (c) Don Stewart 2006-2008@@ -129,6 +131,8 @@ groupBy, inits, tails,+ initsNE,+ tailsNE, strip, stripPrefix, stripSuffix,@@ -185,7 +189,19 @@ -- * Reading from ByteStrings readInt,+ readInt64,+ readInt32,+ readInt16,+ readInt8,++ readWord,+ readWord64,+ readWord32,+ readWord16,+ readWord8,+ readInteger,+ readNatural, -- * Low level CString conversions @@ -232,14 +248,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) @@ -248,27 +264,29 @@ import qualified Data.ByteString.Unsafe as B -- Listy functions transparently exported-import Data.ByteString (empty,null,length,tail,init,append- ,inits,tails,reverse,transpose+import Data.ByteString (null,length,tail,init,append+ ,inits,tails,initsNE,tailsNE,reverse,transpose ,concat,take,takeEnd,drop,dropEnd,splitAt ,intercalate,sort,isPrefixOf,isSuffixOf ,isInfixOf,stripPrefix,stripSuffix ,breakSubstring,copy,group - ,getLine, getContents, putStr, interact+ ,getContents, putStr, interact ,readFile, writeFile, appendFile ,hGetContents, hGet, hGetSome, hPut, hPutStr- ,hGetLine, hGetNonBlocking, hPutNonBlocking+ ,hGetNonBlocking, hPutNonBlocking ,packCString,packCStringLen ,useAsCString,useAsCStringLen ) -import Data.ByteString.Internal+import Data.ByteString.Internal.Type+import Data.ByteString.ReadInt+import Data.ByteString.ReadNat import Data.Char ( isSpace ) -- See bytestring #70 import GHC.Char (eqChar)-import qualified Data.List as List (intersperse)+import qualified Data.List as List import System.IO (Handle,stdout) import Foreign@@ -423,7 +441,7 @@ -- | The 'mapAccumL' function behaves like a combination of 'map' and -- 'foldl'; it applies a function to each element of a ByteString, -- passing an accumulating parameter from left to right, and returning a--- final value of this accumulator together with the new list.+-- final value of this accumulator together with the new ByteString. mapAccumL :: (acc -> Char -> (acc, Char)) -> acc -> ByteString -> (acc, ByteString) mapAccumL f = B.mapAccumL (\acc w -> case f acc (w2c w) of (acc', c) -> (acc', c2w c)) @@ -522,7 +540,7 @@ dropWhile isSpace = dropSpace #-} --- | 'dropWhile' @p xs@ returns the prefix remaining after 'takeWhileEnd' @p+-- | 'dropWhileEnd' @p xs@ returns the prefix remaining after 'takeWhileEnd' @p -- xs@. -- -- @since 0.10.12.0@@ -545,7 +563,7 @@ -- INTERNAL: --- | 'breakChar' breaks its ByteString argument at the first occurence+-- | 'breakChar' breaks its ByteString argument at the first occurrence -- of the specified char. It is more efficient than 'break' as it is -- implemented with @memchr(3)@. I.e. --@@ -843,14 +861,6 @@ unzip ls = (pack (P.map fst ls), pack (P.map snd ls)) {-# INLINE unzip #-} --- | A variety of 'head' for non-empty ByteStrings. 'unsafeHead' omits--- the check for the empty case, which is good for performance, but--- there is an obligation on the programmer to provide a proof that the--- ByteString is non-empty.-unsafeHead :: ByteString -> Char-unsafeHead = w2c . B.unsafeHead-{-# INLINE unsafeHead #-}- -- --------------------------------------------------------------------- -- Things that depend on the encoding @@ -959,13 +969,22 @@ else return [BS f i] -} --- | 'unlines' is an inverse operation to 'lines'. It joins lines,--- after appending a terminating newline to each.+-- | 'unlines' joins lines, appending a terminating newline after each.+--+-- Equivalent to+-- @'concat' . Data.List.concatMap (\\x -> [x, 'singleton' \'\\n'])@. unlines :: [ByteString] -> ByteString-unlines [] = empty-unlines ss = concat (List.intersperse nl ss) `append` nl -- half as much space- where nl = singleton '\n'+unlines = \li -> let+ totLen = List.foldl' (\acc s -> acc +! length s +! 1) 0 li+ (+!) = checkedAdd "Char8.unlines" + go [] _ = pure ()+ go (BS src len : srcs) dest = do+ memcpyFp dest src len+ pokeFpByteOff dest len (c2w '\n')+ go srcs $ dest `plusForeignPtr` (len + 1)+ in unsafeCreateFp totLen (go li)+ -- | 'words' breaks a ByteString up into a list of words, which -- were delimited by Chars representing white space. words :: ByteString -> [ByteString]@@ -977,91 +996,31 @@ unwords = intercalate (singleton ' ') {-# INLINE unwords #-} --- ------------------------------------------------------------------------ Reading from ByteStrings---- | readInt reads an Int from the beginning of the ByteString. If there is no--- integer at the beginning of the string, it returns Nothing, otherwise--- it just returns the int read, and the rest of the string.------ Note: This function will overflow the Int for large integers.-readInt :: ByteString -> Maybe (Int, ByteString)-readInt as- | null as = Nothing- | otherwise =- case unsafeHead as of- '-' -> loop True 0 0 (B.unsafeTail as)- '+' -> loop False 0 0 (B.unsafeTail as)- _ -> loop False 0 0 as-- where loop :: Bool -> Int -> Int -> ByteString -> Maybe (Int, ByteString)- loop neg !i !n !ps- | null ps = end neg i n ps- | otherwise =- case B.unsafeHead ps of- w | w >= 0x30- && w <= 0x39 -> loop neg (i+1)- (n * 10 + (fromIntegral w - 0x30))- (B.unsafeTail ps)- | otherwise -> end neg i n ps-- end _ 0 _ _ = Nothing- end True _ n ps = Just (negate n, ps)- end _ _ n ps = Just (n, ps)---- | readInteger reads an Integer from the beginning of the ByteString. If--- there is no integer at the beginning of the string, it returns Nothing,--- otherwise it just returns the int read, and the rest of the string.-readInteger :: ByteString -> Maybe (Integer, ByteString)-readInteger as- | null as = Nothing- | otherwise =- case unsafeHead as of- '-' -> first (B.unsafeTail as) >>= \(n, bs) -> return (-n, bs)- '+' -> first (B.unsafeTail as)- _ -> first as-- where first ps | null ps = Nothing- | otherwise =- case B.unsafeHead ps of- w | w >= 0x30 && w <= 0x39 -> Just $- loop 1 (fromIntegral w - 0x30) [] (B.unsafeTail ps)- | otherwise -> Nothing-- loop :: Int -> Int -> [Integer]- -> ByteString -> (Integer, ByteString)- loop !d !acc ns !ps- | null ps = combine d acc ns empty- | otherwise =- case B.unsafeHead ps of- w | w >= 0x30 && w <= 0x39 ->- if d == 9 then loop 1 (fromIntegral w - 0x30)- (toInteger acc : ns)- (B.unsafeTail ps)- else loop (d+1)- (10*acc + (fromIntegral w - 0x30))- ns (B.unsafeTail ps)- | otherwise -> combine d acc ns ps-- combine _ acc [] ps = (toInteger acc, ps)- combine d acc ns ps =- (10^d * combine1 1000000000 ns + toInteger acc, ps)-- combine1 _ [n] = n- combine1 b ns = combine1 (b*b) $ combine2 b ns-- combine2 b (n:m:ns) = let !t = m*b + n in t : combine2 b ns- combine2 _ ns = ns- ------------------------------------------------------------------------ -- For non-binary text processing: --- | Write a ByteString to a handle, appending a newline byte+-- | Read a line from stdin.+getLine :: IO ByteString+getLine = B.getLine++-- | Read a line from a handle+hGetLine :: Handle -> IO ByteString+hGetLine = B.hGetLine++-- | Write a ByteString to a handle, appending a newline byte.+--+-- Unlike 'hPutStr', this is not atomic: other threads might write+-- to the handle between writing of the bytestring and the newline.+-- hPutStrLn :: Handle -> ByteString -> IO () hPutStrLn h ps | length ps < 1024 = hPut h (ps `B.snoc` 0x0a) | otherwise = hPut h ps >> hPut h (B.singleton 0x0a) -- don't copy --- | Write a ByteString to stdout, appending a newline byte+-- | Write a ByteString to 'stdout', appending a newline byte.+--+-- Unlike 'putStr', this is not atomic: other threads might write+-- to 'stdout' between writing of the bytestring and the newline.+-- putStrLn :: ByteString -> IO () putStrLn = hPutStrLn stdout
Data/ByteString/Internal.hs view
@@ -1,11 +1,3 @@-{-# LANGUAGE CPP, ForeignFunctionInterface, BangPatterns #-}-{-# LANGUAGE UnliftedFFITypes, MagicHash,- UnboxedTuples, DeriveDataTypeable #-}-{-# LANGUAGE TupleSections #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE PatternSynonyms, ViewPatterns #-}-{-# LANGUAGE Unsafe #-}-{-# LANGUAGE TemplateHaskellQuotes #-} {-# OPTIONS_HADDOCK not-home #-} -- |@@ -47,6 +39,7 @@ unsafePackLiteral, unsafePackLenLiteral, -- * Low level imperative construction+ empty, create, createUptoN, createUptoN',@@ -58,6 +51,7 @@ mallocByteString, -- * Conversion to and from ForeignPtrs+ mkDeferredByteString, fromForeignPtr, toForeignPtr, fromForeignPtr0,@@ -65,7 +59,11 @@ -- * Utilities nullForeignPtr,+ deferForeignPtrAvailability,+ SizeOverflowException,+ overflowError, checkedAdd,+ checkedMultiply, -- * Standard C Functions c_strlen,@@ -95,784 +93,4 @@ unsafeWithForeignPtr ) where -import Prelude hiding (concat, null)-import qualified Data.List as List--import Control.Monad (void)--import Foreign.ForeignPtr (ForeignPtr, withForeignPtr)-import Foreign.Ptr (Ptr, FunPtr, plusPtr, minusPtr)-import Foreign.Storable (Storable(..))-import Foreign.C.Types (CInt(..), CSize(..))-import Foreign.C.String (CString)--#if MIN_VERSION_base(4,13,0)-import Data.Semigroup (Semigroup (sconcat, stimes))-#else-import Data.Semigroup (Semigroup ((<>), sconcat, stimes))-#endif-import Data.List.NonEmpty (NonEmpty ((:|)))--import Control.DeepSeq (NFData(rnf))--import Data.String (IsString(..))--import Control.Exception (assert)--import Data.Bits ((.&.))-import Data.Char (ord)-import Data.Word--import Data.Typeable (Typeable)-import Data.Data (Data(..), mkNoRepType)--import GHC.Base (nullAddr#,realWorld#,unsafeChr)-import GHC.Exts (IsList(..))-import GHC.CString (unpackCString#)-import GHC.Prim (Addr#)-import GHC.IO (IO(IO),unsafeDupablePerformIO)-import GHC.ForeignPtr (ForeignPtr(ForeignPtr)-#if __GLASGOW_HASKELL__ < 900- , newForeignPtr_-#endif- , mallocPlainForeignPtrBytes)--#if MIN_VERSION_base(4,10,0)-import GHC.ForeignPtr (plusForeignPtr)-#else-import GHC.Prim (plusAddr#)-#endif--#if __GLASGOW_HASKELL__ >= 811-import GHC.CString (cstringLength#)-import GHC.ForeignPtr (ForeignPtrContents(FinalPtr))-#else-import GHC.Ptr (Ptr(..))-#endif--#if (__GLASGOW_HASKELL__ < 802) || (__GLASGOW_HASKELL__ >= 811)-import GHC.Types (Int (..))-#endif--#if MIN_VERSION_base(4,15,0)-import GHC.ForeignPtr (unsafeWithForeignPtr)-#endif--import qualified Language.Haskell.TH.Lib as TH-import qualified Language.Haskell.TH.Syntax as TH--#if !MIN_VERSION_base(4,15,0)-unsafeWithForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b-unsafeWithForeignPtr = withForeignPtr-#endif---- CFILES stuff is Hugs only-{-# CFILES cbits/fpstring.c #-}--#if !MIN_VERSION_base(4,10,0)--- |Advances the given address by the given offset in bytes.------ The new 'ForeignPtr' shares the finalizer of the original,--- equivalent from a finalization standpoint to just creating another--- reference to the original. That is, the finalizer will not be--- called before the new 'ForeignPtr' is unreachable, nor will it be--- called an additional time due to this call, and the finalizer will--- be called with the same address that it would have had this call--- not happened, *not* the new address.-plusForeignPtr :: ForeignPtr a -> Int -> ForeignPtr b-plusForeignPtr (ForeignPtr addr guts) (I# offset) = ForeignPtr (plusAddr# addr offset) guts-{-# INLINE [0] plusForeignPtr #-}-{-# RULES-"ByteString plusForeignPtr/0" forall fp .- plusForeignPtr fp 0 = fp- #-}-#endif---- --------------------------------------------------------------------------------- | A space-efficient representation of a 'Word8' vector, supporting many--- efficient operations.------ A 'ByteString' contains 8-bit bytes, or by using the operations from--- "Data.ByteString.Char8" it can be interpreted as containing 8-bit--- characters.----data ByteString = BS {-# UNPACK #-} !(ForeignPtr Word8) -- payload- {-# UNPACK #-} !Int -- length- -- ^ @since 0.11.0.0- deriving (Typeable)---- | Type synonym for the strict flavour of 'ByteString'.------ @since 0.11.2.0-type StrictByteString = ByteString---- |--- @'PS' foreignPtr offset length@ represents a 'ByteString' with data--- backed by a given @foreignPtr@, starting at a given @offset@ in bytes--- and of a specified @length@.------ This pattern is used to emulate the legacy 'ByteString' data--- constructor, so that pre-existing code generally doesn't need to--- change to benefit from the simplified 'BS' constructor and can--- continue to function unchanged.------ /Note:/ Matching with this constructor will always be given a 0 offset,--- as the base will be manipulated by 'plusForeignPtr' instead.----pattern PS :: ForeignPtr Word8 -> Int -> Int -> ByteString-pattern PS fp zero len <- BS fp ((0,) -> (zero, len)) where- PS fp o len = BS (plusForeignPtr fp o) len-#if __GLASGOW_HASKELL__ >= 802-{-# COMPLETE PS #-}-#endif--instance Eq ByteString where- (==) = eq--instance Ord ByteString where- compare = compareBytes--instance Semigroup ByteString where- (<>) = append- sconcat (b:|bs) = concat (b:bs)- stimes = times--instance Monoid ByteString where- mempty = BS nullForeignPtr 0- mappend = (<>)- mconcat = concat--instance NFData ByteString where- rnf BS{} = ()--instance Show ByteString where- showsPrec p ps r = showsPrec p (unpackChars ps) r--instance Read ByteString where- readsPrec p str = [ (packChars x, y) | (x, y) <- readsPrec p str ]---- | @since 0.10.12.0-instance IsList ByteString where- type Item ByteString = Word8- fromList = packBytes- toList = unpackBytes---- | Beware: 'fromString' truncates multi-byte characters to octets.--- e.g. "枯朶に烏のとまりけり秋の暮" becomes �6k�nh~�Q��n�-instance IsString ByteString where- {-# INLINE fromString #-}- fromString = packChars--instance Data ByteString where- gfoldl f z txt = z packBytes `f` unpackBytes txt- toConstr _ = error "Data.ByteString.ByteString.toConstr"- gunfold _ _ = error "Data.ByteString.ByteString.gunfold"- dataTypeOf _ = mkNoRepType "Data.ByteString.ByteString"---- | @since 0.11.2.0-instance TH.Lift ByteString where-#if MIN_VERSION_template_haskell(2,16,0)- lift (BS ptr len) = [| unsafePackLenLiteral |]- `TH.appE` TH.litE (TH.integerL (fromIntegral len))- `TH.appE` TH.litE (TH.BytesPrimL $ TH.Bytes ptr 0 (fromIntegral len))-#else- lift bs@(BS _ len) = [| unsafePackLenLiteral |]- `TH.appE` TH.litE (TH.integerL (fromIntegral len))- `TH.appE` TH.litE (TH.StringPrimL $ unpackBytes bs)-#endif--#if MIN_VERSION_template_haskell(2,17,0)- liftTyped = TH.unsafeCodeCoerce . TH.lift-#elif MIN_VERSION_template_haskell(2,16,0)- liftTyped = TH.unsafeTExpCoerce . TH.lift-#endif----------------------------------------------------------------------------- Internal indexing---- | 'findIndexOrLength' is a variant of findIndex, that returns the length--- of the string if no element is found, rather than Nothing.-findIndexOrLength :: (Word8 -> Bool) -> ByteString -> Int-findIndexOrLength k (BS x l) =- accursedUnutterablePerformIO $ unsafeWithForeignPtr x g- where- g ptr = go 0- where- go !n | n >= l = return l- | otherwise = do w <- peek $ ptr `plusPtr` n- if k w- then return n- else go (n+1)-{-# INLINE findIndexOrLength #-}----------------------------------------------------------------------------- Packing and unpacking from lists--packBytes :: [Word8] -> ByteString-packBytes ws = unsafePackLenBytes (List.length ws) ws--packChars :: [Char] -> ByteString-packChars cs = unsafePackLenChars (List.length cs) cs--{-# INLINE [0] packChars #-}--{-# RULES-"ByteString packChars/packAddress" forall s .- packChars (unpackCString# s) = unsafePackLiteral s- #-}--unsafePackLenBytes :: Int -> [Word8] -> ByteString-unsafePackLenBytes len xs0 =- unsafeCreate len $ \p -> go p xs0- where- go !_ [] = return ()- go !p (x:xs) = poke p x >> go (p `plusPtr` 1) xs--unsafePackLenChars :: Int -> [Char] -> ByteString-unsafePackLenChars len cs0 =- unsafeCreate len $ \p -> go p cs0- where- go !_ [] = return ()- go !p (c:cs) = poke p (c2w c) >> go (p `plusPtr` 1) cs----- | /O(n)/ Pack a null-terminated sequence of bytes, pointed to by an--- Addr\# (an arbitrary machine address assumed to point outside the--- garbage-collected heap) into a @ByteString@. A much faster way to--- create an 'Addr#' is with an unboxed string literal, than to pack a--- boxed string. A unboxed string literal is compiled to a static @char--- []@ by GHC. Establishing the length of the string requires a call to--- @strlen(3)@, so the 'Addr#' must point to a null-terminated buffer (as--- is the case with @\"string\"\#@ literals in GHC). Use 'Data.ByteString.Unsafe.unsafePackAddressLen'--- if you know the length of the string statically.------ An example:------ > literalFS = unsafePackAddress "literal"#------ This function is /unsafe/. If you modify the buffer pointed to by the--- original 'Addr#' this modification will be reflected in the resulting--- @ByteString@, breaking referential transparency.------ Note this also won't work if your 'Addr#' has embedded @\'\\0\'@ characters in--- the string, as @strlen@ will return too short a length.----unsafePackAddress :: Addr# -> IO ByteString-unsafePackAddress addr# = do-#if __GLASGOW_HASKELL__ >= 811- unsafePackLenAddress (I# (cstringLength# addr#)) addr#-#else- l <- c_strlen (Ptr addr#)- unsafePackLenAddress (fromIntegral l) addr#-#endif-{-# INLINE unsafePackAddress #-}---- | See 'unsafePackAddress'. This function is similar,--- but takes an additional length argument rather then computing--- it with @strlen@.--- Therefore embedding @\'\\0\'@ characters is possible.------ @since 0.11.2.0-unsafePackLenAddress :: Int -> Addr# -> IO ByteString-unsafePackLenAddress len addr# = do-#if __GLASGOW_HASKELL__ >= 811- return (BS (ForeignPtr addr# FinalPtr) len)-#else- p <- newForeignPtr_ (Ptr addr#)- return $ BS p len-#endif-{-# INLINE unsafePackLenAddress #-}---- | See 'unsafePackAddress'. This function has similar behavior. Prefer--- this function when the address in known to be an @Addr#@ literal. In--- that context, there is no need for the sequencing guarantees that 'IO'--- provides. On GHC 9.0 and up, this function uses the @FinalPtr@ data--- constructor for @ForeignPtrContents@.------ @since 0.11.1.0-unsafePackLiteral :: Addr# -> ByteString-unsafePackLiteral addr# =-#if __GLASGOW_HASKELL__ >= 811- unsafePackLenLiteral (I# (cstringLength# addr#)) addr#-#else- let len = accursedUnutterablePerformIO (c_strlen (Ptr addr#))- in unsafePackLenLiteral (fromIntegral len) addr#-#endif-{-# INLINE unsafePackLiteral #-}----- | See 'unsafePackLiteral'. This function is similar,--- but takes an additional length argument rather then computing--- it with @strlen@.--- Therefore embedding @\'\\0\'@ characters is possible.------ @since 0.11.2.0-unsafePackLenLiteral :: Int -> Addr# -> ByteString-unsafePackLenLiteral len addr# =-#if __GLASGOW_HASKELL__ >= 811- BS (ForeignPtr addr# FinalPtr) len-#else- BS (accursedUnutterablePerformIO (newForeignPtr_ (Ptr addr#))) len-#endif-{-# INLINE unsafePackLenLiteral #-}--packUptoLenBytes :: Int -> [Word8] -> (ByteString, [Word8])-packUptoLenBytes len xs0 =- unsafeCreateUptoN' len $ \p0 ->- let p_end = plusPtr p0 len- go !p [] = return (p `minusPtr` p0, [])- go !p xs | p == p_end = return (len, xs)- go !p (x:xs) = poke p x >> go (p `plusPtr` 1) xs- in go p0 xs0--packUptoLenChars :: Int -> [Char] -> (ByteString, [Char])-packUptoLenChars len cs0 =- unsafeCreateUptoN' len $ \p0 ->- let p_end = plusPtr p0 len- go !p [] = return (p `minusPtr` p0, [])- go !p cs | p == p_end = return (len, cs)- go !p (c:cs) = poke p (c2w c) >> go (p `plusPtr` 1) cs- in go p0 cs0---- Unpacking bytestrings into lists efficiently is a tradeoff: on the one hand--- we would like to write a tight loop that just blasts the list into memory, on--- the other hand we want it to be unpacked lazily so we don't end up with a--- massive list data structure in memory.------ Our strategy is to combine both: we will unpack lazily in reasonable sized--- chunks, where each chunk is unpacked strictly.------ unpackBytes and unpackChars do the lazy loop, while unpackAppendBytes and--- unpackAppendChars do the chunks strictly.--unpackBytes :: ByteString -> [Word8]-unpackBytes bs = unpackAppendBytesLazy bs []--unpackChars :: ByteString -> [Char]-unpackChars bs = unpackAppendCharsLazy bs []--unpackAppendBytesLazy :: ByteString -> [Word8] -> [Word8]-unpackAppendBytesLazy (BS fp len) xs- | len <= 100 = unpackAppendBytesStrict (BS fp len) xs- | otherwise = unpackAppendBytesStrict (BS fp 100) remainder- where- remainder = unpackAppendBytesLazy (BS (plusForeignPtr fp 100) (len-100)) xs-- -- Why 100 bytes you ask? Because on a 64bit machine the list we allocate- -- takes just shy of 4k which seems like a reasonable amount.- -- (5 words per list element, 8 bytes per word, 100 elements = 4000 bytes)--unpackAppendCharsLazy :: ByteString -> [Char] -> [Char]-unpackAppendCharsLazy (BS fp len) cs- | len <= 100 = unpackAppendCharsStrict (BS fp len) cs- | otherwise = unpackAppendCharsStrict (BS fp 100) remainder- where- remainder = unpackAppendCharsLazy (BS (plusForeignPtr fp 100) (len-100)) cs---- For these unpack functions, since we're unpacking the whole list strictly we--- build up the result list in an accumulator. This means we have to build up--- the list starting at the end. So our traversal starts at the end of the--- buffer and loops down until we hit the sentinal:--unpackAppendBytesStrict :: ByteString -> [Word8] -> [Word8]-unpackAppendBytesStrict (BS fp len) xs =- accursedUnutterablePerformIO $ unsafeWithForeignPtr fp $ \base ->- loop (base `plusPtr` (-1)) (base `plusPtr` (-1+len)) xs- where- loop !sentinal !p acc- | p == sentinal = return acc- | otherwise = do x <- peek p- loop sentinal (p `plusPtr` (-1)) (x:acc)--unpackAppendCharsStrict :: ByteString -> [Char] -> [Char]-unpackAppendCharsStrict (BS fp len) xs =- accursedUnutterablePerformIO $ unsafeWithForeignPtr fp $ \base ->- loop (base `plusPtr` (-1)) (base `plusPtr` (-1+len)) xs- where- loop !sentinal !p acc- | p == sentinal = return acc- | otherwise = do x <- peek p- loop sentinal (p `plusPtr` (-1)) (w2c x:acc)------------------------------------------------------------------------------ | The 0 pointer. Used to indicate the empty Bytestring.-nullForeignPtr :: ForeignPtr Word8-#if __GLASGOW_HASKELL__ >= 811-nullForeignPtr = ForeignPtr nullAddr# FinalPtr-#else-nullForeignPtr = ForeignPtr nullAddr# (error "nullForeignPtr")-#endif---- ------------------------------------------------------------------------ Low level constructors---- | /O(1)/ Build a ByteString from a ForeignPtr.------ If you do not need the offset parameter then you should be using--- 'Data.ByteString.Unsafe.unsafePackCStringLen' or--- 'Data.ByteString.Unsafe.unsafePackCStringFinalizer' instead.----fromForeignPtr :: ForeignPtr Word8- -> Int -- ^ Offset- -> Int -- ^ Length- -> ByteString-fromForeignPtr fp o = BS (plusForeignPtr fp o)-{-# INLINE fromForeignPtr #-}---- | @since 0.11.0.0-fromForeignPtr0 :: ForeignPtr Word8- -> Int -- ^ Length- -> ByteString-fromForeignPtr0 = BS-{-# INLINE fromForeignPtr0 #-}---- | /O(1)/ Deconstruct a ForeignPtr from a ByteString-toForeignPtr :: ByteString -> (ForeignPtr Word8, Int, Int) -- ^ (ptr, offset, length)-toForeignPtr (BS ps l) = (ps, 0, l)-{-# INLINE toForeignPtr #-}---- | /O(1)/ Deconstruct a ForeignPtr from a ByteString------ @since 0.11.0.0-toForeignPtr0 :: ByteString -> (ForeignPtr Word8, Int) -- ^ (ptr, length)-toForeignPtr0 (BS ps l) = (ps, l)-{-# INLINE toForeignPtr0 #-}---- | A way of creating ByteStrings outside the IO monad. The @Int@--- argument gives the final size of the ByteString.-unsafeCreate :: Int -> (Ptr Word8 -> IO ()) -> ByteString-unsafeCreate l f = unsafeDupablePerformIO (create l f)-{-# INLINE unsafeCreate #-}---- | Like 'unsafeCreate' but instead of giving the final size of the--- ByteString, it is just an upper bound. The inner action returns--- the actual size. Unlike 'createAndTrim' the ByteString is not--- reallocated if the final size is less than the estimated size.-unsafeCreateUptoN :: Int -> (Ptr Word8 -> IO Int) -> ByteString-unsafeCreateUptoN l f = unsafeDupablePerformIO (createUptoN l f)-{-# INLINE unsafeCreateUptoN #-}---- | @since 0.10.12.0-unsafeCreateUptoN' :: Int -> (Ptr Word8 -> IO (Int, a)) -> (ByteString, a)-unsafeCreateUptoN' l f = unsafeDupablePerformIO (createUptoN' l f)-{-# INLINE unsafeCreateUptoN' #-}---- | Create ByteString of size @l@ and use action @f@ to fill its contents.-create :: Int -> (Ptr Word8 -> IO ()) -> IO ByteString-create l action = do- fp <- mallocByteString l- -- Cannot use unsafeWithForeignPtr, because action can diverge- withForeignPtr fp $ \p -> action p- return $! BS fp l-{-# INLINE create #-}---- | Given a maximum size @l@ and an action @f@ that fills the 'ByteString'--- starting at the given 'Ptr' and returns the actual utilized length,--- @`createUptoN'` l f@ returns the filled 'ByteString'.-createUptoN :: Int -> (Ptr Word8 -> IO Int) -> IO ByteString-createUptoN l action = do- fp <- mallocByteString l- -- Cannot use unsafeWithForeignPtr, because action can diverge- l' <- withForeignPtr fp $ \p -> action p- assert (l' <= l) $ return $! BS fp l'-{-# INLINE createUptoN #-}---- | Like 'createUptoN', but also returns an additional value created by the--- action.------ @since 0.10.12.0-createUptoN' :: Int -> (Ptr Word8 -> IO (Int, a)) -> IO (ByteString, a)-createUptoN' l action = do- fp <- mallocByteString l- -- Cannot use unsafeWithForeignPtr, because action can diverge- (l', res) <- withForeignPtr fp $ \p -> action p- assert (l' <= l) $ return (BS fp l', res)-{-# INLINE createUptoN' #-}---- | Given the maximum size needed and a function to make the contents--- of a ByteString, createAndTrim makes the 'ByteString'. The generating--- function is required to return the actual final size (<= the maximum--- size), and the resulting byte array is realloced to this size.------ createAndTrim is the main mechanism for creating custom, efficient--- ByteString functions, using Haskell or C functions to fill the space.----createAndTrim :: Int -> (Ptr Word8 -> IO Int) -> IO ByteString-createAndTrim l action = do- fp <- mallocByteString l- -- Cannot use unsafeWithForeignPtr, because action can diverge- withForeignPtr fp $ \p -> do- l' <- action p- if assert (l' <= l) $ l' >= l- then return $! BS fp l- else create l' $ \p' -> memcpy p' p l'-{-# INLINE createAndTrim #-}--createAndTrim' :: Int -> (Ptr Word8 -> IO (Int, Int, a)) -> IO (ByteString, a)-createAndTrim' l action = do- fp <- mallocByteString l- -- Cannot use unsafeWithForeignPtr, because action can diverge- withForeignPtr fp $ \p -> do- (off, l', res) <- action p- if assert (l' <= l) $ l' >= l- then return (BS fp l, res)- else do ps <- create l' $ \p' ->- memcpy p' (p `plusPtr` off) l'- return (ps, res)-{-# INLINE createAndTrim' #-}---- | Wrapper of 'Foreign.ForeignPtr.mallocForeignPtrBytes' with faster implementation for GHC----mallocByteString :: Int -> IO (ForeignPtr a)-mallocByteString = mallocPlainForeignPtrBytes-{-# INLINE mallocByteString #-}----------------------------------------------------------------------------- Implementations for Eq, Ord and Monoid instances--eq :: ByteString -> ByteString -> Bool-eq a@(BS fp len) b@(BS fp' len')- | len /= len' = False -- short cut on length- | fp == fp' = True -- short cut for the same string- | otherwise = compareBytes a b == EQ-{-# INLINE eq #-}--- ^ still needed--compareBytes :: ByteString -> ByteString -> Ordering-compareBytes (BS _ 0) (BS _ 0) = EQ -- short cut for empty strings-compareBytes (BS fp1 len1) (BS fp2 len2) =- accursedUnutterablePerformIO $- unsafeWithForeignPtr fp1 $ \p1 ->- unsafeWithForeignPtr fp2 $ \p2 -> do- i <- memcmp p1 p2 (min len1 len2)- return $! case i `compare` 0 of- EQ -> len1 `compare` len2- x -> x--append :: ByteString -> ByteString -> ByteString-append (BS _ 0) b = b-append a (BS _ 0) = a-append (BS fp1 len1) (BS fp2 len2) =- unsafeCreate (len1+len2) $ \destptr1 -> do- let destptr2 = destptr1 `plusPtr` len1- unsafeWithForeignPtr fp1 $ \p1 -> memcpy destptr1 p1 len1- unsafeWithForeignPtr fp2 $ \p2 -> memcpy destptr2 p2 len2--concat :: [ByteString] -> ByteString-concat = \bss0 -> goLen0 bss0 bss0- -- The idea here is we first do a pass over the input list to determine:- --- -- 1. is a copy necessary? e.g. @concat []@, @concat [mempty, "hello"]@,- -- and @concat ["hello", mempty, mempty]@ can all be handled without- -- copying.- -- 2. if a copy is necessary, how large is the result going to be?- --- -- If a copy is necessary then we create a buffer of the appropriate size- -- and do another pass over the input list, copying the chunks into the- -- buffer. Also, since foreign calls aren't entirely free we skip over- -- empty chunks while copying.- --- -- We pass the original [ByteString] (bss0) through as an argument through- -- goLen0, goLen1, and goLen since we will need it again in goCopy. Passing- -- it as an explicit argument avoids capturing it in these functions'- -- closures which would result in unnecessary closure allocation.- where- -- It's still possible that the result is empty- goLen0 _ [] = mempty- goLen0 bss0 (BS _ 0 :bss) = goLen0 bss0 bss- goLen0 bss0 (bs :bss) = goLen1 bss0 bs bss-- -- It's still possible that the result is a single chunk- goLen1 _ bs [] = bs- goLen1 bss0 bs (BS _ 0 :bss) = goLen1 bss0 bs bss- goLen1 bss0 bs (BS _ len:bss) = goLen bss0 (checkedAdd "concat" len' len) bss- where BS _ len' = bs-- -- General case, just find the total length we'll need- goLen bss0 !total (BS _ len:bss) = goLen bss0 total' bss- where total' = checkedAdd "concat" total len- goLen bss0 total [] =- unsafeCreate total $ \ptr -> goCopy bss0 ptr-- -- Copy the data- goCopy [] !_ = return ()- goCopy (BS _ 0 :bss) !ptr = goCopy bss ptr- goCopy (BS fp len:bss) !ptr = do- unsafeWithForeignPtr fp $ \p -> memcpy ptr p len- goCopy bss (ptr `plusPtr` len)-{-# NOINLINE concat #-}--{-# RULES-"ByteString concat [] -> mempty"- concat [] = mempty-"ByteString concat [bs] -> bs" forall x.- concat [x] = x- #-}---- | /O(log n)/ Repeats the given ByteString n times.-times :: Integral a => a -> ByteString -> ByteString-times n (BS fp len)- | n < 0 = error "stimes: non-negative multiplier expected"- | n == 0 = mempty- | n == 1 = BS fp len- | len == 0 = mempty- | len == 1 = unsafeCreate size $ \destptr ->- unsafeWithForeignPtr fp $ \p -> do- byte <- peek p- void $ memset destptr byte (fromIntegral size)- | otherwise = unsafeCreate size $ \destptr ->- unsafeWithForeignPtr fp $ \p -> do- memcpy destptr p len- fillFrom destptr len- where- size = len * fromIntegral n-- fillFrom :: Ptr Word8 -> Int -> IO ()- fillFrom destptr copied- | 2 * copied < size = do- memcpy (destptr `plusPtr` copied) destptr copied- fillFrom destptr (copied * 2)- | otherwise = memcpy (destptr `plusPtr` copied) destptr (size - copied)---- | Add two non-negative numbers. Errors out on overflow.-checkedAdd :: String -> Int -> Int -> Int-checkedAdd fun x y- | r >= 0 = r- | otherwise = overflowError fun- where r = x + y-{-# INLINE checkedAdd #-}------------------------------------------------------------------------------ | Conversion between 'Word8' and 'Char'. Should compile to a no-op.-w2c :: Word8 -> Char-w2c = unsafeChr . fromIntegral-{-# INLINE w2c #-}---- | Unsafe conversion between 'Char' and 'Word8'. This is a no-op and--- silently truncates to 8 bits Chars > '\255'. It is provided as--- convenience for ByteString construction.-c2w :: Char -> Word8-c2w = fromIntegral . ord-{-# INLINE c2w #-}---- | Selects words corresponding to white-space characters in the Latin-1 range-isSpaceWord8 :: Word8 -> Bool-isSpaceWord8 w8 =- -- Avoid the cost of narrowing arithmetic results to Word8,- -- the conversion from Word8 to Word is free.- let w :: Word- !w = fromIntegral w8- in w .&. 0x50 == 0 -- Quick non-whitespace filter- && w - 0x21 > 0x7e -- Second non-whitespace filter- && ( w == 0x20 -- SP- || w == 0xa0 -- NBSP- || w - 0x09 < 5) -- HT, NL, VT, FF, CR-{-# INLINE isSpaceWord8 #-}---- | Selects white-space characters in the Latin-1 range-isSpaceChar8 :: Char -> Bool-isSpaceChar8 = isSpaceWord8 . c2w-{-# INLINE isSpaceChar8 #-}--overflowError :: String -> a-overflowError fun = error $ "Data.ByteString." ++ fun ++ ": size overflow"------------------------------------------------------------------------------ | This \"function\" has a superficial similarity to 'System.IO.Unsafe.unsafePerformIO' but--- it is in fact a malevolent agent of chaos. It unpicks the seams of reality--- (and the 'IO' monad) so that the normal rules no longer apply. It lulls you--- into thinking it is reasonable, but when you are not looking it stabs you--- in the back and aliases all of your mutable buffers. The carcass of many a--- seasoned Haskell programmer lie strewn at its feet.------ Witness the trail of destruction:------ * <https://github.com/haskell/bytestring/commit/71c4b438c675aa360c79d79acc9a491e7bbc26e7>------ * <https://github.com/haskell/bytestring/commit/210c656390ae617d9ee3b8bcff5c88dd17cef8da>------ * <https://ghc.haskell.org/trac/ghc/ticket/3486>------ * <https://ghc.haskell.org/trac/ghc/ticket/3487>------ * <https://ghc.haskell.org/trac/ghc/ticket/7270>------ Do not talk about \"safe\"! You do not know what is safe!------ Yield not to its blasphemous call! Flee traveller! Flee or you will be--- corrupted and devoured!----{-# INLINE accursedUnutterablePerformIO #-}-accursedUnutterablePerformIO :: IO a -> a-accursedUnutterablePerformIO (IO m) = case m realWorld# of (# _, r #) -> r---- --------------------------------------------------------------------------- Standard C functions-----foreign import ccall unsafe "string.h strlen" c_strlen- :: CString -> IO CSize--foreign import ccall unsafe "static stdlib.h &free" c_free_finalizer- :: FunPtr (Ptr Word8 -> IO ())--foreign import ccall unsafe "string.h memchr" c_memchr- :: Ptr Word8 -> CInt -> CSize -> IO (Ptr Word8)--memchr :: Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8)-memchr p w = c_memchr p (fromIntegral w)--foreign import ccall unsafe "string.h memcmp" c_memcmp- :: Ptr Word8 -> Ptr Word8 -> CSize -> IO CInt--memcmp :: Ptr Word8 -> Ptr Word8 -> Int -> IO CInt-memcmp p q s = c_memcmp p q (fromIntegral s)--foreign import ccall unsafe "string.h memcpy" c_memcpy- :: Ptr Word8 -> Ptr Word8 -> CSize -> IO (Ptr Word8)--memcpy :: Ptr Word8 -> Ptr Word8 -> Int -> IO ()-memcpy p q s = void $ c_memcpy p q (fromIntegral s)--{--foreign import ccall unsafe "string.h memmove" c_memmove- :: Ptr Word8 -> Ptr Word8 -> CSize -> IO (Ptr Word8)--memmove :: Ptr Word8 -> Ptr Word8 -> CSize -> IO ()-memmove p q s = do c_memmove p q s- return ()--}--foreign import ccall unsafe "string.h memset" c_memset- :: Ptr Word8 -> CInt -> CSize -> IO (Ptr Word8)--memset :: Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8)-memset p w = c_memset p (fromIntegral w)---- --------------------------------------------------------------------------- Uses our C code-----foreign import ccall unsafe "static fpstring.h fps_reverse" c_reverse- :: Ptr Word8 -> Ptr Word8 -> CSize -> IO ()--foreign import ccall unsafe "static fpstring.h fps_intersperse" c_intersperse- :: Ptr Word8 -> Ptr Word8 -> CSize -> Word8 -> IO ()--foreign import ccall unsafe "static fpstring.h fps_maximum" c_maximum- :: Ptr Word8 -> CSize -> IO Word8--foreign import ccall unsafe "static fpstring.h fps_minimum" c_minimum- :: Ptr Word8 -> CSize -> IO Word8--foreign import ccall unsafe "static fpstring.h fps_count" c_count- :: Ptr Word8 -> CSize -> Word8 -> IO CSize--foreign import ccall unsafe "static fpstring.h fps_sort" c_sort- :: Ptr Word8 -> CSize -> IO ()+import Data.ByteString.Internal.Type
+ Data/ByteString/Internal/Pure.hs view
@@ -0,0 +1,418 @@+-- Enable yields to make `isValidUtf8` safe to use on large inputs.+{-# OPTIONS_GHC -fno-omit-yields #-}++-- | Haskell implementation of C bits+module Data.ByteString.Internal.Pure+ ( -- * standard string.h functions+ strlen+ , memchr+ , memcmp+ -- * fpstring.c+ , intersperse+ , countOcc+ , countOccBA+ , reverseBytes+ , findMaximum+ , findMinimum+ , quickSort+ , elemIndex+ , isValidUtf8+ , isValidUtf8BA+ -- * itoa.c+ , encodeSignedDec+ , encodeUnsignedDec+ , encodeUnsignedDecPadded+ , encodeUnsignedHex+ -- * static tables (unaligned!)+ , lower_hex_table+ , digit_pairs_table+ )+where++import Prelude++import GHC.Exts (Ptr(..), ByteArray#, indexWord8Array#, Word8#, Int#, indexWord8OffAddr#)+import GHC.Types (Int (..))+import GHC.Word (Word8(..))+import GHC.Int (Int8(..))++import Data.Bits (Bits(..), shiftR, (.&.))+import Data.Word+import Foreign.Ptr (plusPtr, nullPtr)+import Foreign.Storable (Storable(..))+import Control.Monad (when)+import Control.Exception (assert)++import Data.ByteString.Utils.ByteOrder+import Data.ByteString.Utils.UnalignedAccess++----------------------------------------------------------------+-- Haskell versions of standard functions in string.h+----------------------------------------------------------------++strlen :: Ptr Word8 -> IO Int+strlen = go 0 where+ go :: Int -> Ptr Word8 -> IO Int+ go !acc !p = do+ c <- peek p+ if | c == 0 -> pure acc+ | nextAcc <- acc + 1+ , nextAcc >= 0 -> go nextAcc (p `plusPtr` 1)+ | otherwise -> errorWithoutStackTrace+ "bytestring: strlen: String length does not fit in a Haskell Int"++memchr :: Ptr Word8 -> Word8 -> Int -> IO (Ptr Word8)+memchr !p !target !len+ | len == 0 = pure nullPtr+ | otherwise = assert (len > 0) $ do+ c <- peek p+ if c == target+ then pure p+ else memchr (p `plusPtr` 1) target (len - 1)++memcmp :: Ptr Word8 -> Ptr Word8 -> Int -> IO Int+memcmp !p1 !p2 !len+ | len >= 8 = do+ w1 <- unalignedReadU64 p1+ w2 <- unalignedReadU64 p2+ let toBigEndian = whenLittleEndian byteSwap64+ if | w1 == w2+ -> memcmp (p1 `plusPtr` 8) (p2 `plusPtr` 8) (len - 8)+ | toBigEndian w1 < toBigEndian w2+ -> pure (0-1)+ | otherwise -> pure 1+ | otherwise = memcmp1 p1 p2 len++-- | Like 'memcmp', but definitely scans one byte at a time+memcmp1 :: Ptr Word8 -> Ptr Word8 -> Int -> IO Int+memcmp1 !p1 !p2 !len+ | len == 0 = pure 0+ | otherwise = assert (len > 0) $ do+ c1 <- peek p1+ c2 <- peek p2+ if | c1 == c2 -> memcmp1 (p1 `plusPtr` 1) (p2 `plusPtr` 1) (len - 1)+ | c1 < c2 -> pure (0-1)+ | otherwise -> pure 1+++----------------------------------------------------------------+-- Haskell versions of functions in fpstring.c+----------------------------------------------------------------++-- | duplicate a string, interspersing the character through the elements of the+-- duplicated string+intersperse :: Ptr Word8 -> Ptr Word8 -> Int -> Word8 -> IO ()+intersperse !dst !src !len !w = case len of+ 0 -> pure ()+ 1 -> do+ -- copy last char+ c <- peekByteOff src 0+ pokeByteOff dst 0 (c :: Word8)+ _ -> do+ c <- peekByteOff src 0+ pokeByteOff dst 0 (c :: Word8)+ pokeByteOff dst 1 w+ intersperse (plusPtr dst 2) (plusPtr src 1) (len-1) w++countOccBA :: ByteArray# -> Int -> Word8 -> IO Int+countOccBA ba len w = pure (go 0 0)+ where+ go !n !i@(I# i#)+ | i == len = n+ | W8# (indexWord8Array# ba i#) == w = go (n+1) (i+1)+ | otherwise = go n (i+1)++countOcc :: Ptr Word8 -> Int -> Word8 -> IO Int+countOcc p len w = go 0 0+ where+ go !n !i+ | i == len = pure n+ | otherwise = do+ c <- peekByteOff p i+ if c == w+ then go (n+1) (i+1)+ else go n (i+1)++-- | Haskell equivalent of C `sbs_elem_index`+elemIndex :: ByteArray# -> Word8 -> Int -> IO Int+elemIndex !ba !w !len = pure (go 0)+ where+ go !i@(I# i#)+ | i == len = -1+ | W8# (indexWord8Array# ba i#) == w = i+ | otherwise = go (i+1)++-- | Reverse n-bytes from the second pointer into the first+reverseBytes :: Ptr Word8 -> Ptr Word8 -> Int -> IO ()+reverseBytes !dst !src !n+ | n == 0 = pure ()+ | otherwise = reverse_bytes dst (plusPtr dst (n - 1)) src++-- | Note that reverse_bytes reverses at least one byte.+-- Then it loops if necessary until the destination buffer is full+reverse_bytes :: Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO ()+reverse_bytes orig_dst dst src = do+ c <- peekByteOff src 0+ pokeByteOff dst 0 (c :: Word8)+ if orig_dst == dst+ then pure ()+ else reverse_bytes orig_dst (plusPtr dst (-1)) (plusPtr src 1)+++findMaximum :: Ptr Word8 -> Int -> IO Word8+findMaximum !p !n = assert (n > 0) $ find_maximum minBound p (plusPtr p (n - 1))++find_maximum :: Word8 -> Ptr Word8 -> Ptr Word8 -> IO Word8+find_maximum !m !p !plast = do+ c <- peekByteOff p 0+ let !c' = if c > m then c else m+ if p == plast+ then pure c'+ else find_maximum c' (plusPtr p 1) plast++findMinimum :: Ptr Word8 -> Int -> IO Word8+findMinimum !p !n = assert (n > 0) $ find_minimum maxBound p (plusPtr p (n - 1))++find_minimum :: Word8 -> Ptr Word8 -> Ptr Word8 -> IO Word8+find_minimum !m !p !plast = do+ c <- peekByteOff p 0+ let !c' = if c < m then c else m+ if p == plast+ then pure c'+ else find_minimum c' (plusPtr p 1) plast+++quickSort :: Ptr Word8 -> Int -> IO ()+quickSort !p !n+ | n <= 0 = pure ()+ | otherwise = quick_sort p 0 (n - 1)++quick_sort :: Ptr Word8 -> Int -> Int -> IO ()+quick_sort !p !low !high+ | low >= high = pure ()+ | otherwise = do+ pivot_index <- partition p low high+ quick_sort p low (pivot_index-1)+ quick_sort p (pivot_index+1) high+++partition :: Ptr Word8 -> Int -> Int -> IO Int+partition !p !low !high = do+ -- choose the rightmost element as the pivot+ pivot <- peekByteOff p high :: IO Word8+ -- traverse through all elements.+ -- swap element smaller than pivot at index j with leftmost element at+ -- index i greater than pivot (can be itself if no greater element read yet)+ let go !i !j+ | j > high = pure (i-1)+ | otherwise = do+ jv <- peekByteOff p j+ if (jv <= pivot)+ then do+ when (i /= j) $ do+ -- swap values+ iv <- peekByteOff p i :: IO Word8+ pokeByteOff p j iv+ pokeByteOff p i jv+ go (i+1) (j+1)+ else+ go i (j+1)+ go low low++isValidUtf8BA :: ByteArray# -> Int -> IO Bool+isValidUtf8BA !ba !len' = isValidUtf8' (indexWord8Array# ba) len'++isValidUtf8 :: Ptr Word8 -> Int -> IO Bool+isValidUtf8 !(Ptr a) !len' = isValidUtf8' (indexWord8OffAddr# a) len'++isValidUtf8' :: (Int# -> Word8#) -> Int -> IO Bool+isValidUtf8' idx !len = go 0+ where+ indexWord8 (I# i) = W8# (idx i)++ indexIsCont :: Int -> Bool+ indexIsCont i =+ -- We use a signed comparison to avoid an extra comparison with 0x80,+ -- since _signed_ 0x80 is -128.+ let+ v :: Int8+ v = fromIntegral (indexWord8 i)+ in v <= (fromIntegral (0xBF :: Word8))++ go !i+ | i >= len = pure True -- done+ | otherwise = do+ let !b0 = indexWord8 i+ if | b0 <= 0x7F -> go (i+1) -- ASCII+ | b0 >= 0xC2 && b0 <= 0xDF -> go2 (i+1)+ | b0 >= 0xE0 && b0 <= 0xEF -> go3 (i+1) b0+ | otherwise -> go4 (i+1) b0++ go2 !i+ | i >= len = pure False+ | indexIsCont i+ = go (i+1)+ | otherwise+ = pure False++ go3 !i !b0+ | i >= len - 1 = pure False -- Be careful: i+1 might overflow!+ | indexIsCont i+ , indexIsCont (i+1)+ , b1 <- indexWord8 i+ , (b0 == 0xE0 && b1 >= 0xA0) -- E0, A0..BF, 80..BF+ || (b0 >= 0xE1 && b0 <= 0xEC) -- E1..EC, 80..BF, 80..BF+ || (b0 == 0xED && b1 <= 0x9F) -- ED, 80..9F, 80..BF+ || (b0 >= 0xEE && b0 <= 0xEF) -- EE..EF, 80..BF, 80..BF+ = go (i+2)+ | otherwise+ = pure False++ go4 !i !b0+ | i >= len - 2 = pure False -- Be careful: i+2 might overflow!+ | indexIsCont i+ , indexIsCont (i+1)+ , indexIsCont (i+2)+ , b1 <- indexWord8 i+ , (b0 == 0xF0 && b1 >= 0x90) -- F0, 90..BF, 80..BF, 80..BF+ || (b0 >= 0xF1 && b0 <= 0xF3) -- F1..F3, 80..BF, 80..BF, 80..BF+ || (b0 == 0xF4 && b1 <= 0x8F) -- F4, 80..8F, 80..BF, 80..BF+ = go (i+3)++ | otherwise+ = pure False+++----------------------------------------------------------------+-- Haskell versions of functions in itoa.c+----------------------------------------------------------------+++getDigit :: Int -> Word8+getDigit (I# i) = W8# (indexWord8OffAddr# digits i)+ where+ !digits = "0123456789abcdef"#++putDigit :: Ptr a -> Int -> Int -> IO ()+putDigit !addr !off !i = pokeByteOff addr off (getDigit i)++-- | Reverse bytes in the given memory range (inclusive)+reverseBytesInplace :: Ptr Word8 -> Ptr Word8 -> IO ()+reverseBytesInplace !p1 !p2+ | p1 < p2 = do+ c1 <- peekByteOff p1 0+ c2 <- peekByteOff p2 0+ pokeByteOff p1 0 (c2 :: Word8)+ pokeByteOff p2 0 (c1 :: Word8)+ reverseBytesInplace (plusPtr p1 1) (plusPtr p2 (-1))+ | otherwise = pure ()++-- | Encode signed number as decimal+encodeSignedDec :: (Eq a, Num a, Integral a) => a -> Ptr Word8 -> IO (Ptr Word8)+{-# INLINABLE encodeSignedDec #-} -- for specialization+encodeSignedDec !x !buf+ | x >= 0 = encodeUnsignedDec x buf+ | otherwise = do+ -- we cannot negate directly as 0 - (minBound :: Int) = minBound+ -- So we write the sign and the first digit.+ pokeByteOff buf 0 '-'+ let !(q,r) = quotRem x (-10)+ putDigit buf 1 (fromIntegral (abs r))+ case q of+ 0 -> pure (plusPtr buf 2)+ _ -> encodeUnsignedDec' q (plusPtr buf 1) (plusPtr buf 2)+++-- | Encode positive number as decimal+encodeUnsignedDec :: (Eq a, Num a, Integral a) => a -> Ptr Word8 -> IO (Ptr Word8)+{-# INLINABLE encodeUnsignedDec #-} -- for specialization+encodeUnsignedDec !v !next_ptr = encodeUnsignedDec' v next_ptr next_ptr++-- | Encode positive number as little-endian decimal, then reverse it.+--+-- Take two pointers (orig_ptr, next_ptr) to support already encoded digits+-- (e.g. used by encodeSignedDec to avoid overflows)+--+encodeUnsignedDec' :: (Eq a, Num a, Integral a) => a -> Ptr Word8 -> Ptr Word8 -> IO (Ptr Word8)+{-# INLINABLE encodeUnsignedDec' #-} -- for specialization+encodeUnsignedDec' !v !orig_ptr !next_ptr = do+ let !(q,r) = divMod v 10+ putDigit next_ptr 0 (fromIntegral r)+ case q of+ 0 -> do+ -- reverse written digits+ reverseBytesInplace orig_ptr next_ptr+ -- return pointer after our digits+ pure (plusPtr next_ptr 1)+ _ -> encodeUnsignedDec' q orig_ptr (plusPtr next_ptr 1)++encodeUnsignedDecPadded :: (Eq a, Num a, Integral a) => Int -> a -> Ptr Word8 -> IO ()+{-# INLINABLE encodeUnsignedDecPadded #-} -- for specialization+encodeUnsignedDecPadded !max_width !v !buf = assert (max_width > 0) $ do+ let !(q,r) = divMod v 10+ putDigit buf (max_width - 1) (fromIntegral r)+ case q of+ 0 -> do+ -- pad beginning+ let pad 0 = pure ()+ pad n = putDigit buf (n - 1) 0 >> pad (n - 1)+ pad (max_width - 1)+ _ -> encodeUnsignedDecPadded (max_width - 1) q buf++++-- | Encode positive number as hexadecimal+encodeUnsignedHex :: (Eq a, Num a, Integral a, Bits a) => a -> Ptr Word8 -> IO (Ptr Word8)+{-# INLINABLE encodeUnsignedHex #-} -- for specialization+encodeUnsignedHex !v !next_ptr = encodeUnsignedHex' v next_ptr next_ptr++-- | Encode positive number as little-endian hexdecimal, then reverse it.+--+-- Take two pointers (orig_ptr, next_ptr) to support already encoded digits+encodeUnsignedHex' :: (Eq a, Num a, Integral a, Bits a) => a -> Ptr Word8 -> Ptr Word8 -> IO (Ptr Word8)+{-# INLINABLE encodeUnsignedHex' #-} -- for specialization+encodeUnsignedHex' !v !orig_ptr !next_ptr = do+ -- (q,r) = divMod v 16, but faster+ let !q = v `shiftR` 4+ let !r = v .&. 0x0F+ putDigit next_ptr 0 (fromIntegral r)+ case q of+ 0 -> do+ -- reverse written digits+ reverseBytesInplace orig_ptr next_ptr+ -- return pointer after our digits+ pure (plusPtr next_ptr 1)+ _ -> encodeUnsignedHex' q orig_ptr (plusPtr next_ptr 1)+++lower_hex_table :: Ptr Word16+lower_hex_table = Ptr+ "000102030405060708090a0b0c0d0e0f\+ \101112131415161718191a1b1c1d1e1f\+ \202122232425262728292a2b2c2d2e2f\+ \303132333435363738393a3b3c3d3e3f\+ \404142434445464748494a4b4c4d4e4f\+ \505152535455565758595a5b5c5d5e5f\+ \606162636465666768696a6b6c6d6e6f\+ \707172737475767778797a7b7c7d7e7f\+ \808182838485868788898a8b8c8d8e8f\+ \909192939495969798999a9b9c9d9e9f\+ \a0a1a2a3a4a5a6a7a8a9aaabacadaeaf\+ \b0b1b2b3b4b5b6b7b8b9babbbcbdbebf\+ \c0c1c2c3c4c5c6c7c8c9cacbcccdcecf\+ \d0d1d2d3d4d5d6d7d8d9dadbdcdddedf\+ \e0e1e2e3e4e5e6e7e8e9eaebecedeeef\+ \f0f1f2f3f4f5f6f7f8f9fafbfcfdfeff"#++digit_pairs_table :: Ptr Word16+digit_pairs_table = Ptr+ "00010203040506070809\+ \10111213141516171819\+ \20212223242526272829\+ \30313233343536373839\+ \40414243444546474849\+ \50515253545556575859\+ \60616263646566676869\+ \70717273747576777879\+ \80818283848586878889\+ \90919293949596979899"#
+ Data/ByteString/Internal/Type.hs view
@@ -0,0 +1,1298 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE Unsafe #-}++{-# OPTIONS_HADDOCK not-home #-}++{-# LANGUAGE TemplateHaskellQuotes #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UnliftedFFITypes #-}+{-# LANGUAGE ViewPatterns #-}++#include "bytestring-cpp-macros.h"++-- |+-- Module : Data.ByteString.Internal.Type+-- Copyright : (c) Don Stewart 2006-2008+-- (c) Duncan Coutts 2006-2012+-- License : BSD-style+-- Maintainer : dons00@gmail.com, duncan@community.haskell.org+-- Stability : unstable+-- Portability : non-portable+--+-- The 'ByteString' type, its instances, and whatever related+-- utilities the bytestring developers see fit to use internally.+--+module Data.ByteString.Internal.Type (++ -- * The @ByteString@ type and representation+ ByteString+ ( BS+ , PS -- backwards compatibility shim+ ),++ StrictByteString,++ -- * Internal indexing+ findIndexOrLength,++ -- * Conversion with lists: packing and unpacking+ packBytes, packUptoLenBytes, unsafePackLenBytes,+ packChars, packUptoLenChars, unsafePackLenChars,+ unpackBytes, unpackAppendBytesLazy, unpackAppendBytesStrict,+ unpackChars, unpackAppendCharsLazy, unpackAppendCharsStrict,+ unsafePackAddress, unsafePackLenAddress,+ unsafePackLiteral, unsafePackLenLiteral,++ -- * Low level imperative construction+ empty,+ createFp,+ createFpUptoN,+ createFpUptoN',+ createFpAndTrim,+ createFpAndTrim',+ unsafeCreateFp,+ unsafeCreateFpUptoN,+ unsafeCreateFpUptoN',+ create,+ createUptoN,+ createUptoN',+ createAndTrim,+ createAndTrim',+ unsafeCreate,+ unsafeCreateUptoN,+ unsafeCreateUptoN',+ mallocByteString,++ -- * Conversion to and from ForeignPtrs+ mkDeferredByteString,+ fromForeignPtr,+ toForeignPtr,+ fromForeignPtr0,+ toForeignPtr0,++ -- * Utilities+ nullForeignPtr,+ peekFp,+ pokeFp,+ peekFpByteOff,+ pokeFpByteOff,+ minusForeignPtr,+ memcpyFp,+ deferForeignPtrAvailability,+ unsafeDupablePerformIO,+ SizeOverflowException,+ overflowError,+ checkedAdd,+ checkedMultiply,++ -- * Standard C Functions+ c_strlen,+ c_free_finalizer,++ memchr,+ memcmp,+ memcpy,+ memset,++ -- * cbits functions+ c_reverse,+ c_intersperse,+ c_maximum,+ c_minimum,+ c_count,+ c_count_ba,+ c_elem_index,+ c_sort,+ c_int_dec,+ c_int_dec_padded9,+ c_uint_dec,+ c_uint_hex,+ c_long_long_int_dec,+ c_long_long_int_dec_padded18,+ c_long_long_uint_dec,+ c_long_long_uint_hex,+ cIsValidUtf8BA,+ cIsValidUtf8BASafe,+ cIsValidUtf8,+ cIsValidUtf8Safe,++ -- * Chars+ w2c, c2w, isSpaceWord8, isSpaceChar8,++ -- * Deprecated and unmentionable+ accursedUnutterablePerformIO,++ -- * Exported compatibility shim+ plusForeignPtr,+ unsafeWithForeignPtr+ ) where++import Prelude hiding (concat, null)+import qualified Data.List as List++import Foreign.ForeignPtr (ForeignPtr, withForeignPtr)+import Foreign.Ptr+import Foreign.Storable (Storable(..))+import Foreign.C.Types+import Foreign.C.String (CString)+import Foreign.Marshal.Utils+import Foreign.Marshal.Alloc (finalizerFree)++#if PURE_HASKELL+import qualified Data.ByteString.Internal.Pure as Pure+import Data.Bits (toIntegralSized, Bits)+import Data.Maybe (fromMaybe)+import Control.Monad ((<$!>))+#endif++import Data.Semigroup (Semigroup (..))+import Data.List.NonEmpty (NonEmpty ((:|)))++import Control.DeepSeq (NFData(rnf))++import Data.String (IsString(..))++import Control.Exception (assert, throw, Exception)++import Data.Bits ((.&.))+import Data.Char (ord)+import Data.Word++import Data.Data (Data(..), mkConstr, mkNoRepType, Constr, DataType, Fixity(Prefix), constrIndex)++import GHC.Base (nullAddr#,realWorld#,unsafeChr,unpackCString#)+import GHC.Exts (IsList(..), Addr#, minusAddr#, ByteArray#, runRW#, lazy)++#if HS_timesInt2_PRIMOP_AVAILABLE+import GHC.Exts (timesInt2#)+#else+import GHC.Exts ( timesWord2#+ , or#+ , uncheckedShiftRL#+ , int2Word#+ , word2Int#+ )+import Data.Bits (finiteBitSize)+#endif++import GHC.IO (IO(IO))+import GHC.ForeignPtr (ForeignPtr(ForeignPtr)+#if !HS_cstringLength_AND_FinalPtr_AVAILABLE+ , newForeignPtr_+#endif+ , mallocPlainForeignPtrBytes)++import GHC.ForeignPtr (plusForeignPtr)++#if HS_cstringLength_AND_FinalPtr_AVAILABLE+import GHC.Exts (cstringLength#)+import GHC.ForeignPtr (ForeignPtrContents(FinalPtr))+#else+import GHC.Ptr (Ptr(..))+#endif++import GHC.Int (Int (..))++#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 !HS_unsafeWithForeignPtr_AVAILABLE+unsafeWithForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b+unsafeWithForeignPtr = withForeignPtr+#endif++-- CFILES stuff is Hugs only+{-# CFILES cbits/fpstring.c #-}++minusForeignPtr :: ForeignPtr a -> ForeignPtr b -> Int+minusForeignPtr (ForeignPtr addr1 _) (ForeignPtr addr2 _)+ = I# (minusAddr# addr1 addr2)++peekFp :: Storable a => ForeignPtr a -> IO a+peekFp fp = unsafeWithForeignPtr fp peek++pokeFp :: Storable a => ForeignPtr a -> a -> IO ()+pokeFp fp val = unsafeWithForeignPtr fp $ \p -> poke p val++peekFpByteOff :: Storable a => ForeignPtr a -> Int -> IO a+peekFpByteOff fp off = unsafeWithForeignPtr fp $ \p ->+ peekByteOff p off++pokeFpByteOff :: Storable a => ForeignPtr b -> Int -> a -> IO ()+pokeFpByteOff fp off val = unsafeWithForeignPtr fp $ \p ->+ pokeByteOff p off val++-- | 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+-- efficient operations.+--+-- A 'ByteString' contains 8-bit bytes, or by using the operations from+-- "Data.ByteString.Char8" it can be interpreted as containing 8-bit+-- characters.+--+data ByteString = BS {-# UNPACK #-} !(ForeignPtr Word8) -- payload+ {-# UNPACK #-} !Int -- length+ -- ^ @since 0.11.0.0++-- | Type synonym for the strict flavour of 'ByteString'.+--+-- @since 0.11.2.0+type StrictByteString = ByteString++-- |+-- @'PS' foreignPtr offset length@ represents a 'ByteString' with data+-- backed by a given @foreignPtr@, starting at a given @offset@ in bytes+-- and of a specified @length@.+--+-- This pattern is used to emulate the legacy 'ByteString' data+-- constructor, so that pre-existing code generally doesn't need to+-- change to benefit from the simplified 'BS' constructor and can+-- continue to function unchanged.+--+-- /Note:/ Matching with this constructor will always be given a 0 offset,+-- as the base will be manipulated by 'plusForeignPtr' instead.+--+pattern PS :: ForeignPtr Word8 -> Int -> Int -> ByteString+pattern PS fp zero len <- BS fp ((0,) -> (zero, len)) where+ PS fp o len = BS (plusForeignPtr fp o) len+{-# COMPLETE PS #-}++instance Eq ByteString where+ (==) = eq++instance Ord ByteString where+ compare = compareBytes++instance Semigroup ByteString where+ (<>) = append+ sconcat (b:|bs) = concat (b:bs)+ {-# INLINE stimes #-}+ stimes = stimesPolymorphic++instance Monoid ByteString where+ mempty = empty+ mappend = (<>)+ mconcat = concat++instance NFData ByteString where+ rnf BS{} = ()++instance Show ByteString where+ showsPrec p ps r = showsPrec p (unpackChars ps) r++instance Read ByteString where+ readsPrec p str = [ (packChars x, y) | (x, y) <- readsPrec p str ]++-- | @since 0.10.12.0+instance IsList ByteString where+ type Item ByteString = Word8+ fromList = packBytes+ toList = unpackBytes++-- | Beware: 'fromString' truncates multi-byte characters to octets.+-- e.g. "枯朶に烏のとまりけり秋の暮" becomes �6k�nh~�Q��n�+instance IsString ByteString where+ {-# INLINE fromString #-}+ fromString = packChars++instance Data ByteString where+ gfoldl f z txt = z packBytes `f` unpackBytes txt+ toConstr _ = packConstr+ gunfold k z c = case constrIndex c of+ 1 -> k (z packBytes)+ _ -> error "gunfold: unexpected constructor of strict ByteString"+ dataTypeOf _ = byteStringDataType++packConstr :: Constr+packConstr = mkConstr byteStringDataType "pack" [] Prefix++byteStringDataType :: DataType+byteStringDataType = mkNoRepType "Data.ByteString.ByteString"++-- | @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))+#else+ lift bs@(BS _ len) = [| unsafePackLenLiteral |]+ `TH.appE` TH.litE (TH.integerL (fromIntegral len))+ `TH.appE` TH.litE (TH.StringPrimL $ unpackBytes bs)+#endif++#if MIN_VERSION_template_haskell(2,17,0)+-- 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++------------------------------------------------------------------------+-- Internal indexing++-- | 'findIndexOrLength' is a variant of findIndex, that returns the length+-- of the string if no element is found, rather than Nothing.+findIndexOrLength :: (Word8 -> Bool) -> ByteString -> Int+findIndexOrLength k (BS x l) =+ accursedUnutterablePerformIO $ g x+ where+ g ptr = go 0+ where+ go !n | n >= l = return l+ | otherwise = do w <- peekFp $ ptr `plusForeignPtr` n+ if k w+ then return n+ else go (n+1)+{-# INLINE findIndexOrLength #-}++------------------------------------------------------------------------+-- Packing and unpacking from lists++packBytes :: [Word8] -> ByteString+packBytes ws = unsafePackLenBytes (List.length ws) ws++packChars :: [Char] -> ByteString+packChars cs = unsafePackLenChars (List.length cs) cs++{-# INLINE [0] packChars #-}++{-# RULES+"ByteString packChars/packAddress" forall s .+ packChars (unpackCString# s) = unsafePackLiteral s+ #-}++unsafePackLenBytes :: Int -> [Word8] -> ByteString+unsafePackLenBytes len xs0 =+ unsafeCreateFp len $ \p -> go p xs0+ where+ go !_ [] = return ()+ go !p (x:xs) = pokeFp p x >> go (p `plusForeignPtr` 1) xs++unsafePackLenChars :: Int -> [Char] -> ByteString+unsafePackLenChars len cs0 =+ unsafeCreateFp len $ \p -> go p cs0+ where+ go !_ [] = return ()+ go !p (c:cs) = pokeFp p (c2w c) >> go (p `plusForeignPtr` 1) cs+++-- | /O(n)/ Pack a null-terminated sequence of bytes, pointed to by an+-- Addr\# (an arbitrary machine address assumed to point outside the+-- garbage-collected heap) into a @ByteString@. A much faster way to+-- create an 'Addr#' is with an unboxed string literal, than to pack a+-- boxed string. A unboxed string literal is compiled to a static @char+-- []@ by GHC. Establishing the length of the string requires a call to+-- @strlen(3)@, so the 'Addr#' must point to a null-terminated buffer (as+-- is the case with @\"string\"\#@ literals in GHC). Use 'Data.ByteString.Unsafe.unsafePackAddressLen'+-- if you know the length of the string statically.+--+-- An example:+--+-- > literalFS = unsafePackAddress "literal"#+--+-- This function is /unsafe/. If you modify the buffer pointed to by the+-- original 'Addr#' this modification will be reflected in the resulting+-- @ByteString@, breaking referential transparency.+--+-- Note this also won't work if your 'Addr#' has embedded @\'\\0\'@ characters in+-- the string, as @strlen@ will return too short a length.+--+unsafePackAddress :: Addr# -> IO ByteString+unsafePackAddress addr# = do+#if HS_cstringLength_AND_FinalPtr_AVAILABLE+ unsafePackLenAddress (I# (cstringLength# addr#)) addr#+#else+ l <- c_strlen (Ptr addr#)+ unsafePackLenAddress (fromIntegral l) addr#+#endif+{-# INLINE unsafePackAddress #-}++-- | See 'unsafePackAddress'. This function is similar,+-- but takes an additional length argument rather then computing+-- it with @strlen@.+-- Therefore embedding @\'\\0\'@ characters is possible.+--+-- @since 0.11.2.0+unsafePackLenAddress :: Int -> Addr# -> IO ByteString+unsafePackLenAddress len addr# = do+#if HS_cstringLength_AND_FinalPtr_AVAILABLE+ return (BS (ForeignPtr addr# FinalPtr) len)+#else+ p <- newForeignPtr_ (Ptr addr#)+ return $ BS p len+#endif+{-# INLINE unsafePackLenAddress #-}++-- | See 'unsafePackAddress'. This function has similar behavior. Prefer+-- this function when the address in known to be an @Addr#@ literal. In+-- that context, there is no need for the sequencing guarantees that 'IO'+-- provides. On GHC 9.0 and up, this function uses the @FinalPtr@ data+-- constructor for @ForeignPtrContents@.+--+-- @since 0.11.1.0+unsafePackLiteral :: Addr# -> ByteString+unsafePackLiteral addr# =+#if HS_cstringLength_AND_FinalPtr_AVAILABLE+ unsafePackLenLiteral (I# (cstringLength# addr#)) addr#+#else+ let len = accursedUnutterablePerformIO (c_strlen (Ptr addr#))+ in unsafePackLenLiteral (fromIntegral len) addr#+#endif+{-# INLINE unsafePackLiteral #-}+++-- | See 'unsafePackLiteral'. This function is similar,+-- but takes an additional length argument rather then computing+-- it with @strlen@.+-- Therefore embedding @\'\\0\'@ characters is possible.+--+-- @since 0.11.2.0+unsafePackLenLiteral :: Int -> Addr# -> ByteString+unsafePackLenLiteral len addr# =+#if HS_cstringLength_AND_FinalPtr_AVAILABLE+ BS (ForeignPtr addr# FinalPtr) len+#else+ -- newForeignPtr_ allocates a MutVar# internally. If that MutVar#+ -- gets commoned up with the MutVar# of some unrelated ForeignPtr,+ -- it may prevent automatic finalization for that other ForeignPtr.+ -- So we avoid accursedUnutterablePerformIO here.+ BS (unsafeDupablePerformIO (newForeignPtr_ (Ptr addr#))) len+#endif+{-# INLINE unsafePackLenLiteral #-}++packUptoLenBytes :: Int -> [Word8] -> (ByteString, [Word8])+packUptoLenBytes len xs0 =+ unsafeCreateFpUptoN' len $ \p0 ->+ let p_end = plusForeignPtr p0 len+ go !p [] = return (p `minusForeignPtr` p0, [])+ go !p xs | p == p_end = return (len, xs)+ go !p (x:xs) = pokeFp p x >> go (p `plusForeignPtr` 1) xs+ in go p0 xs0++packUptoLenChars :: Int -> [Char] -> (ByteString, [Char])+packUptoLenChars len cs0 =+ unsafeCreateFpUptoN' len $ \p0 ->+ let p_end = plusForeignPtr p0 len+ go !p [] = return (p `minusForeignPtr` p0, [])+ go !p cs | p == p_end = return (len, cs)+ go !p (c:cs) = pokeFp p (c2w c) >> go (p `plusForeignPtr` 1) cs+ in go p0 cs0++-- Unpacking bytestrings into lists efficiently is a tradeoff: on the one hand+-- we would like to write a tight loop that just blasts the list into memory, on+-- the other hand we want it to be unpacked lazily so we don't end up with a+-- massive list data structure in memory.+--+-- Our strategy is to combine both: we will unpack lazily in reasonable sized+-- chunks, where each chunk is unpacked strictly.+--+-- unpackBytes and unpackChars do the lazy loop, while unpackAppendBytes and+-- unpackAppendChars do the chunks strictly.++unpackBytes :: ByteString -> [Word8]+unpackBytes bs = unpackAppendBytesLazy bs []++unpackChars :: ByteString -> [Char]+unpackChars bs = unpackAppendCharsLazy bs []++unpackAppendBytesLazy :: ByteString -> [Word8] -> [Word8]+unpackAppendBytesLazy (BS fp len) xs+ | len <= 100 = unpackAppendBytesStrict (BS fp len) xs+ | otherwise = unpackAppendBytesStrict (BS fp 100) remainder+ where+ remainder = unpackAppendBytesLazy (BS (plusForeignPtr fp 100) (len-100)) xs++ -- Why 100 bytes you ask? Because on a 64bit machine the list we allocate+ -- takes just shy of 4k which seems like a reasonable amount.+ -- (5 words per list element, 8 bytes per word, 100 elements = 4000 bytes)++unpackAppendCharsLazy :: ByteString -> [Char] -> [Char]+unpackAppendCharsLazy (BS fp len) cs+ | len <= 100 = unpackAppendCharsStrict (BS fp len) cs+ | otherwise = unpackAppendCharsStrict (BS fp 100) remainder+ where+ remainder = unpackAppendCharsLazy (BS (plusForeignPtr fp 100) (len-100)) cs++-- For these unpack functions, since we're unpacking the whole list strictly we+-- build up the result list in an accumulator. This means we have to build up+-- the list starting at the end. So our traversal starts at the end of the+-- buffer and loops down until we hit the sentinal:++unpackAppendBytesStrict :: ByteString -> [Word8] -> [Word8]+unpackAppendBytesStrict (BS fp len) xs =+ accursedUnutterablePerformIO $ unsafeWithForeignPtr fp $ \base ->+ loop (base `plusPtr` (-1)) (base `plusPtr` (-1+len)) xs+ where+ loop !sentinal !p acc+ | p == sentinal = return acc+ | otherwise = do x <- peek p+ loop sentinal (p `plusPtr` (-1)) (x:acc)++unpackAppendCharsStrict :: ByteString -> [Char] -> [Char]+unpackAppendCharsStrict (BS fp len) xs =+ accursedUnutterablePerformIO $ unsafeWithForeignPtr fp $ \base ->+ loop (base `plusPtr` (-1)) (base `plusPtr` (-1+len)) xs+ where+ loop !sentinal !p acc+ | p == sentinal = return acc+ | otherwise = do x <- peek p+ loop sentinal (p `plusPtr` (-1)) (w2c x:acc)++------------------------------------------------------------------------++-- | The 0 pointer. Used to indicate the empty Bytestring.+nullForeignPtr :: ForeignPtr Word8+#if HS_cstringLength_AND_FinalPtr_AVAILABLE+nullForeignPtr = ForeignPtr nullAddr# FinalPtr+#else+nullForeignPtr = ForeignPtr nullAddr# (error "nullForeignPtr")+#endif++-- ---------------------------------------------------------------------+-- Low level constructors++-- | /O(1)/ Build a ByteString from a ForeignPtr.+--+-- If you do not need the offset parameter then you should be using+-- 'Data.ByteString.Unsafe.unsafePackCStringLen' or+-- 'Data.ByteString.Unsafe.unsafePackCStringFinalizer' instead.+--+fromForeignPtr :: ForeignPtr Word8+ -> Int -- ^ Offset+ -> Int -- ^ Length+ -> ByteString+fromForeignPtr fp o = BS (plusForeignPtr fp o)+{-# INLINE fromForeignPtr #-}++-- | @since 0.11.0.0+fromForeignPtr0 :: ForeignPtr Word8+ -> Int -- ^ Length+ -> ByteString+fromForeignPtr0 = BS+{-# INLINE fromForeignPtr0 #-}++-- | /O(1)/ Deconstruct a ForeignPtr from a ByteString+toForeignPtr :: ByteString -> (ForeignPtr Word8, Int, Int) -- ^ (ptr, offset, length)+toForeignPtr (BS ps l) = (ps, 0, l)+{-# INLINE toForeignPtr #-}++-- | /O(1)/ Deconstruct a ForeignPtr from a ByteString+--+-- @since 0.11.0.0+toForeignPtr0 :: ByteString -> (ForeignPtr Word8, Int) -- ^ (ptr, length)+toForeignPtr0 (BS ps l) = (ps, l)+{-# INLINE toForeignPtr0 #-}++-- | A way of creating ByteStrings outside the IO monad. The @Int@+-- argument gives the final size of the ByteString.+unsafeCreateFp :: Int -> (ForeignPtr Word8 -> IO ()) -> ByteString+unsafeCreateFp l f = unsafeDupablePerformIO (createFp l f)+{-# INLINE unsafeCreateFp #-}++-- | Like 'unsafeCreateFp' but instead of giving the final size of the+-- ByteString, it is just an upper bound. The inner action returns+-- the actual size. Unlike 'createFpAndTrim' the ByteString is not+-- reallocated if the final size is less than the estimated size.+unsafeCreateFpUptoN :: Int -> (ForeignPtr Word8 -> IO Int) -> ByteString+unsafeCreateFpUptoN l f = unsafeDupablePerformIO (createFpUptoN l f)+{-# INLINE unsafeCreateFpUptoN #-}++unsafeCreateFpUptoN'+ :: Int -> (ForeignPtr Word8 -> IO (Int, a)) -> (ByteString, a)+unsafeCreateFpUptoN' l f = unsafeDupablePerformIO (createFpUptoN' l f)+{-# INLINE unsafeCreateFpUptoN' #-}++-- | Create ByteString of size @l@ and use action @f@ to fill its contents.+createFp :: Int -> (ForeignPtr Word8 -> IO ()) -> IO ByteString+createFp len action = assert (len >= 0) $ do+ fp <- mallocByteString len+ action fp+ mkDeferredByteString fp len+{-# INLINE createFp #-}++-- | Given a maximum size @l@ and an action @f@ that fills the 'ByteString'+-- starting at the given 'Ptr' and returns the actual utilized length,+-- @`createFpUptoN'` l f@ returns the filled 'ByteString'.+createFpUptoN :: Int -> (ForeignPtr Word8 -> IO Int) -> IO ByteString+createFpUptoN maxLen action = assert (maxLen >= 0) $ do+ fp <- mallocByteString maxLen+ len <- action fp+ assert (0 <= len && len <= maxLen) $ mkDeferredByteString fp len+{-# INLINE createFpUptoN #-}++-- | Like 'createFpUptoN', but also returns an additional value created by the+-- action.+createFpUptoN' :: Int -> (ForeignPtr Word8 -> IO (Int, a)) -> IO (ByteString, a)+createFpUptoN' maxLen action = assert (maxLen >= 0) $ do+ fp <- mallocByteString maxLen+ (len, res) <- action fp+ bs <- mkDeferredByteString fp len+ assert (0 <= len && len <= maxLen) $ pure (bs, res)+{-# INLINE createFpUptoN' #-}++-- | Given the maximum size needed and a function to make the contents+-- of a ByteString, createFpAndTrim makes the 'ByteString'. The generating+-- function is required to return the actual final size (<= the maximum+-- size), and the resulting byte array is reallocated to this size.+--+-- createFpAndTrim is the main mechanism for creating custom, efficient+-- ByteString functions, using Haskell or C functions to fill the space.+--+createFpAndTrim :: Int -> (ForeignPtr Word8 -> IO Int) -> IO ByteString+createFpAndTrim maxLen action = assert (maxLen >= 0) $ do+ fp <- mallocByteString maxLen+ len <- action fp+ if assert (0 <= len && len <= maxLen) $ len >= maxLen+ then mkDeferredByteString fp maxLen+ else createFp len $ \dest -> memcpyFp dest fp len+{-# INLINE createFpAndTrim #-}++createFpAndTrim' :: Int -> (ForeignPtr Word8 -> IO (Int, Int, a)) -> IO (ByteString, a)+createFpAndTrim' maxLen action = assert (maxLen >= 0) $ do+ fp <- mallocByteString maxLen+ (off, len, res) <- action fp+ assert (+ 0 <= len && len <= maxLen && -- length OK+ (len == 0 || (0 <= off && off <= maxLen - len)) -- offset OK+ ) $ pure ()+ bs <- if len >= maxLen+ then mkDeferredByteString fp maxLen -- entire buffer used => offset is zero+ else createFp len $ \dest ->+ memcpyFp dest (fp `plusForeignPtr` off) len+ return (bs, res)+{-# INLINE createFpAndTrim' #-}+++wrapAction :: (Ptr Word8 -> IO res) -> ForeignPtr Word8 -> IO res+wrapAction = flip withForeignPtr+ -- Cannot use unsafeWithForeignPtr, because action can diverge++-- | A way of creating ByteStrings outside the IO monad. The @Int@+-- argument gives the final size of the ByteString.+unsafeCreate :: Int -> (Ptr Word8 -> IO ()) -> ByteString+unsafeCreate l f = unsafeCreateFp l (wrapAction f)+{-# INLINE unsafeCreate #-}++-- | Like 'unsafeCreate' but instead of giving the final size of the+-- ByteString, it is just an upper bound. The inner action returns+-- the actual size. Unlike 'createAndTrim' the ByteString is not+-- reallocated if the final size is less than the estimated size.+unsafeCreateUptoN :: Int -> (Ptr Word8 -> IO Int) -> ByteString+unsafeCreateUptoN l f = unsafeCreateFpUptoN l (wrapAction f)+{-# INLINE unsafeCreateUptoN #-}++-- | @since 0.10.12.0+unsafeCreateUptoN' :: Int -> (Ptr Word8 -> IO (Int, a)) -> (ByteString, a)+unsafeCreateUptoN' l f = unsafeCreateFpUptoN' l (wrapAction f)+{-# INLINE unsafeCreateUptoN' #-}++-- | Create ByteString of size @l@ and use action @f@ to fill its contents.+create :: Int -> (Ptr Word8 -> IO ()) -> IO ByteString+create l action = createFp l (wrapAction action)+{-# INLINE create #-}++-- | Given a maximum size @l@ and an action @f@ that fills the 'ByteString'+-- starting at the given 'Ptr' and returns the actual utilized length,+-- @`createUptoN'` l f@ returns the filled 'ByteString'.+createUptoN :: Int -> (Ptr Word8 -> IO Int) -> IO ByteString+createUptoN l action = createFpUptoN l (wrapAction action)+{-# INLINE createUptoN #-}++-- | Like 'createUptoN', but also returns an additional value created by the+-- action.+--+-- @since 0.10.12.0+createUptoN' :: Int -> (Ptr Word8 -> IO (Int, a)) -> IO (ByteString, a)+createUptoN' l action = createFpUptoN' l (wrapAction action)+{-# INLINE createUptoN' #-}++-- | Given the maximum size needed and a function to make the contents+-- of a ByteString, createAndTrim makes the 'ByteString'. The generating+-- function is required to return the actual final size (<= the maximum+-- size), and the resulting byte array is reallocated to this size.+--+-- createAndTrim is the main mechanism for creating custom, efficient+-- ByteString functions, using Haskell or C functions to fill the space.+--+createAndTrim :: Int -> (Ptr Word8 -> IO Int) -> IO ByteString+createAndTrim l action = createFpAndTrim l (wrapAction action)+{-# INLINE createAndTrim #-}++createAndTrim' :: Int -> (Ptr Word8 -> IO (Int, Int, a)) -> IO (ByteString, a)+createAndTrim' l action = createFpAndTrim' l (wrapAction action)+{-# INLINE createAndTrim' #-}+++-- | Wrapper of 'Foreign.ForeignPtr.mallocForeignPtrBytes' with faster implementation for GHC+--+mallocByteString :: Int -> IO (ForeignPtr a)+mallocByteString = mallocPlainForeignPtrBytes+{-# INLINE mallocByteString #-}++------------------------------------------------------------------------+-- Implementations for Eq, Ord and Monoid instances++eq :: ByteString -> ByteString -> Bool+eq a@(BS fp len) b@(BS fp' len')+ | len /= len' = False -- short cut on length+ | fp == fp' = True -- short cut for the same string+ | otherwise = compareBytes a b == EQ+{-# INLINE eq #-}+-- ^ still needed++compareBytes :: ByteString -> ByteString -> Ordering+compareBytes (BS _ 0) (BS _ 0) = EQ -- short cut for empty strings+compareBytes (BS fp1 len1) (BS fp2 len2) =+ accursedUnutterablePerformIO $+ unsafeWithForeignPtr fp1 $ \p1 ->+ unsafeWithForeignPtr fp2 $ \p2 -> do+ i <- memcmp p1 p2 (min len1 len2)+ return $! case i `compare` 0 of+ EQ -> len1 `compare` len2+ x -> x+++-- | /O(1)/ The empty 'ByteString'+empty :: ByteString+-- This enables bypassing #457 by not using (polymorphic) mempty in+-- any definitions used by the (Monoid ByteString) instance+empty = BS nullForeignPtr 0++append :: ByteString -> ByteString -> ByteString+append (BS _ 0) b = b+append a (BS _ 0) = a+append (BS fp1 len1) (BS fp2 len2) =+ unsafeCreateFp (checkedAdd "append" len1 len2) $ \destptr1 -> do+ let destptr2 = destptr1 `plusForeignPtr` len1+ memcpyFp destptr1 fp1 len1+ memcpyFp destptr2 fp2 len2++concat :: [ByteString] -> ByteString+concat = \bss0 -> goLen0 bss0 bss0+ -- The idea here is we first do a pass over the input list to determine:+ --+ -- 1. is a copy necessary? e.g. @concat []@, @concat [mempty, "hello"]@,+ -- and @concat ["hello", mempty, mempty]@ can all be handled without+ -- copying.+ -- 2. if a copy is necessary, how large is the result going to be?+ --+ -- If a copy is necessary then we create a buffer of the appropriate size+ -- and do another pass over the input list, copying the chunks into the+ -- buffer. Also, since foreign calls aren't entirely free we skip over+ -- empty chunks while copying.+ --+ -- We pass the original [ByteString] (bss0) through as an argument through+ -- goLen0, goLen1, and goLen since we will need it again in goCopy. Passing+ -- it as an explicit argument avoids capturing it in these functions'+ -- closures which would result in unnecessary closure allocation.+ where+ -- It's still possible that the result is empty+ goLen0 _ [] = empty+ goLen0 bss0 (BS _ 0 :bss) = goLen0 bss0 bss+ goLen0 bss0 (bs :bss) = goLen1 bss0 bs bss++ -- It's still possible that the result is a single chunk+ goLen1 _ bs [] = bs+ goLen1 bss0 bs (BS _ 0 :bss) = goLen1 bss0 bs bss+ goLen1 bss0 bs (BS _ len:bss) = goLen bss0 (checkedAdd "concat" len' len) bss+ where BS _ len' = bs++ -- General case, just find the total length we'll need+ goLen bss0 !total (BS _ len:bss) = goLen bss0 total' bss+ where total' = checkedAdd "concat" total len+ goLen bss0 total [] =+ unsafeCreateFp total $ \ptr -> goCopy bss0 ptr++ -- Copy the data+ goCopy [] !_ = return ()+ goCopy (BS _ 0 :bss) !ptr = goCopy bss ptr+ goCopy (BS fp len:bss) !ptr = do+ memcpyFp ptr fp len+ goCopy bss (ptr `plusForeignPtr` len)+{-# NOINLINE concat #-}++{-# RULES+"ByteString concat [] -> empty"+ concat [] = empty+"ByteString concat [bs] -> bs" forall x.+ concat [x] = x+ #-}++-- | Repeats the given ByteString n times.+-- Polymorphic wrapper to make sure any generated+-- specializations are reasonably small.+stimesPolymorphic :: Integral a => a -> ByteString -> ByteString+{-# INLINABLE stimesPolymorphic #-}+stimesPolymorphic nRaw !bs = case checkedIntegerToInt n of+ Just nInt+ | nInt >= 0 -> stimesNonNegativeInt nInt bs+ | otherwise -> stimesNegativeErr+ Nothing+ | n < 0 -> stimesNegativeErr+ | BS _ 0 <- bs -> empty+ | otherwise -> stimesOverflowErr+ where n = toInteger nRaw+ -- By exclusively using n instead of nRaw, the semantics are kept simple+ -- and the likelihood of potentially dangerous mistakes minimized.+++{-+Note [Float error calls out of INLINABLE things]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~++If a function is marked INLINE or INLINABLE, then when ghc inlines or+specializes it, it duplicates the function body exactly as written.++This feature is useful for systems of rewrite rules, but sometimes+comes at a code-size cost. One situation where this cost generally+comes with no compensating up-side is when the function in question+calls `error` or something similar.++Such an `error` call is not meaningfully improved by the extra context+inlining or specialization provides, and if inlining or specialization+happens in a different module from where the function was originally+defined, CSE will not be able to de-duplicate the error call floated+out of the inlined RHS and the error call floated out of the original+RHS. See also https://gitlab.haskell.org/ghc/ghc/-/issues/23823++To mitigate this, we manually float the error calls out of INLINABLE+functions when it is possible to do so.+-}++stimesNegativeErr :: ByteString+-- See Note [Float error calls out of INLINABLE things]+stimesNegativeErr+ = errorWithoutStackTrace "stimes @ByteString: non-negative multiplier expected"++stimesOverflowErr :: ByteString+-- See Note [Float error calls out of INLINABLE things]+stimesOverflowErr = overflowError "stimes"++-- | Repeats the given ByteString n times.+stimesNonNegativeInt :: Int -> ByteString -> ByteString+stimesNonNegativeInt n (BS fp len)+ | n == 0 = empty+ | n == 1 = BS fp len+ | len == 0 = empty+ | len == 1 = unsafeCreateFp n $ \destfptr -> do+ byte <- peekFp fp+ unsafeWithForeignPtr destfptr $ \destptr ->+ fillBytes destptr byte n+ | otherwise = unsafeCreateFp size $ \destptr -> do+ memcpyFp destptr fp len+ fillFrom destptr len+ where+ size = checkedMultiply "stimes" n len+ halfSize = (size - 1) `div` 2 -- subtraction and division won't overflow++ fillFrom :: ForeignPtr Word8 -> Int -> IO ()+ fillFrom destptr copied+ | copied <= halfSize = do+ memcpyFp (destptr `plusForeignPtr` copied) destptr copied+ fillFrom destptr (copied * 2)+ | otherwise = memcpyFp (destptr `plusForeignPtr` copied) destptr (size - copied)+++------------------------------------------------------------------------++-- | Conversion between 'Word8' and 'Char'. Should compile to a no-op.+w2c :: Word8 -> Char+w2c = unsafeChr . fromIntegral+{-# INLINE w2c #-}++-- | Unsafe conversion between 'Char' and 'Word8'. This is a no-op and+-- silently truncates to 8 bits Chars > '\255'. It is provided as+-- convenience for ByteString construction.+c2w :: Char -> Word8+c2w = fromIntegral . ord+{-# INLINE c2w #-}++-- | Selects words corresponding to white-space characters in the Latin-1 range+isSpaceWord8 :: Word8 -> Bool+isSpaceWord8 w8 =+ -- Avoid the cost of narrowing arithmetic results to Word8,+ -- the conversion from Word8 to Word is free.+ let w :: Word+ !w = fromIntegral w8+ in w .&. 0x50 == 0 -- Quick non-whitespace filter+ && w - 0x21 > 0x7e -- Second non-whitespace filter+ && ( w == 0x20 -- SP+ || w == 0xa0 -- NBSP+ || w - 0x09 < 5) -- HT, NL, VT, FF, CR+{-# INLINE isSpaceWord8 #-}++-- | Selects white-space characters in the Latin-1 range+isSpaceChar8 :: Char -> Bool+isSpaceChar8 = isSpaceWord8 . c2w+{-# INLINE isSpaceChar8 #-}++------------------------------------------------------------------------++-- | The type of exception raised by 'overflowError'+-- and on failure by overflow-checked arithmetic operations.+newtype SizeOverflowException+ = SizeOverflowException String++instance Show SizeOverflowException where+ show (SizeOverflowException err) = err++instance Exception SizeOverflowException++-- | Raises a 'SizeOverflowException',+-- with a message using the given function name.+overflowError :: String -> a+overflowError fun = throw $ SizeOverflowException msg+ where msg = "Data.ByteString." ++ fun ++ ": size overflow"++-- | Add two non-negative numbers.+-- Calls 'overflowError' on overflow.+checkedAdd :: String -> Int -> Int -> Int+{-# INLINE checkedAdd #-}+checkedAdd fun x y+ -- checking "r < 0" here matches the condition in mallocPlainForeignPtrBytes,+ -- helping the compiler see the latter is redundant in some places+ | r < 0 = overflowError fun+ | otherwise = r+ where r = assert (min x y >= 0) $ x + y++-- | Multiplies two non-negative numbers.+-- Calls 'overflowError' on overflow.+checkedMultiply :: String -> Int -> Int -> Int+{-# INLINE checkedMultiply #-}+checkedMultiply fun !x@(I# x#) !y@(I# y#) = assert (min x y >= 0) $+#if HS_timesInt2_PRIMOP_AVAILABLE+ case timesInt2# x# y# of+ (# 0#, _, result #) -> I# result+ _ -> overflowError fun+#else+ case timesWord2# (int2Word# x#) (int2Word# y#) of+ (# hi, lo #) -> case or# hi (uncheckedShiftRL# lo shiftAmt) of+ 0## -> I# (word2Int# lo)+ _ -> overflowError fun+ where !(I# shiftAmt) = finiteBitSize (0 :: Word) - 1+#endif+++-- | Attempts to convert an 'Integer' value to an 'Int', returning+-- 'Nothing' if doing so would result in an overflow.+checkedIntegerToInt :: Integer -> Maybe Int+{-# INLINE checkedIntegerToInt #-}+-- We could use Data.Bits.toIntegralSized, but this hand-rolled+-- version is currently a bit faster as of GHC 9.2.+-- It's even faster to just match on the Integer constructors, but+-- we'd still need a fallback implementation for integer-simple.+checkedIntegerToInt x+ | x == toInteger res = Just res+ | otherwise = Nothing+ where res = fromInteger x :: Int+++------------------------------------------------------------------------++-- | This \"function\" has a superficial similarity to 'System.IO.Unsafe.unsafePerformIO' but+-- it is in fact a malevolent agent of chaos. It unpicks the seams of reality+-- (and the 'IO' monad) so that the normal rules no longer apply. It lulls you+-- into thinking it is reasonable, but when you are not looking it stabs you+-- in the back and aliases all of your mutable buffers. The carcass of many a+-- seasoned Haskell programmer lie strewn at its feet.+--+-- Witness the trail of destruction:+--+-- * <https://github.com/haskell/bytestring/commit/71c4b438c675aa360c79d79acc9a491e7bbc26e7>+--+-- * <https://github.com/haskell/bytestring/commit/210c656390ae617d9ee3b8bcff5c88dd17cef8da>+--+-- * <https://github.com/haskell/aeson/commit/720b857e2e0acf2edc4f5512f2b217a89449a89d>+--+-- * <https://ghc.haskell.org/trac/ghc/ticket/3486>+--+-- * <https://ghc.haskell.org/trac/ghc/ticket/3487>+--+-- * <https://ghc.haskell.org/trac/ghc/ticket/7270>+--+-- * <https://gitlab.haskell.org/ghc/ghc/-/issues/22204>+--+-- Do not talk about \"safe\"! You do not know what is safe!+--+-- Yield not to its blasphemous call! Flee traveller! Flee or you will be+-- corrupted and devoured!+--+{-# INLINE accursedUnutterablePerformIO #-}+accursedUnutterablePerformIO :: IO a -> a+accursedUnutterablePerformIO (IO m) = case m realWorld# of (# _, r #) -> r++-- ---------------------------------------------------------------------+--+-- Standard C functions+--++memchr :: Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8)+memcmp :: Ptr Word8 -> Ptr Word8 -> Int -> IO CInt+{-# DEPRECATED memset "Use Foreign.Marshal.Utils.fillBytes instead" #-}+-- | deprecated since @bytestring-0.11.5.0@+memset :: Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8)++#if !PURE_HASKELL++foreign import ccall unsafe "string.h strlen" c_strlen+ :: CString -> IO CSize++foreign import ccall unsafe "string.h memchr" c_memchr+ :: Ptr Word8 -> CInt -> CSize -> IO (Ptr Word8)+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+memcmp p q s = c_memcmp p q (fromIntegral s)++foreign import ccall unsafe "string.h memset" c_memset+ :: Ptr Word8 -> CInt -> CSize -> IO (Ptr Word8)+memset p w sz = c_memset p (fromIntegral w) sz++#else++c_strlen :: CString -> IO CSize+c_strlen p = checkedCast <$!> Pure.strlen (castPtr p)++memchr p w len = Pure.memchr p w (checkedCast len)++memcmp p q s = checkedCast <$!> Pure.memcmp p q s++memset p w len = p <$ fillBytes p w (checkedCast len)++#endif++{-# DEPRECATED memcpy "Use Foreign.Marshal.Utils.copyBytes instead" #-}+-- | deprecated since @bytestring-0.11.5.0@+memcpy :: Ptr Word8 -> Ptr Word8 -> Int -> IO ()+memcpy = copyBytes++memcpyFp :: ForeignPtr Word8 -> ForeignPtr Word8 -> Int -> IO ()+memcpyFp fp fq s = unsafeWithForeignPtr fp $ \p ->+ unsafeWithForeignPtr fq $ \q -> copyBytes p q s++c_free_finalizer :: FunPtr (Ptr Word8 -> IO ())+c_free_finalizer = finalizerFree++++-- ---------------------------------------------------------------------+--+-- Uses our C code+--++#if !PURE_HASKELL++foreign import ccall unsafe "static fpstring.h fps_reverse" c_reverse+ :: Ptr Word8 -> Ptr Word8 -> CSize -> IO ()++foreign import ccall unsafe "static fpstring.h fps_intersperse" c_intersperse+ :: Ptr Word8 -> Ptr Word8 -> CSize -> Word8 -> IO ()++foreign import ccall unsafe "static fpstring.h fps_maximum" c_maximum+ :: Ptr Word8 -> CSize -> IO Word8++foreign import ccall unsafe "static fpstring.h fps_minimum" c_minimum+ :: Ptr Word8 -> CSize -> IO Word8++foreign import ccall unsafe "static fpstring.h fps_count" c_count+ :: Ptr Word8 -> CSize -> Word8 -> IO CSize++-- fps_count works with both pointers and ByteArray#+foreign import ccall unsafe "static fpstring.h fps_count" c_count_ba+ :: ByteArray# -> CSize -> Word8 -> IO CSize++foreign import ccall unsafe "static fpstring.h fps_sort" c_sort+ :: Ptr Word8 -> CSize -> IO ()++foreign import ccall unsafe "static sbs_elem_index"+ c_elem_index :: ByteArray# -> Word8 -> CSize -> IO CPtrdiff++++foreign import ccall unsafe "static _hs_bytestring_uint_dec" c_uint_dec+ :: CUInt -> Ptr Word8 -> IO (Ptr Word8)++foreign import ccall unsafe "static _hs_bytestring_long_long_uint_dec" c_long_long_uint_dec+ :: CULLong -> Ptr Word8 -> IO (Ptr Word8)++foreign import ccall unsafe "static _hs_bytestring_int_dec" c_int_dec+ :: CInt -> Ptr Word8 -> IO (Ptr Word8)++foreign import ccall unsafe "static _hs_bytestring_long_long_int_dec" c_long_long_int_dec+ :: CLLong -> Ptr Word8 -> IO (Ptr Word8)++foreign import ccall unsafe "static _hs_bytestring_uint_hex" c_uint_hex+ :: CUInt -> Ptr Word8 -> IO (Ptr Word8)++foreign import ccall unsafe "static _hs_bytestring_long_long_uint_hex" c_long_long_uint_hex+ :: CULLong -> Ptr Word8 -> IO (Ptr Word8)++foreign import ccall unsafe "static _hs_bytestring_int_dec_padded9"+ c_int_dec_padded9 :: CInt -> Ptr Word8 -> IO ()++foreign import ccall unsafe "static _hs_bytestring_long_long_int_dec_padded18"+ c_long_long_int_dec_padded18 :: CLLong -> Ptr Word8 -> IO ()++-- We import bytestring_is_valid_utf8 both unsafe and safe. For small inputs+-- we can use the unsafe version to get a bit more performance, but for large+-- inputs the safe version should be used to avoid GC synchronization pauses+-- in multithreaded contexts.++foreign import ccall unsafe "bytestring_is_valid_utf8" cIsValidUtf8BA+ :: ByteArray# -> CSize -> IO CInt++foreign import ccall safe "bytestring_is_valid_utf8" cIsValidUtf8BASafe+ :: ByteArray# -> CSize -> IO CInt++foreign import ccall unsafe "bytestring_is_valid_utf8" cIsValidUtf8+ :: Ptr Word8 -> CSize -> IO CInt++foreign import ccall safe "bytestring_is_valid_utf8" cIsValidUtf8Safe+ :: Ptr Word8 -> CSize -> IO CInt+++#else++----------------------------------------------------------------+-- Haskell version of functions in fpstring.c+----------------------------------------------------------------++-- | Reverse n-bytes from the second pointer into the first+c_reverse :: Ptr Word8 -> Ptr Word8 -> CSize -> IO ()+c_reverse p1 p2 sz = Pure.reverseBytes p1 p2 (checkedCast sz)++-- | find maximum char in a packed string+c_maximum :: Ptr Word8 -> CSize -> IO Word8+c_maximum ptr sz = Pure.findMaximum ptr (checkedCast sz)++-- | find minimum char in a packed string+c_minimum :: Ptr Word8 -> CSize -> IO Word8+c_minimum ptr sz = Pure.findMinimum ptr (checkedCast sz)++-- | count the number of occurrences of a char in a string+c_count :: Ptr Word8 -> CSize -> Word8 -> IO CSize+c_count ptr sz c = checkedCast <$!> Pure.countOcc ptr (checkedCast sz) c++-- | count the number of occurrences of a char in a string+c_count_ba :: ByteArray# -> Int -> Word8 -> IO CSize+c_count_ba ba o c = checkedCast <$!> Pure.countOccBA ba o c++-- | duplicate a string, interspersing the character through the elements of the+-- duplicated string+c_intersperse :: Ptr Word8 -> Ptr Word8 -> CSize -> Word8 -> IO ()+c_intersperse p1 p2 sz e = Pure.intersperse p1 p2 (checkedCast sz) e++-- | Quick sort bytes+c_sort :: Ptr Word8 -> CSize -> IO ()+c_sort ptr sz = Pure.quickSort ptr (checkedCast sz)++c_elem_index :: ByteArray# -> Word8 -> CSize -> IO CPtrdiff+c_elem_index ba e sz = checkedCast <$!> Pure.elemIndex ba e (checkedCast sz)++cIsValidUtf8BA :: ByteArray# -> CSize -> IO CInt+cIsValidUtf8BA ba sz = bool_to_cint <$> Pure.isValidUtf8BA ba (checkedCast sz)++cIsValidUtf8 :: Ptr Word8 -> CSize -> IO CInt+cIsValidUtf8 ptr sz = bool_to_cint <$> Pure.isValidUtf8 ptr (checkedCast sz)++-- Pure module is compiled with `-fno-omit-yields` so it's always safe (it won't+-- block on large inputs)++cIsValidUtf8BASafe :: ByteArray# -> CSize -> IO CInt+cIsValidUtf8BASafe = cIsValidUtf8BA++cIsValidUtf8Safe :: Ptr Word8 -> CSize -> IO CInt+cIsValidUtf8Safe = cIsValidUtf8++bool_to_cint :: Bool -> CInt+bool_to_cint True = 1+bool_to_cint False = 0++checkedCast :: (Bits a, Bits b, Integral a, Integral b) => a -> b+checkedCast x =+ fromMaybe (errorWithoutStackTrace "checkedCast: overflow")+ (toIntegralSized x)++----------------------------------------------------------------+-- Haskell version of functions in itoa.c+----------------------------------------------------------------++c_int_dec :: CInt -> Ptr Word8 -> IO (Ptr Word8)+c_int_dec = Pure.encodeSignedDec++c_long_long_int_dec :: CLLong -> Ptr Word8 -> IO (Ptr Word8)+c_long_long_int_dec = Pure.encodeSignedDec++c_uint_dec :: CUInt -> Ptr Word8 -> IO (Ptr Word8)+c_uint_dec = Pure.encodeUnsignedDec++c_long_long_uint_dec :: CULLong -> Ptr Word8 -> IO (Ptr Word8)+c_long_long_uint_dec = Pure.encodeUnsignedDec++c_uint_hex :: CUInt -> Ptr Word8 -> IO (Ptr Word8)+c_uint_hex = Pure.encodeUnsignedHex++c_long_long_uint_hex :: CULLong -> Ptr Word8 -> IO (Ptr Word8)+c_long_long_uint_hex = Pure.encodeUnsignedHex++c_int_dec_padded9 :: CInt -> Ptr Word8 -> IO ()+c_int_dec_padded9 = Pure.encodeUnsignedDecPadded 9++c_long_long_int_dec_padded18 :: CLLong -> Ptr Word8 -> IO ()+c_long_long_int_dec_padded18 = Pure.encodeUnsignedDecPadded 18++#endif
Data/ByteString/Lazy.hs view
@@ -1,8 +1,7 @@-{-# LANGUAGE BangPatterns #-}-{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}-{-# OPTIONS_HADDOCK prune #-} {-# LANGUAGE Trustworthy #-} +{-# OPTIONS_HADDOCK prune #-}+ -- | -- Module : Data.ByteString.Lazy -- Copyright : (c) Don Stewart 2006@@ -145,6 +144,8 @@ groupBy, inits, tails,+ initsNE,+ tailsNE, stripPrefix, stripSuffix, @@ -221,21 +222,23 @@ ) 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) import qualified Data.List as List+import qualified Data.List.NonEmpty as NE+import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.Bifunctor as BF import qualified Data.ByteString as P (ByteString) -- type name only import qualified Data.ByteString as S -- S for strict (hmm...)-import qualified Data.ByteString.Internal as S+import qualified Data.ByteString.Internal.Type as S import qualified Data.ByteString.Unsafe as S-import qualified Data.ByteString.Lazy.Internal.Deque as D import Data.ByteString.Lazy.Internal +import Control.Exception (assert) import Control.Monad (mplus) import Data.Word (Word8) import Data.Int (Int64)@@ -270,12 +273,12 @@ unpack :: ByteString -> [Word8] unpack = unpackBytes --- | /O(c)/ Convert a list of strict 'ByteString' into a lazy 'ByteString'-fromChunks :: [P.ByteString] -> ByteString+-- | /O(c)/ Convert a list of 'S.StrictByteString' into a 'LazyByteString'+fromChunks :: [S.StrictByteString] -> LazyByteString fromChunks = List.foldr chunk Empty --- | /O(c)/ Convert a lazy 'ByteString' into a list of strict 'ByteString'-toChunks :: ByteString -> [P.ByteString]+-- | /O(c)/ Convert a 'LazyByteString' into a list of 'S.StrictByteString'+toChunks :: LazyByteString -> [S.StrictByteString] toChunks = foldrChunks (:) [] ------------------------------------------------------------------------@@ -342,22 +345,30 @@ {-# INLINE snoc #-} -- | /O(1)/ Extract the first element of a ByteString, which must be non-empty.+--+-- This is a partial function, consider using 'uncons' instead. head :: HasCallStack => ByteString -> Word8 head Empty = errorEmptyList "head" head (Chunk c _) = S.unsafeHead c {-# INLINE head #-} --- | /O(1)/ Extract the head and tail of a ByteString, returning Nothing+-- | /O(1)/ Extract the 'head' and 'tail' of a ByteString, returning 'Nothing' -- if it is empty. uncons :: ByteString -> Maybe (Word8, ByteString) uncons Empty = Nothing-uncons (Chunk c cs)- = Just (S.unsafeHead c,- if S.length c == 1 then cs else Chunk (S.unsafeTail c) cs)+uncons (Chunk c cs) = case S.length c of+ -- Don't move this test inside of the Just or (,).+ -- We don't want to allocate a thunk to put inside of the tuple!+ -- And if "let !tl = ... in Just (..., tl)" seems more appealing,+ -- remember that this function must remain lazy in cs.+ 1 -> Just (S.unsafeHead c, cs)+ _ -> Just (S.unsafeHead c, Chunk (S.unsafeTail c) cs) {-# INLINE uncons #-} -- | /O(1)/ Extract the elements after the head of a ByteString, which must be -- non-empty.+--+-- This is a partial function, consider using 'uncons' instead. tail :: HasCallStack => ByteString -> ByteString tail Empty = errorEmptyList "tail" tail (Chunk c cs)@@ -367,6 +378,8 @@ -- | /O(n\/c)/ Extract the last element of a ByteString, which must be finite -- and non-empty.+--+-- This is a partial function, consider using 'unsnoc' instead. last :: HasCallStack => ByteString -> Word8 last Empty = errorEmptyList "last" last (Chunk c0 cs0) = go c0 cs0@@ -374,7 +387,9 @@ go _ (Chunk c cs) = go c cs -- XXX Don't inline this. Something breaks with 6.8.2 (haven't investigated yet) --- | /O(n\/c)/ Return all the elements of a 'ByteString' except the last one.+-- | /O(n\/c)/ Returns all the elements of a 'ByteString' except the last one.+--+-- This is a partial function, consider using 'unsnoc' instead. init :: HasCallStack => ByteString -> ByteString init Empty = errorEmptyList "init" init (Chunk c0 cs0) = go c0 cs0@@ -382,7 +397,7 @@ | otherwise = Chunk (S.unsafeInit c) Empty go c (Chunk c' cs) = Chunk c (go c' cs) --- | /O(n\/c)/ Extract the 'init' and 'last' of a ByteString, returning Nothing+-- | /O(n\/c)/ Extract the 'init' and 'last' of a ByteString, returning 'Nothing' -- if it is empty. -- -- * It is no faster than using 'init' and 'last'@@ -426,9 +441,11 @@ (foldrChunks (Chunk . intersperse') Empty cs) where intersperse' :: P.ByteString -> P.ByteString intersperse' (S.BS fp l) =- S.unsafeCreate (2*l) $ \p' -> S.unsafeWithForeignPtr fp $ \p -> do- poke p' w- S.c_intersperse (p' `plusPtr` 1) p (fromIntegral l) w+ S.unsafeCreateFp (2*l) $ \fp' ->+ S.unsafeWithForeignPtr fp' $ \p' ->+ S.unsafeWithForeignPtr fp $ \p -> do+ poke p' w+ S.c_intersperse (p' `plusPtr` 1) p (fromIntegral l) w -- | The 'transpose' function transposes the rows and columns of its -- 'ByteString' argument.@@ -477,12 +494,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@@ -762,18 +789,78 @@ -- -- @since 0.11.2.0 takeEnd :: Int64 -> ByteString -> ByteString-takeEnd i _ | i <= 0 = Empty-takeEnd i cs0 = takeEnd' i cs0- where takeEnd' 0 _ = Empty- takeEnd' n cs =- snd $ foldrChunks takeTuple (n,Empty) cs- takeTuple _ (0, cs) = (0, cs)- takeTuple c (n, cs)- | n > fromIntegral (S.length c) = (n - fromIntegral (S.length c), Chunk c cs)- | otherwise = (0, Chunk (S.takeEnd (fromIntegral n) c) cs)+takeEnd i bs+ | i <= 0 = Empty+ | otherwise = splitAtEndFold (\_ res -> res) id i bs +-- | Helper function for implementing 'takeEnd' and 'dropEnd'+splitAtEndFold+ :: forall result+ . (S.StrictByteString -> result -> result)+ -- ^ What to do when one chunk of output is ready+ -- (The StrictByteString will not be empty.)+ -> (ByteString -> result)+ -- ^ What to do when the split-point is reached+ -> Int64+ -- ^ Number of bytes to leave at the end (must be strictly positive)+ -> ByteString -- ^ Input ByteString+ -> result+{-# INLINE splitAtEndFold #-}+splitAtEndFold step end len bs0 = assert (len > 0) $ case bs0 of+ Empty -> end Empty+ Chunk c t -> goR len c t t+ where+ -- Idea: Keep two references into the input ByteString:+ -- "toSplit" tracks the current split point,+ -- "toScan" tracks the yet-unprocessed tail.+ -- When they are closer than "len" bytes apart, process more input. ("goR")+ -- When they are at least "len" bytes apart, produce more output. ("goL")+ -- We always have that "toScan" is a suffix of "toSplit",+ -- and "toSplit" is a suffix of the original input (bs0).+ goR :: Int64 -> S.StrictByteString -> ByteString -> ByteString -> result+ goR !undershoot nextOutput@(S.BS noFp noLen) toSplit toScan =+ assert (undershoot > 0) $+ -- INVARIANT: length toSplit == length toScan + len - undershoot+ -- (not 'assert'ed because that would break our laziness properties)+ case toScan of+ Empty+ | undershoot >= intToInt64 noLen+ -> end (Chunk nextOutput toSplit)+ | undershootW <- fromIntegral @Int64 @Int undershoot+ -- conversion Int64->Int is OK because 0 < undershoot < noLen+ , splitIndex <- noLen - undershootW+ , beforeSplit <- S.BS noFp splitIndex+ , afterSplit <- S.BS (noFp `S.plusForeignPtr` splitIndex) undershootW+ -> step beforeSplit $ end (Chunk afterSplit toSplit)++ Chunk (S.BS _ cLen) newBsR+ | cLen64 <- intToInt64 cLen+ , undershoot > cLen64+ -> goR (undershoot - cLen64) nextOutput toSplit newBsR+ | undershootW <- fromIntegral @Int64 @Int undershoot+ -> step nextOutput $ goL (cLen - undershootW) toSplit newBsR++ goL :: Int -> ByteString -> ByteString -> result+ goL !overshoot toSplit toScan =+ assert (overshoot >= 0) $+ -- INVARIANT: length toSplit == length toScan + len + intToInt64 overshoot+ -- (not 'assert'ed because that would break our laziness properties)+ case toSplit of+ Empty -> splitAtEndFoldInvariantFailed+ Chunk c@(S.BS _ cLen) newBsL+ | overshoot >= cLen+ -> step c $ goL (overshoot - cLen) newBsL toScan+ | otherwise+ -> goR (intToInt64 $ cLen - overshoot) c newBsL toScan++splitAtEndFoldInvariantFailed :: a+-- See Note [Float error calls out of INLINABLE things] in D.B.Internal.Type+splitAtEndFoldInvariantFailed =+ moduleError "splitAtEndFold"+ "internal error: toSplit not longer than toScan"+ -- | /O(n\/c)/ 'drop' @n xs@ returns the suffix of @xs@ after the first @n@--- elements, or @[]@ if @n > 'length' xs@.+-- elements, or 'empty' if @n > 'length' xs@. drop :: Int64 -> ByteString -> ByteString drop i p | i <= 0 = p drop i cs0 = drop' i cs0@@ -796,44 +883,9 @@ -- -- @since 0.11.2.0 dropEnd :: Int64 -> ByteString -> ByteString-dropEnd i p | i <= 0 = p-dropEnd i p = go D.empty p- where go :: D.Deque -> ByteString -> ByteString- go deque (Chunk c cs)- | D.byteLength deque < i = go (D.snoc c deque) cs- | otherwise =- let (output, deque') = getOutput empty (D.snoc c deque)- in foldrChunks Chunk (go deque' cs) output- go deque Empty = fromDeque $ dropEndBytes deque i-- len c = fromIntegral (S.length c)-- -- get a `ByteString` from all the front chunks of the accumulating deque- -- for which we know they won't be dropped- getOutput :: ByteString -> D.Deque -> (ByteString, D.Deque)- getOutput out deque = case D.popFront deque of- Nothing -> (reverseChunks out, deque)- Just (x, deque') | D.byteLength deque' >= i ->- getOutput (Chunk x out) deque'- _ -> (reverseChunks out, deque)-- -- reverse a `ByteString`s chunks, keeping all internal `S.ByteString`s- -- unchanged- reverseChunks = foldlChunks (flip Chunk) empty-- -- drop n elements from the rear of the accumulating `deque`- dropEndBytes :: D.Deque -> Int64 -> D.Deque- dropEndBytes deque n = case D.popRear deque of- Nothing -> deque- Just (deque', x) | len x <= n -> dropEndBytes deque' (n - len x)- | otherwise ->- D.snoc (S.dropEnd (fromIntegral n) x) deque'-- -- build a lazy ByteString from an accumulating `deque`- fromDeque :: D.Deque -> ByteString- fromDeque deque =- List.foldr chunk Empty (D.front deque) `append`- List.foldl' (flip chunk) Empty (D.rear deque)+dropEnd i p+ | i <= 0 = p+ | otherwise = splitAtEndFold Chunk (const Empty) i p -- | /O(n\/c)/ 'splitAt' @n xs@ is equivalent to @('take' n xs, 'drop' n xs)@. splitAt :: Int64 -> ByteString -> (ByteString, ByteString)@@ -849,7 +901,7 @@ in (Chunk c cs', cs'') --- | Similar to 'P.takeWhile',+-- | Similar to 'Prelude.takeWhile', -- returns the longest (possibly empty) prefix of elements -- satisfying the predicate. takeWhile :: (Word8 -> Bool) -> ByteString -> ByteString@@ -882,7 +934,7 @@ c' | S.length c' == S.length c -> (True, Chunk c bs) | otherwise -> (False, fromStrict c' `append` bs) --- | Similar to 'P.dropWhile',+-- | Similar to 'Prelude.dropWhile', -- drops the longest (possibly empty) prefix of elements -- satisfying the predicate and returns the remainder. dropWhile :: (Word8 -> Bool) -> ByteString -> ByteString@@ -893,7 +945,7 @@ n | n < S.length c -> Chunk (S.drop n c) cs | otherwise -> dropWhile' cs --- | Similar to 'P.dropWhileEnd',+-- | Similar to 'Prelude.dropWhileEnd', -- drops the longest (possibly empty) suffix of elements -- satisfying the predicate and returns the remainder. --@@ -916,7 +968,7 @@ x' | S.null x' -> dropEndBytes xs | otherwise -> List.foldl' (flip Chunk) Empty (x' : xs) --- | Similar to 'P.break',+-- | Similar to 'Prelude.break', -- returns the longest (possibly empty) prefix of elements which __do not__ -- satisfy the predicate and the remainder of the string. --@@ -937,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)@@ -962,7 +1014,7 @@ -- {---- | 'breakByte' breaks its ByteString argument at the first occurence+-- | 'breakByte' breaks its ByteString argument at the first occurrence -- of the specified byte. It is more efficient than 'break' as it is -- implemented with @memchr(3)@. I.e. --@@ -979,7 +1031,7 @@ in (x : xs', xs'') -- | 'spanByte' breaks its ByteString argument at the first--- occurence of a byte other than its argument. It is more efficient+-- occurrence of a byte other than its argument. It is more efficient -- than 'span (==)' -- -- > span (==99) "abcd" == spanByte 99 "abcd" -- fromEnum 'c' == 99@@ -995,7 +1047,7 @@ | otherwise -> (x' : [], x'' : xs) -} --- | Similar to 'P.span',+-- | Similar to 'Prelude.span', -- returns the longest (possibly empty) prefix of elements -- satisfying the predicate and the remainder of the string. --@@ -1007,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 --@@ -1039,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@@ -1066,11 +1119,12 @@ 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 -- ByteStrings such that the concatenation of the result is equal to the--- argument. Moreover, each sublist in the result contains only equal+-- argument. Moreover, each string in the result contains only equal -- elements. For example, -- -- > group "Mississippi" = ["M","i","ss","i","ss","i","pp","i"]@@ -1123,6 +1177,8 @@ -- Indexing ByteStrings -- | /O(c)/ 'ByteString' index (subscript) operator, starting from 0.+--+-- This is a partial function, consider using 'indexMaybe' instead. index :: HasCallStack => ByteString -> Int64 -> Word8 index _ i | i < 0 = moduleError "index" ("negative index: " ++ show i) index cs0 i = index' cs0 i@@ -1383,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.@@ -1417,20 +1479,40 @@ -- --------------------------------------------------------------------- -- Special lists --- | /O(n)/ Return all initial segments of the given 'ByteString', shortest first.+-- | Returns all initial segments of the given 'ByteString', shortest first. inits :: ByteString -> [ByteString]-inits = (Empty :) . inits'- where inits' Empty = []- inits' (Chunk c cs) = List.map (`Chunk` Empty) (List.tail (S.inits c))- ++ List.map (Chunk c) (inits' cs)+-- see Note [Avoid NonEmpty combinators] in Data.ByteString+inits bs = NE.toList $! initsNE bs --- | /O(n)/ Return all final segments of the given 'ByteString', longest first.+-- | Returns all initial segments of the given 'ByteString', shortest first.+--+-- @since 0.11.4.0+initsNE :: ByteString -> NonEmpty ByteString+-- see Note [Avoid NonEmpty combinators] in Data.ByteString+initsNE = (Empty :|) . inits' id+ where+ inits' :: (ByteString -> ByteString) -> ByteString -> [ByteString]+ -- inits' f bs === map f (tail (inits bs))+ inits' _ Empty = []+ inits' f (Chunk c@(S.BS x len) cs)+ = [f (S.BS x n `Chunk` Empty) | n <- [1..len]]+ ++ inits' (f . Chunk c) cs++-- | /O(n)/ Returns all final segments of the given 'ByteString', longest first. tails :: ByteString -> [ByteString]-tails Empty = [Empty]-tails cs@(Chunk c cs')- | S.length c == 1 = cs : tails cs'- | otherwise = cs : tails (Chunk (S.unsafeTail c) cs')+-- see Note [Avoid NonEmpty combinators] in Data.ByteString+tails bs = NE.toList $! tailsNE bs +-- | /O(n)/ Returns all final segments of the given 'ByteString', longest first.+--+-- @since 0.11.4.0+tailsNE :: ByteString -> NonEmpty ByteString+-- see Note [Avoid NonEmpty combinators] in Data.ByteString+tailsNE bs = case uncons bs of+ Nothing -> Empty :| []+ Just (_, tl) -> bs :| tails tl++ -- --------------------------------------------------------------------- -- Low level constructors @@ -1568,10 +1650,12 @@ getContents :: IO ByteString getContents = hGetContents stdin --- | Outputs a 'ByteString' to the specified 'Handle'. The chunks will be--- written one at a time. Other threads might write to the 'Handle' between the--- writes, and hence 'hPut' alone might not be suitable for concurrent writes.+-- | Outputs a 'ByteString' to the specified 'Handle'. --+-- The chunks will be+-- written one at a time. Other threads might write to the 'Handle' in between,+-- and hence 'hPut' alone is not suitable for concurrent writes.+-- hPut :: Handle -> ByteString -> IO () hPut h = foldrChunks (\c rest -> S.hPut h c >> rest) (return ()) @@ -1592,12 +1676,17 @@ 0 -> return bs _ -> return (Chunk c' cs) --- | A synonym for @hPut@, for compatibility+-- | A synonym for 'hPut', for compatibility -- hPutStr :: Handle -> ByteString -> IO () hPutStr = hPut --- | Write a ByteString to stdout+-- | Write a ByteString to 'stdout'.+--+-- The chunks will be+-- written one at a time. Other threads might write to the 'stdout' in between,+-- and hence 'putStr' alone is not suitable for concurrent writes.+-- putStr :: ByteString -> IO () putStr = hPut stdout @@ -1631,6 +1720,9 @@ revChunks :: [P.ByteString] -> ByteString revChunks = List.foldl' (flip chunk) Empty +intToInt64 :: Int -> Int64+intToInt64 = fromIntegral @Int @Int64+ -- $IOChunk -- -- ⚠ Using lazy I\/O functions like 'readFile' or 'hGetContents'@@ -1657,7 +1749,7 @@ -- reading the whole file via 'readFile' executes all three actions -- (open the file handle, read its content, close the file handle) before -- control moves to the following 'writeFile' action. This expectation holds--- for the strict "Data.ByteString" API. However, the above lazy 'ByteString' variant+-- for the strict "Data.ByteString" API. However, the above 'LazyByteString' variant -- of the program fails with @openBinaryFile: resource busy (file is locked)@. -- -- The reason for this is that "Data.ByteString.Lazy" is specifically designed
Data/ByteString/Lazy/Char8.hs view
@@ -1,7 +1,7 @@-{-# LANGUAGE BangPatterns #-}-{-# OPTIONS_HADDOCK prune #-} {-# LANGUAGE Trustworthy #-} +{-# OPTIONS_HADDOCK prune #-}+ -- | -- Module : Data.ByteString.Lazy.Char8 -- Copyright : (c) Don Stewart 2006-2008@@ -123,6 +123,8 @@ groupBy, inits, tails,+ initsNE,+ tailsNE, stripPrefix, stripSuffix, @@ -177,8 +179,28 @@ copy, -- * Reading from ByteStrings+ -- | Note that a lazy 'ByteString' may hold an unbounded stream of+ -- @\'0\'@ digits, in which case the functions below may never return.+ -- If that's a concern, you can use 'take' to first truncate the input+ -- to an acceptable length. Non-termination is also possible when+ -- reading arbitrary precision numbers via 'readInteger' or+ -- 'readNatural', if the input is an unbounded stream of arbitrary+ -- decimal digits.+ -- readInt,+ readInt64,+ readInt32,+ readInt16,+ readInt8,++ readWord,+ readWord64,+ readWord32,+ readWord16,+ readWord8,+ readInteger,+ readNatural, -- * I\/O with 'ByteString's -- | ByteString I/O uses binary mode, without any character decoding@@ -212,7 +234,7 @@ (fromChunks, toChunks ,empty,null,length,tail,init,append,reverse,transpose,cycle ,concat,take,takeEnd,drop,dropEnd,splitAt,intercalate- ,isPrefixOf,isSuffixOf,group,inits,tails,copy+ ,isPrefixOf,isSuffixOf,group,inits,tails,initsNE,tailsNE,copy ,stripPrefix,stripSuffix ,hGetContents, hGet, hPut, getContents ,hGetNonBlocking, hPutNonBlocking@@ -224,17 +246,20 @@ import qualified Data.ByteString as S (ByteString) -- typename only import qualified Data.ByteString as B import qualified Data.ByteString.Unsafe as B+import Data.List.NonEmpty (NonEmpty(..)) import Data.ByteString.Lazy.Internal+import Data.ByteString.Lazy.ReadInt+import Data.ByteString.Lazy.ReadNat -import Data.ByteString.Internal (w2c, c2w, isSpaceWord8)+import Data.ByteString.Internal (c2w,w2c,isSpaceWord8) import Data.Int (Int64) 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) @@ -571,7 +596,7 @@ {-# INLINE spanEnd #-} {---- | 'breakChar' breaks its ByteString argument at the first occurence+-- | 'breakChar' breaks its ByteString argument at the first occurrence -- of the specified Char. It is more efficient than 'break' as it is -- implemented with @memchr(3)@. I.e. --@@ -582,7 +607,7 @@ {-# INLINE breakChar #-} -- | 'spanChar' breaks its ByteString argument at the first--- occurence of a Char other than its argument. It is more efficient+-- occurrence of a Char other than its argument. It is more efficient -- than 'span (==)' -- -- > span (=='c') "abcd" == spanByte 'c' "abcd"@@ -831,66 +856,57 @@ unzip ls = (pack (fmap fst ls), pack (fmap snd ls)) {-# INLINE unzip #-} --- | 'lines' breaks a ByteString up into a list of ByteStrings at+-- | 'lines' lazily splits a ByteString into a list of ByteStrings at -- newline Chars (@'\\n'@). The resulting strings do not contain newlines.------ As of bytestring 0.9.0.3, this function is stricter than its--- list cousin.+-- The first chunk of the result is only strict in the first chunk of the+-- input. -- -- Note that it __does not__ regard CR (@'\\r'@) as a newline character. -- lines :: ByteString -> [ByteString] lines Empty = []-lines (Chunk c0 cs0) = loop0 c0 cs0- where- -- this is a really performance sensitive function but the- -- chunked representation makes the general case a bit expensive- -- however assuming a large chunk size and normalish line lengths- -- we will find line endings much more frequently than chunk- -- endings so it makes sense to optimise for that common case.- -- So we partition into two special cases depending on whether we- -- are keeping back a list of chunks that will eventually be output- -- once we get to the end of the current line.-- -- the common special case where we have no existing chunks of- -- the current line- loop0 :: S.ByteString -> ByteString -> [ByteString]- loop0 c cs =- case B.elemIndex (c2w '\n') c of- Nothing -> case cs of- Empty | B.null c -> []- | otherwise -> [Chunk c Empty]- (Chunk c' cs')- | B.null c -> loop0 c' cs'- | otherwise -> loop c' [c] cs'-- Just n | n /= 0 -> Chunk (B.unsafeTake n c) Empty- : loop0 (B.unsafeDrop (n+1) c) cs- | otherwise -> Empty- : loop0 (B.unsafeTail c) cs+lines (Chunk c0 cs0) = unNE $! go c0 cs0+ where+ -- Natural NonEmpty -> List+ unNE :: NonEmpty a -> [a]+ unNE (a :| b) = a : b - -- the general case when we are building a list of chunks that are- -- part of the same line- loop :: S.ByteString -> [S.ByteString] -> ByteString -> [ByteString]- loop c line cs =- case B.elemIndex (c2w '\n') c of- Nothing ->- case cs of- Empty -> let !c' = revChunks (c : line)- in [c']+ -- Strict in the first argument, lazy in the second.+ consNE :: ByteString -> NonEmpty ByteString -> NonEmpty ByteString+ consNE !a b = a :| (unNE $! b) - (Chunk c' cs') -> loop c' (c : line) cs'+ -- Note invariant: The initial chunk is non-empty on input, and we+ -- need to be sure to maintain this in internal recursive calls.+ go :: S.ByteString -> ByteString -> NonEmpty ByteString+ go c cs = case B.elemIndex (c2w '\n') c of+ Just n+ | n1 <- n + 1+ , n1 < B.length c -> consNE c' $ go (B.unsafeDrop n1 c) cs+ -- 'c' was a multi-line chunk+ | otherwise -> c' :| lines cs+ -- 'c' was a single-line chunk+ where+ !c' = chunk (B.unsafeTake n c) Empty - Just n ->- let !c' = revChunks (B.unsafeTake n c : line)- in c' : loop0 (B.unsafeDrop (n+1) c) cs+ -- Initial chunk with no new line becomes first chunk of+ -- first line of result, with the rest of the result lazy!+ -- In particular, we don't strictly pattern match on 'cs'.+ --+ -- We can form `Chunk c ...` because the invariant is maintained+ -- here and also by using `chunk` in the defintion of `c'` above.+ Nothing -> let ~(l:|ls) = lazyRest cs+ in Chunk c l :| ls+ where+ lazyRest :: ByteString -> NonEmpty ByteString+ lazyRest (Chunk c' cs') = go c' cs'+ lazyRest Empty = Empty :| [] --- | 'unlines' is an inverse operation to 'lines'. It joins lines,--- after appending a terminating newline to each.+-- | 'unlines' joins lines, appending a terminating newline after each.+--+-- Equivalent to+-- @'concat' . Data.List.concatMap (\\x -> [x, 'singleton' \'\\n'])@. unlines :: [ByteString] -> ByteString-unlines [] = empty-unlines ss = concat (List.intersperse nl ss) `append` nl -- half as much space- where nl = singleton '\n'+unlines = List.foldr (\x t -> x `append` cons '\n' t) Empty -- | 'words' breaks a ByteString up into a list of words, which -- were delimited by Chars representing white space. And@@ -906,109 +922,22 @@ unwords = intercalate (singleton ' ') {-# INLINE unwords #-} --- | readInt reads an Int from the beginning of the ByteString. If--- there is no integer at the beginning of the string, it returns--- Nothing, otherwise it just returns the int read, and the rest of the--- string.+-- | Write a ByteString to a handle, appending a newline byte. ----- Note: This function will overflow the Int for large integers.--readInt :: ByteString -> Maybe (Int, ByteString)-{-# INLINE readInt #-}-readInt Empty = Nothing-readInt (Chunk x xs) = case w2c (B.unsafeHead x) of- '-' -> loop True 0 0 (B.unsafeTail x) xs- '+' -> loop False 0 0 (B.unsafeTail x) xs- _ -> loop False 0 0 x xs-- where loop :: Bool -> Int -> Int- -> S.ByteString -> ByteString -> Maybe (Int, ByteString)- loop neg !i !n !c cs- | B.null c = case cs of- Empty -> end neg i n c cs- (Chunk c' cs') -> loop neg i n c' cs'- | otherwise =- case B.unsafeHead c of- w | w >= 0x30- && w <= 0x39 -> loop neg (i+1)- (n * 10 + (fromIntegral w - 0x30))- (B.unsafeTail c) cs- | otherwise -> end neg i n c cs-- {-# INLINE end #-}- end _ 0 _ _ _ = Nothing- end neg _ n c cs = e- where n' = if neg then negate n else n- c' = chunk c cs- e = n' `seq` c' `seq` Just (n',c')- -- in n' `seq` c' `seq` JustS n' c'---- | readInteger reads an Integer from the beginning of the ByteString. If--- there is no integer at the beginning of the string, it returns Nothing,--- otherwise it just returns the int read, and the rest of the string.-readInteger :: ByteString -> Maybe (Integer, ByteString)-readInteger Empty = Nothing-readInteger (Chunk c0 cs0) =- case w2c (B.unsafeHead c0) of- '-' -> first (B.unsafeTail c0) cs0 >>= \(n, cs') -> return (-n, cs')- '+' -> first (B.unsafeTail c0) cs0- _ -> first c0 cs0-- where first c cs- | B.null c = case cs of- Empty -> Nothing- (Chunk c' cs') -> first' c' cs'- | otherwise = first' c cs-- first' c cs = case B.unsafeHead c of- w | w >= 0x30 && w <= 0x39 -> Just $- loop 1 (fromIntegral w - 0x30) [] (B.unsafeTail c) cs- | otherwise -> Nothing-- loop :: Int -> Int -> [Integer]- -> S.ByteString -> ByteString -> (Integer, ByteString)- loop !d !acc ns !c cs- | B.null c = case cs of- Empty -> combine d acc ns c cs- (Chunk c' cs') -> loop d acc ns c' cs'- | otherwise =- case B.unsafeHead c of- w | w >= 0x30 && w <= 0x39 ->- if d < 9 then loop (d+1)- (10*acc + (fromIntegral w - 0x30))- ns (B.unsafeTail c) cs- else loop 1 (fromIntegral w - 0x30)- (fromIntegral acc : ns)- (B.unsafeTail c) cs- | otherwise -> combine d acc ns c cs-- combine _ acc [] c cs = end (fromIntegral acc) c cs- combine d acc ns c cs =- end (10^d * combine1 1000000000 ns + fromIntegral acc) c cs-- combine1 _ [n] = n- combine1 b ns = combine1 (b*b) $ combine2 b ns-- combine2 b (n:m:ns) = let !t = n+m*b in t : combine2 b ns- combine2 _ ns = ns-- end n c cs = let !c' = chunk c cs- in (n, c')----- | Write a ByteString to a handle, appending a newline byte+-- The chunks will be+-- written one at a time, followed by a newline.+-- Other threads might write to the 'Handle' in between,+-- and hence 'hPutStrLn' alone is not suitable for concurrent writes. -- hPutStrLn :: Handle -> ByteString -> IO () hPutStrLn h ps = hPut h ps >> hPut h (L.singleton 0x0a) --- | Write a ByteString to stdout, appending a newline byte+-- | Write a ByteString to 'stdout', appending a newline byte. --+-- The chunks will be+-- written one at a time, followed by a newline.+-- Other threads might write to the 'stdout' in between,+-- and hence 'putStrLn' alone is not suitable for concurrent writes.+-- putStrLn :: ByteString -> IO () putStrLn = hPutStrLn stdout---- ------------------------------------------------------------------------ Internal utilities---- reverse a list of possibly-empty chunks into a lazy ByteString-revChunks :: [S.ByteString] -> ByteString-revChunks = List.foldl' (flip chunk) Empty
Data/ByteString/Lazy/Internal.hs view
@@ -1,11 +1,10 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveLift #-}-{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE Unsafe #-}+ {-# OPTIONS_HADDOCK not-home #-} +{-# LANGUAGE TypeFamilies #-}+ -- | -- Module : Data.ByteString.Lazy.Internal -- Copyright : (c) Don Stewart 2006-2008@@ -24,7 +23,7 @@ module Data.ByteString.Lazy.Internal ( -- * The lazy @ByteString@ type and representation- ByteString(..),+ ByteString(Empty, Chunk), LazyByteString, chunk, foldrChunks,@@ -49,40 +48,57 @@ import Prelude hiding (concat) -import qualified Data.ByteString.Internal as S+import qualified Data.ByteString.Internal.Type as S import Data.Word (Word8)-import Foreign.Ptr (plusPtr) import Foreign.Storable (Storable(sizeOf)) -#if MIN_VERSION_base(4,13,0)-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) import Data.String (IsString(..)) -import Data.Typeable (Typeable)-import Data.Data (Data(..), mkNoRepType)+import Data.Data (Data(..), mkConstr, mkNoRepType, Constr, DataType, Fixity(Prefix), constrIndex) 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. ----- A lazy 'ByteString' contains 8-bit bytes, or by using the operations+-- A 'LazyByteString' contains 8-bit bytes, or by using the operations -- 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.StrictByteString ByteString+ -- INVARIANT: The S.StrictByteString 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.StrictByteString ByteString++pattern Chunk :: S.StrictByteString -> 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@@ -127,10 +143,18 @@ instance Data ByteString where gfoldl f z txt = z packBytes `f` unpackBytes txt- toConstr _ = error "Data.ByteString.Lazy.ByteString.toConstr"- gunfold _ _ = error "Data.ByteString.Lazy.ByteString.gunfold"- dataTypeOf _ = mkNoRepType "Data.ByteString.Lazy.ByteString"+ toConstr _ = packConstr+ gunfold k z c = case constrIndex c of+ 1 -> k (z packBytes)+ _ -> error "gunfold: unexpected constructor of lazy ByteString"+ dataTypeOf _ = byteStringDataType +packConstr :: Constr+packConstr = mkConstr byteStringDataType "pack" [] Prefix++byteStringDataType :: DataType+byteStringDataType = mkNoRepType "Data.ByteString.Lazy.ByteString"+ ------------------------------------------------------------------------ -- Packing and unpacking from lists @@ -159,15 +183,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)@@ -178,13 +208,13 @@ ------------------------------------------------------------------------ -- | Smart constructor for 'Chunk'. Guarantees the data type invariant.-chunk :: S.ByteString -> ByteString -> ByteString+chunk :: S.StrictByteString -> ByteString -> ByteString chunk c@(S.BS _ len) cs | len == 0 = cs | otherwise = Chunk c cs {-# INLINE chunk #-} -- | Consume the chunks of a lazy ByteString with a natural right fold.-foldrChunks :: (S.ByteString -> a -> a) -> a -> ByteString -> a+foldrChunks :: (S.StrictByteString -> a -> a) -> a -> ByteString -> a foldrChunks f z = go where go Empty = z go (Chunk c cs) = f c (go cs)@@ -192,7 +222,7 @@ -- | Consume the chunks of a lazy ByteString with a strict, tail-recursive, -- accumulating left fold.-foldlChunks :: (a -> S.ByteString -> a) -> a -> ByteString -> a+foldlChunks :: (a -> S.StrictByteString -> a) -> a -> ByteString -> a foldlChunks f = go where go !a Empty = a go !a (Chunk c cs) = go (f a c) cs@@ -280,18 +310,18 @@ ------------------------------------------------------------------------ -- Conversions --- |/O(1)/ Convert a strict 'ByteString' into a lazy 'ByteString'.-fromStrict :: S.ByteString -> ByteString+-- |/O(1)/ Convert a 'S.StrictByteString' into a 'LazyByteString'.+fromStrict :: S.StrictByteString -> LazyByteString fromStrict (S.BS _ 0) = Empty fromStrict bs = Chunk bs Empty --- |/O(n)/ Convert a lazy 'ByteString' into a strict 'ByteString'.+-- |/O(n)/ Convert a 'LazyByteString' into a 'S.StrictByteString'. ----- Note that this is an /expensive/ operation that forces the whole lazy--- ByteString into memory and then copies all the data. If possible, try to+-- Note that this is an /expensive/ operation that forces the whole+-- 'LazyByteString' into memory and then copies all the data. If possible, try to -- avoid converting back and forth between strict and lazy bytestrings. ---toStrict :: ByteString -> S.ByteString+toStrict :: LazyByteString -> S.StrictByteString toStrict = \cs -> goLen0 cs cs -- We pass the original [ByteString] (bss0) through as an argument through -- goLen0, goLen1, and goLen since we will need it again in goCopy. Passing@@ -300,27 +330,23 @@ 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+ goLen cs0 (S.checkedAdd "Lazy.toStrict" bl cl) cs -- General case, just find the total length we'll need goLen cs0 !total (Chunk (S.BS _ cl) cs) =- goLen cs0 (S.checkedAdd "Lazy.concat" total cl) cs+ goLen cs0 (S.checkedAdd "Lazy.toStrict" total cl) cs goLen cs0 total Empty =- S.unsafeCreate total $ \ptr -> goCopy cs0 ptr+ S.unsafeCreateFp total $ \ptr -> goCopy cs0 ptr -- Copy the data goCopy Empty !_ = return ()- goCopy (Chunk (S.BS _ 0 ) cs) !ptr = goCopy cs ptr- goCopy (Chunk (S.BS fp len) cs) !ptr =- S.unsafeWithForeignPtr fp $ \p -> do- S.memcpy ptr p len- goCopy cs (ptr `plusPtr` len)+ goCopy (Chunk (S.BS fp len) cs) !ptr = do+ S.memcpyFp ptr fp len+ goCopy cs (ptr `S.plusForeignPtr` len) -- See the comment on Data.ByteString.Internal.concat for some background on -- this implementation.
− Data/ByteString/Lazy/Internal/Deque.hs
@@ -1,65 +0,0 @@-{- |- A Deque used for accumulating `S.ByteString`s in `Data.ByteString.Lazy.dropEnd`.--}-module Data.ByteString.Lazy.Internal.Deque (- Deque (..),- empty,- null,- cons,- snoc,- popFront,- popRear,-) where--import qualified Data.ByteString as S-import Data.Int (Int64)-import Prelude hiding (head, length, null)---- A `S.ByteString` Deque used as an accumulator for lazy--- Bytestring operations-data Deque = Deque- { front :: [S.ByteString]- , rear :: [S.ByteString]- , -- | Total length in bytes- byteLength :: !Int64- }---- An empty Deque-empty :: Deque-empty = Deque [] [] 0---- Is the `Deque` empty?--- O(1)-null :: Deque -> Bool-null deque = byteLength deque == 0---- Add a `S.ByteString` to the front of the `Deque`--- O(1)-cons :: S.ByteString -> Deque -> Deque-cons x (Deque fs rs acc) = Deque (x : fs) rs (acc + len x)---- Add a `S.ByteString` to the rear of the `Deque`--- O(1)-snoc :: S.ByteString -> Deque -> Deque-snoc x (Deque fs rs acc) = Deque fs (x : rs) (acc + len x)--len :: S.ByteString -> Int64-len x = fromIntegral $ S.length x---- Pop a `S.ByteString` from the front of the `Deque`--- Returns the bytestring and the updated Deque, or Nothing if the Deque is empty--- O(1) , occasionally O(n)-popFront :: Deque -> Maybe (S.ByteString, Deque)-popFront (Deque [] rs acc) = case reverse rs of- [] -> Nothing- x : xs -> Just (x, Deque xs [] (acc - len x))-popFront (Deque (x : xs) rs acc) = Just (x, Deque xs rs (acc - len x))---- Pop a `S.ByteString` from the rear of the `Deque`--- Returns the bytestring and the updated Deque, or Nothing if the Deque is empty--- O(1) , occasionally O(n)-popRear :: Deque -> Maybe (Deque, S.ByteString)-popRear (Deque fs [] acc) = case reverse fs of- [] -> Nothing- x : xs -> Just (Deque [] xs (acc - len x), x)-popRear (Deque fs (x : xs) acc) = Just (Deque fs xs (acc - len x), x)
+ Data/ByteString/Lazy/ReadInt.hs view
@@ -0,0 +1,259 @@+{-# LANGUAGE CPP #-}++-- This file is also included by "Data.ByteString.ReadInt", after defining+-- "BYTESTRING_STRICT". The two modules share much of their code, but+-- the lazy version adds an outer loop over the chunks.++#ifdef BYTESTRING_STRICT+module Data.ByteString.ReadInt+#else+module Data.ByteString.Lazy.ReadInt+#endif+ ( readInt+ , readInt8+ , readInt16+ , readInt32+ , readWord+ , readWord8+ , readWord16+ , readWord32+ , readInt64+ , readWord64+ ) where++import qualified Data.ByteString.Internal as BI+#ifdef BYTESTRING_STRICT+import Data.ByteString+#else+import Data.ByteString.Lazy+import Data.ByteString.Lazy.Internal+#endif+import Data.Bits (FiniteBits, isSigned)+import Data.ByteString.Internal (pattern BS, plusForeignPtr)+import Data.Int+import Data.Word+import Foreign.ForeignPtr (ForeignPtr)+import Foreign.Ptr (minusPtr, plusPtr)+import Foreign.Storable (Storable(..))++----- Public API++-- | Try to read a signed 'Int' value from the 'ByteString', returning+-- @Just (val, str)@ on success, where @val@ is the value read and @str@ is the+-- rest of the input string. If the sequence of digits decodes to a value+-- larger than can be represented by an 'Int', the returned value will be+-- 'Nothing'.+--+-- 'readInt' does not ignore leading whitespace, the value must start+-- immediately at the beginning of the input string.+--+-- ==== __Examples__+-- >>> readInt "-1729 sum of cubes"+-- Just (-1729," sum of cubes")+-- >>> readInt "+1: readInt also accepts a leading '+'"+-- Just (1, ": readInt also accepts a leading '+'")+-- >>> readInt "not a decimal number"+-- Nothing+-- >>> readInt "12345678901234567890 overflows maxBound"+-- Nothing+-- >>> readInt "-12345678901234567890 underflows minBound"+-- Nothing+--+readInt :: ByteString -> Maybe (Int, ByteString)+readInt = _read++-- | A variant of 'readInt' specialised to 'Int32'.+readInt32 :: ByteString -> Maybe (Int32, ByteString)+readInt32 = _read++-- | A variant of 'readInt' specialised to 'Int16'.+readInt16 :: ByteString -> Maybe (Int16, ByteString)+readInt16 = _read++-- | A variant of 'readInt' specialised to 'Int8'.+readInt8 :: ByteString -> Maybe (Int8, ByteString)+readInt8 = _read++-- | Try to read a 'Word' value from the 'ByteString', returning+-- @Just (val, str)@ on success, where @val@ is the value read and @str@ is the+-- rest of the input string. If the sequence of digits decodes to a value+-- larger than can be represented by a 'Word', the returned value will be+-- 'Nothing'.+--+-- 'readWord' does not ignore leading whitespace, the value must start with a+-- decimal digit immediately at the beginning of the input string. Leading @+@+-- signs are not accepted.+--+-- ==== __Examples__+-- >>> readWord "1729 sum of cubes"+-- Just (1729," sum of cubes")+-- >>> readWord "+1729 has an explicit sign"+-- Nothing+-- >>> readWord "not a decimal number"+-- Nothing+-- >>> readWord "98765432109876543210 overflows maxBound"+-- Nothing+--+readWord :: ByteString -> Maybe (Word, ByteString)+readWord = _read++-- | A variant of 'readWord' specialised to 'Word32'.+readWord32 :: ByteString -> Maybe (Word32, ByteString)+readWord32 = _read++-- | A variant of 'readWord' specialised to 'Word16'.+readWord16 :: ByteString -> Maybe (Word16, ByteString)+readWord16 = _read++-- | A variant of 'readWord' specialised to 'Word8'.+readWord8 :: ByteString -> Maybe (Word8, ByteString)+readWord8 = _read++-- | A variant of 'readInt' specialised to 'Int64'.+readInt64 :: ByteString -> Maybe (Int64, ByteString)+readInt64 = _read++-- | A variant of 'readWord' specialised to 'Word64'.+readWord64 :: ByteString -> Maybe (Word64, ByteString)+readWord64 = _read++-- | Polymorphic Int*/Word* reader+_read :: forall a. (Integral a, FiniteBits a, Bounded a)+ => ByteString -> Maybe (a, ByteString)+{-# INLINE _read #-}+_read+ | isSigned @a 0+ = \ bs -> signed bs >>= \ (r, s, d1) -> _readDecimal r s d1+ | otherwise+ -- When the input is @16^n-1@, as is the case with 'maxBound' for+ -- all the Word* types, the last decimal digit of 'maxBound' is 5.+ = \ bs -> unsigned 5 bs >>= \ (r, s, d1) -> _readDecimal r s d1+ where+ -- Returns:+ -- * Mod 10 min/max bound remainder+ -- * 2nd and later digits+ -- * 1st digit+ --+ -- When the input is @8*16^n-1@, as is the case with 'maxBound' for+ -- all the Int* types, the last decimal digit of 'maxBound' is 7.+ --+ signed :: ByteString -> Maybe (Word64, ByteString, Word64)+ signed bs = do+ (w, s) <- uncons bs+ let d1 = fromDigit w+ if | d1 <= 9 -> Just (7, s, d1) -- leading digit+ | w == 0x2d -> unsigned 8 s -- minus sign+ | w == 0x2b -> unsigned 7 s -- plus sign+ | otherwise -> Nothing -- not a number++ unsigned :: Word64 -> ByteString -> Maybe (Word64, ByteString, Word64)+ unsigned r bs = do+ (w, s) <- uncons bs+ let d1 = fromDigit w+ if | d1 <= 9 -> Just (r, s, d1) -- leading digit+ | otherwise -> Nothing -- not a number++----- Fixed-width unsigned reader++-- | Intermediate result from scanning a chunk, final output is+-- converted to the requested type once all chunks are processed.+--+data Result = Overflow+ | Result !Int -- number of bytes (digits) read+ !Word64 -- accumulator value++_readDecimal :: forall a. (Integral a, Bounded a)+ => Word64 -- ^ abs(maxBound/minBound) `mod` 10+ -> ByteString -- ^ Input string+ -> Word64 -- ^ First digit value+ -> Maybe (a, ByteString)+{-# INLINE _readDecimal #-}+_readDecimal !r = consume+ where+ consume :: ByteString -> Word64 -> Maybe (a, ByteString)+#ifdef BYTESTRING_STRICT+ consume (BS fp len) a = case _digits q r fp len a of+ Result used acc+ | used == len+ -> convert acc empty+ | otherwise+ -> convert acc $ BS (fp `plusForeignPtr` used) (len - used)+ _ -> Nothing+#else+ -- All done+ consume Empty acc = convert acc Empty+ -- Process next chunk+ consume (Chunk (BS fp len) cs) acc+ = case _digits q r fp len acc of+ Result used acc'+ | used == len+ -- process remaining chunks+ -> consume cs acc'+ | otherwise+ -- ran into a non-digit+ -> convert acc' $+ Chunk (BS (fp `plusForeignPtr` used) (len - used)) cs+ _ -> Nothing+#endif+ convert :: Word64 -> ByteString -> Maybe (a, ByteString)+ convert !acc rest =+ let !i = case r of+ -- minBound @Int* `mod` 10 == 8+ 8 -> negate $ fromIntegral @Word64 @a acc+ _ -> fromIntegral @Word64 @a acc+ in Just (i, rest)++ -- The quotient of 'maxBound' divided by 10 is needed for+ -- overflow checks, once the accumulator exceeds this value+ -- no further digits can be added. If equal, the last digit+ -- must not exceed the `r` value (max/min bound `mod` 10).+ --+ q = fromIntegral @a @Word64 maxBound `div` 10++----- Per chunk decoder++-- | Process as many digits as we can, returning the additional+-- number of digits found and the updated accumulator. If the+-- accumulator would overflow return 'Overflow'.+--+_digits :: Word64 -- ^ maximum non-overflow value `div` 10+ -> Word64 -- ^ maximum non-overflow vavlue `mod` 10+ -> ForeignPtr Word8 -- ^ Input buffer+ -> Int -- ^ Input length+ -> Word64 -- ^ Accumulated value of leading digits+ -> Result -- ^ Bytes read and final accumulator,+ -- or else overflow indication+{-# INLINE _digits #-}+_digits !q !r fp len a = BI.accursedUnutterablePerformIO $+ BI.unsafeWithForeignPtr fp $ \ ptr -> do+ let end = ptr `plusPtr` len+ go ptr end ptr a+ where+ go !start !end = loop+ where+ loop !ptr !acc = getDigit >>= \ !d ->+ if | d > 9+ -> return $ Result (ptr `minusPtr` start) acc+ | acc < q || acc == q && d <= r+ -> loop (ptr `plusPtr` 1) (acc * 10 + d)+ | otherwise+ -> return Overflow+ where+ getDigit :: IO Word64+ getDigit+ | ptr /= end = fromDigit <$> peek ptr+ | otherwise = pure 10 -- End of input+ {-# NOINLINE getDigit #-}+ -- 'getDigit' makes it possible to implement a single success+ -- exit point from the loop. If instead we return 'Result'+ -- from multiple places, when '_digits' is inlined we get (at+ -- least GHC 8.10 through 9.2) for each exit path a separate+ -- join point implementing the continuation code. GHC ticket+ -- <https://gitlab.haskell.org/ghc/ghc/-/issues/20739>.+ --+ -- The NOINLINE pragma is required to avoid inlining branches+ -- that would restore multiple exit points.++fromDigit :: Word8 -> Word64+{-# INLINE fromDigit #-}+fromDigit = \ !w -> fromIntegral w - 0x30 -- i.e. w - '0'
+ Data/ByteString/Lazy/ReadNat.hs view
@@ -0,0 +1,252 @@+{-# LANGUAGE CPP #-}++-- This file is included by "Data.ByteString.ReadInt", after defining+-- "BYTESTRING_STRICT". The two modules are largely identical, except for the+-- choice of ByteString type and the loops in `readNatural`, where the lazy+-- version needs to nest the inner loop inside a loop over the constituent+-- chunks.++#ifdef BYTESTRING_STRICT+module Data.ByteString.ReadNat+#else+module Data.ByteString.Lazy.ReadNat+#endif+ ( readInteger+ , readNatural+ ) where++import qualified Data.ByteString.Internal as BI+#ifdef BYTESTRING_STRICT+import Data.ByteString+#else+import Data.ByteString.Lazy+import Data.ByteString.Lazy.Internal+#endif+import Data.Bits (finiteBitSize)+import Data.ByteString.Internal (pattern BS, plusForeignPtr)+import Data.Word+import Foreign.ForeignPtr (ForeignPtr)+import Foreign.Ptr (Ptr, minusPtr, plusPtr)+import Foreign.Storable (Storable(..))+import Numeric.Natural (Natural)++----- Public API++-- | 'readInteger' reads an 'Integer' from the beginning of the 'ByteString'.+-- If there is no 'Integer' at the beginning of the string, it returns+-- 'Nothing', otherwise it just returns the 'Integer' read, and the rest of+-- the string.+--+-- 'readInteger' does not ignore leading whitespace, the value must start+-- immediately at the beginning of the input string.+--+-- ==== __Examples__+-- >>> readInteger "-000111222333444555666777888999 all done"+-- Just (-111222333444555666777888999," all done")+-- >>> readInteger "+1: readInteger also accepts a leading '+'"+-- Just (1, ": readInteger also accepts a leading '+'")+-- >>> readInteger "not a decimal number"+-- Nothing+--+readInteger :: ByteString -> Maybe (Integer, ByteString)+readInteger = \ bs -> do+ (w, s) <- uncons bs+ let d = fromDigit w+ if | d <= 9 -> unsigned d s -- leading digit+ | w == 0x2d -> negative s -- minus sign+ | w == 0x2b -> positive s -- plus sign+ | otherwise -> Nothing -- not a number+ where+ unsigned :: Word -> ByteString -> Maybe (Integer, ByteString)+ unsigned d s =+ let (!n, rest) = _readDecimal d s+ !i = toInteger n+ in Just (i, rest)++ positive :: ByteString -> Maybe (Integer, ByteString)+ positive bs = do+ (w, s) <- uncons bs+ let d = fromDigit w+ if | d <= 9 -> unsigned d s+ | otherwise -> Nothing++ negative :: ByteString -> Maybe (Integer, ByteString)+ negative bs = do+ (w, s) <- uncons bs+ let d = fromDigit w+ if | d > 9 -> Nothing+ | otherwise -> let (n, rest) = _readDecimal d s+ !i = negate $ toInteger n+ in Just (i, rest)++-- | 'readNatural' reads a 'Natural' number from the beginning of the+-- 'ByteString'. If there is no 'Natural' number at the beginning of the+-- string, it returns 'Nothing', otherwise it just returns the number read, and+-- the rest of the string.+--+-- 'readNatural' does not ignore leading whitespace, the value must start with+-- a decimal digit immediately at the beginning of the input string. Leading+-- @+@ signs are not accepted.+--+-- ==== __Examples__+-- >>> readNatural "000111222333444555666777888999 all done"+-- Just (111222333444555666777888999," all done")+-- >>> readNatural "+000111222333444555666777888999 explicit sign"+-- Nothing+-- >>> readNatural "not a decimal number"+-- Nothing+--+readNatural :: ByteString -> Maybe (Natural, ByteString)+readNatural bs = do+ (w, s) <- uncons bs+ let d = fromDigit w+ if | d <= 9 -> Just $! _readDecimal d s+ | otherwise -> Nothing++----- Internal implementation++-- | Intermediate result from scanning a chunk, final output is+-- obtained via `convert` after all the chunks are processed.+--+data Result = Result !Int -- Bytes consumed+ !Word -- Value of LSW+ !Int -- Digits in LSW+ [Natural] -- Little endian MSW list++_readDecimal :: Word -> ByteString -> (Natural, ByteString)+_readDecimal =+ -- Having read one digit, we're about to read the 2nd So the digit count+ -- up to 'safeLog' starts at 2.+ consume [] 2+ where+ consume :: [Natural] -> Int -> Word -> ByteString+ -> (Natural, ByteString)+#ifdef BYTESTRING_STRICT+ consume ns cnt acc (BS fp len) =+ -- Having read one digit, we're about to read the 2nd+ -- So the digit count up to 'safeLog' starts at 2.+ case natdigits fp len acc cnt ns of+ Result used acc' cnt' ns'+ | used == len+ -> convert acc' cnt' ns' $ empty+ | otherwise+ -> convert acc' cnt' ns' $+ BS (fp `plusForeignPtr` used) (len - used)+#else+ -- All done+ consume ns cnt acc Empty = convert acc cnt ns Empty+ -- Process next chunk+ consume ns cnt acc (Chunk (BS fp len) cs)+ = case natdigits fp len acc cnt ns of+ Result used acc' cnt' ns'+ | used == len -- process more chunks+ -> consume ns' cnt' acc' cs+ | otherwise -- ran into a non-digit+ -> let c = Chunk (BS (fp `plusForeignPtr` used) (len - used)) cs+ in convert acc' cnt' ns' c+#endif+ convert !acc !cnt !ns rest =+ let !n = combine acc cnt ns+ in (n, rest)++ -- | Merge least-significant word with reduction of of little-endian tail.+ --+ -- The input is:+ --+ -- * Least significant digits as a 'Word' (LSW)+ -- * The number of digits that went into the LSW+ -- * All the remaining digit groups ('safeLog' digits each),+ -- in little-endian order+ --+ -- The result is obtained by pairwise recursive combining of all the+ -- full size digit groups, followed by multiplication by @10^cnt@ and+ -- addition of the LSW.+ combine :: Word -- ^ value of LSW+ -> Int -- ^ count of digits in LSW+ -> [Natural] -- ^ tail elements (base @10^'safeLog'@)+ -> Natural+ {-# INLINE combine #-}+ combine !acc !_ [] = wordToNatural acc+ combine !acc !cnt ns =+ wordToNatural (10^cnt) * combine1 safeBase ns + wordToNatural acc++ -- | Recursive reduction of little-endian sequence of 'Natural'-valued+ -- /digits/ in base @base@ (a power of 10). The base is squared after+ -- each round. This shows better asymptotic performance than one word+ -- at a time multiply-add folds. See:+ -- <https://gmplib.org/manual/Multiplication-Algorithms>+ --+ combine1 :: Natural -> [Natural] -> Natural+ combine1 _ [n] = n+ combine1 base ns = combine1 (base * base) (combine2 base ns)++ -- | One round pairwise merge of numbers in base @base@.+ combine2 :: Natural -> [Natural] -> [Natural]+ combine2 base (n:m:ns) = let !t = m * base + n in t : combine2 base ns+ combine2 _ ns = ns++-- The intermediate representation is a little-endian sequence in base+-- @10^'safeLog'@, prefixed by an initial element in base @10^cnt@ for some+-- @cnt@ between 1 and 'safeLog'. The final result is obtained by recursive+-- pairwise merging of the tail followed by a final multiplication by @10^cnt@+-- and addition of the head.+--+natdigits :: ForeignPtr Word8 -- ^ Input chunk+ -> Int -- ^ Chunk length+ -> Word -- ^ accumulated element+ -> Int -- ^ partial digit count+ -> [Natural] -- ^ accumulated MSB elements+ -> Result+{-# INLINE natdigits #-}+natdigits fp len = \ acc cnt ns ->+ BI.accursedUnutterablePerformIO $+ BI.unsafeWithForeignPtr fp $ \ ptr -> do+ let end = ptr `plusPtr` len+ go ptr end acc cnt ns ptr+ where+ go !start !end = loop+ where+ loop :: Word -> Int -> [Natural] -> Ptr Word8 -> IO Result+ loop !acc !cnt ns !ptr = getDigit >>= \ !d ->+ if | d > 9+ -> return $ Result (ptr `minusPtr` start) acc cnt ns+ | cnt < safeLog+ -> loop (10*acc + d) (cnt+1) ns $ ptr `plusPtr` 1+ | otherwise+ -> let !acc' = wordToNatural acc+ in loop d 1 (acc' : ns) $ ptr `plusPtr` 1+ where+ getDigit | ptr /= end = fromDigit <$> peek ptr+ | otherwise = pure 10 -- End of input+ {-# NOINLINE getDigit #-}+ -- 'getDigit' makes it possible to implement a single success+ -- exit point from the loop. If instead we return 'Result'+ -- from multiple places, when 'natdigits' is inlined we get (at+ -- least GHC 8.10 through 9.2) for each exit path a separate+ -- join point implementing the continuation code. GHC ticket+ -- <https://gitlab.haskell.org/ghc/ghc/-/issues/20739>.+ --+ -- The NOINLINE pragma is required to avoid inlining branches+ -- that would restore multiple exit points.++----- Misc functions++-- | Largest decimal digit count that never overflows the accumulator+-- The base 10 logarithm of 2 is ~0.30103, therefore 2^n has at least+-- @1 + floor (0.3 n)@ decimal digits. Therefore @floor (0.3 n)@,+-- digits cannot overflow the upper bound of an @n-bit@ word.+--+safeLog :: Int+safeLog = 3 * finiteBitSize @Word 0 `div` 10++-- | 10-power base for little-endian sequence of ~Word-sized "digits"+safeBase :: Natural+safeBase = 10 ^ safeLog++fromDigit :: Word8 -> Word+{-# INLINE fromDigit #-}+fromDigit = \ !w -> fromIntegral w - 0x30 -- i.e. w - '0'++wordToNatural :: Word -> Natural+{-# INLINE wordToNatural #-}+wordToNatural = fromIntegral
+ Data/ByteString/ReadInt.hs view
@@ -0,0 +1,3 @@+{-# LANGUAGE CPP #-}+#define BYTESTRING_STRICT+#include "Lazy/ReadInt.hs"
+ Data/ByteString/ReadNat.hs view
@@ -0,0 +1,3 @@+{-# LANGUAGE CPP #-}+#define BYTESTRING_STRICT+#include "Lazy/ReadNat.hs"
Data/ByteString/Short.hs view
@@ -2,10 +2,10 @@ -- | -- Module : Data.ByteString.Short--- Copyright : (c) Duncan Coutts 2012-2013+-- Copyright : (c) Duncan Coutts 2012-2013, Julian Ospald 2022 -- License : BSD-style ----- Maintainer : duncan@community.haskell.org+-- Maintainer : hasufell@posteo.de -- Stability : stable -- Portability : ghc only --@@ -33,20 +33,20 @@ -- | With GHC, the memory overheads are as follows, expressed in words and -- in bytes (words are 4 and 8 bytes on 32 or 64bit machines respectively). --- -- * 'B.ByteString' unshared: 9 words; 36 or 72 bytes.+ -- * t'Data.ByteString.ByteString' unshared: 8 words; 32 or 64 bytes. --- -- * 'B.ByteString' shared substring: 5 words; 20 or 40 bytes.+ -- * t'Data.ByteString.ByteString' shared substring: 4 words; 16 or 32 bytes. -- -- * 'ShortByteString': 4 words; 16 or 32 bytes. --- -- For the string data itself, both 'ShortByteString' and 'B.ByteString' use+ -- For the string data itself, both 'ShortByteString' and t'Data.ByteString.ByteString' use -- one byte per element, rounded up to the nearest word. For example, -- including the overheads, a length 10 'ShortByteString' would take -- @16 + 12 = 28@ bytes on a 32bit platform and @32 + 16 = 48@ bytes on a -- 64bit platform. -- -- These overheads can all be reduced by 1 word (4 or 8 bytes) when the- -- 'ShortByteString' or 'B.ByteString' is unpacked into another constructor.+ -- 'ShortByteString' or t'Data.ByteString.ByteString' is unpacked into another constructor. -- -- For example: --@@ -58,7 +58,7 @@ -- string data. -- ** Heap fragmentation- -- | With GHC, the 'B.ByteString' representation uses /pinned/ memory,+ -- | With GHC, the t'Data.ByteString.ByteString' representation uses /pinned/ memory, -- meaning it cannot be moved by the GC. This is usually the right thing to -- do for larger strings, but for small strings using pinned memory can -- lead to heap fragmentation which wastes space. The 'ShortByteString'@@ -67,23 +67,113 @@ -- small unpinned strings are allocated in the same way as normal heap -- allocations, rather than in a separate pinned area. - -- * Conversions- toShort,- fromShort,+ -- * Introducing and eliminating 'ShortByteString's+ empty,+ singleton, pack, unpack,+ fromShort,+ toShort, - -- * Other operations- empty, null, length, index, indexMaybe, (!?),+ -- * Basic interface+ snoc,+ cons,+ append,+ last,+ tail,+ uncons,+ head,+ init,+ unsnoc,+ null,+ length, + -- * Encoding validation+ isValidUtf8,++ -- * Transforming ShortByteStrings+ map,+ reverse,+ intercalate,++ -- * Reducing 'ShortByteString's (folds)+ foldl,+ foldl',+ foldl1,+ foldl1',++ foldr,+ foldr',+ foldr1,+ foldr1',++ -- ** Special folds+ all,+ any,+ concat,++ -- ** Generating and unfolding ByteStrings+ replicate,+ unfoldr,+ unfoldrN,++ -- * Substrings++ -- ** Breaking strings+ take,+ takeEnd,+ takeWhileEnd,+ takeWhile,+ drop,+ dropEnd,+ dropWhile,+ dropWhileEnd,+ breakEnd,+ break,+ span,+ spanEnd,+ splitAt,+ split,+ splitWith,+ stripSuffix,+ stripPrefix,++ -- * Predicates+ isInfixOf,+ isPrefixOf,+ isSuffixOf,++ -- ** Search for arbitrary substrings+ breakSubstring,++ -- * Searching ShortByteStrings++ -- ** Searching by equality+ elem,++ -- ** Searching with a predicate+ find,+ filter,+ partition,++ -- * Indexing ShortByteStrings+ index,+ indexMaybe,+ (!?),+ elemIndex,+ elemIndices,+ count,+ findIndex,+ findIndices,+ -- * Low level conversions -- ** Packing 'Foreign.C.String.CString's and pointers packCString, packCStringLen, - -- ** Using ByteStrings as 'Foreign.C.String.CString's+ -- ** Using ShortByteStrings as 'Foreign.C.String.CString's useAsCString,- useAsCStringLen+ useAsCStringLen, ) where import Data.ByteString.Short.Internal
Data/ByteString/Short/Internal.hs view
@@ -1,610 +1,1777 @@-{-# LANGUAGE DeriveDataTypeable, CPP, BangPatterns, RankNTypes,- ForeignFunctionInterface, MagicHash, UnboxedTuples,- UnliftedFFITypes #-}-{-# LANGUAGE TypeFamilies #-}-{-# OPTIONS_GHC -fno-warn-name-shadowing #-}-{-# LANGUAGE Unsafe #-}-{-# LANGUAGE TemplateHaskellQuotes #-}-{-# OPTIONS_HADDOCK not-home #-}---- |--- Module : Data.ByteString.Short.Internal--- Copyright : (c) Duncan Coutts 2012-2013--- License : BSD-style------ Maintainer : duncan@community.haskell.org--- Stability : stable--- Portability : ghc only------ Internal representation of ShortByteString----module Data.ByteString.Short.Internal (-- -- * The @ShortByteString@ type and representation- ShortByteString(..),-- -- * Conversions- toShort,- fromShort,- pack,- unpack,-- -- * Other operations- empty, null, length, index, indexMaybe, (!?), unsafeIndex,-- -- * Low level operations- createFromPtr, copyToPtr,-- -- * Low level conversions- -- ** Packing 'CString's and pointers- packCString,- packCStringLen,-- -- ** Using ByteStrings as 'CString's- useAsCString,- useAsCStringLen- ) where--import Data.ByteString.Internal (ByteString(..), accursedUnutterablePerformIO)-import qualified Data.ByteString.Internal as BS--import Data.Typeable (Typeable)-import Data.Data (Data(..), mkNoRepType)-import Data.Semigroup (Semigroup((<>)))-import Data.Monoid (Monoid(..))-import Data.String (IsString(..))-import Control.DeepSeq (NFData(..))-import qualified Data.List as List (length)-import Foreign.C.String (CString, CStringLen)-import Foreign.C.Types (CSize(..), CInt(..))-import Foreign.Marshal.Alloc (allocaBytes)-import Foreign.ForeignPtr (touchForeignPtr)-import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)-import Foreign.Storable (pokeByteOff)--import qualified GHC.Exts-import GHC.Exts ( Int(I#), Int#, Ptr(Ptr), Addr#, Char(C#)- , State#, RealWorld- , ByteArray#, MutableByteArray#- , newByteArray#- , newPinnedByteArray#- , byteArrayContents#- , unsafeCoerce#-#if MIN_VERSION_base(4,10,0)- , isByteArrayPinned#- , isTrue#-#endif- , sizeofByteArray#- , indexWord8Array#, indexCharArray#- , writeWord8Array#, writeCharArray#- , unsafeFreezeByteArray# )-import GHC.IO-import GHC.ForeignPtr (ForeignPtr(ForeignPtr), ForeignPtrContents(PlainPtr))-import GHC.ST (ST(ST), runST)-import GHC.Stack.Types (HasCallStack)-import GHC.Word--import Prelude ( Eq(..), Ord(..), Ordering(..), Read(..), Show(..)- , ($), ($!), error, (++), (.)- , String, userError- , Bool(..), (&&), otherwise- , (+), (-), fromIntegral- , return- , Maybe(..) )--import qualified Language.Haskell.TH.Lib as TH-import qualified Language.Haskell.TH.Syntax as TH---- | A compact representation of a 'Word8' vector.------ It has a lower memory overhead than a 'ByteString' and does not--- contribute to heap fragmentation. It can be converted to or from a--- 'ByteString' (at the cost of copying the string data). It supports very few--- other operations.------ It is suitable for use as an internal representation for code that needs--- to keep many short strings in memory, but it /should not/ be used as an--- interchange type. That is, it should not generally be used in public APIs.--- The 'ByteString' type is usually more suitable for use in interfaces; it is--- more flexible and it supports a wide range of operations.----data ShortByteString = SBS ByteArray#- deriving Typeable---- | @since 0.11.2.0-instance TH.Lift ShortByteString where-#if MIN_VERSION_template_haskell(2,16,0)- lift sbs = [| unsafePackLenLiteral |]- `TH.appE` TH.litE (TH.integerL (fromIntegral len))- `TH.appE` TH.litE (TH.BytesPrimL $ TH.Bytes ptr 0 (fromIntegral len))- where- BS ptr len = fromShort sbs-#else- lift sbs = [| unsafePackLenLiteral |]- `TH.appE` TH.litE (TH.integerL (fromIntegral len))- `TH.appE` TH.litE (TH.StringPrimL $ BS.unpackBytes bs)- where- bs@(BS _ len) = fromShort sbs-#endif--#if MIN_VERSION_template_haskell(2,17,0)- liftTyped = TH.unsafeCodeCoerce . TH.lift-#elif MIN_VERSION_template_haskell(2,16,0)- liftTyped = TH.unsafeTExpCoerce . TH.lift-#endif---- The ByteArray# representation is always word sized and aligned but with a--- known byte length. Our representation choice for ShortByteString is to leave--- the 0--3 trailing bytes undefined. This means we can use word-sized writes,--- but we have to be careful with reads, see equateBytes and compareBytes below.---instance Eq ShortByteString where- (==) = equateBytes--instance Ord ShortByteString where- compare = compareBytes--instance Semigroup ShortByteString where- (<>) = append--instance Monoid ShortByteString where- mempty = empty- mappend = (<>)- mconcat = concat--instance NFData ShortByteString where- rnf SBS{} = ()--instance Show ShortByteString where- showsPrec p ps r = showsPrec p (unpackChars ps) r--instance Read ShortByteString where- readsPrec p str = [ (packChars x, y) | (x, y) <- readsPrec p str ]---- | @since 0.10.12.0-instance GHC.Exts.IsList ShortByteString where- type Item ShortByteString = Word8- fromList = packBytes- toList = unpackBytes---- | Beware: 'fromString' truncates multi-byte characters to octets.--- e.g. "枯朶に烏のとまりけり秋の暮" becomes �6k�nh~�Q��n�-instance IsString ShortByteString where- fromString = packChars--instance Data ShortByteString where- gfoldl f z txt = z packBytes `f` unpackBytes txt- toConstr _ = error "Data.ByteString.Short.ShortByteString.toConstr"- gunfold _ _ = error "Data.ByteString.Short.ShortByteString.gunfold"- dataTypeOf _ = mkNoRepType "Data.ByteString.Short.ShortByteString"----------------------------------------------------------------------------- Simple operations---- | /O(1)/. The empty 'ShortByteString'.-empty :: ShortByteString-empty = create 0 (\_ -> return ())---- | /O(1)/ The length of a 'ShortByteString'.-length :: ShortByteString -> Int-length (SBS barr#) = I# (sizeofByteArray# barr#)---- | /O(1)/ Test whether a 'ShortByteString' is empty.-null :: ShortByteString -> Bool-null sbs = length sbs == 0---- | /O(1)/ 'ShortByteString' index (subscript) operator, starting from 0.-index :: HasCallStack => ShortByteString -> Int -> Word8-index sbs i- | i >= 0 && i < length sbs = unsafeIndex sbs i- | otherwise = indexError sbs i---- | /O(1)/ 'ShortByteString' index, starting from 0, that returns 'Just' if:------ > 0 <= n < length bs------ @since 0.11.0.0-indexMaybe :: ShortByteString -> Int -> Maybe Word8-indexMaybe sbs i- | i >= 0 && i < length sbs = Just $! unsafeIndex sbs i- | otherwise = Nothing-{-# INLINE indexMaybe #-}---- | /O(1)/ 'ShortByteString' index, starting from 0, that returns 'Just' if:------ > 0 <= n < length bs------ @since 0.11.0.0-(!?) :: ShortByteString -> Int -> Maybe Word8-(!?) = indexMaybe-{-# INLINE (!?) #-}--unsafeIndex :: ShortByteString -> Int -> Word8-unsafeIndex sbs = indexWord8Array (asBA sbs)--indexError :: HasCallStack => ShortByteString -> Int -> a-indexError sbs i =- error $ "Data.ByteString.Short.index: error in array index; " ++ show i- ++ " not in range [0.." ++ show (length sbs) ++ ")"---- | @since 0.11.2.0-unsafePackLenLiteral :: Int -> Addr# -> ShortByteString-unsafePackLenLiteral len addr# =- accursedUnutterablePerformIO $ createFromPtr (Ptr addr#) len----------------------------------------------------------------------------- Internal utils--asBA :: ShortByteString -> BA-asBA (SBS ba#) = BA# ba#--create :: Int -> (forall s. MBA s -> ST s ()) -> ShortByteString-create len fill =- runST $ do- mba <- newByteArray len- fill mba- BA# ba# <- unsafeFreezeByteArray mba- return (SBS ba#)-{-# INLINE create #-}----------------------------------------------------------------------------- Conversion to and from ByteString---- | /O(n)/. Convert a 'ByteString' into a 'ShortByteString'.------ This makes a copy, so does not retain the input string.----toShort :: ByteString -> ShortByteString-toShort !bs = unsafeDupablePerformIO (toShortIO bs)--toShortIO :: ByteString -> IO ShortByteString-toShortIO (BS fptr len) = do- mba <- stToIO (newByteArray len)- let ptr = unsafeForeignPtrToPtr fptr- stToIO (copyAddrToByteArray ptr mba 0 len)- touchForeignPtr fptr- BA# ba# <- stToIO (unsafeFreezeByteArray mba)- return (SBS ba#)----- | /O(n)/. Convert a 'ShortByteString' into a 'ByteString'.----fromShort :: ShortByteString -> ByteString-#if MIN_VERSION_base(4,10,0)-fromShort (SBS b#)- | isTrue# (isByteArrayPinned# b#) = BS fp len- where- addr# = byteArrayContents# b#- fp = ForeignPtr addr# (PlainPtr (unsafeCoerce# b#))- len = I# (sizeofByteArray# b#)-#endif-fromShort !sbs = unsafeDupablePerformIO (fromShortIO sbs)--fromShortIO :: ShortByteString -> IO ByteString-fromShortIO sbs = do- let len = length sbs- mba@(MBA# mba#) <- stToIO (newPinnedByteArray len)- stToIO (copyByteArray (asBA sbs) 0 mba 0 len)- let fp = ForeignPtr (byteArrayContents# (unsafeCoerce# mba#))- (PlainPtr mba#)- return (BS fp len)------------------------------------------------------------------------------ Packing and unpacking from lists---- | /O(n)/. Convert a list into a 'ShortByteString'-pack :: [Word8] -> ShortByteString-pack = packBytes---- | /O(n)/. Convert a 'ShortByteString' into a list.-unpack :: ShortByteString -> [Word8]-unpack = unpackBytes--packChars :: [Char] -> ShortByteString-packChars cs = packLenChars (List.length cs) cs--packBytes :: [Word8] -> ShortByteString-packBytes cs = packLenBytes (List.length cs) cs--packLenChars :: Int -> [Char] -> ShortByteString-packLenChars len cs0 =- create len (\mba -> go mba 0 cs0)- where- go :: MBA s -> Int -> [Char] -> ST s ()- go !_ !_ [] = return ()- go !mba !i (c:cs) = do- writeCharArray mba i c- go mba (i+1) cs--packLenBytes :: Int -> [Word8] -> ShortByteString-packLenBytes len ws0 =- create len (\mba -> go mba 0 ws0)- where- go :: MBA s -> Int -> [Word8] -> ST s ()- go !_ !_ [] = return ()- go !mba !i (w:ws) = do- writeWord8Array mba i w- go mba (i+1) ws---- Unpacking bytestrings into lists effeciently is a tradeoff: on the one hand--- we would like to write a tight loop that just blats the list into memory, on--- the other hand we want it to be unpacked lazily so we don't end up with a--- massive list data structure in memory.------ Our strategy is to combine both: we will unpack lazily in reasonable sized--- chunks, where each chunk is unpacked strictly.------ unpackChars does the lazy loop, while unpackAppendBytes and--- unpackAppendChars do the chunks strictly.--unpackChars :: ShortByteString -> [Char]-unpackChars bs = unpackAppendCharsLazy bs []--unpackBytes :: ShortByteString -> [Word8]-unpackBytes bs = unpackAppendBytesLazy bs []---- Why 100 bytes you ask? Because on a 64bit machine the list we allocate--- takes just shy of 4k which seems like a reasonable amount.--- (5 words per list element, 8 bytes per word, 100 elements = 4000 bytes)--unpackAppendCharsLazy :: ShortByteString -> [Char] -> [Char]-unpackAppendCharsLazy sbs = go 0 (length sbs)- where- sz = 100-- go off len cs- | len <= sz = unpackAppendCharsStrict sbs off len cs- | otherwise = unpackAppendCharsStrict sbs off sz remainder- where remainder = go (off+sz) (len-sz) cs--unpackAppendBytesLazy :: ShortByteString -> [Word8] -> [Word8]-unpackAppendBytesLazy sbs = go 0 (length sbs)- where- sz = 100-- go off len ws- | len <= sz = unpackAppendBytesStrict sbs off len ws- | otherwise = unpackAppendBytesStrict sbs off sz remainder- where remainder = go (off+sz) (len-sz) ws---- For these unpack functions, since we're unpacking the whole list strictly we--- build up the result list in an accumulator. This means we have to build up--- the list starting at the end. So our traversal starts at the end of the--- buffer and loops down until we hit the sentinal:--unpackAppendCharsStrict :: ShortByteString -> Int -> Int -> [Char] -> [Char]-unpackAppendCharsStrict !sbs off len = go (off-1) (off-1 + len)- where- go !sentinal !i !acc- | i == sentinal = acc- | otherwise = let !c = indexCharArray (asBA sbs) i- in go sentinal (i-1) (c:acc)--unpackAppendBytesStrict :: ShortByteString -> Int -> Int -> [Word8] -> [Word8]-unpackAppendBytesStrict !sbs off len = go (off-1) (off-1 + len)- where- go !sentinal !i !acc- | i == sentinal = acc- | otherwise = let !w = indexWord8Array (asBA sbs) i- in go sentinal (i-1) (w:acc)------------------------------------------------------------------------------ Eq and Ord implementations--equateBytes :: ShortByteString -> ShortByteString -> Bool-equateBytes sbs1 sbs2 =- let !len1 = length sbs1- !len2 = length sbs2- in len1 == len2- && 0 == accursedUnutterablePerformIO- (memcmp_ByteArray (asBA sbs1) (asBA sbs2) len1)--compareBytes :: ShortByteString -> ShortByteString -> Ordering-compareBytes sbs1 sbs2 =- let !len1 = length sbs1- !len2 = length sbs2- !len = min len1 len2- in case accursedUnutterablePerformIO- (memcmp_ByteArray (asBA sbs1) (asBA sbs2) len) of- i | i < 0 -> LT- | i > 0 -> GT- | len2 > len1 -> LT- | len2 < len1 -> GT- | otherwise -> EQ------------------------------------------------------------------------------ Appending and concatenation--append :: ShortByteString -> ShortByteString -> ShortByteString-append src1 src2 =- let !len1 = length src1- !len2 = length src2- in create (len1 + len2) $ \dst -> do- copyByteArray (asBA src1) 0 dst 0 len1- copyByteArray (asBA src2) 0 dst len1 len2--concat :: [ShortByteString] -> ShortByteString-concat sbss =- create (totalLen 0 sbss) (\dst -> copy dst 0 sbss)- where- totalLen !acc [] = acc- totalLen !acc (sbs: sbss) = totalLen (acc + length sbs) sbss-- copy :: MBA s -> Int -> [ShortByteString] -> ST s ()- copy !_ !_ [] = return ()- copy !dst !off (src : sbss) = do- let !len = length src- copyByteArray (asBA src) 0 dst off len- copy dst (off + len) sbss------------------------------------------------------------------------------ Exported low level operations--copyToPtr :: ShortByteString -- ^ source data- -> Int -- ^ offset into source- -> Ptr a -- ^ destination- -> Int -- ^ number of bytes to copy- -> IO ()-copyToPtr src off dst len =- stToIO $- copyByteArrayToAddr (asBA src) off dst len--createFromPtr :: Ptr a -- ^ source data- -> Int -- ^ number of bytes to copy- -> IO ShortByteString-createFromPtr !ptr len =- stToIO $ do- mba <- newByteArray len- copyAddrToByteArray ptr mba 0 len- BA# ba# <- unsafeFreezeByteArray mba- return (SBS ba#)------------------------------------------------------------------------------ Primop wrappers--data BA = BA# ByteArray#-data MBA s = MBA# (MutableByteArray# s)--indexCharArray :: BA -> Int -> Char-indexCharArray (BA# ba#) (I# i#) = C# (indexCharArray# ba# i#)--indexWord8Array :: BA -> Int -> Word8-indexWord8Array (BA# ba#) (I# i#) = W8# (indexWord8Array# ba# i#)--newByteArray :: Int -> ST s (MBA s)-newByteArray (I# len#) =- ST $ \s -> case newByteArray# len# s of- (# s, mba# #) -> (# s, MBA# mba# #)--newPinnedByteArray :: Int -> ST s (MBA s)-newPinnedByteArray (I# len#) =- ST $ \s -> case newPinnedByteArray# len# s of- (# s, mba# #) -> (# s, MBA# mba# #)--unsafeFreezeByteArray :: MBA s -> ST s BA-unsafeFreezeByteArray (MBA# mba#) =- ST $ \s -> case unsafeFreezeByteArray# mba# s of- (# s, ba# #) -> (# s, BA# ba# #)--writeCharArray :: MBA s -> Int -> Char -> ST s ()-writeCharArray (MBA# mba#) (I# i#) (C# c#) =- ST $ \s -> case writeCharArray# mba# i# c# s of- s -> (# s, () #)--writeWord8Array :: MBA s -> Int -> Word8 -> ST s ()-writeWord8Array (MBA# mba#) (I# i#) (W8# w#) =- ST $ \s -> case writeWord8Array# mba# i# w# s of- s -> (# s, () #)--copyAddrToByteArray :: Ptr a -> MBA RealWorld -> Int -> Int -> ST RealWorld ()-copyAddrToByteArray (Ptr src#) (MBA# dst#) (I# dst_off#) (I# len#) =- ST $ \s -> case copyAddrToByteArray# src# dst# dst_off# len# s of- s -> (# s, () #)--copyByteArrayToAddr :: BA -> Int -> Ptr a -> Int -> ST RealWorld ()-copyByteArrayToAddr (BA# src#) (I# src_off#) (Ptr dst#) (I# len#) =- ST $ \s -> case copyByteArrayToAddr# src# src_off# dst# len# s of- s -> (# s, () #)--copyByteArray :: BA -> Int -> MBA s -> Int -> Int -> ST s ()-copyByteArray (BA# src#) (I# src_off#) (MBA# dst#) (I# dst_off#) (I# len#) =- ST $ \s -> case copyByteArray# src# src_off# dst# dst_off# len# s of- s -> (# s, () #)------------------------------------------------------------------------------ FFI imports--memcmp_ByteArray :: BA -> BA -> Int -> IO CInt-memcmp_ByteArray (BA# ba1#) (BA# ba2#) len =- c_memcmp_ByteArray ba1# ba2# (fromIntegral len)--foreign import ccall unsafe "string.h memcmp"- c_memcmp_ByteArray :: ByteArray# -> ByteArray# -> CSize -> IO CInt------------------------------------------------------------------------------ Primop replacements--copyAddrToByteArray# :: Addr#- -> MutableByteArray# RealWorld -> Int#- -> Int#- -> State# RealWorld -> State# RealWorld--copyByteArrayToAddr# :: ByteArray# -> Int#- -> Addr#- -> Int#- -> State# RealWorld -> State# RealWorld--copyByteArray# :: ByteArray# -> Int#- -> MutableByteArray# s -> Int#- -> Int#- -> State# s -> State# s--copyAddrToByteArray# = GHC.Exts.copyAddrToByteArray#-copyByteArrayToAddr# = GHC.Exts.copyByteArrayToAddr#-copyByteArray# = GHC.Exts.copyByteArray#---- | /O(n)./ Construct a new @ShortByteString@ from a @CString@. The--- resulting @ShortByteString@ is an immutable copy of the original--- @CString@, and is managed on the Haskell heap. The original--- @CString@ must be null terminated.------ @since 0.10.10.0-packCString :: CString -> IO ShortByteString-packCString cstr = do- len <- BS.c_strlen cstr- packCStringLen (cstr, fromIntegral len)---- | /O(n)./ Construct a new @ShortByteString@ from a @CStringLen@. The--- resulting @ShortByteString@ is an immutable copy of the original @CStringLen@.--- The @ShortByteString@ is a normal Haskell value and will be managed on the--- Haskell heap.------ @since 0.10.10.0-packCStringLen :: CStringLen -> IO ShortByteString-packCStringLen (cstr, len) | len >= 0 = createFromPtr cstr len-packCStringLen (_, len) =- moduleErrorIO "packCStringLen" ("negative length: " ++ show len)---- | /O(n) construction./ Use a @ShortByteString@ with a function requiring a--- null-terminated @CString@. The @CString@ is a copy and will be freed--- automatically; it must not be stored or used after the--- subcomputation finishes.------ @since 0.10.10.0-useAsCString :: ShortByteString -> (CString -> IO a) -> IO a-useAsCString bs action =- allocaBytes (l+1) $ \buf -> do- copyToPtr bs 0 buf (fromIntegral l)- pokeByteOff buf l (0::Word8)- action buf- where l = length bs---- | /O(n) construction./ Use a @ShortByteString@ with a function requiring a @CStringLen@.--- As for @useAsCString@ this function makes a copy of the original @ShortByteString@.--- It must not be stored or used after the subcomputation finishes.------ @since 0.10.10.0-useAsCStringLen :: ShortByteString -> (CStringLen -> IO a) -> IO a-useAsCStringLen bs action =- allocaBytes l $ \buf -> do- copyToPtr bs 0 buf (fromIntegral l)- action (buf, l)- where l = length bs---- ------------------------------------------------------------------------ Internal utilities--moduleErrorIO :: HasCallStack => String -> String -> IO a-moduleErrorIO fun msg = throwIO . userError $ moduleErrorMsg fun msg-{-# NOINLINE moduleErrorIO #-}--moduleErrorMsg :: String -> String -> String-moduleErrorMsg fun msg = "Data.ByteString.Short." ++ fun ++ ':':' ':msg+{-# LANGUAGE CPP #-}+{-# LANGUAGE Unsafe #-}++{-# OPTIONS_HADDOCK not-home #-}+{-# OPTIONS_GHC -fexpose-all-unfoldings #-}++{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UnliftedFFITypes #-}++#include "bytestring-cpp-macros.h"++-- |+-- Module : Data.ByteString.Short.Internal+-- Copyright : (c) Duncan Coutts 2012-2013, Julian Ospald 2022+-- License : BSD-style+--+-- Maintainer : hasufell@posteo.de+-- Stability : stable+-- Portability : ghc only+--+-- Internal representation of ShortByteString+--+module Data.ByteString.Short.Internal (++ -- * The @ShortByteString@ type and representation+ ShortByteString(.., SBS),++ -- * Introducing and eliminating 'ShortByteString's+ empty,+ singleton,+ pack,+ unpack,+ fromShort,+ toShort,++ -- * Basic interface+ snoc,+ cons,+ append,+ last,+ tail,+ uncons,+ head,+ init,+ unsnoc,+ null,+ length,++ -- * Transforming ShortByteStrings+ map,+ reverse,+ intercalate,++ -- * Reducing 'ShortByteString's (folds)+ foldl,+ foldl',+ foldl1,+ foldl1',++ foldr,+ foldr',+ foldr1,+ foldr1',++ -- ** Special folds+ all,+ any,+ concat,++ -- ** Generating and unfolding ShortByteStrings+ replicate,+ unfoldr,+ unfoldrN,++ -- * Substrings++ -- ** Breaking strings+ take,+ takeEnd,+ takeWhileEnd,+ takeWhile,+ drop,+ dropEnd,+ dropWhile,+ dropWhileEnd,+ breakEnd,+ break,+ span,+ spanEnd,+ splitAt,+ split,+ splitWith,+ stripSuffix,+ stripPrefix,++ -- * Predicates+ isInfixOf,+ isPrefixOf,+ isSuffixOf,++ -- ** Search for arbitrary substrings+ breakSubstring,++ -- * Searching ShortByteStrings++ -- ** Searching by equality+ elem,++ -- ** Searching with a predicate+ find,+ filter,+ partition,++ -- * Indexing ShortByteStrings+ index,+ indexMaybe,+ (!?),+ elemIndex,+ elemIndices,+ count,+ findIndex,+ findIndices,+ unsafeIndex,++ -- * Low level operations+ createFromPtr,+ copyToPtr,++ -- ** Encoding validation+ isValidUtf8,++ -- * Low level conversions+ -- ** Packing 'Foreign.C.String.CString's and pointers+ packCString,+ packCStringLen,++ -- ** Using ShortByteStrings as 'Foreign.C.String.CString's+ useAsCString,+ useAsCStringLen,+ ) where++import Data.ByteString.Internal.Type+ ( ByteString(..)+ , unsafeDupablePerformIO+ , accursedUnutterablePerformIO+ , checkedAdd+ , c_elem_index+ , cIsValidUtf8BASafe+ , cIsValidUtf8BA+ )++import Data.Array.Byte+ ( ByteArray(..), MutableByteArray(..) )+import Data.Bits+ ( FiniteBits (finiteBitSize)+ , shiftL+#if HS_UNALIGNED_ByteArray_OPS_OK+ , shiftR+#endif+ , (.&.)+ , (.|.)+ )+import Data.Data+ ( Data(..) )+import Data.Monoid+ ( Monoid(..) )+import Data.Semigroup+ ( Semigroup(..), stimesMonoid )+import Data.List.NonEmpty+ ( NonEmpty(..) )+import Data.String+ ( IsString(..) )+import Control.Applicative+ ( pure )+import Control.DeepSeq+ ( NFData )+import Control.Exception+ ( assert )+import Control.Monad+ ( (>>) )+import Foreign.C.String+ ( CString+ , CStringLen+ )+import Foreign.Marshal.Alloc+ ( allocaBytes )+import Foreign.Storable+ ( pokeByteOff )+import GHC.Exts+ ( Int(I#), Int#, Ptr(Ptr), Addr#, Char(C#)+ , State#, RealWorld+ , ByteArray#, MutableByteArray#+ , newByteArray#+ , byteArrayContents#+ , unsafeCoerce#+ , copyMutableByteArray#+ , isByteArrayPinned#+ , isTrue#+ , compareByteArrays#+ , sizeofByteArray#+ , indexWord8Array#, indexCharArray#+ , writeWord8Array#+ , unsafeFreezeByteArray#+#if HS_UNALIGNED_ByteArray_OPS_OK+ ,writeWord64Array#+ ,indexWord8ArrayAsWord64#+#endif+ , setByteArray#+ , sizeofByteArray#+ , indexWord8Array#, indexCharArray#+ , writeWord8Array#+ , unsafeFreezeByteArray#+ , touch# )+import GHC.Generics+ ( Generic )+import GHC.IO hiding ( unsafeDupablePerformIO )+import GHC.ForeignPtr+ ( ForeignPtr(ForeignPtr)+ , ForeignPtrContents(PlainPtr)+ )+import GHC.ST+ ( ST(ST)+ , runST+ )+import GHC.Stack.Types+ ( HasCallStack )+import GHC.Word+import Prelude+ ( Eq(..), Ord(..), Ordering(..), Read(..), Show(..)+ , ($), ($!), error, (++), (.), (||)+ , String, userError+ , Bool(..), (&&), otherwise+ , (+), (-), fromIntegral+ , (*)+ , (^)+ , (<$>)+ , return+ , Maybe(..)+ , not+ , snd+ )++import qualified Data.ByteString.Internal.Type as BS++import qualified Data.List as List+import qualified GHC.Exts+import qualified Language.Haskell.TH.Syntax as TH++-- | A compact representation of a 'Word8' vector.+--+-- It has a lower memory overhead than a 'ByteString' and does not+-- contribute to heap fragmentation. It can be converted to or from a+-- 'ByteString' (at the cost of copying the string data). It supports very few+-- other operations.+--+newtype ShortByteString =+ -- | @since 0.12.0.0+ ShortByteString+ { unShortByteString :: ByteArray+ -- ^ @since 0.12.0.0+ }+ deriving (Eq, TH.Lift, Data, Generic, NFData)++-- | Prior to @bytestring-0.12@ 'SBS' was a genuine constructor of 'ShortByteString',+-- but now it is a bundled pattern synonym, provided as a compatibility shim.+pattern SBS :: ByteArray# -> ShortByteString+pattern SBS x = ShortByteString (ByteArray x)+{-# COMPLETE SBS #-}++-- | Lexicographic order.+instance Ord ShortByteString where+ compare = compareBytes++-- Instead of deriving Semigroup / Monoid , we stick to our own implementations+-- of mappend / mconcat, because they are safer with regards to overflows+-- (see prop_32bitOverflow_Short_mconcat test).+-- ByteArray is likely to catch up starting from GHC 9.6:+-- * https://gitlab.haskell.org/ghc/ghc/-/merge_requests/8272+-- * https://gitlab.haskell.org/ghc/ghc/-/merge_requests/9128++instance Semigroup ShortByteString where+ (<>) = append+ sconcat (b:|bs) = concat (b:bs)+ stimes = stimesMonoid++instance Monoid ShortByteString where+ mempty = empty+ mappend = (<>)+ mconcat = concat++instance Show ShortByteString where+ showsPrec p ps r = showsPrec p (unpackChars ps) r++instance Read ShortByteString where+ readsPrec p str = [ (packChars x, y) | (x, y) <- readsPrec p str ]++-- | @since 0.10.12.0+instance GHC.Exts.IsList ShortByteString where+ type Item ShortByteString = Word8+ fromList = ShortByteString . GHC.Exts.fromList+ fromListN = (ShortByteString .) . GHC.Exts.fromListN+ toList = GHC.Exts.toList . unShortByteString++-- | Beware: 'fromString' truncates multi-byte characters to octets.+-- e.g. "枯朶に烏のとまりけり秋の暮" becomes �6k�nh~�Q��n�+instance IsString ShortByteString where+ fromString = packChars++------------------------------------------------------------------------+-- Simple operations++-- | /O(1)/. The empty 'ShortByteString'.+empty :: ShortByteString+empty = create 0 (\_ -> return ())++-- | /O(1)/ The length of a 'ShortByteString'.+length :: ShortByteString -> Int+length (SBS barr#) = I# (sizeofByteArray# barr#)++-- | /O(1)/ Test whether a 'ShortByteString' is empty.+null :: ShortByteString -> Bool+null sbs = length sbs == 0++-- | /O(1)/ 'ShortByteString' index (subscript) operator, starting from 0.+--+-- This is a partial function, consider using 'indexMaybe' instead.+index :: HasCallStack => ShortByteString -> Int -> Word8+index sbs i+ | i >= 0 && i < length sbs = unsafeIndex sbs i+ | otherwise = indexError sbs i++-- | /O(1)/ 'ShortByteString' index, starting from 0, that returns 'Just' if:+--+-- > 0 <= n < length bs+--+-- @since 0.11.0.0+indexMaybe :: ShortByteString -> Int -> Maybe Word8+indexMaybe sbs i+ | i >= 0 && i < length sbs = Just $! unsafeIndex sbs i+ | otherwise = Nothing+{-# INLINE indexMaybe #-}++-- | /O(1)/ 'ShortByteString' index, starting from 0, that returns 'Just' if:+--+-- > 0 <= n < length bs+--+-- @since 0.11.0.0+(!?) :: ShortByteString -> Int -> Maybe Word8+(!?) = indexMaybe+{-# INLINE (!?) #-}++-- | /O(1)/ Unsafe indexing without bounds checking.+unsafeIndex :: ShortByteString -> Int -> Word8+unsafeIndex sbs = indexWord8Array (asBA sbs)++indexError :: HasCallStack => ShortByteString -> Int -> a+indexError sbs i =+ moduleError "index" $ "error in array index: " ++ show i+ ++ " not in range [0.." ++ show (length sbs) ++ "]"++------------------------------------------------------------------------+-- Internal utils++asBA :: ShortByteString -> ByteArray+asBA (ShortByteString ba) = ba++create :: Int -> (forall s. MutableByteArray s -> ST s ()) -> ShortByteString+create len fill =+ assert (len >= 0) $ runST $ do+ mba <- newByteArray len+ fill mba+ ShortByteString <$> unsafeFreezeByteArray mba+{-# INLINE create #-}++-- | Given the maximum size needed and a function to make the contents+-- of a ShortByteString, createAndTrim makes the 'ShortByteString'.+-- The generating function is required to return the actual final size+-- (<= the maximum size) and the result value. The resulting byte array+-- is realloced to this size.+createAndTrim :: Int -> (forall s. MutableByteArray s -> ST s (Int, a)) -> (ShortByteString, a)+createAndTrim maxLen fill =+ assert (maxLen >= 0) $ runST $ do+ mba <- newByteArray maxLen+ (len, res) <- fill mba+ if assert (0 <= len && len <= maxLen) $ len >= maxLen+ then do+ ba <- unsafeFreezeByteArray mba+ return (ShortByteString ba, res)+ else do+ mba2 <- newByteArray len+ copyMutableByteArray mba 0 mba2 0 len+ ba <- unsafeFreezeByteArray mba2+ return (ShortByteString ba, res)+{-# INLINE createAndTrim #-}++createAndTrim' :: Int -> (forall s. MutableByteArray s -> ST s Int) -> ShortByteString+createAndTrim' maxLen fill =+ assert (maxLen >= 0) $ runST $ do+ mba <- newByteArray maxLen+ len <- fill mba+ if assert (0 <= len && len <= maxLen) $ len >= maxLen+ then do+ ShortByteString <$> unsafeFreezeByteArray mba+ else do+ mba2 <- newByteArray len+ copyMutableByteArray mba 0 mba2 0 len+ ShortByteString <$> unsafeFreezeByteArray mba2+{-# INLINE createAndTrim' #-}++-- | Like createAndTrim, but with two buffers at once+createAndTrim2 :: Int -> Int -> (forall s. MutableByteArray s -> MutableByteArray s -> ST s (Int, Int)) -> (ShortByteString, ShortByteString)+createAndTrim2 maxLen1 maxLen2 fill =+ runST $ do+ mba1 <- newByteArray maxLen1+ mba2 <- newByteArray maxLen2+ (len1, len2) <- fill mba1 mba2+ sbs1 <- freeze' len1 maxLen1 mba1+ sbs2 <- freeze' len2 maxLen2 mba2+ pure (sbs1, sbs2)+ where+ freeze' :: Int -> Int -> MutableByteArray s -> ST s ShortByteString+ freeze' len maxLen mba =+ if assert (0 <= len && len <= maxLen) $ len >= maxLen+ then do+ ShortByteString <$> unsafeFreezeByteArray mba+ else do+ mba2 <- newByteArray len+ copyMutableByteArray mba 0 mba2 0 len+ ShortByteString <$> unsafeFreezeByteArray mba2+{-# INLINE createAndTrim2 #-}++isPinned :: ByteArray# -> Bool+isPinned ba# = isTrue# (isByteArrayPinned# ba#)++------------------------------------------------------------------------+-- Conversion to and from ByteString++-- | /O(n)/. Convert a 'ByteString' into a 'ShortByteString'.+--+-- This makes a copy, so does not retain the input string.+--+toShort :: ByteString -> ShortByteString+toShort !bs = unsafeDupablePerformIO (toShortIO bs)++toShortIO :: ByteString -> IO ShortByteString+toShortIO (BS fptr len) = do+ mba <- stToIO (newByteArray len)+ BS.unsafeWithForeignPtr fptr $ \ptr ->+ stToIO (copyAddrToByteArray ptr mba 0 len)+ ShortByteString <$> stToIO (unsafeFreezeByteArray mba)++-- | /O(n)/. Convert a 'ShortByteString' into a 'ByteString'.+--+fromShort :: ShortByteString -> ByteString+fromShort sbs@(SBS b#)+ | isPinned b# = BS inPlaceFp len+ | otherwise = BS.unsafeCreateFp len $ \fp ->+ BS.unsafeWithForeignPtr fp $ \p -> copyToPtr sbs 0 p len+ where+ inPlaceFp = ForeignPtr (byteArrayContents# b#)+ (PlainPtr (unsafeCoerce# b#))+ len = I# (sizeofByteArray# b#)++-- | /O(1)/ Convert a 'Word8' into a 'ShortByteString'+--+-- @since 0.11.3.0+singleton :: Word8 -> ShortByteString+singleton = \w -> create 1 (\mba -> writeWord8Array mba 0 w)++------------------------------------------------------------------------+-- Packing and unpacking from lists++-- | /O(n)/. Convert a list into a 'ShortByteString'+pack :: [Word8] -> ShortByteString+pack = packBytes++-- | /O(n)/. Convert a 'ShortByteString' into a list.+unpack :: ShortByteString -> [Word8]+unpack sbs = GHC.Exts.build (unpackFoldr sbs)+{-# INLINE unpack #-}++--+-- Have unpack fuse with good list consumers+--+unpackFoldr :: ShortByteString -> (Word8 -> a -> a) -> a -> a+unpackFoldr sbs k z = foldr k z sbs+{-# INLINE [0] unpackFoldr #-}++{-# RULES+"ShortByteString unpack-list" [1] forall bs .+ unpackFoldr bs (:) [] = unpackBytes bs+ #-}++packChars :: [Char] -> ShortByteString+packChars = \cs -> packLenBytes (List.length cs) (List.map BS.c2w cs)++packBytes :: [Word8] -> ShortByteString+packBytes = \ws -> packLenBytes (List.length ws) ws++packLenBytes :: Int -> [Word8] -> ShortByteString+packLenBytes len ws0 =+ create len (\mba -> go mba 0 ws0)+ where+ go :: MutableByteArray s -> Int -> [Word8] -> ST s ()+ go !_ !_ [] = return ()+ go !mba !i (w:ws) = do+ writeWord8Array mba i w+ go mba (i+1) ws++-- Unpacking bytestrings into lists efficiently is a tradeoff: on the one hand+-- we would like to write a tight loop that just blats the list into memory, on+-- the other hand we want it to be unpacked lazily so we don't end up with a+-- massive list data structure in memory.+--+-- Our strategy is to combine both: we will unpack lazily in reasonable sized+-- chunks, where each chunk is unpacked strictly.+--+-- unpackChars does the lazy loop, while unpackAppendBytes and+-- unpackAppendChars do the chunks strictly.++unpackChars :: ShortByteString -> [Char]+unpackChars sbs = unpackAppendCharsLazy sbs []++unpackBytes :: ShortByteString -> [Word8]+unpackBytes sbs = unpackAppendBytesLazy sbs []+++-- Why 100 bytes you ask? Because on a 64bit machine the list we allocate+-- takes just shy of 4k which seems like a reasonable amount.+-- (5 words per list element, 8 bytes per word, 100 elements = 4000 bytes)++unpackAppendCharsLazy :: ShortByteString -> [Char] -> [Char]+unpackAppendCharsLazy sbs = go 0 (length sbs)+ where+ sz = 100++ go off len cs+ | len <= sz = unpackAppendCharsStrict sbs off len cs+ | otherwise = unpackAppendCharsStrict sbs off sz remainder+ where remainder = go (off+sz) (len-sz) cs++unpackAppendBytesLazy :: ShortByteString -> [Word8] -> [Word8]+unpackAppendBytesLazy sbs = go 0 (length sbs)+ where+ sz = 100++ go off len ws+ | len <= sz = unpackAppendBytesStrict sbs off len ws+ | otherwise = unpackAppendBytesStrict sbs off sz remainder+ where remainder = go (off+sz) (len-sz) ws++-- For these unpack functions, since we're unpacking the whole list strictly we+-- build up the result list in an accumulator. This means we have to build up+-- the list starting at the end. So our traversal starts at the end of the+-- buffer and loops down until we hit the sentinal:++unpackAppendCharsStrict :: ShortByteString -> Int -> Int -> [Char] -> [Char]+unpackAppendCharsStrict !sbs off len = go (off-1) (off-1 + len)+ where+ go !sentinal !i acc+ | i == sentinal = acc+ | otherwise = let !c = indexCharArray (asBA sbs) i+ in go sentinal (i-1) (c:acc)++unpackAppendBytesStrict :: ShortByteString -> Int -> Int -> [Word8] -> [Word8]+unpackAppendBytesStrict !sbs off len = go (off-1) (off-1 + len)+ where+ go !sentinal !i acc+ | i == sentinal = acc+ | otherwise = let !w = indexWord8Array (asBA sbs) i+ in go sentinal (i-1) (w:acc)+++------------------------------------------------------------------------+-- Eq and Ord implementations++compareBytes :: ShortByteString -> ShortByteString -> Ordering+compareBytes sbs1 sbs2 =+ let !len1 = length sbs1+ !len2 = length sbs2+ !len = min len1 len2+ in case compareByteArrays (asBA sbs1) (asBA sbs2) len of+ i | i < 0 -> LT+ | i > 0 -> GT+ | len2 > len1 -> LT+ | len2 < len1 -> GT+ | otherwise -> EQ++------------------------------------------------------------------------+-- Appending and concatenation++append :: ShortByteString -> ShortByteString -> ShortByteString+append src1 src2 =+ let !len1 = length src1+ !len2 = length src2+ in create (checkedAdd "Short.append" len1 len2) $ \dst -> do+ copyByteArray (asBA src1) 0 dst 0 len1+ copyByteArray (asBA src2) 0 dst len1 len2++concat :: [ShortByteString] -> ShortByteString+concat = \sbss ->+ create (totalLen 0 sbss) (\dst -> copy dst 0 sbss)+ where+ totalLen !acc [] = acc+ totalLen !acc (curr : rest)+ = totalLen (checkedAdd "Short.concat" acc $ length curr) rest++ copy :: MutableByteArray s -> Int -> [ShortByteString] -> ST s ()+ copy !_ !_ [] = return ()+ copy !dst !off (src : sbss) = do+ let !len = length src+ copyByteArray (asBA src) 0 dst off len+ copy dst (off + len) sbss++-- ---------------------------------------------------------------------+-- Basic interface++infixr 5 `cons` --same as list (:)+infixl 5 `snoc`++-- | /O(n)/ Append a byte to the end of a 'ShortByteString'+--+-- Note: copies the entire byte array+--+-- @since 0.11.3.0+snoc :: ShortByteString -> Word8 -> ShortByteString+snoc = \sbs c -> let len = length sbs+ newLen = checkedAdd "Short.snoc" len 1+ in create newLen $ \mba -> do+ copyByteArray (asBA sbs) 0 mba 0 len+ writeWord8Array mba len c++-- | /O(n)/ 'cons' is analogous to (:) for lists.+--+-- Note: copies the entire byte array+--+-- @since 0.11.3.0+cons :: Word8 -> ShortByteString -> ShortByteString+cons c = \sbs -> let len = length sbs+ newLen = checkedAdd "Short.cons" len 1+ in create newLen $ \mba -> do+ writeWord8Array mba 0 c+ copyByteArray (asBA sbs) 0 mba 1 len++-- | /O(1)/ Extract the last element of a ShortByteString, which must be finite and non-empty.+-- An exception will be thrown in the case of an empty ShortByteString.+--+-- This is a partial function, consider using 'unsnoc' instead.+--+-- @since 0.11.3.0+last :: HasCallStack => ShortByteString -> Word8+last = \sbs -> case null sbs of+ True -> errorEmptySBS "last"+ False -> indexWord8Array (asBA sbs) (length sbs - 1)++-- | /O(n)/ Extract the elements after the head of a ShortByteString, which must be non-empty.+-- An exception will be thrown in the case of an empty ShortByteString.+--+-- This is a partial function, consider using 'uncons' instead.+--+-- Note: copies the entire byte array+--+-- @since 0.11.3.0+tail :: HasCallStack => ShortByteString -> ShortByteString+tail = \sbs ->+ let l = length sbs+ nl = l - 1+ in case null sbs of+ True -> errorEmptySBS "tail"+ False -> create nl $ \mba -> copyByteArray (asBA sbs) 1 mba 0 nl++-- | /O(n)/ Extract the 'head' and 'tail' of a ShortByteString, returning 'Nothing'+-- if it is empty.+--+-- @since 0.11.3.0+uncons :: ShortByteString -> Maybe (Word8, ShortByteString)+uncons = \sbs ->+ let l = length sbs+ nl = l - 1+ in if | l <= 0 -> Nothing+ | otherwise -> let h = indexWord8Array (asBA sbs) 0+ t = create nl $ \mba -> copyByteArray (asBA sbs) 1 mba 0 nl+ in Just (h, t)++-- | /O(1)/ Extract the first element of a ShortByteString, which must be non-empty.+-- An exception will be thrown in the case of an empty ShortByteString.+--+-- This is a partial function, consider using 'uncons' instead.+--+-- @since 0.11.3.0+head :: HasCallStack => ShortByteString -> Word8+head = \sbs -> case null sbs of+ True -> errorEmptySBS "head"+ False -> indexWord8Array (asBA sbs) 0++-- | /O(n)/ Return all the elements of a 'ShortByteString' except the last one.+-- An exception will be thrown in the case of an empty ShortByteString.+--+-- This is a partial function, consider using 'unsnoc' instead.+--+-- Note: copies the entire byte array+--+-- @since 0.11.3.0+init :: HasCallStack => ShortByteString -> ShortByteString+init = \sbs ->+ let l = length sbs+ nl = l - 1+ in case null sbs of+ True -> errorEmptySBS "init"+ False -> create nl $ \mba -> copyByteArray (asBA sbs) 0 mba 0 nl++-- | /O(n)/ Extract the 'init' and 'last' of a ShortByteString, returning 'Nothing'+-- if it is empty.+--+-- @since 0.11.3.0+unsnoc :: ShortByteString -> Maybe (ShortByteString, Word8)+unsnoc = \sbs ->+ let l = length sbs+ nl = l - 1+ in if | l <= 0 -> Nothing+ | otherwise -> let l' = indexWord8Array (asBA sbs) (l - 1)+ i = create nl $ \mba -> copyByteArray (asBA sbs) 0 mba 0 nl+ in Just (i, l')+++-- ---------------------------------------------------------------------+-- Transformations++-- | /O(n)/ 'map' @f xs@ is the ShortByteString obtained by applying @f@ to each+-- element of @xs@.+--+-- @since 0.11.3.0+map :: (Word8 -> Word8) -> ShortByteString -> ShortByteString+map f = \sbs ->+ let l = length sbs+ ba = asBA sbs+ in create l (\mba -> go ba mba 0 l)+ where+ go :: ByteArray -> MutableByteArray s -> Int -> Int -> ST s ()+ go !ba !mba !i !l+ | i >= l = return ()+ | otherwise = do+ let w = indexWord8Array ba i+ writeWord8Array mba i (f w)+ go ba mba (i+1) l+++-- | /O(n)/ 'reverse' @xs@ efficiently returns the elements of @xs@ in reverse order.+--+-- @since 0.11.3.0+reverse :: ShortByteString -> ShortByteString+reverse = \sbs ->+ let l = length sbs+ ba = asBA sbs+#if HS_UNALIGNED_ByteArray_OPS_OK+ in create l (\mba -> go ba mba l)+ where+ go :: forall s. ByteArray -> MutableByteArray s -> Int -> ST s ()+ go !ba !mba !l = do+ -- this is equivalent to: (q, r) = l `quotRem` 8+ let q = l `shiftR` 3+ r = l .&. 7+ i' <- goWord8Chunk 0 r+ goWord64Chunk i' 0 q+ where++ goWord64Chunk :: Int -> Int -> Int -> ST s ()+ goWord64Chunk !off !i' !cl = loop i'+ where+ loop :: Int -> ST s ()+ loop !i+ | i >= cl = return ()+ | otherwise = do+ let w = indexWord8ArrayAsWord64 ba (off + (i * 8))+ writeWord64Array mba (cl - 1 - i) (byteSwap64 w)+ loop (i+1)++ goWord8Chunk :: Int -> Int -> ST s Int+ goWord8Chunk !i' !cl = loop i'+ where+ loop :: Int -> ST s Int+ loop !i+ | i >= cl = return i+ | otherwise = do+ let w = indexWord8Array ba i+ writeWord8Array mba (l - 1 - i) w+ loop (i+1)+#else+ in create l (\mba -> go ba mba 0 l)+ where+ go :: ByteArray -> MutableByteArray s -> Int -> Int -> ST s ()+ go !ba !mba !i !l+ | i >= l = return ()+ | otherwise = do+ let w = indexWord8Array ba i+ writeWord8Array mba (l - 1 - i) w+ go ba mba (i+1) l+#endif+++-- | /O(n)/ The 'intercalate' function takes a 'ShortByteString' and a list of+-- 'ShortByteString's and concatenates the list after interspersing the first+-- argument between each element of the list.+--+-- @since 0.11.3.0+intercalate :: ShortByteString -> [ShortByteString] -> ShortByteString+intercalate sep = \case+ [] -> empty+ [x] -> x -- This branch exists for laziness, not speed+ (sbs:t) -> let !totalLen = List.foldl' (\acc chunk -> acc +! length sep +! length chunk) (length sbs) t+ in create totalLen (\mba ->+ let !l = length sbs+ in copyByteArray (asBA sbs) 0 mba 0 l >> go mba l t)+ where+ ba = asBA sep+ lba = length sep++ go :: MutableByteArray s -> Int -> [ShortByteString] -> ST s ()+ go _ _ [] = pure ()+ go mba !off (chunk:chunks) = do+ let lc = length chunk+ copyByteArray ba 0 mba off lba+ copyByteArray (asBA chunk) 0 mba (off + lba) lc+ go mba (off + lc + lba) chunks+ (+!) = checkedAdd "Short.intercalate"+++-- ---------------------------------------------------------------------+-- Reducing 'ShortByteString's++-- | 'foldl', applied to a binary operator, a starting value (typically+-- the left-identity of the operator), and a ShortByteString, reduces the+-- ShortByteString using the binary operator, from left to right.+--+-- @since 0.11.3.0+foldl :: (a -> Word8 -> a) -> a -> ShortByteString -> a+foldl f v = List.foldl f v . unpack++-- | 'foldl'' is like 'foldl', but strict in the accumulator.+--+-- @since 0.11.3.0+foldl' :: (a -> Word8 -> a) -> a -> ShortByteString -> a+foldl' f v = List.foldl' f v . unpack++-- | 'foldr', applied to a binary operator, a starting value+-- (typically the right-identity of the operator), and a ShortByteString,+-- reduces the ShortByteString using the binary operator, from right to left.+--+-- @since 0.11.3.0+foldr :: (Word8 -> a -> a) -> a -> ShortByteString -> a+foldr k v = \sbs ->+ let l = length sbs+ ba = asBA sbs+ w = indexWord8Array ba+ go !n | n >= l = v+ | otherwise = k (w n) (go (n + 1))+ in go 0+{-# INLINE foldr #-}++-- | 'foldr'' is like 'foldr', but strict in the accumulator.+--+-- @since 0.11.3.0+foldr' :: (Word8 -> a -> a) -> a -> ShortByteString -> a+foldr' k v = \sbs ->+ let l = length sbs+ ba = asBA sbs+ w = indexWord8Array ba+ go !ix !v' | ix < 0 = v'+ | otherwise = go (ix - 1) (k (w ix) v')+ in go (l - 1) v+{-# INLINE foldr' #-}++-- | 'foldl1' is a variant of 'foldl' that has no starting value+-- argument, and thus must be applied to non-empty 'ShortByteString's.+-- An exception will be thrown in the case of an empty ShortByteString.+--+-- @since 0.11.3.0+foldl1 :: HasCallStack => (Word8 -> Word8 -> Word8) -> ShortByteString -> Word8+foldl1 k = List.foldl1 k . unpack++-- | 'foldl1'' is like 'foldl1', but strict in the accumulator.+-- An exception will be thrown in the case of an empty ShortByteString.+--+-- @since 0.11.3.0+foldl1' :: HasCallStack => (Word8 -> Word8 -> Word8) -> ShortByteString -> Word8+foldl1' k = List.foldl1' k . unpack++-- | 'foldr1' is a variant of 'foldr' that has no starting value argument,+-- and thus must be applied to non-empty 'ShortByteString's+-- An exception will be thrown in the case of an empty ShortByteString.+--+-- @since 0.11.3.0+foldr1 :: HasCallStack => (Word8 -> Word8 -> Word8) -> ShortByteString -> Word8+foldr1 k = List.foldr1 k . unpack++-- | 'foldr1'' is a variant of 'foldr1', but is strict in the+-- accumulator.+--+-- @since 0.11.3.0+foldr1' :: HasCallStack => (Word8 -> Word8 -> Word8) -> ShortByteString -> Word8+foldr1' k = \sbs -> if null sbs then errorEmptySBS "foldr1'" else foldr' k (last sbs) (init sbs)++++-- ---------------------------------------------------------------------+-- Special folds++-- | /O(n)/ Applied to a predicate and a 'ShortByteString', 'all' determines+-- if all elements of the 'ShortByteString' satisfy the predicate.+--+-- @since 0.11.3.0+all :: (Word8 -> Bool) -> ShortByteString -> Bool+all k = \sbs ->+ let l = length sbs+ ba = asBA sbs+ w = indexWord8Array ba+ go !n | n >= l = True+ | otherwise = k (w n) && go (n + 1)+ in go 0+++-- | /O(n)/ Applied to a predicate and a 'ShortByteString', 'any' determines if+-- any element of the 'ShortByteString' satisfies the predicate.+--+-- @since 0.11.3.0+any :: (Word8 -> Bool) -> ShortByteString -> Bool+any k = \sbs ->+ let l = length sbs+ ba = asBA sbs+ w = indexWord8Array ba+ go !n | n >= l = False+ | otherwise = k (w n) || go (n + 1)+ in go 0++++-- ---------------------------------------------------------------------+-- Substrings++-- | /O(n)/ 'take' @n@, applied to a ShortByteString @xs@, returns the prefix+-- of @xs@ of length @n@, or @xs@ itself if @n > 'length' xs@.+--+-- Note: copies the entire byte array+--+-- @since 0.11.3.0+take :: Int -> ShortByteString -> ShortByteString+take = \n -> \sbs -> let sl = length sbs+ in if | n >= sl -> sbs+ | n <= 0 -> empty+ | otherwise ->+ create n $ \mba -> copyByteArray (asBA sbs) 0 mba 0 n++-- | Similar to 'Prelude.takeWhile',+-- returns the longest (possibly empty) prefix of elements+-- satisfying the predicate.+--+-- @since 0.11.3.0+takeWhile :: (Word8 -> Bool) -> ShortByteString -> ShortByteString+takeWhile f = \sbs -> take (findIndexOrLength (not . f) sbs) sbs++-- | /O(n)/ @'takeEnd' n xs@ is equivalent to @'drop' ('length' xs - n) xs@.+-- Takes @n@ elements from end of bytestring.+--+-- >>> takeEnd 3 "abcdefg"+-- "efg"+-- >>> takeEnd 0 "abcdefg"+-- ""+-- >>> takeEnd 4 "abc"+-- "abc"+--+-- @since 0.11.3.0+takeEnd :: Int -> ShortByteString -> ShortByteString+takeEnd n = \sbs -> let sl = length sbs+ in if | n >= sl -> sbs+ | n <= 0 -> empty+ | otherwise -> create n $ \mba -> copyByteArray (asBA sbs) (max 0 (sl - n)) mba 0 n+++-- | Returns the longest (possibly empty) suffix of elements+-- satisfying the predicate.+--+-- @'takeWhileEnd' p@ is equivalent to @'reverse' . 'takeWhile' p . 'reverse'@.+--+-- @since 0.11.3.0+takeWhileEnd :: (Word8 -> Bool) -> ShortByteString -> ShortByteString+takeWhileEnd f = \sbs -> drop (findFromEndUntil (not . f) sbs) sbs++-- | /O(n)/ 'drop' @n@ @xs@ returns the suffix of @xs@ after the first n elements, or 'empty' if @n > 'length' xs@.+--+-- Note: copies the entire byte array+--+-- @since 0.11.3.0+drop :: Int -> ShortByteString -> ShortByteString+drop = \n -> \sbs ->+ let len = length sbs+ in if | n <= 0 -> sbs+ | n >= len -> empty+ | otherwise ->+ let newLen = len - n+ in create newLen $ \mba -> copyByteArray (asBA sbs) n mba 0 newLen++-- | /O(n)/ @'dropEnd' n xs@ is equivalent to @'take' ('length' xs - n) xs@.+-- Drops @n@ elements from end of bytestring.+--+-- >>> dropEnd 3 "abcdefg"+-- "abcd"+-- >>> dropEnd 0 "abcdefg"+-- "abcdefg"+-- >>> dropEnd 4 "abc"+-- ""+--+-- @since 0.11.3.0+dropEnd :: Int -> ShortByteString -> ShortByteString+dropEnd n = \sbs -> let sl = length sbs+ nl = sl - n+ in if | n >= sl -> empty+ | n <= 0 -> sbs+ | otherwise -> create nl $ \mba -> copyByteArray (asBA sbs) 0 mba 0 nl++-- | Similar to 'Prelude.dropWhile',+-- drops the longest (possibly empty) prefix of elements+-- satisfying the predicate and returns the remainder.+--+-- Note: copies the entire byte array+--+-- @since 0.11.3.0+dropWhile :: (Word8 -> Bool) -> ShortByteString -> ShortByteString+dropWhile f = \sbs -> drop (findIndexOrLength (not . f) sbs) sbs++-- | Similar to 'Prelude.dropWhileEnd',+-- drops the longest (possibly empty) suffix of elements+-- satisfying the predicate and returns the remainder.+--+-- @'dropWhileEnd' p@ is equivalent to @'reverse' . 'dropWhile' p . 'reverse'@.+--+-- @since 0.11.3.0+dropWhileEnd :: (Word8 -> Bool) -> ShortByteString -> ShortByteString+dropWhileEnd f = \sbs -> take (findFromEndUntil (not . f) sbs) sbs++-- | 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))@.+--+-- @since 0.11.3.0+breakEnd :: (Word8 -> Bool) -> ShortByteString -> (ShortByteString, ShortByteString)+breakEnd p = \sbs -> splitAt (findFromEndUntil p sbs) sbs++-- | Similar to 'Prelude.break',+-- returns the longest (possibly empty) prefix of elements which __do not__+-- satisfy the predicate and the remainder of the string.+--+-- 'break' @p@ is equivalent to @'span' (not . p)@ and to @('takeWhile' (not . p) &&& 'dropWhile' (not . p))@.+--+-- @since 0.11.3.0+break :: (Word8 -> Bool) -> ShortByteString -> (ShortByteString, ShortByteString)+break p = \sbs -> case findIndexOrLength p sbs of n -> (take n sbs, drop n sbs)+{-# INLINE break #-}++-- | Similar to 'Prelude.span',+-- returns the longest (possibly empty) prefix of elements+-- satisfying the predicate and the remainder of the string.+--+-- 'span' @p@ is equivalent to @'break' (not . p)@ and to @('takeWhile' p &&& 'dropWhile' p)@.+--+-- @since 0.11.3.0+span :: (Word8 -> Bool) -> ShortByteString -> (ShortByteString, ShortByteString)+span p = break (not . p)++-- | 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)@.+--+-- We have+--+-- > spanEnd (not . isSpace) "x y z" == ("x y ", "z")+--+-- and+--+-- > spanEnd (not . isSpace) sbs+-- > ==+-- > let (x, y) = span (not . isSpace) (reverse sbs) in (reverse y, reverse x)+--+-- @since 0.11.3.0+spanEnd :: (Word8 -> Bool) -> ShortByteString -> (ShortByteString, ShortByteString)+spanEnd p = \sbs -> splitAt (findFromEndUntil (not . p) sbs) sbs++-- | /O(n)/ 'splitAt' @n sbs@ is equivalent to @('take' n sbs, 'drop' n sbs)@.+--+-- Note: copies the substrings+--+-- @since 0.11.3.0+splitAt :: Int -> ShortByteString -> (ShortByteString, ShortByteString)+splitAt n = \sbs -> if+ | n <= 0 -> (empty, sbs)+ | otherwise ->+ let slen = length sbs+ in if | n >= slen -> (sbs, empty)+ | otherwise ->+ let rlen = slen - n+ lsbs = create n $ \mba -> copyByteArray (asBA sbs) 0 mba 0 n+ rsbs = create rlen $ \mba -> copyByteArray (asBA sbs) n mba 0 rlen+ in (lsbs, rsbs)++-- | /O(n)/ Break a 'ShortByteString' into pieces separated by the byte+-- argument, consuming the delimiter. I.e.+--+-- > split 10 "a\nb\nd\ne" == ["a","b","d","e"] -- fromEnum '\n' == 10+-- > split 97 "aXaXaXa" == ["","X","X","X",""] -- fromEnum 'a' == 97+-- > split 120 "x" == ["",""] -- fromEnum 'x' == 120+-- > split undefined "" == [] -- and not [""]+--+-- and+--+-- > intercalate [c] . split c == id+-- > split == splitWith . (==)+--+-- Note: copies the substrings+--+-- @since 0.11.3.0+split :: Word8 -> ShortByteString -> [ShortByteString]+split w = splitWith (== w)+++-- | /O(n)/ Splits a 'ShortByteString' into components delimited by+-- separators, where the predicate returns True for a separator element.+-- The resulting components do not contain the separators. Two adjacent+-- separators result in an empty component in the output. eg.+--+-- > splitWith (==97) "aabbaca" == ["","","bb","c",""] -- fromEnum 'a' == 97+-- > splitWith undefined "" == [] -- and not [""]+--+-- @since 0.11.3.0+splitWith :: (Word8 -> Bool) -> ShortByteString -> [ShortByteString]+splitWith p = \sbs -> if+ | null sbs -> []+ | otherwise -> go sbs+ where+ go sbs'+ | null sbs' = [empty]+ | otherwise =+ case break p sbs' of+ (a, b)+ | null b -> [a]+ | otherwise -> a : go (tail b)+++-- | /O(n)/ The 'stripSuffix' function takes two ShortByteStrings and returns 'Just'+-- the remainder of the second iff the first is its suffix, and otherwise+-- 'Nothing'.+--+-- @since 0.11.3.0+stripSuffix :: ShortByteString -> ShortByteString -> Maybe ShortByteString+stripSuffix sbs1 = \sbs2 -> do+ let l1 = length sbs1+ l2 = length sbs2+ if | isSuffixOf sbs1 sbs2 ->+ if null sbs1+ then Just sbs2+ else Just $! create (l2 - l1) $ \dst -> do+ copyByteArray (asBA sbs2) 0 dst 0 (l2 - l1)+ | otherwise -> Nothing++-- | /O(n)/ The 'stripPrefix' function takes two ShortByteStrings and returns 'Just'+-- the remainder of the second iff the first is its prefix, and otherwise+-- 'Nothing'.+--+-- @since 0.11.3.0+stripPrefix :: ShortByteString -> ShortByteString -> Maybe ShortByteString+stripPrefix sbs1 = \sbs2 -> do+ let l1 = length sbs1+ l2 = length sbs2+ if | isPrefixOf sbs1 sbs2 ->+ if null sbs1+ then Just sbs2+ else Just $! create (l2 - l1) $ \dst -> do+ copyByteArray (asBA sbs2) l1 dst 0 (l2 - l1)+ | otherwise -> Nothing+++-- ---------------------------------------------------------------------+-- Unfolds and replicates+++-- | /O(n)/ 'replicate' @n x@ is a ShortByteString of length @n@ with @x@+-- the value of every element. The following holds:+--+-- > replicate w c = unfoldr w (\u -> Just (u,u)) c+--+-- @since 0.11.3.0+replicate :: Int -> Word8 -> ShortByteString+replicate w c+ | w <= 0 = empty+ | otherwise = create w (\mba -> setByteArray mba 0 w (fromIntegral c))+++-- | /O(n)/, where /n/ is the length of the result. The 'unfoldr'+-- function is analogous to the List \'unfoldr\'. 'unfoldr' builds a+-- ShortByteString from a seed value. The function takes the element and+-- returns 'Nothing' if it is done producing the ShortByteString or returns+-- 'Just' @(a,b)@, in which case, @a@ is the next byte in the string,+-- and @b@ is the seed value for further production.+--+-- This function is not efficient/safe. It will build a list of @[Word8]@+-- and run the generator until it returns `Nothing`, otherwise recurse infinitely,+-- then finally create a 'ShortByteString'.+--+-- If you know the maximum length, consider using 'unfoldrN'.+--+-- Examples:+--+-- > unfoldr (\x -> if x <= 5 then Just (x, x + 1) else Nothing) 0+-- > == pack [0, 1, 2, 3, 4, 5]+--+-- @since 0.11.3.0+unfoldr :: (a -> Maybe (Word8, a)) -> a -> ShortByteString+unfoldr f = \x0 -> packBytesRev $ go x0 []+ where+ go x words' = case f x of+ Nothing -> words'+ Just (w, x') -> go x' (w:words')++-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a ShortByteString from a seed+-- value. However, the length of the result is limited by the first+-- argument to 'unfoldrN'. This function is more efficient than 'unfoldr'+-- when the maximum length of the result is known.+--+-- The following equation relates 'unfoldrN' and 'unfoldr':+--+-- > fst (unfoldrN n f s) == take n (unfoldr f s)+--+-- @since 0.11.3.0+unfoldrN :: forall a. Int -> (a -> Maybe (Word8, a)) -> a -> (ShortByteString, Maybe a)+unfoldrN i f = \x0 ->+ if | i < 0 -> (empty, Just x0)+ | otherwise -> createAndTrim i $ \mba -> go mba x0 0++ where+ go :: forall s. MutableByteArray s -> a -> Int -> ST s (Int, Maybe a)+ go !mba !x !n = go' x n+ where+ go' :: a -> Int -> ST s (Int, Maybe a)+ go' !x' !n'+ | n' == i = return (n', Just x')+ | otherwise = case f x' of+ Nothing -> return (n', Nothing)+ Just (w, x'') -> do+ writeWord8Array mba n' w+ go' x'' (n'+1)+{-# INLINE unfoldrN #-}++++-- --------------------------------------------------------------------+-- Predicates++-- | Check whether one string is a substring of another.+--+-- @since 0.11.3.0+isInfixOf :: ShortByteString -> ShortByteString -> Bool+isInfixOf sbs = \s -> null sbs || not (null $ snd $ (GHC.Exts.inline breakSubstring) sbs s)++-- |/O(n)/ The 'isPrefixOf' function takes two ShortByteStrings and returns 'True'+-- iff the first is a prefix of the second.+--+-- @since 0.11.3.0+isPrefixOf :: ShortByteString -> ShortByteString -> Bool+isPrefixOf sbs1 = \sbs2 -> do+ let l1 = length sbs1+ l2 = length sbs2+ if | l1 == 0 -> True+ | l2 < l1 -> False+ | otherwise ->+ let i = compareByteArraysOff (asBA sbs1) 0 (asBA sbs2) 0 l1+ in i == 0++-- | /O(n)/ The 'isSuffixOf' function takes two ShortByteStrings and returns 'True'+-- iff the first is a suffix of the second.+--+-- The following holds:+--+-- > isSuffixOf x y == reverse x `isPrefixOf` reverse y+--+-- @since 0.11.3.0+isSuffixOf :: ShortByteString -> ShortByteString -> Bool+isSuffixOf sbs1 = \sbs2 -> do+ let l1 = length sbs1+ l2 = length sbs2+ if | l1 == 0 -> True+ | l2 < l1 -> False+ | otherwise ->+ let i = compareByteArraysOff (asBA sbs1) 0 (asBA sbs2) (l2 - l1) l1+ in i == 0++-- | Break a string on a substring, returning a pair of the part of the+-- string prior to the match, and the rest of the string.+--+-- The following relationships hold:+--+-- > break (== c) l == breakSubstring (singleton c) l+--+-- For example, to tokenise a string, dropping delimiters:+--+-- > tokenise x y = h : if null t then [] else tokenise x (drop (length x) t)+-- > where (h,t) = breakSubstring x y+--+-- To skip to the first occurrence of a string:+--+-- > snd (breakSubstring x y)+--+-- To take the parts of a string before a delimiter:+--+-- > fst (breakSubstring x y)+--+-- Note that calling `breakSubstring x` does some preprocessing work, so+-- you should avoid unnecessarily duplicating breakSubstring calls with the same+-- pattern.+--+-- @since 0.11.3.0+breakSubstring :: ShortByteString -- ^ String to search for+ -> ShortByteString -- ^ String to search in+ -> (ShortByteString, ShortByteString) -- ^ Head and tail of string broken at substring+breakSubstring pat =+ case lp of+ 0 -> (empty,)+ 1 -> breakByte (head pat)+ _ -> if lp * 8 <= finiteBitSize (0 :: Word)+ then shift+ else karpRabin+ where+ lp = length pat+ karpRabin :: ShortByteString -> (ShortByteString, ShortByteString)+ karpRabin src+ | length src < lp = (src,empty)+ | otherwise = search (rollingHash $ take lp src) lp+ where+ k = 2891336453 :: Word32+ rollingHash = foldl' (\h b -> h * k + fromIntegral b) 0+ hp = rollingHash pat+ m = k ^ lp+ get = fromIntegral . unsafeIndex src+ search !hs !i+ | hp == hs && pat == take lp b = u+ | length src <= i = (src, empty) -- not found+ | otherwise = search hs' (i + 1)+ where+ u@(_, b) = splitAt (i - lp) src+ hs' = hs * k ++ get i -+ m * get (i - lp)+ {-# INLINE karpRabin #-}++ shift :: ShortByteString -> (ShortByteString, ShortByteString)+ shift !src+ | length src < lp = (src, empty)+ | otherwise = search (intoWord $ take lp src) lp+ where+ intoWord :: ShortByteString -> Word+ intoWord = foldl' (\w b -> (w `shiftL` 8) .|. fromIntegral b) 0++ wp = intoWord pat+ mask' = (1 `shiftL` (8 * lp)) - 1+ search !w !i+ | w == wp = splitAt (i - lp) src+ | length src <= i = (src, empty)+ | otherwise = search w' (i + 1)+ where+ b = fromIntegral (unsafeIndex src i)+ w' = mask' .&. ((w `shiftL` 8) .|. b)+ {-# INLINE shift #-}+++-- --------------------------------------------------------------------+-- Searching ShortByteString++-- | /O(n)/ 'elem' is the 'ShortByteString' membership predicate.+--+-- @since 0.11.3.0+elem :: Word8 -> ShortByteString -> Bool+elem c = \sbs -> case elemIndex c sbs of Nothing -> False ; _ -> True++-- | /O(n)/ 'filter', applied to a predicate and a ShortByteString,+-- returns a ShortByteString containing those characters that satisfy the+-- predicate.+--+-- @since 0.11.3.0+filter :: (Word8 -> Bool) -> ShortByteString -> ShortByteString+filter k = \sbs -> let l = length sbs+ in if | l <= 0 -> sbs+ | otherwise -> createAndTrim' l $ \mba -> go mba (asBA sbs) l+ where+ go :: forall s. MutableByteArray s -- mutable output bytestring+ -> ByteArray -- input bytestring+ -> Int -- length of input bytestring+ -> ST s Int+ go !mba ba !l = go' 0 0+ where+ go' :: Int -- bytes read+ -> Int -- bytes written+ -> ST s Int+ go' !br !bw+ | br >= l = return bw+ | otherwise = do+ let w = indexWord8Array ba br+ if k w+ then do+ writeWord8Array mba bw w+ go' (br+1) (bw+1)+ else+ go' (br+1) bw+{-# INLINE filter #-}++-- | /O(n)/ The 'find' function takes a predicate and a ShortByteString,+-- and returns the first element in matching the predicate, or 'Nothing'+-- if there is no such element.+--+-- > find f p = case findIndex f p of Just n -> Just (p ! n) ; _ -> Nothing+--+-- @since 0.11.3.0+find :: (Word8 -> Bool) -> ShortByteString -> Maybe Word8+find f = \sbs -> case findIndex f sbs of+ Just n -> Just (sbs `index` n)+ _ -> Nothing+{-# INLINE find #-}++-- | /O(n)/ The 'partition' function takes a predicate a ShortByteString and returns+-- the pair of ShortByteStrings with elements which do and do not satisfy the+-- predicate, respectively; i.e.,+--+-- > partition p bs == (filter p sbs, filter (not . p) sbs)+--+-- @since 0.11.3.0+partition :: (Word8 -> Bool) -> ShortByteString -> (ShortByteString, ShortByteString)+partition k = \sbs -> let len = length sbs+ in if | len <= 0 -> (sbs, sbs)+ | otherwise -> createAndTrim2 len len $ \mba1 mba2 -> go mba1 mba2 (asBA sbs) len+ where+ go :: forall s.+ MutableByteArray s -- mutable output bytestring1+ -> MutableByteArray s -- mutable output bytestring2+ -> ByteArray -- input bytestring+ -> Int -- length of input bytestring+ -> ST s (Int, Int) -- (length mba1, length mba2)+ go !mba1 !mba2 ba !l = go' 0 0+ where+ go' :: Int -- bytes read+ -> Int -- bytes written to bytestring 1+ -> ST s (Int, Int) -- (length mba1, length mba2)+ go' !br !bw1+ | br >= l = return (bw1, br - bw1)+ | otherwise = do+ let w = indexWord8Array ba br+ if k w+ then do+ writeWord8Array mba1 bw1 w+ go' (br+1) (bw1+1)+ else do+ writeWord8Array mba2 (br - bw1) w+ go' (br+1) bw1+++-- --------------------------------------------------------------------+-- Indexing ShortByteString++-- | /O(n)/ The 'elemIndex' function returns the index of the first+-- element in the given 'ShortByteString' which is equal to the query+-- element, or 'Nothing' if there is no such element.+--+-- @since 0.11.3.0+elemIndex :: Word8 -> ShortByteString -> Maybe Int+elemIndex c = \sbs@(SBS ba#) -> do+ let l = length sbs+ accursedUnutterablePerformIO $ do+ !s <- c_elem_index ba# c (fromIntegral l)+ return $! if s < 0 then Nothing else Just (fromIntegral s)+++-- | /O(n)/ The 'elemIndices' function extends 'elemIndex', by returning+-- the indices of all elements equal to the query element, in ascending order.+--+-- @since 0.11.3.0+elemIndices :: Word8 -> ShortByteString -> [Int]+elemIndices k = findIndices (==k)++-- | count returns the number of times its argument appears in the ShortByteString+--+-- @since 0.11.3.0+count :: Word8 -> ShortByteString -> Int+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+-- returns the index of the first element in the ShortByteString+-- satisfying the predicate.+--+-- @since 0.11.3.0+findIndex :: (Word8 -> Bool) -> ShortByteString -> Maybe Int+findIndex k = \sbs ->+ let l = length sbs+ ba = asBA sbs+ w = indexWord8Array ba+ go !n | n >= l = Nothing+ | k (w n) = Just n+ | otherwise = go (n + 1)+ in go 0+{-# INLINE findIndex #-}+++-- | /O(n)/ The 'findIndices' function extends 'findIndex', by returning the+-- indices of all elements satisfying the predicate, in ascending order.+--+-- @since 0.11.3.0+findIndices :: (Word8 -> Bool) -> ShortByteString -> [Int]+findIndices k = \sbs ->+ let l = length sbs+ ba = asBA sbs+ w = indexWord8Array ba+ go !n | n >= l = []+ | k (w n) = n : go (n + 1)+ | otherwise = go (n + 1)+ in go 0++------------------------------------------------------------------------+-- Exported low level operations++copyToPtr :: ShortByteString -- ^ source data+ -> Int -- ^ offset into source+ -> Ptr a -- ^ destination+ -> Int -- ^ number of bytes to copy+ -> IO ()+copyToPtr src off dst len =+ stToIO $+ copyByteArrayToAddr (asBA src) off dst len++createFromPtr :: Ptr a -- ^ source data+ -> Int -- ^ number of bytes to copy+ -> IO ShortByteString+createFromPtr !ptr len =+ stToIO $ do+ mba <- newByteArray len+ copyAddrToByteArray ptr mba 0 len+ ShortByteString <$> unsafeFreezeByteArray mba+++------------------------------------------------------------------------+-- Primop wrappers++indexCharArray :: ByteArray -> Int -> Char+indexCharArray (ByteArray ba#) (I# i#) = C# (indexCharArray# ba# i#)++indexWord8Array :: ByteArray -> Int -> Word8+indexWord8Array (ByteArray ba#) (I# i#) = W8# (indexWord8Array# ba# i#)++#if HS_UNALIGNED_ByteArray_OPS_OK+indexWord8ArrayAsWord64 :: ByteArray -> Int -> Word64+indexWord8ArrayAsWord64 (ByteArray ba#) (I# i#) = W64# (indexWord8ArrayAsWord64# ba# i#)+#endif++newByteArray :: Int -> ST s (MutableByteArray s)+newByteArray len@(I# len#) =+ assert (len >= 0) $+ ST $ \s -> case newByteArray# len# s of+ (# s', mba# #) -> (# s', MutableByteArray mba# #)++unsafeFreezeByteArray :: MutableByteArray s -> ST s ByteArray+unsafeFreezeByteArray (MutableByteArray mba#) =+ ST $ \s -> case unsafeFreezeByteArray# mba# s of+ (# s', ba# #) -> (# s', ByteArray ba# #)++writeWord8Array :: MutableByteArray s -> Int -> Word8 -> ST s ()+writeWord8Array (MutableByteArray mba#) (I# i#) (W8# w#) =+ ST $ \s -> case writeWord8Array# mba# i# w# s of+ s' -> (# s', () #)++#if HS_UNALIGNED_ByteArray_OPS_OK+writeWord64Array :: MutableByteArray s -> Int -> Word64 -> ST s ()+writeWord64Array (MutableByteArray mba#) (I# i#) (W64# w#) =+ ST $ \s -> case writeWord64Array# mba# i# w# s of+ s' -> (# s', () #)+#endif++copyAddrToByteArray :: Ptr a -> MutableByteArray RealWorld -> Int -> Int -> ST RealWorld ()+copyAddrToByteArray (Ptr src#) (MutableByteArray dst#) (I# dst_off#) (I# len#) =+ ST $ \s -> case copyAddrToByteArray# src# dst# dst_off# len# s of+ s' -> (# s', () #)++copyByteArrayToAddr :: ByteArray -> Int -> Ptr a -> Int -> ST RealWorld ()+copyByteArrayToAddr (ByteArray src#) (I# src_off#) (Ptr dst#) (I# len#) =+ ST $ \s -> case copyByteArrayToAddr# src# src_off# dst# len# s of+ s' -> (# s', () #)++copyByteArray :: ByteArray -> Int -> MutableByteArray s -> Int -> Int -> ST s ()+copyByteArray (ByteArray src#) (I# src_off#) (MutableByteArray dst#) (I# dst_off#) (I# len#) =+ ST $ \s -> case copyByteArray# src# src_off# dst# dst_off# len# s of+ s' -> (# s', () #)++setByteArray :: MutableByteArray s -> Int -> Int -> Int -> ST s ()+setByteArray (MutableByteArray dst#) (I# off#) (I# len#) (I# c#) =+ ST $ \s -> case setByteArray# dst# off# len# c# s of+ s' -> (# s', () #)++copyMutableByteArray :: MutableByteArray s -> Int -> MutableByteArray s -> Int -> Int -> ST s ()+copyMutableByteArray (MutableByteArray src#) (I# src_off#) (MutableByteArray dst#) (I# dst_off#) (I# len#) =+ ST $ \s -> case copyMutableByteArray# src# src_off# dst# dst_off# len# s of+ s' -> (# s', () #)+++------------------------------------------------------------------------+-- FFI imports+--+compareByteArrays :: ByteArray -> ByteArray -> Int -> Int+compareByteArrays ba1 ba2 = compareByteArraysOff ba1 0 ba2 0++compareByteArraysOff :: ByteArray -- ^ array 1+ -> Int -- ^ offset for array 1+ -> ByteArray -- ^ array 2+ -> Int -- ^ offset for array 2+ -> Int -- ^ length to compare+ -> Int -- ^ like memcmp+compareByteArraysOff (ByteArray ba1#) (I# ba1off#) (ByteArray ba2#) (I# ba2off#) (I# len#) =+ I# (compareByteArrays# ba1# ba1off# ba2# ba2off# len#)++------------------------------------------------------------------------+-- Primop replacements++copyAddrToByteArray# :: Addr#+ -> MutableByteArray# RealWorld -> Int#+ -> Int#+ -> State# RealWorld -> State# RealWorld++copyByteArrayToAddr# :: ByteArray# -> Int#+ -> Addr#+ -> Int#+ -> State# RealWorld -> State# RealWorld++copyByteArray# :: ByteArray# -> Int#+ -> MutableByteArray# s -> Int#+ -> Int#+ -> State# s -> State# s++copyAddrToByteArray# = GHC.Exts.copyAddrToByteArray#+copyByteArrayToAddr# = GHC.Exts.copyByteArrayToAddr#+copyByteArray# = GHC.Exts.copyByteArray#++-- | /O(n)./ Construct a new @ShortByteString@ from a @CString@. The+-- resulting @ShortByteString@ is an immutable copy of the original+-- @CString@, and is managed on the Haskell heap. The original+-- @CString@ must be null terminated.+--+-- @since 0.10.10.0+packCString :: CString -> IO ShortByteString+packCString cstr = do+ len <- BS.c_strlen cstr+ packCStringLen (cstr, fromIntegral len)++-- | /O(n)./ Construct a new @ShortByteString@ from a @CStringLen@. The+-- resulting @ShortByteString@ is an immutable copy of the original @CStringLen@.+-- The @ShortByteString@ is a normal Haskell value and will be managed on the+-- Haskell heap.+--+-- @since 0.10.10.0+packCStringLen :: CStringLen -> IO ShortByteString+packCStringLen (cstr, len) | len >= 0 = createFromPtr cstr len+packCStringLen (_, len) =+ moduleErrorIO "packCStringLen" ("negative length: " ++ show len)++-- | /O(n) construction./ Use a @ShortByteString@ with a function requiring a+-- null-terminated @CString@. The @CString@ is a copy and will be freed+-- automatically; it must not be stored or used after the+-- subcomputation finishes.+--+-- @since 0.10.10.0+useAsCString :: ShortByteString -> (CString -> IO a) -> IO a+useAsCString sbs action =+ allocaBytes (l+1) $ \buf -> do+ copyToPtr sbs 0 buf (fromIntegral l)+ pokeByteOff buf l (0::Word8)+ action buf+ where l = length sbs++-- | /O(n) construction./ Use a @ShortByteString@ with a function requiring a 'CStringLen'.+-- As for 'useAsCString' this function makes a copy of the original @ShortByteString@.+-- It must not be stored or used after the subcomputation finishes.+--+-- Beware that this function does not add a terminating @\NUL@ byte at the end of 'CStringLen'.+-- If you need to construct a pointer to a null-terminated sequence, use 'useAsCString'+-- (and measure length independently if desired).+--+-- @since 0.10.10.0+useAsCStringLen :: ShortByteString -> (CStringLen -> IO a) -> IO a+useAsCStringLen sbs action =+ allocaBytes l $ \buf -> do+ copyToPtr sbs 0 buf (fromIntegral l)+ action (buf, l)+ where l = length sbs++-- | /O(n)/ Check whether a 'ShortByteString' represents valid UTF-8.+--+-- @since 0.11.3.0+isValidUtf8 :: ShortByteString -> Bool+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.+ -- This specific limit was chosen based on results of a simple benchmark, see:+ -- https://github.com/haskell/bytestring/issues/451#issuecomment-991879338+ -- When changing this function, also consider changing the related function:+ -- Data.ByteString.isValidUtf8+ i <- if n < 1000000 || not (isPinned ba#)+ then cIsValidUtf8BA ba# (fromIntegral n)+ else cIsValidUtf8BASafe ba# (fromIntegral n)+ IO (\s -> (# touch# ba# s, () #))+ return $ i /= 0++-- ---------------------------------------------------------------------+-- Internal utilities++moduleErrorIO :: HasCallStack => String -> String -> IO a+moduleErrorIO fun msg = throwIO . userError $ moduleErrorMsg fun msg+{-# NOINLINE moduleErrorIO #-}++moduleErrorMsg :: String -> String -> String+moduleErrorMsg fun msg = "Data.ByteString.Short." ++ fun ++ ':':' ':msg+++-- Find from the end of the string using predicate.+--+-- Return '0' if the predicate returns false for the entire ShortByteString.+findFromEndUntil :: (Word8 -> Bool) -> ShortByteString -> Int+findFromEndUntil k sbs = go (length sbs - 1)+ where+ ba = asBA sbs+ go !n | n < 0 = 0+ | k (indexWord8Array ba n) = n + 1+ | otherwise = go (n - 1)++findIndexOrLength :: (Word8 -> Bool) -> ShortByteString -> Int+findIndexOrLength k sbs = go 0+ where+ l = length sbs+ ba = asBA sbs+ go !n | n >= l = l+ | k (indexWord8Array ba n) = n+ | otherwise = go (n + 1)+++packBytesRev :: [Word8] -> ShortByteString+packBytesRev cs = packLenBytesRev (List.length cs) cs++packLenBytesRev :: Int -> [Word8] -> ShortByteString+packLenBytesRev len ws0 =+ create len (\mba -> go mba len ws0)+ where+ go :: MutableByteArray s -> Int -> [Word8] -> ST s ()+ go !_ !_ [] = return ()+ go !mba !i (w:ws) = do+ writeWord8Array mba (i - 1) w+ go mba (i - 1) ws+++breakByte :: Word8 -> ShortByteString -> (ShortByteString, ShortByteString)+breakByte c sbs = case elemIndex c sbs of+ Nothing -> (sbs, empty)+ Just n -> (take n sbs, drop n sbs)++-- Common up near identical calls to `error' to reduce the number+-- constant strings created when compiled:+errorEmptySBS :: HasCallStack => String -> a+errorEmptySBS fun = moduleError fun "empty ShortByteString"+{-# NOINLINE errorEmptySBS #-}++moduleError :: HasCallStack => String -> String -> a+moduleError fun msg = error (moduleErrorMsg fun msg)+{-# NOINLINE moduleError #-}+
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
@@ -0,0 +1,40 @@+{-# 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++module Data.ByteString.Utils.ByteOrder+ ( ByteOrder(..)+ , hostByteOrder+ , whenLittleEndian+ , whenBigEndian+ ) where++import GHC.ByteOrder (ByteOrder(..))++hostByteOrder :: ByteOrder+hostByteOrder =+#ifdef WORDS_BIGENDIAN+ BigEndian+#else+ LittleEndian+#endif++-- | If the host is little-endian, applies the given function to the given arg.+-- If the host is big-endian, returns the second argument unchanged.+whenLittleEndian :: (a -> a) -> a -> a+whenLittleEndian fun val = case hostByteOrder of+ LittleEndian -> fun val+ BigEndian -> val++-- | If the host is little-endian, returns the second argument unchanged.+-- If the host is big-endian, applies the given function to the given arg.+whenBigEndian :: (a -> a) -> a -> a+whenBigEndian fun val = case hostByteOrder of+ LittleEndian -> val+ BigEndian -> fun val
+ Data/ByteString/Utils/UnalignedAccess.hs view
@@ -0,0 +1,93 @@+{-# LANGUAGE CPP #-}++#include "bytestring-cpp-macros.h"++-- |+-- Module : Data.ByteString.Utils.UnalignedAccess+-- Copyright : (c) Matthew Craven 2023-2024+-- License : BSD-style+-- Maintainer : clyring@gmail.com+-- Stability : internal+-- Portability : non-portable+--+-- Primitives for reading and writing at potentially-unaligned memory locations++module Data.ByteString.Utils.UnalignedAccess+ ( unalignedWriteU16+ , unalignedWriteU32+ , unalignedWriteU64+ , unalignedWriteFloat+ , unalignedWriteDouble+ , unalignedReadU64+ ) where++import Foreign.Ptr+import Data.Word+++#if HS_UNALIGNED_ADDR_PRIMOPS_AVAILABLE+import GHC.IO (IO(..))+import GHC.Word (Word16(..), Word32(..), Word64(..))+import GHC.Exts++unalignedWriteU16 :: Word16 -> Ptr Word8 -> IO ()+unalignedWriteU16 = coerce $ \(W16# x#) (Ptr p#) s+ -> (# writeWord8OffAddrAsWord16# p# 0# x# s, () #)++unalignedWriteU32 :: Word32 -> Ptr Word8 -> IO ()+unalignedWriteU32 = coerce $ \(W32# x#) (Ptr p#) s+ -> (# writeWord8OffAddrAsWord32# p# 0# x# s, () #)++unalignedWriteU64 :: Word64 -> Ptr Word8 -> IO ()+unalignedWriteU64 = coerce $ \(W64# x#) (Ptr p#) s+ -> (# writeWord8OffAddrAsWord64# p# 0# x# s, () #)++unalignedWriteFloat :: Float -> Ptr Word8 -> IO ()+unalignedWriteFloat = coerce $ \(F# x#) (Ptr p#) s+ -> (# writeWord8OffAddrAsFloat# p# 0# x# s, () #)++unalignedWriteDouble :: Double -> Ptr Word8 -> IO ()+unalignedWriteDouble = coerce $ \(D# x#) (Ptr p#) s+ -> (# writeWord8OffAddrAsDouble# p# 0# x# s, () #)++unalignedReadU64 :: Ptr Word8 -> IO Word64+unalignedReadU64 = coerce $ \(Ptr p#) s+ -> case readWord8OffAddrAsWord64# p# 0# s of+ (# s', w64# #) -> (# s', W64# w64# #)++#elif HS_UNALIGNED_POKES_OK+import Foreign.Storable++unalignedWriteU16 :: Word16 -> Ptr Word8 -> IO ()+unalignedWriteU16 x p = poke (castPtr p) x++unalignedWriteU32 :: Word32 -> Ptr Word8 -> IO ()+unalignedWriteU32 x p = poke (castPtr p) x++unalignedWriteU64 :: Word64 -> Ptr Word8 -> IO ()+unalignedWriteU64 x p = poke (castPtr p) x++unalignedWriteFloat :: Float -> Ptr Word8 -> IO ()+unalignedWriteFloat x p = poke (castPtr p) x++unalignedWriteDouble :: Double -> Ptr Word8 -> IO ()+unalignedWriteDouble x p = poke (castPtr p) x++unalignedReadU64 :: Ptr Word8 -> IO Word64+unalignedReadU64 p = peek (castPtr p)++#else+foreign import ccall unsafe "static fpstring.h fps_unaligned_write_u16"+ unalignedWriteU16 :: Word16 -> Ptr Word8 -> IO ()+foreign import ccall unsafe "static fpstring.h fps_unaligned_write_u32"+ unalignedWriteU32 :: Word32 -> Ptr Word8 -> IO ()+foreign import ccall unsafe "static fpstring.h fps_unaligned_write_u64"+ unalignedWriteU64 :: Word64 -> Ptr Word8 -> IO ()+foreign import ccall unsafe "static fpstring.h fps_unaligned_write_HsFloat"+ unalignedWriteFloat :: Float -> Ptr Word8 -> IO ()+foreign import ccall unsafe "static fpstring.h fps_unaligned_write_HsDouble"+ unalignedWriteDouble :: Double -> Ptr Word8 -> IO ()+foreign import ccall unsafe "static fpstring.h fps_unaligned_read_u64"+ unalignedReadU64 :: Ptr Word8 -> IO Word64+#endif+
README.md view
@@ -1,6 +1,6 @@ # ByteString: Fast, Packed Strings of Bytes -[](https://github.com/haskell/bytestring/actions?query=workflow%3Aci) [](https://hackage.haskell.org/package/bytestring) [](https://matrix.hackage.haskell.org/package/bytestring) [](http://stackage.org/lts/package/bytestring) [](http://stackage.org/nightly/package/bytestring)+[](https://github.com/haskell/bytestring/actions?query=workflow%3Aci) [](https://hackage.haskell.org/package/bytestring) [](http://stackage.org/lts/package/bytestring) [](http://stackage.org/nightly/package/bytestring) This library provides the `Data.ByteString` module -- strict and lazy byte arrays manipulable as strings -- providing very time/space-efficient@@ -15,8 +15,8 @@ Requirements: - * Cabal 1.10 or greater- * GHC 7.0 or greater+ * Cabal 2.2 or greater+ * GHC 8.4 or greater ### Authors
bench/BenchAll.hs view
@@ -7,34 +7,36 @@ -- Portability : tested on GHC only -- -{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE PackageImports #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE MagicHash #-}- module Main (main) where import Data.Foldable (foldMap) import Data.Monoid+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 import qualified Data.ByteString.Lazy as L+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 @@ -42,6 +44,8 @@ import BenchCount import BenchCSV import BenchIndices+import BenchReadInt+import BenchShort ------------------------------------------------------------------------------ -- Benchmark support@@ -93,6 +97,15 @@ lazyByteStringData = case S.splitAt (nRepl `div` 2) byteStringData of (bs1, bs2) -> L.fromChunks [bs1, bs2] +{-# NOINLINE smallChunksData #-}+smallChunksData :: L.ByteString+smallChunksData = L.fromChunks $ List.unfoldr step (byteStringData, 1)+ where+ step (!s, !i)+ | S.null s = Nothing+ | otherwise = case S.splitAt i s of+ (!s1, !s2) -> Just (s1, (s2, i * 71 `mod` 97))+ {-# NOINLINE byteStringChunksData #-} byteStringChunksData :: [S.ByteString] byteStringChunksData = map (S.pack . replicate (4 ) . fromIntegral) intData@@ -111,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@@ -237,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"@@ -264,15 +342,12 @@ P.primMapLazyByteStringFixed P.word8 ] , bgroup "ByteString insertion" $- let dataName = " byteStringChunks" ++- show (S.length (head byteStringChunksData)) ++ "Data"- in- [ benchB ("foldMap byteStringInsert" ++ dataName) byteStringChunksData- (foldMap byteStringInsert)- , benchB ("foldMap byteString" ++ dataName) byteStringChunksData+ [ benchB "foldMap byteStringInsert" byteStringChunksData+ (foldMap Extra.byteStringInsert)+ , benchB "foldMap byteString" byteStringChunksData (foldMap byteString)- , benchB ("foldMap byteStringCopy" ++ dataName) byteStringChunksData- (foldMap byteStringCopy)+ , benchB "foldMap byteStringCopy" byteStringChunksData+ (foldMap Extra.byteStringCopy) ] , bgroup "Non-bounded encodings"@@ -375,6 +450,11 @@ [ bench "intersperse" $ whnf (S.intersperse 32) byteStringData , bench "intersperse (unaligned)" $ whnf (S.intersperse 32) (S.drop 1 byteStringData) ]+ , bgroup "intercalate"+ [ bench "intercalate (large)" $ whnf (S.intercalate $ S8.pack " and also ") (replicate 300 (S8.pack "expression"))+ , bench "intercalate (small)" $ whnf (S.intercalate $ S8.pack "&") (replicate 30 (S8.pack "foo"))+ , bench "intercalate (tiny)" $ whnf (S.intercalate $ S8.pack "&") (S8.pack <$> ["foo", "bar", "baz"])+ ] , bgroup "partition" [ bgroup "strict"@@ -398,7 +478,34 @@ , bench "balancedSlow" $ partitionLazy (\x -> hashWord8 x < w 128) ] ]+ , bgroup "inits"+ [ bench "strict" $ nf S.inits byteStringData+ , bench "lazy" $ nf L.inits lazyByteStringData+ , bench "lazy (small chunks)" $ nf L.inits smallChunksData+ ]+ , bgroup "tails"+ [ bench "strict" $ nf S.tails byteStringData+ , bench "lazy" $ nf L.tails lazyByteStringData+ ]+ , bgroup "splitAtEnd (lazy)" $ let+ testSAE op = \bs -> [op i bs | i <- [0,5..L.length bs]] `deepseq` ()+ {-# INLINE testSAE #-}+ in+ [ bench "takeEnd" $+ nf (testSAE L.takeEnd) lazyByteStringData+ , bench "takeEnd (small chunks)" $+ nf (testSAE L.takeEnd) smallChunksData+ , bench "dropEnd" $+ nf (testSAE L.dropEnd) lazyByteStringData+ , bench "dropEnd (small chunks)" $+ nf (testSAE L.dropEnd) smallChunksData+ ] , bgroup "sort" $ map (\s -> bench (S8.unpack s) $ nf S.sort s) sortInputs+ , bgroup "stimes" $ let st = stimes :: Int -> S.ByteString -> S.ByteString+ in+ [ bench "strict (tiny)" $ whnf (st 4) (S8.pack "test")+ , bench "strict (large)" $ whnf (st 50) byteStringData+ ] , bgroup "words" [ bench "lorem ipsum" $ nf S8.words loremIpsum , bench "one huge word" $ nf S8.words byteStringData@@ -463,8 +570,14 @@ [ bench "map (+1) large" $ nf (S.map (+ 1)) largeTraversalInput , bench "map (+1) small" $ nf (S.map (+ 1)) smallTraversalInput ]+ , bgroup "unlines"+ [ bench "lazy" $ nf L8.unlines (map (L8.pack . show) intData)+ , bench "strict" $ nf S8.unlines (map (S8.pack . show) intData)+ ] , benchBoundsCheckFusion , benchCount , benchCSV , benchIndices+ , benchReadInt+ , benchShort ]
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)@@ -9,14 +11,11 @@ -- Running example for documentation of Data.ByteString.Builder -- -{-# LANGUAGE CPP #-}-{-# LANGUAGE OverloadedStrings #-}- module BenchCSV (benchCSV) where --- **************************************************************************+-- ************************************************************************** -- CamHac 2011: An introduction to Data.ByteString.Builder--- **************************************************************************+-- ************************************************************************** {- The Encoding Problem
bench/BenchIndices.hs view
@@ -6,8 +6,6 @@ -- -- Benchmark elemIndex, findIndex, elemIndices, and findIndices -{-# LANGUAGE BangPatterns #-}- module BenchIndices (benchIndices) where import Data.Foldable (foldMap)@@ -15,7 +13,7 @@ import Data.Monoid import Data.String import Test.Tasty.Bench-import Prelude hiding (words)+import Prelude hiding (words, head, tail) import Data.Word (Word8) import qualified Data.ByteString as S@@ -38,15 +36,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@@ -54,8 +52,8 @@ , bench "ElemIndex" $ nf (S.elemIndex nl) absurdlong ] , bgroup "ByteString strict second index" $- [ bench "FindIndices" $ nf (listToMaybe . tail . S.findIndices (== nl)) absurdlong- , bench "ElemIndices" $ nf (listToMaybe . tail . S.elemIndices nl) absurdlong+ [ bench "FindIndices" $ nf (listToMaybe . drop 1 . S.findIndices (== nl)) absurdlong+ , bench "ElemIndices" $ nf (listToMaybe . drop 1 . S.elemIndices nl) absurdlong , bench "FindIndex" $ nf bench_find_index_second absurdlong , bench "ElemIndex" $ nf bench_elem_index_second absurdlong ]
+ bench/BenchReadInt.hs view
@@ -0,0 +1,138 @@+{-# LANGUAGE CPP #-}++-- |+-- Copyright : (c) 2021 Viktor Dukhovni+-- License : BSD3-style (see LICENSE)+--+-- Maintainer : Viktor Dukhovni <ietf-dane@dukhovni.org>+--+-- Benchmark readInt and variants, readWord and variants,+-- readInteger and readNatural++module BenchReadInt (benchReadInt) where++import qualified Data.ByteString.Builder as B+import qualified Data.ByteString.Char8 as S+import qualified Data.ByteString.Lazy.Char8 as L+import Test.Tasty.Bench+import Data.Int+import Data.Word+import Numeric.Natural+#if !(MIN_VERSION_base(4,11,0))+import Data.Semigroup (Semigroup((<>)))+#endif+import Data.Monoid (mconcat)++------------------------------------------------------------------------------+-- Benchmark+------------------------------------------------------------------------------++-- Sum space-separated integers in a ByteString.+loopS :: Integral a+ => (S.ByteString -> Maybe (a, S.ByteString)) -> S.ByteString -> a+loopS rd = go 0+ where+ go !acc !bs = case rd bs of+ Just (i, t) -> case S.uncons t of+ Just (_, t') -> go (acc + i) t'+ Nothing -> acc + i+ Nothing -> acc++-- Sum space-separated integers in a ByteString.+loopL :: Integral a+ => (L.ByteString -> Maybe (a, L.ByteString)) -> L.ByteString -> a+loopL rd = go 0+ where+ go !acc !bs = case rd bs of+ Just (i, t) -> case L.uncons t of+ Just (_, t') -> go (acc + i) t'+ Nothing -> acc + i+ Nothing -> acc++benchReadInt :: Benchmark+benchReadInt = bgroup "Read Integral"+ [ bgroup "Strict"+ [ bench "ReadInt" $ nf (loopS S.readInt) intS+ , bench "ReadInt8" $ nf (loopS S.readInt8) int8S+ , bench "ReadInt16" $ nf (loopS S.readInt16) int16S+ , bench "ReadInt32" $ nf (loopS S.readInt32) int32S+ , bench "ReadInt64" $ nf (loopS S.readInt64) int64S+ , bench "ReadWord" $ nf (loopS S.readWord) wordS+ , bench "ReadWord8" $ nf (loopS S.readWord8) word8S+ , bench "ReadWord16" $ nf (loopS S.readWord16) word16S+ , bench "ReadWord32" $ nf (loopS S.readWord32) word32S+ , bench "ReadWord64" $ nf (loopS S.readWord64) word64S+ , bench "ReadInteger" $ nf (loopS S.readInteger) bignatS+ , bench "ReadNatural" $ nf (loopS S.readNatural) bignatS+ , bench "ReadInteger small" $ nf (loopS S.readInteger) intS+ , bench "ReadNatural small" $ nf (loopS S.readNatural) wordS+ ]++ , bgroup "Lazy"+ [ bench "ReadInt" $ nf (loopL L.readInt) intL+ , bench "ReadInt8" $ nf (loopL L.readInt8) int8L+ , bench "ReadInt16" $ nf (loopL L.readInt16) int16L+ , bench "ReadInt32" $ nf (loopL L.readInt32) int32L+ , bench "ReadInt64" $ nf (loopL L.readInt64) int64L+ , bench "ReadWord" $ nf (loopL L.readWord) wordL+ , bench "ReadWord8" $ nf (loopL L.readWord8) word8L+ , bench "ReadWord16" $ nf (loopL L.readWord16) word16L+ , bench "ReadWord32" $ nf (loopL L.readWord32) word32L+ , bench "ReadWord64" $ nf (loopL L.readWord64) word64L+ , bench "ReadInteger" $ nf (loopL L.readInteger) bignatL+ , bench "ReadNatural" $ nf (loopL L.readNatural) bignatL+ , bench "ReadInteger small" $ nf (loopL L.readInteger) intL+ , bench "ReadNatural small" $ nf (loopL L.readNatural) wordL+ ]+ ]+ where+ mkWordL :: forall a. (Integral a, Bounded a)+ => (a -> B.Builder) -> L.ByteString+ mkWordL f = B.toLazyByteString b+ where b = mconcat [f i <> B.char8 ' ' | i <- [n-255..n]]+ n = maxBound @a+ mkWordS f = S.toStrict $ mkWordL f++ mkIntL :: forall a. (Integral a, Bounded a)+ => (a -> B.Builder) -> L.ByteString+ mkIntL f = B.toLazyByteString b+ where b = mconcat [f (i + 128) <> B.char8 ' ' | i <- [n-255..n]]+ n = maxBound @a+ mkIntS f = S.toStrict $ mkIntL f++ wordS, word8S, word16S, word32S, word64S :: S.ByteString+ !wordS = mkWordS B.wordDec+ !word8S = mkWordS B.word8Dec+ !word16S = mkWordS B.word16Dec+ !word32S = mkWordS B.word32Dec+ !word64S = mkWordS B.word64Dec++ intS, int8S, int16S, int32S, int64S :: S.ByteString+ !intS = mkIntS B.intDec+ !int8S = mkIntS B.int8Dec+ !int16S = mkIntS B.int16Dec+ !int32S = mkIntS B.int32Dec+ !int64S = mkIntS B.int64Dec++ word8L, word16L, word32L, word64L :: L.ByteString+ !wordL = mkWordL B.wordDec+ !word8L = mkWordL B.word8Dec+ !word16L = mkWordL B.word16Dec+ !word32L = mkWordL B.word32Dec+ !word64L = mkWordL B.word64Dec++ intL, int8L, int16L, int32L, int64L :: L.ByteString+ !intL = mkIntL B.intDec+ !int8L = mkIntL B.int8Dec+ !int16L = mkIntL B.int16Dec+ !int32L = mkIntL B.int32Dec+ !int64L = mkIntL B.int64Dec++ bignatL :: L.ByteString+ !bignatL = B.toLazyByteString b+ where b = mconcat [B.integerDec (powpow i) <> B.char8 ' ' | i <- [0..13]]+ powpow :: Word -> Integer+ powpow n = 2^(2^n :: Word)++ bignatS :: S.ByteString+ !bignatS = S.toStrict bignatL
+ bench/BenchShort.hs view
@@ -0,0 +1,246 @@+{-# LANGUAGE OverloadedStrings #-}++module BenchShort (benchShort) where++import Control.DeepSeq (force)+import Data.Foldable (foldMap)+import Data.Maybe (listToMaybe)+import Data.Monoid+import Data.String+import Test.Tasty.Bench+import Prelude hiding (words, head, tail)++import Data.ByteString.Short (ShortByteString)+import qualified Data.ByteString.Short as S++import Data.ByteString.Builder+import Data.ByteString.Builder.Extra (byteStringCopy,+ byteStringInsert,+ intHost)+import Data.ByteString.Builder.Internal (ensureFree)+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 System.Random++++------------------------------------------------------------------------------+-- Benchmark+------------------------------------------------------------------------------++-- input data (NOINLINE to ensure memoization)+----------------------------------------------++-- | Few-enough repetitions to avoid making GC too expensive.+nRepl :: Int+nRepl = 10000++{-# NOINLINE intData #-}+intData :: [Int]+intData = [1..nRepl]++{-# NOINLINE byteStringData #-}+byteStringData :: S.ShortByteString+byteStringData = S.pack $ map fromIntegral intData++{-# NOINLINE loremIpsum #-}+loremIpsum :: S.ShortByteString+loremIpsum = mconcat+ [ " Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor"+ , "incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, quis"+ , "nostrud exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat."+ , "Duis aute irure dolor in reprehenderit in voluptate velit esse cillum dolore eu"+ , "fugiat nulla pariatur. Excepteur sint occaecat cupidatat non proident, sunt in"+ , "culpa qui officia deserunt mollit anim id est laborum."+ ]++-- benchmark wrappers+---------------------++{-# INLINE benchB' #-}+benchB' :: String -> a -> (a -> ShortByteString) -> Benchmark+benchB' name x b = bench name $ whnf (S.length . b) x+++-- We use this construction of just looping through @n,n-1,..,1@ to ensure that+-- we measure the speed of the encoding and not the speed of generating the+-- values to be encoded.+{-# INLINE benchIntEncodingB #-}+benchIntEncodingB :: Int -- ^ Maximal 'Int' to write+ -> BoundedPrim Int -- ^ 'BoundedPrim' to execute+ -> IO () -- ^ 'IO' action to benchmark+benchIntEncodingB n0 w+ | n0 <= 0 = return ()+ | otherwise = do+ fpbuf <- mallocForeignPtrBytes (n0 * PI.sizeBound w)+ withForeignPtr fpbuf (loop n0) >> return ()+ where+ loop !n !op+ | n <= 0 = return op+ | otherwise = PI.runB w n op >>= loop (n - 1)+++-- Helpers+-------------++hashInt :: Int -> Int+hashInt x = iterate step x !! 10+ where+ step a = e+ where b = (a `xor` 61) `xor` (a `shiftR` 16)+ c = b + (b `shiftL` 3)+ d = c `xor` (c `shiftR` 4)+ e = d * 0x27d4eb2d+ f = e `xor` (e `shiftR` 15)++w :: Int -> Word8+w = fromIntegral++hashWord8 :: Word8 -> Word8+hashWord8 = fromIntegral . hashInt . fromIntegral++foldInputs' :: [[Word8]]+foldInputs' = force (S.unpack <$> foldInputs)++foldInputs :: [S.ShortByteString]+foldInputs = map (\k -> S.pack $ if k <= 6 then take (2 ^ k) [32..95] else concat (replicate (2 ^ (k - 6)) [32..95])) [0..16]++largeTraversalInput :: S.ShortByteString+largeTraversalInput = S.concat (replicate 10 byteStringData)++smallTraversalInput :: S.ShortByteString+smallTraversalInput = "The quick brown fox"++zeroes :: S.ShortByteString+zeroes = S.replicate 10000 0++partitionStrict p = nf (S.partition p) . randomStrict $ mkStdGen 98423098+ where randomStrict = fst . S.unfoldrN 10000 (Just . random)++-- ASCII \n to ensure no typos+nl :: Word8+nl = 0xa+{-# INLINE nl #-}++-- non-inlined equality test+nilEq :: Word8 -> Word8 -> Bool+{-# NOINLINE nilEq #-}+nilEq = (==)++-- lines of 200 letters from a to e, followed by repeated letter f+absurdlong :: S.ShortByteString+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 999999 0x66++bench_find_index_second :: ShortByteString -> Maybe Int+bench_find_index_second bs =+ let isNl = (== nl)+ in case S.findIndex isNl bs of+ Just !i -> S.findIndex isNl (S.drop (i+1) bs)+ Nothing -> Nothing+{-# INLINE bench_find_index_second #-}++bench_elem_index_second :: ShortByteString -> Maybe Int+bench_elem_index_second bs =+ case S.elemIndex nl bs of+ Just !i -> S.elemIndex nl (S.drop (i+1) bs)+ Nothing -> Nothing+{-# INLINE bench_elem_index_second #-}++++-- benchmarks+-------------++benchShort :: Benchmark+benchShort = absurdlong `seq` bgroup "ShortByteString"+ [ bgroup "Small payload"+ [ benchB' "mempty" () (const mempty)+ , benchB' "UTF-8 String (naive)" "hello world\0" fromString+ , benchB' "String (naive)" "hello world!" fromString+ ]+ , bgroup "intercalate"+ [ bench "intercalate (large)" $ whnf (S.intercalate $ " and also ") (replicate 300 "expression")+ , bench "intercalate (small)" $ whnf (S.intercalate "&") (replicate 30 "foo")+ , bench "intercalate (tiny)" $ whnf (S.intercalate "&") (["foo", "bar", "baz"])+ ]+ , bgroup "partition"+ [+ bgroup "strict"+ [+ bench "mostlyTrueFast" $ partitionStrict (< (w 225))+ , bench "mostlyFalseFast" $ partitionStrict (< (w 10))+ , bench "balancedFast" $ partitionStrict (< (w 128))++ , bench "mostlyTrueSlow" $ partitionStrict (\x -> hashWord8 x < w 225)+ , bench "mostlyFalseSlow" $ partitionStrict (\x -> hashWord8 x < w 10)+ , bench "balancedSlow" $ partitionStrict (\x -> hashWord8 x < w 128)+ ]+ ]+ , bgroup "folds"+ [ bgroup "strict"+ [ bgroup "foldl" $ map (\s -> bench (show $ S.length s) $+ nf (S.foldl (\acc x -> acc + fromIntegral x) (0 :: Int)) s) foldInputs+ , bgroup "foldl'" $ map (\s -> bench (show $ S.length s) $+ nf (S.foldl' (\acc x -> acc + fromIntegral x) (0 :: Int)) s) foldInputs+ , bgroup "foldr" $ map (\s -> bench (show $ S.length s) $+ nf (S.foldr (\x acc -> fromIntegral x + acc) (0 :: Int)) s) foldInputs+ , bgroup "foldr'" $ map (\s -> bench (show $ S.length s) $+ nf (S.foldr' (\x acc -> fromIntegral x + acc) (0 :: Int)) s) foldInputs+ , bgroup "foldr1'" $ map (\s -> bench (show $ S.length s) $+ nf (S.foldr1' (\x acc -> fromIntegral x + acc)) s) foldInputs+ , bgroup "unfoldrN" $ map (\s -> bench (show $ S.length s) $+ nf (S.unfoldrN (S.length s) (\a -> Just (a, a + 1))) 0) foldInputs+ , bgroup "filter" $ map (\s -> bench (show $ S.length s) $+ nf (S.filter odd) s) foldInputs+ ]+ ]+ , bgroup "findIndexOrLength"+ [ bench "takeWhile" $ nf (S.takeWhile even) zeroes+ , bench "dropWhile" $ nf (S.dropWhile even) zeroes+ , bench "break" $ nf (S.break odd) zeroes+ ]+ , bgroup "findIndex_"+ [ bench "findIndices" $ nf (sum . S.findIndices (\x -> x == 129 || x == 72)) byteStringData+ , bench "find" $ nf (S.find (>= 198)) byteStringData+ ]+ , bgroup "traversals"+ [ bench "map (+1) large" $ nf (S.map (+ 1)) largeTraversalInput+ , bench "map (+1) small" $ nf (S.map (+ 1)) smallTraversalInput+ ]+ , bgroup "ShortByteString strict first index" $+ [ bench "FindIndices" $ nf (listToMaybe . S.findIndices (== nl)) absurdlong+ , bench "ElemIndices" $ nf (listToMaybe . S.elemIndices nl) absurdlong+ , bench "FindIndex" $ nf (S.findIndex (== nl)) absurdlong+ , bench "ElemIndex" $ nf (S.elemIndex nl) absurdlong+ ]+ , bgroup "ShortByteString strict second index" $+ [ bench "FindIndices" $ nf (listToMaybe . drop 1 . S.findIndices (== nl)) absurdlong+ , bench "ElemIndices" $ nf (listToMaybe . drop 1 . S.elemIndices nl) absurdlong+ , bench "FindIndex" $ nf bench_find_index_second absurdlong+ , bench "ElemIndex" $ nf bench_elem_index_second absurdlong+ ]+ , bgroup "ShortByteString index equality inlining" $+ [ bench "FindIndices/inlined" $ nf (S.findIndices (== nl)) absurdlong+ , bench "FindIndices/non-inlined" $ nf (S.findIndices (nilEq nl)) absurdlong+ , bench "FindIndex/inlined" $ nf (S.findIndex (== nl)) absurdlong+ , bench "FindIndex/non-inlined" $ nf (S.findIndex (nilEq nl)) absurdlong+ ]+ , bgroup "ShortByteString conversions" $+ [ bgroup "unpack" $ map (\s -> bench (show $ S.length s) $+ nf (\x -> S.unpack x) s) foldInputs+ , bgroup "pack" $ map (\s -> bench (show $ length s) $+ nf S.pack s) foldInputs'+ , bench "unpack and get last element" $ nf (\x -> last . S.unpack $ x) absurdlong+ , bench "unpack and get first 120 elements" $ nf (\x -> take 120 . S.unpack $ x) absurdlong+ ]+ ]
bytestring.cabal view
@@ -1,5 +1,7 @@+Cabal-Version: 2.2+ Name: bytestring-Version: 0.11.2.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)@@ -29,8 +31,9 @@ serialisation or pretty printing. . There is also a 'ShortByteString' type which has a lower memory overhead- and can can be converted to or from a 'ByteString', but supports very few- other operations. It is suitable for keeping many short strings in memory.+ and can be converted to or from a 'ByteString'. It is suitable for keeping+ many short strings in memory, especially long-term, without incurring any+ possible heap fragmentation costs. . 'ByteString's are not designed for Unicode. For Unicode strings you should use the 'Text' type from the @text@ package.@@ -40,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,@@ -54,92 +57,147 @@ Maintainer: Haskell Bytestring Team <andrew.lelechenko@gmail.com>, Core Libraries Committee Homepage: https://github.com/haskell/bytestring Bug-reports: https://github.com/haskell/bytestring/issues-Tested-With: GHC==9.0.1,- GHC==8.10.4,+Tested-With: GHC==9.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+extra-source-files: README.md Changelog.md include/bytestring-cpp-macros.h +Flag pure-haskell+ description: Don't use bytestring's standard C routines++ When this flag is true, bytestring will use pure Haskell variants (no C FFI)+ of the internal functions. This is not recommended except in use cases that+ cannot (or do not) depend on C, such as with GHC's JavaScript backend.++ default: False+ manual: True+ source-repository head 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 - 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+ if impl(ghc < 9.4)+ build-depends: data-array-byte >= 0.1 && < 0.2 - 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.Lazy.Internal.Deque+ 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- -O2- -fmax-simplifier-iterations=10- -fdicts-cheap- -fspec-constr-count=6- - c-sources: cbits/fpstring.c- cbits/itoa.c- - if (arch(aarch64))- c-sources: cbits/aarch64/is-valid-utf8.c+ 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+ other-modules: Data.ByteString.Internal.Pure+ default-extensions: NoForeignFunctionInterface+ -- Pure Haskell implementation only implemented for recent GHCs/base+ build-depends: base >= 4.18 && < 5 else- c-sources: cbits/is-valid-utf8.c- - cc-options: -std=c11- - -- Required, due to the following issues:- -- * https://gitlab.haskell.org/ghc/ghc/-/issues/20525#note_385580- -- * https://gitlab.haskell.org/ghc/ghc/-/issues/19417- if os(windows)- extra-libraries: gcc_s gcc+ cpp-options: -DPURE_HASKELL=0 + c-sources: cbits/fpstring.c+ cbits/itoa.c+ cbits/shortbytestring.c+ cbits/aligned-static-hs-data.c++ if (arch(aarch64))+ c-sources: cbits/aarch64/is-valid-utf8.c+ else+ c-sources: cbits/is-valid-utf8.c++ -- DNDEBUG disables asserts in cbits/+ cc-options: -std=c11 -DNDEBUG=1+ -fno-strict-aliasing+ -Werror=undef++ -- No need to link to libgcc on ghc-9.4 and later which uses a clang-based+ -- toolchain.+ 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@@ -154,32 +212,40 @@ Properties.ByteStringChar8 Properties.ByteStringLazy Properties.ByteStringLazyChar8+ Properties.ShortByteString QuickCheckUtils hs-source-dirs: tests, tests/builder build-depends: base, bytestring, deepseq,- ghc-prim, QuickCheck, tasty,- tasty-quickcheck,+ tasty-quickcheck >= 0.8.1, template-haskell,- transformers >= 0.3+ 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 BenchCSV BenchIndices+ BenchReadInt+ 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 build-depends: base, bytestring, deepseq,
cbits/aarch64/is-valid-utf8.c view
@@ -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.@@ -258,22 +260,24 @@ //'Roll back' our pointer a little to prepare for a slow search of the rest. uint32_t token; 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;- ptrdiff_t lookahead = 0;- if (token_ptr[3] > (int8_t)0xBF) {- lookahead = 1;- }- else if (token_ptr[2] > (int8_t)0xBF) {- lookahead = 2;- }- else if (token_ptr[1] > (int8_t)0xBF) {- lookahead = 3;+ uint8_t const *token_ptr = (uint8_t const *)&token;+ ptrdiff_t rollback = 0;+ // We must not roll back if no big blocks were processed, as then+ // the fallback function would examine out-of-bounds data (#620).+ // In that case, prev_input contains only nulls and we skip the if body.+ if (token_ptr[3] >= 0x80u) {+ // Look for an incomplete multi-byte code point+ if (token_ptr[3] >= 0xC0u) {+ rollback = 1;+ } else if (token_ptr[2] >= 0xE0u) {+ rollback = 2;+ } else if (token_ptr[1] >= 0xF0u) {+ rollback = 3;+ } } // Finish the job.- uint8_t const * const small_ptr = ptr - lookahead;- size_t const small_len = remaining + lookahead;+ uint8_t const *const small_ptr = ptr - rollback;+ size_t const small_len = remaining + rollback; return is_valid_utf8_fallback(small_ptr, small_len); }
+ cbits/aligned-static-hs-data.c view
@@ -0,0 +1,756 @@+// This file contains various chunks of raw static data that we can't+// put into GHC-Haskell primitive string literals because we perform+// /aligned/ reads with them.++#include "MachDeps.h"+#include <stdint.h>++extern const char hs_bytestring_lower_hex_table[513];+const char hs_bytestring_lower_hex_table[513]+ __attribute__(( aligned(ALIGNMENT_WORD16) ))+ = "000102030405060708090a0b0c0d0e0f"+ "101112131415161718191a1b1c1d1e1f"+ "202122232425262728292a2b2c2d2e2f"+ "303132333435363738393a3b3c3d3e3f"+ "404142434445464748494a4b4c4d4e4f"+ "505152535455565758595a5b5c5d5e5f"+ "606162636465666768696a6b6c6d6e6f"+ "707172737475767778797a7b7c7d7e7f"+ "808182838485868788898a8b8c8d8e8f"+ "909192939495969798999a9b9c9d9e9f"+ "a0a1a2a3a4a5a6a7a8a9aaabacadaeaf"+ "b0b1b2b3b4b5b6b7b8b9babbbcbdbebf"+ "c0c1c2c3c4c5c6c7c8c9cacbcccdcecf"+ "d0d1d2d3d4d5d6d7d8d9dadbdcdddedf"+ "e0e1e2e3e4e5e6e7e8e9eaebecedeeef"+ "f0f1f2f3f4f5f6f7f8f9fafbfcfdfeff";++extern const char hs_bytestring_digit_pairs_table[201];+const char hs_bytestring_digit_pairs_table[201]+ __attribute__(( aligned(ALIGNMENT_WORD16) ))+ = "00010203040506070809"+ "10111213141516171819"+ "20212223242526272829"+ "30313233343536373839"+ "40414243444546474849"+ "50515253545556575859"+ "60616263646566676869"+ "70717273747576777879"+ "80818283848586878889"+ "90919293949596979899";++extern const uint64_t hs_bytestring_float_pow5_inv_split[31];+const uint64_t hs_bytestring_float_pow5_inv_split[31] = {+// map (finv float_pow5_inv_bitcount) [0..float_max_inv_split]+ 0x800000000000001,+ 0x666666666666667,+ 0x51eb851eb851eb9,+ 0x4189374bc6a7efa,+ 0x68db8bac710cb2a,+ 0x53e2d6238da3c22,+ 0x431bde82d7b634e,+ 0x6b5fca6af2bd216,+ 0x55e63b88c230e78,+ 0x44b82fa09b5a52d,+ 0x6df37f675ef6eae,+ 0x57f5ff85e592558,+ 0x465e6604b7a8447,+ 0x709709a125da071,+ 0x5a126e1a84ae6c1,+ 0x480ebe7b9d58567,+ 0x734aca5f6226f0b,+ 0x5c3bd5191b525a3,+ 0x49c97747490eae9,+ 0x760f253edb4ab0e,+ 0x5e72843249088d8,+ 0x4b8ed0283a6d3e0,+ 0x78e480405d7b966,+ 0x60b6cd004ac9452,+ 0x4d5f0a66a23a9db,+ 0x7bcb43d769f762b,+ 0x63090312bb2c4ef,+ 0x4f3a68dbc8f03f3,+ 0x7ec3daf94180651,+ 0x65697bfa9acd1da,+ 0x51212ffbaf0a7e2+};++extern const uint64_t hs_bytestring_float_pow5_split[47];+const uint64_t hs_bytestring_float_pow5_split[47] = {+// map (fnorm float_pow5_bitcount) [0..float_max_split]+ 0x1000000000000000,+ 0x1400000000000000,+ 0x1900000000000000,+ 0x1f40000000000000,+ 0x1388000000000000,+ 0x186a000000000000,+ 0x1e84800000000000,+ 0x1312d00000000000,+ 0x17d7840000000000,+ 0x1dcd650000000000,+ 0x12a05f2000000000,+ 0x174876e800000000,+ 0x1d1a94a200000000,+ 0x12309ce540000000,+ 0x16bcc41e90000000,+ 0x1c6bf52634000000,+ 0x11c37937e0800000,+ 0x16345785d8a00000,+ 0x1bc16d674ec80000,+ 0x1158e460913d0000,+ 0x15af1d78b58c4000,+ 0x1b1ae4d6e2ef5000,+ 0x10f0cf064dd59200,+ 0x152d02c7e14af680,+ 0x1a784379d99db420,+ 0x108b2a2c28029094,+ 0x14adf4b7320334b9,+ 0x19d971e4fe8401e7,+ 0x1027e72f1f128130,+ 0x1431e0fae6d7217c,+ 0x193e5939a08ce9db,+ 0x1f8def8808b02452,+ 0x13b8b5b5056e16b3,+ 0x18a6e32246c99c60,+ 0x1ed09bead87c0378,+ 0x13426172c74d822b,+ 0x1812f9cf7920e2b6,+ 0x1e17b84357691b64,+ 0x12ced32a16a1b11e,+ 0x178287f49c4a1d66,+ 0x1d6329f1c35ca4bf,+ 0x125dfa371a19e6f7,+ 0x16f578c4e0a060b5,+ 0x1cb2d6f618c878e3,+ 0x11efc659cf7d4b8d,+ 0x166bb7f0435c9e71,+ 0x1c06a5ec5433c60d+};++extern const uint64_t hs_bytestring_double_pow5_inv_split[584];+const uint64_t hs_bytestring_double_pow5_inv_split[584] = {+// splitWord128s $ map (finv double_pow5_inv_bitcount) [0..double_max_inv_split]+ 0x1,0x2000000000000000,+ 0x999999999999999a,0x1999999999999999,+ 0x47ae147ae147ae15,0x147ae147ae147ae1,+ 0x6c8b4395810624de,0x10624dd2f1a9fbe7,+ 0x7a786c226809d496,0x1a36e2eb1c432ca5,+ 0x61f9f01b866e43ab,0x14f8b588e368f084,+ 0xb4c7f34938583622,0x10c6f7a0b5ed8d36,+ 0x87a6520ec08d236a,0x1ad7f29abcaf4857,+ 0x9fb841a566d74f88,0x15798ee2308c39df,+ 0xe62d01511f12a607,0x112e0be826d694b2,+ 0xd6ae6881cb5109a4,0x1b7cdfd9d7bdbab7,+ 0xdef1ed34a2a73aea,0x15fd7fe17964955f,+ 0x7f27f0f6e885c8bb,0x119799812dea1119,+ 0x650cb4be40d60df8,0x1c25c268497681c2,+ 0xea70909833de7193,0x16849b86a12b9b01,+ 0x21f3a6e0297ec143,0x1203af9ee756159b,+ 0x6985d7cd0f313537,0x1cd2b297d889bc2b,+ 0x2137dfd73f5a90f9,0x170ef54646d49689,+ 0xe75fe645cc4873fa,0x12725dd1d243aba0,+ 0xa5663d3c7a0d865d,0x1d83c94fb6d2ac34,+ 0x511e976394d79eb1,0x179ca10c9242235d,+ 0xda7edf82dd794bc1,0x12e3b40a0e9b4f7d,+ 0x2a6498d1625bac68,0x1e392010175ee596,+ 0xeeb6e0a781e2f053,0x182db34012b25144,+ 0x58924d52ce4f26a9,0x1357c299a88ea76a,+ 0x27507bb7b07ea441,0x1ef2d0f5da7dd8aa,+ 0x52a6c95fc0655034,0x18c240c4aecb13bb,+ 0xeebd44c99eaa690,0x13ce9a36f23c0fc9,+ 0xb17953adc3110a80,0x1fb0f6be50601941,+ 0xc12ddc8b02740867,0x195a5efea6b34767,+ 0x3424b06f3529a052,0x14484bfeebc29f86,+ 0x901d59f290ee19db,0x1039d66589687f9e,+ 0x4cfbc31db4b0295f,0x19f623d5a8a73297,+ 0x3d9635b15d59bab2,0x14c4e977ba1f5bac,+ 0x97ab5e277de16228,0x109d8792fb4c4956,+ 0xf2abc9d8c9689d0d,0x1a95a5b7f87a0ef0,+ 0x5bbca17a3aba173e,0x154484932d2e725a,+ 0xafca1ac82efb45cb,0x11039d428a8b8eae,+ 0xb2dcf7a6b1920945,0x1b38fb9daa78e44a,+ 0xf57d92ebc141a104,0x15c72fb1552d836e,+ 0xc46475896767b403,0x116c262777579c58,+ 0x6d6d88dbd8a5ecd2,0x1be03d0bf225c6f4,+ 0x8abe071646eb23db,0x164cfda3281e38c3,+ 0x6efe6c11d255b649,0x11d7314f534b609c,+ 0xb197134fb6ef8a0e,0x1c8b821885456760,+ 0x27ac0f72f8bfa1a5,0x16d601ad376ab91a,+ 0xb95672c260994e1e,0x1244ce242c5560e1,+ 0xf5571e03cdc21695,0x1d3ae36d13bbce35,+ 0x2aac18030b01abab,0x17624f8a762fd82b,+ 0xbbbce0026f348956,0x12b50c6ec4f31355,+ 0x92c7ccd0b1eda889,0x1dee7a4ad4b81eef,+ 0xdbd30a408e57ba07,0x17f1fb6f10934bf2,+ 0x7ca8d50071dfc806,0x1327fc58da0f6ff5,+ 0xfaa7bb33e9660cd6,0x1ea6608e29b24cbb,+ 0x9552fc298784d711,0x18851a0b548ea3c9,+ 0xaaa8c9bad2d0ac0e,0x139dae6f76d88307,+ 0xdddadc5e1e1aace3,0x1f62b0b257c0d1a5,+ 0x7e48b04b4b488a4f,0x191bc08eac9a4151,+ 0xcb6d59d5d5d3a1d9,0x141633a556e1cdda,+ 0x3c577b1177dc817b,0x1011c2eaabe7d7e2,+ 0xc6f25e825960cf2a,0x19b604aaaca62636,+ 0x6bf518684780a5bb,0x14919d5556eb51c5,+ 0x232a79ed06008496,0x10747ddddf22a7d1,+ 0xd1dd8fe1a3340756,0x1a53fc9631d10c81,+ 0xa7e4731ae8f66c45,0x150ffd44f4a73d34,+ 0x531d28e253f8569e,0x10d9976a5d52975d,+ 0xeb61db03b98d5762,0x1af5bf109550f22e,+ 0xbc4e48cfc7a445e8,0x159165a6ddda5b58,+ 0x6371d3d96c836b20,0x11411e1f17e1e2ad,+ 0x9f1c8628ad9f11cd,0x1b9b6364f3030448,+ 0xe5b06b53be18db0b,0x1615e91d8f359d06,+ 0xeaf3890fcb4715a2,0x11ab20e472914a6b,+ 0x44b8db4c7871bc37,0x1c45016d841baa46,+ 0x3c715d6c6c1635f,0x169d9abe03495505,+ 0x3638de456bcde919,0x1217aefe69077737,+ 0x56c163a2461641c1,0x1cf2b1970e725858,+ 0xdf011c81d1ab67ce,0x17288e1271f51379,+ 0x7f3416ce4155eca5,0x1286d80ec190dc61,+ 0x6520247d3556476e,0x1da48ce468e7c702,+ 0xea801d30f7783925,0x17b6d71d20b96c01,+ 0xbb99b0f3f92cfa84,0x12f8ac174d612334,+ 0x5f5c4e532847f739,0x1e5aacf215683854,+ 0x7f7d0b75b9d32c2e,0x18488a5b44536043,+ 0x9930d5f7c7dc2358,0x136d3b7c36a919cf,+ 0x8eb4898c72f9d226,0x1f152bf9f10e8fb2,+ 0x722a07a38f2e41b8,0x18ddbcc7f40ba628,+ 0xc1bb394fa5be9afa,0x13e497065cd61e86,+ 0x9c5ec2190930f7f6,0x1fd424d6faf030d7,+ 0x49e56814075a5ff8,0x197683df2f268d79,+ 0x6e51201005e1e660,0x145ecfe5bf520ac7,+ 0xf1da800cd181851a,0x104bd984990e6f05,+ 0x4fc400148268d4f5,0x1a12f5a0f4e3e4d6,+ 0xd96999aa01ed772b,0x14dbf7b3f71cb711,+ 0xadee1488018ac5bc,0x10aff95cc5b09274,+ 0x497ceda668de092c,0x1ab328946f80ea54,+ 0x3aca57b853e4d424,0x155c2076bf9a5510,+ 0x623b7960431d7683,0x1116805effaeaa73,+ 0x9d2bf566d1c8bd9e,0x1b5733cb32b110b8,+ 0x7dbcc452416d647f,0x15df5ca28ef40d60,+ 0xcafd69db678ab6cc,0x117f7d4ed8c33de6,+ 0xab2f0fc572778adf,0x1bff2ee48e052fd7,+ 0x88f273045b92d580,0x1665bf1d3e6a8cac,+ 0xd3f528d049424466,0x11eaff4a98553d56,+ 0xb988414d4203a0a3,0x1cab3210f3bb9557,+ 0x6139cdd76802e6e9,0x16ef5b40c2fc7779,+ 0xe761717920025254,0x125915cd68c9f92d,+ 0xa568b58e999d5086,0x1d5b561574765b7c,+ 0x5120913ee14aa6d2,0x177c44ddf6c515fd,+ 0xa74d40ff1aa21f0e,0x12c9d0b1923744ca,+ 0xbaece64f769cb4a,0x1e0fb44f50586e11,+ 0x3c8bd850c5ee3c3b,0x180c903f7379f1a7,+ 0xca0979da37f1c9c9,0x133d4032c2c7f485,+ 0xa9a8c2f6bfe942db,0x1ec866b79e0cba6f,+ 0x2153cf2bccba9be3,0x18a0522c7e709526,+ 0x1aa9728970954982,0x13b374f06526ddb8,+ 0xf775840f1a88759d,0x1f8587e7083e2f8c,+ 0x5f9136727ba05e17,0x19379fec0698260a,+ 0x1940f85b9619e4df,0x142c7ff0054684d5,+ 0xe100c6afab47ea4c,0x1023998cd1053710,+ 0xce67a44c453fdd47,0x19d28f47b4d524e7,+ 0xd852e9d69dccb106,0x14a8729fc3ddb71f,+ 0x79dbee454b0a2738,0x1086c219697e2c19,+ 0x295fe3a211a9d859,0x1a71368f0f30468f,+ 0xbab31c81a7bb137a,0x15275ed8d8f36ba5,+ 0x6228e39aec95a92f,0x10ec4be0ad8f8951,+ 0x9d0e38f7e0ef7517,0x1b13ac9aaf4c0ee8,+ 0xb0d82d931a592a79,0x15a956e225d67253,+ 0x8d79be0f4847552e,0x11544581b7dec1dc,+ 0x158f967eda0bbb7c,0x1bba08cf8c979c94,+ 0x77a611ff14d62f97,0x162e6d72d6dfb076,+ 0xf951a7ff43de8c79,0x11bebdf578b2f391,+ 0xc21c3ffed2fdad8e,0x1c6463225ab7ec1c,+ 0x1b0333242648ad8,0x16b6b5b5155ff017,+ 0x159c28e9b83a246,0x122bc490dde659ac,+ 0xcef604175f3903a3,0x1d12d41afca3c2ac,+ 0x725e69ac4c2d9c83,0x17424348ca1c9bbd,+ 0xf5185489d68ae39c,0x129b69070816e2fd,+ 0xee8d540fbdab05c6,0x1dc574d80cf16b2f,+ 0xbed77672fe226b05,0x17d12a4670c1228c,+ 0xff12c528cb4ebc04,0x130dbb6b8d674ed6,+ 0xcb513b74787df9a0,0x1e7c5f127bd87e24,+ 0x90dc929f9fe614d,0x18637f41fcad31b7,+ 0xa0d7d42194cb810a,0x1382cc34ca2427c5,+ 0x67bfb9cf5478ce77,0x1f37ad21436d0c6f,+ 0x1fcc94a5dd2d71f9,0x18f9574dcf8a7059,+ 0x7fd6dd517dbdf4c7,0x13faac3e3fa1f37a,+ 0xffbe2ee8c92fee0b,0x1ff779fd329cb8c3,+ 0x6631bf20a0f324d6,0x1992c7fdc216fa36,+ 0xb827cc1a1a5c1d78,0x14756ccb01abfb5e,+ 0x935309ae7b7ce460,0x105df0a267bcc918,+ 0x1eeb42b0c594a099,0x1a2fe76a3f9474f4,+ 0xe58902270476e6e1,0x14f31f8832dd2a5c,+ 0xb7a0ce859d2bebe7,0x10c27fa028b0eeb0,+ 0x59014a6f61dfdfd8,0x1ad0cc33744e4ab4,+ 0xe0cdd525e7e64cad,0x1573d68f903ea229,+ 0x4d7177518651d6f1,0x11297872d9cbb4ee,+ 0x7be8bee8d6e957e8,0x1b758d848fac54b0,+ 0xfcba3253df211320,0x15f7a46a0c89dd59,+ 0x63c8284318e74280,0x1192e9ee706e4aae,+ 0x60d0d3827d86a66,0x1c1e43171a4a1117,+ 0x6b3da42cecad21eb,0x167e9c127b6e7412,+ 0x88fe1cf0bd574e56,0x11fee341fc585cdb,+ 0x419694b462254a23,0x1ccb0536608d615f,+ 0x67abaa29e81dd4e9,0x1708d0f84d3de77f,+ 0xb95621bb2017dd87,0x126d73f9d764b932,+ 0xc223692b668c95a5,0x1d7becc2f23ac1ea,+ 0xce82ba891ed6de1d,0x179657025b6234bb,+ 0xa53562074bdf1818,0x12deac01e2b4f6fc,+ 0x3b889cd87964f359,0x1e3113363787f194,+ 0xfc6d4a46c783f5e1,0x18274291c6065adc,+ 0x30576e9f06032b1a,0x13529ba7d19eaf17,+ 0x1a257dcb3cd1de90,0x1eea92a61c311825,+ 0x481dfe3c30a7e540,0x18bba884e35a79b7,+ 0xd34b31c9c0865100,0x13c9539d82aec7c5,+ 0x5211e942cda3b4cd,0x1fa885c8d117a609,+ 0x74db21023e1c90a4,0x19539e3a40dfb807,+ 0xf715b401cb4a0d50,0x1442e4fb67196005,+ 0xf8de299b09080aa7,0x103583fc527ab337,+ 0x8e304291a80cddd7,0x19ef3993b72ab859,+ 0x3e8d020e200a4b13,0x14bf6142f8eef9e1,+ 0x653d9b3e80083c0f,0x10991a9bfa58c7e7,+ 0x6ec8f864000d2ce4,0x1a8e90f9908e0ca5,+ 0x8bd3f9e999a423ea,0x153eda614071a3b7,+ 0x3ca994bae1501cbb,0x10ff151a99f482f9,+ 0xc775bac49bb3612b,0x1b31bb5dc320d18e,+ 0xd2c4956a16291a89,0x15c162b168e70e0b,+ 0xdbd0778811ba7ba1,0x11678227871f3e6f,+ 0x2c80bf401c5d929b,0x1bd8d03f3e9863e6,+ 0xbd33cc3349e47549,0x16470cff6546b651,+ 0xca8fd68f6e505dd4,0x11d270cc51055ea7,+ 0x4419574be3b3c953,0x1c83e7ad4e6efdd9,+ 0x347790982f63aa9,0x16cfec8aa52597e1,+ 0xcf6c60d468c4fbba,0x123ff06eea847980,+ 0xe57a34870e07f92a,0x1d331a4b10d3f59a,+ 0x512e906c0b399422,0x175c1508da432ae2,+ 0xda8ba6bcd5c7a9b5,0x12b010d3e1cf5581,+ 0x90df712e22d90f87,0x1de6815302e5559c,+ 0xda4c5a8b4f140c6c,0x17eb9aa8cf1dde16,+ 0xaea37ba2a5a9a38a,0x1322e220a5b17e78,+ 0x7dd25f6aa2a905a9,0x1e9e369aa2b59727,+ 0x97db7f888220d154,0x187e92154ef7ac1f,+ 0x797c6606ce80a777,0x139874ddd8c6234c,+ 0x8f2d700ae4010bf1,0x1f5a549627a36bad,+ 0xc2459a25000d65a,0x191510781fb5efbe,+ 0x701d1481d99a4515,0x1410d9f9b2f7f2fe,+ 0xc017439b147b6a77,0x100d7b2e28c65bfe,+ 0xccf205c4ed9243f2,0x19af2b7d0e0a2cca,+ 0xa5b37d0be0e9cc2,0x148c22ca71a1bd6f,+ 0x848f973cb3ee3ce,0x10701bd527b4978c,+ 0xda0e5bec78649fb0,0x1a4cf9550c5425ac,+ 0x7b3eaff060507fc0,0x150a6110d6a9b7bd,+ 0x95cbbff380406633,0x10d51a73deee2c97,+ 0xefac665266cd7052,0x1aee90b964b04758,+ 0x2623850eb8a459db,0x158ba6fab6f36c47,+ 0x1e82d0d893b6ae49,0x113c85955f29236c,+ 0xfd9e1af41f8ab075,0x1b9408eefea838ac,+ 0x97b1af29b2d559f7,0x16100725988693bd,+ 0xac8e25baf5777b2c,0x11a66c1e139edc97,+ 0x7a7d092b2258c513,0x1c3d79c9b8fe2dbf,+ 0x61fda0ef4ead6a76,0x169794a160cb57cc,+ 0xe7fe1a590bbdeec5,0x1212dd4de7091309,+ 0xa6635d5b45fcb13a,0x1ceafbafd80e84dc,+ 0x851c4aaf6b308dc8,0x172262f3133ed0b0,+ 0xd0e36ef2bc26d7d4,0x1281e8c275cbda26,+ 0xb49f17eac6a48c86,0x1d9ca79d894629d7,+ 0x2a18dfef0550706b,0x17b08617a104ee46,+ 0x54e0b3259dd9f389,0x12f39e794d9d8b6b,+ 0x87cdeb6f62f65274,0x1e5297287c2f4578,+ 0xd30b22bf825ea85d,0x18421286c9bf6ac6,+ 0xf3c1bcc684bb9e4,0x13680ed23aff889f,+ 0x18602c7a4079296d,0x1f0ce4839198da98,+ 0x46b356c833942124,0x18d71d360e13e213,+ 0x388f78a029434db6,0x13df4a91a4dcb4dc,+ 0x5a7f2766a86baf8a,0x1fcbaa82a1612160,+ 0x153285ebb9efbfa2,0x196fbb9bb44db44d,+ 0xaa8ed189618c994e,0x145962e2f6a4903d,+ 0xeed8a7a11ad6e10c,0x1047824f2bb6d9ca,+ 0x7e27729b5e249b45,0x1a0c03b1df8af611,+ 0xfe85f549181d4904,0x14d6695b193bf80d,+ 0xcb9e5dd4134aa0d0,0x10ab877c142ff9a4,+ 0xdf63c9535211014d,0x1aac0bf9b9e65c3a,+ 0x191ca10f74da6771,0x15566ffafb1eb02f,+ 0xadb080d92a4852c1,0x1111f32f2f4bc025,+ 0x15e7348eaa0d5134,0x1b4feb7eb212cd09,+ 0xab1f5d3eee710dc4,0x15d98932280f0a6d,+ 0xbc1917658b8da49d,0x117ad428200c0857,+ 0x2cf4f23c127c3a94,0x1bf7b9d9cce00d59,+ 0xf0c3f4fcdb969543,0x165fc7e170b33de0,+ 0x5a365d9716121103,0x11e6398126f5cb1a,+ 0x9056fc24f01ce804,0x1ca38f350b22de90,+ 0xd9df301d8ce3ecd0,0x16e93f5da2824ba6,+ 0xe17f59b13d8323da,0x125432b14ecea2eb,+ 0x68cbc2b52f38395c,0x1d53844ee47dd179,+ 0x53d6355dbf602de3,0x177603725064a794,+ 0xa9782ab165e68b1c,0x12c4cf8ea6b6ec76,+ 0xf26aab56fd744fa,0x1e07b27dd78b13f1,+ 0x3f52222abfdf6a62,0x18062864ac6f4327,+ 0x65db4e88997f884e,0x1338205089f29c1f,+ 0x6fc54a7428cc0d4a,0x1ec033b40fea9365,+ 0x596aa1f68709a43b,0x1899c2f673220f84,+ 0xadeee7f86c07b696,0x13ae3591f5b4d936,+ 0x497e3ff3e00c5756,0x1f7d228322baf524,+ 0xd464fff64cd6ac45,0x1930e868e89590e9,+ 0x4383fff83d7889d1,0x14272053ed4473ee,+ 0xcf9cccc69793a174,0x101f4d0ff1038ff1,+ 0x7f6147a425b90252,0x19cbae7fe805b31c,+ 0xcc4dd2e9b7c7350f,0x14a2f1ffecd15c16,+ 0x3d0b0f215fd290d9,0x10825b3323dab012,+ 0x61ab4b689950e7c1,0x1a6a2b85062ab350,+ 0x4e22a2ba1440b967,0x1521bc6a6b555c40,+ 0xb4ee894dd009453,0x10e7c9eebc4449cd,+ 0x1217da87c800ed51,0x1b0c764ac6d3a948,+ 0xdb46486ca000bdda,0x15a391d56bdc876c,+ 0x490506bd4ccd64af,0x114fa7ddefe39f8a,+ 0xa8080ac87ae23ab1,0x1bb2a62fe638ff43,+ 0x5339a239fbe82ef4,0x162884f31e93ff69,+ 0x75c7b4fb2fecf25d,0x11ba03f5b20fff87,+ 0x22d92191e647ea2e,0x1c5cd322b67fff3f,+ 0xb57a8141850654f2,0x16b0a8e891ffff65,+ 0xc4620101373843f5,0x1226ed86db3332b7,+ 0x3a366801f1f39fee,0x1d0b15a491eb8459,+ 0xfb5eb99b27f6198b,0x173c115074bc69e0,+ 0x2f7efae2865e7ad6,0x129674405d6387e7,+ 0xe597f7d0d6fd9156,0x1dbd86cd6238d971,+ 0x8479930d78cadaab,0x17cad23de82d7ac1,+ 0xd06142712d6f1556,0x1308a831868ac89a,+ 0x4d686a4eaf182222,0x1e74404f3daada91,+ 0xa453883ef279b4e8,0x185d003f6488aeda,+ 0xe9dc6cff28615d87,0x137d99cc506d58ae,+ 0xa960ae650d6895a4,0x1f2f5c7a1a488de4,+ 0xbab3beb73ded4483,0x18f2b061aea07183,+ 0x2ef6322c318a9d36,0x13f559e7bee6c136+};++extern const uint64_t hs_bytestring_double_pow5_split[652];+const uint64_t hs_bytestring_double_pow5_split[652] = {+// splitWord128s $ map (fnorm double_pow5_bitcount) [0..double_max_split]+ 0x0,0x1000000000000000,+ 0x0,0x1400000000000000,+ 0x0,0x1900000000000000,+ 0x0,0x1f40000000000000,+ 0x0,0x1388000000000000,+ 0x0,0x186a000000000000,+ 0x0,0x1e84800000000000,+ 0x0,0x1312d00000000000,+ 0x0,0x17d7840000000000,+ 0x0,0x1dcd650000000000,+ 0x0,0x12a05f2000000000,+ 0x0,0x174876e800000000,+ 0x0,0x1d1a94a200000000,+ 0x0,0x12309ce540000000,+ 0x0,0x16bcc41e90000000,+ 0x0,0x1c6bf52634000000,+ 0x0,0x11c37937e0800000,+ 0x0,0x16345785d8a00000,+ 0x0,0x1bc16d674ec80000,+ 0x0,0x1158e460913d0000,+ 0x0,0x15af1d78b58c4000,+ 0x0,0x1b1ae4d6e2ef5000,+ 0x0,0x10f0cf064dd59200,+ 0x0,0x152d02c7e14af680,+ 0x0,0x1a784379d99db420,+ 0x0,0x108b2a2c28029094,+ 0x0,0x14adf4b7320334b9,+ 0x4000000000000000,0x19d971e4fe8401e7,+ 0x8800000000000000,0x1027e72f1f128130,+ 0xaa00000000000000,0x1431e0fae6d7217c,+ 0xd480000000000000,0x193e5939a08ce9db,+ 0xc9a0000000000000,0x1f8def8808b02452,+ 0xbe04000000000000,0x13b8b5b5056e16b3,+ 0xad85000000000000,0x18a6e32246c99c60,+ 0xd8e6400000000000,0x1ed09bead87c0378,+ 0x878fe80000000000,0x13426172c74d822b,+ 0x6973e20000000000,0x1812f9cf7920e2b6,+ 0x3d0da8000000000,0x1e17b84357691b64,+ 0x8262889000000000,0x12ced32a16a1b11e,+ 0x22fb2ab400000000,0x178287f49c4a1d66,+ 0xabb9f56100000000,0x1d6329f1c35ca4bf,+ 0xcb54395ca0000000,0x125dfa371a19e6f7,+ 0xbe2947b3c8000000,0x16f578c4e0a060b5,+ 0x2db399a0ba000000,0x1cb2d6f618c878e3,+ 0xfc90400474400000,0x11efc659cf7d4b8d,+ 0x7bb4500591500000,0x166bb7f0435c9e71,+ 0xdaa16406f5a40000,0x1c06a5ec5433c60d,+ 0xa8a4de8459868000,0x118427b3b4a05bc8,+ 0xd2ce16256fe82000,0x15e531a0a1c872ba,+ 0x87819baecbe22800,0x1b5e7e08ca3a8f69,+ 0xf4b1014d3f6d5900,0x111b0ec57e6499a1,+ 0x71dd41a08f48af40,0x1561d276ddfdc00a,+ 0xe549208b31adb10,0x1aba4714957d300d,+ 0x28f4db456ff0c8ea,0x10b46c6cdd6e3e08,+ 0x33321216cbecfb24,0x14e1878814c9cd8a,+ 0xbffe969c7ee839ed,0x1a19e96a19fc40ec,+ 0xf7ff1e21cf512434,0x105031e2503da893,+ 0xf5fee5aa43256d41,0x14643e5ae44d12b8,+ 0x337e9f14d3eec892,0x197d4df19d605767,+ 0x5e46da08ea7ab6,0x1fdca16e04b86d41,+ 0xa03aec4845928cb2,0x13e9e4e4c2f34448,+ 0xc849a75a56f72fde,0x18e45e1df3b0155a,+ 0x7a5c1130ecb4fbd6,0x1f1d75a5709c1ab1,+ 0xec798abe93f11d65,0x13726987666190ae,+ 0xa797ed6e38ed64bf,0x184f03e93ff9f4da,+ 0x517de8c9c728bdef,0x1e62c4e38ff87211,+ 0xd2eeb17e1c7976b5,0x12fdbb0e39fb474a,+ 0x87aa5ddda397d462,0x17bd29d1c87a191d,+ 0xe994f5550c7dc97b,0x1dac74463a989f64,+ 0x11fd195527ce9ded,0x128bc8abe49f639f,+ 0xd67c5faa71c24568,0x172ebad6ddc73c86,+ 0x8c1b77950e32d6c2,0x1cfa698c95390ba8,+ 0x57912abd28dfc639,0x121c81f7dd43a749,+ 0xad75756c7317b7c8,0x16a3a275d494911b,+ 0x98d2d2c78fdda5ba,0x1c4c8b1349b9b562,+ 0x9f83c3bcb9ea8794,0x11afd6ec0e14115d,+ 0x764b4abe8652979,0x161bcca7119915b5,+ 0x493de1d6e27e73d7,0x1ba2bfd0d5ff5b22,+ 0x6dc6ad264d8f0866,0x1145b7e285bf98f5,+ 0xc938586fe0f2ca80,0x159725db272f7f32,+ 0x7b866e8bd92f7d20,0x1afcef51f0fb5eff,+ 0xad34051767bdae34,0x10de1593369d1b5f,+ 0x9881065d41ad19c1,0x15159af804446237,+ 0x7ea147f492186032,0x1a5b01b605557ac5,+ 0x6f24ccf8db4f3c1f,0x1078e111c3556cbb,+ 0x4aee003712230b27,0x14971956342ac7ea,+ 0xdda98044d6abcdf0,0x19bcdfabc13579e4,+ 0xa89f02b062b60b6,0x10160bcb58c16c2f,+ 0xcd2c6c35c7b638e4,0x141b8ebe2ef1c73a,+ 0x8077874339a3c71d,0x1922726dbaae3909,+ 0xe0956914080cb8e4,0x1f6b0f092959c74b,+ 0x6c5d61ac8507f38e,0x13a2e965b9d81c8f,+ 0x4774ba17a649f072,0x188ba3bf284e23b3,+ 0x1951e89d8fdc6c8f,0x1eae8caef261aca0,+ 0xfd3316279e9c3d9,0x132d17ed577d0be4,+ 0x13c7fdbb186434cf,0x17f85de8ad5c4edd,+ 0x58b9fd29de7d4203,0x1df67562d8b36294,+ 0xb7743e3a2b0e4942,0x12ba095dc7701d9c,+ 0xe5514dc8b5d1db92,0x17688bb5394c2503,+ 0xdea5a13ae3465277,0x1d42aea2879f2e44,+ 0xb2784c4ce0bf38a,0x1249ad2594c37ceb,+ 0xcdf165f6018ef06d,0x16dc186ef9f45c25,+ 0x416dbf7381f2ac88,0x1c931e8ab871732f,+ 0x88e497a83137abd5,0x11dbf316b346e7fd,+ 0xeb1dbd923d8596ca,0x1652efdc6018a1fc,+ 0x25e52cf6cce6fc7d,0x1be7abd3781eca7c,+ 0x97af3c1a40105dce,0x1170cb642b133e8d,+ 0xfd9b0b20d0147542,0x15ccfe3d35d80e30,+ 0x3d01cde904199292,0x1b403dcc834e11bd,+ 0x462120b1a28ffb9b,0x1108269fd210cb16,+ 0xd7a968de0b33fa82,0x154a3047c694fddb,+ 0xcd93c3158e00f923,0x1a9cbc59b83a3d52,+ 0xc07c59ed78c09bb6,0x10a1f5b813246653,+ 0xb09b7068d6f0c2a3,0x14ca732617ed7fe8,+ 0xdcc24c830cacf34c,0x19fd0fef9de8dfe2,+ 0xc9f96fd1e7ec180f,0x103e29f5c2b18bed,+ 0x3c77cbc661e71e13,0x144db473335deee9,+ 0x8b95beb7fa60e598,0x1961219000356aa3,+ 0x6e7b2e65f8f91efe,0x1fb969f40042c54c,+ 0xc50cfcffbb9bb35f,0x13d3e2388029bb4f,+ 0xb6503c3faa82a037,0x18c8dac6a0342a23,+ 0xa3e44b4f95234844,0x1efb1178484134ac,+ 0xe66eaf11bd360d2b,0x135ceaeb2d28c0eb,+ 0xe00a5ad62c839075,0x183425a5f872f126,+ 0x980cf18bb7a47493,0x1e412f0f768fad70,+ 0x5f0816f752c6c8dc,0x12e8bd69aa19cc66,+ 0xf6ca1cb527787b13,0x17a2ecc414a03f7f,+ 0xf47ca3e2715699d7,0x1d8ba7f519c84f5f,+ 0xf8cde66d86d62026,0x127748f9301d319b,+ 0xf7016008e88ba830,0x17151b377c247e02,+ 0xb4c1b80b22ae923c,0x1cda62055b2d9d83,+ 0x50f91306f5ad1b65,0x12087d4358fc8272,+ 0xe53757c8b318623f,0x168a9c942f3ba30e,+ 0x9e852dbadfde7acf,0x1c2d43b93b0a8bd2,+ 0xa3133c94cbeb0cc1,0x119c4a53c4e69763,+ 0x8bd80bb9fee5cff1,0x16035ce8b6203d3c,+ 0xaece0ea87e9f43ee,0x1b843422e3a84c8b,+ 0x4d40c9294f238a75,0x1132a095ce492fd7,+ 0x2090fb73a2ec6d12,0x157f48bb41db7bcd,+ 0x68b53a508ba78856,0x1adf1aea12525ac0,+ 0x417144725748b536,0x10cb70d24b7378b8,+ 0x51cd958eed1ae283,0x14fe4d06de5056e6,+ 0xe640faf2a8619b24,0x1a3de04895e46c9f,+ 0xefe89cd7a93d00f7,0x1066ac2d5daec3e3,+ 0xebe2c40d938c4134,0x14805738b51a74dc,+ 0x26db7510f86f5181,0x19a06d06e2611214,+ 0x9849292a9b4592f1,0x100444244d7cab4c,+ 0xbe5b73754216f7ad,0x1405552d60dbd61f,+ 0xadf25052929cb598,0x1906aa78b912cba7,+ 0x996ee4673743e2ff,0x1f485516e7577e91,+ 0xffe54ec0828a6ddf,0x138d352e5096af1a,+ 0xbfdea270a32d0957,0x18708279e4bc5ae1,+ 0x2fd64b0ccbf84bad,0x1e8ca3185deb719a,+ 0x5de5eee7ff7b2f4c,0x1317e5ef3ab32700,+ 0x755f6aa1ff59fb1f,0x17dddf6b095ff0c0,+ 0x92b7454a7f3079e7,0x1dd55745cbb7ecf0,+ 0x5bb28b4e8f7e4c30,0x12a5568b9f52f416,+ 0xf29f2e22335ddf3c,0x174eac2e8727b11b,+ 0xef46f9aac035570b,0x1d22573a28f19d62,+ 0xd58c5c0ab8215667,0x123576845997025d,+ 0x4aef730d6629ac01,0x16c2d4256ffcc2f5,+ 0x9dab4fd0bfb41701,0x1c73892ecbfbf3b2,+ 0xa28b11e277d08e60,0x11c835bd3f7d784f,+ 0x8b2dd65b15c4b1f9,0x163a432c8f5cd663,+ 0x6df94bf1db35de77,0x1bc8d3f7b3340bfc,+ 0xc4bbcf772901ab0a,0x115d847ad000877d,+ 0x35eac354f34215cd,0x15b4e5998400a95d,+ 0x8365742a30129b40,0x1b221effe500d3b4,+ 0xd21f689a5e0ba108,0x10f5535fef208450,+ 0x6a742c0f58e894a,0x1532a837eae8a565,+ 0x4851137132f22b9d,0x1a7f5245e5a2cebe,+ 0xed32ac26bfd75b42,0x108f936baf85c136,+ 0xa87f57306fcd3212,0x14b378469b673184,+ 0xd29f2cfc8bc07e97,0x19e056584240fde5,+ 0xa3a37c1dd7584f1e,0x102c35f729689eaf,+ 0x8c8c5b254d2e62e6,0x14374374f3c2c65b,+ 0x6faf71eea079fb9f,0x1945145230b377f2,+ 0xb9b4e6a48987a87,0x1f965966bce055ef,+ 0x674111026d5f4c94,0x13bdf7e0360c35b5,+ 0xc111554308b71fba,0x18ad75d8438f4322,+ 0x7155aa93cae4e7a8,0x1ed8d34e547313eb,+ 0x26d58a9c5ecf10c9,0x13478410f4c7ec73,+ 0xf08aed437682d4fb,0x1819651531f9e78f,+ 0xecada89454238a3a,0x1e1fbe5a7e786173,+ 0x73ec895cb4963664,0x12d3d6f88f0b3ce8,+ 0x90e7abb3e1bbc3fd,0x1788ccb6b2ce0c22,+ 0x352196a0da2ab4fd,0x1d6affe45f818f2b,+ 0x134fe24885ab11e,0x1262dfeebbb0f97b,+ 0xc1823dadaa715d65,0x16fb97ea6a9d37d9,+ 0x31e2cd19150db4bf,0x1cba7de5054485d0,+ 0x1f2dc02fad2890f7,0x11f48eaf234ad3a2,+ 0xa6f9303b9872b535,0x1671b25aec1d888a,+ 0x50b77c4a7e8f6282,0x1c0e1ef1a724eaad,+ 0x5272adae8f199d91,0x1188d357087712ac,+ 0x670f591a32e004f6,0x15eb082cca94d757,+ 0x40d32f60bf980633,0x1b65ca37fd3a0d2d,+ 0x4883fd9c77bf03e0,0x111f9e62fe44483c,+ 0x5aa4fd0395aec4d8,0x156785fbbdd55a4b,+ 0x314e3c447b1a760e,0x1ac1677aad4ab0de,+ 0xded0e5aaccf089c9,0x10b8e0acac4eae8a,+ 0x96851f15802cac3b,0x14e718d7d7625a2d,+ 0xfc2666dae037d74a,0x1a20df0dcd3af0b8,+ 0x9d980048cc22e68e,0x10548b68a044d673,+ 0x84fe005aff2ba032,0x1469ae42c8560c10,+ 0xa63d8071bef6883e,0x198419d37a6b8f14,+ 0xcfcce08e2eb42a4e,0x1fe52048590672d9,+ 0x21e00c58dd309a70,0x13ef342d37a407c8,+ 0x2a580f6f147cc10d,0x18eb0138858d09ba,+ 0xb4ee134ad99bf150,0x1f25c186a6f04c28,+ 0x7114cc0ec80176d2,0x137798f428562f99,+ 0xcd59ff127a01d486,0x18557f31326bbb7f,+ 0xc0b07ed7188249a8,0x1e6adefd7f06aa5f,+ 0xd86e4f466f516e09,0x1302cb5e6f642a7b,+ 0xce89e3180b25c98b,0x17c37e360b3d351a,+ 0x822c5bde0def3bee,0x1db45dc38e0c8261,+ 0xf15bb96ac8b58575,0x1290ba9a38c7d17c,+ 0x2db2a7c57ae2e6d2,0x1734e940c6f9c5dc,+ 0x391f51b6d99ba086,0x1d022390f8b83753,+ 0x3b3931248014454,0x1221563a9b732294,+ 0x4a077d6da019569,0x16a9abc9424feb39,+ 0x45c895cc9081fac3,0x1c5416bb92e3e607,+ 0x8b9d5d9fda513cba,0x11b48e353bce6fc4,+ 0xae84b507d0e58be8,0x1621b1c28ac20bb5,+ 0x1a25e249c51eeee3,0x1baa1e332d728ea3,+ 0xf057ad6e1b33554d,0x114a52dffc679925,+ 0x6c6d98c9a2002aa1,0x159ce797fb817f6f,+ 0x4788fefc0a803549,0x1b04217dfa61df4b,+ 0xcb59f5d8690214e,0x10e294eebc7d2b8f,+ 0xcfe30734e83429a1,0x151b3a2a6b9c7672,+ 0x83dbc9022241340a,0x1a6208b50683940f,+ 0xb2695da15568c086,0x107d457124123c89,+ 0x1f03b509aac2f0a7,0x149c96cd6d16cbac,+ 0x26c4a24c1573acd1,0x19c3bc80c85c7e97,+ 0x783ae56f8d684c03,0x101a55d07d39cf1e,+ 0x16499ecb70c25f03,0x1420eb449c8842e6,+ 0x9bdc067e4cf2f6c4,0x19292615c3aa539f,+ 0x82d3081de02fb476,0x1f736f9b3494e887,+ 0xb1c3e512ac1dd0c9,0x13a825c100dd1154,+ 0xde34de57572544fc,0x18922f31411455a9,+ 0x55c215ed2cee963b,0x1eb6bafd91596b14,+ 0xb5994db43c151de5,0x133234de7ad7e2ec,+ 0xe2ffa1214b1a655e,0x17fec216198ddba7,+ 0xdbbf89699de0feb6,0x1dfe729b9ff15291,+ 0x2957b5e202ac9f31,0x12bf07a143f6d39b,+ 0xf3ada35a8357c6fe,0x176ec98994f48881,+ 0x70990c31242db8bd,0x1d4a7bebfa31aaa2,+ 0x865fa79eb69c9376,0x124e8d737c5f0aa5,+ 0xe7f791866443b854,0x16e230d05b76cd4e,+ 0xa1f575e7fd54a669,0x1c9abd04725480a2,+ 0xa53969b0fe54e801,0x11e0b622c774d065,+ 0xe87c41d3dea2202,0x1658e3ab7952047f,+ 0xd229b5248d64aa82,0x1bef1c9657a6859e,+ 0x435a1136d85eea91,0x117571ddf6c81383,+ 0x143095848e76a536,0x15d2ce55747a1864,+ 0x193cbae5b2144e83,0x1b4781ead1989e7d,+ 0x2fc5f4cf8f4cb112,0x110cb132c2ff630e,+ 0xbbb77203731fdd56,0x154fdd7f73bf3bd1,+ 0x2aa54e844fe7d4ac,0x1aa3d4df50af0ac6,+ 0xdaa75112b1f0e4eb,0x10a6650b926d66bb,+ 0xd15125575e6d1e26,0x14cffe4e7708c06a,+ 0x85a56ead360865b0,0x1a03fde214caf085,+ 0x7387652c41c53f8e,0x10427ead4cfed653,+ 0x50693e7752368f71,0x14531e58a03e8be8,+ 0x64838e1526c4334e,0x1967e5eec84e2ee2,+ 0xfda4719a70754022,0x1fc1df6a7a61ba9a,+ 0xde86c70086494815,0x13d92ba28c7d14a0,+ 0x162878c0a7db9a1a,0x18cf768b2f9c59c9,+ 0x5bb296f0d1d280a1,0x1f03542dfb83703b,+ 0x194f9e5683239064,0x1362149cbd322625,+ 0x5fa385ec23ec747e,0x183a99c3ec7eafae,+ 0xf78c67672ce7919d,0x1e494034e79e5b99,+ 0x3ab7c0a07c10bb02,0x12edc82110c2f940,+ 0x4965b0c89b14e9c3,0x17a93a2954f3b790,+ 0x5bbf1cfac1da2433,0x1d9388b3aa30a574,+ 0xb957721cb92856a0,0x127c35704a5e6768,+ 0xe7ad4ea3e7726c48,0x171b42cc5cf60142,+ 0xa198a24ce14f075a,0x1ce2137f74338193,+ 0x44ff65700cd16498,0x120d4c2fa8a030fc,+ 0x563f3ecc1005bdbe,0x16909f3b92c83d3b,+ 0x2bcf0e7f14072d2e,0x1c34c70a777a4c8a,+ 0x5b61690f6c847c3d,0x11a0fc668aac6fd6,+ 0xf239c35347a59b4c,0x16093b802d578bcb,+ 0xeec83428198f021f,0x1b8b8a6038ad6ebe,+ 0x553d20990ff96153,0x1137367c236c6537,+ 0x2a8c68bf53f7b9a8,0x1585041b2c477e85,+ 0x752f82ef28f5a812,0x1ae64521f7595e26,+ 0x93db1d57999890b,0x10cfeb353a97dad8,+ 0xb8d1e4ad7ffeb4e,0x1503e602893dd18e,+ 0x8e7065dd8dffe622,0x1a44df832b8d45f1,+ 0xf9063faa78bfefd5,0x106b0bb1fb384bb6,+ 0xb747cf9516efebca,0x1485ce9e7a065ea4,+ 0xe519c37a5cabe6bd,0x19a742461887f64d,+ 0xaf301a2c79eb7036,0x1008896bcf54f9f0,+ 0xdafc20b798664c43,0x140aabc6c32a386c,+ 0x11bb28e57e7fdf54,0x190d56b873f4c688,+ 0x1629f31ede1fd72a,0x1f50ac6690f1f82a,+ 0x4dda37f34ad3e67a,0x13926bc01a973b1a,+ 0xe150c5f01d88e019,0x187706b0213d09e0,+ 0x19a4f76c24eb181f,0x1e94c85c298c4c59,+ 0xb0071aa39712ef13,0x131cfd3999f7afb7,+ 0x9c08e14c7cd7aad8,0x17e43c8800759ba5,+ 0x30b199f9c0d958e,0x1ddd4baa0093028f,+ 0x61e6f003c1887d79,0x12aa4f4a405be199,+ 0xba60ac04b1ea9cd7,0x1754e31cd072d9ff,+ 0xa8f8d705de65440d,0x1d2a1be4048f907f,+ 0xc99b8663aaff4a88,0x123a516e82d9ba4f,+ 0xbc0267fc95bf1d2a,0x16c8e5ca239028e3,+ 0xab0301fbbb2ee474,0x1c7b1f3cac74331c,+ 0xeae1e13d54fd4ec9,0x11ccf385ebc89ff1,+ 0x659a598caa3ca27b,0x1640306766bac7ee,+ 0xff00efefd4cbcb1a,0x1bd03c81406979e9,+ 0x3f6095f5e4ff5ef0,0x116225d0c841ec32,+ 0xcf38bb735e3f36ac,0x15baaf44fa52673e,+ 0x8306ea5035cf0457,0x1b295b1638e7010e,+ 0x11e4527221a162b6,0x10f9d8ede39060a9,+ 0x565d670eaa09bb64,0x15384f295c7478d3,+ 0x2bf4c0d2548c2a3d,0x1a8662f3b3919708,+ 0x1b78f88374d79a66,0x1093fdd8503afe65,+ 0x625736a4520d8100,0x14b8fd4e6449bdfe,+ 0xfaed044d6690e140,0x19e73ca1fd5c2d7d,+ 0xbcd422b0601a8cc8,0x103085e53e599c6e,+ 0x6c092b5c78212ffa,0x143ca75e8df0038a,+ 0x70b763396297bf8,0x194bd136316c046d,+ 0x48ce53c07bb3daf6,0x1f9ec583bdc70588,+ 0x2d80f4584d5068da,0x13c33b72569c6375,+ 0x78e1316e60a48310,0x18b40a4eec437c52+};
cbits/fpstring.c view
@@ -29,6 +29,9 @@ * SUCH DAMAGE. */ +#include "HsFFI.h"+#include "MachDeps.h"+ #include "fpstring.h" #if defined(__x86_64__) #include <x86intrin.h>@@ -38,8 +41,9 @@ #include <stdint.h> #include <stdbool.h> -#ifndef __STDC_NO_ATOMICS__+#if defined(__x86_64__) && (__GNUC__ >= 7 || __GNUC__ == 6 && __GNUC_MINOR__ >= 3 || defined(__clang_major__)) && !defined(__STDC_NO_ATOMICS__) #include <stdatomic.h>+#define USE_SIMD_COUNT #endif /* copy a string in reverse */@@ -105,7 +109,38 @@ return qsort(p, len, 1, fps_compare); } -/* count the number of occurences of a char in a string */+// We don't actually always use these unaligned write functions on the+// Haskell side, but the macros we check there aren't visible here...+void fps_unaligned_write_u16(uint16_t x, uint8_t *p) {+ memcpy(p, &x, 2);+ return;+}++void fps_unaligned_write_u32(uint32_t x, uint8_t *p) {+ memcpy(p, &x, 4);+ return;+}++void fps_unaligned_write_u64(uint64_t x, uint8_t *p) {+ memcpy(p, &x, 8);+ return;+}++void fps_unaligned_write_HsFloat(HsFloat x, uint8_t *p) {+ memcpy(p, &x, SIZEOF_HSFLOAT);+}++void fps_unaligned_write_HsDouble(HsDouble x, uint8_t *p) {+ memcpy(p, &x, SIZEOF_HSDOUBLE);+}++uint64_t fps_unaligned_read_u64(uint8_t *p) {+ uint64_t ans;+ memcpy(&ans, p, 8);+ return ans;+}++/* count the number of occurrences of a char in a string */ size_t fps_count_naive(unsigned char *str, size_t len, unsigned char w) { size_t c; for (c = 0; len-- != 0; ++str)@@ -114,9 +149,6 @@ return c; } -#if defined(__x86_64__) && (__GNUC__ >= 6 || defined(__clang_major__)) && !defined(__STDC_NO_ATOMICS__)-#define USE_SIMD_COUNT-#endif #ifdef USE_SIMD_COUNT __attribute__((target("sse4.2")))
cbits/is-valid-utf8.c view
@@ -32,19 +32,25 @@ #include <stdbool.h> #include <stddef.h> #include <stdint.h>+#include <string.h> #ifdef __x86_64__+#include <cpuid.h> #include <emmintrin.h> #include <immintrin.h>+#if (__GNUC__ >= 7 || __GNUC__ == 6 && __GNUC_MINOR__ >= 3 || \+ defined(__clang_major__)) && \+ !defined(__STDC_NO_ATOMICS__)+#include <stdatomic.h> #include <tmmintrin.h>-#include <cpuid.h>+#else+// This is needed to support CentOS 7, which has a very old GCC.+#define CRUFTY_GCC #endif--#ifndef __STDC_NO_ATOMICS__-#include <stdatomic.h> #endif #include <MachDeps.h>+#include "ghcplatform.h" #ifdef WORDS_BIGENDIAN #define to_little_endian(x) __builtin_bswap64(x)@@ -55,7 +61,37 @@ // 0x80 in every 'lane'. static uint64_t const high_bits_mask = 0x8080808080808080ULL; -static inline int is_valid_utf8_fallback(uint8_t const *const src, size_t const len) {+static inline uint64_t read_uint64(const uint64_t *p) {+ uint64_t r;+ memcpy(&r, p, 8);+ return r;+}++// stand-in for __builtin_ctzll, used because __builtin_ctzll can+// cause runtime linker issues for GHC in some exotic situations (#601)+//+// See also these ghc issues:+// * https://gitlab.haskell.org/ghc/ghc/-/issues/21787+// * https://gitlab.haskell.org/ghc/ghc/-/issues/22011+static inline int hs_bytestring_ctz64(const uint64_t x) {+ // These CPP conditions are taken from ghc-prim:+ // https://gitlab.haskell.org/ghc/ghc/-/blob/73b5c7ce33929e1f7c9283ed7c2860aa40f6d0ec/libraries/ghc-prim/cbits/ctz.c#L31-57+ // credit to Herbert Valerio Riedel, Erik de Castro Lopo+#if defined(__GNUC__) && (defined(i386_HOST_ARCH) || defined(powerpc_HOST_ARCH))+ uint32_t xhi = (uint32_t)(x >> 32);+ uint32_t xlo = (uint32_t) x;+ return xlo ? __builtin_ctz(xlo) : 32 + __builtin_ctz(xhi);+#elif SIZEOF_UNSIGNED_LONG == 8+ return __builtin_ctzl(x);+#elif SIZEOF_UNSIGNED_LONG_LONG == 8+ return __builtin_ctzll(x);+#else+# error no suitable __builtin_ctz() found+#endif+}++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.@@ -74,10 +110,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(*big_ptr) & high_bits_mask,- to_little_endian(*(big_ptr + 1)) & high_bits_mask,- to_little_endian(*(big_ptr + 2)) & high_bits_mask,- to_little_endian(*(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) {@@ -87,16 +124,16 @@ if (results[3] == 0) { ptr += 8; } else {- ptr += (__builtin_ctzl(results[3]) / 8);+ ptr += (hs_bytestring_ctz64(results[3]) / 8); } } else {- ptr += (__builtin_ctzl(results[2]) / 8);+ ptr += (hs_bytestring_ctz64(results[2]) / 8); } } else {- ptr += (__builtin_ctzl(results[1]) / 8);+ ptr += (hs_bytestring_ctz64(results[1]) / 8); } } else {- ptr += (__builtin_ctzl(results[0]) / 8);+ ptr += (hs_bytestring_ctz64(results[0]) / 8); } } }@@ -154,7 +191,7 @@ return 1; } -#ifdef __x86_64__+#if defined(__x86_64__) && !defined(CRUFTY_GCC) // SSE2 @@ -309,7 +346,7 @@ // +------------+---------------+------------------+----------------+ // | F0 | 3 | 3 | 6 | // +------------+---------------+------------------+----------------+-// | F4 | 4 | 4 | 8 |+// | F4 | 3 | 4 | 7 | // +------------+---------------+------------------+----------------+ // index1 -> E0, index14 -> ED static int8_t const df_ee_lookup[16] = {@@ -322,10 +359,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); } @@ -406,7 +459,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]));@@ -445,20 +498,27 @@ return 0; } // 'Roll back' our pointer a little to prepare for a slow search of the rest.- int16_t tokens[2];+ uint16_t tokens[2]; tokens[0] = _mm_extract_epi16(prev_input, 6); tokens[1] = _mm_extract_epi16(prev_input, 7);- int8_t const *token_ptr = (int8_t const *)tokens;- ptrdiff_t lookahead = 0;- if (token_ptr[3] > (int8_t)0xBF) {- lookahead = 1;- } else if (token_ptr[2] > (int8_t)0xBF) {- lookahead = 2;- } else if (token_ptr[1] > (int8_t)0xBF) {- lookahead = 3;+ uint8_t const *token_ptr = (uint8_t const *)tokens;+ ptrdiff_t rollback = 0;+ // We must not roll back if no big blocks were processed, as then+ // the fallback function would examine out-of-bounds data (#620).+ // In that case, prev_input contains only nulls and we skip the if body.+ if (token_ptr[3] >= 0x80u) {+ // Look for an incomplete multi-byte code point+ if (token_ptr[3] >= 0xC0u) {+ rollback = 1;+ } else if (token_ptr[2] >= 0xE0u) {+ rollback = 2;+ } else if (token_ptr[1] >= 0xF0u) {+ rollback = 3;+ } }- uint8_t const *const small_ptr = ptr - lookahead;- size_t const small_len = remaining + lookahead;+ // Finish the job.+ uint8_t const *const small_ptr = ptr - rollback;+ size_t const small_len = remaining + rollback; return is_valid_utf8_fallback(small_ptr, small_len); } @@ -589,10 +649,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 =@@ -635,23 +711,30 @@ } // 'Roll back' our pointer a little to prepare for a slow search of the rest. uint32_t tokens_blob = _mm256_extract_epi32(prev_input, 7);- int8_t const *tokens = (int8_t const *)&tokens_blob;- ptrdiff_t lookahead = 0;- if (tokens[3] > (int8_t)0xBF) {- lookahead = 1;- } else if (tokens[2] > (int8_t)0xBF) {- lookahead = 2;- } else if (tokens[1] > (int8_t)0xBF) {- lookahead = 3;+ uint8_t const *token_ptr = (uint8_t const *)&tokens_blob;+ ptrdiff_t rollback = 0;+ // We must not roll back if no big blocks were processed, as then+ // the fallback function would examine out-of-bounds data (#620).+ // In that case, prev_input contains only nulls and we skip the if body.+ if (token_ptr[3] >= 0x80u) {+ // Look for an incomplete multi-byte code point+ if (token_ptr[3] >= 0xC0u) {+ rollback = 1;+ } else if (token_ptr[2] >= 0xE0u) {+ rollback = 2;+ } else if (token_ptr[1] >= 0xF0u) {+ rollback = 3;+ } }- uint8_t const *const small_ptr = ptr - lookahead;- size_t const small_len = remaining + lookahead;+ // Finish the job.+ uint8_t const *const small_ptr = ptr - rollback;+ size_t const small_len = remaining + rollback; return is_valid_utf8_fallback(small_ptr, small_len); } #endif -#ifdef __x86_64__+#if defined(__x86_64__) && !defined(CRUFTY_GCC) static inline bool has_sse2() { uint32_t eax = 0, ebx = 0, ecx = 0, edx = 0; __get_cpuid_count(1, 0, &eax, &ebx, &ecx, &edx);@@ -674,17 +757,20 @@ } #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) { return 1; }-#ifdef __x86_64__+#if defined(__x86_64__) && !defined(CRUFTY_GCC) 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);
+ cbits/shortbytestring.c view
@@ -0,0 +1,21 @@+#include <assert.h>+#include <stddef.h>+#include <stdint.h>+#include <string.h>+++ptrdiff_t+sbs_elem_index(const void *s,+ uint8_t c,+ size_t n)+{+ const void *so = memchr(s, c, n);++ if (so) {+ ptrdiff_t diff = so - s;+ assert(diff >= 0);+ return diff;+ } else {+ return -1;+ }+}
+ include/bytestring-cpp-macros.h view
@@ -0,0 +1,50 @@+#if defined(__STDC__) || defined(__GNUC__) || defined(__clang__)+#error "bytestring-cpp-macros.h does not work in C code yet"+#endif+++#if defined(i386_HOST_ARCH) || defined(x86_64_HOST_ARCH) \+ || ((defined(arm_HOST_ARCH) || defined(aarch64_HOST_ARCH)) \+ && defined(__ARM_FEATURE_UNALIGNED)) \+ || defined(powerpc_HOST_ARCH) || defined(powerpc64_HOST_ARCH) \+ || defined(powerpc64le_HOST_ARCH) \+ || defined(javascript_HOST_ARCH)+/*+Not all architectures are forgiving of unaligned accesses; whitelist ones+which are known not to trap (either to the kernel for emulation, or crash).+*/+#define HS_UNALIGNED_POKES_OK 1+#else+#if PURE_HASKELL+#error "-fpure-haskell isn't supported yet on architectures only supporting aligned accesses."+#endif+#define HS_UNALIGNED_POKES_OK 0+#endif+++#define HS_UNALIGNED_ByteArray_OPS_OK \+ 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/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+*/+++#define HS_CAST_FLOAT_WORD_OPS_AVAILABLE MIN_VERSION_base(4,14,0)+/*+These operations were added in base-4.10.0, but due to+https://gitlab.haskell.org/ghc/ghc/-/issues/16617 they+are buggy with negative floats before ghc-8.10.+*/++#define HS_UNALIGNED_ADDR_PRIMOPS_AVAILABLE MIN_VERSION_base(4,20,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,39 +1,55 @@-{-# LANGUAGE LambdaCase #-}- module IsValidUtf8 (testSuite) where import Data.Bits (shiftR, (.&.), shiftL) import Data.ByteString (ByteString)+import qualified Data.ByteString.Short as SBS 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" $ [- adjustOption (max testCount) . testProperty "Valid UTF-8" $ goValid,- adjustOption (max testCount) . testProperty "Invalid UTF-8" $ goInvalid,+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,+ adjustOption (max testCount) . testProperty "Invalid UTF-8 ShortByteString" $ goInvalidSBS, testGroup "Regressions" checkRegressions ] where- goValid :: Property- goValid = forAll arbitrary $- \(ValidUtf8 ss) -> (B.isValidUtf8 . foldMap sequenceToBS $ ss) === True- goInvalid :: Property- goInvalid = forAll arbitrary $ - \inv -> (B.isValidUtf8 . 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,+ testProperty "Splitting valid in two" splitValid ] where tooHigh :: ByteString@@ -41,9 +57,55 @@ [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]++ splitValid :: Property+ splitValid = forAll genValidUtf8 $ \bs ->+ forAll (choose (0, B.length bs)) $ \k ->+ case B.splitAt k bs of+ -- q may have non-zero offset, which+ -- allows this property test to tickle #620+ (p, q) -> B.isValidUtf8 p == B.isValidUtf8 q+ -- Helpers -data Utf8Sequence = +-- 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 | Three Word8 Word8 Word8 |@@ -61,7 +123,7 @@ genThree :: Gen Utf8Sequence genThree = do w1 <- elements [0xE0 .. 0xED]- w2 <- elements $ case w1 of + w2 <- elements $ case w1 of 0xE0 -> [0xA0 .. 0xBF] 0xED -> [0x80 .. 0x9F] _ -> [0x80 .. 0xBF]@@ -70,7 +132,7 @@ genFour :: Gen Utf8Sequence genFour = do w1 <- elements [0xF0 .. 0xF4]- w2 <- elements $ case w1 of + w2 <- elements $ case w1 of 0xF0 -> [0x90 .. 0xBF] 0xF4 -> [0x80 .. 0x8F] _ -> [0x80 .. 0xBF]@@ -78,46 +140,46 @@ w4 <- elements [0x80 .. 0xBF] pure . Four w1 w2 w3 $ w4 shrink = \case- One w1 -> One <$> case w1 of + One w1 -> One <$> case w1 of 0x00 -> [] _ -> [0x00 .. (w1 - 1)]- Two w1 w2 -> case (w1, w2) of + Two w1 w2 -> case (w1, w2) of (0xC2, 0x80) -> allOnes _ -> (Two <$> [0xC2 .. (w1 - 1)] <*> [0x80 .. (w2 - 1)]) ++ allOnes- Three w1 w2 w3 -> case (w1, w2, w3) of + Three w1 w2 w3 -> case (w1, w2, w3) of (0xE0, 0xA0, 0x80) -> allTwos ++ allOnes (0xE0, 0xA0, _) -> (Three 0xE0 0xA0 <$> [0x80 .. (w3 - 1)]) ++ allTwos ++ allOnes- (0xE0, _, _) -> + (0xE0, _, _) -> (Three 0xE0 <$> [0xA0 .. (w2 - 1)] <*> [0x80 .. (w3 - 1)]) ++ allTwos ++ allOnes _ -> do w1' <- [0xE0 .. (w1 - 1)]- case w1' of - 0xE0 -> (Three 0xE0 <$> [0xA0 .. 0xBF] <*> [0x80 .. 0xBF]) ++ - allTwos ++ + case w1' of+ 0xE0 -> (Three 0xE0 <$> [0xA0 .. 0xBF] <*> [0x80 .. 0xBF]) +++ allTwos ++ allOnes- _ -> (Three w1' <$> [0x80 .. 0xBF] <*> [0x80 .. 0xBF]) ++ - allTwos ++ + _ -> (Three w1' <$> [0x80 .. 0xBF] <*> [0x80 .. 0xBF]) +++ allTwos ++ allOnes- Four w1 w2 w3 w4 -> case (w1, w2, w3, w4) of + Four w1 w2 w3 w4 -> case (w1, w2, w3, w4) of (0xF0, 0x90, 0x80, 0x80) -> allThrees ++ allTwos ++ allOnes- (0xF0, 0x90, 0x80, _) -> - (Four 0xF0 0x90 0x80 <$> [0x80 .. (w4 - 1)]) ++ + (0xF0, 0x90, 0x80, _) ->+ (Four 0xF0 0x90 0x80 <$> [0x80 .. (w4 - 1)]) ++ allThrees ++ allTwos ++ allOnes- (0xF0, 0x90, _, _) -> + (0xF0, 0x90, _, _) -> (Four 0xF0 0x90 <$> [0x80 .. (w3 - 1)] <*> [0x80 .. (w4 - 1)]) ++ allThrees ++ allTwos ++ allOnes- (0xF0, _, _, _) -> + (0xF0, _, _, _) -> (Four 0xF0 <$> [0x90 .. (w2 - 1)] <*> [0x80 .. (w3 - 1)] <*> [0x80 .. (w4 - 1)]) ++ allThrees ++ allTwos ++ allOnes _ -> do w1' <- [0xF0 .. (w1 - 1)]- case w1' of + case w1' of 0xF0 -> (Four 0xF0 <$> [0x90 .. 0xBF] <*> [0x80 .. 0xBF] <*> [0x80 .. 0xBF]) ++ allThrees ++ allTwos ++@@ -134,7 +196,7 @@ allTwos = Two <$> [0xC2 .. 0xDF] <*> [0x80 .. 0xBF] allThrees :: [Utf8Sequence]-allThrees = (Three 0xE0 <$> [0xA0 .. 0xBF] <*> [0x80 .. 0xBF]) ++ +allThrees = (Three 0xE0 <$> [0xA0 .. 0xBF] <*> [0x80 .. 0xBF]) ++ (Three 0xED <$> [0x80 .. 0x9F] <*> [0x80 .. 0xBF]) ++ (Three <$> [0xE1 .. 0xEC] <*> [0x80 .. 0xBF] <*> [0x80 .. 0xBF]) ++ (Three <$> [0xEE .. 0xEF] <*> [0x80 .. 0xBF] <*> [0x80 .. 0xBF])@@ -146,7 +208,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@@ -178,9 +240,9 @@ , InvalidUtf8 <$> genValidUtf8 <*> genInvalidUtf8 <*> pure mempty , InvalidUtf8 <$> genValidUtf8 <*> genInvalidUtf8 <*> genValidUtf8 ]- shrink (InvalidUtf8 p i s) = - (InvalidUtf8 p i <$> shrinkBS s) ++- ((\p' -> InvalidUtf8 p' i s) <$> shrinkBS p)+ shrink (InvalidUtf8 p i s) =+ (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@@ -207,7 +269,7 @@ -- overlong encoding , do k <- choose (0, 0xFFFF) let c = chr k- case k of + case k of _ | k < 0x80 -> oneof [ let (w, x) = ord2 c in pure [w, x] , let (w, x, y) = ord3 c in pure [w, x, y] , let (w, x, y, z) = ord4 c in pure [w, x, y, z] ]@@ -224,14 +286,15 @@ vectorOf k gen genValidUtf8 :: Gen ByteString-genValidUtf8 = sized $ \size -> +genValidUtf8 = sized $ \size -> if size <= 0 then pure mempty else oneof [ 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@@ -244,7 +307,7 @@ gen3Byte :: Gen ByteString gen3Byte = do b1 <- elements [0xE0 .. 0xED]- b2 <- elements $ case b1 of + b2 <- elements $ case b1 of 0xE0 -> [0xA0 .. 0xBF] 0xED -> [0x80 .. 0x9F] _ -> [0x80 .. 0xBF]@@ -253,7 +316,7 @@ gen4Byte :: Gen ByteString gen4Byte = do b1 <- elements [0xF0 .. 0xF4]- b2 <- elements $ case b1 of + b2 <- elements $ case b1 of 0xF0 -> [0x90 .. 0xBF] 0xF4 -> [0x80 .. 0x8F] _ -> [0x80 .. 0xBF]@@ -261,8 +324,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)
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,9 +1,13 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+-- 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+-- proxy arguments. Here the 'RdInt' class methods used to generate tests for+-- all the various 'readInt' types require explicit type applications. module Properties (testSuite) where +import Prelude hiding (head, tail) import Foreign.C.String (withCString) import Foreign.Storable import Foreign.ForeignPtr@@ -21,7 +25,9 @@ import Data.Char import Data.Word import Data.Maybe-import Data.Int (Int64)+import Data.Either (isLeft)+import Data.Bits (finiteBitSize, bit)+import Data.Int (Int8, Int16, Int32, Int64) import Data.Semigroup import GHC.Exts (Int(..), newPinnedByteArray#, unsafeFreezeByteArray#) import GHC.ST (ST(..), runST)@@ -46,12 +52,12 @@ import qualified Data.ByteString.Lazy.Char8 as D import qualified Data.ByteString.Lazy.Internal as L-import Prelude hiding (abs) import QuickCheckUtils import Test.Tasty import Test.Tasty.QuickCheck +import qualified Properties.ShortByteString as PropSBS import qualified Properties.ByteString as PropBS import qualified Properties.ByteStringChar8 as PropBS8 import qualified Properties.ByteStringLazy as PropBL@@ -65,32 +71,258 @@ prop_bijectionBB (Char8 c) = (P.w2c . P.c2w) c == id c prop_bijectionBB' w = (P.c2w . P.w2c) w == id w -prop_head2BB xs = (not (null xs)) ==> head xs == (P.unsafeHead . P.pack) xs--prop_tail1BB xs = (not (null xs)) ==> tail xs == (P.unpack . P.unsafeTail. P.pack) xs+prop_unsafeHead xs = not (P.null xs) ==> P.head xs === P.unsafeHead xs+prop_unsafeTail xs = not (P.null xs) ==> P.tail xs === P.unsafeTail xs+prop_unsafeLast xs = not (P.null xs) ==> P.last xs === P.unsafeLast xs+prop_unsafeInit xs = not (P.null xs) ==> P.init xs === P.unsafeInit xs -prop_last1BB xs = (not (null xs)) ==> last xs == (P.unsafeLast . P.pack) xs+prop_lines_empty_invariant =+ True === case LC.lines (LC.pack "\nfoo\n") of+ Empty : _ -> True+ _ -> False -prop_init1BB xs =- (not (null xs)) ==>- init xs == (P.unpack . P.unsafeInit . P.pack) xs+prop_lines_lazy =+ take 2 (LC.lines (LC.append (LC.pack "a\nb\n") undefined)) === [LC.pack "a", LC.pack "b"] -prop_lines_lazy1 =- head (LC.lines (LC.append (LC.pack "a\nb\n") undefined)) == LC.pack "a" prop_lines_lazy2 =- head (tail (LC.lines (LC.append (LC.pack "a\nb\n") undefined))) == LC.pack "b"+ c === case LC.lines (Chunk c undefined) of+ Chunk c _ : _ -> c+ _ -> P.empty+ where+ c = C.pack "etc..." +prop_lines_lazy3 =+ c === case LC.lines d of+ Chunk c _ : _ -> c+ _ -> P.empty+ where+ c = C.pack "etc..."+ d = Chunk c d+ prop_strip x = C.strip x == (C.dropSpace . C.reverse . C.dropSpace . C.reverse) x --- Ensure that readInt and readInteger over lazy ByteStrings are not+class (Bounded a, Integral a, Show a) => RdInt a where+ rdIntC :: C.ByteString -> Maybe (a, C.ByteString)+ rdIntD :: D.ByteString -> Maybe (a, D.ByteString)++instance RdInt Int where { rdIntC = C.readInt; rdIntD = D.readInt }+instance RdInt Int8 where { rdIntC = C.readInt8; rdIntD = D.readInt8 }+instance RdInt Int16 where { rdIntC = C.readInt16; rdIntD = D.readInt16 }+instance RdInt Int32 where { rdIntC = C.readInt32; rdIntD = D.readInt32 }+instance RdInt Int64 where { rdIntC = C.readInt64; rdIntD = D.readInt64 }+--+instance RdInt Word where { rdIntC = C.readWord; rdIntD = D.readWord }+instance RdInt Word8 where { rdIntC = C.readWord8; rdIntD = D.readWord8 }+instance RdInt Word16 where { rdIntC = C.readWord16; rdIntD = D.readWord16 }+instance RdInt Word32 where { rdIntC = C.readWord32; rdIntD = D.readWord32 }+instance RdInt Word64 where { rdIntC = C.readWord64; rdIntD = D.readWord64 }++smax :: forall a. (Bounded a, Show a) => String+smax = show $ maxBound @a+smax1 :: forall a. (Bounded a, Integral a) => String+smax1 = show $ fromIntegral @a @Integer maxBound + 1+smax10 :: forall a. (Bounded a, Integral a) => String+smax10 = show $ fromIntegral @a @Integer maxBound + 10++smin :: forall a. (Bounded a, Show a) => String+smin = show (minBound @a)+smin1 :: forall a. (Bounded a, Integral a) => String+smin1 = show $ fromIntegral @a @Integer minBound - 1+smin10 :: forall a. (Bounded a, Integral a) => String+smin10 = show $ fromIntegral @a @Integer minBound - 10++-- Ensure that readWord64 and readInteger over lazy ByteStrings are not -- excessively strict.-prop_readIntSafe = (fst . fromJust . D.readInt) (Chunk (C.pack "1z") Empty) == 1-prop_readIntUnsafe = (fst . fromJust . D.readInt) (Chunk (C.pack "2z") undefined) == 2+prop_readWordSafe = (fst . fromJust . D.readWord64) (Chunk (C.pack "1z") Empty) == 1+prop_readWordUnsafe = (fst . fromJust . D.readWord64) (Chunk (C.pack "2z") undefined) == 2 prop_readIntegerSafe = (fst . fromJust . D.readInteger) (Chunk (C.pack "1z") Empty) == 1 prop_readIntegerUnsafe = (fst . fromJust . D.readInteger) (Chunk (C.pack "2z") undefined) == 2+prop_readNaturalSafe = (fst . fromJust . D.readNatural) (Chunk (C.pack "1z") Empty) == 1+prop_readNaturalUnsafe = (fst . fromJust . D.readNatural) (Chunk (C.pack "2z") undefined) == 2+prop_readIntBoundsCC = rdWordBounds @Word+ && rdWordBounds @Word8+ && rdWordBounds @Word16+ && rdWordBounds @Word32+ && rdWordBounds @Word64+ && rdIntBounds @Int+ && rdIntBounds @Int8+ && rdIntBounds @Int16+ && rdIntBounds @Int32+ && rdIntBounds @Int64+ where+ tailStr = " tail"+ zeroStr = "000000000000000000000000000"+ spack s = C.pack $ s ++ tailStr+ spackPlus s = C.pack $ '+' : (s ++ tailStr)+ spackMinus s = C.pack $ '-' : (s ++ tailStr)+ spackLong s = C.pack $ s ++ zeroStr ++ tailStr+ spackZeros s = case s of+ '+':num -> C.pack $ '+' : zeroStr ++ num ++ tailStr+ '-':num -> C.pack $ '-' : zeroStr ++ num ++ tailStr+ num -> C.pack $ zeroStr ++ num ++ tailStr+ good i = Just (i, C.pack tailStr)+ --+ rdWordBounds :: forall a. RdInt a => Bool+ rdWordBounds =+ -- Upper bound+ rdIntC @a (spack (smax @a)) == good maxBound+ -- With leading zeros+ && rdIntC @a (spackZeros (smax @a)) == good maxBound+ -- Overflow in last digit+ && rdIntC @a (spack (smax1 @a)) == Nothing+ -- Overflow in 2nd-last digit+ && rdIntC @a (spack (smax10 @a)) == Nothing+ -- Trailing zeros+ && rdIntC @a (spackLong (smax @a)) == Nothing+ --+ rdIntBounds :: forall a. RdInt a => Bool+ rdIntBounds =+ rdWordBounds @a+ -- Lower bound+ && rdIntC @a (spack (smin @a)) == good minBound+ -- With leading signs+ && rdIntC @a (spackPlus (smax @a)) == good maxBound+ && rdIntC @a (spackMinus (smax @a)) == good (negate maxBound)+ -- With leading zeros+ && rdIntC @a (spackZeros (smax @a)) == good maxBound+ -- Underflow in last digit+ && rdIntC @a (spack (smin1 @a)) == Nothing+ -- Underflow in 2nd-last digit+ && rdIntC @a (spack (smin10 @a)) == Nothing+ -- Trailing zeros+ && rdIntC @a (spackLong (smin @a)) == Nothing +prop_readIntBoundsLC = rdWordBounds @Word+ && rdWordBounds @Word8+ && rdWordBounds @Word16+ && rdWordBounds @Word32+ && rdWordBounds @Word64+ && rdIntBounds @Int+ && rdIntBounds @Int8+ && rdIntBounds @Int16+ && rdIntBounds @Int32+ && rdIntBounds @Int64+ where+ tailStr = " tail"+ zeroStr = "000000000000000000000000000"+ spack s = LC.pack $ s ++ tailStr+ spackPlus s = LC.singleton '+' `D.append` LC.pack s `D.append` LC.pack tailStr+ spackMinus s = LC.singleton '-' `D.append` LC.pack s `D.append` LC.pack tailStr+ spackLong1 s = LC.pack s `D.append` LC.pack zeroStr `D.append` LC.pack tailStr+ spackLong2 s = LC.pack (s ++ zeroStr) `D.append` LC.pack tailStr+ spackZeros s = case s of+ '+':num -> LC.pack ('+' : zeroStr) `D.append` LC.pack (num ++ tailStr)+ '-':num -> LC.pack ('-' : zeroStr) `D.append` LC.pack (num ++ tailStr)+ num -> LC.pack $ zeroStr ++ num ++ tailStr+ good i = Just (i, LC.pack tailStr)+ --+ rdWordBounds :: forall a. RdInt a => Bool+ rdWordBounds =+ -- Upper bound+ rdIntD @a (spack (smax @a)) == good maxBound+ -- With leading zeros+ && rdIntD @a (spackZeros (smax @a)) == good maxBound+ -- Overflow in last digit+ && rdIntD @a (spack (smax1 @a)) == Nothing+ -- Overflow in 2nd-last digit+ && rdIntD @a (spack (smax10 @a)) == Nothing+ -- Overflow across chunk boundary+ && rdIntD @a (spackLong1 (smax @a)) == Nothing+ -- Overflow within chunk+ && rdIntD @a (spackLong2 (smax @a)) == Nothing+ -- Sign with no digits+ && rdIntD @a (LC.pack "+ foo") == Nothing+ && rdIntD @a (LC.pack "-bar") == Nothing+ --+ rdIntBounds :: forall a. RdInt a => Bool+ rdIntBounds =+ rdWordBounds @a+ -- Lower bound+ && rdIntD @a (spack (smin @a)) == good minBound+ -- With leading signs+ && rdIntD @a (spackPlus (smax @a)) == good maxBound+ && rdIntD @a (spackMinus (smax @a)) == good (negate maxBound)+ -- With leading zeros+ && rdIntD @a (spackZeros (smin @a)) == good minBound+ -- Overflow in last digit+ && rdIntD @a (spack (smin1 @a)) == Nothing+ -- Overflow in 2nd-last digit+ && rdIntD @a (spack (smin10 @a)) == Nothing+ -- Overflow across chunk boundary+ && rdIntD @a (spackLong1 (smin @a)) == Nothing+ -- Overflow within chunk+ && rdIntD @a (spackLong2 (smin @a)) == Nothing+ ------------------------------------------------------------------------ +expectSizeOverflow :: a -> Property+expectSizeOverflow val = ioProperty $ do+ isLeft <$> try @P.SizeOverflowException (evaluate val)++prop_checkedAdd = forAll (vectorOf 2 nonNeg) $ \[x, y] -> if oflo x y+ then expectSizeOverflow (P.checkedAdd "" x y)+ else property $ P.checkedAdd "" x y == x + y+ where nonNeg = choose (0, (maxBound @Int))+ oflo x y = toInteger x + toInteger y /= toInteger @Int (x + y)++multCompl :: Int -> Gen Int+multCompl x = choose (0, fromInteger @Int maxc)+ -- This choice creates products with magnitude roughly in the range+ -- [0..5*(maxBound @Int)], which results in a roughly even split+ -- between positive and negative overflowed Int results, while still+ -- producing a fair number of non-overflowing products.+ where maxc = toInteger (maxBound @Int) * 5 `quot` max 5 (abs $ toInteger x)++prop_checkedMultiply = forAll genScale $ \scale ->+ forAll (genVal scale) $ \x ->+ forAll (multCompl x) $ \y -> if oflo x y+ then expectSizeOverflow (P.checkedMultiply "" x y)+ else property $ P.checkedMultiply "" x y == x * y+ where genScale = choose (0, finiteBitSize @Int 0 - 1)+ genVal scale = choose (0, bit scale - 1)+ oflo x y = toInteger x * toInteger y /= toInteger @Int (x * y)++prop_stimesOverflowBasic bs = forAll (multCompl len) $ \n ->+ toInteger n * toInteger len > maxInt ==> expectSizeOverflow (stimes n bs)+ where+ maxInt = toInteger @Int (maxBound @Int)+ len = P.length bs++prop_stimesOverflowScary bs =+ -- "Scary" because this test will cause heap corruption+ -- (not just memory exhaustion) with the old stimes implementation.+ n > 1 ==> expectSizeOverflow (stimes reps bs)+ where+ n = P.length bs+ reps = maxBound @Word `quot` fromIntegral @Int @Word n + 1++prop_stimesOverflowEmpty = forAll (choose (0, maxBound @Word)) $ \n ->+ stimes n mempty === mempty @P.ByteString++concat32bitOverflow :: (Int -> a) -> ([a] -> a) -> Property+concat32bitOverflow replicateLike concatLike = let+ intBits = finiteBitSize @Int 0+ largeBS = concatLike $ replicate (bit 14) $ replicateLike (bit 17)+ in if intBits /= 32+ then label "skipped due to non-32-bit Int" True+ else expectSizeOverflow largeBS++prop_32bitOverflow_Strict_mconcat :: Property+prop_32bitOverflow_Strict_mconcat =+ concat32bitOverflow (`P.replicate` 0) mconcat++prop_32bitOverflow_Lazy_toStrict :: Property+prop_32bitOverflow_Lazy_toStrict =+ concat32bitOverflow (`P.replicate` 0) (L.toStrict . L.fromChunks)++prop_32bitOverflow_Short_mconcat :: Property+prop_32bitOverflow_Short_mconcat =+ concat32bitOverflow makeShort mconcat+ where makeShort n = Short.toShort $ P.replicate n 0+++------------------------------------------------------------------------+ prop_packUptoLenBytes cs = forAll (choose (0, length cs + 1)) $ \n -> let (bs, cs') = P.packUptoLenBytes n cs@@ -218,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"@@ -226,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"@@ -234,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"@@ -242,7 +474,7 @@ D.writeFile fn x y <- D.readFile fn D.length y `seq` removeFile fn- return (x == y)+ return (x === y) ------------------------------------------------------------------------ @@ -253,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"@@ -262,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"@@ -271,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"@@ -280,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" ==@@ -397,14 +629,16 @@ testSuite :: TestTree testSuite = testGroup "Properties"- [ testGroup "StrictWord8" PropBS.tests- , testGroup "StrictChar8" PropBS8.tests- , testGroup "LazyWord8" PropBL.tests- , testGroup "LazyChar8" PropBL8.tests- , testGroup "Misc" misc_tests- , testGroup "IO" io_tests- , testGroup "Short" short_tests- , testGroup "Strictness" strictness_checks+ [ testGroup "ShortByteString" PropSBS.tests+ , testGroup "StrictWord8" PropBS.tests+ , testGroup "StrictChar8" PropBS8.tests+ , testGroup "LazyWord8" PropBL.tests+ , testGroup "LazyChar8" PropBL8.tests+ , testGroup "Overflow" overflow_tests+ , testGroup "Misc" misc_tests+ , testGroup "IO" io_tests+ , testGroup "Short" short_tests+ , testGroup "Strictness" strictness_checks ] io_tests =@@ -421,6 +655,17 @@ , testProperty "packAddress " prop_packAddress ] +overflow_tests =+ [ testProperty "checkedAdd" prop_checkedAdd+ , testProperty "checkedMultiply" prop_checkedMultiply+ , testProperty "StrictByteString stimes (basic)" prop_stimesOverflowBasic+ , testProperty "StrictByteString stimes (scary)" prop_stimesOverflowScary+ , testProperty "StrictByteString stimes (empty)" prop_stimesOverflowEmpty+ , testProperty "StrictByteString mconcat" prop_32bitOverflow_Strict_mconcat+ , testProperty "LazyByteString toStrict" prop_32bitOverflow_Lazy_toStrict+ , testProperty "ShortByteString mconcat" prop_32bitOverflow_Short_mconcat+ ]+ misc_tests = [ testProperty "packUptoLenBytes" prop_packUptoLenBytes , testProperty "packUptoLenChars" prop_packUptoLenChars@@ -446,21 +691,27 @@ , testProperty "w2c . c2w" prop_bijectionBB , testProperty "c2w . w2c" prop_bijectionBB' - , testProperty "unsafeHead" prop_head2BB- , testProperty "unsafeTail" prop_tail1BB- , testProperty "unsafeLast" prop_last1BB- , testProperty "unsafeInit" prop_init1BB+ , testProperty "unsafeHead" prop_unsafeHead+ , testProperty "unsafeTail" prop_unsafeTail+ , testProperty "unsafeLast" prop_unsafeLast+ , testProperty "unsafeInit" prop_unsafeInit , testProperty "unsafeIndex" prop_unsafeIndexBB - , testProperty "lines_lazy1" prop_lines_lazy1+ , testProperty "lines_lazy" prop_lines_lazy , testProperty "lines_lazy2" prop_lines_lazy2+ , testProperty "lines_lazy3" prop_lines_lazy3+ , testProperty "lines_invar" prop_lines_empty_invariant , testProperty "strip" prop_strip , testProperty "isSpace" prop_isSpaceWord8 - , testProperty "readIntSafe" prop_readIntSafe- , testProperty "readIntUnsafe" prop_readIntUnsafe+ , testProperty "readWordSafe" prop_readWordSafe+ , testProperty "readWordUnsafe" prop_readWordUnsafe+ , testProperty "readIntBoundsCC" prop_readIntBoundsCC+ , testProperty "readIntBoundsLC" prop_readIntBoundsLC , testProperty "readIntegerSafe" prop_readIntegerSafe , testProperty "readIntegerUnsafe" prop_readIntegerUnsafe+ , testProperty "readNaturalSafe" prop_readNaturalSafe+ , testProperty "readNaturalUnsafe" prop_readNaturalUnsafe ] strictness_checks =@@ -476,7 +727,7 @@ , testProperty "scanl is lazy" $ \ xs -> L.take (L.length xs + 1) (L.scanl (+) 0 (explosiveTail (xs <> L.singleton 1))) === (L.pack . fmap (L.foldr (+) 0) . L.inits) xs , testProperty "scanl1 is lazy" $ \ xs -> L.length xs > 0 ==>- L.take (L.length xs) (L.scanl1 (+) (explosiveTail (xs <> L.singleton 1))) === (L.pack . fmap (L.foldr1 (+)) . tail . L.inits) xs+ L.take (L.length xs) (L.scanl1 (+) (explosiveTail (xs <> L.singleton 1))) === (L.pack . fmap (L.foldr1 (+)) . drop 1 . L.inits) xs ] , testGroup "Lazy Char" [ testProperty "foldr is lazy" $ \ xs ->@@ -490,7 +741,8 @@ , testProperty "scanl is lazy" $ \ xs -> let char1 +. char2 = toEnum (fromEnum char1 + fromEnum char2) in D.take (D.length xs + 1) (D.scanl (+.) '\NUL' (explosiveTail (xs <> D.singleton '\SOH'))) === (D.pack . fmap (D.foldr (+.) '\NUL') . D.inits) xs , testProperty "scanl1 is lazy" $ \ xs -> D.length xs > 0 ==> let char1 +. char2 = toEnum (fromEnum char1 + fromEnum char2) in- D.take (D.length xs) (D.scanl1 (+.) (explosiveTail (xs <> D.singleton '\SOH'))) === (D.pack . fmap (D.foldr1 (+.)) . tail . D.inits) xs+ D.take (D.length xs) (D.scanl1 (+.) (explosiveTail (xs <> D.singleton '\SOH'))) === (D.pack . fmap (D.foldr1 (+.)) . drop 1 . D.inits) xs+ , testProperty "unlines is lazy" $ \ xs -> D.take (D.length xs + 1) (D.unlines (xs : error "Tail of this list is undefined!")) === xs `D.snoc` '\n' ] ]
tests/Properties/ByteString.hs view
@@ -4,7 +4,14 @@ -- License : BSD-style {-# LANGUAGE CPP #-}++{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE ViewPatterns #-}+-- 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+-- proxy arguments. Here the 'RdInt' class methods used to generate tests for+-- all the various 'readInt' types require explicit type applications. -- We are happy to sacrifice optimizations in exchange for faster compilation, -- but need to test rewrite rules. As one can check using -ddump-rule-firings,@@ -20,52 +27,114 @@ -- Properties.ByteString{Char8,Lazy,LazyChar8}, which include this file. #ifndef BYTESTRING_CHAR8 -#ifndef BYTESTRING_LAZY+#if defined(BYTESTRING_SHORT)+module Properties.ShortByteString (tests) where+import qualified Data.ByteString.Short as B+import qualified Data.ByteString.Short.Internal as B+#define BYTESTRING_TYPE B.ShortByteString+#elif !(defined BYTESTRING_LAZY) module Properties.ByteString (tests) where+#define BYTESTRING_TYPE B.ByteString import qualified Data.ByteString as B import GHC.IO.Encoding #else 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- #else #ifndef BYTESTRING_LAZY module Properties.ByteStringChar8 (tests) where import qualified Data.ByteString.Char8 as B+#define BYTESTRING_TYPE B.ByteString #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 +import Data.Int+import Numeric.Natural (Natural)+ import Text.Read #endif +import Prelude hiding (head, tail) import Control.Arrow import Data.Char+import Data.Data (toConstr, showConstr, Data) import Data.Foldable+import Data.Generics.Text (gread, gshow) import qualified Data.List as List+import qualified Data.List.NonEmpty as NE import Data.Semigroup import Data.String import Data.Tuple+import Data.Word import Test.Tasty import Test.Tasty.QuickCheck import QuickCheckUtils +#ifdef BYTESTRING_LAZY+import Data.Int+#endif+ #ifndef BYTESTRING_CHAR8 toElem :: Word8 -> Word8 toElem = id #else toElem :: Char8 -> Char toElem (Char8 c) = c++class (Integral a, Show a) => RdInt a where+ bread :: BYTESTRING_TYPE -> Maybe (a, BYTESTRING_TYPE)+ sread :: String -> Maybe (a, String)++instance RdInt Int where { bread = B.readInt; sread = readInt }+instance RdInt Int8 where { bread = B.readInt8; sread = readInt8 }+instance RdInt Int16 where { bread = B.readInt16; sread = readInt16 }+instance RdInt Int32 where { bread = B.readInt32; sread = readInt32 }+instance RdInt Int64 where { bread = B.readInt64; sread = readInt64 }+--+instance RdInt Word where { bread = B.readWord; sread = readWord }+instance RdInt Word8 where { bread = B.readWord8; sread = readWord8 }+instance RdInt Word16 where { bread = B.readWord16; sread = readWord16 }+instance RdInt Word32 where { bread = B.readWord32; sread = readWord32 }+instance RdInt Word64 where { bread = B.readWord64; sread = readWord64 }+--+instance RdInt Integer where { bread = B.readInteger; sread = readInteger }+instance RdInt Natural where { bread = B.readNatural; sread = readNatural }++instance Arbitrary Natural where+ arbitrary = i2n <$> arbitrary+ where i2n :: Integer -> Natural+ i2n i | i >= 0 = fromIntegral i+ | otherwise = fromIntegral $ negate i++testRdInt :: forall a. (Arbitrary a, RdInt a) => String -> TestTree+testRdInt s = testGroup s $+ [ testProperty "from string" $ int64OK $ \value prefix suffix ->+ let si = show @a value+ b = prefix <> B.pack si <> suffix+ in fmap (second B.unpack) (bread @a b)+ === sread @a (B.unpack prefix ++ si ++ B.unpack suffix)+ , testProperty "from number" $ int64OK $ \n ->+ bread @a (B.pack (show n)) === Just (n, B.empty)+ ] #endif +intToIndexTy :: Int -> IndexTy+#ifdef BYTESTRING_LAZY+type IndexTy = Int64+intToIndexTy = fromIntegral @Int @Int64+#else+type IndexTy = Int+intToIndexTy = id+#endif+ tests :: [TestTree] tests = [ testProperty "pack . unpack" $@@ -73,13 +142,14 @@ , testProperty "unpack . pack" $ \(map toElem -> xs) -> xs === B.unpack (B.pack xs) , testProperty "read . show" $- \x -> (x :: B.ByteString) === read (show x)+ \x -> (x :: BYTESTRING_TYPE) === read (show x)+#ifndef BYTESTRING_SHORT , testProperty "fromStrict . toStrict" $ \x -> B.fromStrict (B.toStrict x) === x , testProperty "toStrict . fromStrict" $ \x -> B.toStrict (B.fromStrict x) === x-#ifndef BYTESTRING_LAZY-#ifndef BYTESTRING_CHAR8+#endif+#if !defined(BYTESTRING_LAZY) && !defined(BYTESTRING_CHAR8) && !defined(BYTESTRING_SHORT) , testProperty "toFilePath >>= fromFilePath" $ \x -> ioProperty $ do r <- B.toFilePath x >>= B.fromFilePath@@ -92,26 +162,28 @@ -- but if it is ASCII, we should not generate Unicode filenames. enc <- getFileSystemEncoding pure $ case textEncodingName enc of- "ASCII" -> property (prop . getASCIIString)- _ -> property prop-#endif+ "ASCII" -> property (prop . getASCIIString)+ "ANSI_X3.4-1968" -> property (prop . getASCIIString)+ _ -> property prop #endif , testProperty "==" $ \x y -> (x == y) === (B.unpack x == B.unpack y) , testProperty "== refl" $- \x -> (x :: B.ByteString) == x+ \x -> (x :: BYTESTRING_TYPE) == x , testProperty "== symm" $- \x y -> ((x :: B.ByteString) == y) === (y == x)+ \x y -> ((x :: BYTESTRING_TYPE) == y) === (y == x) , testProperty "== pack unpack" $ \x -> x == B.pack (B.unpack x)+#ifndef BYTESTRING_SHORT , testProperty "== copy" $ \x -> x == B.copy x+#endif , testProperty "compare" $ \x y -> compare x y === compare (B.unpack x) (B.unpack y) , testProperty "compare EQ" $- \x -> compare (x :: B.ByteString) x == EQ+ \x -> compare (x :: BYTESTRING_TYPE) x == EQ , testProperty "compare GT" $ \x (toElem -> c) -> compare (B.snoc x c) x == GT , testProperty "compare LT" $@@ -157,6 +229,7 @@ \x -> B.null x === null (B.unpack x) , testProperty "reverse" $ \x -> B.unpack (B.reverse x) === reverse (B.unpack x)+#ifndef BYTESTRING_SHORT , testProperty "transpose" $ \xs -> map B.unpack (B.transpose xs) === List.transpose (map B.unpack xs) , testProperty "group" $@@ -171,6 +244,11 @@ \x -> map B.unpack (B.inits x) === List.inits (B.unpack x) , testProperty "tails" $ \x -> map B.unpack (B.tails x) === List.tails (B.unpack x)+ , testProperty "initsNE" $+ \x -> NE.map B.unpack (B.initsNE x) === NE.inits (B.unpack x)+ , testProperty "tailsNE" $+ \x -> NE.map B.unpack (B.tailsNE x) === NE.tails (B.unpack x)+#endif , testProperty "all" $ \f x -> B.all f x === all f (B.unpack x) , testProperty "all ==" $@@ -186,7 +264,7 @@ , testProperty "<>" $ \x y -> B.unpack (x <> y) === B.unpack x <> B.unpack y , testProperty "stimes" $- \(Sqrt (NonNegative n)) (Sqrt x) -> stimes (n :: Int) (x :: B.ByteString) === mtimesDefault n x+ \(Sqrt (NonNegative n)) (Sqrt x) -> stimes (n :: Int) (x :: BYTESTRING_TYPE) === stimesMonoid n x , testProperty "break" $ \f x -> (B.unpack *** B.unpack) (B.break f x) === break f (B.unpack x)@@ -214,10 +292,12 @@ \x -> (B.unpack *** B.unpack) (B.break isSpace x) === break isSpace (B.unpack x) #endif +#ifndef BYTESTRING_SHORT , testProperty "concatMap" $ \f x -> B.unpack (B.concatMap f x) === concatMap (B.unpack . f) (B.unpack x) , testProperty "concatMap singleton" $ \x -> B.unpack (B.concatMap B.singleton x) === concatMap (: []) (B.unpack x)+#endif , testProperty "singleton" $ \(toElem -> c) -> B.unpack (B.singleton c) === [c]@@ -239,7 +319,7 @@ #endif , testProperty "drop" $- \n x -> B.unpack (B.drop n x) === List.genericDrop n (B.unpack x)+ \(intToIndexTy -> n) x -> B.unpack (B.drop n x) === List.genericDrop n (B.unpack x) , testProperty "drop 10" $ \x -> let n = 10 in B.unpack (B.drop n x) === List.genericDrop n (B.unpack x) , testProperty "drop 2^31" $@@ -256,7 +336,7 @@ #endif , testProperty "take" $- \n x -> B.unpack (B.take n x) === List.genericTake n (B.unpack x)+ \(intToIndexTy -> n) x -> B.unpack (B.take n x) === List.genericTake n (B.unpack x) , testProperty "take 10" $ \x -> let n = 10 in B.unpack (B.take n x) === List.genericTake n (B.unpack x) , testProperty "take 2^31" $@@ -273,23 +353,21 @@ #endif , testProperty "dropEnd" $- \n x -> B.dropEnd n x === B.take (B.length x - n) x+ \(intToIndexTy -> n) x -> B.dropEnd n x === B.take (B.length x - n) x , testProperty "dropWhileEnd" $ \f x -> B.dropWhileEnd f x === B.reverse (B.dropWhile f (B.reverse x)) , testProperty "takeEnd" $- \n x -> B.takeEnd n x === B.drop (B.length x - n) x+ \(intToIndexTy -> n) x -> B.takeEnd n x === B.drop (B.length x - n) x , testProperty "takeWhileEnd" $ \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" $ \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" $@@ -299,15 +377,15 @@ , testProperty "compareLength 4" $ \x (toElem -> c) -> B.compareLength (B.snoc x c <> undefined) (B.length x) === GT , testProperty "compareLength 5" $- \x n -> B.compareLength x n === compare (B.length x) n+ \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" $@@ -334,8 +412,10 @@ \f x -> B.find f x === find f (B.unpack x) , testProperty "findIndex" $ \f x -> B.findIndex f x === fmap fromIntegral (List.findIndex f (B.unpack x))+#ifndef BYTESTRING_SHORT , testProperty "findIndexEnd" $ \f x -> B.findIndexEnd f x === fmap fromIntegral (findIndexEnd f (B.unpack x))+#endif , testProperty "findIndices" $ \f x -> B.findIndices f x === fmap fromIntegral (List.findIndices f (B.unpack x)) , testProperty "findIndices ==" $@@ -343,12 +423,16 @@ , testProperty "elem" $ \(toElem -> c) x -> B.elem c x === elem c (B.unpack x)+#ifndef BYTESTRING_SHORT , testProperty "notElem" $ \(toElem -> c) x -> B.notElem c x === notElem c (B.unpack x)+#endif , testProperty "elemIndex" $ \(toElem -> c) x -> B.elemIndex c x === fmap fromIntegral (List.elemIndex c (B.unpack x))+#ifndef BYTESTRING_SHORT , testProperty "elemIndexEnd" $ \(toElem -> c) x -> B.elemIndexEnd c x === fmap fromIntegral (elemIndexEnd c (B.unpack x))+#endif , testProperty "elemIndices" $ \(toElem -> c) x -> B.elemIndices c x === fmap fromIntegral (List.elemIndices c (B.unpack x)) @@ -397,28 +481,35 @@ (l1 == l2 || l1 == l2 + 1) && sum (map B.length splits) + l2 == B.length x , testProperty "splitAt" $- \n x -> (B.unpack *** B.unpack) (B.splitAt n x) === List.genericSplitAt n (B.unpack x)+ \(intToIndexTy -> n) x -> (B.unpack *** B.unpack) (B.splitAt n x)+ === List.genericSplitAt n (B.unpack x) , testProperty "splitAt 10" $ \x -> let n = 10 in (B.unpack *** B.unpack) (B.splitAt n x) === List.genericSplitAt n (B.unpack x) , testProperty "splitAt (2^31)" $ \x -> let n = 2^31 in (B.unpack *** B.unpack) (B.splitAt n x) === List.genericSplitAt n (B.unpack x) , testProperty "head" $- \x -> not (B.null x) ==> B.head x === head (B.unpack x)+ \x -> case B.unpack x of+ [] -> property True+ hd : _ -> B.head x === hd , testProperty "last" $ \x -> not (B.null x) ==> B.last x === last (B.unpack x) , testProperty "tail" $- \x -> not (B.null x) ==> B.unpack (B.tail x) === tail (B.unpack x)+ \x -> case B.unpack x of+ [] -> property True+ _ : tl -> B.unpack (B.tail x) === tl , testProperty "tail length" $ \x -> not (B.null x) ==> B.length x === 1 + B.length (B.tail x) , testProperty "init" $ \x -> not (B.null x) ==> B.unpack (B.init x) === init (B.unpack x) , testProperty "init length" $ \x -> not (B.null x) ==> B.length x === 1 + B.length (B.init x)+#ifndef BYTESTRING_SHORT , testProperty "maximum" $ \x -> not (B.null x) ==> B.maximum x === maximum (B.unpack x) , testProperty "minimum" $ \x -> not (B.null x) ==> B.minimum x === minimum (B.unpack x)+#endif , testProperty "foldl" $ \f (toElem -> c) x -> B.foldl ((toElem .) . f) c x === foldl ((toElem .) . f) c (B.unpack x)@@ -462,6 +553,7 @@ , testProperty "foldr1 max" $ \x -> not (B.null x) ==> B.foldr1 max x === B.foldr max minBound x +#ifndef BYTESTRING_SHORT , testProperty "scanl" $ \f (toElem -> c) x -> B.unpack (B.scanl ((toElem .) . f) c x) === scanl ((toElem .) . f) c (B.unpack x) , testProperty "scanl foldl" $@@ -477,14 +569,17 @@ \f x -> B.unpack (B.scanr1 ((toElem .) . f) x) === scanr1 ((toElem .) . f) (B.unpack x) , testProperty "scanr1 empty" $ \f -> B.scanr1 f B.empty === B.empty+#endif -#ifndef BYTESTRING_LAZY+#if !defined(BYTESTRING_LAZY) && !defined(BYTESTRING_SHORT) , testProperty "sort" $ \x -> B.unpack (B.sort x) === List.sort (B.unpack x) #endif +#ifndef BYTESTRING_SHORT , testProperty "intersperse" $ \(toElem -> c) x -> B.unpack (B.intersperse c x) === List.intersperse c (B.unpack x)+#endif , testProperty "intercalate" $ \(Sqrt x) (Sqrt ys) -> B.unpack (B.intercalate x ys) === List.intercalate (B.unpack x) (map B.unpack ys) , testProperty "intercalate 'c' [x,y]" $@@ -492,6 +587,7 @@ , testProperty "intercalate split" $ \(toElem -> c) x -> B.intercalate (B.singleton c) (B.split c x) === x +#ifndef BYTESTRING_SHORT , testProperty "mapAccumL" $ \f (toElem -> c) x -> second B.unpack (B.mapAccumL ((second toElem .) . f) c x) === List.mapAccumL ((second toElem .) . f) c (B.unpack x)@@ -505,29 +601,53 @@ \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 , testProperty "index" $- \(NonNegative n) x -> fromIntegral n < B.length x ==> B.index x (fromIntegral n) === B.unpack x !! n+ \(NonNegative n) x -> intToIndexTy n < B.length x ==> B.index x (intToIndexTy n) === B.unpack x !! n , testProperty "indexMaybe" $- \(NonNegative n) x -> fromIntegral n < B.length x ==> B.indexMaybe x (fromIntegral n) === Just (B.unpack x !! n)+ \(NonNegative n) x -> intToIndexTy n < B.length x ==> B.indexMaybe x (intToIndexTy n) === Just (B.unpack x !! n) , testProperty "indexMaybe Nothing" $- \n x -> (n :: Int) < 0 || fromIntegral n >= B.length x ==> B.indexMaybe x (fromIntegral n) === Nothing+ \n x -> n < 0 || intToIndexTy n >= B.length x ==> B.indexMaybe x (intToIndexTy n) === Nothing , testProperty "!?" $- \n x -> B.indexMaybe x (fromIntegral (n :: Int)) === x B.!? (fromIntegral n)+ \(intToIndexTy -> n) x -> B.indexMaybe x n === x B.!? n #ifdef BYTESTRING_CHAR8 , testProperty "isString" $ \x -> x === fromString (B.unpack x)- , testProperty "readInt 1" $- \x -> fmap (second B.unpack) (B.readInt x) === readInt (B.unpack x)- , testProperty "readInt 2" $- \n -> B.readInt (B.pack (show n)) === Just (n, B.empty)- , testProperty "readInteger 1" $- \x -> fmap (second B.unpack) (B.readInteger x) === readInteger (B.unpack x)- , testProperty "readInteger 2" $- \n -> B.readInteger (B.pack (show n)) === Just (n, B.empty)+ , testRdInt @Int "readInt"+ , testRdInt @Int8 "readInt8"+ , testRdInt @Int16 "readInt16"+ , testRdInt @Int32 "readInt32"+ , testRdInt @Int64 "readInt64"+ , testRdInt @Word "readWord"+ , testRdInt @Word8 "readWord8"+ , testRdInt @Word16 "readWord16"+ , testRdInt @Word32 "readWord32"+ , testRdInt @Word64 "readWord64"+ , testRdInt @Integer "readInteger"+ , testRdInt @Natural "readNatural" , testProperty "lines" $ \x -> map B.unpack (B.lines x) === lines (B.unpack x) , testProperty "lines \\n" $ once $@@ -574,17 +694,31 @@ , testProperty "fromString literal" $ fromString "\0\1\2\3\4" == B.pack [0,1,2,3,4] #endif++#ifndef BYTESTRING_SHORT+ , testProperty "toConstr is pack" $+ \(x :: BYTESTRING_TYPE) -> showConstr (toConstr x) === "pack"+#ifndef BYTESTRING_CHAR8+ , testProperty "gshow" $+ \x -> gshow x === "(pack " ++ gshow (B.unpack x) ++ ")"+#endif+-- -- gread is broken on bytestring-0.12 and fixed on bytestring-master+-- , testProperty "gread . gshow = reads . show" $+-- \(x :: BYTESTRING_TYPE) -> gread (gshow x) === (reads (show x) :: [(BYTESTRING_TYPE, String)])+#endif ] unsnoc :: [a] -> Maybe ([a], a) unsnoc [] = Nothing unsnoc xs = Just (init xs, last xs) +#ifndef BYTESTRING_SHORT findIndexEnd :: (a -> Bool) -> [a] -> Maybe Int findIndexEnd f xs = fmap (\n -> length xs - 1 - n) (List.findIndex f (reverse xs)) elemIndexEnd :: Eq a => a -> [a] -> Maybe Int elemIndexEnd c xs = fmap (\n -> length xs - 1 - n) (List.elemIndex c (reverse xs))+#endif stripSuffix :: Eq a => [a] -> [a] -> Maybe [a] stripSuffix x y = fmap reverse (List.stripPrefix (reverse x) (reverse y))@@ -608,15 +742,89 @@ | y' <- fromInteger y, toInteger y' == y -> Just (y', zs) otherwise -> Nothing +readWord :: String -> Maybe (Word, String)+readWord xs = case readIntegerUnsigned xs of+ Just (y, zs)+ | y' <- fromInteger y, toInteger y' == y -> Just (y', zs)+ otherwise -> Nothing++readInt8 :: String -> Maybe (Int8, String)+readInt8 xs = case readInteger xs of+ Just (y, zs)+ | y' <- fromInteger y, toInteger y' == y -> Just (y', zs)+ otherwise -> Nothing++readWord8 :: String -> Maybe (Word8, String)+readWord8 xs = case readIntegerUnsigned xs of+ Just (y, zs)+ | y' <- fromInteger y, toInteger y' == y -> Just (y', zs)+ otherwise -> Nothing++readInt16 :: String -> Maybe (Int16, String)+readInt16 xs = case readInteger xs of+ Just (y, zs)+ | y' <- fromInteger y, toInteger y' == y -> Just (y', zs)+ otherwise -> Nothing++readWord16 :: String -> Maybe (Word16, String)+readWord16 xs = case readIntegerUnsigned xs of+ Just (y, zs)+ | y' <- fromInteger y, toInteger y' == y -> Just (y', zs)+ otherwise -> Nothing++readInt32 :: String -> Maybe (Int32, String)+readInt32 xs = case readInteger xs of+ Just (y, zs)+ | y' <- fromInteger y, toInteger y' == y -> Just (y', zs)+ otherwise -> Nothing++readWord32 :: String -> Maybe (Word32, String)+readWord32 xs = case readIntegerUnsigned xs of+ Just (y, zs)+ | y' <- fromInteger y, toInteger y' == y -> Just (y', zs)+ otherwise -> Nothing++readInt64 :: String -> Maybe (Int64, String)+readInt64 xs = case readInteger xs of+ Just (y, zs)+ | y' <- fromInteger y, toInteger y' == y -> Just (y', zs)+ otherwise -> Nothing++readWord64 :: String -> Maybe (Word64, String)+readWord64 xs = case readIntegerUnsigned xs of+ Just (y, zs)+ | y' <- fromInteger y, toInteger y' == y -> Just (y', zs)+ otherwise -> Nothing+ readInteger :: String -> Maybe (Integer, String) readInteger ('+' : xs) = readIntegerUnsigned xs readInteger ('-' : xs) = fmap (first negate) (readIntegerUnsigned xs) readInteger xs = readIntegerUnsigned xs +readNatural :: String -> Maybe (Natural, String)+readNatural xs = case readIntegerUnsigned xs of+ Just (y, zs)+ | y >= 0 -> Just (fromIntegral @Integer @Natural y, zs)+ _ -> Nothing+ readIntegerUnsigned :: String -> Maybe (Integer, String) readIntegerUnsigned xs = case readMaybe ys of Just y -> Just (y, zs) 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/Properties/ShortByteString.hs view
@@ -0,0 +1,5 @@+{-# LANGUAGE CPP #-}++#define BYTESTRING_SHORT++#include "ByteString.hs"
tests/QuickCheckUtils.hs view
@@ -1,12 +1,13 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE UndecidableInstances #-} module QuickCheckUtils ( Char8(..) , String8(..) , CByteString(..) , Sqrt(..)+ , int64OK+ , tooStrictErr ) where import Test.Tasty.QuickCheck@@ -18,10 +19,12 @@ import Data.Int 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 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@@ -45,13 +48,14 @@ 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 (n `div` numChunks)) + shrink = map L.fromChunks . shrink . L.toChunks+ instance CoArbitrary L.ByteString where coarbitrary s = coarbitrary (L.unpack s) @@ -101,3 +105,38 @@ arbitrary = Sqrt <$> sized (\n -> resize (round @Double $ sqrt $ fromIntegral @Int n) arbitrary) shrink = map Sqrt . shrink . unSqrt+++sizedShortByteString :: Int -> Gen SB.ShortByteString+sizedShortByteString n = do m <- choose(0, n)+ fmap SB.pack $ vectorOf m arbitrary++instance Arbitrary SB.ShortByteString where+ arbitrary = sized sizedShortByteString+ shrink = map SB.pack . shrink . SB.unpack++instance CoArbitrary SB.ShortByteString where+ coarbitrary s = coarbitrary (SB.unpack s)++-- | This /poison instance/ exists to make accidental mis-use+-- of the @Arbitrary Int64@ instance a bit less likely.+instance {-# OVERLAPPING #-}+ TypeError (Text "Found a test taking a raw Int64 argument."+ :$$: Text "'instance Arbitrary Int64' by default is likely to"+ :$$: Text "produce very large numbers after the first few tests,"+ :$$: Text "which doesn't make great indices into a LazyByteString."+ :$$: Text "For indices, try 'intToIndexTy' in Properties/ByteString.hs."+ :$$: Text ""+ :$$: Text "If very few small-numbers tests is OK, use"+ :$$: Text "'int64OK' to bypass this poison-instance."+ ) => Testable (Int64 -> prop) where+ property = error "poison instance Testable (Int64 -> prop)"++-- | Use this to bypass the poison instance for @Testable (Int64 -> prop)@+-- 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,14 +18,12 @@ 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) import Data.Foldable-#if !MIN_VERSION_base(4,11,0)-import Data.Semigroup-#endif+import Data.Semigroup (Semigroup(..)) import Data.Word import qualified Data.ByteString as S@@ -47,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,8 +47,12 @@ import Test.Tasty (TestTree, TestName, testGroup) import Test.Tasty.QuickCheck ( Arbitrary(..), oneof, choose, listOf, elements- , counterexample, ioProperty, UnicodeString(..), Property, testProperty- , (===), (.&&.), conjoin )+ , counterexample, ioProperty, Property, testProperty+ , (===), (.&&.), conjoin, forAll, forAllShrink+ , UnicodeString(..), NonNegative(..), Positive(..)+ , mapSize, (==>)+ )+import QuickCheckUtils tests :: [TestTree]@@ -67,13 +63,15 @@ , testPut , testRunBuilder , testWriteFile+ , testStimes ] ++ testsEncodingToBuilder ++ testsBinary ++ testsASCII ++ testsFloating ++ testsChar8 ++- testsUtf8+ testsUtf8 +++ [testLaziness] ------------------------------------------------------------------------------@@ -199,6 +197,11 @@ unless success (error msg) return success +testStimes :: TestTree+testStimes = testProperty "stimes" $+ \(Sqrt (NonNegative n)) (Sqrt x) ->+ stimes (n :: Int) x === toLazyByteString (stimes n (lazyByteString x))+ removeFile :: String -> IO () removeFile fn = void $ withCString fn c_unlink @@ -319,22 +322,6 @@ -- 'Arbitary' instances ----------------------- -instance Arbitrary L.ByteString where- arbitrary = L.fromChunks <$> listOf arbitrary- shrink lbs- | L.null lbs = []- | otherwise = pure $ L.take (L.length lbs `div` 2) lbs--instance Arbitrary S.ByteString where- arbitrary =- trim S.drop =<< trim S.take =<< S.pack <$> listOf arbitrary- where- trim f bs = oneof [pure bs, f <$> choose (0, S.length bs) <*> pure bs]-- shrink bs- | S.null bs = []- | otherwise = pure $ S.take (S.length bs `div` 2) bs- instance Arbitrary Mode where arbitrary = oneof [Threshold <$> arbitrary, pure Smart, pure Insert, pure Copy, pure Hex]@@ -547,13 +534,20 @@ testBuilderConstr name ref mkBuilder = testProperty name check where- check x =- (ws ++ ws) ==- (L.unpack $ toLazyByteString $ mkBuilder x `BI.append` mkBuilder x)- where- ws = ref x+ check = int64OK $ \x ->+ forAllShrink genPaddingAmount shrink $ \paddingAmount -> let+ -- use padding to make sure we test at unaligned positions+ ws = ref x+ b1 = mkBuilder x+ b2 = byteStringCopy (S.take paddingAmount padBuf) <> b1 <> b1+ in (replicate paddingAmount (S.c2w ' ') ++ ws ++ ws) ===+ (L.unpack $ toLazyByteString b2) + maxPaddingAmount = 15+ padBuf = S.replicate maxPaddingAmount (S.c2w ' ')+ genPaddingAmount = choose (0, maxPaddingAmount) + testsBinary :: [TestTree] testsBinary = [ testBuilderConstr "word8" bigEndian_list word8@@ -987,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 ]