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 (25583B)


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