on master help sign in
Fix miscounting of digits (gh-99)
4482f29Bryan O'Sullivan
Data/Text/Lazy/Builder/Int.hs+11−3
@@ -1,4 +1,5 @@
1−{-# LANGUAGE BangPatterns, CPP, MagicHash, RankNTypes, UnboxedTuples #-}
1+{-# LANGUAGE BangPatterns, CPP, MagicHash, RankNTypes, ScopedTypeVariables,
2+ UnboxedTuples #-}
2#if __GLASGOW_HASKELL__ >= 702
3#if __GLASGOW_HASKELL__ >= 702
3{-# LANGUAGE Trustworthy #-}
4{-# LANGUAGE Trustworthy #-}
4#endif
5#endif
@@ -133,8 +134,15 @@ i2w v = zero + fromIntegral v
133
134
134countDigits :: (Integral a) => a -> Int
135countDigits :: (Integral a) => a -> Int
135{-# INLINE countDigits #-}
136{-# INLINE countDigits #-}
136−countDigits v0 = go 1 (fromIntegral v0 :: Word64)
137+countDigits v0
137− where go !k v
138+ | fromIntegral v64 == v0 = go 1 v64
139+ | otherwise = goBig 1 (fromIntegral v0)
140+ where v64 = fromIntegral v0
141+ goBig !k (v :: Integer)
142+ | v > big = goBig (k + 19) (v `quot` big)
143+ | otherwise = go k (fromIntegral v)
144+ big = 10000000000000000000
145+ go !k (v :: Word64)
138 | v < 10 = k
146 | v < 10 = k
139 | v < 100 = k + 1
147 | v < 100 = k + 1
140 | v < 1000 = k + 2
148 | v < 1000 = k + 2
tests/Tests/Properties.hs−32
@@ -758,36 +758,6 @@ tb_decimal_big_int64 (BigBounded (a::Int64)) = tb_decimal a
758tb_decimal_big_word (BigBounded (a::Word)) = tb_decimal a
758tb_decimal_big_word (BigBounded (a::Word)) = tb_decimal a
759tb_decimal_big_word64 (BigBounded (a::Word64)) = tb_decimal a
759tb_decimal_big_word64 (BigBounded (a::Word64)) = tb_decimal a
760
760
761−countDigits :: (Integral a) => a -> Int
762−countDigits v0
763− | v0 > max64 = big 20 (v0 `quot` 10000000000000000000)
764− | otherwise = go 1 (fromIntegral v0 :: Word64)
765− where
766− max64 = fromIntegral (maxBound :: Word64)
767− big !k v
768− | v > max64 = big (k+20) (v `quot` 10000000000000000000)
769− | otherwise = go k (fromIntegral v :: Word64)
770− go !k v
771− | v < 10 = k
772− | v < 100 = k + 1
773− | v < 1000 = k + 2
774− | v < 1000000000000 =
775− k + if v < 100000000
776− then if v < 1000000
777− then if v < 10000
778− then 3
779− else 4 + fin v 100000
780− else 6 + fin v 10000000
781− else if v < 10000000000
782− then 8 + fin v 1000000000
783− else 10 + fin v 100000000000
784− | otherwise = go (k + 12) (v `quot` 1000000000000)
785− fin v n = if v >= n then 1 else 0
786−
787−t_cd (Big k) = counterexample (show x ++ " /= " ++ show y) (x == y)
788− where x = countDigits k
789− y = length (show k)
790−
791tb_hex :: (Integral a, Show a) => a -> Bool
761tb_hex :: (Integral a, Show a) => a -> Bool
792tb_hex = (TB.toLazyText . TB.hexadecimal) `eq` (TL.pack . flip showHex "")
762tb_hex = (TB.toLazyText . TB.hexadecimal) `eq` (TL.pack . flip showHex "")
793
763
@@ -889,8 +859,6 @@ shorten n t@(S.Stream arr off len)
889tests :: Test
859tests :: Test
890tests =
860tests =
891 testGroup "Properties" [
861 testGroup "Properties" [
892− testProperty "t_cd" t_cd,
893−
894 testGroup "creation/elimination" [
862 testGroup "creation/elimination" [
895 testProperty "t_pack_unpack" t_pack_unpack,
863 testProperty "t_pack_unpack" t_pack_unpack,
896 testProperty "tl_pack_unpack" tl_pack_unpack,
864 testProperty "tl_pack_unpack" tl_pack_unpack,