diff --git a/.github/workflows/windows_and_macOS.yml b/.github/workflows/windows_and_macOS.yml index e37523a7..4ef1a083 100644 --- a/.github/workflows/windows_and_macOS.yml +++ b/.github/workflows/windows_and_macOS.yml @@ -12,7 +12,7 @@ jobs: runs-on: ${{ matrix.os }} strategy: matrix: - os: ['windows-latest', 'macOS-latest'] + os: ['windows-latest', 'macOS-15'] ghc: ['latest'] fail-fast: false steps: diff --git a/benchmarks/haskell/Benchmarks/Builder.hs b/benchmarks/haskell/Benchmarks/Builder.hs index 5a7018a5..5e11af17 100644 --- a/benchmarks/haskell/Benchmarks/Builder.hs +++ b/benchmarks/haskell/Benchmarks/Builder.hs @@ -16,6 +16,7 @@ import qualified Data.Text.Lazy as LT import qualified Data.Text.Lazy.Builder as LTB import qualified Data.Text.Lazy.Builder.Int as Int import Data.Int (Int64) +import Numeric (showHex) benchmark :: Benchmark benchmark = bgroup "Builder" @@ -38,6 +39,18 @@ benchmark = bgroup "Builder" (bench (show (length (show n))) $ nf show n) ] ] + , bgroup "decInteger" + [ bench "Txt64" $ nf (LTB.toLazyText . Int.decimalInteger) (10 ^ (64 :: Int) :: Integer) + , bench "Str64" $ nf (LTB.toLazyText . LTB.fromString . show) (10 ^ (64 :: Int) :: Integer) + , bench "Txt6400" $ nf (LTB.toLazyText . Int.decimalInteger) (10 ^ (6400 :: Int) :: Integer) + , bench "Str6400" $ nf (LTB.toLazyText . LTB.fromString . show) (10 ^ (6400 :: Int) :: Integer) + ] + , bgroup "hexInteger" + [ bench "Txt64" $ nf (LTB.toLazyText . Int.hexadecimalInteger) (10 ^ (64 :: Int) :: Integer) + , bench "Str64" $ nf (LTB.toLazyText . LTB.fromString . flip showHex "") (10 ^ (64 :: Int) :: Integer) + , bench "Txt6400" $ nf (LTB.toLazyText . Int.hexadecimalInteger) (10 ^ (6400 :: Int) :: Integer) + , bench "Str6400" $ nf (LTB.toLazyText . LTB.fromString . flip showHex "") (10 ^ (6400 :: Int) :: Integer) + ] ] where numbers :: [Int64] diff --git a/src/Data/Text/Internal/Builder/Int/Digits.hs b/src/Data/Text/Internal/Builder/Int/Digits.hs index 7c698c0a..a453b00d 100644 --- a/src/Data/Text/Internal/Builder/Int/Digits.hs +++ b/src/Data/Text/Internal/Builder/Int/Digits.hs @@ -12,8 +12,9 @@ -- This module exists because the C preprocessor does things that we -- shall not speak of when confronted with Haskell multiline strings. -module Data.Text.Internal.Builder.Int.Digits (digits) where +module Data.Text.Internal.Builder.Int.Digits (digits, Base(..), base10, base16) where +import Data.Bits (finiteBitSize) import Data.ByteString.Char8 (ByteString, pack) digits :: ByteString @@ -23,3 +24,30 @@ digits = pack \4041424344454647484950515253545556575859\ \6061626364656667686970717273747576777879\ \8081828384858687888990919293949596979899" + +data Base = Base + { base :: !Word + , maxWord :: !Integer + -- ^ Greatest power of @b@ whose remainders are representable as an @Word@ + , maxDigits :: !Int + -- ^ Number of base-@b@ digits to represent numbers smaller than @maxWord@ + } + +base10 :: Base +base10 = Base + { base = 10 + , maxWord = 10 ^ maxDigits10 + , maxDigits = maxDigits10 + } where + -- log_10 2 = 0.301... > 3/10 + -- In general this is an underapproximation, and it is close enough that + -- the rounding makes it exact for 64-bit words. + maxDigits10 = finiteBitSize (0 :: Word) * 3 `div` 10 + +base16 :: Base +base16 = Base + { base = 16 + , maxWord = 16 ^ maxDigits16 + , maxDigits = maxDigits16 + } where + maxDigits16 = finiteBitSize (0 :: Word) `div` 4 diff --git a/src/Data/Text/Lazy/Builder/Int.hs b/src/Data/Text/Lazy/Builder/Int.hs index e3ccf026..a4dc6676 100644 --- a/src/Data/Text/Lazy/Builder/Int.hs +++ b/src/Data/Text/Lazy/Builder/Int.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE BangPatterns, RankNTypes, ScopedTypeVariables #-} +{-# LANGUAGE BangPatterns, NamedFieldPuns, RankNTypes, ScopedTypeVariables #-} {-# LANGUAGE Trustworthy #-} -- Module: Data.Text.Lazy.Builder.Int @@ -14,6 +14,9 @@ module Data.Text.Lazy.Builder.Int ( decimal , hexadecimal + , integer + , decimalInteger + , hexadecimalInteger ) where import Data.Int (Int8, Int16, Int32, Int64) @@ -21,10 +24,9 @@ import Data.Monoid (mempty) import qualified Data.ByteString.Unsafe as B import Data.Text.Internal.Builder.Functions (i2d) import Data.Text.Internal.Builder -import Data.Text.Internal.Builder.Int.Digits (digits) +import Data.Text.Internal.Builder.Int.Digits (digits, Base(..), base10, base16) import Data.Text.Array import Data.Word (Word, Word8, Word16, Word32, Word64) -import GHC.Base (quotInt, remInt) import Control.Monad.ST decimal :: Integral a => a -> Builder @@ -38,7 +40,7 @@ decimal :: Integral a => a -> Builder {-# RULES "decimal/Word16" decimal = positive :: Word16 -> Builder #-} {-# RULES "decimal/Word32" decimal = positive :: Word32 -> Builder #-} {-# RULES "decimal/Word64" decimal = positive :: Word64 -> Builder #-} -{-# RULES "decimal/Integer" decimal = integer 10 :: Integer -> Builder #-} +{-# RULES "decimal/Integer" decimal = decimalInteger :: Integer -> Builder #-} decimal i = decimal' (<= -128) i {-# NOINLINE decimal #-} @@ -161,7 +163,7 @@ hexadecimal i hexInteger :: Integer -> Builder hexInteger i | i < 0 = error hexErrMsg - | otherwise = integer 16 i + | otherwise = hexadecimalInteger i hexErrMsg :: String hexErrMsg = "Data.Text.Lazy.Builder.Int.hexadecimal: applied to negative number" @@ -172,19 +174,21 @@ hexDigit n | otherwise = singleton $! toEnum (fromIntegral n + 87) {-# INLINE hexDigit #-} -data T = T !Integer !Int +decimalInteger :: Integer -> Builder +decimalInteger = integer base10 boundedDecimal boundedDecimal -integer :: Int -> Integer -> Builder -integer 10 i - | i' <- fromInteger i, toInteger i' == i = decimal (i' :: Int) -integer 16 i - | i' <- fromInteger i, toInteger i' == i = hexadecimal (i' :: Int) -integer base i +hexadecimalInteger :: Integer -> Builder +hexadecimalInteger = integer base16 hexadecimal hexadecimal + +{-# INLINE integer #-} +integer :: Base -> (Int -> Builder) -> (Word -> Builder) -> Integer -> Builder +integer _ fromInt _ i + | i' <- fromInteger i, toInteger i' == i = fromInt i' +integer (Base { base, maxWord, maxDigits }) _ fromWord i | i < 0 = singleton '-' <> go (-i) | otherwise = go i where - go n | n < maxInt = int (fromInteger n) - | otherwise = putH (splitf (maxInt * maxInt) n) + go n = putH (splitf (maxWord * maxWord) n) splitf p n | p > n = [n] @@ -199,42 +203,23 @@ integer base i (q, r) -> q : r : splitb p ns splitb _ _ = [] - T maxInt10 maxDigits10 = - until ((>mi) . (*10) . fstT) (\(T n d) -> T (n*10) (d+1)) (T 10 1) - where mi = toInteger (maxBound :: Int) - T maxInt16 maxDigits16 = - until ((>mi) . (*16) . fstT) (\(T n d) -> T (n*16) (d+1)) (T 16 1) - where mi = toInteger (maxBound :: Int) - - fstT (T a _) = a - - maxInt | base == 10 = maxInt10 - | otherwise = maxInt16 - maxDigits | base == 10 = maxDigits10 - | otherwise = maxDigits16 - - putH (n:ns) = case n `quotRem` maxInt of + putH (n:ns) = case n `quotRem` maxWord of (x, y) - | q > 0 -> int q <> pblock r <> putB ns - | otherwise -> int r <> putB ns + | q > 0 -> fromWord q <> pblock r <> putB ns + | otherwise -> fromWord r <> putB ns where q = fromInteger x r = fromInteger y putH _ = error "putH: the impossible happened" - putB (n:ns) = case n `quotRem` maxInt of + putB (n:ns) = case n `quotRem` maxWord of (x, y) -> pblock q <> pblock r <> putB ns where q = fromInteger x r = fromInteger y putB _ = Data.Monoid.mempty - int :: Int -> Builder - int x | base == 10 = decimal x - | otherwise = hexadecimal x - pblock = loop maxDigits where loop !d !n | d == 1 = hexDigit n | otherwise = loop (d-1) q <> hexDigit r - where q = n `quotInt` base - r = n `remInt` base + where (q, r) = n `quotRem` base diff --git a/tests/Tests/Properties/Builder.hs b/tests/Tests/Properties/Builder.hs index ee38b46b..ba4cfe06 100644 --- a/tests/Tests/Properties/Builder.hs +++ b/tests/Tests/Properties/Builder.hs @@ -62,6 +62,7 @@ tb_hex :: (Integral a, Show a) => a -> Property tb_hex = (TB.toLazyText . TB.hexadecimal) `eq` (TL.pack . flip showHex "") tb_hexadecimal_integer (a::Integer) = tb_hex a +tb_hexadecimal_integer_big (Big a) = tb_hex a tb_hexadecimal_int (a::Int) = tb_hex a tb_hexadecimal_int8 (a::Int8) = tb_hex a tb_hexadecimal_int16 (a::Int16) = tb_hex a @@ -134,6 +135,7 @@ testBuilder = testProperty "tb_hexadecimal_int32" tb_hexadecimal_int32, testProperty "tb_hexadecimal_int64" tb_hexadecimal_int64, testProperty "tb_hexadecimal_integer" tb_hexadecimal_integer, + testProperty "tb_hexadecimal_integer_big" tb_hexadecimal_integer_big, testProperty "tb_hexadecimal_word" tb_hexadecimal_word, testProperty "tb_hexadecimal_word8" tb_hexadecimal_word8, testProperty "tb_hexadecimal_word16" tb_hexadecimal_word16, diff --git a/tests/Tests/QuickCheckUtils.hs b/tests/Tests/QuickCheckUtils.hs index 5c1c4275..f565dd67 100644 --- a/tests/Tests/QuickCheckUtils.hs +++ b/tests/Tests/QuickCheckUtils.hs @@ -112,7 +112,10 @@ newtype BigInt = Big Integer deriving (Eq, Show) instance Arbitrary BigInt where - arbitrary = choose (1::Int,200) >>= \e -> Big <$> choose (10^(e-1),10^e) + arbitrary = arbitrary >>= \sign -> + choose (1::Int,200) >>= \e -> + let s = if sign then id else negate in + Big . s <$> choose (10^(e-1),10^e) shrink (Big a) = [Big (a `div` 2^(l-e)) | e <- shrink l] where l = truncate (log (fromIntegral a) / log 2 :: Double) :: Integer