fixed

Pure Haskell large fixed-width integers and Montgomery arithmetic (docs.ppad.tech/fixed).
git clone git://git.ppad.tech/fixed.git
Log | Files | Refs | README | LICENSE

Scalar.hs (25717B)


      1 {-# LANGUAGE BangPatterns #-}
      2 {-# LANGUAGE MagicHash #-}
      3 {-# LANGUAGE NumericUnderscores #-}
      4 {-# LANGUAGE PatternSynonyms #-}
      5 {-# LANGUAGE ViewPatterns #-}
      6 {-# LANGUAGE UnboxedSums #-}
      7 {-# LANGUAGE UnboxedTuples #-}
      8 {-# LANGUAGE UnliftedNewtypes #-}
      9 
     10 -- |
     11 -- Module: Numeric.Montgomery.Secp256k1.Scalar
     12 -- Copyright: (c) 2025 Jared Tobin
     13 -- License: MIT
     14 -- Maintainer: Jared Tobin <jared@ppad.tech>
     15 --
     16 -- Montgomery form 'Wider' words, as well as arithmetic operations, with
     17 -- domain derived from the secp256k1 elliptic curve scalar group order.
     18 
     19 module Numeric.Montgomery.Secp256k1.Scalar (
     20   -- * Montgomery form, secp256k1 scalar group order modulus
     21     Montgomery(..)
     22   , render
     23   , to
     24   , from
     25   , zero
     26   , one
     27 
     28   -- * Comparison
     29   , eq
     30   , eq_vartime
     31 
     32   -- * Reduction and retrieval
     33   , redc
     34   , redc#
     35   , retr
     36   , retr#
     37 
     38   -- * Constant-time selection
     39   , select
     40   , select#
     41 
     42   -- * Montgomery arithmetic
     43   , add
     44   , add#
     45   , sub
     46   , sub#
     47   , mul
     48   , mul#
     49   , sqr
     50   , sqr#
     51   , neg
     52   , neg#
     53   , inv
     54   , inv#
     55   , exp
     56   , exp#
     57   , odd_vartime
     58   , odd#
     59   ) where
     60 
     61 import Control.DeepSeq
     62 import qualified Data.Choice as C
     63 import Data.Word.Limb (Limb(..))
     64 import qualified Data.Word.Limb as L
     65 import qualified Data.Word.Wide as W
     66 import Data.Word.Wider (Wider(..))
     67 import qualified Data.Word.Wider as WW
     68 import GHC.Exts (Word(..), Word#)
     69 import Prelude hiding (or, and, not, exp)
     70 
     71 -- montgomery arithmetic, specialized to the secp256k1 scalar group order
     72 -- 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEBAAEDCE6AF48A03BBFD25E8CD0364141
     73 
     74 -- | Montgomery-form 'Wider' words, on the Montgomery domain defined by
     75 --   the secp256k1 scalar group order.
     76 --
     77 --   >>> let one = 1 :: Montgomery
     78 --   >>> one
     79 --   1
     80 --   >>> putStrLn (render one)
     81 --   (4624529908474429119, 4994812053365940164, 1, 0)
     82 data Montgomery = Montgomery !Limb4
     83 
     84 instance Show Montgomery where
     85   show = show . from
     86 
     87 -- | Render a 'Montgomery' value as a 'String', showing its individual
     88 --   'Limb's.
     89 --
     90 --   >>> putStrLn (render 1)
     91 --   (4624529908474429119, 4994812053365940164, 1, 0)
     92 render :: Montgomery -> String
     93 render (Montgomery (L4 a b c d)) =
     94      "(" <> show (W# a) <> ", " <> show (W# b) <> ", "
     95   <> show (W# c) <> ", " <> show (W# d) <> ")"
     96 
     97 -- | Note that 'fromInteger' necessarily runs in variable time due
     98 --   to conversion from the variable-size, potentially heap-allocated
     99 --   'Integer' type.
    100 instance Num Montgomery where
    101   a + b = add a b
    102   a - b = sub a b
    103   a * b = mul a b
    104   negate a = neg a
    105   abs = id
    106   fromInteger = to . WW.to_vartime
    107   signum (Montgomery (# l0, l1, l2, l3 #)) =
    108     let !(Limb l) = l0 `L.or#` l1 `L.or#` l2 `L.or#` l3
    109         !n = C.from_word_nonzero# l
    110         !(Montgomery z) = zero
    111         !(Montgomery o) = one
    112     in  Montgomery (select# z o n)
    113 
    114 instance NFData Montgomery where
    115   rnf (Montgomery a) = case a of (# _, _, _, _ #) -> ()
    116 
    117 -- utilities ------------------------------------------------------------------
    118 
    119 type Limb2 = (# Limb, Limb #)
    120 
    121 type Limb4 = (# Limb, Limb, Limb, Limb #)
    122 
    123 pattern L4 :: Word# -> Word# -> Word# -> Word# -> Limb4
    124 pattern L4 w0 w1 w2 w3 = (# Limb w0, Limb w1, Limb w2, Limb w3 #)
    125 {-# COMPLETE L4 #-}
    126 
    127 -- Wide wrapping addition, when addend is only a limb.
    128 wadd_w# :: Limb2 -> Limb -> Limb2
    129 wadd_w# (# x_lo, x_hi #) y_lo =
    130   let !(# s0, c0 #) = L.add_o# x_lo y_lo
    131       !(# s1, _ #) = L.add_o# x_hi c0
    132   in  (# s0, s1 #)
    133 {-# INLINE wadd_w# #-}
    134 
    135 -- Truncate a wide word to a 'Limb'.
    136 lo :: Limb2 -> Limb
    137 lo (# l, _ #) = l
    138 {-# INLINE lo #-}
    139 
    140 -- comparison -----------------------------------------------------------------
    141 
    142 -- | Constant-time equality comparison.
    143 eq :: Montgomery -> Montgomery -> C.Choice
    144 eq (Montgomery (L4 a0 a1 a2 a3)) (Montgomery (L4 b0 b1 b2 b3)) =
    145   C.eq_wider# (# a0, a1, a2, a3 #) (# b0, b1, b2, b3 #)
    146 {-# INLINE eq #-}
    147 
    148 -- | Variable-time equality comparison.
    149 eq_vartime :: Montgomery -> Montgomery -> Bool
    150 eq_vartime (Montgomery (Wider -> a)) (Montgomery (Wider -> b)) =
    151   WW.eq_vartime a b
    152 
    153 -- innards --------------------------------------------------------------------
    154 
    155 redc_inner#
    156   :: Limb4             -- ^ upper limbs
    157   -> Limb4             -- ^ lower limbs
    158   -> (# Limb4, Limb #) -- ^ upper limbs, meta-carry
    159 redc_inner# (# u0, u1, u2, u3 #) (# l0, l1, l2, l3 #) =
    160   let !(# m0, m1, m2, m3 #) =
    161         L4 0xBFD25E8CD0364141## 0xBAAEDCE6AF48A03B##
    162            0xFFFFFFFFFFFFFFFE## 0xFFFFFFFFFFFFFFFF##
    163       !n                = Limb 0x4B0DFF665588B13F##
    164       !w_0              = L.mul_w# l0 n
    165       !(# _, c_00 #)    = L.mac# w_0 m0 l0 (Limb 0##)
    166       !(# l0_1, c_01 #) = L.mac# w_0 m1 l1 c_00
    167       !(# l0_2, c_02 #) = L.mac# w_0 m2 l2 c_01
    168       !(# l0_3, c_03 #) = L.mac# w_0 m3 l3 c_02
    169       !(# u_0, mc_0 #)  = L.add_c# u0 c_03 (Limb 0##)
    170       !w_1              = L.mul_w# l0_1 n
    171       !(# _, c_10 #)    = L.mac# w_1 m0 l0_1 (Limb 0##)
    172       !(# l1_1, c_11 #) = L.mac# w_1 m1 l0_2 c_10
    173       !(# l1_2, c_12 #) = L.mac# w_1 m2 l0_3 c_11
    174       !(# u1_3, c_13 #) = L.mac# w_1 m3 u_0 c_12
    175       !(# u_1, mc_1 #)  = L.add_c# u1 c_13 mc_0
    176       !w_2              = L.mul_w# l1_1 n
    177       !(# _, c_20 #)    = L.mac# w_2 m0 l1_1 (Limb 0##)
    178       !(# l2_1, c_21 #) = L.mac# w_2 m1 l1_2 c_20
    179       !(# u2_2, c_22 #) = L.mac# w_2 m2 u1_3 c_21
    180       !(# u2_3, c_23 #) = L.mac# w_2 m3 u_1 c_22
    181       !(# u_2, mc_2 #)  = L.add_c# u2 c_23 mc_1
    182       !w_3              = L.mul_w# l2_1 n
    183       !(# _, c_30 #)    = L.mac# w_3 m0 l2_1 (Limb 0##)
    184       !(# u3_1, c_31 #) = L.mac# w_3 m1 u2_2 c_30
    185       !(# u3_2, c_32 #) = L.mac# w_3 m2 u2_3 c_31
    186       !(# u3_3, c_33 #) = L.mac# w_3 m3 u_2 c_32
    187       !(# u_3, mc_3 #)  = L.add_c# u3 c_33 mc_2
    188   in  (# (# u3_1, u3_2, u3_3, u_3 #), mc_3 #)
    189 {-# INLINE redc_inner# #-}
    190 
    191 redc#
    192   :: Limb4 -- ^ lower limbs
    193   -> Limb4 -- ^ upper limbs
    194   -> Limb4 -- ^ result
    195 redc# l u =
    196   let -- group order
    197       !m = L4 0xBFD25E8CD0364141## 0xBAAEDCE6AF48A03B##
    198               0xFFFFFFFFFFFFFFFE## 0xFFFFFFFFFFFFFFFF##
    199       !(# nu, mc #) = redc_inner# u l
    200   in  WW.sub_mod_c# nu mc m m
    201 {-# INLINE redc# #-}
    202 
    203 -- | Montgomery reduction.
    204 --
    205 --   The first argument represents the low words, and the second the
    206 --   high words, of an extra-large eight-limb word in Montgomery form.
    207 redc
    208   :: Montgomery -- ^ low wider-word, Montgomery form
    209   -> Montgomery -- ^ high wider-word, Montgomery form
    210   -> Montgomery -- ^ reduced value
    211 redc (Montgomery l) (Montgomery u) =
    212   let !res = redc# l u
    213   in  (Montgomery res)
    214 
    215 retr_inner#
    216   :: Limb4 -- ^ value in montgomery form
    217   -> Limb4 -- ^ retrieved value
    218 retr_inner# (# x0, x1, x2, x3 #) =
    219   let !(# m0, m1, m2, m3 #) =
    220         L4 0xBFD25E8CD0364141## 0xBAAEDCE6AF48A03B##
    221            0xFFFFFFFFFFFFFFFE## 0xFFFFFFFFFFFFFFFF##
    222       !n                = Limb 0x4B0DFF665588B13F##
    223       !u_0              = L.mul_w# x0 n
    224       !(# _, o0 #)      = L.mac# u_0 m0 x0 (Limb 0##)
    225       !(# o0_1, p0_1 #) = L.mac# u_0 m1 (Limb 0##) o0
    226       !(# p0_2, q0_2 #) = L.mac# u_0 m2 (Limb 0##) p0_1
    227       !(# q0_3, r0_3 #) = L.mac# u_0 m3 (Limb 0##) q0_2
    228       !u_1              = L.mul_w# (L.add_w# o0_1 x1) n
    229       !(# _, o1 #)      = L.mac# u_1 m0 x1 o0_1
    230       !(# o1_1, p1_1 #) = L.mac# u_1 m1 p0_2 o1
    231       !(# p1_2, q1_2 #) = L.mac# u_1 m2 q0_3 p1_1
    232       !(# q1_3, r1_3 #) = L.mac# u_1 m3 r0_3 q1_2
    233       !u_2              = L.mul_w# (L.add_w# o1_1 x2) n
    234       !(# _, o2 #)      = L.mac# u_2 m0 x2 o1_1
    235       !(# o2_1, p2_1 #) = L.mac# u_2 m1 p1_2 o2
    236       !(# p2_2, q2_2 #) = L.mac# u_2 m2 q1_3 p2_1
    237       !(# q2_3, r2_3 #) = L.mac# u_2 m3 r1_3 q2_2
    238       !u_3              = L.mul_w# (L.add_w# o2_1 x3) n
    239       !(# _, o3 #)      = L.mac# u_3 m0 x3 o2_1
    240       !(# o3_1, p3_1 #) = L.mac# u_3 m1 p2_2 o3
    241       !(# p3_2, q3_2 #) = L.mac# u_3 m2 q2_3 p3_1
    242       !(# q3_3, r3_3 #) = L.mac# u_3 m3 r2_3 q3_2
    243   in  (# o3_1, p3_2, q3_3, r3_3 #)
    244 {-# INLINE retr_inner# #-}
    245 
    246 retr#
    247   :: Limb4
    248   -> Limb4
    249 retr# f = retr_inner# f
    250 {-# INLINE retr# #-}
    251 
    252 -- | Retrieve a 'Montgomery' value from the Montgomery domain, producing
    253 --   a 'Wider' word.
    254 retr
    255   :: Montgomery -- ^ value in Montgomery form
    256   -> Wider      -- ^ retrieved value
    257 retr (Montgomery f) =
    258   let !res = retr# f
    259   in  (Wider res)
    260 
    261 -- | Montgomery multiplication (FIOS), without conditional subtract.
    262 mul_inner#
    263   :: Limb4              -- ^ x
    264   -> Limb4              -- ^ y
    265   -> (# Limb4, Limb #)  -- ^ product, meta-carry
    266 mul_inner# (# x0, x1, x2, x3 #) (# y0, y1, y2, y3 #) =
    267   let !(# m0, m1, m2, m3 #) =
    268         L4 0xBFD25E8CD0364141## 0xBAAEDCE6AF48A03B##
    269            0xFFFFFFFFFFFFFFFE## 0xFFFFFFFFFFFFFFFF##
    270       !n                           = Limb 0x4B0DFF665588B13F##
    271       !axy0                        = L.mul_c# x0 y0
    272       !u0                          = L.mul_w# (lo axy0) n
    273       !(# (# _, a0 #), c0 #)       = W.add_o# (L.mul_c# u0 m0) axy0
    274       !carry0                      = (# a0, c0 #)
    275       !axy0_1                      = L.mul_c# x0 y1
    276       !umc0_1                      = W.add_w# (L.mul_c# u0 m1) carry0
    277       !(# (# o0, ab0_1 #), c0_1 #) = W.add_o# axy0_1 umc0_1
    278       !carry0_1                    = (# ab0_1, c0_1 #)
    279       !axy0_2                      = L.mul_c# x0 y2
    280       !umc0_2                      = W.add_w# (L.mul_c# u0 m2) carry0_1
    281       !(# (# p0, ab0_2 #), c0_2 #) = W.add_o# axy0_2 umc0_2
    282       !carry0_2                    = (# ab0_2, c0_2 #)
    283       !axy0_3                      = L.mul_c# x0 y3
    284       !umc0_3                      = W.add_w# (L.mul_c# u0 m3) carry0_2
    285       !(# (# q0, ab0_3 #), c0_3 #) = W.add_o# axy0_3 umc0_3
    286       !carry0_3                    = (# ab0_3, c0_3 #)
    287       !(# r0, mc0 #)               = carry0_3
    288       !axy1                        = wadd_w# (L.mul_c# x1 y0) o0
    289       !u1                          = L.mul_w# (lo axy1) n
    290       !(# (# _, a1 #), c1 #)       = W.add_o# (L.mul_c# u1 m0) axy1
    291       !carry1                      = (# a1, c1 #)
    292       !axy1_1                      = wadd_w# (L.mul_c# x1 y1) p0
    293       !umc1_1                      = W.add_w# (L.mul_c# u1 m1) carry1
    294       !(# (# o1, ab1_1 #), c1_1 #) = W.add_o# axy1_1 umc1_1
    295       !carry1_1                    = (# ab1_1, c1_1 #)
    296       !axy1_2                      = wadd_w# (L.mul_c# x1 y2) q0
    297       !umc1_2                      = W.add_w# (L.mul_c# u1 m2) carry1_1
    298       !(# (# p1, ab1_2 #), c1_2 #) = W.add_o# axy1_2 umc1_2
    299       !carry1_2                    = (# ab1_2, c1_2 #)
    300       !axy1_3                      = wadd_w# (L.mul_c# x1 y3) r0
    301       !umc1_3                      = W.add_w# (L.mul_c# u1 m3) carry1_2
    302       !(# (# q1, ab1_3 #), c1_3 #) = W.add_o# axy1_3 umc1_3
    303       !carry1_3                    = (# ab1_3, c1_3 #)
    304       !(# r1, mc1 #)               = wadd_w# carry1_3 mc0
    305       !axy2                        = wadd_w# (L.mul_c# x2 y0) o1
    306       !u2                          = L.mul_w# (lo axy2) n
    307       !(# (# _, a2 #), c2 #)       = W.add_o# (L.mul_c# u2 m0) axy2
    308       !carry2                      = (# a2, c2 #)
    309       !axy2_1                      = wadd_w# (L.mul_c# x2 y1) p1
    310       !umc2_1                      = W.add_w# (L.mul_c# u2 m1) carry2
    311       !(# (# o2, ab2_1 #), c2_1 #) = W.add_o# axy2_1 umc2_1
    312       !carry2_1                    = (# ab2_1, c2_1 #)
    313       !axy2_2                      = wadd_w# (L.mul_c# x2 y2) q1
    314       !umc2_2                      = W.add_w# (L.mul_c# u2 m2) carry2_1
    315       !(# (# p2, ab2_2 #), c2_2 #) = W.add_o# axy2_2 umc2_2
    316       !carry2_2                    = (# ab2_2, c2_2 #)
    317       !axy2_3                      = wadd_w# (L.mul_c# x2 y3) r1
    318       !umc2_3                      = W.add_w# (L.mul_c# u2 m3) carry2_2
    319       !(# (# q2, ab2_3 #), c2_3 #) = W.add_o# axy2_3 umc2_3
    320       !carry2_3                    = (# ab2_3, c2_3 #)
    321       !(# r2, mc2 #)               = wadd_w# carry2_3 mc1
    322       !axy3                        = wadd_w# (L.mul_c# x3 y0) o2
    323       !u3                          = L.mul_w# (lo axy3) n
    324       !(# (# _, a3 #), c3 #)       = W.add_o# (L.mul_c# u3 m0) axy3
    325       !carry3                      = (# a3, c3 #)
    326       !axy3_1                      = wadd_w# (L.mul_c# x3 y1) p2
    327       !umc3_1                      = W.add_w# (L.mul_c# u3 m1) carry3
    328       !(# (# o3, ab3_1 #), c3_1 #) = W.add_o# axy3_1 umc3_1
    329       !carry3_1                    = (# ab3_1, c3_1 #)
    330       !axy3_2                      = wadd_w# (L.mul_c# x3 y2) q2
    331       !umc3_2                      = W.add_w# (L.mul_c# u3 m2) carry3_1
    332       !(# (# p3, ab3_2 #), c3_2 #) = W.add_o# axy3_2 umc3_2
    333       !carry3_2                    = (# ab3_2, c3_2 #)
    334       !axy3_3                      = wadd_w# (L.mul_c# x3 y3) r2
    335       !umc3_3                      = W.add_w# (L.mul_c# u3 m3) carry3_2
    336       !(# (# q3, ab3_3 #), c3_3 #) = W.add_o# axy3_3 umc3_3
    337       !carry3_3                    = (# ab3_3, c3_3 #)
    338       !(# r3, mc3 #)               = wadd_w# carry3_3 mc2
    339   in  (# (# o3, p3, q3, r3 #), mc3 #)
    340 {-# INLINE mul_inner# #-}
    341 
    342 mul#
    343   :: Limb4
    344   -> Limb4
    345   -> Limb4
    346 mul# a b =
    347   let -- group order
    348       !m = L4 0xBFD25E8CD0364141## 0xBAAEDCE6AF48A03B##
    349               0xFFFFFFFFFFFFFFFE## 0xFFFFFFFFFFFFFFFF##
    350       !(# nu, mc #) = mul_inner# a b
    351   in  WW.sub_mod_c# nu mc m m
    352 {-# NOINLINE mul# #-} -- cannot be inlined without exploding comp time
    353 
    354 -- | Multiplication in the Montgomery domain.
    355 --
    356 --   Note that 'Montgomery' is an instance of 'Num', so you can use '*'
    357 --   to apply this function.
    358 --
    359 --   >>> 1 * 1 :: Montgomery
    360 --   1
    361 mul
    362   :: Montgomery -- ^ multiplicand in montgomery form
    363   -> Montgomery -- ^ multiplier in montgomery form
    364   -> Montgomery -- ^ montgomery product
    365 mul (Montgomery a) (Montgomery b) = Montgomery (mul# a b)
    366 
    367 to#
    368   :: Limb4 -- ^ integer
    369   -> Limb4
    370 to# x =
    371   let !r2 = L4 0x896CF21467D7D140## 0x741496C20E7CF878## -- r^2 mod m
    372                0xE697F5E45BCD07C6## 0x9D671CD581C69BC5##
    373   in  mul# x r2
    374 {-# INLINE to# #-}
    375 
    376 -- | Convert a 'Wider' word to the Montgomery domain.
    377 to :: Wider -> Montgomery
    378 to (Wider x) = Montgomery (to# x)
    379 
    380 -- | Retrieve a 'Montgomery' word from the Montgomery domain.
    381 --
    382 --   This function is a synonym for 'retr'.
    383 from :: Montgomery -> Wider
    384 from = retr
    385 
    386 add#
    387   :: Limb4 -- ^ augend
    388   -> Limb4 -- ^ addend
    389   -> Limb4 -- ^ sum
    390 add# a b =
    391   let -- group order
    392       !m = L4 0xBFD25E8CD0364141## 0xBAAEDCE6AF48A03B##
    393               0xFFFFFFFFFFFFFFFE## 0xFFFFFFFFFFFFFFFF##
    394   in  WW.add_mod# a b m
    395 {-# INLINE add# #-}
    396 
    397 -- | Addition in the Montgomery domain.
    398 --
    399 --   Note that 'Montgomery' is an instance of 'Num', so you can use '+'
    400 --   to apply this function.
    401 --
    402 --   >>> 1 + 1 :: Montgomery
    403 --   2
    404 add
    405   :: Montgomery -- ^ augend
    406   -> Montgomery -- ^ addend
    407   -> Montgomery -- ^ sum
    408 add (Montgomery a) (Montgomery b) = Montgomery (add# a b)
    409 
    410 sub#
    411   :: Limb4 -- ^ minuend
    412   -> Limb4 -- ^ subtrahend
    413   -> Limb4 -- ^ difference
    414 sub# a b =
    415   let !m = L4 0xBFD25E8CD0364141## 0xBAAEDCE6AF48A03B##
    416               0xFFFFFFFFFFFFFFFE## 0xFFFFFFFFFFFFFFFF##
    417   in  WW.sub_mod# a b m
    418 {-# INLINE sub# #-}
    419 
    420 -- | Subtraction in the Montgomery domain.
    421 --
    422 --   Note that 'Montgomery' is an instance of 'Num', so you can use '-'
    423 --   to apply this function.
    424 --
    425 --   >>> 1 - 1 :: Montgomery
    426 --   0
    427 sub
    428   :: Montgomery -- ^ minuend
    429   -> Montgomery -- ^ subtrahend
    430   -> Montgomery -- ^ difference
    431 sub (Montgomery a) (Montgomery b) = Montgomery (sub# a b)
    432 
    433 neg#
    434   :: Limb4 -- ^ argument
    435   -> Limb4 -- ^ modular negation
    436 neg# a = sub# (L4 0## 0## 0## 0##) a
    437 {-# INLINE neg# #-}
    438 
    439 -- | Additive inverse in the Montgomery domain.
    440 --
    441 --   Note that 'Montgomery' is an instance of 'Num', so you can use 'negate'
    442 --   to apply this function.
    443 --
    444 --   >>> negate 1 :: Montgomery
    445 --   115792089237316195423570985008687907852837564279074904382605163141518161494336
    446 --   >>> (negate 1 :: Montgomery) + 1
    447 --   0
    448 neg :: Montgomery -> Montgomery
    449 neg (Montgomery a) = Montgomery (neg# a)
    450 
    451 sqr# :: Limb4 -> Limb4
    452 sqr# a =
    453   let !(# l, h #) = WW.sqr# a
    454   in  redc# l h
    455 {-# NOINLINE sqr# #-} -- cannot be inlined without exploding comp time
    456 
    457 -- | Squaring in the Montgomery domain.
    458 --
    459 --   >>> sqr 1
    460 --   1
    461 --   >>> sqr 2
    462 --   4
    463 --   >>> sqr (negate 2)
    464 --   4
    465 sqr
    466   :: Montgomery -- ^ argument
    467   -> Montgomery -- ^ square
    468 sqr (Montgomery a) = Montgomery (mul# a a)
    469 
    470 -- | Zero (the additive unit) in the Montgomery domain.
    471 zero :: Montgomery
    472 zero = Montgomery (L4 0## 0## 0## 0##)
    473 
    474 -- | One (the multiplicative unit) in the Montgomery domain.
    475 one :: Montgomery
    476 one = Montgomery (L4 0x402DA1732FC9BEBF## 0x4551231950B75FC4##
    477                      0x0000000000000001## 0x0000000000000000##)
    478 
    479 -- generated by etc/generate_inv.sh
    480 inv#
    481   :: Limb4
    482   -> Limb4
    483 inv# a =
    484   let
    485       !t1 = sqr# a
    486       !t2 = mul# t1 a
    487       !t3 = sqr# t2
    488       !t4 = sqr# t3
    489       !t5 = mul# t4 t2
    490       !t6 = sqr# t5
    491       !t7 = sqr# t6
    492       !t8 = sqr# t7
    493       !t9 = sqr# t8
    494       !t10 = mul# t9 t5
    495       !t11 = sqr# t10
    496       !t12 = sqr# t11
    497       !t13 = sqr# t12
    498       !t14 = sqr# t13
    499       !t15 = sqr# t14
    500       !t16 = sqr# t15
    501       !t17 = sqr# t16
    502       !t18 = sqr# t17
    503       !t19 = mul# t18 t10
    504       !t20 = sqr# t19
    505       !t21 = sqr# t20
    506       !t22 = sqr# t21
    507       !t23 = sqr# t22
    508       !t24 = sqr# t23
    509       !t25 = sqr# t24
    510       !t26 = sqr# t25
    511       !t27 = sqr# t26
    512       !t28 = sqr# t27
    513       !t29 = sqr# t28
    514       !t30 = sqr# t29
    515       !t31 = sqr# t30
    516       !t32 = sqr# t31
    517       !t33 = sqr# t32
    518       !t34 = sqr# t33
    519       !t35 = sqr# t34
    520       !t36 = mul# t35 t19
    521       !t37 = sqr# t36
    522       !t38 = sqr# t37
    523       !t39 = sqr# t38
    524       !t40 = sqr# t39
    525       !t41 = sqr# t40
    526       !t42 = sqr# t41
    527       !t43 = sqr# t42
    528       !t44 = sqr# t43
    529       !t45 = sqr# t44
    530       !t46 = sqr# t45
    531       !t47 = sqr# t46
    532       !t48 = sqr# t47
    533       !t49 = sqr# t48
    534       !t50 = sqr# t49
    535       !t51 = sqr# t50
    536       !t52 = sqr# t51
    537       !t53 = sqr# t52
    538       !t54 = sqr# t53
    539       !t55 = sqr# t54
    540       !t56 = sqr# t55
    541       !t57 = sqr# t56
    542       !t58 = sqr# t57
    543       !t59 = sqr# t58
    544       !t60 = sqr# t59
    545       !t61 = sqr# t60
    546       !t62 = sqr# t61
    547       !t63 = sqr# t62
    548       !t64 = sqr# t63
    549       !t65 = sqr# t64
    550       !t66 = sqr# t65
    551       !t67 = sqr# t66
    552       !t68 = sqr# t67
    553       !t69 = mul# t68 t36
    554       !t70 = sqr# t69
    555       !t71 = sqr# t70
    556       !t72 = sqr# t71
    557       !t73 = sqr# t72
    558       !t74 = sqr# t73
    559       !t75 = sqr# t74
    560       !t76 = sqr# t75
    561       !t77 = sqr# t76
    562       !t78 = sqr# t77
    563       !t79 = sqr# t78
    564       !t80 = sqr# t79
    565       !t81 = sqr# t80
    566       !t82 = sqr# t81
    567       !t83 = sqr# t82
    568       !t84 = sqr# t83
    569       !t85 = sqr# t84
    570       !t86 = sqr# t85
    571       !t87 = sqr# t86
    572       !t88 = sqr# t87
    573       !t89 = sqr# t88
    574       !t90 = sqr# t89
    575       !t91 = sqr# t90
    576       !t92 = sqr# t91
    577       !t93 = sqr# t92
    578       !t94 = sqr# t93
    579       !t95 = sqr# t94
    580       !t96 = sqr# t95
    581       !t97 = sqr# t96
    582       !t98 = sqr# t97
    583       !t99 = sqr# t98
    584       !t100 = sqr# t99
    585       !t101 = sqr# t100
    586       !t102 = mul# t101 t36
    587       !t103 = sqr# t102
    588       !t104 = sqr# t103
    589       !t105 = sqr# t104
    590       !t106 = sqr# t105
    591       !t107 = sqr# t106
    592       !t108 = sqr# t107
    593       !t109 = sqr# t108
    594       !t110 = sqr# t109
    595       !t111 = sqr# t110
    596       !t112 = sqr# t111
    597       !t113 = sqr# t112
    598       !t114 = sqr# t113
    599       !t115 = sqr# t114
    600       !t116 = sqr# t115
    601       !t117 = sqr# t116
    602       !t118 = sqr# t117
    603       !t119 = mul# t118 t19
    604       !t120 = sqr# t119
    605       !t121 = sqr# t120
    606       !t122 = sqr# t121
    607       !t123 = sqr# t122
    608       !t124 = sqr# t123
    609       !t125 = sqr# t124
    610       !t126 = sqr# t125
    611       !t127 = sqr# t126
    612       !t128 = mul# t127 t10
    613       !t129 = sqr# t128
    614       !t130 = sqr# t129
    615       !t131 = sqr# t130
    616       !t132 = sqr# t131
    617       !t133 = mul# t132 t5
    618       !t134 = sqr# t133
    619       !t135 = sqr# t134
    620       !t136 = mul# t135 t2
    621       !t137 = sqr# t136
    622       !t138 = mul# t137 a
    623       !t139 = sqr# t2
    624       !t140 = mul# t139 a
    625       !t141 = sqr# t5
    626       !t142 = sqr# t141
    627       !t143 = mul# t142 t2
    628       !t144 = sqr# t138
    629       !t145 = sqr# t144
    630       !t146 = mul# t145 a
    631       !t147 = sqr# t146
    632       !t148 = sqr# t147
    633       !t149 = sqr# t148
    634       !t150 = sqr# t149
    635       !t151 = mul# t150 t140
    636       !t152 = sqr# t151
    637       !t153 = sqr# t152
    638       !t154 = mul# t153 a
    639       !t155 = sqr# t154
    640       !t156 = sqr# t155
    641       !t157 = mul# t156 a
    642       !t158 = sqr# t157
    643       !t159 = sqr# t158
    644       !t160 = mul# t159 a
    645       !t161 = sqr# t160
    646       !t162 = sqr# t161
    647       !t163 = sqr# t162
    648       !t164 = sqr# t163
    649       !t165 = mul# t164 t140
    650       !t166 = sqr# t165
    651       !t167 = sqr# t166
    652       !t168 = sqr# t167
    653       !t169 = mul# t168 t2
    654       !t170 = sqr# t169
    655       !t171 = sqr# t170
    656       !t172 = sqr# t171
    657       !t173 = sqr# t172
    658       !t174 = mul# t173 t140
    659       !t175 = sqr# t174
    660       !t176 = sqr# t175
    661       !t177 = sqr# t176
    662       !t178 = sqr# t177
    663       !t179 = sqr# t178
    664       !t180 = mul# t179 t140
    665       !t181 = sqr# t180
    666       !t182 = sqr# t181
    667       !t183 = sqr# t182
    668       !t184 = sqr# t183
    669       !t185 = mul# t184 t2
    670       !t186 = sqr# t185
    671       !t187 = sqr# t186
    672       !t188 = mul# t187 a
    673       !t189 = sqr# t188
    674       !t190 = sqr# t189
    675       !t191 = mul# t190 a
    676       !t192 = sqr# t191
    677       !t193 = sqr# t192
    678       !t194 = sqr# t193
    679       !t195 = sqr# t194
    680       !t196 = sqr# t195
    681       !t197 = mul# t196 t5
    682       !t198 = sqr# t197
    683       !t199 = sqr# t198
    684       !t200 = mul# t199 a
    685       !t201 = sqr# t200
    686       !t202 = sqr# t201
    687       !t203 = sqr# t202
    688       !t204 = mul# t203 a
    689       !t205 = sqr# t204
    690       !t206 = sqr# t205
    691       !t207 = sqr# t206
    692       !t208 = sqr# t207
    693       !t209 = mul# t208 a
    694       !t210 = sqr# t209
    695       !t211 = sqr# t210
    696       !t212 = mul# t211 a
    697       !t213 = sqr# t212
    698       !t214 = sqr# t213
    699       !t215 = sqr# t214
    700       !t216 = sqr# t215
    701       !t217 = sqr# t216
    702       !t218 = sqr# t217
    703       !t219 = sqr# t218
    704       !t220 = sqr# t219
    705       !t221 = sqr# t220
    706       !t222 = sqr# t221
    707       !t223 = mul# t222 t140
    708       !t224 = sqr# t223
    709       !t225 = sqr# t224
    710       !t226 = sqr# t225
    711       !t227 = sqr# t226
    712       !t228 = mul# t227 t140
    713       !t229 = sqr# t228
    714       !t230 = sqr# t229
    715       !t231 = sqr# t230
    716       !t232 = sqr# t231
    717       !t233 = sqr# t232
    718       !t234 = sqr# t233
    719       !t235 = sqr# t234
    720       !t236 = sqr# t235
    721       !t237 = sqr# t236
    722       !t238 = mul# t237 t10
    723       !t239 = sqr# t238
    724       !t240 = sqr# t239
    725       !t241 = mul# t240 a
    726       !t242 = sqr# t241
    727       !t243 = sqr# t242
    728       !t244 = sqr# t243
    729       !t245 = mul# t244 a
    730       !t246 = sqr# t245
    731       !t247 = sqr# t246
    732       !t248 = sqr# t247
    733       !t249 = mul# t248 a
    734       !t250 = sqr# t249
    735       !t251 = sqr# t250
    736       !t252 = sqr# t251
    737       !t253 = sqr# t252
    738       !t254 = sqr# t253
    739       !t255 = mul# t254 t5
    740       !t256 = sqr# t255
    741       !t257 = sqr# t256
    742       !t258 = mul# t257 a
    743       !t259 = sqr# t258
    744       !t260 = sqr# t259
    745       !t261 = sqr# t260
    746       !t262 = sqr# t261
    747       !t263 = sqr# t262
    748       !t264 = mul# t263 t2
    749       !t265 = sqr# t264
    750       !t266 = sqr# t265
    751       !t267 = sqr# t266
    752       !t268 = sqr# t267
    753       !t269 = mul# t268 t2
    754       !t270 = sqr# t269
    755       !t271 = sqr# t270
    756       !t272 = mul# t271 a
    757       !t273 = sqr# t272
    758       !t274 = sqr# t273
    759       !t275 = sqr# t274
    760       !t276 = sqr# t275
    761       !t277 = sqr# t276
    762       !t278 = sqr# t277
    763       !t279 = sqr# t278
    764       !t280 = sqr# t279
    765       !t281 = mul# t280 t2
    766       !t282 = sqr# t281
    767       !t283 = sqr# t282
    768       !t284 = sqr# t283
    769       !t285 = mul# t284 t2
    770       !t286 = sqr# t285
    771       !t287 = sqr# t286
    772       !t288 = sqr# t287
    773       !t289 = mul# t288 a
    774       !t290 = sqr# t289
    775       !t291 = sqr# t290
    776       !t292 = sqr# t291
    777       !t293 = sqr# t292
    778       !t294 = sqr# t293
    779       !t295 = sqr# t294
    780       !t296 = mul# t295 a
    781       !t297 = sqr# t296
    782       !t298 = sqr# t297
    783       !t299 = sqr# t298
    784       !t300 = sqr# t299
    785       !t301 = sqr# t300
    786       !t302 = sqr# t301
    787       !t303 = sqr# t302
    788       !t304 = sqr# t303
    789       !t305 = mul# t304 t143
    790       !r = t305
    791   in  r
    792 {-# INLINE inv# #-}
    793 
    794 -- | Multiplicative inverse in the Montgomery domain.
    795 --
    796 --   Note that 'zero' has no multiplicative inverse; 'inv' returns
    797 --   'zero' when applied to it.
    798 --
    799 --   >> inv 2
    800 --   57896044618658097711785492504343953926418782139537452191302581570759080747169
    801 --   >> inv 2 * 2
    802 --   1
    803 inv
    804   :: Montgomery -- ^ argument
    805   -> Montgomery -- ^ inverse
    806 inv (Montgomery w) = Montgomery (inv# w)
    807 
    808 -- | Exponentiation in the Montgomery domain.
    809 --
    810 --   >>> exp 2 3
    811 --   8
    812 --   >>> exp 2 10
    813 --   1024
    814 exp :: Montgomery -> Wider -> Montgomery
    815 exp (Montgomery b) (Wider e) = Montgomery (exp# b e)
    816 
    817 exp#
    818   :: Limb4
    819   -> Limb4
    820   -> Limb4
    821 exp# b e =
    822   let !o = L4 0x402DA1732FC9BEBF## 0x4551231950B75FC4##
    823               0x0000000000000001## 0x0000000000000000##
    824       loop !r !m !ex n = case n of
    825         0 -> r
    826         _ ->
    827           let !(# ne, bit #) = WW.shr1_c# ex
    828               !candidate = mul# r m
    829               !nr = select# r candidate bit
    830               !nm = sqr# m
    831           in  loop nr nm ne (n - 1)
    832   in  loop o b e (256 :: Word)
    833 {-# INLINE exp# #-}
    834 
    835 odd# :: Limb4 -> C.Choice
    836 odd# = WW.odd#
    837 {-# INLINE odd# #-}
    838 
    839 -- | Check if a 'Montgomery' value is odd.
    840 --
    841 --   Note that the comparison is performed in constant time, but we
    842 --   branch when converting to 'Bool'.
    843 --
    844 --   >>> odd 1
    845 --   True
    846 --   >>> odd 2
    847 --   False
    848 --   >>> Data.Word.Wider.odd (retr 3) -- parity is preserved
    849 --   True
    850 odd_vartime :: Montgomery -> Bool
    851 odd_vartime (Montgomery m) = C.decide (odd# m)
    852 
    853 -- constant-time selection ----------------------------------------------------
    854 
    855 select#
    856   :: Limb4    -- ^ a
    857   -> Limb4    -- ^ b
    858   -> C.Choice -- ^ c
    859   -> Limb4    -- ^ result
    860 select# = WW.select#
    861 {-# INLINE select# #-}
    862 
    863 -- | Return b if c is truthy, otherwise return a.
    864 --
    865 --   >>> import qualified Data.Choice as C
    866 --   >>> select 0 1 (C.true# ())
    867 --   1
    868 select
    869   :: Montgomery    -- ^ a
    870   -> Montgomery    -- ^ b
    871   -> C.Choice      -- ^ c
    872   -> Montgomery    -- ^ result
    873 select (Montgomery a) (Montgomery b) c = Montgomery (select# a b c)
    874