commit 099fede7a453685f8edaacb2ecc0988033098b86
parent 1bba4f2903d66757a78b74d92f786593eef6fa39
Author: Jared Tobin <jared@jtobin.io>
Date: Wed, 9 Jul 2025 12:39:32 -0230
lib: refining wide word stuff
Diffstat:
7 files changed, 160 insertions(+), 3 deletions(-)
diff --git a/bench/Criterion/Choice.hs b/bench/Criterion/Choice.hs
@@ -0,0 +1,19 @@
+{-# LANGUAGE MagicHash #-}
+
+module Criterion.Choice (
+ choice_utils
+ ) where
+
+import Criterion.Main
+import qualified Data.Choice as C
+import GHC.Exts
+
+-- XX some of these are so fast that they're difficult to benchmark naively
+-- like this; performance is dominated by function call overhead and such.
+-- likely it would be better to benchmark them executed repeatedly in
+-- a loop
+
+choice_utils :: Benchmark
+choice_utils = bgroup "choice utilities" [
+ ]
+
diff --git a/bench/Criterion/Wide.hs b/bench/Criterion/Wide.hs
@@ -0,0 +1,37 @@
+module Criterion.Wide (
+ benches
+ ) where
+
+import Criterion.Main
+import qualified Data.Word.Wide as Wide
+import Prelude hiding (recip)
+
+benches :: Benchmark
+benches = bgroup "wide arithmetic" [
+ div1by1_big
+ , div1by1_small
+ , recip
+ , div2by1_bench
+ , quotrem2by1_bench
+ ]
+
+div1by1_big :: Benchmark
+div1by1_big = bench "wide div1by1 (big)" $
+ nf (Wide.div1by1 4294967294 32 4294967293) 32
+
+div1by1_small :: Benchmark
+div1by1_small = bench "wide div1by1 (small)" $
+ nf (Wide.div1by1 4294967294 32 2) 2
+
+recip :: Benchmark
+recip = bench "wide recip" $
+ nf Wide.recip 18446744073709551606
+
+div2by1_bench :: Benchmark
+div2by1_bench = bench "wide div2by1" $
+ nf (Wide.div2by1 (Wide.wide 4294967294 32)) 18446744073709551606
+
+quotrem2by1_bench :: Benchmark
+quotrem2by1_bench = bench "wide quotrem2by1" $
+ nf (Wide.quotrem2by1 (Wide.wide 4294967294 32)) 18446744073709551606
+
diff --git a/bench/Main.hs b/bench/Main.hs
@@ -11,6 +11,7 @@ import qualified Data.Word.Extended as W
import Data.Word (Word64)
import Prelude hiding (or, and, div, mod)
import qualified Prelude (div)
+import qualified Criterion.Wide as W
add_sub :: Benchmark
add_sub = bgroup "addition & subtraction" [
@@ -49,6 +50,8 @@ main = defaultMain [
add_sub
, multiplication
, division
+ , division_utils
+ , W.benches
]
-- addition and subtraction ---------------------------------------------------
diff --git a/lib/Data/Word/Wide.hs b/lib/Data/Word/Wide.hs
@@ -46,6 +46,9 @@ mul_c# a b =
in (# l, h #)
{-# INLINE mul_c# #-}
+mul_c :: Word -> Word -> Wide
+mul_c (W# a) (W# b) = Wide (mul_c# a b)
+
-- constant-time quotient, given maximum bitsizes
div1by1# :: Word# -> Word# -> Word# -> Word# -> Word#
div1by1# dividend dividend_bits divisor divisor_bits =
@@ -271,9 +274,15 @@ new_recip :: Word -> Reciprocal
new_recip (W# w) = new_recip# w
-- quotient and remainder of wide word (lo, hi), divided by divisor
-quotrem_2by1# :: (# Word#, Word# #) -> Word# -> (# Word#, Word# #)
-quotrem_2by1# (# l, h #) d = quotRemWord2# h l d
-{-# INLINE quotrem_2by1# #-}
+quotrem2by1# :: (# Word#, Word# #) -> Word# -> (# Word#, Word# #)
+quotrem2by1# (# l, h #) d = quotRemWord2# h l d
+{-# INLINE quotrem2by1# #-}
+
+-- ~6x slower than div2by1, but useful for testing
+quotrem2by1 :: Wide -> Word -> (Word, Word)
+quotrem2by1 (Wide u) (W# d) =
+ let !(# q, r #) = quotrem2by1# u d
+ in (W# q, W# r)
-- quotient and remainder of wide word (lo, hi) divided using reciprocal
div2by1# :: (# Word#, Word# #) -> Reciprocal -> (# Word#, Word# #)
diff --git a/ppad-fixed.cabal b/ppad-fixed.cabal
@@ -55,6 +55,9 @@ benchmark fixed-bench
default-language: Haskell2010
hs-source-dirs: bench
main-is: Main.hs
+ other-modules:
+ Criterion.Wide
+ , Criterion.Choice
ghc-options:
-rtsopts -O2 -Wall
diff --git a/test/Main.hs b/test/Main.hs
@@ -17,6 +17,7 @@ import qualified Prelude (div, rem)
import Test.Tasty
import qualified Test.Tasty.HUnit as H
import qualified Test.Tasty.QuickCheck as Q
+import qualified Wide as W
fi :: (Integral a, Num b) => a -> b
fi = fromIntegral
@@ -236,5 +237,6 @@ main = defaultMain $ testGroup "ppad-fixed" [
, H.testCase "quotrem_2by1 matches case0" quotrem_2by1_case0
, H.testCase "quotrem_by1 matches case0" quotrem_by1_case0
]
+ , W.tests
]
diff --git a/test/Wide.hs b/test/Wide.hs
@@ -0,0 +1,84 @@
+module Wide (
+ tests
+ ) where
+
+import qualified Data.Word.Wide as W
+import Prelude hiding (div, recip)
+import Test.Tasty
+import qualified Test.Tasty.HUnit as H
+
+tests :: TestTree
+tests = testGroup "wide unit tests" [
+ H.testCase "mul_c, case 0" mul_c_case0
+ , H.testCase "div1by1, case 0" div1by1_case0
+ , H.testCase "div1by1, case 1" div1by1_case1
+ , H.testCase "recip, case 0" recip_case0
+ , H.testCase "recip, case 1" recip_case1
+ , H.testCase "recip, case 2" recip_case2
+ , H.testCase "div2by1, case 0" div2by1_case0
+ , H.testCase "div2by1, case 1" div2by1_case1
+ , H.testCase "div2by1, case 2" div2by1_case2
+ ]
+
+mul_c_case0 :: H.Assertion
+mul_c_case0 = do
+ let a = 4294967294
+ b = 2
+ H.assertEqual "matches" (W.wide 8589934588 0) (W.mul_c a b)
+
+div1by1_case0 :: H.Assertion
+div1by1_case0 = do
+ let dnd = 4294967294
+ dnb = 32
+ div = 4294967293
+ dib = 32
+ v0 = W.div1by1 dnd dnb div dib
+ H.assertEqual "matches" 1 v0
+
+div1by1_case1 :: H.Assertion
+div1by1_case1 = do
+ let dnd = 4294967294
+ dnb = 32
+ div = 2
+ dib = 2
+ v0 = W.div1by1 dnd dnb div dib
+ H.assertEqual "matches" 2147483647 v0
+
+recip_case0 :: H.Assertion
+recip_case0 = do
+ let d = 18446744073709551606
+ e = W.recip d
+ H.assertEqual "matches" 10 e
+
+recip_case1 :: H.Assertion
+recip_case1 = do
+ let d = 0x8000000000000000 -- 2^63
+ e = W.recip d
+ H.assertEqual "matches" 0xffffffffffffffff e
+
+recip_case2 :: H.Assertion
+recip_case2 = do
+ let d = 0x8000000000000001 -- 2^63 + 1
+ e = W.recip d
+ H.assertEqual "matches" 0xfffffffffffffffc e
+
+div2by1_case0 :: H.Assertion
+div2by1_case0 = do
+ let d = maxBound - 1
+ r = W.div2by1 (W.wide (maxBound - 63) (maxBound - 2)) d
+ e = (maxBound, maxBound - 65)
+ H.assertEqual "matches" e r
+
+div2by1_case1 :: H.Assertion
+div2by1_case1 = do
+ let d = 0x8000000000000000 -- 2^63
+ r = W.div2by1 (W.wide 0xffffffffffffffff 0x7fffffffffffffff) d
+ e = (0xffffffffffffffff, 0x7fffffffffffffff)
+ H.assertEqual "matches" e r
+
+div2by1_case2 :: H.Assertion
+div2by1_case2 = do
+ let d = 0x8000000000000001 -- 2^63 + 1
+ r = W.div2by1 (W.wide 0x0000000000000000 0x8000000000000000) d
+ e = (0xfffffffffffffffe, 0x2)
+ H.assertEqual "matches" e r
