fixed

commit ebede50c1cb0d7f69338f4cc0a6adcc8638b2f1c
parent a93333c184f7bb05c04c21019f50523c8d858b87
Author: Jared Tobin <jared@jtobin.io>
Date:   Wed, 22 Jan 2025 16:48:31 +0400

lib: _2by1 functions

Diffstat:
M
lib/Data/Word/Extended.hs
 | 
19
+++++++++++++++++++
M
test/Main.hs
 | 
13
+++++++++++++

2 files changed, 32 insertions(+), 0 deletions(-)
diff --git a/lib/Data/Word/Extended.hs b/lib/Data/Word/Extended.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE NumericUnderscores #-}
+{-# LANGUAGE ViewPatterns #-}
 
 module Data.Word.Extended where
 
@@ -286,3 +287,21 @@ quot_rem_r hi lo y_0
             | otherwise = qa
       in  go q_acc rhat_acc
 
+recip_2by1 :: Word64 -> Word64
+recip_2by1 d = r where
+  !(P r _) = quot_rem_r (B.complement d) 0xffffffffffffffff d
+
+quot_rem_2by1 :: Word64 -> Word64 -> Word64 -> Word64 -> W64Pair
+quot_rem_2by1 uh ul d rec =
+  let !(P qh_0 ql) = mul_c rec uh
+      !(P ql_0 c)  = add_c ql ul 0
+      !(P (succ -> qh_1) _)  = add_c qh_0 uh c
+      !r = ul - qh_1 * d -- sub_mul?
+
+      !(P qh_y r_y) | r > ql_0  = P (qh_1 - 1) (r + d)
+                    | otherwise = P qh_1 r
+
+  in  if   r_y >= d
+      then P (qh_y + 1) (r_y - d)
+      else P qh_y r_y
+
diff --git a/test/Main.hs b/test/Main.hs
@@ -4,6 +4,7 @@
 module Main where
 
 import Data.Bits ((.|.), (.&.), (.<<.), (.>>.))
+import qualified Data.Bits as B
 import Data.Word (Word64)
 import Data.Word.Extended
 import Test.Tasty
@@ -114,6 +115,16 @@ quot_rem_r_case1 = do
   let !(P q r) = quot_rem_r 0 4 2
   H.assertEqual mempty (P 2 0) (P q r)
 
+recip_2by1_case0 :: H.Assertion
+recip_2by1_case0 = do
+  let !q = recip_2by1 (B.complement 4)
+  H.assertEqual mempty 5 q
+
+recip_2by1_case1 :: H.Assertion
+recip_2by1_case1 = do
+  let !q = recip_2by1 (B.complement 0xff)
+  H.assertEqual mempty 256 q
+
 -- main -----------------------------------------------------------------------
 
 inverses :: TestTree
@@ -157,6 +168,8 @@ main = defaultMain $
   , testGroup "unit tests" [
       H.testCase "quot_rem_r matches case0" quot_rem_r_case0
     , H.testCase "quot_rem_r matches case1" quot_rem_r_case1
+    , H.testCase "recip_2by1 matches case0" recip_2by1_case0
+    , H.testCase "recip_2by1 matches case1" recip_2by1_case1
     ]
   ]