commit dbf556e634531aba482cbc7aa3f1aad66d033523
parent 09d3cf81230cc16a9aa21da513f2b4aa81ea51fc
Author: Jared Tobin <jared@jtobin.io>
Date: Sun, 2 Nov 2025 19:16:25 +0400
lib: axe some old wide stuff
Diffstat:
2 files changed, 20 insertions(+), 137 deletions(-)
diff --git a/lib/Data/Word/Montgomery.hs b/lib/Data/Word/Montgomery.hs
@@ -13,13 +13,12 @@ import qualified Data.Word.Wider as W
import GHC.Exts
import Prelude hiding (div, mod, or, and, not, quot, rem, recip)
--- reference 'montgomery_reduction_inner'
redc_inner#
- :: (# Word#, Word#, Word#, Word# #) -- upper
- -> (# Word#, Word#, Word#, Word# #) -- lower
- -> (# Word#, Word#, Word#, Word# #) -- modulus
- -> Word# -- mod neg inv
- -> (# (# Word#, Word#, Word#, Word# #), Word# #) -- upper, meta-carry
+ :: (# Word#, Word#, Word#, Word# #) -- ^ upper words
+ -> (# Word#, Word#, Word#, Word# #) -- ^ lower words
+ -> (# Word#, Word#, Word#, Word# #) -- ^ modulus
+ -> Word# -- ^ mod neg inv
+ -> (# (# Word#, Word#, Word#, Word# #), Word# #) -- ^ upper words, meta-carry
redc_inner# (# u0, u1, u2, u3 #) (# l0, l1, l2, l3 #) (# m0, m1, m2, m3 #) n =
let -- outer loop, i == 0 ---------------------------------------------------
!w_0 = L.mul_w# l0 n
@@ -74,29 +73,28 @@ redc_inner# (# u0, u1, u2, u3 #) (# l0, l1, l2, l3 #) (# m0, m1, m2, m3 #) n =
in (# (# u3_1, u3_2, u3_3, u_3 #), mc_3 #)
{-# INLINE redc_inner# #-}
+-- | Montgomery reduction.
redc#
- :: (# Word#, Word#, Word#, Word# #) -- lower
- -> (# Word#, Word#, Word#, Word# #) -- upper
- -> (# Word#, Word#, Word#, Word# #) -- modulus
- -> Word# -- mod neg inv
- -> (# Word#, Word#, Word#, Word# #)
+ :: (# Word#, Word#, Word#, Word# #) -- ^ lower words
+ -> (# Word#, Word#, Word#, Word# #) -- ^ upper words
+ -> (# Word#, Word#, Word#, Word# #) -- ^ modulus
+ -> Word# -- ^ mod neg inv
+ -> (# Word#, Word#, Word#, Word# #) -- ^ result
redc# l u m n =
let !(# nu, mc #) = redc_inner# u l m n
- in W.sub_mod_c# nu mc m m -- XX shouldn't use Data.Word.Wider version
+ in W.sub_mod_c# nu mc m m
{-# INLINE redc# #-}
--- XX here only for testing; should probably be in Data.Word.Wider itself
redc :: W.Wider -> W.Wider -> W.Wider -> Word -> W.Wider
redc (W.Wider l) (W.Wider u) (W.Wider m) (W# n) =
let !res = redc# l u m n
in (W.Wider res)
--- reference 'montgomery_retrieve_inner'
retr_inner#
- :: (# Word#, Word#, Word#, Word# #) -- montgomery form
- -> (# Word#, Word#, Word#, Word# #) -- modulus
- -> Word# -- mod neg inv
- -> (# Word#, Word#, Word#, Word# #)
+ :: (# Word#, Word#, Word#, Word# #) -- ^ value in montgomery form
+ -> (# Word#, Word#, Word#, Word# #) -- ^ modulus
+ -> Word# -- ^ mod neg inv
+ -> (# Word#, Word#, Word#, Word# #) -- ^ retrieved value
retr_inner# (# x0, x1, x2, x3 #) (# m0, m1, m2, m3 #) n =
let -- outer loop, i == 0 ---------------------------------------------------
!u_0 = L.mul_w# x0 n -- out state
@@ -141,12 +139,11 @@ retr#
retr# f m n = retr_inner# f m n
{-# INLINE retr# #-}
--- XX ditto
retr
- :: W.Wider -- montgomery form
- -> W.Wider -- modulus
- -> Word -- mod neg inv
- -> W.Wider
+ :: W.Wider -- ^ value in montgomery form
+ -> W.Wider -- ^ modulus
+ -> Word -- ^ mod neg inv
+ -> W.Wider -- ^ retrieved value
retr (W.Wider f) (W.Wider m) (W# n) =
let !res = retr# f m n
in (W.Wider res)
diff --git a/lib/Data/Word/Wide.hs b/lib/Data/Word/Wide.hs
@@ -27,22 +27,17 @@ module Data.Word.Wide (
, and
, xor
, not
- , shr
- , unchecked_shr
-- * Arithmetic
, add
, sub
, mul
- , quotrem_by1
- , _quotrem_by1
, add_w#
, mul_w#
) where
import Control.DeepSeq
-import qualified Data.Choice as C
import Data.Bits ((.|.), (.&.), (.<<.), (.>>.))
import qualified Data.Bits as B
import qualified Data.Word.Limb as L
@@ -150,77 +145,6 @@ not :: Wide -> Wide
not (Wide w) = Wide (not_w# w)
{-# INLINE not #-}
--- overflowing, vartime w/respect to s
-shr_of_vartime# :: (# Word#, Word# #) -> Int# -> C.MaybeWide#
-shr_of_vartime# (# l, h #) s
- | isTrue# (s ># wide_size) = C.none_wide# (# 0##, 0## #)
- | otherwise =
- let !(# shift_num, rem #) = quotRemInt# s size
- !w_1 = case shift_num of
- 0# ->
- let !h_0 = uncheckedShiftRL# h rem
- !car = uncheckedShiftL# h (size -# rem)
- !shf = uncheckedShiftRL# l rem
- !l_0 = or# shf car
- in (# l_0, h_0 #)
- 1# ->
- let !l_0 = uncheckedShiftRL# h rem
- in (# l_0, 0## #)
- 2# ->
- (# l, h #)
- _ -> error "ppad-fixed (shr_of_vartime#): internal error"
- in C.some_wide# w_1
- where
- !size = case B.finiteBitSize (0 :: Word) of I# m -> m
- !wide_size = 2# *# size
-{-# INLINE shr_of_vartime# #-}
-
-shr_of# :: (# Word#, Word# #) -> Int# -> C.MaybeWide#
-shr_of# (# l, h #) s =
- let !shift_bits = size -# (word2Int# (clz# (int2Word# (wide_size -# 1#))))
- !overflow = C.not_c#
- (C.from_word_lt# (int2Word# s) (int2Word# wide_size))
- !shift = remWord# (int2Word# s) (int2Word# wide_size)
- loop !j !res
- | isTrue# (j <# shift_bits) =
- let !bit = C.from_word_lsb# -- XX not inlined
- (and# (uncheckedShiftRL# shift j) 1##)
- !nres = C.ct_select_wide# -- XX
- res
- (C.expect_wide# -- XX
- (shr_of_vartime# -- XX
- res
- (word2Int# (uncheckedShiftL# 1## j)))
- "shift within range")
- bit
- in loop (j +# 1#) nres
- | otherwise = res
- !result = loop 0# (# l, h #)
- in C.just_wide#
- (C.ct_select_wide# result (# 0##, 0## #) overflow)
- (C.not_c# overflow)
- where
- !size = case B.finiteBitSize (0 :: Word) of I# m -> m
- !wide_size = 2# *# size
-{-# INLINE shr_of# #-}
-
-shr# :: (# Word#, Word# #) -> Int# -> (# Word#, Word# #)
-shr# w s = C.expect_wide# (shr_of# w s) "invalid shift"
-{-# INLINE shr# #-}
-
--- wrapping
-unchecked_shr# :: (# Word#, Word# #) -> Int# -> (# Word#, Word# #)
-unchecked_shr# w s = C.expect_wide_or# (shr_of# w s) (# 0##, 0## #)
-{-# INLINE unchecked_shr# #-}
-
--- constant-time shr, ErrorCall on invalid shift
-shr :: Wide -> Int -> Wide
-shr (Wide w) (I# s) = Wide (shr# w s)
-
--- constant-time shr, saturating
-unchecked_shr :: Wide -> Int -> Wide
-unchecked_shr (Wide w) (I# s) = Wide (unchecked_shr# w s)
-
-- addition, subtraction ------------------------------------------------------
-- wide addition (overflowing)
@@ -283,41 +207,3 @@ mul_w# (# a0, a1 #) (# b0, b1 #) =
mul :: Wide -> Wide -> Wide
mul (Wide a) (Wide b) = Wide (mul_w# a b)
--- division -------------------------------------------------------------------
-
--- quotient and remainder of wide word (lo, hi), divided by divisor
-_quotrem_by1# :: (# Word#, Word# #) -> Word# -> (# Word#, Word# #)
-_quotrem_by1# (# l, h #) d = quotRemWord2# h l d
-{-# INLINE _quotrem_by1# #-}
-
--- ~6x slower than quotrem_by1, but useful for testing
-_quotrem_by1 :: Wide -> Word -> (Word, Word)
-_quotrem_by1 (Wide u) (W# d) =
- let !(# q, r #) = _quotrem_by1# u d
- in (W# q, W# r)
-
--- quotient and remainder of wide word (lo, hi) divided using reciprocal
-quotrem_by1# :: (# Word#, Word# #) -> L.Reciprocal -> (# Word#, Word# #)
-quotrem_by1# (# u0, u1 #) (L.Reciprocal (# d, _, r #)) =
- let !(# q0_0, q1_0 #) = L.mul_c# r u1
- !(# q0_1, q1_1 #) = add_w# (# q0_0, q1_0 #) (# u0, u1 #)
- !q1_2 = plusWord# q1_1 1##
- !r_0 = minusWord# u0 (timesWord# q1_2 d)
- -- ct block 1
- !r_gt_q0 = C.from_word_lt# q0_1 r_0
- !q1_3 = C.ct_select_word# q1_2 (minusWord# q1_2 1##) r_gt_q0
- !r_1 = C.ct_select_word# r_0 (plusWord# r_0 d) r_gt_q0
- -- ct block 2
- !r_ge_d = C.from_word_le# d r_1
- !q1_4 = C.ct_select_word# q1_3 (plusWord# q1_3 1##) r_ge_d
- !r_2 = C.ct_select_word# r_1 (minusWord# r_1 d) r_ge_d
- in (# q1_4, r_2 #)
-{-# INLINE quotrem_by1# #-}
-
--- quotient and remainder of wide word divided by word
-quotrem_by1 :: Wide -> Word -> (Word, Word)
-quotrem_by1 (Wide (# u0, u1 #)) (W# d) =
- let !re = L.recip# d
- !(# q, r #) = quotrem_by1# (# u0, u1 #) re
- in (W# q, W# r)
-
