Export decimalInteger and hexadecimalInteger and improve their efficiency

.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:

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]

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

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,17 +14,19 @@ module Data.Text.Lazy.Builder.Int
     (
       decimal
     , hexadecimal
+    , integer
+    , decimalInteger
+    , hexadecimalInteger
     ) where
 
 import Data.Int (Int8, Int16, Int32, Int64)
 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

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,

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