commit 34d6268c446ab4497e5f31fb3fa459e4dd89f19e
parent 8890a30241602a9552d40ca0fb4da88109d99e77
Author: Jared Tobin <jared@jtobin.io>
Date: Sat, 25 Jan 2025 12:56:31 +0400
lib: general refinement
Diffstat:
6 files changed, 180 insertions(+), 114 deletions(-)
diff --git a/bench/Main.hs b/bench/Main.hs
@@ -3,7 +3,6 @@
module Main where
-import Control.DeepSeq
import Criterion.Main
import Data.Bits ((.|.), (.&.), (.^.))
import qualified Data.Bits as B
@@ -11,13 +10,6 @@ import qualified Data.Word.Extended as W
import Prelude hiding (or, and, div, mod)
import qualified Prelude (div)
-instance NFData W.Word256
-instance NFData W.Word320
-instance NFData W.Word512
-instance NFData W.Word576
-instance NFData W.Word640
-instance NFData W.Word1152
-
or_baseline :: Benchmark
or_baseline = bench "or (baseline)" $ nf ((.|.) w0) w1 where
w0, w1 :: Integer
@@ -114,8 +106,8 @@ div_baseline = bench "div (baseline)" $ nf (Prelude.div w0) w1 where
!w0 = 0x41cf50c7d0d65afabcf5ba37750dba71c7db29ec9f20a216d3ef013a59b9188a
!w1 = 0x066bd4c3c10e30260cb6e7832af25f15527b089b258a1fef13b6eec3ce73bf06
-div_pure :: Benchmark
-div_pure = bench "div_pure" $ nf (W.div_pure w0) w1 where
+div :: Benchmark
+div = bench "div" $ nf (W.div w0) w1 where
!w0 = W.to_word256
0x41cf50c7d0d65afabcf5ba37750dba71c7db29ec9f20a216d3ef013a59b9188a
!w1 = W.to_word256
@@ -135,23 +127,23 @@ mod_baseline = bench "mod (baseline)" $ nf (Prelude.rem w0) w1 where
!w0 = 0x41cf50c7d0d65afabcf5ba37750dba71c7db29ec9f20a216d3ef013a59b9188a
!w1 = 0x066bd4c3c10e30260cb6e7832af25f15527b089b258a1fef13b6eec3ce73bf06
-mod_pure :: Benchmark
-mod_pure = bench "mod (pure)" $ nf (W.mod_pure w0) w1 where
+mod :: Benchmark
+mod = bench "mod (pure)" $ nf (W.mod w0) w1 where
!w0 = W.to_word256
0x41cf50c7d0d65afabcf5ba37750dba71c7db29ec9f20a216d3ef013a59b9188a
!w1 = W.to_word256
0x066bd4c3c10e30260cb6e7832af25f15527b089b258a1fef13b6eec3ce73bf06
-quotrem_by1_gen :: Benchmark
-quotrem_by1_gen =
- bench "quotrem_by1_gen" $
- nf (W.quotrem_by1_gen (W.Word576 300 200 100 0 0 0 0 0 0) 3)
+quotrem_by1 :: Benchmark
+quotrem_by1 =
+ bench "quotrem_by1" $
+ nf (W.quotrem_by1 (W.Word576 300 200 100 0 0 0 0 0 0) 3)
(B.complement 50)
-quotrem_knuth_gen :: Benchmark
-quotrem_knuth_gen =
- bench "quotrem_knuth_gen" $
- nf (W.quotrem_knuth_gen u 5 d) 4
+quotrem_knuth :: Benchmark
+quotrem_knuth =
+ bench "quotrem_knuth" $
+ nf (W.quotrem_knuth u 5 d) 4
where
!u = W.Word576
2162362899639802732 8848548347662387477 13702897166684377657
@@ -162,28 +154,25 @@ quotrem_knuth_gen =
main :: IO ()
main = defaultMain [
- -- quotrem_knuth_gen
- -- quotrem_by1
- --, quotrem_by1_gen
- div_baseline
- , div_pure
- --, div
- --, mul_baseline
- --, mul
- --, mod_baseline
- --, mod_pure
- --, mod
- --, div_baseline_small
- --, div_small
- --, or_baseline
- --, or
- --, and_baseline
- --, and
- --, xor_baseline
- --, xor
- --, add_baseline
- --, add
- --, sub_baseline
- --, sub
+ quotrem_by1
+ , quotrem_knuth
+ , div_baseline
+ , div
+ , div_baseline_small
+ , div_small
+ , mul_baseline
+ , mul
+ , add_baseline
+ , add
+ , sub_baseline
+ , sub
+ , mod_baseline
+ , mod
+ , or_baseline
+ , or
+ , and_baseline
+ , and
+ , xor_baseline
+ , xor
]
diff --git a/bench/Weight.hs b/bench/Weight.hs
@@ -5,19 +5,10 @@
module Main where
-import Control.DeepSeq
import qualified Data.Bits as B
import qualified Data.Word.Extended as E
import qualified Weigh as W
-instance NFData E.Word256
-instance NFData E.Word320
-instance NFData E.Word512
-instance NFData E.Word576
-instance NFData E.Word640
-instance NFData E.Word832
-instance NFData E.Word1152
-
i0, i1 :: Integer
i0 = 0x7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed
i1 = 0x7fffffffffffffffffffffffffffffffffffffffffffffbfffffffffffffffed
@@ -36,6 +27,30 @@ w3 = E.to_word256 i3
main :: IO ()
main = do
+ let !u0 = E.Word576 300 200 100 0 0 0 0 0 0
+ !u1 = E.Word576
+ 0x1234567890ABCDEF
+ 0xFEDCBA0987654321
+ 0x123456789ABCDEF0
+ 0 0 0 0 0 0
+
+ !u2 = E.Word576
+ 2162362899639802732
+ 8848548347662387477
+ 13702897166684377657
+ 16799544643779908154
+ 1 0 0 0 0
+
+ !d0 = B.complement 50
+
+ !d1 = E.Word256 0x0 0x0 0x1 0x100000000
+
+ !d2 = E.Word256
+ 16950798510782491100
+ 2612788699139816405
+ 5146719872810836952
+ 14966148379609982000
+
W.mainWith $ do
W.func "add (baseline)" ((+) i0) i1
W.func "add" (E.add w0) w1
@@ -44,12 +59,9 @@ main = do
W.func "mul (baseline)" ((*) i0) i1
W.func "mul" (E.mul w0) w1
W.func "div (baseline)" (Prelude.div i2) i3
- W.func "div_pure" (E.div_pure w2) w3
- W.func "quotrem_by1_gen"
- (E.quotrem_by1_gen (E.Word576 300 200 100 0 0 0 0 0 0) 3) (B.complement 50)
- W.func "quotrem_gen"
- (E.quotrem_gen (E.Word576 0x1234567890ABCDEF 0xFEDCBA0987654321 0x123456789ABCDEF0 0 0 0 0 0 0)) (E.Word256 0x0 0x0 0x1 0x100000000)
- W.func "quotrem_knuth_gen"
- (E.quotrem_knuth_gen (E.Word576 2162362899639802732 8848548347662387477 13702897166684377657 16799544643779908154 1 0 0 0 0) 5 (E.Word256 16950798510782491100 2612788699139816405 5146719872810836952 14966148379609982000)) 4
+ W.func "div" (E.div w2) w3
+ W.func "quotrem_by1" (E.quotrem_by1 u0 3) d0
+ W.func "quotrem" (E.quotrem u1) d1
+ W.func "quotrem_knuth" (E.quotrem_knuth u2 5 d2) 4
diff --git a/lib/Data/Word/Extended.hs b/lib/Data/Word/Extended.hs
@@ -4,13 +4,60 @@
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE ViewPatterns #-}
-module Data.Word.Extended where
-
+module Data.Word.Extended (
+ Word256(..)
+ , zero
+ , one
+
+ -- * Conversion
+ , to_integer
+ , to_word256
+
+ -- * Comparison
+ , lt
+ , gt
+ , is_zero
+
+ -- * Bit Operations
+ , or
+ , and
+ , xor
+
+ -- * Arithmetic
+ , add
+ , sub
+ , mul
+ , div
+
+ -- * Modular Arithmetic
+ , mod
+
+ -- for testing/benchmarking
+ , Word128(..)
+ , Word576(..)
+ , Word640(..)
+ , Word832(..)
+ , Word1152(..)
+ , quotrem
+ , quotrem_r
+ , quotrem_by1
+ , quotrem_2by1
+ , quotrem_knuth
+ , recip_2by1
+ , to_word512
+ , word512_to_integer
+ , mul_512
+ , mul_c
+ , umul_hop
+ , umul_step
+ ) where
+
+import Control.DeepSeq
import Data.Bits ((.|.), (.&.), (.<<.), (.>>.), (.^.))
import qualified Data.Bits as B
import Data.Word (Word64)
import GHC.Generics
-import Prelude hiding (div, mod)
+import Prelude hiding (div, mod, or, and)
fi :: (Integral a, Num b) => a -> b
fi = fromIntegral
@@ -26,6 +73,8 @@ data Word256 = Word256
{-# UNPACK #-} !Word64
deriving (Eq, Show, Generic)
+instance NFData Word256
+
sel256 :: Word256 -> Int -> Word64
sel256 (Word256 a0 a1 a2 a3) = \case
0 -> a0; 1 -> a1; 2 -> a2; 3 -> a3
@@ -51,18 +100,24 @@ data Word512 = Word512
{-# UNPACK #-} !Word64
deriving (Eq, Show, Generic)
+instance NFData Word512
+
-- utility words ------------------------------------------------------------
data Word128 = P
{-# UNPACK #-} !Word64
{-# UNPACK #-} !Word64
- deriving (Eq, Show)
+ deriving (Eq, Show, Generic)
+
+instance NFData Word128
data Word320 = Word320
!Word256
{-# UNPACK #-} !Word64
deriving (Eq, Show, Generic)
+instance NFData Word320
+
data Word576 = Word576
{-# UNPACK #-} !Word64
{-# UNPACK #-} !Word64
@@ -75,6 +130,8 @@ data Word576 = Word576
{-# UNPACK #-} !Word64
deriving (Eq, Show, Generic)
+instance NFData Word576
+
zero576 :: Word576
zero576 = Word576 0 0 0 0 0 0 0 0 0
@@ -102,16 +159,22 @@ data Word640 = Word640
{-# UNPACK #-} !Word64
deriving (Eq, Show, Generic)
+instance NFData Word640
+
data Word832 = Word832
{-# UNPACK #-} !Word576
{-# UNPACK #-} !Word256
deriving (Eq, Show, Generic)
+instance NFData Word832
+
data Word1152 = Word1152 -- yikes
{-# UNPACK #-} !Word576
{-# UNPACK #-} !Word576
deriving (Eq, Show, Generic)
+instance NFData Word1152
+
-- conversion -----------------------------------------------------------------
to_integer :: Word256 -> Integer
@@ -680,12 +743,12 @@ quotrem_2by1 uh ul d rec =
then P (qh_y + 1) (r_y - d)
else P qh_y r_y
-quotrem_by1_gen
+quotrem_by1
:: Word576 -- dividend
-> Int -- dividend length
-> Word64 -- divisor
-> Word640
-quotrem_by1_gen (Word576 u0 u1 u2 u3 u4 u5 u6 u7 u8) ulen d = case ulen of
+quotrem_by1 (Word576 u0 u1 u2 u3 u4 u5 u6 u7 u8) ulen d = case ulen of
9 ->
let !r_0 = u8
!(Word640 q0 r0) = step7 zero576 r_0
@@ -739,7 +802,7 @@ quotrem_by1_gen (Word576 u0 u1 u2 u3 u4 u5 u6 u7 u8) ulen d = case ulen of
let !r_0 = u1
in step0 zero576 r_0
_ ->
- error "ppad-fixed (quotrem_by1_gen): bad index"
+ error "ppad-fixed (quotrem_by1): bad index"
where
!rec = recip_2by1 d
@@ -776,13 +839,13 @@ quotrem_by1_gen (Word576 u0 u1 u2 u3 u4 u5 u6 u7 u8) ulen d = case ulen of
in Word640 (Word576 q0 q1 q2 q3 q4 q5 q6 q q8) nr
-- XX expensive
-quotrem_knuth_gen
+quotrem_knuth
:: Word576
-> Int
-> Word256
-> Int
-> Word1152
-quotrem_knuth_gen u ulen d dlen = loop (ulen - dlen - 1) zero576 u where
+quotrem_knuth u ulen d dlen = loop (ulen - dlen - 1) zero576 u where
!d_hi = sel256 d (dlen - 1)
!d_lo = sel256 d (dlen - 2)
!rec = recip_2by1 d_hi
@@ -814,11 +877,11 @@ quotrem_knuth_gen u ulen d dlen = loop (ulen - dlen - 1) zero576 u where
let !q = set576 qacc j qhat
in loop (pred j) q u1
-quotrem_gen
+quotrem
:: Word576
-> Word256
-> Word832
-quotrem_gen u@(Word576 u0 u1 u2 u3 u4 u5 u6 u7 u8) d@(Word256 d0 d1 d2 d3) =
+quotrem u@(Word576 u0 u1 u2 u3 u4 u5 u6 u7 u8) d@(Word256 d0 d1 d2 d3) =
let !dlen = setlen_256 d
!shift = B.countLeadingZeros d3
!dn = fill256 (dlen - 1) shift
@@ -832,10 +895,10 @@ quotrem_gen u@(Word576 u0 u1 u2 u3 u4 u5 u6 u7 u8) d@(Word256 d0 d1 d2 d3) =
in if dlen == 1
then
let !dn_0 = sel256 dn 0
- !(Word640 q r) = quotrem_by1_gen un (ulen + 1) dn_0
+ !(Word640 q r) = quotrem_by1 un (ulen + 1) dn_0
in Word832 q (Word256 (r .>>. shift) 0 0 0)
else
- let !(Word1152 q un0) = quotrem_knuth_gen un (ulen + 1) dn dlen
+ let !(Word1152 q un0) = quotrem_knuth un (ulen + 1) dn dlen
!r_pre = fill_rem dlen un0 shift
!un_dlen_1 = sel576 un0 (dlen - 1)
!r = set256 r_pre (dlen - 1) (un_dlen_1 .>>.shift)
@@ -910,22 +973,22 @@ quotrem_gen u@(Word576 u0 u1 u2 u3 u4 u5 u6 u7 u8) d@(Word256 d0 d1 d2 d3) =
| z0 /= 0 = 1
| otherwise = error "ppad-fixed (quotrem_256): division by zero"
-div_pure :: Word256 -> Word256 -> Word256
-div_pure a@(Word256 a0 a1 a2 a3) b@(Word256 b0 _ _ _)
+div :: Word256 -> Word256 -> Word256
+div a@(Word256 a0 a1 a2 a3) b@(Word256 b0 _ _ _)
| is_zero b || b `gt` a = zero -- ?
| a == b = one
| is_word64 a = Word256 (a0 `quot` b0) 0 0 0
| otherwise =
let !u = Word576 a0 a1 a2 a3 0 0 0 0 0
- !(Word832 (Word576 q0 q1 q2 q3 _ _ _ _ _) _) = quotrem_gen u b
+ !(Word832 (Word576 q0 q1 q2 q3 _ _ _ _ _) _) = quotrem u b
in Word256 q0 q1 q2 q3
-mod_pure :: Word256 -> Word256 -> Word256
-mod_pure a@(Word256 a0 a1 a2 a3) b@(Word256 b0 _ _ _)
+mod :: Word256 -> Word256 -> Word256
+mod a@(Word256 a0 a1 a2 a3) b@(Word256 b0 _ _ _)
| is_zero b || a == b = zero -- ?
| a `lt` b = a
| is_word64 a = Word256 (a0 `Prelude.rem` b0) 0 0 0
| otherwise =
let !u = Word576 a0 a1 a2 a3 0 0 0 0 0
- !(Word832 _ r) = quotrem_gen u b
+ !(Word832 _ r) = quotrem u b
in r
diff --git a/ppad-fixed.cabal b/ppad-fixed.cabal
@@ -1,6 +1,6 @@
cabal-version: 3.0
name: ppad-fixed
-version: 0.1.0
+version: 0.0.1
synopsis: Fixed-width integers.
license: MIT
license-file: LICENSE
@@ -26,6 +26,7 @@ library
Data.Word.Extended
build-depends:
base >= 4.9 && < 5
+ , deepseq >= 1.5 && < 1.6
test-suite fixed-tests
type: exitcode-stdio-1.0
@@ -56,7 +57,6 @@ benchmark fixed-bench
build-depends:
base
, criterion
- , deepseq
, ppad-fixed
benchmark fixed-weigh
@@ -70,7 +70,6 @@ benchmark fixed-weigh
build-depends:
base
- , deepseq
, ppad-fixed
, weigh
@@ -85,6 +84,5 @@ executable fixed-profile
build-depends:
base
, criterion
- , deepseq
, ppad-fixed
diff --git a/src/Main.hs b/src/Main.hs
@@ -19,6 +19,6 @@ main = do
1286679968202709238
3741537094902495500
- let foo = quotrem_gen u d
+ let foo = quotrem u d
print foo
diff --git a/test/Main.hs b/test/Main.hs
@@ -13,6 +13,10 @@ import Test.Tasty
import qualified Test.Tasty.HUnit as H
import qualified Test.Tasty.QuickCheck as Q
+fi :: (Integral a, Num b) => a -> b
+fi = fromIntegral
+{-# INLINE fi #-}
+
instance Q.Arbitrary Word256 where
arbitrary = do
w0 <- Q.arbitrary
@@ -140,15 +144,15 @@ mul_512_matches (Q.NonNegative a) (Q.NonNegative b) =
!rite = to_word512 (a * b)
in left == rite
-div_pure_matches :: DivMonotonic -> Bool
-div_pure_matches (DivMonotonic (a, b)) =
- let !left = to_word256 a `div_pure` to_word256 b
+div_matches :: DivMonotonic -> Bool
+div_matches (DivMonotonic (a, b)) =
+ let !left = to_word256 a `div` to_word256 b
!rite = to_word256 (a `Prelude.div` b)
in left == rite
-mod_pure_matches :: DivMonotonic -> Bool
-mod_pure_matches (DivMonotonic (a, b)) =
- let !left = to_word256 a `mod_pure` to_word256 b
+mod_matches :: DivMonotonic -> Bool
+mod_matches (DivMonotonic (a, b)) =
+ let !left = to_word256 a `mod` to_word256 b
!rite = to_word256 (a `rem` b)
in left == rite
@@ -180,28 +184,28 @@ quotrem_2by1_case0 = do
!o = quotrem_2by1 8 4 d (recip_2by1 d)
H.assertEqual mempty (P 8 2052) o
-quotrem_by1_gen_case0 :: H.Assertion
-quotrem_by1_gen_case0 = do
+quotrem_by1_case0 :: H.Assertion
+quotrem_by1_case0 = do
let !u = Word576 8 4 0 0 0 0 0 0 0
!d = B.complement 0xFF :: Word64
- !(Word640 q r) = quotrem_by1_gen u 2 d
+ !(Word640 q r) = quotrem_by1 u 2 d
let pec_quo = Word576 4 0 0 0 0 0 0 0 0
pec_rem = 1032
H.assertEqual "remainder matches" pec_rem r
H.assertEqual "quotient matches" pec_quo q
-quotrem_by1_gen_case1 :: H.Assertion
-quotrem_by1_gen_case1 = do
+quotrem_by1_case1 :: H.Assertion
+quotrem_by1_case1 = do
let !u = Word576 8 26 0 0 0 0 0 0 0
!d = B.complement 0xFF :: Word64
- !(Word640 q r) = quotrem_by1_gen u 2 d
+ !(Word640 q r) = quotrem_by1 u 2 d
let pec_quo = Word576 26 0 0 0 0 0 0 0 0
pec_rem = 6664
H.assertEqual "remainder matches" pec_rem r
H.assertEqual "quotient matches" pec_quo q
-quotrem_knuth_gen_case0 :: H.Assertion
-quotrem_knuth_gen_case0 = do
+quotrem_knuth_case0 :: H.Assertion
+quotrem_knuth_case0 = do
let !u = Word576
2162362899639802732
8848548347662387477
@@ -214,7 +218,7 @@ quotrem_knuth_gen_case0 = do
2612788699139816405
5146719872810836952
14966148379609982000
- !(Word1152 q nu) = quotrem_knuth_gen u 5 d 4
+ !(Word1152 q nu) = quotrem_knuth u 5 d 4
!pec_q = Word576 2 0 0 0 0 0 0 0 0
!pec_u = Word576
5154254025493923764
@@ -226,15 +230,15 @@ quotrem_knuth_gen_case0 = do
H.assertEqual "divisor matches" pec_u nu
H.assertEqual "quotient matches" pec_q q
-quotrem_gen_case0 :: H.Assertion
-quotrem_gen_case0 = do
+quotrem_case0 :: H.Assertion
+quotrem_case0 = do
let !u = Word576
0x1234567890ABCDEF
0xFEDCBA0987654321
0x123456789ABCDEF0
0 0 0 0 0 0
!d = Word256 0x0 0x0 0x1 0x100000000
- !(Word832 q r) = quotrem_gen u d
+ !(Word832 q r) = quotrem u d
!pec_q = Word576 0 0 0 0 0 0 0 0 0
!pec_r = Word256
1311768467294899695
@@ -244,8 +248,8 @@ quotrem_gen_case0 = do
H.assertEqual "remainder matches" pec_r r
H.assertEqual "quotient matches" pec_q q
-quotrem_gen_case1 :: H.Assertion
-quotrem_gen_case1 = do
+quotrem_case1 :: H.Assertion
+quotrem_case1 = do
let !u = Word576
5152276743337338587
6823823105342984773
@@ -257,7 +261,7 @@ quotrem_gen_case1 = do
653197174784954101
1286679968202709238
3741537094902495500
- !(Word832 q r) = quotrem_gen u d
+ !(Word832 q r) = quotrem u d
!pec_q = Word576 2 0 0 0 0 0 0 0 0
!pec_r = Word256
5900249524800868845
@@ -301,12 +305,12 @@ arithmetic = testGroup "arithmetic" [
Q.withMaxSuccess 1000 add_matches
, Q.testProperty "subtraction matches (nonneg, monotonic)" $
Q.withMaxSuccess 1000 sub_matches
- , Q.testProperty "multiplication matches (nonneg, low bits)" $
+ , Q.testProperty "512-bit multiplication matches (nonneg, low bits)" $
Q.withMaxSuccess 1000 mul_512_matches
- , Q.testProperty "pure division matches" $
- Q.withMaxSuccess 1000 div_pure_matches
- , Q.testProperty "pure mod matches" $
- Q.withMaxSuccess 1000 mod_pure_matches
+ , Q.testProperty "division matches" $
+ Q.withMaxSuccess 1000 div_matches
+ , Q.testProperty "mod matches" $
+ Q.withMaxSuccess 1000 mod_matches
]
utils :: TestTree
@@ -335,11 +339,11 @@ main = defaultMain $
, H.testCase "recip_2by1 matches case0" recip_2by1_case0
, H.testCase "recip_2by1 matches case1" recip_2by1_case1
, H.testCase "quotrem_2by1 matches case0" quotrem_2by1_case0
- , H.testCase "quotrem_by1_gen matches case0" quotrem_by1_gen_case0
- , H.testCase "quotrem_by1_gen matches case1" quotrem_by1_gen_case1
- , H.testCase "quotrem_knuth_gen matches case0" quotrem_knuth_gen_case0
- , H.testCase "quotrem_gen matches case0" quotrem_gen_case0
- , H.testCase "quotrem_gen matches case1" quotrem_gen_case1
+ , H.testCase "quotrem_by1 matches case0" quotrem_by1_case0
+ , H.testCase "quotrem_by1 matches case1" quotrem_by1_case1
+ , H.testCase "quotrem_knuth matches case0" quotrem_knuth_case0
+ , H.testCase "quotrem matches case0" quotrem_case0
+ , H.testCase "quotrem matches case1" quotrem_case1
]
]
