ppad-fixed 0.1.2 → 0.1.3

raw patch · 8 files changed

+536/−478 lines, 8 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG +6/−0
• lib/Data/Choice.hs +94/−167
• lib/Data/Word/Limb.hs +21/−12
• lib/Data/Word/Wide.hs +117/−57
• lib/Data/Word/Wider.hs +138/−93
• lib/Numeric/Montgomery/Secp256k1/Curve.hs +76/−70
• lib/Numeric/Montgomery/Secp256k1/Scalar.hs +82/−77
• ppad-fixed.cabal +2/−2

@@ -1,5 +1,11 @@ # Changelog +- 0.1.3 (2025-12-28)+  * Makes some backward-incompatible API tweaks to Data.Choice:++    * 'from_word_mask# is now 'from_full_mask#'+    * 'from_word#' is now 'from_bit#'+ - 0.1.2 (2025-12-27)   * Fixes an API mistake made in the v0.1.1 release. 

@@ -11,41 +11,34 @@ -- License: MIT -- Maintainer: Jared Tobin <jared@ppad.tech> ----- Constant-time choice.+-- Primitives for constant-time choice.+--+-- The 'Choice' type encodes truthy and falsy values as unboxed 'Word#'+-- bit masks.+--+-- Use the standard logical primitives ('or', 'and', 'xor', 'not', eq')+-- to manipulate in-flight 'Choice' values. Use one of the selection+-- functions to use a 'Choice' to select a value in constant time,+-- or 'decide' to reduce a 'Choice' to a 'Bool' at the /end/ of a+-- sensitive computation.  module Data.Choice (   -- * Choice     Choice+  , decide   , true#   , false#-  , decide   , to_word# -  -- * MaybeWord#-  , MaybeWord#(..)-  , some_word#-  , none_word#--  -- * MaybeWide#-  , MaybeWide#(..)-  , some_wide#-  , just_wide#-  , none_wide#-  , expect_wide#-  , expect_wide_or#-   -- * Construction-  , from_word_mask#-  , from_word#+  , from_full_mask#+  , from_bit#   , from_word_nonzero#   , from_word_eq#   , from_word_le#   , from_word_lt#   , from_word_gt# -  , from_wide#-  , from_wide_le#-   -- * Manipulation   , or   , and@@ -72,82 +65,52 @@  -- utilities ------------------------------------------------------------------ +type Limb2 = (# Word#, Word# #)++type Limb4 = (# Word#, Word#, Word#, Word# #)+ -- wrapping negation neg_w# :: Word# -> Word# neg_w# w = Exts.plusWord# (Exts.not# w) 1## {-# INLINE neg_w# #-} -hi# :: Word# -> (# Word#, Word# #)+hi# :: Word# -> Limb2 hi# w = (# 0##, w #) {-# INLINE hi# #-} -lo# :: Word# -> (# Word#, Word# #)+lo# :: Word# -> Limb2 lo# w = (# w, 0## #) {-# INLINE lo# #-} -not_w# :: (# Word#, Word# #) -> (# Word#, Word# #)-not_w# (# a0, a1 #) = (# Exts.not# a0, Exts.not# a1 #)-{-# INLINE not_w# #-}--or_w# :: (# Word#, Word# #) -> (# Word#, Word# #) -> (# Word#, Word# #)+or_w# :: Limb2 -> Limb2 -> Limb2 or_w# (# a0, a1 #) (# b0, b1 #) = (# Exts.or# a0 b0, Exts.or# a1 b1 #) {-# INLINE or_w# #-} -and_w# :: (# Word#, Word# #) -> (# Word#, Word# #) -> (# Word#, Word# #)+and_w# :: Limb2 -> Limb2 -> Limb2 and_w# (# a0, a1 #) (# b0, b1 #) = (# Exts.and# a0 b0, Exts.and# a1 b1 #) {-# INLINE and_w# #-} -xor_w# :: (# Word#, Word# #) -> (# Word#, Word# #) -> (# Word#, Word# #)+xor_w# :: Limb2 -> Limb2 -> Limb2 xor_w# (# a0, a1 #) (# b0, b1 #) = (# Exts.xor# a0 b0, Exts.xor# a1 b1 #) {-# INLINE xor_w# #-} --- subtract-with-borrow-sub_b# :: Word# -> Word# -> Word# -> (# Word#, Word# #)-sub_b# m n b =-  let !(# d0, b0 #) = Exts.subWordC# m n-      !(#  d, b1 #) = Exts.subWordC# d0 b-      !c = Exts.int2Word# (Exts.orI# b0 b1)-  in  (# d, c #)-{-# INLINE sub_b# #-}---- wide subtract-with-borrow-sub_wb#-  :: (# Word#, Word# #)-  -> (# Word#, Word# #)-  -> (# Word#, Word#, Word# #)-sub_wb# (# a0, a1 #) (# b0, b1 #) =-  let !(# s0, c0 #) = sub_b# a0 b0 0##-      !(# s1, c1 #) = sub_b# a1 b1 c0-  in  (# s0, s1, c1 #)-{-# INLINE sub_wb# #-}---- wide subtraction (wrapping)-sub_w#-  :: (# Word#, Word# #)-  -> (# Word#, Word# #)-  -> (# Word#, Word# #)-sub_w# a b =-  let !(# c0, c1, _ #) = sub_wb# a b-  in  (# c0, c1 #)-{-# INLINE sub_w# #-}- -- choice ---------------------------------------------------------------------  -- | Constant-time choice, encoded as a mask. -----   Note that 'Choice' is defined as an unboxed newtype, and so a+--   Note that 'Choice' is defined as an unlifted newtype, and so a --   'Choice' value cannot be bound at the top level. You should work --   with it locally in the context of a computation. -----   It's safe to 'decide' a choice, reducing it to a 'Bool', at any---   time, but the general encouraged pattern is to do that only at the---   end of a computation.+--   Use one of the selection functions to select a 'Choice' value in+--   constant time, or 'decide' to reduce it to a 'Bool' at the /end/ of+--   a sensitive computation. -- --   >>> decide (or# (false# ()) (true# ())) --   True newtype Choice = Choice Word# --- | Construct the falsy value.+-- | Construct the falsy 'Choice'. -- --   >>> decide (false# ()) --   False@@ -155,7 +118,7 @@ false# _ = Choice 0## {-# INLINE false# #-} --- | Construct the truthy value.+-- | Construct the truthy 'Choice'. -- --   >>> decide (true# ()) --   True@@ -166,6 +129,13 @@  -- | Decide a 'Choice' by reducing it to a 'Bool'. --+--   The 'decide' function itself runs in constant time, but once+--   it reduces a 'Choice' to a 'Bool', any subsequent branching on+--   the result is liable to introduce variable-time behaviour.+--+--   You should 'decide' only at the /end/ of a computation, after all+--   security-sensitive computations have been carried out.+-- --   >>> decide (true# ()) --   True decide :: Choice -> Bool@@ -173,91 +143,44 @@ {-# INLINE decide #-}  -- | Convert a 'Choice' to an unboxed 'Word#'.+--+--   This essentially "unboxes" the 'Choice' for direct manipulation.+--+--   >>> import qualified GHC.Exts as Exts+--   >>> Exts.isTrue# (Exts.eqWord# 0## (to_word# (false# ())))+--   True to_word# :: Choice -> Word# to_word# (Choice c) = Exts.and# c 1## {-# INLINE to_word# #-} --- constant time 'Maybe Word#'-newtype MaybeWord# = MaybeWord# (# Word#, Choice #)--some_word# :: Word# -> MaybeWord#-some_word# w = MaybeWord# (# w, true# () #)-{-# INLINE some_word# #-}--none_word# :: Word# -> MaybeWord#-none_word# w = MaybeWord# (# w, false# () #)-{-# INLINE none_word# #-}---- constant time 'Maybe (# Word#, Word# #)'-newtype MaybeWide# = MaybeWide# (# (# Word#, Word# #), Choice #)--just_wide# :: (# Word#, Word# #) -> Choice -> MaybeWide#-just_wide# w c = MaybeWide# (# w, c #)-{-# INLINE just_wide# #-}--some_wide# :: (# Word#, Word# #) -> MaybeWide#-some_wide# w = MaybeWide# (# w, true# () #)-{-# INLINE some_wide# #-}--none_wide# :: (# Word#, Word# #) -> MaybeWide#-none_wide# w = MaybeWide# (# w, false# () #)-{-# INLINE none_wide# #-}--expect_wide# :: MaybeWide# -> String -> (# Word#, Word# #)-expect_wide# (MaybeWide# (# w, Choice c #)) msg-    | Exts.isTrue# (Exts.eqWord# c t#) = w-    | otherwise = error $ "ppad-fixed (expect_wide#): " <> msg-  where-    !(Choice t#) = true# ()-{-# INLINE expect_wide# #-}--expect_wide_or# :: MaybeWide# -> (# Word#, Word# #) -> (# Word#, Word# #)-expect_wide_or# (MaybeWide# (# w, Choice c #)) alt-    | Exts.isTrue# (Exts.eqWord# c t#) = w-    | otherwise = alt-  where-    !(Choice t#) = true# ()-{-# INLINE expect_wide_or# #-}- -- construction --------------------------------------------------------------- --- | Construct a 'Choice' from an unboxed mask.+-- | Construct a 'Choice' from an unboxed full-word mask. -----   The input is /not/ checked.+--   The input is /not/ checked to be a full-word mask. -----   >>> decide (from_word_mask# 0##)+--   >>> decide (from_full_mask# 0##) --   False---   >>> decide (from_word_mask# 0xFFFFFFFFF_FFFFFFFF##)+--   >>> decide (from_full_mask# 0xFFFFFFFFF_FFFFFFFF##) --   True-from_word_mask# :: Word# -> Choice-from_word_mask# w = Choice w-{-# INLINE from_word_mask# #-}+from_full_mask# :: Word# -> Choice+from_full_mask# w = Choice w+{-# INLINE from_full_mask# #-}  -- | Construct a 'Choice' from an unboxed word, which should be either --   0## or 1##. -----   The input is /not/ checked.+--   The input is /not/ checked to be a bit. -----   >>> decide (from_word# 1##)+--   >>> decide (from_bit# 1##) --   True-from_word# :: Word# -> Choice-from_word# w = Choice (neg_w# w)-{-# INLINE from_word# #-}---- | Construct a 'Choice' from a two-limb word, constructing a mask from---   the lower limb, which should be 0## or 1##.------   The input is /not/ checked.------   >>> decide (from_wide# (# 0##, 1## #))---   False-from_wide# :: (# Word#, Word# #) -> Choice-from_wide# (# l, _ #) = from_word# l-{-# INLINE from_wide# #-}+from_bit# :: Word# -> Choice+from_bit# w = Choice (neg_w# w)+{-# INLINE from_bit# #-}  -- | Construct a 'Choice' from a /nonzero/ unboxed word. -----   The input is /not/ checked.+--   The input is /not/ checked to be nonzero. -- --   >>> decide (from_word_nonzero# 2##) --   True@@ -266,7 +189,7 @@   let !n = neg_w# w       !s = case B.finiteBitSize (0 :: Word) of I# m -> m Exts.-# 1#       !v = Exts.uncheckedShiftRL# (Exts.or# w n) s-  in  from_word# v+  in  from_bit# v {-# INLINE from_word_nonzero# #-}  -- | Construct a 'Choice' from an equality comparison.@@ -280,7 +203,7 @@   Choice w -> Choice (Exts.not# w) {-# INLINE from_word_eq# #-} --- | Construct a 'Choice from an at most comparison.+-- | Construct a 'Choice from an at-most comparison. -- --   >>> decide (from_word_le# 0## 1##) --   True@@ -295,28 +218,9 @@             (Exts.or# (Exts.not# x) y)             (Exts.or# (Exts.xor# x y) (Exts.not# (Exts.minusWord# y x))))           s-  in  from_word# bit+  in  from_bit# bit {-# INLINE from_word_le# #-} --- | Construct a 'Choice' from an at most comparison on a two-limb---   unboxed word.------   >>> decide (from_wide_le# (# 0##, 0## #) (# 1##, 0## #))---   True---   >>> decide (from_wide_le# (# 1##, 0## #) (# 1##, 0## #))---   True-from_wide_le# :: (# Word#, Word# #) -> (# Word#, Word# #) -> Choice-from_wide_le# x y =-  let !s = case B.finiteBitSize (0 :: Word) of I# m -> m Exts.-# 1#-      !mask =-        (and_w#-          (or_w# (not_w# x) y)-          (or_w# (xor_w# x y) (not_w# (sub_w# y x))))-      !bit = case mask of-        (# l, _ #) -> Exts.uncheckedShiftRL# l s-  in  from_word# bit-{-# INLINE from_wide_le# #-}- -- | Construct a 'Choice' from a less-than comparison. -- --   >>> decide (from_word_lt# 0## 1##)@@ -332,7 +236,7 @@             (Exts.and# (Exts.not# x) y)             (Exts.and# (Exts.or# (Exts.not# x) y) (Exts.minusWord# x y)))           s-  in  from_word# bit+  in  from_bit# bit {-# INLINE from_word_lt# #-}  -- | Construct a 'Choice' from a greater-than comparison.@@ -348,59 +252,82 @@ -- manipulation ---------------------------------------------------------------  -- | Logically negate a 'Choice'.+--+--   >>> decide (not (true# ()))+--   False+--   >>> decide (not (false# ()))+--   True not :: Choice -> Choice not (Choice w) = Choice (Exts.not# w) {-# INLINE not #-}  -- | Logical disjunction on 'Choice' values.+--+--   >>> decide (or (true# ()) (false# ()))+--   True or :: Choice -> Choice -> Choice or (Choice w0) (Choice w1) = Choice (Exts.or# w0 w1) {-# INLINE or #-}  -- | Logical conjunction on 'Choice' values.+--+--   >>> decide (and (true# ()) (false# ()))+--   False and :: Choice -> Choice -> Choice and (Choice w0) (Choice w1) = Choice (Exts.and# w0 w1) {-# INLINE and #-}  -- | Logical inequality on 'Choice' values.+--+--   >>> decide (xor (true# ()) (false# ()))+--   True xor :: Choice -> Choice -> Choice xor (Choice w0) (Choice w1) = Choice (Exts.xor# w0 w1) {-# INLINE xor #-}  -- | Logical inequality on 'Choice' values.+--+--   >>> decide (ne (true# ()) (false# ()))+--   True ne :: Choice -> Choice -> Choice ne c0 c1 = xor c0 c1 {-# INLINE ne #-}  -- | Logical equality on 'Choice' values.+--+--   >>> decide (eq (true# ()) (false# ()))+--   False eq :: Choice -> Choice -> Choice eq c0 c1 = not (ne c0 c1) {-# INLINE eq #-}  -- constant-time selection ---------------------------------------------------- --- | Select an unboxed word, given a 'Choice'.+-- | Select an unboxed word without branching, given a 'Choice'.+--+--   >>> let w = C.select_word# 0## 1## (C.true# ()) in GHC.Word.W# w+--   1 select_word# :: Word# -> Word# -> Choice -> Word# select_word# a b (Choice c) = Exts.xor# a (Exts.and# c (Exts.xor# a b)) {-# INLINE select_word# #-} --- | Select an unboxed two-limb word, given a 'Choice'.+-- | Select an unboxed two-limb word without branching, given a 'Choice'. select_wide#-  :: (# Word#, Word# #)-  -> (# Word#, Word# #)+  :: Limb2+  -> Limb2   -> Choice-  -> (# Word#, Word# #)+  -> Limb2 select_wide# a b (Choice w) =   let !mask = or_w# (hi# w) (lo# w)   in  xor_w# a (and_w# mask (xor_w# a b)) {-# INLINE select_wide# #-} --- | Select an unboxed four-limb word, given a 'Choice'.+-- | Select an unboxed four-limb word without branching, given a 'Choice'. select_wider#-  :: (# Word#, Word#, Word#, Word# #)-  -> (# Word#, Word#, Word#, Word# #)+  :: Limb4+  -> Limb4   -> Choice-  -> (# Word#, Word#, Word#, Word# #)+  -> Limb4 select_wider# (# a0, a1, a2, a3 #) (# b0, b1, b2, b3 #) (Choice w) =   let !w0 = Exts.xor# a0 (Exts.and# w (Exts.xor# a0 b0))       !w1 = Exts.xor# a1 (Exts.and# w (Exts.xor# a1 b1))@@ -428,8 +355,8 @@ --   >>> decide (eq_wide (# 0##, 0## #) (# 0##, 0## #)) --   True eq_wide#-  :: (# Word#, Word# #)-  -> (# Word#, Word# #)+  :: Limb2+  -> Limb2   -> Choice eq_wide# (# a0, a1 #) (# b0, b1 #) =   let !s = case B.finiteBitSize (0 :: Word) of I# m -> m Exts.-# 1#@@ -443,8 +370,8 @@ --   >>> let zero = (# 0##, 0##, 0##, 0## #) in decide (eq_wider# zero zero) --   True eq_wider#-  :: (# Word#, Word#, Word#, Word# #)-  -> (# Word#, Word#, Word#, Word# #)+  :: Limb4+  -> Limb4   -> Choice eq_wider# (# a0, a1, a2, a3 #) (# b0, b1, b2, b3 #) =   let !s = case B.finiteBitSize (0 :: Word) of I# m -> m Exts.-# 1#

@@ -14,6 +14,9 @@ -- Maintainer: Jared Tobin <jared@ppad.tech> -- -- The primitive 'Limb' type, as well as operations on it.+--+-- All operations run in constant time with respect to inputs, unless+-- specifically indicated otherwise.  module Data.Word.Limb (   -- * Limb@@ -63,6 +66,10 @@   , mul_s#    , mac#++  -- * Re-exported+  , Word(..)+  , Word#   ) where  import qualified Data.Bits as B@@ -79,7 +86,7 @@  -- comparison ----------------------------------------------------------------- --- | Equality comparison.+-- | Constant-time equality comparison. eq#   :: Limb   -> Limb@@ -87,6 +94,7 @@ eq# (Limb a) (Limb b) = C.eq_word# a b {-# INLINE eq# #-} +-- | Variable-time equality comparison. eq_vartime#   :: Limb   -> Limb@@ -94,7 +102,7 @@ eq_vartime# (Limb a) (Limb b) = Exts.isTrue# (Exts.eqWord# a b) {-# INLINE eq_vartime# #-} --- | Inequality comparison.+-- | Constant-time inequality comparison. ne#   :: Limb   -> Limb@@ -102,6 +110,7 @@ ne# a b = C.not (eq# a b) {-# INLINE ne# #-} +-- | Variable-time inequality comparison. ne_vartime#   :: Limb   -> Limb@@ -109,14 +118,14 @@ ne_vartime# a b = not (eq_vartime# a b) {-# INLINE ne_vartime# #-} --- | Comparison to zero.+-- | Constant-time comparison to zero. nonzero#   :: Limb   -> C.Choice nonzero# (Limb a) = C.from_word_nonzero# a {-# INLINE nonzero# #-} --- | Less than.+-- | Constant-time less than comparison. lt#   :: Limb   -> Limb@@ -124,7 +133,7 @@ lt# (Limb a) (Limb b) = C.from_word_lt# a b {-# INLINE lt# #-} --- | Greater than.+-- | Constant-time greater than comparison. gt#   :: Limb   -> Limb@@ -132,7 +141,7 @@ gt# (Limb a) (Limb b) = C.from_word_gt# a b {-# INLINE gt# #-} --- selection ------------------------------------------------------------------+-- constant-time selection ----------------------------------------------------  -- | Return a if c is truthy, otherwise return b. select#@@ -195,10 +204,10 @@ bits# (Limb a) =   let !_BITS = B.finiteBitSize (0 :: Word)       !zs = B.countLeadingZeros (Exts.W# a)-  in  _BITS - zs -- XX unbox?+  in  _BITS - zs {-# INLINE bits# #-} --- | Bit-shift left.+-- | Unchecked bit-shift left. shl#   :: Limb       -- ^ limb   -> Exts.Int#  -- ^ shift amount@@ -206,7 +215,7 @@ shl# (Limb w) s = Limb (Exts.uncheckedShiftL# w s) {-# INLINE shl# #-} --- | Bit-shift left by 1, returning the result and carry.+-- | Unchecked bit-shift left by 1, returning the result and carry. shl1#   :: Limb   -> (# Limb, Limb #)@@ -217,7 +226,7 @@   in  (# Limb r, Limb c #) {-# INLINE shl1# #-} --- | Bit-shift right.+-- | Unchecked logical bit-shift right. shr#   :: Limb       -- ^ limb   -> Exts.Int#  -- ^ shift amount@@ -225,7 +234,7 @@ shr# (Limb w) s = Limb (Exts.uncheckedShiftRL# w s) {-# INLINE shr# #-} --- | Bit-shift right by 1, returning the result and carry.+-- | Unchecked logical bit-shift right by 1, returning the result and carry. shr1#   :: Limb   -> (# Limb, Limb #)@@ -317,7 +326,7 @@   -> Limb -- ^ difference sub_s# (Limb m) (Limb n) =   let !(# d, b #) = Exts.subWordC# m n-      !borrow = C.from_word# (Exts.int2Word# b)+      !borrow = C.from_bit# (Exts.int2Word# b)   in  Limb (C.select_word# d 0## borrow) {-# INLINE sub_s# #-} 

@@ -25,6 +25,10 @@   , to_vartime   , from_vartime +  -- * Constant-time selection+  , select+  , select#+   -- * Bit Manipulation   , or   , or#@@ -36,6 +40,7 @@   , not#    -- * Comparison+  , eq   , eq_vartime    -- * Arithmetic@@ -60,7 +65,6 @@ import qualified Data.Choice as C import Data.Word.Limb (Limb(..)) import qualified Data.Word.Limb as L-import GHC.Exts import Prelude hiding (div, mod, or, and, not, quot, rem, recip)  -- utilities ------------------------------------------------------------------@@ -71,14 +75,14 @@  -- wide words ----------------------------------------------------------------- -pattern Limb2-  :: Word# -> Word#-  -> (# Limb, Limb #)-pattern Limb2 w0 w1 = (# Limb w0, Limb w1 #)-{-# COMPLETE Limb2 #-}+type Limb2 = (# Limb, Limb #) +pattern L2 :: L.Word# -> L.Word# -> Limb2+pattern L2 w0 w1 = (# Limb w0, Limb w1 #)+{-# COMPLETE L2 #-}+ -- | Little-endian wide words.-data Wide = Wide !(# Limb, Limb #)+data Wide = Wide !Limb2  instance Show Wide where   show = show . from_vartime@@ -97,7 +101,7 @@     let !(Limb l) = l0 `L.or#` l1         !n = C.from_word_nonzero# l         !b = C.to_word# n-    in  Wide (Limb2 b 0##)+    in  Wide (L2 b 0##)  instance NFData Wide where   rnf (Wide a) = case a of (# _, _ #) -> ()@@ -106,9 +110,10 @@  -- | Construct a 'Wide' word from low and high 'Word's. wide :: Word -> Word -> Wide-wide (W# l) (W# h) = Wide (# Limb l, Limb h #)+wide (L.W# l) (L.W# h) = Wide (# Limb l, Limb h #)+{-# INLINE wide #-} --- | Convert an 'Integer' to a 'Wide' word.+-- | Convert an 'Integer' to a 'Wide' word in variable time. -- --   >>> to_vartime 1 --   1@@ -116,78 +121,133 @@ to_vartime n =   let !size = B.finiteBitSize (0 :: Word)       !mask = fi (maxBound :: Word) :: Integer-      !(W# w0) = fi (n .&. mask)-      !(W# w1) = fi ((n .>>. size) .&. mask)+      !(L.W# w0) = fi (n .&. mask)+      !(L.W# w1) = fi ((n .>>. size) .&. mask)   in  Wide (# Limb w0, Limb w1 #)+{-# INLINABLE to_vartime #-} --- | Convert a 'Wide' word to an 'Integer'.+-- | Convert a 'Wide' word to an 'Integer' in variable time. -- --   >>> from_vartime 1 --   1 from_vartime :: Wide -> Integer from_vartime (Wide (# Limb a, Limb b #)) =-      fi (W# b) .<<. (B.finiteBitSize (0 :: Word))-  .|. fi (W# a)+      fi (L.W# b) .<<. (B.finiteBitSize (0 :: Word))+  .|. fi (L.W# a)+{-# INLINABLE from_vartime #-}  -- comparison ----------------------------------------------------------------- +-- | Compare 'Wide' words for equality in constant time.+--+--   >>> import qualified Data.Chocie as C+--   >>> C.decide (eq 1 1)+--   True+eq :: Wide -> Wide -> C.Choice+eq (Wide (# Limb a0, Limb a1 #)) (Wide (# Limb b0, Limb b1 #)) =+  C.eq_wide# (# a0, a1 #) (# b0, b1 #)+{-# INLINABLE eq #-}+ -- | Compare 'Wide' words for equality in variable time.+--+--   >>> eq_vartime 1 1+--   True eq_vartime :: Wide -> Wide -> Bool-eq_vartime (Wide (# Limb a0, Limb b0 #)) (Wide (# Limb a1, Limb b1 #)) =-  isTrue# (andI# (eqWord# a0 a1) (eqWord# b0 b1))+eq_vartime (Wide (# a0, b0 #)) (Wide (# a1, b1 #)) =+  L.eq_vartime# a0 a1 && L.eq_vartime# b0 b1+{-# INLINABLE eq_vartime #-} +-- constant-time selection-----------------------------------------------------++-- | Return a if c is truthy, otherwise return b.+--+--   >>> import qualified Data.Choice as C+--   >>> select 0 1 (C.true# ())+--   1+select+  :: Wide     -- ^ a+  -> Wide     -- ^ b+  -> C.Choice -- ^ c+  -> Wide     -- ^ result+select (Wide a) (Wide b) c = Wide (select# a b c)+{-# INLINABLE select #-}++select#+  :: Limb2    -- ^ a+  -> Limb2    -- ^ b+  -> C.Choice -- ^ c+  -> Limb2    -- ^ result+select# (L2 a0 a1) (L2 b0 b1) c =+  let !(# w0, w1 #) = C.select_wide# (# a0, a1 #) (# b0, b1 #) c+  in  L2 w0 w1+{-# INLINE select# #-}+ -- bits ----------------------------------------------------------------------- -or_w# :: (# Limb, Limb #) -> (# Limb, Limb #) -> (# Limb, Limb #)-or_w# (# a0, a1 #) (# b0, b1 #) = (# L.or# a0 b0, L.or# a1 b1 #)-{-# INLINE or_w# #-}+or# :: Limb2 -> Limb2 -> Limb2+or# (# a0, a1 #) (# b0, b1 #) = (# L.or# a0 b0, L.or# a1 b1 #)+{-# INLINE or# #-} +-- | Logical disjunction on 'Wide' words. or :: Wide -> Wide -> Wide-or (Wide a) (Wide b) = Wide (or_w# a b)+or (Wide a) (Wide b) = Wide (or# a b)+{-# INLINABLE or #-} -and_w# :: (# Limb, Limb #) -> (# Limb, Limb #) -> (# Limb, Limb #)-and_w# (# a0, a1 #) (# b0, b1 #) = (# L.and# a0 b0, L.and# a1 b1 #)-{-# INLINE and_w# #-}+and# :: Limb2 -> Limb2 -> Limb2+and# (# a0, a1 #) (# b0, b1 #) = (# L.and# a0 b0, L.and# a1 b1 #)+{-# INLINE and# #-} +-- | Logical conjunction on 'Wide' words. and :: Wide -> Wide -> Wide-and (Wide a) (Wide b) = Wide (and_w# a b)+and (Wide a) (Wide b) = Wide (and# a b)+{-# INLINABLE and #-} -xor_w# :: (# Limb, Limb #) -> (# Limb, Limb #) -> (# Limb, Limb #)-xor_w# (# a0, a1 #) (# b0, b1 #) = (# L.xor# a0 b0, L.xor# a1 b1 #)-{-# INLINE xor_w# #-}+xor# :: Limb2 -> Limb2 -> Limb2+xor# (# a0, a1 #) (# b0, b1 #) = (# L.xor# a0 b0, L.xor# a1 b1 #)+{-# INLINE xor# #-} +-- | Logical exclusive-or on 'Wide' words. xor :: Wide -> Wide -> Wide-xor (Wide a) (Wide b) = Wide (xor_w# a b)+xor (Wide a) (Wide b) = Wide (xor# a b)+{-# INLINABLE xor #-} -not_w# :: (# Limb, Limb #) -> (# Limb, Limb #)-not_w# (# a0, a1 #) = (# L.not# a0, L.not# a1 #)-{-# INLINE not_w# #-}+not# :: Limb2 -> Limb2+not# (# a0, a1 #) = (# L.not# a0, L.not# a1 #)+{-# INLINE not# #-} +-- | Logical negation on 'Wide' words. not :: Wide -> Wide-not (Wide w) = Wide (not_w# w)-{-# INLINE not #-}+not (Wide w) = Wide (not# w)+{-# INLINABLE not #-}  -- negation ------------------------------------------------------------------- -neg#-  :: (# Limb, Limb #) -- ^ argument-  -> (# Limb, Limb #) -- ^ (wrapping) additive inverse-neg# w = add_w# (not_w# w) (# Limb 1##, Limb 0## #)-{-# INLINE neg# #-}-+-- | Wrapping negation on 'Wide' words, producing an additive inverse.+--+--   >>> neg 1+--   340282366920938463463374607431768211455+--   >>> 1 + neg 1+--   >>> 0 neg   :: Wide -- ^ argument   -> Wide -- ^ (wrapping) additive inverse neg (Wide w) = Wide (neg# w)+{-# INLINABLE neg #-} +neg#+  :: Limb2 -- ^ argument+  -> Limb2 -- ^ (wrapping) additive inverse+neg# w = add_w# (not# w) (L2 1## 0##)+{-# INLINE neg# #-}+ -- addition, subtraction ------------------------------------------------------  -- | Overflowing addition, computing 'a + b', returning the sum and a --   carry bit. add_o#-  :: (# Limb, Limb #)              -- ^ augend-  -> (# Limb, Limb #)              -- ^ addend-  -> (# (# Limb, Limb #), Limb #)  -- ^ (# sum, carry bit #)+  :: Limb2              -- ^ augend+  -> Limb2              -- ^ addend+  -> (# Limb2, Limb #)  -- ^ (# sum, carry bit #) add_o# (# a0, a1 #) (# b0, b1 #) =   let !(# s0, c0 #) = L.add_o# a0 b0       !(# s1, c1 #) = L.add_c# a1 b1 c0@@ -195,20 +255,20 @@ {-# INLINE add_o# #-}  -- | Overflowing addition on 'Wide' words, computing 'a + b', returning---   the sum and carry.+--   the sum and carry bit. add_o   :: Wide         -- ^ augend   -> Wide         -- ^ addend   -> (Wide, Word) -- ^ (sum, carry) add_o (Wide a) (Wide b) =   let !(# s, Limb c #) = add_o# a b-  in  (Wide s, W# c)+  in  (Wide s, L.W# c)  -- | Wrapping addition, computing 'a + b'. add_w#-  :: (# Limb, Limb #) -- ^ augend-  -> (# Limb, Limb #) -- ^ addend-  -> (# Limb, Limb #) -- ^ sum+  :: Limb2 -- ^ augend+  -> Limb2 -- ^ addend+  -> Limb2 -- ^ sum add_w# a b =   let !(# c, _ #) = add_o# a b   in  c@@ -221,9 +281,9 @@ -- | Borrowing subtraction, computing 'a - b' and returning the --   difference with a borrow mask. sub_b#-  :: (# Limb, Limb #)              -- ^ minuend-  -> (# Limb, Limb #)              -- ^ subtrahend-  -> (# (# Limb, Limb #), Limb #) -- ^ (# difference, borrow mask #)+  :: Limb2              -- ^ minuend+  -> Limb2              -- ^ subtrahend+  -> (# Limb2, Limb #) -- ^ (# difference, borrow mask #) sub_b# (# a0, a1 #) (# b0, b1 #) =   let !(# s0, c0 #) = L.sub_b# a0 b0 (Limb 0##)       !(# s1, c1 #) = L.sub_b# a1 b1 c0@@ -232,9 +292,9 @@  -- | Wrapping subtraction, computing 'a - b'. sub_w#-  :: (# Limb, Limb #) -- ^ minuend-  -> (# Limb, Limb #) -- ^ subtrahend-  -> (# Limb, Limb #) -- ^ difference+  :: Limb2 -- ^ minuend+  -> Limb2 -- ^ subtrahend+  -> Limb2 -- ^ difference sub_w# a b =   let !(# c, _ #) = sub_b# a b   in  c@@ -248,9 +308,9 @@  -- | Wrapping multiplication, computing 'a b'. mul_w#-  :: (# Limb, Limb #) -- ^ multiplicand-  -> (# Limb, Limb #) -- ^ multiplier-  -> (# Limb, Limb #) -- ^ product+  :: Limb2 -- ^ multiplicand+  -> Limb2 -- ^ multiplier+  -> Limb2 -- ^ product mul_w# (# a0, a1 #) (# b0, b1 #) =   let !(# p0_lo, p0_hi #) = L.mul_c# a0 b0       !(# p1_lo, _ #) = L.mul_c# a0 b1

@@ -53,9 +53,11 @@   , shr_limb#   , shl_limb#   , and-  , and_w#+  , and#   , or-  , or_w#+  , or#+  , xor+  , xor#   , not   , not# @@ -97,17 +99,17 @@  -- wider words ---------------------------------------------------------------- -pattern Limb4-  :: Word# -> Word# -> Word# -> Word#-  -> (# Limb, Limb, Limb, Limb #)-pattern Limb4 w0 w1 w2 w3 = (# Limb w0, Limb w1, Limb w2, Limb w3 #)-{-# COMPLETE Limb4 #-}+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 #-}+ -- | Little-endian wider words, consisting of four 'Limbs'. -- --   >>> 1 :: Wider --   1-data Wider = Wider !(# Limb, Limb, Limb, Limb #)+data Wider = Wider !Limb4  instance Show Wider where   show = show . from_vartime@@ -121,12 +123,12 @@   (*) = mul   abs = id   fromInteger = to_vartime-  negate w = add (not w) (Wider (Limb4 1## 0## 0## 0##))+  negate w = add (not w) (Wider (L4 1## 0## 0## 0##))   signum (Wider (# l0, l1, l2, l3 #)) =     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  Wider (Limb4 b 0## 0## 0##)+    in  Wider (L4 b 0## 0## 0##)  instance NFData Wider where   rnf (Wider a) = case a of@@ -135,12 +137,12 @@ -- comparison -----------------------------------------------------------------  eq#-  :: (# Limb, Limb, Limb, Limb #)-  -> (# Limb, Limb, Limb, Limb #)+  :: Limb4+  -> Limb4   -> C.Choice eq# a b =-  let !(Limb4 a0 a1 a2 a3) = a-      !(Limb4 b0 b1 b2 b3) = b+  let !(L4 a0 a1 a2 a3) = a+      !(L4 b0 b1 b2 b3) = b   in  C.eq_wider# (# a0, a1, a2, a3 #) (# b0, b1, b2, b3 #) {-# INLINE eq# #-} @@ -158,14 +160,15 @@       && (L.eq_vartime# a1 b1)       && (L.eq_vartime# a2 b2)       && (L.eq_vartime# a3 b3)+{-# INLINABLE eq_vartime #-}  lt#-  :: (# Limb, Limb, Limb, Limb #)-  -> (# Limb, Limb, Limb, Limb #)+  :: Limb4+  -> Limb4   -> C.Choice lt# a b =   let !(# _, Limb bor #) = sub_b# a b-  in  C.from_word_mask# bor+  in  C.from_full_mask# bor {-# INLINE lt# #-}  -- | Constant-time less-than comparison between 'Wider' values.@@ -177,14 +180,15 @@ --   False lt :: Wider -> Wider -> C.Choice lt (Wider a) (Wider b) = lt# a b+{-# INLINABLE lt #-}  gt#-  :: (# Limb, Limb, Limb, Limb #)-  -> (# Limb, Limb, Limb, Limb #)+  :: Limb4+  -> Limb4   -> C.Choice gt# a b =   let !(# _, Limb bor #) = sub_b# b a-  in  C.from_word_mask# bor+  in  C.from_full_mask# bor {-# INLINE gt# #-}  -- | Constant-time greater-than comparison between 'Wider' values.@@ -196,10 +200,11 @@ --   True gt :: Wider -> Wider -> C.Choice gt (Wider a) (Wider b) = gt# a b+{-# INLINABLE gt #-}  cmp#-  :: (# Limb, Limb, Limb, Limb #)-  -> (# Limb, Limb, Limb, Limb #)+  :: Limb4+  -> Limb4   -> Int# cmp# (# l0, l1, l2, l3 #) (# r0, r1, r2, r3 #) =   let !(# w0, b0 #) = L.sub_b# r0 l0 (Limb 0##)@@ -241,8 +246,8 @@ --   >>> wider 1 0 0 0 --   1 wider :: Word -> Word -> Word -> Word -> Wider-wider (W# w0) (W# w1) (W# w2) (W# w3) = Wider-  (# Limb w0, Limb w1, Limb w2, Limb w3 #)+wider (W# w0) (W# w1) (W# w2) (W# w3) = Wider (L4 w0 w1 w2 w3)+{-# INLINABLE wider #-}  -- | Convert an 'Integer' to a 'Wider' word. --@@ -256,34 +261,34 @@       !(W# w1) = fi ((n .>>. size) .&. mask)       !(W# w2) = fi ((n .>>. (2 * size)) .&. mask)       !(W# w3) = fi ((n .>>. (3 * size)) .&. mask)-  in  Wider (# Limb w0, Limb w1, Limb w2, Limb w3 #)+  in  Wider (L4 w0 w1 w2 w3)+{-# INLINABLE to_vartime #-}  -- | Convert a 'Wider' word to an 'Integer'. -- --   >>> from_vartime 1 --   1 from_vartime :: Wider -> Integer-from_vartime (Wider (# Limb w0, Limb w1, Limb w2, Limb w3 #)) =+from_vartime (Wider (L4 w0 w1 w2 w3)) =         fi (W# w3) .<<. (3 * size)     .|. fi (W# w2) .<<. (2 * size)     .|. fi (W# w1) .<<. size     .|. fi (W# w0)   where     !size = B.finiteBitSize (0 :: Word)+{-# INLINABLE from_vartime #-}  -- constant-time selection-----------------------------------------------------  select#-  :: (# Limb, Limb, Limb, Limb #) -- ^ a-  -> (# Limb, Limb, Limb, Limb #) -- ^ b-  -> C.Choice                     -- ^ c-  -> (# Limb, Limb, Limb, Limb #) -- ^ result-select# a b c =-  let !(# Limb a0, Limb a1, Limb a2, Limb a3 #) = a-      !(# Limb b0, Limb b1, Limb b2, Limb b3 #) = b-      !(# w0, w1, w2, w3 #) =+  :: Limb4    -- ^ a+  -> Limb4    -- ^ b+  -> C.Choice -- ^ c+  -> Limb4    -- ^ result+select# (L4 a0 a1 a2 a3) (L4 b0 b1 b2 b3) c =+  let !(# w0, w1, w2, w3 #) =         C.select_wider# (# a0, a1, a2, a3 #) (# b0, b1, b2, b3 #) c-  in  (# Limb w0, Limb w1, Limb w2, Limb w3 #)+  in  L4 w0 w1 w2 w3 {-# INLINE select# #-}  -- | Return a if c is truthy, otherwise return b.@@ -297,12 +302,13 @@   -> C.Choice -- ^ c   -> Wider    -- ^ result select (Wider a) (Wider b) c = Wider (select# a b c)+{-# INLINABLE select #-}  -- bit manipulation -----------------------------------------------------------  shr1_c#-  :: (# Limb, Limb, Limb, Limb #)                 -- ^ argument-  -> (# (# Limb, Limb, Limb, Limb #), C.Choice #) -- ^ result, carry+  :: Limb4                 -- ^ argument+  -> (# Limb4, C.Choice #) -- ^ result, carry shr1_c# (# w0, w1, w2, w3 #) =   let !s = case B.finiteBitSize (0 :: Word) of I# m -> m Exts.-# 1#       !(# s3, c3 #) = (# L.shr# w3 1#, L.shl# w3 s #)@@ -314,7 +320,7 @@       !(# s0, c0 #) = (# L.shr# w0 1#, L.shl# w0 s #)       !r0           = L.or# s0 c1       !(Limb w)     = L.shr# c0 s-  in  (# (# r0, r1, r2, r3 #), C.from_word# w #)+  in  (# (# r0, r1, r2, r3 #), C.from_bit# w #) {-# INLINE shr1_c# #-}  -- | Constant-time 1-bit shift-right with carry, with a 'Choice'@@ -323,6 +329,7 @@ shr1_c (Wider w) =   let !(# r, c #) = shr1_c# w   in  (# Wider r, c #)+{-# INLINABLE shr1_c #-}  -- | Constant-time 1-bit shift-right. --@@ -334,10 +341,11 @@ shr1 (Wider w) =   let !(# r, _ #) = shr1_c# w   in  Wider r+{-# INLINABLE shr1 #-}  shl1_c#-  :: (# Limb, Limb, Limb, Limb #)                 -- ^ argument-  -> (# (# Limb, Limb, Limb, Limb #), C.Choice #) -- ^ result, carry+  :: Limb4                 -- ^ argument+  -> (# Limb4, C.Choice #) -- ^ result, carry shl1_c# (# w0, w1, w2, w3 #) =   let !s = case B.finiteBitSize (0 :: Word) of I# m -> m Exts.-# 1#       !(# s0, c0 #) = (# L.shl# w0 1#, L.shr# w0 s #)@@ -349,7 +357,7 @@       !(# s3, c3 #) = (# L.shl# w3 1#, L.shr# w3 s #)       !r3           = L.or# s3 c2       !(Limb w)     = L.shl# c3 s-  in  (# (# r0, r1, r2, r3 #), C.from_word# w #)+  in  (# (# r0, r1, r2, r3 #), C.from_bit# w #) {-# INLINE shl1_c# #-}  -- | Constant-time 1-bit shift-left with carry, with a 'Choice' indicating@@ -358,6 +366,7 @@ shl1_c (Wider w) =   let !(# r, c #) = shl1_c# w   in  (# Wider r, c #)+{-# INLINABLE shl1_c #-}  -- | Constant-time 1-bit shift-left. --@@ -369,14 +378,14 @@ shl1 (Wider w) =   let !(# r, _ #) = shl1_c# w   in  Wider r+{-# INLINABLE shl1 #-}  shr_limb#-  :: (# Limb, Limb, Limb, Limb #)+  :: Limb4   -> Int#-  -> (# (# Limb, Limb, Limb, Limb #), Limb #)+  -> (# Limb4, Limb #) shr_limb# (# a0, a1, a2, a3 #) rs =-  let !size = case B.finiteBitSize (0 :: Word) of I# m -> m-      !ls = size Exts.-# rs+  let !ls = case B.finiteBitSize (0 :: Word) of I# m -> m Exts.-# rs       !(# l3, c3 #) = (# L.shr# a3 rs, L.shl# a3 ls #)       !(# l2, c2 #) = (# L.or# (L.shr# a2 rs) c3, L.shl# a2 ls #)       !(# l1, c1 #) = (# L.or# (L.shr# a1 rs) c2, L.shl# a1 ls #)@@ -397,14 +406,14 @@ shr_limb (Wider w) (I# s) =   let !(# r, _ #) = shr_limb# w s   in  Wider r+{-# INLINABLE shr_limb #-}  shl_limb#-  :: (# Limb, Limb, Limb, Limb #)+  :: Limb4   -> Int#-  -> (# (# Limb, Limb, Limb, Limb #), Limb #)+  -> (# Limb4, Limb #) shl_limb# (# a0, a1, a2, a3 #) ls =-  let !size = case B.finiteBitSize (0 :: Word) of I# m -> m-      !rs = size Exts.-# ls+  let !rs = case B.finiteBitSize (0 :: Word) of I# m -> m Exts.-# ls       !(# l0, c0 #) = (# L.shl# a0 ls, L.shr# a0 rs #)       !(# l1, c1 #) = (# L.or# (L.shl# a1 ls) c0, L.shr# a1 rs #)       !(# l2, c2 #) = (# L.or# (L.shl# a2 ls) c1, L.shr# a2 rs #)@@ -427,14 +436,15 @@ shl_limb (Wider w) (I# s) =   let !(# r, _ #) = shl_limb# w s   in  Wider r+{-# INLINABLE shl_limb #-} -and_w#-  :: (# Limb, Limb, Limb, Limb #)-  -> (# Limb, Limb, Limb, Limb #)-  -> (# Limb, Limb, Limb, Limb #)-and_w# (# a0, a1, a2, a3 #) (# b0, b1, b2, b3 #) =+and#+  :: Limb4+  -> Limb4+  -> Limb4+and# (# a0, a1, a2, a3 #) (# b0, b1, b2, b3 #) =   (# L.and# a0 b0, L.and# a1 b1, L.and# a2 b2, L.and# a3 b3 #)-{-# INLINE and_w# #-}+{-# INLINE and# #-}  -- | Binary /and/. --@@ -446,15 +456,16 @@   :: Wider -- ^ a   -> Wider -- ^ b   -> Wider -- ^ a & b-and (Wider a) (Wider b) = Wider (and_w# a b)+and (Wider a) (Wider b) = Wider (and# a b)+{-# INLINABLE and #-} -or_w#-  :: (# Limb, Limb, Limb, Limb #)-  -> (# Limb, Limb, Limb, Limb #)-  -> (# Limb, Limb, Limb, Limb #)-or_w# (# a0, a1, a2, a3 #) (# b0, b1, b2, b3 #) =+or#+  :: Limb4+  -> Limb4+  -> Limb4+or# (# a0, a1, a2, a3 #) (# b0, b1, b2, b3 #) =   (# L.or# a0 b0, L.or# a1 b1, L.or# a2 b2, L.or# a3 b3 #)-{-# INLINE or_w# #-}+{-# INLINE or# #-}  -- | Binary /or/. --@@ -466,11 +477,33 @@   :: Wider -- ^ a   -> Wider -- ^ b   -> Wider -- ^ a | b-or (Wider a) (Wider b) = Wider (or_w# a b)+or (Wider a) (Wider b) = Wider (or# a b)+{-# INLINABLE or #-} +xor#+  :: Limb4+  -> Limb4+  -> Limb4+xor# (# a0, a1, a2, a3 #) (# b0, b1, b2, b3 #) =+  (# L.xor# a0 b0, L.xor# a1 b1, L.xor# a2 b2, L.xor# a3 b3 #)+{-# INLINE xor# #-}++-- | Binary /xor/.+--+--   >>> xor 1 1+--   0+--   >>> xor 1 0+--   1+xor+  :: Wider -- ^ a+  -> Wider -- ^ b+  -> Wider -- ^ a ^ b+xor (Wider a) (Wider b) = Wider (xor# a b)+{-# INLINABLE xor #-}+ not#-  :: (# Limb, Limb, Limb, Limb #)-  -> (# Limb, Limb, Limb, Limb #)+  :: Limb4+  -> Limb4 not# (# l0, l1, l2, l3 #) = (# L.not# l0, L.not# l1, L.not# l2, L.not# l3 #) {-# INLINE not# #-} @@ -484,13 +517,14 @@   :: Wider -- ^ value   -> Wider -- ^ not value not (Wider w) = Wider (not# w)+{-# INLINABLE not #-}  -- addition, subtraction ------------------------------------------------------  add_o#-  :: (# Limb, Limb, Limb, Limb #)             -- ^ augend-  -> (# Limb, Limb, Limb, Limb #)             -- ^ addend-  -> (# (# Limb, Limb, Limb, Limb #), Limb #) -- ^ (# sum, carry bit #)+  :: Limb4             -- ^ augend+  -> Limb4             -- ^ addend+  -> (# Limb4, Limb #) -- ^ (# sum, carry bit #) add_o# (# a0, a1, a2, a3 #) (# b0, b1, b2, b3 #) =   let !(# s0, c0 #) = L.add_o# a0 b0       !(# s1, c1 #) = L.add_c# a1 b1 c0@@ -513,11 +547,12 @@ add_o (Wider a) (Wider b) =   let !(# s, Limb c #) = add_o# a b   in  (Wider s, W# c)+{-# INLINABLE add_o #-}  add_w#-  :: (# Limb, Limb, Limb, Limb #) -- ^ augend-  -> (# Limb, Limb, Limb, Limb #) -- ^ addend-  -> (# Limb, Limb, Limb, Limb #) -- ^ sum+  :: Limb4 -- ^ augend+  -> Limb4 -- ^ addend+  -> Limb4 -- ^ sum add_w# a b =   let !(# c, _ #) = add_o# a b   in  c@@ -538,10 +573,10 @@ {-# INLINE add #-}  add_mod#-  :: (# Limb, Limb, Limb, Limb #) -- ^ augend-  -> (# Limb, Limb, Limb, Limb #) -- ^ addend-  -> (# Limb, Limb, Limb, Limb #) -- ^ modulus-  -> (# Limb, Limb, Limb, Limb #) -- ^ sum+  :: Limb4 -- ^ augend+  -> Limb4 -- ^ addend+  -> Limb4 -- ^ modulus+  -> Limb4 -- ^ sum add_mod# a b m =   let !(# w, c #) = add_o# a b   in  sub_mod_c# w c m m@@ -562,11 +597,12 @@   -> Wider -- ^ modulus   -> Wider -- ^ sum add_mod (Wider a) (Wider b) (Wider m) = Wider (add_mod# a b m)+{-# INLINABLE add_mod #-}  sub_b#-  :: (# Limb, Limb, Limb, Limb #)              -- ^ minuend-  -> (# Limb, Limb, Limb, Limb #)              -- ^ subtrahend-  -> (# (# Limb, Limb, Limb, Limb #), Limb #) -- ^ (# diff, borrow mask #)+  :: Limb4              -- ^ minuend+  -> Limb4              -- ^ subtrahend+  -> (# Limb4, Limb #) -- ^ (# diff, borrow mask #) sub_b# (# a0, a1, a2, a3 #) (# b0, b1, b2, b3 #) =   let !(# s0, c0 #) = L.sub_b# a0 b0 (Limb 0##)       !(# s1, c1 #) = L.sub_b# a1 b1 c0@@ -589,6 +625,7 @@ sub_b (Wider l) (Wider r) =   let !(# d, Limb b #) = sub_b# l r   in  (Wider d, W# b)+{-# INLINABLE sub_b #-}  -- | Wrapping subtraction, computing 'a - b' and returning the --   difference.@@ -607,12 +644,13 @@ sub (Wider a) (Wider b) =   let !(# d, _ #) = sub_b# a b   in  Wider d+{-# INLINABLE sub #-}  sub_mod#-  :: (# Limb, Limb, Limb, Limb #) -- ^ minuend-  -> (# Limb, Limb, Limb, Limb #) -- ^ subtrahend-  -> (# Limb, Limb, Limb, Limb #) -- ^ modulus-  -> (# Limb, Limb, Limb, Limb #) -- ^ difference+  :: Limb4 -- ^ minuend+  -> Limb4 -- ^ subtrahend+  -> Limb4 -- ^ modulus+  -> Limb4 -- ^ difference sub_mod# a b (# p0, p1, p2, p3 #) =   let !(# o, m #) = sub_b# a b       !ba = (# L.and# p0 m, L.and# p1 m, L.and# p2 m, L.and# p3 m #)@@ -634,14 +672,15 @@   -> Wider   -> Wider sub_mod (Wider a) (Wider b) (Wider p) = Wider (sub_mod# a b p)+{-# INLINABLE sub_mod #-}  -- | Modular subtraction with carry. Computes (# a, c #) - b mod m. sub_mod_c#-  :: (# Limb, Limb, Limb, Limb #) -- ^ minuend+  :: Limb4 -- ^ minuend   -> Limb                         -- ^ carry bit-  -> (# Limb, Limb, Limb, Limb #) -- ^ subtrahend-  -> (# Limb, Limb, Limb, Limb #) -- ^ modulus-  -> (# Limb, Limb, Limb, Limb #) -- ^ difference+  -> Limb4 -- ^ subtrahend+  -> Limb4 -- ^ modulus+  -> Limb4 -- ^ difference sub_mod_c# a c b (# p0, p1, p2, p3 #) =   let !(# (# o0, o1, o2, o3 #), bb #) = sub_b# a b       !(# _, m #) = L.sub_b# c (Limb 0##) bb@@ -652,9 +691,9 @@ -- multiplication -------------------------------------------------------------  mul_c#-  :: (# Limb, Limb, Limb, Limb #)-  -> (# Limb, Limb, Limb, Limb #)-  -> (# (# Limb, Limb, Limb, Limb #), (# Limb, Limb, Limb, Limb #) #)+  :: Limb4+  -> Limb4+  -> (# Limb4, Limb4 #) mul_c# (# x0, x1, x2, x3 #) (# y0, y1, y2, y3 #) =   let !(# z0, c0_0 #)   = L.mac# x0 y0 (Limb 0##) (Limb 0##)       !(# s1_0, c1_0 #) = L.mac# x0 y1 (Limb 0##) c0_0@@ -700,6 +739,7 @@ mul_c (Wider a) (Wider b) =   let !(# l, h #) = mul_c# a b   in  (Wider l, Wider h)+{-# INLINABLE mul_c #-}  -- | Wrapping multiplication. --@@ -717,10 +757,11 @@ mul (Wider a) (Wider b) =   let !(# l, _ #) = mul_c# a b   in  Wider l+{-# INLINABLE mul #-}  sqr#-  :: (# Limb, Limb, Limb, Limb #)-  -> (# (# Limb, Limb, Limb, Limb #), (# Limb, Limb, Limb, Limb #) #)+  :: Limb4+  -> (# Limb4, Limb4 #) sqr# (# x0, x1, x2, x3 #) =   let !sh = case B.finiteBitSize (0 :: Word) of I# m -> m Exts.-# 1#       !(# q1_0, c1_0 #)  = L.mac# x1 x0 (Limb 0##) (Limb 0##)@@ -760,9 +801,12 @@ sqr (Wider w) =   let !(# l, h #) = sqr# w   in  (Wider l, Wider h)+{-# INLINABLE sqr #-} -odd# :: (# Limb, Limb, Limb, Limb #) -> C.Choice-odd# (# Limb w, _, _, _ #) = C.from_word# (Exts.and# w 1##)+odd# :: Limb4 -> C.Choice+odd# (# l, _, _, _ #) =+  let !(Limb w) = L.and# l (Limb 1##)+  in  C.from_bit# w {-# INLINE odd# #-}  -- | Check if a 'Wider' is odd, returning a 'Choice'.@@ -770,4 +814,5 @@   :: Wider   -> C.Choice odd (Wider w) = odd# w+{-# INLINABLE odd #-} 

@@ -1,6 +1,7 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE NumericUnderscores #-}+{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE UnboxedSums #-} {-# LANGUAGE UnboxedTuples #-}@@ -30,13 +31,13 @@    -- * Reduction and retrieval   , redc-  , retr   , redc#+  , retr   , retr#    -- * Constant-time selection-  , select#   , select+  , select#    -- * Montgomery arithmetic   , add@@ -66,7 +67,7 @@ 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, sqrt, exp)  -- montgomery arithmetic, specialized to the secp256k1 field prime modulus@@ -80,7 +81,7 @@ --   1 --   >>> putStrLn (render one) --   (4294968273, 0, 0, 0)-data Montgomery = Montgomery !(# Limb, Limb, Limb, Limb #)+data Montgomery = Montgomery !Limb4  -- | Render a 'Montgomery' value as a 'String', showing its individual --   'Limb's.@@ -88,7 +89,7 @@ --   >>> putStrLn (render 1) --   (4294968273, 0, 0, 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) <> ")" @@ -116,8 +117,16 @@  -- 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@@ -125,7 +134,7 @@ {-# INLINE wadd_w# #-}  -- Truncate a wide word to a 'Limb'.-lo :: (# Limb, Limb #) -> Limb+lo :: Limb2 -> Limb lo (# l, _ #) = l {-# INLINE lo #-} @@ -133,10 +142,8 @@  -- | 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.@@ -147,9 +154,9 @@ -- 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 0xFFFFFFFEFFFFFC2F##, Limb 0xFFFFFFFFFFFFFFFF##@@ -184,13 +191,13 @@  -- | Montgomery reduction. 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 -- field prime-      !m = (# Limb 0xFFFFFFFEFFFFFC2F##, Limb 0xFFFFFFFFFFFFFFFF##-           ,  Limb 0xFFFFFFFFFFFFFFFF##, Limb 0xFFFFFFFFFFFFFFFF## #)+      !m = L4 0xFFFFFFFEFFFFFC2F## 0xFFFFFFFFFFFFFFFF##+              0xFFFFFFFFFFFFFFFF## 0xFFFFFFFFFFFFFFFF##       !(# nu, mc #) = redc_inner# u l   in  WW.sub_mod_c# nu mc m m {-# INLINE redc# #-}@@ -208,12 +215,12 @@   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 0xFFFFFFFEFFFFFC2F##, Limb 0xFFFFFFFFFFFFFFFF##-        ,  Limb 0xFFFFFFFFFFFFFFFF##, Limb 0xFFFFFFFFFFFFFFFF## #)+        L4 0xFFFFFFFEFFFFFC2F## 0xFFFFFFFFFFFFFFFF##+           0xFFFFFFFFFFFFFFFF## 0xFFFFFFFFFFFFFFFF##       !n                = Limb 0xD838091DD2253531##       !u_0              = L.mul_w# x0 n       !(# _, o0 #)      = L.mac# u_0 m0 x0 (Limb 0##)@@ -239,8 +246,8 @@ {-# INLINE retr_inner# #-}  retr#-  :: (# Limb, Limb, Limb, Limb #) -- montgomery form-  -> (# Limb, Limb, Limb, Limb #)+  :: Limb4 -- montgomery form+  -> Limb4 retr# f = retr_inner# f {-# INLINE retr# #-} @@ -255,13 +262,13 @@  -- | 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 0xFFFFFFFEFFFFFC2F##, Limb 0xFFFFFFFFFFFFFFFF##-        ,  Limb 0xFFFFFFFFFFFFFFFF##, Limb 0xFFFFFFFFFFFFFFFF## #)+        L4 0xFFFFFFFEFFFFFC2F## 0xFFFFFFFFFFFFFFFF##+           0xFFFFFFFFFFFFFFFF## 0xFFFFFFFFFFFFFFFF##       !n                           = Limb 0xD838091DD2253531##       !axy0                        = L.mul_c# x0 y0       !u0                          = L.mul_w# (lo axy0) n@@ -335,13 +342,13 @@ {-# INLINE mul_inner# #-}  mul#-  :: (# Limb, Limb, Limb, Limb #)-  -> (# Limb, Limb, Limb, Limb #)-  -> (# Limb, Limb, Limb, Limb #)+  :: Limb4+  -> Limb4+  -> Limb4 mul# a b =   let -- field prime-      !m = (# Limb 0xFFFFFFFEFFFFFC2F##, Limb 0xFFFFFFFFFFFFFFFF##-           ,  Limb 0xFFFFFFFFFFFFFFFF##, Limb 0xFFFFFFFFFFFFFFFF## #)+      !m = L4 0xFFFFFFFEFFFFFC2F## 0xFFFFFFFFFFFFFFFF##+              0xFFFFFFFFFFFFFFFF## 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@@ -360,11 +367,10 @@ 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 0x000007A2000E90A1##, Limb 0x1##, Limb 0##, Limb 0## #)+  let !r2 = L4 0x000007A2000E90A1## 0x1## 0## 0## -- r^2 mod m   in  mul# x r2 {-# INLINE to# #-} @@ -379,13 +385,13 @@ 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 -- field prime-      !m = (# Limb 0xFFFFFFFEFFFFFC2F##, Limb 0xFFFFFFFFFFFFFFFF##-           ,  Limb 0xFFFFFFFFFFFFFFFF##, Limb 0xFFFFFFFFFFFFFFFF## #)+      !m = L4 0xFFFFFFFEFFFFFC2F## 0xFFFFFFFFFFFFFFFF##+              0xFFFFFFFFFFFFFFFF## 0xFFFFFFFFFFFFFFFF##   in  WW.add_mod# a b m {-# INLINE add# #-} @@ -400,13 +406,13 @@ 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 -- field prime-      !m = (# Limb 0xFFFFFFFEFFFFFC2F##, Limb 0xFFFFFFFFFFFFFFFF##-           ,  Limb 0xFFFFFFFFFFFFFFFF##, Limb 0xFFFFFFFFFFFFFFFF## #)+      !m = L4 0xFFFFFFFEFFFFFC2F## 0xFFFFFFFFFFFFFFFF##+              0xFFFFFFFFFFFFFFFF## 0xFFFFFFFFFFFFFFFF##   in  WW.sub_mod# a b m {-# INLINE sub# #-} @@ -421,9 +427,9 @@ 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.@@ -438,7 +444,7 @@ 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@@ -457,19 +463,19 @@  -- | 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 0x1000003D1##, Limb 0##, Limb 0##, Limb 0## #)+one = Montgomery (L4 0x1000003D1## 0## 0## 0##)  -- generated by etc/generate_inv.sh inv#-  :: (# Limb, Limb, Limb, Limb #)-  -> (# Limb, Limb, Limb, Limb #)+  :: Limb4+  -> Limb4 inv# a =   let -- montgomery 'one'-      !t0 = (# Limb 0x1000003D1##, Limb 0##, Limb 0##, Limb 0## #)+      !t0 = L4 0x1000003D1## 0## 0## 0##       !t1 = sqr# t0       !t2 = mul# a t1       !t3 = sqr# t2@@ -1009,10 +1015,10 @@  -- generated by etc/generate_sqrt.sh sqrt#-  :: (# Limb, Limb, Limb, Limb #)-  -> (# (# Limb, Limb, Limb, Limb #), C.Choice #)+  :: Limb4+  -> (# Limb4, C.Choice #) sqrt# a =-  let !t0 = (# Limb 0x1000003D1##, Limb 0##, Limb 0##, Limb 0## #)+  let !t0 = L4 0x1000003D1## 0## 0## 0##       !t1 = sqr# t0       !t2 = sqr# t1       !t3 = sqr# t2@@ -1530,11 +1536,11 @@ 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 0x1000003D1##, Limb 0##, Limb 0##, Limb 0## #)+  let !o = L4 0x1000003D1## 0## 0## 0##       loop !r !m !ex n = case n of         0 -> r         _ ->@@ -1546,7 +1552,7 @@   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# #-} @@ -1567,10 +1573,10 @@ -- 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# #-} 

@@ -1,6 +1,7 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE NumericUnderscores #-}+{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE UnboxedSums #-} {-# LANGUAGE UnboxedTuples #-}@@ -30,13 +31,13 @@    -- * Reduction and retrieval   , redc-  , retr   , redc#+  , retr   , retr#    -- * Constant-time selection-  , select#   , select+  , select#    -- * Montgomery arithmetic   , add@@ -53,8 +54,8 @@   , inv#   , exp   , exp#-  , odd#   , odd_vartime+  , odd#   ) where  import Control.DeepSeq@@ -64,7 +65,7 @@ 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 @@ --   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 @@ --   >>> 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 @@     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 @@ {-# 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 @@  -- | 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 @@ -- 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 @@ {-# 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 @@   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 @@ {-# 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 @@  -- | 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 @@ {-# 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 (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 = 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 (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 (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 :: 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 @@  -- | 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 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 @@   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 @@ -- 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# #-} 

@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               ppad-fixed-version:            0.1.2+version:            0.1.3 synopsis:           Large fixed-width words and constant-time arithmetic. license:            MIT license-file:       LICENSE@@ -8,7 +8,7 @@ maintainer:         jared@ppad.tech category:           Data build-type:         Simple-tested-with:        GHC == { 9.8.1 }+tested-with:        GHC == { 9.10.3 } extra-doc-files:    CHANGELOG description:   A pure high-performance implementation of large fixed-width integers