commit a1edba5126a4d4de66ddaf2dfd2eeaac183790f2
parent 879bd52fff4996cbc81d46bd3f0cfebf41123118
Author: Jared Tobin <jared@jtobin.io>
Date: Sat, 27 Dec 2025 18:31:07 -0330
lib: corresponding scalar changes
Diffstat:
1 file changed, 79 insertions(+), 74 deletions(-)
diff --git a/lib/Numeric/Montgomery/Secp256k1/Scalar.hs b/lib/Numeric/Montgomery/Secp256k1/Scalar.hs
@@ -1,6 +1,7 @@
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE NumericUnderscores #-}
+{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE UnboxedSums #-}
{-# LANGUAGE UnboxedTuples #-}
@@ -64,7 +65,7 @@ import qualified Data.Word.Limb as L
import qualified Data.Word.Wide as W
import Data.Word.Wider (Wider(..))
import qualified Data.Word.Wider as WW
-import GHC.Exts (Word(..))
+import GHC.Exts (Word(..), Word#)
import Prelude hiding (or, and, not, exp)
-- montgomery arithmetic, specialized to the secp256k1 scalar group order
@@ -78,7 +79,7 @@ import Prelude hiding (or, and, not, exp)
-- 1
-- >>> putStrLn (render one)
-- (4624529908474429119, 4994812053365940164, 1, 0)
-data Montgomery = Montgomery !(# Limb, Limb, Limb, Limb #)
+data Montgomery = Montgomery !Limb4
instance Show Montgomery where
show = show . from
@@ -89,7 +90,7 @@ instance Show Montgomery where
-- >>> putStrLn (render 1)
-- (4624529908474429119, 4994812053365940164, 1, 0)
render :: Montgomery -> String
-render (Montgomery (# Limb a, Limb b, Limb c, Limb d #)) =
+render (Montgomery (L4 a b c d)) =
"(" <> show (W# a) <> ", " <> show (W# b) <> ", "
<> show (W# c) <> ", " <> show (W# d) <> ")"
@@ -107,15 +108,23 @@ instance Num Montgomery where
let !(Limb l) = l0 `L.or#` l1 `L.or#` l2 `L.or#` l3
!n = C.from_word_nonzero# l
!b = C.to_word# n
- in Montgomery (# Limb b, Limb 0##, Limb 0##, Limb 0## #)
+ in Montgomery (L4 b 0## 0## 0##)
instance NFData Montgomery where
rnf (Montgomery a) = case a of (# _, _, _, _ #) -> ()
-- utilities ------------------------------------------------------------------
+type Limb2 = (# Limb, Limb #)
+
+type Limb4 = (# Limb, Limb, Limb, Limb #)
+
+pattern L4 :: Word# -> Word# -> Word# -> Word# -> Limb4
+pattern L4 w0 w1 w2 w3 = (# Limb w0, Limb w1, Limb w2, Limb w3 #)
+{-# COMPLETE L4 #-}
+
-- Wide wrapping addition, when addend is only a limb.
-wadd_w# :: (# Limb, Limb #) -> Limb -> (# Limb, Limb #)
+wadd_w# :: Limb2 -> Limb -> Limb2
wadd_w# (# x_lo, x_hi #) y_lo =
let !(# s0, c0 #) = L.add_o# x_lo y_lo
!(# s1, _ #) = L.add_o# x_hi c0
@@ -123,7 +132,7 @@ wadd_w# (# x_lo, x_hi #) y_lo =
{-# INLINE wadd_w# #-}
-- Truncate a wide word to a 'Limb'.
-lo :: (# Limb, Limb #) -> Limb
+lo :: Limb2 -> Limb
lo (# l, _ #) = l
{-# INLINE lo #-}
@@ -131,10 +140,8 @@ lo (# l, _ #) = l
-- | Constant-time equality comparison.
eq :: Montgomery -> Montgomery -> C.Choice
-eq
- (Montgomery (# Limb a0, Limb a1, Limb a2, Limb a3 #))
- (Montgomery (# Limb b0, Limb b1, Limb b2, Limb b3 #))
- = C.eq_wider# (# a0, a1, a2, a3 #) (# b0, b1, b2, b3 #)
+eq (Montgomery (L4 a0 a1 a2 a3)) (Montgomery (L4 b0 b1 b2 b3)) =
+ C.eq_wider# (# a0, a1, a2, a3 #) (# b0, b1, b2, b3 #)
{-# INLINE eq #-}
-- | Variable-time equality comparison.
@@ -145,13 +152,13 @@ eq_vartime (Montgomery (Wider -> a)) (Montgomery (Wider -> b)) =
-- innards --------------------------------------------------------------------
redc_inner#
- :: (# Limb, Limb, Limb, Limb #) -- ^ upper limbs
- -> (# Limb, Limb, Limb, Limb #) -- ^ lower limbs
- -> (# (# Limb, Limb, Limb, Limb #), Limb #) -- ^ upper limbs, meta-carry
+ :: Limb4 -- ^ upper limbs
+ -> Limb4 -- ^ lower limbs
+ -> (# Limb4, Limb #) -- ^ upper limbs, meta-carry
redc_inner# (# u0, u1, u2, u3 #) (# l0, l1, l2, l3 #) =
let !(# m0, m1, m2, m3 #) =
- (# Limb 0xBFD25E8CD0364141##, Limb 0xBAAEDCE6AF48A03B##
- , Limb 0xFFFFFFFFFFFFFFFE##, Limb 0xFFFFFFFFFFFFFFFF## #)
+ L4 0xBFD25E8CD0364141## 0xBAAEDCE6AF48A03B##
+ 0xFFFFFFFFFFFFFFFE## 0xFFFFFFFFFFFFFFFF##
!n = Limb 0x4B0DFF665588B13F##
!w_0 = L.mul_w# l0 n
!(# _, c_00 #) = L.mac# w_0 m0 l0 (Limb 0##)
@@ -181,13 +188,13 @@ redc_inner# (# u0, u1, u2, u3 #) (# l0, l1, l2, l3 #) =
{-# INLINE redc_inner# #-}
redc#
- :: (# Limb, Limb, Limb, Limb #) -- ^ lower limbs
- -> (# Limb, Limb, Limb, Limb #) -- ^ upper limbs
- -> (# Limb, Limb, Limb, Limb #) -- ^ result
+ :: Limb4 -- ^ lower limbs
+ -> Limb4 -- ^ upper limbs
+ -> Limb4 -- ^ result
redc# l u =
let -- group order
- !m = (# Limb 0xBFD25E8CD0364141##, Limb 0xBAAEDCE6AF48A03B##
- , Limb 0xFFFFFFFFFFFFFFFE##, Limb 0xFFFFFFFFFFFFFFFF## #)
+ !m = L4 0xBFD25E8CD0364141## 0xBAAEDCE6AF48A03B##
+ 0xFFFFFFFFFFFFFFFE## 0xFFFFFFFFFFFFFFFF##
!(# nu, mc #) = redc_inner# u l
in WW.sub_mod_c# nu mc m m
{-# INLINE redc# #-}
@@ -205,12 +212,12 @@ redc (Montgomery l) (Montgomery u) =
in (Montgomery res)
retr_inner#
- :: (# Limb, Limb, Limb, Limb #) -- ^ value in montgomery form
- -> (# Limb, Limb, Limb, Limb #) -- ^ retrieved value
+ :: Limb4 -- ^ value in montgomery form
+ -> Limb4 -- ^ retrieved value
retr_inner# (# x0, x1, x2, x3 #) =
let !(# m0, m1, m2, m3 #) =
- (# Limb 0xBFD25E8CD0364141##, Limb 0xBAAEDCE6AF48A03B##
- , Limb 0xFFFFFFFFFFFFFFFE##, Limb 0xFFFFFFFFFFFFFFFF## #)
+ L4 0xBFD25E8CD0364141## 0xBAAEDCE6AF48A03B##
+ 0xFFFFFFFFFFFFFFFE## 0xFFFFFFFFFFFFFFFF##
!n = Limb 0x4B0DFF665588B13F##
!u_0 = L.mul_w# x0 n
!(# _, o0 #) = L.mac# u_0 m0 x0 (Limb 0##)
@@ -236,8 +243,8 @@ retr_inner# (# x0, x1, x2, x3 #) =
{-# INLINE retr_inner# #-}
retr#
- :: (# Limb, Limb, Limb, Limb #)
- -> (# Limb, Limb, Limb, Limb #)
+ :: Limb4
+ -> Limb4
retr# f = retr_inner# f
{-# INLINE retr# #-}
@@ -252,13 +259,13 @@ retr (Montgomery f) =
-- | Montgomery multiplication (FIOS), without conditional subtract.
mul_inner#
- :: (# Limb, Limb, Limb, Limb #) -- ^ x
- -> (# Limb, Limb, Limb, Limb #) -- ^ y
- -> (# (# Limb, Limb, Limb, Limb #), Limb #) -- ^ product, meta-carry
+ :: Limb4 -- ^ x
+ -> Limb4 -- ^ y
+ -> (# Limb4, Limb #) -- ^ product, meta-carry
mul_inner# (# x0, x1, x2, x3 #) (# y0, y1, y2, y3 #) =
let !(# m0, m1, m2, m3 #) =
- (# Limb 0xBFD25E8CD0364141##, Limb 0xBAAEDCE6AF48A03B##
- , Limb 0xFFFFFFFFFFFFFFFE##, Limb 0xFFFFFFFFFFFFFFFF## #)
+ L4 0xBFD25E8CD0364141## 0xBAAEDCE6AF48A03B##
+ 0xFFFFFFFFFFFFFFFE## 0xFFFFFFFFFFFFFFFF##
!n = Limb 0x4B0DFF665588B13F##
!axy0 = L.mul_c# x0 y0
!u0 = L.mul_w# (lo axy0) n
@@ -332,13 +339,13 @@ mul_inner# (# x0, x1, x2, x3 #) (# y0, y1, y2, y3 #) =
{-# INLINE mul_inner# #-}
mul#
- :: (# Limb, Limb, Limb, Limb #)
- -> (# Limb, Limb, Limb, Limb #)
- -> (# Limb, Limb, Limb, Limb #)
+ :: Limb4
+ -> Limb4
+ -> Limb4
mul# a b =
let -- group order
- !m = (# Limb 0xBFD25E8CD0364141##, Limb 0xBAAEDCE6AF48A03B##
- , Limb 0xFFFFFFFFFFFFFFFE##, Limb 0xFFFFFFFFFFFFFFFF## #)
+ !m = L4 0xBFD25E8CD0364141## 0xBAAEDCE6AF48A03B##
+ 0xFFFFFFFFFFFFFFFE## 0xFFFFFFFFFFFFFFFF##
!(# nu, mc #) = mul_inner# a b
in WW.sub_mod_c# nu mc m m
{-# NOINLINE mul# #-} -- cannot be inlined without exploding comp time
@@ -357,13 +364,12 @@ mul
mul (Montgomery a) (Montgomery b) = Montgomery (mul# a b)
to#
- :: (# Limb, Limb, Limb, Limb #) -- ^ integer
- -> (# Limb, Limb, Limb, Limb #)
+ :: Limb4 -- ^ integer
+ -> Limb4
to# x =
- let -- r^2 mod m
- !r2 = (# Limb 0x896CF21467D7D140##, Limb 0x741496C20E7CF878##
- , Limb 0xE697F5E45BCD07C6##, Limb 0x9D671CD581C69BC5## #)
- in mul# x r2
+ let !r2 = L4 0x896CF21467D7D140## 0x741496C20E7CF878## -- r^2 mod m
+ 0xE697F5E45BCD07C6## 0x9D671CD581C69BC5##
+ in mul# x r2
{-# INLINE to# #-}
-- | Convert a 'Wider' word to the Montgomery domain.
@@ -377,13 +383,13 @@ from :: Montgomery -> Wider
from = retr
add#
- :: (# Limb, Limb, Limb, Limb #) -- ^ augend
- -> (# Limb, Limb, Limb, Limb #) -- ^ addend
- -> (# Limb, Limb, Limb, Limb #) -- ^ sum
+ :: Limb4 -- ^ augend
+ -> Limb4 -- ^ addend
+ -> Limb4 -- ^ sum
add# a b =
let -- group order
- !m = (# Limb 0xBFD25E8CD0364141##, Limb 0xBAAEDCE6AF48A03B##
- , Limb 0xFFFFFFFFFFFFFFFE##, Limb 0xFFFFFFFFFFFFFFFF## #)
+ !m = L4 0xBFD25E8CD0364141## 0xBAAEDCE6AF48A03B##
+ 0xFFFFFFFFFFFFFFFE## 0xFFFFFFFFFFFFFFFF##
in WW.add_mod# a b m
{-# INLINE add# #-}
@@ -401,12 +407,12 @@ add
add (Montgomery a) (Montgomery b) = Montgomery (add# a b)
sub#
- :: (# Limb, Limb, Limb, Limb #) -- ^ minuend
- -> (# Limb, Limb, Limb, Limb #) -- ^ subtrahend
- -> (# Limb, Limb, Limb, Limb #) -- ^ difference
+ :: Limb4 -- ^ minuend
+ -> Limb4 -- ^ subtrahend
+ -> Limb4 -- ^ difference
sub# a b =
- let !m = (# Limb 0xBFD25E8CD0364141##, Limb 0xBAAEDCE6AF48A03B##
- , Limb 0xFFFFFFFFFFFFFFFE##, Limb 0xFFFFFFFFFFFFFFFF## #)
+ let !m = L4 0xBFD25E8CD0364141## 0xBAAEDCE6AF48A03B##
+ 0xFFFFFFFFFFFFFFFE## 0xFFFFFFFFFFFFFFFF##
in WW.sub_mod# a b m
{-# INLINE sub# #-}
@@ -424,9 +430,9 @@ sub
sub (Montgomery a) (Montgomery b) = Montgomery (sub# a b)
neg#
- :: (# Limb, Limb, Limb, Limb #) -- ^ argument
- -> (# Limb, Limb, Limb, Limb #) -- ^ modular negation
-neg# a = sub# (# Limb 0##, Limb 0##, Limb 0##, Limb 0## #) a
+ :: Limb4 -- ^ argument
+ -> Limb4 -- ^ modular negation
+neg# a = sub# (L4 0## 0## 0## 0##) a
{-# INLINE neg# #-}
-- | Additive inverse in the Montgomery domain.
@@ -441,7 +447,7 @@ neg# a = sub# (# Limb 0##, Limb 0##, Limb 0##, Limb 0## #) a
neg :: Montgomery -> Montgomery
neg (Montgomery a) = Montgomery (neg# a)
-sqr# :: (# Limb, Limb, Limb, Limb #) -> (# Limb, Limb, Limb, Limb #)
+sqr# :: Limb4 -> Limb4
sqr# a =
let !(# l, h #) = WW.sqr# a
in redc# l h
@@ -462,21 +468,20 @@ sqr (Montgomery a) = Montgomery (mul# a a)
-- | Zero (the additive unit) in the Montgomery domain.
zero :: Montgomery
-zero = Montgomery (# Limb 0##, Limb 0##, Limb 0##, Limb 0## #)
+zero = Montgomery (L4 0## 0## 0## 0##)
-- | One (the multiplicative unit) in the Montgomery domain.
one :: Montgomery
-one = Montgomery
- (# Limb 0x402DA1732FC9BEBF##, Limb 0x4551231950B75FC4##
- , Limb 0x0000000000000001##, Limb 0x0000000000000000## #)
+one = Montgomery (L4 0x402DA1732FC9BEBF## 0x4551231950B75FC4##
+ 0x0000000000000001## 0x0000000000000000##)
-- generated by etc/generate_inv.sh
inv#
- :: (# Limb, Limb, Limb, Limb #)
- -> (# Limb, Limb, Limb, Limb #)
+ :: Limb4
+ -> Limb4
inv# a =
- let !t0 = (# Limb 0x402DA1732FC9BEBF##, Limb 0x4551231950B75FC4##
- , Limb 0x0000000000000001##, Limb 0x0000000000000000## #)
+ let !t0 = L4 0x402DA1732FC9BEBF## 0x4551231950B75FC4##
+ 0x0000000000000001## 0x0000000000000000##
!t1 = sqr# t0
!t2 = mul# a t1
!t3 = sqr# t2
@@ -954,12 +959,12 @@ exp :: Montgomery -> Wider -> Montgomery
exp (Montgomery b) (Wider e) = Montgomery (exp# b e)
exp#
- :: (# Limb, Limb, Limb, Limb #)
- -> (# Limb, Limb, Limb, Limb #)
- -> (# Limb, Limb, Limb, Limb #)
+ :: Limb4
+ -> Limb4
+ -> Limb4
exp# b e =
- let !o = (# Limb 0x402DA1732FC9BEBF##, Limb 0x4551231950B75FC4##
- , Limb 0x0000000000000001##, Limb 0x0000000000000000## #)
+ let !o = L4 0x402DA1732FC9BEBF## 0x4551231950B75FC4##
+ 0x0000000000000001## 0x0000000000000000##
loop !r !m !ex n = case n of
0 -> r
_ ->
@@ -971,7 +976,7 @@ exp# b e =
in loop o b e (256 :: Word)
{-# INLINE exp# #-}
-odd# :: (# Limb, Limb, Limb, Limb #) -> C.Choice
+odd# :: Limb4 -> C.Choice
odd# = WW.odd#
{-# INLINE odd# #-}
@@ -992,10 +997,10 @@ odd_vartime (Montgomery m) = C.decide (odd# m)
-- constant-time selection ----------------------------------------------------
select#
- :: (# Limb, Limb, Limb, Limb #) -- ^ a
- -> (# Limb, Limb, Limb, Limb #) -- ^ b
- -> C.Choice -- ^ c
- -> (# Limb, Limb, Limb, Limb #) -- ^ result
+ :: Limb4 -- ^ a
+ -> Limb4 -- ^ b
+ -> C.Choice -- ^ c
+ -> Limb4 -- ^ result
select# = WW.select#
{-# INLINE select# #-}
