diff --git a/Changelog.md b/Changelog.md --- a/Changelog.md +++ b/Changelog.md @@ -1,9 +1,118 @@ -[0.11.5.4] — January 2025 +[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)) + -[0.11.5.4]: https://github.com/haskell/bytestring/compare/0.11.5.3...0.11.5.4 +[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. + + +[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 diff --git a/Data/ByteString.hs b/Data/ByteString.hs --- a/Data/ByteString.hs +++ b/Data/ByteString.hs @@ -1,11 +1,6 @@ -{-# OPTIONS_HADDOCK prune #-} {-# LANGUAGE Trustworthy #-} -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE MagicHash #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE TupleSections #-} -{-# LANGUAGE TypeApplications #-} +{-# OPTIONS_HADDOCK prune #-} -- | -- Module : Data.ByteString @@ -47,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, @@ -248,7 +259,6 @@ import Control.Monad (when) import Foreign.C.String (CString, CStringLen) -import Foreign.C.Types (CSize (CSize), CInt (CInt)) import Foreign.ForeignPtr (ForeignPtr, touchForeignPtr) import Foreign.ForeignPtr.Unsafe(unsafeForeignPtrToPtr) import Foreign.Marshal.Alloc (allocaBytes) @@ -380,16 +390,16 @@ -- | /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) = unsafeCreateFp (l+1) $ \p -> do +cons c (BS x len) = unsafeCreateFp (checkedAdd "cons" len 1) $ \p -> do pokeFp p c - memcpyFp (p `plusForeignPtr` 1) x l + 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 = unsafeCreateFp (l+1) $ \p -> do - memcpyFp p x l - pokeFp (p `plusForeignPtr` 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. @@ -773,7 +783,7 @@ -- ^ input of length n -> ByteString -- ^ output of length n+1 -scanl f v = \(BS a len) -> unsafeCreateFp (len+1) $ \q -> do +scanl f v = \(BS a len) -> unsafeCreateFp (checkedAdd "scanl" len 1) $ \q -> do -- see fold inlining pokeFp q v let @@ -817,7 +827,7 @@ -- ^ input of length n -> ByteString -- ^ output of length n+1 -scanr f v = \(BS a len) -> unsafeCreateFp (len+1) $ \b -> do +scanr f v = \(BS a len) -> unsafeCreateFp (checkedAdd "scanr" len 1) $ \b -> do -- see fold inlining pokeFpByteOff b len v let @@ -1062,7 +1072,7 @@ -- | Returns the longest (possibly empty) suffix of elements which __do not__ -- satisfy the predicate and the remainder of the string. -- --- 'breakEnd' @p@ is equivalent to @'spanEnd' (not . p)@ and to @('takeWhileEnd' (not . p) &&& 'dropWhileEnd' (not . p))@. +-- 'breakEnd' @p@ is equivalent to @'spanEnd' (not . p)@ and to @('dropWhileEnd' (not . p) &&& 'takeWhileEnd' (not . p))@. -- breakEnd :: (Word8 -> Bool) -> ByteString -> (ByteString, ByteString) breakEnd p ps = splitAt (findFromEndUntil p ps) ps @@ -1107,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 -- @@ -1228,8 +1238,9 @@ go (destPtr' `plusForeignPtr` chunkLen) chunks go (dstPtr0 `plusForeignPtr` hLen) t where - totalLen = List.foldl' (\acc (BS _ chunkLen) -> acc + chunkLen + sepLen) hLen t -{-# INLINE intercalate #-} + totalLen = List.foldl' (\acc chunk -> acc +! sepLen +! length chunk) hLen t + (+!) = checkedAdd "intercalate" +{-# INLINABLE intercalate #-} -- --------------------------------------------------------------------- -- Indexing ByteStrings @@ -1545,17 +1556,6 @@ else cIsValidUtf8Safe p (fromIntegral len) pure $ i /= 0 --- 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" cIsValidUtf8 - :: Ptr Word8 -> CSize -> IO CInt - -foreign import ccall safe "bytestring_is_valid_utf8" cIsValidUtf8Safe - :: 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. -- @@ -1680,11 +1680,6 @@ 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) @@ -1785,9 +1780,13 @@ 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) @@ -1830,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 $ @@ -1877,6 +1879,10 @@ if c == fromIntegral (ord '\n') 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 = diff --git a/Data/ByteString/Builder.hs b/Data/ByteString/Builder.hs --- a/Data/ByteString/Builder.hs +++ b/Data/ByteString/Builder.hs @@ -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 @@ -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 diff --git a/Data/ByteString/Builder/ASCII.hs b/Data/ByteString/Builder/ASCII.hs --- a/Data/ByteString/Builder/ASCII.hs +++ b/Data/ByteString/Builder/ASCII.hs @@ -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 diff --git a/Data/ByteString/Builder/Extra.hs b/Data/ByteString/Builder/Extra.hs --- a/Data/ByteString/Builder/Extra.hs +++ b/Data/ByteString/Builder/Extra.hs @@ -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. -- diff --git a/Data/ByteString/Builder/Internal.hs b/Data/ByteString/Builder/Internal.hs --- a/Data/ByteString/Builder/Internal.hs +++ b/Data/ByteString/Builder/Internal.hs @@ -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,12 +131,14 @@ ) 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.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. @@ -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 @@ -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) @@ -1090,7 +1191,7 @@ wrapChunk op' $ const $ nextBuffer (Just (buf, max minSize bufSize)) >>= fill nextStep - insertChunkH :: Ptr Word8 -> S.ByteString -> BuildStep a -> IO (ChunkIOStream a) + 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 diff --git a/Data/ByteString/Builder/Prim.hs b/Data/ByteString/Builder/Prim.hs --- a/Data/ByteString/Builder/Prim.hs +++ b/Data/ByteString/Builder/Prim.hs @@ -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' -- @ -- @@ -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,8 +525,8 @@ -- 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. +-- 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 aggressive buffer wrapping introduced by this @@ -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 diff --git a/Data/ByteString/Builder/Prim/ASCII.hs b/Data/ByteString/Builder/Prim/ASCII.hs --- a/Data/ByteString/Builder/Prim/ASCII.hs +++ b/Data/ByteString/Builder/Prim/ASCII.hs @@ -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 diff --git a/Data/ByteString/Builder/Prim/Binary.hs b/Data/ByteString/Builder/Prim/Binary.hs --- a/Data/ByteString/Builder/Prim/Binary.hs +++ b/Data/ByteString/Builder/Prim/Binary.hs @@ -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,38 +80,22 @@ -- | Encoding 'Word16's in big endian format. {-# INLINE word16BE #-} word16BE :: FixedPrim Word16 -#ifdef WORDS_BIGENDIAN -word16BE = word16Host -#else -word16BE = byteSwap16 >$< word16Host -#endif +word16BE = whenLittleEndian byteSwap16 >$< word16Host -- | Encoding 'Word16's in little endian format. {-# INLINE word16LE #-} word16LE :: FixedPrim Word16 -#ifdef WORDS_BIGENDIAN -word16LE = byteSwap16 >$< word16Host -#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 = byteSwap32 >$< word32Host -#endif +word32BE = whenLittleEndian byteSwap32 >$< word32Host -- | Encoding 'Word32's in little endian format. {-# INLINE word32LE #-} word32LE :: FixedPrim Word32 -#ifdef WORDS_BIGENDIAN -word32LE = byteSwap32 >$< word32Host -#else -word32LE = word32Host -#endif +word32LE = whenBigEndian byteSwap32 >$< word32Host -- on a little endian machine: -- word32LE w32 = fixedPrim 4 (\w p -> poke (castPtr p) w32) @@ -119,20 +103,12 @@ -- | Encoding 'Word64's in big endian format. {-# INLINE word64BE #-} word64BE :: FixedPrim Word64 -#ifdef WORDS_BIGENDIAN -word64BE = word64Host -#else -word64BE = byteSwap64 >$< word64Host -#endif +word64BE = whenLittleEndian byteSwap64 >$< word64Host -- | Encoding 'Word64's in little endian format. {-# INLINE word64LE #-} word64LE :: FixedPrim Word64 -#ifdef WORDS_BIGENDIAN -word64LE = byteSwap64 >$< word64Host -#else -word64LE = word64Host -#endif +word64LE = whenBigEndian byteSwap64 >$< word64Host -- | Encode a single native machine 'Word'. The 'Word's is encoded in host order, @@ -143,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 @@ -215,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 ------------------------------ @@ -261,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 diff --git a/Data/ByteString/Builder/Prim/Internal.hs b/Data/ByteString/Builder/Prim/Internal.hs --- a/Data/ByteString/Builder/Prim/Internal.hs +++ b/Data/ByteString/Builder/Prim/Internal.hs @@ -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 -> diff --git a/Data/ByteString/Builder/Prim/Internal/Base16.hs b/Data/ByteString/Builder/Prim/Internal/Base16.hs --- a/Data/ByteString/Builder/Prim/Internal/Base16.hs +++ b/Data/ByteString/Builder/Prim/Internal/Base16.hs @@ -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 diff --git a/Data/ByteString/Builder/Prim/Internal/Floating.hs b/Data/ByteString/Builder/Prim/Internal/Floating.hs --- a/Data/ByteString/Builder/Prim/Internal/Floating.hs +++ b/Data/ByteString/Builder/Prim/Internal/Floating.hs @@ -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 diff --git a/Data/ByteString/Builder/RealFloat/D2S.hs b/Data/ByteString/Builder/RealFloat/D2S.hs --- a/Data/ByteString/Builder/RealFloat/D2S.hs +++ b/Data/ByteString/Builder/RealFloat/D2S.hs @@ -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 diff --git a/Data/ByteString/Builder/RealFloat/F2S.hs b/Data/ByteString/Builder/RealFloat/F2S.hs --- a/Data/ByteString/Builder/RealFloat/F2S.hs +++ b/Data/ByteString/Builder/RealFloat/F2S.hs @@ -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 diff --git a/Data/ByteString/Builder/RealFloat/Internal.hs b/Data/ByteString/Builder/RealFloat/Internal.hs --- a/Data/ByteString/Builder/RealFloat/Internal.hs +++ b/Data/ByteString/Builder/RealFloat/Internal.hs @@ -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,13 +72,20 @@ 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 @@ -90,34 +95,8 @@ 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) #) diff --git a/Data/ByteString/Builder/RealFloat/TableGenerator.hs b/Data/ByteString/Builder/RealFloat/TableGenerator.hs --- a/Data/ByteString/Builder/RealFloat/TableGenerator.hs +++ b/Data/ByteString/Builder/RealFloat/TableGenerator.hs @@ -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 diff --git a/Data/ByteString/Char8.hs b/Data/ByteString/Char8.hs --- a/Data/ByteString/Char8.hs +++ b/Data/ByteString/Char8.hs @@ -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 @@ -187,7 +189,19 @@ -- * Reading from ByteStrings readInt, + readInt64, + readInt32, + readInt16, + readInt8, + + readWord, + readWord64, + readWord32, + readWord16, + readWord8, + readInteger, + readNatural, -- * Low level CString conversions @@ -257,15 +271,17 @@ ,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.Type +import Data.ByteString.ReadInt +import Data.ByteString.ReadNat import Data.Char ( isSpace ) -- See bytestring #70 @@ -845,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 @@ -988,84 +996,16 @@ 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: + +-- | 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. -- diff --git a/Data/ByteString/Internal.hs b/Data/ByteString/Internal.hs --- a/Data/ByteString/Internal.hs +++ b/Data/ByteString/Internal.hs @@ -60,7 +60,10 @@ -- * Utilities nullForeignPtr, deferForeignPtrAvailability, + SizeOverflowException, + overflowError, checkedAdd, + checkedMultiply, -- * Standard C Functions c_strlen, diff --git a/Data/ByteString/Internal/Pure.hs b/Data/ByteString/Internal/Pure.hs new file mode 100644 --- /dev/null +++ b/Data/ByteString/Internal/Pure.hs @@ -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"# diff --git a/Data/ByteString/Internal/Type.hs b/Data/ByteString/Internal/Type.hs --- a/Data/ByteString/Internal/Type.hs +++ b/Data/ByteString/Internal/Type.hs @@ -1,13 +1,15 @@ -{-# LANGUAGE CPP, ForeignFunctionInterface, BangPatterns #-} -{-# LANGUAGE UnliftedFFITypes, MagicHash, - UnboxedTuples #-} -{-# LANGUAGE TupleSections #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE PatternSynonyms, ViewPatterns #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE Unsafe #-} -{-# LANGUAGE TemplateHaskellQuotes #-} + {-# 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 @@ -78,7 +80,10 @@ memcpyFp, deferForeignPtrAvailability, unsafeDupablePerformIO, + SizeOverflowException, + overflowError, checkedAdd, + checkedMultiply, -- * Standard C Functions c_strlen, @@ -95,7 +100,21 @@ 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, @@ -112,66 +131,76 @@ import qualified Data.List as List import Foreign.ForeignPtr (ForeignPtr, withForeignPtr) -import Foreign.Ptr (Ptr, FunPtr, plusPtr) +import Foreign.Ptr import Foreign.Storable (Storable(..)) -import Foreign.C.Types (CInt(..), CSize(..)) +import Foreign.C.Types import Foreign.C.String (CString) import Foreign.Marshal.Utils +import Foreign.Marshal.Alloc (finalizerFree) -#if MIN_VERSION_base(4,13,0) -import Data.Semigroup (Semigroup (sconcat, stimes)) -#else -import Data.Semigroup (Semigroup ((<>), sconcat, stimes)) +#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) +import Control.Exception (assert, throw, Exception) import Data.Bits ((.&.)) import Data.Char (ord) import Data.Word -import Data.Data (Data(..), mkNoRepType) +import Data.Data (Data(..), mkConstr, mkNoRepType, Constr, DataType, Fixity(Prefix), constrIndex) -import GHC.Base (nullAddr#,realWorld#,unsafeChr) -import GHC.Exts (IsList(..), Addr#, minusAddr#) -import GHC.CString (unpackCString#) -import GHC.Magic (runRW#, lazy) +import GHC.Base (nullAddr#,realWorld#,unsafeChr,unpackCString#) +import GHC.Exts (IsList(..), Addr#, minusAddr#, ByteArray#, runRW#, lazy) +#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 __GLASGOW_HASKELL__ < 900 +#if !HS_cstringLength_AND_FinalPtr_AVAILABLE , newForeignPtr_ #endif , mallocPlainForeignPtrBytes) -#if MIN_VERSION_base(4,10,0) import GHC.ForeignPtr (plusForeignPtr) -#else -import GHC.Prim (plusAddr#) -#endif -#if __GLASGOW_HASKELL__ >= 811 -import GHC.CString (cstringLength#) +#if HS_cstringLength_AND_FinalPtr_AVAILABLE +import GHC.Exts (cstringLength#) import GHC.ForeignPtr (ForeignPtrContents(FinalPtr)) #else import GHC.Ptr (Ptr(..)) #endif -import GHC.Types (Int (..)) +import GHC.Int (Int (..)) -#if MIN_VERSION_base(4,15,0) +#if HS_unsafeWithForeignPtr_AVAILABLE import GHC.ForeignPtr (unsafeWithForeignPtr) #endif import qualified Language.Haskell.TH.Lib as TH import qualified Language.Haskell.TH.Syntax as TH -#if !MIN_VERSION_base(4,15,0) +#if !HS_unsafeWithForeignPtr_AVAILABLE unsafeWithForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b unsafeWithForeignPtr = withForeignPtr #endif @@ -179,25 +208,6 @@ -- CFILES stuff is Hugs only {-# CFILES cbits/fpstring.c #-} -#if !MIN_VERSION_base(4,10,0) --- |Advances the given address by the given offset in bytes. --- --- The new 'ForeignPtr' shares the finalizer of the original, --- equivalent from a finalization standpoint to just creating another --- reference to the original. That is, the finalizer will not be --- called before the new 'ForeignPtr' is unreachable, nor will it be --- called an additional time due to this call, and the finalizer will --- be called with the same address that it would have had this call --- not happened, *not* the new address. -plusForeignPtr :: ForeignPtr a -> Int -> ForeignPtr b -plusForeignPtr (ForeignPtr addr guts) (I# offset) = ForeignPtr (plusAddr# addr offset) guts -{-# INLINE [0] plusForeignPtr #-} -{-# RULES -"ByteString plusForeignPtr/0" forall fp . - plusForeignPtr fp 0 = fp - #-} -#endif - minusForeignPtr :: ForeignPtr a -> ForeignPtr b -> Int minusForeignPtr (ForeignPtr addr1 _) (ForeignPtr addr2 _) = I# (minusAddr# addr1 addr2) @@ -295,9 +305,7 @@ pattern PS :: ForeignPtr Word8 -> Int -> Int -> ByteString pattern PS fp zero len <- BS fp ((0,) -> (zero, len)) where PS fp o len = BS (plusForeignPtr fp o) len -#if __GLASGOW_HASKELL__ >= 802 {-# COMPLETE PS #-} -#endif instance Eq ByteString where (==) = eq @@ -308,7 +316,8 @@ instance Semigroup ByteString where (<>) = append sconcat (b:|bs) = concat (b:bs) - stimes = times + {-# INLINE stimes #-} + stimes = stimesPolymorphic instance Monoid ByteString where mempty = empty @@ -338,13 +347,22 @@ 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" + 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)) @@ -355,8 +373,10 @@ #endif #if MIN_VERSION_template_haskell(2,17,0) +-- template-haskell-2.17 first ships with ghc-9.0 liftTyped = TH.unsafeCodeCoerce . TH.lift #elif MIN_VERSION_template_haskell(2,16,0) +-- template-haskell-2.16 first ships with ghc-8.10 liftTyped = TH.unsafeTExpCoerce . TH.lift #endif @@ -432,7 +452,7 @@ -- unsafePackAddress :: Addr# -> IO ByteString unsafePackAddress addr# = do -#if __GLASGOW_HASKELL__ >= 811 +#if HS_cstringLength_AND_FinalPtr_AVAILABLE unsafePackLenAddress (I# (cstringLength# addr#)) addr# #else l <- c_strlen (Ptr addr#) @@ -448,7 +468,7 @@ -- @since 0.11.2.0 unsafePackLenAddress :: Int -> Addr# -> IO ByteString unsafePackLenAddress len addr# = do -#if __GLASGOW_HASKELL__ >= 811 +#if HS_cstringLength_AND_FinalPtr_AVAILABLE return (BS (ForeignPtr addr# FinalPtr) len) #else p <- newForeignPtr_ (Ptr addr#) @@ -465,7 +485,7 @@ -- @since 0.11.1.0 unsafePackLiteral :: Addr# -> ByteString unsafePackLiteral addr# = -#if __GLASGOW_HASKELL__ >= 811 +#if HS_cstringLength_AND_FinalPtr_AVAILABLE unsafePackLenLiteral (I# (cstringLength# addr#)) addr# #else let len = accursedUnutterablePerformIO (c_strlen (Ptr addr#)) @@ -482,7 +502,7 @@ -- @since 0.11.2.0 unsafePackLenLiteral :: Int -> Addr# -> ByteString unsafePackLenLiteral len addr# = -#if __GLASGOW_HASKELL__ >= 811 +#if HS_cstringLength_AND_FinalPtr_AVAILABLE BS (ForeignPtr addr# FinalPtr) len #else -- newForeignPtr_ allocates a MutVar# internally. If that MutVar# @@ -575,7 +595,7 @@ -- | The 0 pointer. Used to indicate the empty Bytestring. nullForeignPtr :: ForeignPtr Word8 -#if __GLASGOW_HASKELL__ >= 811 +#if HS_cstringLength_AND_FinalPtr_AVAILABLE nullForeignPtr = ForeignPtr nullAddr# FinalPtr #else nullForeignPtr = ForeignPtr nullAddr# (error "nullForeignPtr") @@ -637,30 +657,30 @@ -- | Create ByteString of size @l@ and use action @f@ to fill its contents. createFp :: Int -> (ForeignPtr Word8 -> IO ()) -> IO ByteString -createFp l action = do - fp <- mallocByteString l +createFp len action = assert (len >= 0) $ do + fp <- mallocByteString len action fp - mkDeferredByteString fp l + 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 l action = do - fp <- mallocByteString l - l' <- action fp - assert (l' <= l) $ mkDeferredByteString fp l' +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' l action = do - fp <- mallocByteString l - (l', res) <- action fp - bs <- mkDeferredByteString fp l' - assert (l' <= l) $ pure (bs, res) +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 @@ -672,22 +692,26 @@ -- ByteString functions, using Haskell or C functions to fill the space. -- createFpAndTrim :: Int -> (ForeignPtr Word8 -> IO Int) -> IO ByteString -createFpAndTrim l action = do - fp <- mallocByteString l - l' <- action fp - if assert (0 <= l' && l' <= l) $ l' >= l - then mkDeferredByteString fp l - else createFp l' $ \dest -> memcpyFp dest fp l' +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' l action = do - fp <- mallocByteString l - (off, l', res) <- action fp - bs <- if assert (0 <= l' && l' <= l) $ l' >= l - then mkDeferredByteString fp l -- entire buffer used => offset is zero - else createFp l' $ \dest -> - memcpyFp dest (fp `plusForeignPtr` off) l' +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' #-} @@ -791,7 +815,7 @@ append (BS _ 0) b = b append a (BS _ 0) = a append (BS fp1 len1) (BS fp2 len2) = - unsafeCreateFp (len1+len2) $ \destptr1 -> do + unsafeCreateFp (checkedAdd "append" len1 len2) $ \destptr1 -> do let destptr2 = destptr1 `plusForeignPtr` len1 memcpyFp destptr1 fp1 len1 memcpyFp destptr2 fp2 len2 @@ -847,37 +871,80 @@ 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" +-- | 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 size $ \destfptr -> do + | len == 1 = unsafeCreateFp n $ \destfptr -> do byte <- peekFp fp unsafeWithForeignPtr destfptr $ \destptr -> - fillBytes destptr byte (fromIntegral n) + fillBytes destptr byte n | otherwise = unsafeCreateFp size $ \destptr -> do memcpyFp destptr fp len fillFrom destptr len where - size = len * fromIntegral n + size = checkedMultiply "stimes" n len + halfSize = (size - 1) `div` 2 -- subtraction and division won't overflow fillFrom :: ForeignPtr Word8 -> Int -> IO () fillFrom destptr copied - | 2 * copied <= size = do + | copied <= halfSize = do memcpyFp (destptr `plusForeignPtr` copied) destptr copied fillFrom destptr (copied * 2) | otherwise = memcpyFp (destptr `plusForeignPtr` copied) destptr (size - copied) --- | Add two non-negative numbers. Errors out on overflow. ... -checkedAdd :: String -> Int -> Int -> Int -checkedAdd fun x y - | r >= 0 = r - | otherwise = overflowError fun - where r = x + y -{-# INLINE checkedAdd #-} ------------------------------------------------------------------------ @@ -912,9 +979,67 @@ 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 = error $ "Data.ByteString." ++ fun ++ ": size overflow" +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 @@ -954,24 +1079,42 @@ -- 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 "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 sz = c_memchr p (fromIntegral w) sz 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 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 () @@ -981,19 +1124,18 @@ memcpyFp fp fq s = unsafeWithForeignPtr fp $ \p -> unsafeWithForeignPtr fq $ \q -> copyBytes p q s -foreign import ccall unsafe "string.h memset" c_memset - :: Ptr Word8 -> CInt -> CSize -> IO (Ptr Word8) +c_free_finalizer :: FunPtr (Ptr Word8 -> IO ()) +c_free_finalizer = finalizerFree -{-# DEPRECATED memset "Use Foreign.Marshal.Utils.fillBytes instead" #-} --- | deprecated since @bytestring-0.11.5.0@ -memset :: Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8) -memset p w sz = c_memset p (fromIntegral w) sz + -- --------------------------------------------------------------------- -- -- Uses our C code -- +#if !PURE_HASKELL + foreign import ccall unsafe "static fpstring.h fps_reverse" c_reverse :: Ptr Word8 -> Ptr Word8 -> CSize -> IO () @@ -1009,5 +1151,148 @@ 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 diff --git a/Data/ByteString/Lazy.hs b/Data/ByteString/Lazy.hs --- a/Data/ByteString/Lazy.hs +++ b/Data/ByteString/Lazy.hs @@ -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 @@ -237,9 +236,9 @@ import qualified Data.ByteString as S -- S for strict (hmm...) 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) @@ -274,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 (:) [] ------------------------------------------------------------------------ @@ -790,16 +789,76 @@ -- -- @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 'empty' if @n > 'length' xs@. drop :: Int64 -> ByteString -> ByteString @@ -824,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) @@ -965,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) @@ -1035,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 -- @@ -1067,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 @@ -1094,6 +1119,7 @@ comb acc [s] Empty = [revChunks (s:acc)] comb acc [s] (Chunk c cs) = comb (s:acc) (S.split w c) cs comb acc (s:ss) cs = revChunks (s:acc) : comb [] ss cs + comb _ [] _ = error "Strict split returned [] for nonempty input" {-# INLINE split #-} -- | The 'group' function takes a ByteString and returns a list of @@ -1413,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. @@ -1688,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' @@ -1714,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 diff --git a/Data/ByteString/Lazy/Char8.hs b/Data/ByteString/Lazy/Char8.hs --- a/Data/ByteString/Lazy/Char8.hs +++ b/Data/ByteString/Lazy/Char8.hs @@ -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 @@ -179,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 @@ -228,8 +248,10 @@ 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 @@ -899,96 +921,6 @@ unwords :: [ByteString] -> ByteString 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. --- --- 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. -- diff --git a/Data/ByteString/Lazy/Internal.hs b/Data/ByteString/Lazy/Internal.hs --- a/Data/ByteString/Lazy/Internal.hs +++ b/Data/ByteString/Lazy/Internal.hs @@ -1,16 +1,10 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE DeriveLift #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE Unsafe #-} -#ifdef HS_BYTESTRING_ASSERTIONS -{-# LANGUAGE PatternSynonyms #-} -#endif - {-# OPTIONS_HADDOCK not-home #-} +{-# LANGUAGE TypeFamilies #-} + -- | -- Module : Data.ByteString.Lazy.Internal -- Copyright : (c) Don Stewart 2006-2008 @@ -59,17 +53,13 @@ import Data.Word (Word8) import Foreign.Storable (Storable(sizeOf)) -#if MIN_VERSION_base(4,13,0) -import Data.Semigroup (Semigroup (sconcat, stimes)) -#else -import Data.Semigroup (Semigroup ((<>), sconcat, stimes)) -#endif +import Data.Semigroup (Semigroup (..)) import Data.List.NonEmpty (NonEmpty ((:|))) import Control.DeepSeq (NFData, rnf) import Data.String (IsString(..)) -import Data.Data (Data(..), mkNoRepType) +import Data.Data (Data(..), mkConstr, mkNoRepType, Constr, DataType, Fixity(Prefix), constrIndex) import GHC.Exts (IsList(..)) @@ -83,13 +73,13 @@ -- | 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. -- #ifndef HS_BYTESTRING_ASSERTIONS -data ByteString = Empty | Chunk {-# UNPACK #-} !S.ByteString ByteString - -- INVARIANT: The S.ByteString field of any Chunk is not empty. +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 @@ -97,9 +87,9 @@ -- preprocessor macro is defined, by renaming the actual constructor -- and providing a pattern synonym that does the checking: #else -data ByteString = Empty | Chunk_ {-# UNPACK #-} !S.ByteString ByteString +data ByteString = Empty | Chunk_ {-# UNPACK #-} !S.StrictByteString ByteString -pattern Chunk :: S.ByteString -> ByteString -> 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 @@ -153,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 @@ -210,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) @@ -224,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 @@ -312,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 @@ -337,17 +335,16 @@ -- It's still possible that the result is a single chunk goLen1 _ bs Empty = bs 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.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 = do S.memcpyFp ptr fp len goCopy cs (ptr `S.plusForeignPtr` len) diff --git a/Data/ByteString/Lazy/Internal/Deque.hs b/Data/ByteString/Lazy/Internal/Deque.hs deleted file mode 100644 --- a/Data/ByteString/Lazy/Internal/Deque.hs +++ /dev/null @@ -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, tail, 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) diff --git a/Data/ByteString/Lazy/ReadInt.hs b/Data/ByteString/Lazy/ReadInt.hs new file mode 100644 --- /dev/null +++ b/Data/ByteString/Lazy/ReadInt.hs @@ -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 + -- . + -- + -- 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' diff --git a/Data/ByteString/Lazy/ReadNat.hs b/Data/ByteString/Lazy/ReadNat.hs new file mode 100644 --- /dev/null +++ b/Data/ByteString/Lazy/ReadNat.hs @@ -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: + -- + -- + 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 + -- . + -- + -- 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 diff --git a/Data/ByteString/ReadInt.hs b/Data/ByteString/ReadInt.hs new file mode 100644 --- /dev/null +++ b/Data/ByteString/ReadInt.hs @@ -0,0 +1,3 @@ +{-# LANGUAGE CPP #-} +#define BYTESTRING_STRICT +#include "Lazy/ReadInt.hs" diff --git a/Data/ByteString/ReadNat.hs b/Data/ByteString/ReadNat.hs new file mode 100644 --- /dev/null +++ b/Data/ByteString/ReadNat.hs @@ -0,0 +1,3 @@ +{-# LANGUAGE CPP #-} +#define BYTESTRING_STRICT +#include "Lazy/ReadNat.hs" diff --git a/Data/ByteString/Short.hs b/Data/ByteString/Short.hs --- a/Data/ByteString/Short.hs +++ b/Data/ByteString/Short.hs @@ -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: 8 words; 32 or 64 bytes. + -- * t'Data.ByteString.ByteString' unshared: 8 words; 32 or 64 bytes. -- - -- * 'B.ByteString' shared substring: 4 words; 16 or 32 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' diff --git a/Data/ByteString/Short/Internal.hs b/Data/ByteString/Short/Internal.hs --- a/Data/ByteString/Short/Internal.hs +++ b/Data/ByteString/Short/Internal.hs @@ -1,33 +1,15 @@ -{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE ForeignFunctionInterface #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE MagicHash #-} -{-# LANGUAGE MultiWayIf #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TemplateHaskellQuotes #-} -{-# LANGUAGE TupleSections #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE UnboxedTuples #-} -{-# LANGUAGE UnliftedFFITypes #-} {-# LANGUAGE Unsafe #-} -{-# LANGUAGE ViewPatterns #-} {-# OPTIONS_HADDOCK not-home #-} - {-# OPTIONS_GHC -fexpose-all-unfoldings #-} --- 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) -#define SAFE_UNALIGNED 1 -#endif +{-# 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 @@ -42,7 +24,7 @@ module Data.ByteString.Short.Internal ( -- * The @ShortByteString@ type and representation - ShortByteString(..), + ShortByteString(.., SBS), -- * Introducing and eliminating 'ShortByteString's empty, @@ -163,33 +145,36 @@ , unsafeDupablePerformIO , accursedUnutterablePerformIO , checkedAdd + , c_elem_index + , cIsValidUtf8BASafe + , cIsValidUtf8BA ) +import Data.Array.Byte + ( ByteArray(..), MutableByteArray(..) ) import Data.Bits ( FiniteBits (finiteBitSize) , shiftL -#if MIN_VERSION_base(4,12,0) && defined(SAFE_UNALIGNED) +#if HS_UNALIGNED_ByteArray_OPS_OK , shiftR #endif , (.&.) , (.|.) ) import Data.Data - ( Data(..) - , mkNoRepType - ) + ( Data(..) ) import Data.Monoid ( Monoid(..) ) import Data.Semigroup - ( Semigroup((<>)) ) + ( Semigroup(..), stimesMonoid ) +import Data.List.NonEmpty + ( NonEmpty(..) ) import Data.String ( IsString(..) ) -import Data.Typeable - ( Typeable ) import Control.Applicative ( pure ) import Control.DeepSeq - ( NFData(..) ) + ( NFData ) import Control.Exception ( assert ) import Control.Monad @@ -198,15 +183,6 @@ ( CString , CStringLen ) -import Foreign.C.Types - ( CSize(..) - , CInt(..) - , CPtrdiff(..) - ) -import Foreign.ForeignPtr - ( touchForeignPtr ) -import Foreign.ForeignPtr.Unsafe - ( unsafeForeignPtrToPtr ) import Foreign.Marshal.Alloc ( allocaBytes ) import Foreign.Storable @@ -216,22 +192,17 @@ , State#, RealWorld , ByteArray#, MutableByteArray# , newByteArray# - , newPinnedByteArray# , byteArrayContents# , unsafeCoerce# , copyMutableByteArray# -#if MIN_VERSION_base(4,10,0) , isByteArrayPinned# , isTrue# -#endif -#if MIN_VERSION_base(4,11,0) , compareByteArrays# -#endif , sizeofByteArray# , indexWord8Array#, indexCharArray# , writeWord8Array# , unsafeFreezeByteArray# -#if MIN_VERSION_base(4,12,0) && defined(SAFE_UNALIGNED) +#if HS_UNALIGNED_ByteArray_OPS_OK ,writeWord64Array# ,indexWord8ArrayAsWord64# #endif @@ -241,6 +212,8 @@ , writeWord8Array# , unsafeFreezeByteArray# , touch# ) +import GHC.Generics + ( Generic ) import GHC.IO hiding ( unsafeDupablePerformIO ) import GHC.ForeignPtr ( ForeignPtr(ForeignPtr) @@ -272,7 +245,6 @@ import qualified Data.List as List import qualified GHC.Exts -import qualified Language.Haskell.TH.Lib as TH import qualified Language.Haskell.TH.Syntax as TH -- | A compact representation of a 'Word8' vector. @@ -282,54 +254,41 @@ -- 'ByteString' (at the cost of copying the string data). It supports very few -- other 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. - +newtype ShortByteString = + -- | @since 0.12.0.0 + ShortByteString + { unShortByteString :: ByteArray + -- ^ @since 0.12.0.0 + } + deriving (Eq, TH.Lift, Data, Generic, NFData) -instance Eq ShortByteString where - (==) = equateBytes +-- | 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 NFData ShortByteString where - rnf SBS{} = () - instance Show ShortByteString where showsPrec p ps r = showsPrec p (unpackChars ps) r @@ -339,20 +298,15 @@ -- | @since 0.10.12.0 instance GHC.Exts.IsList ShortByteString where type Item ShortByteString = Word8 - fromList = packBytes - toList = unpack + 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 -instance Data ShortByteString where - gfoldl f z txt = z packBytes `f` unpack txt - toConstr _ = error "Data.ByteString.Short.ShortByteString.toConstr" - gunfold _ _ = error "Data.ByteString.Short.ShortByteString.gunfold" - dataTypeOf _ = mkNoRepType "Data.ByteString.Short.ShortByteString" - ------------------------------------------------------------------------ -- Simple operations @@ -362,7 +316,7 @@ -- | /O(1)/ The length of a 'ShortByteString'. length :: ShortByteString -> Int -length (unSBS -> barr#) = I# (sizeofByteArray# barr#) +length (SBS barr#) = I# (sizeofByteArray# barr#) -- | /O(1)/ Test whether a 'ShortByteString' is empty. null :: ShortByteString -> Bool @@ -405,28 +359,18 @@ moduleError "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# = - -- createFromPtr allocates, so accursedUnutterablePerformIO is wrong - unsafeDupablePerformIO $ createFromPtr (Ptr addr#) len - ------------------------------------------------------------------------ -- Internal utils -asBA :: ShortByteString -> BA -asBA (unSBS -> ba#) = BA# ba# - -unSBS :: ShortByteString -> ByteArray# -unSBS (SBS ba#) = ba# +asBA :: ShortByteString -> ByteArray +asBA (ShortByteString ba) = ba -create :: Int -> (forall s. MBA s -> ST s ()) -> ShortByteString +create :: Int -> (forall s. MutableByteArray s -> ST s ()) -> ShortByteString create len fill = - runST $ do + assert (len >= 0) $ runST $ do mba <- newByteArray len fill mba - BA# ba# <- unsafeFreezeByteArray mba - return (SBS ba#) + ShortByteString <$> unsafeFreezeByteArray mba {-# INLINE create #-} -- | Given the maximum size needed and a function to make the contents @@ -434,67 +378,60 @@ -- 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. MBA s -> ST s (Int, a)) -> (ShortByteString, a) -createAndTrim l fill = - runST $ do - mba <- newByteArray l - (l', res) <- fill mba - if assert (l' <= l) $ l' >= l +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# ba# <- unsafeFreezeByteArray mba - return (SBS ba#, res) + ba <- unsafeFreezeByteArray mba + return (ShortByteString ba, res) else do - mba2 <- newByteArray l' - copyMutableByteArray mba 0 mba2 0 l' - BA# ba# <- unsafeFreezeByteArray mba2 - return (SBS ba#, res) + mba2 <- newByteArray len + copyMutableByteArray mba 0 mba2 0 len + ba <- unsafeFreezeByteArray mba2 + return (ShortByteString ba, res) {-# INLINE createAndTrim #-} -createAndTrim' :: Int -> (forall s. MBA s -> ST s Int) -> ShortByteString -createAndTrim' l fill = - runST $ do - mba <- newByteArray l - l' <- fill mba - if assert (l' <= l) $ l' >= l +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 - BA# ba# <- unsafeFreezeByteArray mba - return (SBS ba#) + ShortByteString <$> unsafeFreezeByteArray mba else do - mba2 <- newByteArray l' - copyMutableByteArray mba 0 mba2 0 l' - BA# ba# <- unsafeFreezeByteArray mba2 - return (SBS ba#) + mba2 <- newByteArray len + copyMutableByteArray mba 0 mba2 0 len + ShortByteString <$> unsafeFreezeByteArray mba2 {-# INLINE createAndTrim' #-} -createAndTrim'' :: Int -> (forall s. MBA s -> MBA s -> ST s (Int, Int)) -> (ShortByteString, ShortByteString) -createAndTrim'' l fill = +-- | 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 l - mba2 <- newByteArray l - (l1, l2) <- fill mba1 mba2 - sbs1 <- freeze' l1 mba1 - sbs2 <- freeze' l2 mba2 + 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 -> MBA s -> ST s ShortByteString - freeze' l' mba = - if assert (l' <= l) $ l' >= l + freeze' :: Int -> Int -> MutableByteArray s -> ST s ShortByteString + freeze' len maxLen mba = + if assert (0 <= len && len <= maxLen) $ len >= maxLen then do - BA# ba# <- unsafeFreezeByteArray mba - return (SBS ba#) + ShortByteString <$> unsafeFreezeByteArray mba else do - mba2 <- newByteArray l' - copyMutableByteArray mba 0 mba2 0 l' - BA# ba# <- unsafeFreezeByteArray mba2 - return (SBS ba#) -{-# INLINE createAndTrim'' #-} + mba2 <- newByteArray len + copyMutableByteArray mba 0 mba2 0 len + ShortByteString <$> unsafeFreezeByteArray mba2 +{-# INLINE createAndTrim2 #-} isPinned :: ByteArray# -> Bool -#if MIN_VERSION_base(4,10,0) isPinned ba# = isTrue# (isByteArrayPinned# ba#) -#else -isPinned _ = False -#endif ------------------------------------------------------------------------ -- Conversion to and from ByteString @@ -509,31 +446,21 @@ 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#) + 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 (unSBS -> b#) - | isPinned b# = BS fp len - where - addr# = byteArrayContents# b# - fp = ForeignPtr addr# (PlainPtr (unsafeCoerce# b#)) - len = I# (sizeofByteArray# b#) -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) +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' -- @@ -575,7 +502,7 @@ packLenBytes len ws0 = create len (\mba -> go mba 0 ws0) where - go :: MBA s -> Int -> [Word8] -> ST s () + go :: MutableByteArray s -> Int -> [Word8] -> ST s () go !_ !_ [] = return () go !mba !i (w:ws) = do writeWord8Array mba i w @@ -648,13 +575,6 @@ ------------------------------------------------------------------------ -- Eq and Ord implementations -equateBytes :: ShortByteString -> ShortByteString -> Bool -equateBytes sbs1 sbs2 = - let !len1 = length sbs1 - !len2 = length sbs2 - in len1 == len2 - && 0 == compareByteArrays (asBA sbs1) (asBA sbs2) len1 - compareBytes :: ShortByteString -> ShortByteString -> Ordering compareBytes sbs1 sbs2 = let !len1 = length sbs1 @@ -667,7 +587,6 @@ | len2 < len1 -> GT | otherwise -> EQ - ------------------------------------------------------------------------ -- Appending and concatenation @@ -675,7 +594,7 @@ append src1 src2 = let !len1 = length src1 !len2 = length src2 - in create (len1 + len2) $ \dst -> do + in create (checkedAdd "Short.append" len1 len2) $ \dst -> do copyByteArray (asBA src1) 0 dst 0 len1 copyByteArray (asBA src2) 0 dst len1 len2 @@ -683,10 +602,11 @@ concat = \sbss -> create (totalLen 0 sbss) (\dst -> copy dst 0 sbss) where - totalLen !acc [] = acc - totalLen !acc (sbs: sbss) = totalLen (acc + length sbs) sbss + totalLen !acc [] = acc + totalLen !acc (curr : rest) + = totalLen (checkedAdd "Short.concat" acc $ length curr) rest - copy :: MBA s -> Int -> [ShortByteString] -> ST s () + copy :: MutableByteArray s -> Int -> [ShortByteString] -> ST s () copy !_ !_ [] = return () copy !dst !off (src : sbss) = do let !len = length src @@ -705,11 +625,11 @@ -- -- @since 0.11.3.0 snoc :: ShortByteString -> Word8 -> ShortByteString -snoc = \sbs c -> let l = length sbs - nl = l + 1 - in create nl $ \mba -> do - copyByteArray (asBA sbs) 0 mba 0 l - writeWord8Array mba l c +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. -- @@ -717,11 +637,11 @@ -- -- @since 0.11.3.0 cons :: Word8 -> ShortByteString -> ShortByteString -cons c = \sbs -> let l = length sbs - nl = l + 1 - in create nl $ \mba -> do +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 l + 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. @@ -817,7 +737,7 @@ ba = asBA sbs in create l (\mba -> go ba mba 0 l) where - go :: BA -> MBA s -> Int -> Int -> ST s () + go :: ByteArray -> MutableByteArray s -> Int -> Int -> ST s () go !ba !mba !i !l | i >= l = return () | otherwise = do @@ -833,11 +753,10 @@ reverse = \sbs -> let l = length sbs ba = asBA sbs --- https://gitlab.haskell.org/ghc/ghc/-/issues/21015 -#if MIN_VERSION_base(4,12,0) && defined(SAFE_UNALIGNED) +#if HS_UNALIGNED_ByteArray_OPS_OK in create l (\mba -> go ba mba l) where - go :: forall s. BA -> MBA s -> Int -> ST s () + 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 @@ -870,7 +789,7 @@ #else in create l (\mba -> go ba mba 0 l) where - go :: BA -> MBA s -> Int -> Int -> ST s () + go :: ByteArray -> MutableByteArray s -> Int -> Int -> ST s () go !ba !mba !i !l | i >= l = return () | otherwise = do @@ -897,7 +816,7 @@ ba = asBA sep lba = length sep - go :: MBA s -> Int -> [ShortByteString] -> ST s () + go :: MutableByteArray s -> Int -> [ShortByteString] -> ST s () go _ _ [] = pure () go mba !off (chunk:chunks) = do let lc = length chunk @@ -1319,7 +1238,7 @@ | otherwise -> createAndTrim i $ \mba -> go mba x0 0 where - go :: forall s. MBA s -> a -> Int -> ST s (Int, Maybe a) + 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) @@ -1344,6 +1263,7 @@ 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 @@ -1471,8 +1391,8 @@ in if | l <= 0 -> sbs | otherwise -> createAndTrim' l $ \mba -> go mba (asBA sbs) l where - go :: forall s. MBA s -- mutable output bytestring - -> BA -- input bytestring + 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 @@ -1513,14 +1433,14 @@ -- -- @since 0.11.3.0 partition :: (Word8 -> Bool) -> ShortByteString -> (ShortByteString, ShortByteString) -partition k = \sbs -> let l = length sbs - in if | l <= 0 -> (sbs, sbs) - | otherwise -> createAndTrim'' l $ \mba1 mba2 -> go mba1 mba2 (asBA sbs) l +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. - MBA s -- mutable output bytestring1 - -> MBA s -- mutable output bytestring2 - -> BA -- input bytestring + 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 @@ -1550,7 +1470,7 @@ -- -- @since 0.11.3.0 elemIndex :: Word8 -> ShortByteString -> Maybe Int -elemIndex c = \sbs@(unSBS -> ba#) -> do +elemIndex c = \sbs@(SBS ba#) -> do let l = length sbs accursedUnutterablePerformIO $ do !s <- c_elem_index ba# c (fromIntegral l) @@ -1568,8 +1488,8 @@ -- -- @since 0.11.3.0 count :: Word8 -> ShortByteString -> Int -count w = \sbs@(unSBS -> ba#) -> accursedUnutterablePerformIO $ - fromIntegral <$> c_count ba# (fromIntegral $ length sbs) w +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 @@ -1602,8 +1522,6 @@ | otherwise = go (n + 1) in go 0 - - ------------------------------------------------------------------------ -- Exported low level operations @@ -1623,76 +1541,68 @@ stToIO $ do mba <- newByteArray len copyAddrToByteArray ptr mba 0 len - BA# ba# <- unsafeFreezeByteArray mba - return (SBS ba#) + ShortByteString <$> unsafeFreezeByteArray mba ------------------------------------------------------------------------ -- 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#) +indexCharArray :: ByteArray -> Int -> Char +indexCharArray (ByteArray ba#) (I# i#) = C# (indexCharArray# ba# i#) -indexWord8Array :: BA -> Int -> Word8 -indexWord8Array (BA# ba#) (I# i#) = W8# (indexWord8Array# ba# i#) +indexWord8Array :: ByteArray -> Int -> Word8 +indexWord8Array (ByteArray ba#) (I# i#) = W8# (indexWord8Array# ba# i#) -#if MIN_VERSION_base(4,12,0) && defined(SAFE_UNALIGNED) -indexWord8ArrayAsWord64 :: BA -> Int -> Word64 -indexWord8ArrayAsWord64 (BA# ba#) (I# i#) = W64# (indexWord8ArrayAsWord64# 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 (MBA s) -newByteArray (I# len#) = +newByteArray :: Int -> ST s (MutableByteArray s) +newByteArray len@(I# len#) = + assert (len >= 0) $ 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# #) + (# s', mba# #) -> (# s', MutableByteArray mba# #) -unsafeFreezeByteArray :: MBA s -> ST s BA -unsafeFreezeByteArray (MBA# mba#) = +unsafeFreezeByteArray :: MutableByteArray s -> ST s ByteArray +unsafeFreezeByteArray (MutableByteArray mba#) = ST $ \s -> case unsafeFreezeByteArray# mba# s of - (# s', ba# #) -> (# s', BA# ba# #) + (# s', ba# #) -> (# s', ByteArray ba# #) -writeWord8Array :: MBA s -> Int -> Word8 -> ST s () -writeWord8Array (MBA# mba#) (I# i#) (W8# w#) = +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 MIN_VERSION_base(4,12,0) && defined(SAFE_UNALIGNED) -writeWord64Array :: MBA s -> Int -> Word64 -> ST s () -writeWord64Array (MBA# mba#) (I# i#) (W64# w#) = +#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 -> MBA RealWorld -> Int -> Int -> ST RealWorld () -copyAddrToByteArray (Ptr src#) (MBA# dst#) (I# dst_off#) (I# len#) = +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 :: BA -> Int -> Ptr a -> Int -> ST RealWorld () -copyByteArrayToAddr (BA# src#) (I# src_off#) (Ptr dst#) (I# len#) = +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 :: BA -> Int -> MBA s -> Int -> Int -> ST s () -copyByteArray (BA# src#) (I# src_off#) (MBA# dst#) (I# dst_off#) (I# len#) = +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 :: MBA s -> Int -> Int -> Int -> ST s () -setByteArray (MBA# dst#) (I# off#) (I# len#) (I# c#) = +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 :: MBA s -> Int -> MBA s -> Int -> Int -> ST s () -copyMutableByteArray (MBA# src#) (I# src_off#) (MBA# dst#) (I# dst_off#) (I# len#) = +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', () #) @@ -1700,41 +1610,18 @@ ------------------------------------------------------------------------ -- FFI imports -- -compareByteArrays :: BA -> BA -> Int -> Int +compareByteArrays :: ByteArray -> ByteArray -> Int -> Int compareByteArrays ba1 ba2 = compareByteArraysOff ba1 0 ba2 0 -compareByteArraysOff :: BA -- ^ array 1 +compareByteArraysOff :: ByteArray -- ^ array 1 -> Int -- ^ offset for array 1 - -> BA -- ^ array 2 + -> ByteArray -- ^ array 2 -> Int -- ^ offset for array 2 -> Int -- ^ length to compare -> Int -- ^ like memcmp -#if MIN_VERSION_base(4,11,0) -compareByteArraysOff (BA# ba1#) (I# ba1off#) (BA# ba2#) (I# ba2off#) (I# len#) = +compareByteArraysOff (ByteArray ba1#) (I# ba1off#) (ByteArray ba2#) (I# ba2off#) (I# len#) = I# (compareByteArrays# ba1# ba1off# ba2# ba2off# len#) -#else -compareByteArraysOff (BA# ba1#) ba1off (BA# ba2#) ba2off len = - assert (ba1off + len <= (I# (sizeofByteArray# ba1#))) - $ assert (ba2off + len <= (I# (sizeofByteArray# ba2#))) - $ fromIntegral $ accursedUnutterablePerformIO $ - c_memcmp_ByteArray ba1# - ba1off - ba2# - ba2off - (fromIntegral len) - -foreign import ccall unsafe "static sbs_memcmp_off" - c_memcmp_ByteArray :: ByteArray# -> Int -> ByteArray# -> Int -> CSize -> IO CInt -#endif - -foreign import ccall unsafe "static sbs_elem_index" - c_elem_index :: ByteArray# -> Word8 -> CSize -> IO CPtrdiff - -foreign import ccall unsafe "static fpstring.h fps_count" c_count - :: ByteArray# -> CSize -> Word8 -> IO CSize - - ------------------------------------------------------------------------ -- Primop replacements @@ -1793,10 +1680,14 @@ 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@. +-- | /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 = @@ -1809,7 +1700,7 @@ -- -- @since 0.11.3.0 isValidUtf8 :: ShortByteString -> Bool -isValidUtf8 sbs@(unSBS -> ba#) = accursedUnutterablePerformIO $ do +isValidUtf8 sbs@(SBS ba#) = accursedUnutterablePerformIO $ do let n = length sbs -- Use a safe FFI call for large inputs to avoid GC synchronization pauses -- in multithreaded contexts. @@ -1818,22 +1709,11 @@ -- When changing this function, also consider changing the related function: -- Data.ByteString.isValidUtf8 i <- if n < 1000000 || not (isPinned ba#) - then cIsValidUtf8 ba# (fromIntegral n) - else cIsValidUtf8Safe ba# (fromIntegral n) + then cIsValidUtf8BA ba# (fromIntegral n) + else cIsValidUtf8BASafe ba# (fromIntegral n) IO (\s -> (# touch# ba# s, () #)) return $ i /= 0 --- 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" cIsValidUtf8 - :: ByteArray# -> CSize -> IO CInt - -foreign import ccall safe "bytestring_is_valid_utf8" cIsValidUtf8Safe - :: ByteArray# -> CSize -> IO CInt - -- --------------------------------------------------------------------- -- Internal utilities @@ -1873,7 +1753,7 @@ packLenBytesRev len ws0 = create len (\mba -> go mba len ws0) where - go :: MBA s -> Int -> [Word8] -> ST s () + go :: MutableByteArray s -> Int -> [Word8] -> ST s () go !_ !_ [] = return () go !mba !i (w:ws) = do writeWord8Array mba (i - 1) w diff --git a/Data/ByteString/Unsafe.hs b/Data/ByteString/Unsafe.hs --- a/Data/ByteString/Unsafe.hs +++ b/Data/ByteString/Unsafe.hs @@ -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) -- --------------------------------------------------------------------- -- diff --git a/Data/ByteString/Utils/ByteOrder.hs b/Data/ByteString/Utils/ByteOrder.hs new file mode 100644 --- /dev/null +++ b/Data/ByteString/Utils/ByteOrder.hs @@ -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 diff --git a/Data/ByteString/Utils/UnalignedAccess.hs b/Data/ByteString/Utils/UnalignedAccess.hs new file mode 100644 --- /dev/null +++ b/Data/ByteString/Utils/UnalignedAccess.hs @@ -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 + diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -15,8 +15,8 @@ Requirements: - * Cabal 1.10 or greater - * GHC 8.0 or greater + * Cabal 2.2 or greater + * GHC 8.4 or greater ### Authors diff --git a/bench/BenchAll.hs b/bench/BenchAll.hs --- a/bench/BenchAll.hs +++ b/bench/BenchAll.hs @@ -7,18 +7,18 @@ -- 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 @@ -26,16 +26,17 @@ import qualified Data.ByteString.Lazy.Char8 as L8 import Data.ByteString.Builder -import Data.ByteString.Builder.Extra (byteStringCopy, - byteStringInsert, - intHost) -import Data.ByteString.Builder.Internal (ensureFree) +import qualified Data.ByteString.Builder.Extra as Extra +import qualified Data.ByteString.Builder.Internal as BI import Data.ByteString.Builder.Prim (BoundedPrim, FixedPrim, (>$<)) import qualified Data.ByteString.Builder.Prim as P import qualified Data.ByteString.Builder.Prim.Internal as PI import Foreign +import Foreign.ForeignPtr +import qualified GHC.Exts as Exts +import GHC.Ptr (Ptr(..)) import System.Random @@ -43,6 +44,7 @@ import BenchCount import BenchCSV import BenchIndices +import BenchReadInt import BenchShort ------------------------------------------------------------------------------ @@ -97,9 +99,12 @@ {-# NOINLINE smallChunksData #-} smallChunksData :: L.ByteString -smallChunksData - = L.fromChunks [S.take sz (S.drop n byteStringData) - | let sz = 48, n <- [0, sz .. S.length byteStringData]] +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] @@ -119,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 @@ -245,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" @@ -273,11 +343,11 @@ ] , bgroup "ByteString insertion" $ [ benchB "foldMap byteStringInsert" byteStringChunksData - (foldMap byteStringInsert) + (foldMap Extra.byteStringInsert) , benchB "foldMap byteString" byteStringChunksData (foldMap byteString) , benchB "foldMap byteStringCopy" byteStringChunksData - (foldMap byteStringCopy) + (foldMap Extra.byteStringCopy) ] , bgroup "Non-bounded encodings" @@ -417,7 +487,25 @@ [ 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 @@ -490,5 +578,6 @@ , benchCount , benchCSV , benchIndices + , benchReadInt , benchShort ] diff --git a/bench/BenchBoundsCheckFusion.hs b/bench/BenchBoundsCheckFusion.hs --- a/bench/BenchBoundsCheckFusion.hs +++ b/bench/BenchBoundsCheckFusion.hs @@ -8,8 +8,6 @@ -- -- Benchmark that the bounds checks fuse. -{-# LANGUAGE PackageImports, ScopedTypeVariables, BangPatterns #-} - module BenchBoundsCheckFusion (benchBoundsCheckFusion) where import Prelude hiding (words) diff --git a/bench/BenchCSV.hs b/bench/BenchCSV.hs --- a/bench/BenchCSV.hs +++ b/bench/BenchCSV.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + -- | -- Copyright : (c) 2010-2011 Simon Meier -- License : BSD3-style (see LICENSE) @@ -8,9 +10,6 @@ -- -- Running example for documentation of Data.ByteString.Builder -- - -{-# LANGUAGE CPP #-} -{-# LANGUAGE OverloadedStrings #-} module BenchCSV (benchCSV) where diff --git a/bench/BenchIndices.hs b/bench/BenchIndices.hs --- a/bench/BenchIndices.hs +++ b/bench/BenchIndices.hs @@ -6,8 +6,6 @@ -- -- Benchmark elemIndex, findIndex, elemIndices, and findIndices -{-# LANGUAGE BangPatterns #-} - module BenchIndices (benchIndices) where import Data.Foldable (foldMap) diff --git a/bench/BenchReadInt.hs b/bench/BenchReadInt.hs new file mode 100644 --- /dev/null +++ b/bench/BenchReadInt.hs @@ -0,0 +1,138 @@ +{-# LANGUAGE CPP #-} + +-- | +-- Copyright : (c) 2021 Viktor Dukhovni +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Viktor Dukhovni +-- +-- 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 diff --git a/bench/BenchShort.hs b/bench/BenchShort.hs --- a/bench/BenchShort.hs +++ b/bench/BenchShort.hs @@ -1,7 +1,3 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE PackageImports #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE MagicHash #-} {-# LANGUAGE OverloadedStrings #-} module BenchShort (benchShort) where diff --git a/bytestring.cabal b/bytestring.cabal --- a/bytestring.cabal +++ b/bytestring.cabal @@ -1,5 +1,7 @@ +Cabal-Version: 2.2 + Name: bytestring -Version: 0.11.5.4 +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) @@ -30,7 +32,8 @@ . There is also a 'ShortByteString' type which has a lower memory overhead and can be converted to or from a 'ByteString'. It is suitable for keeping - many short strings in memory. + 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,97 +57,147 @@ Maintainer: Haskell Bytestring Team , Core Libraries Committee Homepage: https://github.com/haskell/bytestring Bug-reports: https://github.com/haskell/bytestring/issues -Tested-With: GHC==9.4.1, - GHC==9.2.4, +Tested-With: GHC==9.10.1, + GHC==9.8.2, + GHC==9.6.5, + GHC==9.4.8, + GHC==9.2.8, GHC==9.0.2, GHC==8.10.7, GHC==8.8.4, GHC==8.6.5, - GHC==8.4.4, - GHC==8.2.2, - GHC==8.0.2 + GHC==8.4.4 Build-Type: Simple -Cabal-Version: >= 1.10 -extra-source-files: README.md Changelog.md +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.Internal.Type - 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 -Wincomplete-uni-patterns - -O2 - -fmax-simplifier-iterations=10 - -fdicts-cheap - -fspec-constr-count=6 - - c-sources: cbits/fpstring.c - cbits/itoa.c - cbits/shortbytestring.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 - - -- DNDEBUG disables asserts in cbits/ - cc-options: -std=c11 -DNDEBUG=1 - -fno-strict-aliasing - - -- No need to link to libgcc on ghc-9.4 and later which uses a clang-based - -- toolchain. - if os(windows) && impl(ghc < 9.3) - extra-libraries: 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 @@ -166,26 +219,30 @@ build-depends: base, bytestring, deepseq, - ghc-prim, QuickCheck, tasty, 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 diff --git a/cbits/aligned-static-hs-data.c b/cbits/aligned-static-hs-data.c new file mode 100644 --- /dev/null +++ b/cbits/aligned-static-hs-data.c @@ -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 + +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 +}; diff --git a/cbits/fpstring.c b/cbits/fpstring.c --- a/cbits/fpstring.c +++ b/cbits/fpstring.c @@ -29,6 +29,9 @@ * SUCH DAMAGE. */ +#include "HsFFI.h" +#include "MachDeps.h" + #include "fpstring.h" #if defined(__x86_64__) #include @@ -104,6 +107,37 @@ void fps_sort(unsigned char *p, size_t len) { return qsort(p, len, 1, fps_compare); +} + +// 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 */ diff --git a/cbits/shortbytestring.c b/cbits/shortbytestring.c --- a/cbits/shortbytestring.c +++ b/cbits/shortbytestring.c @@ -1,26 +1,12 @@ #include #include +#include #include -int -sbs_memcmp_off(const void *s1, - size_t off1, - const void *s2, - size_t off2, - size_t n) -{ - const void *s1o = s1 + off1; - const void *s2o = s2 + off2; - - int r = memcmp(s1o, s2o, n); - - return r; -} - ptrdiff_t sbs_elem_index(const void *s, - int c, + uint8_t c, size_t n) { const void *so = memchr(s, c, n); diff --git a/include/bytestring-cpp-macros.h b/include/bytestring-cpp-macros.h new file mode 100644 --- /dev/null +++ b/include/bytestring-cpp-macros.h @@ -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) diff --git a/tests/IsValidUtf8.hs b/tests/IsValidUtf8.hs --- a/tests/IsValidUtf8.hs +++ b/tests/IsValidUtf8.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE LambdaCase #-} - module IsValidUtf8 (testSuite) where import Data.Bits (shiftR, (.&.), shiftL) diff --git a/tests/Lift.hs b/tests/Lift.hs --- a/tests/Lift.hs +++ b/tests/Lift.hs @@ -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 diff --git a/tests/Properties.hs b/tests/Properties.hs --- a/tests/Properties.hs +++ b/tests/Properties.hs @@ -1,6 +1,9 @@ -{-# 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 @@ -22,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) @@ -47,7 +52,6 @@ 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 @@ -97,15 +101,228 @@ 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 @@ -233,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" @@ -241,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" @@ -249,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" @@ -257,7 +474,7 @@ D.writeFile fn x y <- D.readFile fn D.length y `seq` removeFile fn - return (x == y) + return (x === y) ------------------------------------------------------------------------ @@ -268,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" @@ -277,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" @@ -286,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" @@ -295,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" == @@ -417,6 +634,7 @@ , 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 @@ -437,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 @@ -475,10 +704,14 @@ , 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 = diff --git a/tests/Properties/ByteString.hs b/tests/Properties/ByteString.hs --- a/tests/Properties/ByteString.hs +++ b/tests/Properties/ByteString.hs @@ -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, @@ -36,8 +43,6 @@ import qualified Data.ByteString.Lazy as B #endif -import Data.Word - #else #ifndef BYTESTRING_LAZY @@ -50,6 +55,9 @@ #define BYTESTRING_TYPE B.ByteString #endif +import Data.Int +import Numeric.Natural (Natural) + import Text.Read #endif @@ -57,24 +65,76 @@ 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" $ @@ -203,10 +263,8 @@ \x y -> B.unpack (mappend x y) === B.unpack x `mappend` B.unpack y , testProperty "<>" $ \x y -> B.unpack (x <> y) === B.unpack x <> B.unpack y -#ifndef BYTESTRING_SHORT , testProperty "stimes" $ - \(Sqrt (NonNegative n)) (Sqrt x) -> stimes (n :: Int) (x :: BYTESTRING_TYPE) === mtimesDefault n x -#endif + \(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) @@ -261,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" $ @@ -278,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" $ @@ -295,11 +353,11 @@ #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)) @@ -309,7 +367,7 @@ , testProperty "toChunks . fromChunks" $ \xs -> B.toChunks (B.fromChunks xs) === filter (/= mempty) xs , testProperty "append lazy" $ - \(toElem -> c) -> B.head (B.singleton c <> undefined) === c + \(toElem -> c) -> B.head (B.singleton c <> tooStrictErr) === c , testProperty "compareLength 1" $ \x -> B.compareLength x (B.length x) === EQ , testProperty "compareLength 2" $ @@ -319,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" $ @@ -423,7 +481,8 @@ (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)" $ @@ -542,30 +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 $ @@ -612,6 +694,18 @@ , 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) @@ -648,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 diff --git a/tests/QuickCheckUtils.hs b/tests/QuickCheckUtils.hs --- a/tests/QuickCheckUtils.hs +++ b/tests/QuickCheckUtils.hs @@ -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,6 +19,8 @@ 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 @@ -51,6 +54,8 @@ (sizedByteString (n `div` numChunks)) + shrink = map L.fromChunks . shrink . L.toChunks + instance CoArbitrary L.ByteString where coarbitrary s = coarbitrary (L.unpack s) @@ -112,3 +117,26 @@ 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" diff --git a/tests/builder/Data/ByteString/Builder/Prim/TestUtils.hs b/tests/builder/Data/ByteString/Builder/Prim/TestUtils.hs --- a/tests/builder/Data/ByteString/Builder/Prim/TestUtils.hs +++ b/tests/builder/Data/ByteString/Builder/Prim/TestUtils.hs @@ -1,5 +1,5 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE ScopedTypeVariables #-} + -- | -- Copyright : (c) 2011 Simon Meier -- License : BSD3-style (see LICENSE) diff --git a/tests/builder/Data/ByteString/Builder/Prim/Tests.hs b/tests/builder/Data/ByteString/Builder/Prim/Tests.hs --- a/tests/builder/Data/ByteString/Builder/Prim/Tests.hs +++ b/tests/builder/Data/ByteString/Builder/Prim/Tests.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE MagicHash #-} - -- | -- Copyright : (c) 2011 Simon Meier -- License : BSD3-style (see LICENSE) diff --git a/tests/builder/Data/ByteString/Builder/Tests.hs b/tests/builder/Data/ByteString/Builder/Tests.hs --- a/tests/builder/Data/ByteString/Builder/Tests.hs +++ b/tests/builder/Data/ByteString/Builder/Tests.hs @@ -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 ]