diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -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. diff --git a/lib/Data/Choice.hs b/lib/Data/Choice.hs --- a/lib/Data/Choice.hs +++ b/lib/Data/Choice.hs @@ -11,41 +11,34 @@ -- License: MIT -- Maintainer: Jared Tobin -- --- 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# diff --git a/lib/Data/Word/Limb.hs b/lib/Data/Word/Limb.hs --- a/lib/Data/Word/Limb.hs +++ b/lib/Data/Word/Limb.hs @@ -14,6 +14,9 @@ -- Maintainer: Jared Tobin -- -- 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# #-} diff --git a/lib/Data/Word/Wide.hs b/lib/Data/Word/Wide.hs --- a/lib/Data/Word/Wide.hs +++ b/lib/Data/Word/Wide.hs @@ -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 diff --git a/lib/Data/Word/Wider.hs b/lib/Data/Word/Wider.hs --- a/lib/Data/Word/Wider.hs +++ b/lib/Data/Word/Wider.hs @@ -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 #-} diff --git a/lib/Numeric/Montgomery/Secp256k1/Curve.hs b/lib/Numeric/Montgomery/Secp256k1/Curve.hs --- a/lib/Numeric/Montgomery/Secp256k1/Curve.hs +++ b/lib/Numeric/Montgomery/Secp256k1/Curve.hs @@ -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# #-} diff --git a/lib/Numeric/Montgomery/Secp256k1/Scalar.hs b/lib/Numeric/Montgomery/Secp256k1/Scalar.hs --- a/lib/Numeric/Montgomery/Secp256k1/Scalar.hs +++ b/lib/Numeric/Montgomery/Secp256k1/Scalar.hs @@ -1,6 +1,7 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE UnboxedSums #-} {-# LANGUAGE UnboxedTuples #-} @@ -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# #-} diff --git a/ppad-fixed.cabal b/ppad-fixed.cabal --- a/ppad-fixed.cabal +++ b/ppad-fixed.cabal @@ -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