fixed

commit 231a4e8cb760549260020caa81fd8415283bbbb8
parent fb7193e66833738307844edbb7093736d8bbed8a
Author: Jared Tobin <jared@jtobin.io>
Date:   Fri, 24 Jan 2025 10:42:25 +0400

lib: pure quotrem_by1

Diffstat:
M
lib/Data/Word/Extended.hs
 | 
29
++++++++++++++++++++---------
M
ppad-fixed.cabal
 | 
1
-
M
test/Main.hs
 | 
22
++++++++++++++++++++++

3 files changed, 42 insertions(+), 10 deletions(-)
diff --git a/lib/Data/Word/Extended.hs b/lib/Data/Word/Extended.hs
@@ -70,6 +70,9 @@ data Word576 = Word576
   {-# UNPACK #-} !Word64
   deriving (Eq, Show, Generic)
 
+zero576 :: Word576
+zero576 = Word576 0 0 0 0 0 0 0 0 0
+
 sel576 :: Word576 -> Int -> Word64
 sel576 (Word576 a0 a1 a2 a3 a4 a5 a6 a7 a8) = \case
   0 -> a0; 1 -> a1; 2 -> a2; 3 -> a3; 4 -> a4
@@ -482,15 +485,23 @@ quotrem_by1 quo u d = do
             loop (pred j) rnex
   loop (lu - 2) r0
 
--- XX needs to be dynamic
-quotrem_by1_256 :: Word256 -> Word64 -> Word320
-quotrem_by1_256 (Word256 u0 u1 u2 u3) d =
-  let !rec = recip_2by1 d
-      !r0  = u3
-      !(P q2 r1) = quotrem_2by1 r0 u2 d rec
-      !(P q1 r2) = quotrem_2by1 r1 u1 d rec
-      !(P q0 r3) = quotrem_2by1 r2 u0 d rec
-  in  Word320 (Word256 q0 q1 q2 0) r3
+quotrem_by1_gen
+  :: Word576  -- dividend
+  -> Int      -- dividend length
+  -> Word64   -- divisor
+  -> Word640
+quotrem_by1_gen u ulen d =
+    let !r0  = sel576 u (ulen - 1)
+    in  loop (ulen - 2) zero576 r0
+  where
+    !rec = recip_2by1 d
+    loop !j !acc !racc
+      | j < 0 = Word640 acc racc
+      | otherwise =
+          let !u_j = sel576 u j
+              !(P q_j r) = quotrem_2by1 racc u_j d rec
+              !nacc = set576 acc j q_j
+          in  loop (pred j) nacc r
 
 -- XX primarray
 quotrem_knuth
diff --git a/ppad-fixed.cabal b/ppad-fixed.cabal
@@ -79,7 +79,6 @@ benchmark fixed-weigh
     , weigh
 
 executable fixed-profile
-  type:                exitcode-stdio-1.0
   default-language:    Haskell2010
   hs-source-dirs:      src
   main-is:             Main.hs
diff --git a/test/Main.hs b/test/Main.hs
@@ -197,6 +197,16 @@ quotrem_by1_case0 = do
   H.assertEqual "remainder matches" pec_rem r
   H.assertEqual "quotient matches" pec_array q
 
+quotrem_by1_gen_case0 :: H.Assertion
+quotrem_by1_gen_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
+  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_case1 :: H.Assertion
 quotrem_by1_case1 = do
   let (q, r) = runST $ do
@@ -212,6 +222,16 @@ quotrem_by1_case1 = do
   H.assertEqual "remainder matches" pec_rem r
   H.assertEqual "quotient matches" pec_array q
 
+quotrem_by1_gen_case1 :: H.Assertion
+quotrem_by1_gen_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
+  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_case0 :: H.Assertion
 quotrem_knuth_case0 = do
   let (q, u) = runST $ do
@@ -366,6 +386,8 @@ main = defaultMain $
     , H.testCase "quotrem_2by1 matches case0" quotrem_2by1_case0
     , H.testCase "quotrem_by1 matches case0" quotrem_by1_case0
     , H.testCase "quotrem_by1 matches case1" quotrem_by1_case1
+    , 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 matches case0" quotrem_knuth_case0
     , H.testCase "quotrem matches case0" quotrem_case0
     , H.testCase "quotrem matches case1" quotrem_case1