Add wordPaddedDec9

This commit is contained in:
Andrew Martin 2019-12-30 20:43:36 -05:00
parent 2b85e2cb84
commit ecde041d9d
3 changed files with 41 additions and 10 deletions

View file

@ -8,7 +8,7 @@
* Add `putManyConsLength`, useful for chunked HTTP encoding. * Add `putManyConsLength`, useful for chunked HTTP encoding.
* Add `runOnto` * Add `runOnto`
* Add `Data.Bytes.Chunks.length` * Add `Data.Bytes.Chunks.length`
* Add `wordPaddedTwoDigitDec` * Add `wordPaddedDec2` and `wordPaddedDec9`.
## 0.3.1.0 -- 2019-11-20 ## 0.3.1.0 -- 2019-11-20

View file

@ -52,7 +52,8 @@ module Data.ByteArray.Builder.Bounded
, ascii , ascii
, char , char
-- ** Native -- ** Native
, wordPaddedTwoDigitDec , wordPaddedDec2
, wordPaddedDec9
-- ** Machine-Readable -- ** Machine-Readable
-- *** One -- *** One
, word8 , word8
@ -528,18 +529,43 @@ word8LowerHex# w#
-- two digits. For example: 0 is encoded as @00@, 5 is encoded as @05@, and -- two digits. For example: 0 is encoded as @00@, 5 is encoded as @05@, and
-- 73 is encoded as @73@. -- 73 is encoded as @73@.
-- --
-- Precondition: Argument less than 100. Failure to satisfy this precondition -- Precondition: Argument must be less than 100. Failure to satisfy this
-- will not result in a segfault, but the resulting bytes are undefined. The -- precondition will not result in a segfault, but the resulting bytes are
-- implement uses a heuristic for division that is inaccurate for large -- undefined. The implemention uses a heuristic for division that is inaccurate
-- numbers. -- for large numbers.
wordPaddedTwoDigitDec :: Word -> Builder 2 wordPaddedDec2 :: Word -> Builder 2
wordPaddedTwoDigitDec !w = Unsafe.construct $ \arr off -> do wordPaddedDec2 !w = Unsafe.construct $ \arr off -> do
let d1 = approxDiv10 w let d1 = approxDiv10 w
d2 = w - (10 * d1) d2 = w - (10 * d1)
writeByteArray arr off (unsafeWordToWord8 (d1 + 48)) writeByteArray arr off (unsafeWordToWord8 (d1 + 48))
writeByteArray arr (off + 1) (unsafeWordToWord8 (d2 + 48)) writeByteArray arr (off + 1) (unsafeWordToWord8 (d2 + 48))
pure (off + 2) pure (off + 2)
-- | Encode a number less than 1e9 as a decimal number, zero-padding it to
-- nine digits. For example: 0 is encoded as @000000000@ and 5 is encoded as
-- @000000005@.
--
-- Precondition: Argument must be less than 1e9. Failure to satisfy this
-- precondition will not result in a segfault, but the resulting bytes are
-- undefined. The implemention uses a heuristic for division that is inaccurate
-- for large numbers.
wordPaddedDec9 :: Word -> Builder 9
wordPaddedDec9 !w = Unsafe.construct $ \arr off -> do
putRem10
(putRem10 $ putRem10 $ putRem10 $ putRem10 $ putRem10 $
putRem10 $ putRem10 $ putRem10
(\_ _ _ -> pure ())
) arr (off + 8) w
pure (off + 9)
putRem10 :: (MutableByteArray s -> Int -> Word -> ST s a) -> MutableByteArray s -> Int -> Word -> ST s a
{-# inline putRem10 #-}
putRem10 andThen arr off dividend = do
let quotient = approxDiv10 dividend
remainder = dividend - (10 * quotient)
writeByteArray arr off (unsafeWordToWord8 (remainder + 48))
andThen arr (off - 1) quotient
-- | Encode an ASCII character. -- | Encode an ASCII character.
-- Precondition: Input must be an ASCII character. This is not checked. -- Precondition: Input must be an ASCII character. This is not checked.
ascii :: Char -> Builder 1 ascii :: Char -> Builder 1
@ -824,6 +850,7 @@ logBase10 :: Double -> Double
logBase10 d = log d / 2.30258509299 logBase10 d = log d / 2.30258509299
-- Based on C code from https://stackoverflow.com/a/5558614 -- Based on C code from https://stackoverflow.com/a/5558614
-- For numbers less than 1073741829, this gives a correct answer.
approxDiv10 :: Word -> Word approxDiv10 :: Word -> Word
approxDiv10 !n = unsafeShiftR (0x1999999A * n) 32 approxDiv10 !n = unsafeShiftR (0x1999999A * n) 32

View file

@ -64,10 +64,14 @@ tests = testGroup "Tests"
runConcat 1 (word64PaddedUpperHex w) runConcat 1 (word64PaddedUpperHex w)
=== ===
pack (showWord64PaddedUpperHex w) pack (showWord64PaddedUpperHex w)
, TQC.testProperty "wordPaddedTwoDigitDec" $ TQC.forAll (TQC.choose (0,99)) $ \w -> , TQC.testProperty "wordPaddedDec2" $ TQC.forAll (TQC.choose (0,99)) $ \w ->
Bounded.run Nat.two (Bounded.wordPaddedTwoDigitDec w) Bounded.run Nat.two (Bounded.wordPaddedDec2 w)
=== ===
pack (zeroPadL 2 (show w)) pack (zeroPadL 2 (show w))
, TQC.testProperty "wordPaddedDec9" $ TQC.forAll (TQC.choose (0,999999999)) $ \w ->
Bounded.run Nat.constant (Bounded.wordPaddedDec9 w)
===
pack (zeroPadL 9 (show w))
, TQC.testProperty "word8Dec" $ \w -> , TQC.testProperty "word8Dec" $ \w ->
runConcat 1 (word8Dec w) runConcat 1 (word8Dec w)
=== ===