Better Tests and Benchmarks for Float and Double Builders

.github/workflows/ci.yml

@@ -135,7 +135,7 @@ jobs:
         githubToken: ${{ github.token }}
         install: |
           apt-get update -y
-          apt-get install -y curl ghc libghc-tasty-quickcheck-dev libghc-syb-dev
+          apt-get install -y curl ghc libghc-tasty-quickcheck-dev libghc-tasty-hunit-dev libghc-tasty-expected-failure-dev libghc-syb-dev
         run: |
           curl -s https://hackage.haskell.org/package/data-array-byte-0.1/data-array-byte-0.1.tar.gz | tar xz
           ghc --version

bench/BenchAll.hs

@@ -7,8 +7,11 @@
 -- Portability : tested on GHC only
 --
 
+{-# LANGUAGE ViewPatterns        #-}
+
 module Main (main) where
 
+import           Control.Exception                     (assert)
 import           Data.Foldable                         (foldMap)
 import           Data.Monoid
 import           Data.Semigroup
@@ -19,6 +22,8 @@ import           Prelude                               hiding (words)
 import qualified Data.List                             as List
 import           Control.DeepSeq
 import           Control.Exception
+import           Numeric.IEEE
+import           System.IO.Unsafe                      (unsafePerformIO)
 
 import qualified Data.ByteString                       as S
 import qualified Data.ByteString.Char8                 as S8
@@ -55,6 +60,17 @@ countToZero :: Int -> Maybe (Int, Int)
 countToZero 0 = Nothing
 countToZero n = Just (n, n - 1)
 
+castWord32ToFloat :: Word32 -> Float
+castWord32ToFloat x = unsafePerformIO (with x (peek . castPtr))
+
+castWord64ToDouble :: Word64 -> Double
+castWord64ToDouble x = unsafePerformIO (with x (peek . castPtr))
+
+castFloatToWord32 :: Float -> Word32
+castFloatToWord32 x = unsafePerformIO (with x (peek . castPtr))
+
+castDoubleToWord64 :: Double -> Word64
+castDoubleToWord64 x = unsafePerformIO (with x (peek . castPtr))
 
 ------------------------------------------------------------------------------
 -- Benchmark
@@ -79,14 +95,60 @@ smallIntegerData = map fromIntegral intData
 largeIntegerData :: [Integer]
 largeIntegerData = map (* (10 ^ (100 :: Integer))) smallIntegerData
 
+{-# NOINLINE floatSubnormalData #-}
+floatSubnormalData :: [Float]
+floatSubnormalData = assert (increment > 0) $ map evenlyDistribute [1..nRepl]
+  where
+  evenlyDistribute x = castWord32ToFloat $ increment * fromIntegral x
+  increment = castFloatToWord32 maxSubnormal `div` fromIntegral nRepl
+  maxSubnormal = predIEEE minNormal
 
-{-# NOINLINE floatData #-}
-floatData :: [Float]
-floatData = map (\x -> (3.14159 * fromIntegral x) ^ (3 :: Int)) intData
+{-# NOINLINE floatNormalData #-}
+floatNormalData :: [Float]
+floatNormalData = assert (increment > 0) $ map evenlyDistribute [0..nRepl]
+  where
+  evenlyDistribute x = castWord32ToFloat $ increment * fromIntegral x + minimum
+  increment = (maximum - minimum) `div` fromIntegral nRepl
+  minimum = castFloatToWord32 minNormal
+  maximum = castFloatToWord32 maxFinite
+
+{-# NOINLINE floatSpecials #-}
+floatSpecials :: [Float]
+floatSpecials = take nRepl $ cycle specials
+  where
+  specials = [nan, infinity, negate infinity, 0 -0]
 
-{-# NOINLINE doubleData #-}
-doubleData :: [Double]
-doubleData = map (\x -> (3.14159 * fromIntegral x) ^ (3 :: Int)) intData
+{-# NOINLINE doubleSubnormalData #-}
+doubleSubnormalData :: [Double]
+doubleSubnormalData = assert (increment > 0) $ map evenlyDistribute [1..nRepl]
+  where
+  evenlyDistribute x = castWord64ToDouble $ increment * fromIntegral x
+  increment = castDoubleToWord64 maxSubnormal `div` fromIntegral nRepl
+  maxSubnormal = predIEEE minNormal
+
+{-# NOINLINE doubleSmallData #-}
+doubleSmallData :: [Double]
+doubleSmallData = assert (increment > 0) $ map evenlyDistribute [1..nRepl]
+  where
+  evenlyDistribute x = castWord64ToDouble $ increment * fromIntegral x + minimum
+  increment = (maximum - minimum) `div` fromIntegral nRepl
+  minimum = castDoubleToWord64 1.0
+  maximum = castDoubleToWord64 $ 2 ^ 53
+
+{-# NOINLINE doubleBigData #-}
+doubleBigData :: [Double]
+doubleBigData = assert (increment > 0) $ map evenlyDistribute [1..nRepl]
+  where
+  evenlyDistribute x = castWord64ToDouble $ increment * fromIntegral x + minimum
+  increment = (maximum - minimum) `div` fromIntegral nRepl
+  minimum = castDoubleToWord64 $ 2 ^ 53
+  maximum = castDoubleToWord64 maxFinite
+
+{-# NOINLINE doubleSpecials #-}
+doubleSpecials :: [Double]
+doubleSpecials = take nRepl $ cycle specials
+  where
+  specials = [nan, infinity, negate infinity, 0 -0]
 
 {-# NOINLINE byteStringData #-}
 byteStringData :: S.ByteString
@@ -353,12 +415,22 @@ main = do
       , bgroup "Non-bounded encodings"
         [ benchB "byteStringHex"           byteStringData     $ byteStringHex
         , benchB "lazyByteStringHex"       lazyByteStringData $ lazyByteStringHex
-        , benchB "foldMap floatDec"        floatData          $ foldMap floatDec
-        , benchB "foldMap doubleDec"       doubleData         $ foldMap doubleDec
           -- Note that the small data corresponds to the intData pre-converted
           -- to Integer.
         , benchB "foldMap integerDec (small)"                     smallIntegerData        $ foldMap integerDec
         , benchB "foldMap integerDec (large)"                     largeIntegerData        $ foldMap integerDec
+        , bgroup "RealFloat"
+          [ bgroup "FGeneric" $ subAndNormalBench generic
+          , bgroup "FScientific"$ subAndNormalBench scientific
+          , bgroup "FStandard"
+            [ bgroup "Positive" $ fixedPrecision id id
+            , bgroup "Negative" $ fixedPrecision negate negate
+            , bgroup "Special"
+              [ benchB "Float  Average" floatSpecials  $ foldMap (formatFloat  standardDefaultPrecision)
+              , benchB "Double Average" doubleSpecials $ foldMap (formatDouble standardDefaultPrecision)
+              ]
+            ]
+          ]
         ]
       ]
 
@@ -581,3 +653,44 @@ main = do
     , benchReadInt
     , benchShort
     ]
+
+subAndNormalBench format =
+  [ bgroup "Positive" $ benchs id id
+  , bgroup "Negative" $ benchs negate negate
+  , bgroup "Special"
+    [ benchB "Float  Average" floatSpecials  $ foldMap (formatFloat  format)
+    , benchB "Double Average" doubleSpecials $ foldMap (formatDouble format)
+    ]
+  ]
+  where
+  benchs f d = 
+    [ bgroup "Float"
+      [ benchB "Subnormal" (map f floatSubnormalData)  $ foldMap $ formatFloat  format
+      , benchB "Normal"    (map f floatNormalData)     $ foldMap $ formatFloat  format
+      ]
+    , bgroup "Double"
+      [ benchB "Subnormal" (map d doubleSubnormalData) $ foldMap $ formatDouble format
+      , benchB "Small"     (map d doubleSmallData)     $ foldMap $ formatDouble format
+      , benchB "Big"       (map d doubleBigData)       $ foldMap $ formatDouble format
+      ]
+    ]
+
+fixedPrecision f d =
+  [ bgroup "default precision"
+    [ bgroup "Float"
+      [ benchB "Subnormal" (map f floatSubnormalData) $ foldMap $ formatFloat standardDefaultPrecision
+      , benchB "Normal"    (map f floatNormalData)    $ foldMap $ formatFloat standardDefaultPrecision
+      ]
+    , bgroup "Double"
+      [ benchB "Subnormal" (map d doubleSubnormalData) $ foldMap $ formatDouble standardDefaultPrecision
+      , benchB "Small"     (map d doubleSmallData)     $ foldMap $ formatDouble standardDefaultPrecision
+      , benchB "Big"       (map d doubleBigData)       $ foldMap $ formatDouble standardDefaultPrecision
+      ]
+    ]
+  , bgroup "precision"
+    [ benchB "Float-Precision-1"  (map f floatNormalData) $ foldMap $ formatFloat  $ standard 1
+    , benchB "Double-Precision-1" (map d doubleSmallData) $ foldMap $ formatDouble $ standard 1
+    , benchB "Float-Precision-6"  (map f floatNormalData) $ foldMap $ formatFloat  $ standard 6
+    , benchB "Double-Precision-6" (map d doubleSmallData) $ foldMap $ formatDouble $ standard 6
+    ]
+  ]

bytestring.cabal

@@ -214,6 +214,8 @@ test-suite bytestring-tests
                     deepseq,
                     QuickCheck,
                     tasty,
+                    tasty-expected-failure,
+                    tasty-hunit,
                     tasty-quickcheck >= 0.8.1,
                     template-haskell,
                     transformers >= 0.3,
@@ -241,4 +243,5 @@ benchmark bytestring-bench
                     bytestring,
                     deepseq,
                     tasty-bench,
-                    random
+                    random,
+                    ieee754