diff --git a/Data/Mod.hs b/Data/Mod.hs --- a/Data/Mod.hs +++ b/Data/Mod.hs @@ -1,26 +1,22 @@ -- | -- Module: Data.Mod --- Copyright: (c) 2017-2022 Andrew Lelechenko +-- Copyright: (c) 2017-2019 Andrew Lelechenko -- Licence: MIT -- Maintainer: Andrew Lelechenko -- -- , -- promoting moduli to the type level, with an emphasis on performance. -- Originally part of package. --- --- This module supports moduli of arbitrary size. --- Use "Data.Mod.Word" to achieve better performance, --- when your moduli fit into 'Word'. -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE CPP #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE UnboxedTuples #-} module Data.Mod ( Mod @@ -31,26 +27,45 @@ import Control.Exception import Control.DeepSeq -import Data.Ratio #ifdef MIN_VERSION_semirings import Data.Euclidean (GcdDomain(..), Euclidean(..), Field) +import Data.Ratio import Data.Semiring (Semiring(..), Ring(..)) #endif import GHC.Exts import GHC.Generics +import GHC.Integer.GMP.Internals import GHC.Natural (Natural(..), powModNatural) -import GHC.TypeNats (Nat, KnownNat, natVal) +#if MIN_VERSION_base(4,11,0) +import GHC.TypeNats hiding (Mod) +#elif MIN_VERSION_base(4,10,0) +import GHC.TypeNats +#else + +import GHC.TypeLits hiding (natVal, someNatVal) +import qualified GHC.TypeLits as TL + +natVal :: KnownNat n => proxy n -> Natural +natVal = fromInteger . TL.natVal + +someNatVal :: Natural -> SomeNat +someNatVal n = case TL.someNatVal (toInteger n) of + Nothing -> error "someNatVal: impossible negative argument" + Just sn -> sn + +#endif + -- | This data type represents -- , -- equipped with useful instances. -- -- For example, 3 :: 'Mod' 10 stands for the class of integers --- congruent to \( 3 \bmod 10 \colon \ldots {}−17, −7, 3, 13, 23 \ldots \) +-- congruent to 3 modulo 10: …−17, −7, 3, 13, 23… -- -- >>> :set -XDataKinds --- >>> 3 + 8 :: Mod 10 -- 3 + 8 = 11 ≡ 1 (mod 10) --- (1 `modulo` 10) +-- >>> 3 + 8 :: Mod 10 +-- (1 `modulo` 10) -- because 3 + 8 = 11 ≡ 1 (mod 10) -- -- __Warning:__ division by residue, which is not -- @@ -59,11 +74,7 @@ newtype Mod (m :: Nat) = Mod { unMod :: Natural -- ^ The canonical representative of the residue class, - -- always between 0 and \( m - 1 \) inclusively. - -- - -- >>> :set -XDataKinds - -- >>> -1 :: Mod 10 - -- (9 `modulo` 10) + -- always between 0 and m - 1 inclusively. } deriving (Eq, Ord, Generic) @@ -76,8 +87,8 @@ succ x = if x == maxBound then throw Overflow else coerce (succ @Natural) x pred x = if x == minBound then throw Underflow else coerce (pred @Natural) x - toEnum = (fromIntegral :: Int -> Mod m) - fromEnum = (fromIntegral :: Natural -> Int) . unMod + toEnum = fromIntegral + fromEnum = fromIntegral . unMod enumFrom x = enumFromTo x maxBound enumFromThen x y = enumFromThenTo x y (if y >= x then maxBound else minBound) @@ -89,19 +100,83 @@ minBound = Mod 0 maxBound = let mx = Mod (natVal mx - 1) in mx +bigNatToNat :: BigNat -> Natural +bigNatToNat r# = + if isTrue# (sizeofBigNat# r# ==# 1#) then NatS# (bigNatToWord r#) else NatJ# r# + +subIfGe :: BigNat -> BigNat -> Natural +subIfGe z# m# = case z# `compareBigNat` m# of + LT -> NatJ# z# + EQ -> NatS# 0## + GT -> bigNatToNat $ z# `minusBigNat` m# + +#if !MIN_VERSION_base(4,12,0) +addWordC# :: Word# -> Word# -> (# Word#, Int# #) +addWordC# x# y# = (# z#, word2Int# c# #) + where + !(# c#, z# #) = x# `plusWord2#` y# +#endif + addMod :: Natural -> Natural -> Natural -> Natural -addMod m x y = let z = x + y in if z >= m then z - m else z +addMod (NatS# m#) (NatS# x#) (NatS# y#) = + if isTrue# c# || isTrue# (z# `geWord#` m#) then NatS# (z# `minusWord#` m#) else NatS# z# + where + !(# z#, c# #) = x# `addWordC#` y# +addMod NatS#{} _ _ = brokenInvariant +addMod (NatJ# m#) (NatS# x#) (NatS# y#) = + if isTrue# c# then subIfGe (wordToBigNat2 1## z#) m# else NatS# z# + where + !(# z#, c# #) = x# `addWordC#` y# +addMod (NatJ# m#) (NatS# x#) (NatJ# y#) = subIfGe (y# `plusBigNatWord` x#) m# +addMod (NatJ# m#) (NatJ# x#) (NatS# y#) = subIfGe (x# `plusBigNatWord` y#) m# +addMod (NatJ# m#) (NatJ# x#) (NatJ# y#) = subIfGe (x# `plusBigNat` y#) m# subMod :: Natural -> Natural -> Natural -> Natural -subMod m x y = if x >= y then x - y else m + x - y +subMod (NatS# m#) (NatS# x#) (NatS# y#) = + if isTrue# (x# `geWord#` y#) then NatS# z# else NatS# (z# `plusWord#` m#) + where + z# = x# `minusWord#` y# +subMod NatS#{} _ _ = brokenInvariant +subMod (NatJ# m#) (NatS# x#) (NatS# y#) = + if isTrue# (x# `geWord#` y#) + then NatS# (x# `minusWord#` y#) + else bigNatToNat $ m# `minusBigNatWord` (y# `minusWord#` x#) +subMod (NatJ# m#) (NatS# x#) (NatJ# y#) = + bigNatToNat $ (m# `minusBigNat` y#) `plusBigNatWord` x# +subMod NatJ#{} (NatJ# x#) (NatS# y#) = + bigNatToNat $ x# `minusBigNatWord` y# +subMod (NatJ# m#) (NatJ# x#) (NatJ# y#) = case x# `compareBigNat` y# of + LT -> bigNatToNat $ (m# `minusBigNat` y#) `plusBigNat` x# + EQ -> NatS# 0## + GT -> bigNatToNat $ x# `minusBigNat` y# negateMod :: Natural -> Natural -> Natural -negateMod !_ 0 = 0 -negateMod m x = m - x +negateMod _ (NatS# 0##) = NatS# 0## +negateMod (NatS# m#) (NatS# x#) = NatS# (m# `minusWord#` x#) +negateMod NatS#{} _ = brokenInvariant +negateMod (NatJ# m#) (NatS# x#) = bigNatToNat $ m# `minusBigNatWord` x# +negateMod (NatJ# m#) (NatJ# x#) = bigNatToNat $ m# `minusBigNat` x# mulMod :: Natural -> Natural -> Natural -> Natural -mulMod m x y = (x * y) `Prelude.rem` m +mulMod (NatS# m#) (NatS# x#) (NatS# y#) = NatS# r# + where + !(# z1#, z2# #) = timesWord2# x# y# + !(# _, r# #) = quotRemWord2# z1# z2# m# +mulMod NatS#{} _ _ = brokenInvariant +mulMod (NatJ# m#) (NatS# x#) (NatS# y#) = + bigNatToNat $ wordToBigNat2 z1# z2# `remBigNat` m# + where + !(# z1#, z2# #) = timesWord2# x# y# +mulMod (NatJ# m#) (NatS# x#) (NatJ# y#) = + bigNatToNat $ (y# `timesBigNatWord` x#) `remBigNat` m# +mulMod (NatJ# m#) (NatJ# x#) (NatS# y#) = + bigNatToNat $ (x# `timesBigNatWord` y#) `remBigNat` m# +mulMod (NatJ# m#) (NatJ# x#) (NatJ# y#) = + bigNatToNat $ (x# `timesBigNat` y#) `remBigNat` m# +brokenInvariant :: a +brokenInvariant = error "argument is larger than modulo" + instance KnownNat m => Num (Mod m) where mx@(Mod !x) + (Mod !y) = Mod $ addMod (natVal mx) x y {-# INLINE (+) #-} @@ -145,6 +220,19 @@ {-# INLINE negate #-} -- | See the warning about division above. +instance KnownNat m => Fractional (Mod m) where + fromRational r = case denominator r of + 1 -> num + den -> num / fromInteger den + where + num = fromInteger (numerator r) + {-# INLINE fromRational #-} + recip mx = case invertMod mx of + Nothing -> throw DivideByZero + Just y -> y + {-# INLINE recip #-} + +-- | See the warning about division above. instance KnownNat m => GcdDomain (Mod m) where divide x y = Just (x / y) gcd = const $ const 1 @@ -163,29 +251,16 @@ #endif --- | See the warning about division above. -instance KnownNat m => Fractional (Mod m) where - fromRational r = case denominator r of - 1 -> num - den -> num / fromInteger den - where - num = fromInteger (numerator r) - {-# INLINE fromRational #-} - recip mx = case invertMod mx of - Nothing -> throw DivideByZero - Just y -> y - {-# INLINE recip #-} - -- | If an argument is -- -- with the modulo, return its modular inverse. -- Otherwise return 'Nothing'. -- -- >>> :set -XDataKinds --- >>> invertMod 3 :: Mod 10 -- 3 * 7 = 21 ≡ 1 (mod 10) --- Just (7 `modulo` 10) --- >>> invertMod 4 :: Mod 10 -- 4 and 10 are not coprime --- Nothing +-- >>> invertMod 3 :: Mod 10 +-- Just (7 `modulo` 10) -- because 3 * 7 = 21 ≡ 1 (mod 10) +-- >>> invertMod 4 :: Mod 10 +-- Nothing -- because 4 and 10 are not coprime invertMod :: KnownNat m => Mod m -> Maybe (Mod m) invertMod mx = if y <= 0 @@ -195,18 +270,6 @@ y = recipModInteger (toInteger (unMod mx)) (toInteger (natVal mx)) {-# INLINABLE invertMod #-} -recipModInteger :: Integer -> Integer -> Integer -recipModInteger x m = case gcdExt x m of - (1, s) -> s `mod` m - _ -> -1 - -gcdExt :: Integer -> Integer -> (Integer, Integer) -gcdExt = go 1 0 - where - go s !_ r 0 = (r, s) - go s s' r r' = case Prelude.quotRem r r' of - (q, r'') -> go s' (s - q * s') r' r'' - -- | Drop-in replacement for 'Prelude.^' with much better performance. -- Negative powers are allowed, but may throw 'DivideByZero', if an argument -- is not with the modulo. @@ -214,25 +277,18 @@ -- Building with @-O@ triggers a rewrite rule 'Prelude.^' = '^%'. -- -- >>> :set -XDataKinds --- >>> 3 ^% 4 :: Mod 10 -- 3 ^ 4 = 81 ≡ 1 (mod 10) --- (1 `modulo` 10) --- >>> 3 ^% (-1) :: Mod 10 -- 3 * 7 = 21 ≡ 1 (mod 10) --- (7 `modulo` 10) --- >>> 4 ^% (-1) :: Mod 10 -- 4 and 10 are not coprime --- (*** Exception: divide by zero +-- >>> 3 ^% 4 :: Mod 10 +-- (1 `modulo` 10) -- because 3 ^ 4 = 81 ≡ 1 (mod 10) +-- >>> 3 ^% (-1) :: Mod 10 +-- (7 `modulo` 10) -- because 3 * 7 = 21 ≡ 1 (mod 10) +-- >>> 4 ^% (-1) :: Mod 10 +-- (*** Exception: divide by zero -- because 4 and 10 are not coprime (^%) :: (KnownNat m, Integral a) => Mod m -> a -> Mod m mx ^% a | a < 0 = case invertMod mx of Nothing -> throw DivideByZero - Just my -> Mod $ powModNatural (unMod my) (fromIntegral' (-a)) (natVal mx) - | otherwise = Mod $ powModNatural (unMod mx) (fromIntegral' a) (natVal mx) - where -#if __GLASGOW_HASKELL__ == 900 && __GLASGOW_HASKELL_PATCHLEVEL1__ == 1 - -- Cannot use fromIntegral because of https://gitlab.haskell.org/ghc/ghc/-/issues/19411 - fromIntegral' = fromInteger . toInteger -#else - fromIntegral' = fromIntegral -#endif + Just my -> Mod $ powModNatural (unMod my) (fromIntegral (-a)) (natVal mx) + | otherwise = Mod $ powModNatural (unMod mx) (fromIntegral a) (natVal mx) {-# INLINABLE [1] (^%) #-} {-# SPECIALISE [1] (^%) :: @@ -249,6 +305,7 @@ "powMod/2/Int" forall x. x ^% (2 :: Int) = let u = x in u*u "powMod/3/Int" forall x. x ^% (3 :: Int) = let u = x in u*u*u "powMod/2/Word" forall x. x ^% (2 :: Word) = let u = x in u*u -"powMod/3/Word" forall x. x ^% (3 :: Word) = let u = x in u*u*u #-} +"powMod/3/Word" forall x. x ^% (3 :: Word) = let u = x in u*u*u +#-} infixr 8 ^% diff --git a/Data/Mod/Word.hs b/Data/Mod/Word.hs deleted file mode 100644 --- a/Data/Mod/Word.hs +++ /dev/null @@ -1,370 +0,0 @@ --- | --- Module: Data.Mod.Word --- Copyright: (c) 2017-2022 Andrew Lelechenko --- Licence: MIT --- Maintainer: Andrew Lelechenko --- --- , --- promoting moduli to the type level, with an emphasis on performance. --- Originally part of package. --- --- This module supports only moduli, which fit into 'Word'. --- Use (slower) "Data.Mod" to handle arbitrary-sized moduli. - -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE CPP #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE MagicHash #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeInType #-} -{-# LANGUAGE UnboxedTuples #-} - -module Data.Mod.Word - ( Mod - , unMod - , invertMod - , (^%) - ) where - -import Prelude as P hiding (even) -import Control.Exception -import Control.DeepSeq -import Data.Bits -import Data.Ratio -#ifdef MIN_VERSION_semirings -import Data.Euclidean (GcdDomain(..), Euclidean(..), Field) -import Data.Semiring (Semiring(..), Ring(..)) -#endif -import GHC.Exts -import GHC.Generics -import GHC.Natural (Natural(..)) -import GHC.TypeNats (Nat, KnownNat, natVal) - --- | This data type represents --- , --- equipped with useful instances. --- --- For example, 3 :: 'Mod' 10 stands for the class of integers --- congruent to \( 3 \bmod 10 \colon \ldots {−17}, −7, 3, 13, 23 \ldots \) --- --- >>> :set -XDataKinds --- >>> 3 + 8 :: Mod 10 -- 3 + 8 = 11 ≡ 1 (mod 10) --- (1 `modulo` 10) --- --- __Warning:__ division by residue, which is not --- --- with the modulo, throws 'DivideByZero'. --- Consider using 'invertMod' for non-prime moduli. -newtype Mod (m :: Nat) = Mod - { unMod :: Word - -- ^ The canonical representative of the residue class, - -- always between 0 and \( m - 1 \) inclusively. - -- - -- >>> :set -XDataKinds - -- >>> -1 :: Mod 10 - -- (9 `modulo` 10) - } - deriving (Eq, Ord, Generic) - -instance NFData (Mod m) - -instance KnownNat m => Show (Mod m) where - show m = "(" ++ show (unMod m) ++ " `modulo` " ++ show (natVal m) ++ ")" - -instance KnownNat m => Enum (Mod m) where - succ x = if x == maxBound then throw Overflow else coerce (succ @Word) x - pred x = if x == minBound then throw Underflow else coerce (pred @Word) x - - toEnum = fromIntegral - fromEnum = fromIntegral . unMod - - enumFrom x = enumFromTo x maxBound - enumFromThen x y = enumFromThenTo x y (if y >= x then maxBound else minBound) - - enumFromTo = coerce (enumFromTo @Word) - enumFromThenTo = coerce (enumFromThenTo @Word) - -instance KnownNat m => Bounded (Mod m) where - minBound = Mod 0 - maxBound = let mx = Mod (fromIntegral (natVal mx) - 1) in mx - -#if !MIN_VERSION_base(4,12,0) -addWordC# :: Word# -> Word# -> (# Word#, Int# #) -addWordC# x# y# = (# z#, word2Int# c# #) - where - !(# c#, z# #) = x# `plusWord2#` y# -#endif - -addMod :: Natural -> Word -> Word -> Word -addMod (NatS# m#) (W# x#) (W# y#) = - if isTrue# c# || isTrue# (z# `geWord#` m#) then W# (z# `minusWord#` m#) else W# z# - where - !(# z#, c# #) = x# `addWordC#` y# -addMod NatJ#{} _ _ = tooLargeModulo - -subMod :: Natural -> Word -> Word -> Word -subMod (NatS# m#) (W# x#) (W# y#) = - if isTrue# (x# `geWord#` y#) then W# z# else W# (z# `plusWord#` m#) - where - z# = x# `minusWord#` y# -subMod NatJ#{} _ _ = tooLargeModulo - -negateMod :: Natural -> Word -> Word -negateMod _ (W# 0##) = W# 0## -negateMod (NatS# m#) (W# x#) = W# (m# `minusWord#` x#) -negateMod NatJ#{} _ = tooLargeModulo - -mulMod :: Natural -> Word -> Word -> Word -mulMod (NatS# m#) (W# x#) (W# y#) = W# r# - where - !(# z1#, z2# #) = timesWord2# x# y# - !(# _, r# #) = quotRemWord2# z1# z2# m# -mulMod NatJ#{} _ _ = tooLargeModulo - -fromIntegerMod :: Natural -> Integer -> Word -fromIntegerMod m x = case toIntegralSized m :: Maybe Word of - Nothing -> tooLargeModulo - Just{} -> fromInteger $ x `P.mod` toInteger m - -#ifdef MIN_VERSION_semirings - -fromNaturalMod :: Natural -> Natural -> Word -fromNaturalMod m x = case toIntegralSized m :: Maybe Word of - Nothing -> tooLargeModulo - Just{} -> fromIntegral' $ x `P.rem` m - where -#if __GLASGOW_HASKELL__ == 900 && __GLASGOW_HASKELL_PATCHLEVEL1__ == 1 - -- Cannot use fromIntegral because of https://gitlab.haskell.org/ghc/ghc/-/issues/19411 - fromIntegral' = fromInteger . toInteger -#else - fromIntegral' = fromIntegral -#endif - -#endif - -tooLargeModulo :: a -tooLargeModulo = error "modulo does not fit into a machine word" - -instance KnownNat m => Num (Mod m) where - mx@(Mod !x) + (Mod !y) = Mod $ addMod (natVal mx) x y - {-# INLINE (+) #-} - mx@(Mod !x) - (Mod !y) = Mod $ subMod (natVal mx) x y - {-# INLINE (-) #-} - negate mx@(Mod !x) = Mod $ negateMod (natVal mx) x - {-# INLINE negate #-} - mx@(Mod !x) * (Mod !y) = Mod $ mulMod (natVal mx) x y - {-# INLINE (*) #-} - abs = id - {-# INLINE abs #-} - signum = const x - where - x = if natVal x > 1 then Mod 1 else Mod 0 - {-# INLINE signum #-} - fromInteger x = mx - where - mx = Mod $ fromIntegerMod (natVal mx) x - {-# INLINE fromInteger #-} - -#ifdef MIN_VERSION_semirings - -instance KnownNat m => Semiring (Mod m) where - plus = (+) - {-# INLINE plus #-} - times = (*) - {-# INLINE times #-} - zero = Mod 0 - {-# INLINE zero #-} - one = mx - where - mx = if natVal mx > 1 then Mod 1 else Mod 0 - {-# INLINE one #-} - fromNatural x = mx - where - mx = Mod $ fromNaturalMod (natVal mx) x - {-# INLINE fromNatural #-} - -instance KnownNat m => Ring (Mod m) where - negate = P.negate - {-# INLINE negate #-} - --- | See the warning about division above. -instance KnownNat m => GcdDomain (Mod m) where - divide x y = Just (x / y) - gcd = const $ const 1 - lcm = const $ const 1 - coprime = const $ const True - --- | See the warning about division above. -instance KnownNat m => Euclidean (Mod m) where - degree = const 0 - quotRem x y = (x / y, 0) - quot = (/) - rem = const $ const 0 - --- | See the warning about division above. -instance KnownNat m => Field (Mod m) - -#endif - --- | See the warning about division above. -instance KnownNat m => Fractional (Mod m) where - fromRational r = case denominator r of - 1 -> num - den -> num / fromInteger den - where - num = fromInteger (numerator r) - {-# INLINE fromRational #-} - recip mx = case invertMod mx of - Nothing -> throw DivideByZero - Just y -> y - {-# INLINE recip #-} - --- | If an argument is --- --- with the modulo, return its modular inverse. --- Otherwise return 'Nothing'. --- --- >>> :set -XDataKinds --- >>> invertMod 3 :: Mod 10 -- 3 * 7 = 21 ≡ 1 (mod 10) --- Just (7 `modulo` 10) --- >>> invertMod 4 :: Mod 10 -- 4 and 10 are not coprime --- Nothing -invertMod :: KnownNat m => Mod m -> Maybe (Mod m) -invertMod mx@(Mod x) = case natVal mx of - NatJ#{} -> tooLargeModulo - NatS# 0## -> Nothing - NatS# m# -> Mod <$> invertModWord x (W# m#) - -invertModWord :: Word -> Word -> Maybe Word -invertModWord x m@(W# m#) - -- If both x and k are even, no inverse exists - | even x, isTrue# (k# `gtWord#` 0##) = Nothing - | otherwise = case invertModWordOdd x m' of - Nothing -> Nothing - -- goDouble cares only about mod 2^k, - -- so overflows and underflows in (1 - x * y) are fine - Just y -> Just $ goDouble y (1 - x * y) - where - k# = ctz# m# - m' = m `unsafeShiftR` I# (word2Int# k#) - - xm' = x * m' - - goDouble :: Word -> Word -> Word - goDouble acc r@(W# r#) - | isTrue# (tz# `geWord#` k#) - = acc - | otherwise - = goDouble (acc + m' `unsafeShiftL` tz) (r - xm' `unsafeShiftL` tz) - where - tz# = ctz# r# - tz = I# (word2Int# tz#) - --- | Extended binary gcd. --- The second argument must be odd. -invertModWordOdd :: Word -> Word -> Maybe Word -invertModWordOdd 0 !_ = Nothing -invertModWordOdd !x !m = go00 0 m 1 x - where - halfMp1 :: Word - halfMp1 = half m + 1 - - -- Both s and s' may be even - go00 :: Word -> Word -> Word -> Word -> Maybe Word - go00 !r !s !r' !s' - | even s = let (# hr, hs #) = doHalf r s in go00 hr hs r' s' - | otherwise = go10 r s r' s' - - -- Here s is odd, s' may be even - go10 :: Word -> Word -> Word -> Word -> Maybe Word - go10 !r !s !r' !s' - | even s' = let (# hr', hs' #) = doHalf r' s' in go10 r s hr' hs' - | otherwise = go11 r s r' s' - - -- Here s may be even, s' is odd - go01 :: Word -> Word -> Word -> Word -> Maybe Word - go01 !r !s !r' !s' - | even s = let (# hr, hs #) = doHalf r s in go01 hr hs r' s' - | otherwise = go11 r s r' s' - - -- Both s and s' are odd - go11 :: Word -> Word -> Word -> Word -> Maybe Word - go11 !r !s !r' !s' = case s `compare` s' of - EQ -> if s == 1 then Just r else Nothing - LT -> let newR' = r' - r + (r `ge` r') * m in - let newS' = s' - s in - let (# hr', hs' #) = doHalf newR' newS' in - go10 r s hr' hs' - GT -> let newR = r - r' + (r' `ge` r) * m in - let newS = s - s' in - let (# hr, hs #) = doHalf newR newS in - go01 hr hs r' s' - - doHalf :: Word -> Word -> (# Word, Word #) - doHalf r s = (# half r + (r .&. 1) * halfMp1, half s #) - {-# INLINE doHalf #-} - --- | ge x y returns 1 is x >= y and 0 otherwise. -ge :: Word -> Word -> Word -ge (W# x) (W# y) = W# (int2Word# (x `geWord#` y)) - -even :: Word -> Bool -even x = (x .&. 1) == 0 -{-# INLINE even #-} - -half :: Word -> Word -half x = x `shiftR` 1 -{-# INLINE half #-} - --- | Drop-in replacement for 'Prelude.^' with a bit better performance. --- Negative powers are allowed, but may throw 'DivideByZero', if an argument --- is not with the modulo. --- --- Building with @-O@ triggers a rewrite rule 'Prelude.^' = '^%'. --- --- >>> :set -XDataKinds --- >>> 3 ^% 4 :: Mod 10 -- 3 ^ 4 = 81 ≡ 1 (mod 10) --- (1 `modulo` 10) --- >>> 3 ^% (-1) :: Mod 10 -- 3 * 7 = 21 ≡ 1 (mod 10) --- (7 `modulo` 10) --- >>> 4 ^% (-1) :: Mod 10 -- 4 and 10 are not coprime --- (*** Exception: divide by zero -(^%) :: (KnownNat m, Integral a) => Mod m -> a -> Mod m -mx@(Mod (W# x#)) ^% a = case natVal mx of - NatJ#{} -> tooLargeModulo - NatS# m# - | a < 0 -> case invertMod mx of - Nothing -> throw DivideByZero - Just (Mod (W# y#)) -> Mod $ W# (f y# (- a) 1##) - | otherwise -> Mod $ W# (f x# a 1##) - where - f :: Integral a => Word# -> a -> Word# -> Word# - f _ 0 acc# = acc# - f b# e acc# = f bb# (e `P.quot` 2) (if odd e then ba# else acc#) - where - !(# bb1#, bb2# #) = timesWord2# b# b# - !(# _, bb# #) = quotRemWord2# bb1# bb2# m# - !(# ba1#, ba2# #) = timesWord2# b# acc# - !(# _, ba# #) = quotRemWord2# ba1# ba2# m# -{-# INLINABLE [1] (^%) #-} - -{-# SPECIALISE [1] (^%) :: - KnownNat m => Mod m -> Integer -> Mod m, - KnownNat m => Mod m -> Natural -> Mod m, - KnownNat m => Mod m -> Int -> Mod m, - KnownNat m => Mod m -> Word -> Mod m #-} - -{-# RULES -"powMod" forall (x :: KnownNat m => Mod m) p. x ^ p = x ^% p - -"powMod/2/Integer" forall x. x ^% (2 :: Integer) = let u = x in u*u -"powMod/3/Integer" forall x. x ^% (3 :: Integer) = let u = x in u*u*u -"powMod/2/Int" forall x. x ^% (2 :: Int) = let u = x in u*u -"powMod/3/Int" forall x. x ^% (3 :: Int) = let u = x in u*u*u -"powMod/2/Word" forall x. x ^% (2 :: Word) = let u = x in u*u -"powMod/3/Word" forall x. x ^% (3 :: Word) = let u = x in u*u*u #-} - -infixr 8 ^% diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2017-2022 Andrew Lelechenko +Copyright (c) 2019 Andrew Lelechenko Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,4 +1,4 @@ -# mod [![Hackage](http://img.shields.io/hackage/v/mod.svg)](https://hackage.haskell.org/package/mod) [![Stackage LTS](http://stackage.org/package/mod/badge/lts)](http://stackage.org/lts/package/mod) [![Stackage Nightly](http://stackage.org/package/mod/badge/nightly)](http://stackage.org/nightly/package/mod) +# mod [![Build Status](https://travis-ci.org/Bodigrim/mod.svg)](https://travis-ci.org/Bodigrim/mod) [![Hackage](http://img.shields.io/hackage/v/mod.svg)](https://hackage.haskell.org/package/mod) [![Hackage CI](https://matrix.hackage.haskell.org/api/v2/packages/mod/badge)](https://matrix.hackage.haskell.org/package/mod) [![Stackage LTS](http://stackage.org/package/mod/badge/lts)](http://stackage.org/lts/package/mod) [![Stackage Nightly](http://stackage.org/package/mod/badge/nightly)](http://stackage.org/nightly/package/mod) [Modular arithmetic](https://en.wikipedia.org/wiki/Modular_arithmetic), promoting moduli to the type level, with an emphasis on performance. @@ -21,21 +21,19 @@ ## Competitors There are other Haskell packages, employing the very same idea of moduli on the type level, -namely `modular`, `modular-arithmetic` and `finite-field`. One can also use `finite-typelits`, -which covers some elementary modular arithmetic as well. -Unfortunately, all of them fall behind +namely `modular` and `modular-arithmetic`. Unfortunately, both of them fall behind in terms of performance. Here is a brief comparison: -| Discipline | `mod` | `modular` | `modular-arithmetic` | `finite-typelits` | `finite-field` -| :---------- | :----: | :-------: | :------------------: | :---------------: | :------------: -| Addition | Fast | Slow | Slow | Slow | Slow -| Small `(*)` | Fast | Slow | Slow | Slow | Slow -| Inversion | Fast | N/A | Slow | N/A | Slow -| Power | Fast | Slow | Slow | Slow | Slow -| Overflows | Safe | Safe | Unsafe | Safe | Safe +| Discipline | `mod` | `modular` | `modular-arithmetic` +| :---------- | :----: | :-------: | :------------------: +| Addition | Fast | Slow | Slow +| Small `(*)` | Fast | Slow | Slow +| Inversion | Fast | N/A | Slow +| Power | Fast | Slow | Slow +| Overflows | Safe | Safe | Unsafe * __Addition.__ - All competing implementations of + It appears that `modular` and `modular-arithmetic` implementations of the modular addition involve divisions, while `mod` completely avoids this costly operation. It makes difference even for small numbers; e. g., `sum [1..10^7]` becomes 5x faster. For larger integers the speed up @@ -68,38 +66,6 @@ Even less expected is that `50 :: Mod Word8 300` appears to be `6` (remember that type-level numbers are always `Natural`). -### What is the difference between `mod` and `finite-typelits`? - -`mod` is specifically designed to represent modular residues -for mathematical applications (__wrapping-around__ finite numbers) and -provides modular inversion and exponentiation. - -The main focus of `finite-typelits` is on __non-wrapping-around__ finite numbers, -like indices of arrays in `vector-sized`. -It features a `Num` instance only for the sake of overloading numeric literals. -There is no lawful way to define `Num` except modular arithmetic, -but from `finite-typelits` viewpoint this is a by-product. - -## Citius, altius, fortius! - -If you are looking for an ultimate performance -and your moduli fit into `Word`, -try `Data.Mod.Word`, -which is a drop-in replacement of `Data.Mod`, -offering better performance and much less allocations. - -## Benchmarks - -Here are some relative benchmarks (less is better), -which can be reproduced by running `cabal bench`. - -| Discipline | `Data.Mod.Word` | `Data.Mod` | `modular` | `modular-arithmetic` | `finite-typelits` | `finite-field` -| :---------- | :--------------: | :---------: | :-------: | :------------------: | :---------------: | :------------: -| Sum | 0.25x | 1x | 11.4x | 5.7x | 8.9x | 8.6x -| Product | 0.95x | 1x | 9.6x | 4.8x | 7.0x | 7.0x -| Inversion | 0.95x | 1x | N/A | 2.6x | N/A | 3.0x -| Power | 0.90x | 1x | 6.9x | 3.8x | 5.0x | 4.9x - ## What's next? This package was cut out of [`arithmoi`](https://hackage.haskell.org/package/arithmoi) @@ -107,4 +73,4 @@ with a light dependency footprint. This goal certainly limits the scope of API to the bare minimum. If you need more advanced tools (the Chinese remainder theorem, cyclic groups, modular equations, etc.) -please refer to [Math.NumberTheory.Moduli](https://hackage.haskell.org/package/arithmoi/docs/Math-NumberTheory-Moduli.html). +please refer to [Math.NumberTheory.Moduli](hackage.haskell.org/package/arithmoi/docs/Math-NumberTheory-Moduli.html). diff --git a/bench/Bench.hs b/bench/Bench.hs deleted file mode 100644 --- a/bench/Bench.hs +++ /dev/null @@ -1,193 +0,0 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE CPP #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE PolyKinds #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE ViewPatterns #-} - -{-# OPTIONS_GHC -fno-warn-type-defaults -fno-warn-name-shadowing #-} - -module Main where - -import Data.Proxy -import Test.Tasty.Bench - -import qualified Data.Mod -import qualified Data.Mod.Word -#ifdef MIN_VERSION_finite_field -import qualified Data.FiniteField.PrimeField -#endif -#ifdef MIN_VERSION_finite_typelits -import qualified Data.Finite -#endif -#ifdef MIN_VERSION_modular_arithmetic -import qualified Data.Modular -#endif -#ifdef MIN_VERSION_modular -import qualified Numeric.Modular -#endif - -type P = 20000003 - -#ifdef MIN_VERSION_modular -forceModular :: Numeric.Modular.Mod P -> Numeric.Modular.Mod P -forceModular a = (a == a) `seq` a -#endif - -benchSum :: Benchmark -benchSum = bgroup "Sum" - [ measure "Data.Mod" (Proxy @Data.Mod.Mod) - , cmp $ measure "Data.Mod.Word" (Proxy @Data.Mod.Word.Mod) -#ifdef MIN_VERSION_finite_field - , cmp $ measure "finite-field" (Proxy @Data.FiniteField.PrimeField.PrimeField) -#endif -#ifdef MIN_VERSION_finite_typelits - , cmp $ measure "finite-typelits" (Proxy @Data.Finite.Finite) -#endif -#ifdef MIN_VERSION_modular_arithmetic - , cmp $ measure "modular-arithmetic" (Proxy @(Data.Modular.Mod Integer)) -#endif -#ifdef MIN_VERSION_modular - , cmp $ bench "modular" $ nf (show . sumNModular) lim -#endif - ] - where - cmp = bcompare "$NF == \"Data.Mod\" && $(NF-1) == \"Sum\"" - lim = 20000000 - - measure :: (Eq (t P), Num (t P)) => String -> Proxy t -> Benchmark - measure name p = bench name $ whnf (sumN p) lim - {-# INLINE measure #-} - - sumN :: (Eq (t P), Num (t P)) => Proxy t -> Int -> t P - sumN = const $ \n -> go 0 (fromIntegral n) - where - go !acc 0 = acc - go acc n = go (acc + n) (n - 1) - {-# INLINE sumN #-} - -#ifdef MIN_VERSION_modular - sumNModular :: Int -> Numeric.Modular.Mod P - sumNModular = \n -> go 0 (fromIntegral n) - where - go acc@(forceModular -> !_) 0 = acc - go acc n = go (acc + n) (n - 1) - {-# INLINE sumNModular #-} -#endif - -benchProduct :: Benchmark -benchProduct = bgroup "Product" - [ measure "Data.Mod" (Proxy @Data.Mod.Mod) - , cmp $ measure "Data.Mod.Word" (Proxy @Data.Mod.Word.Mod) -#ifdef MIN_VERSION_finite_field - , cmp $ measure "finite-field" (Proxy @Data.FiniteField.PrimeField.PrimeField) -#endif -#ifdef MIN_VERSION_finite_typelits - , cmp $ measure "finite-typelits" (Proxy @Data.Finite.Finite) -#endif -#ifdef MIN_VERSION_modular_arithmetic - , cmp $ measure "modular-arithmetic" (Proxy @(Data.Modular.Mod Integer)) -#endif -#ifdef MIN_VERSION_modular - , cmp $ bench "modular" $ nf (show . productNModular) lim -#endif - ] - where - cmp = bcompare "$NF == \"Data.Mod\" && $(NF-1) == \"Product\"" - lim = 20000000 - - measure :: (Eq (t P), Num (t P)) => String -> Proxy t -> Benchmark - measure name p = bench name $ whnf (productN p) lim - {-# INLINE measure #-} - - productN :: (Eq (t P), Num (t P)) => Proxy t -> Int -> t P - productN = const $ \n -> go 1 (fromIntegral n) - where - go !acc 0 = acc - go acc n = go (acc * n) (n - 1) - {-# INLINE productN #-} - -#ifdef MIN_VERSION_modular - productNModular :: Int -> Numeric.Modular.Mod P - productNModular = \n -> go 1 (fromIntegral n) - where - go acc@(forceModular -> !_) 0 = acc - go acc n = go (acc * n) (n - 1) - {-# INLINE productNModular #-} -#endif - -benchInversion :: Benchmark -benchInversion = bgroup "Inversion" - [ measure "Data.Mod" (Proxy @Data.Mod.Mod) - , cmp $ measure "Data.Mod.Word" (Proxy @Data.Mod.Word.Mod) -#ifdef MIN_VERSION_finite_field - , cmp $ measure "finite-field" (Proxy @Data.FiniteField.PrimeField.PrimeField) -#endif -#ifdef MIN_VERSION_modular_arithmetic - , cmp $ measure "modular-arithmetic" (Proxy @(Data.Modular.Mod Integer)) -#endif - ] - where - cmp = bcompare "$NF == \"Data.Mod\" && $(NF-1) == \"Inversion\"" - lim = 1500000 - - measure :: (Eq (t P), Fractional (t P)) => String -> Proxy t -> Benchmark - measure name p = bench name $ whnf (invertN p) lim - {-# INLINE measure #-} - - invertN :: (Eq (t P), Fractional (t P)) => Proxy t -> Int -> t P - invertN = const $ \n -> go 0 (fromIntegral n) - where - go !acc 0 = acc - go acc n = go (acc + recip n) (n - 1) - {-# INLINE invertN #-} - -benchPower :: Benchmark -benchPower = bgroup "Power" - [ measure "Data.Mod" (Proxy @Data.Mod.Mod) - , cmp $ measure "Data.Mod.Word" (Proxy @Data.Mod.Word.Mod) -#ifdef MIN_VERSION_finite_field - , cmp $ measure "finite-field" (Proxy @Data.FiniteField.PrimeField.PrimeField) -#endif -#ifdef MIN_VERSION_finite_typelits - , cmp $ measure "finite-typelits" (Proxy @Data.Finite.Finite) -#endif -#ifdef MIN_VERSION_modular_arithmetic - , cmp $ measure "modular-arithmetic" (Proxy @(Data.Modular.Mod Integer)) -#endif -#ifdef MIN_VERSION_modular - , cmp $ bench "modular" $ nf (show . powerNModular) lim -#endif - ] - where - cmp = bcompare "$NF == \"Data.Mod\" && $(NF-1) == \"Power\"" - lim = 1000000 - - measure :: (Eq (t P), Num (t P)) => String -> Proxy t -> Benchmark - measure name p = bench name $ whnf (powerN p) lim - {-# INLINE measure #-} - - powerN :: (Eq (t P), Num (t P)) => Proxy t -> Int -> t P - powerN = const $ go 0 - where - go !acc 0 = acc - go acc n = go (acc + 2 ^ n) (n - 1) - {-# INLINE powerN #-} - -#ifdef MIN_VERSION_modular - powerNModular :: Int -> Numeric.Modular.Mod P - powerNModular = go 0 - where - go acc@(forceModular -> !_) 0 = acc - go acc n = go (acc + 2 ^ n) (n - 1) - {-# INLINE powerNModular #-} -#endif - -main :: IO () -main = defaultMain - [ benchSum - , benchProduct - , benchInversion - , benchPower - ] diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,25 +1,3 @@ -# 0.0.0.0 - -* Offshoot of 0.1.2.2, but without `integer-gmp` and `vector` dependencies. - Provided only for the sake of clients, who use GHC < 9 with `integer-simple`: - performance is badly affected and there are no `Storable`, `Prim` and `Unbox` instances. - -# 0.1.2.2 - -* Work around an issue with [`fromIntegral`](https://gitlab.haskell.org/ghc/ghc/-/issues/19411) in GHC 9.0.1. - -# 0.1.2.1 - -* Support `integer-gmp-1.1`. - -# 0.1.2.0 - -* Add `Storable`, `Prim` and `Unbox` instances. - -# 0.1.1.0 - -* Add `Data.Mod.Word`. - # 0.1.0.0 * Initial release diff --git a/mod.cabal b/mod.cabal --- a/mod.cabal +++ b/mod.cabal @@ -1,10 +1,10 @@ name: mod -version: 0.0.0.0 +version: 0.1.0.0 cabal-version: >=1.10 build-type: Simple license: MIT license-file: LICENSE -copyright: 2017-2022 Andrew Lelechenko +copyright: 2019 Andrew Lelechenko maintainer: Andrew Lelechenko homepage: https://github.com/Bodigrim/mod bug-reports: https://github.com/Bodigrim/mod/issues @@ -15,7 +15,7 @@ Originally part of package. category: Math, Number Theory author: Andrew Lelechenko -tested-with: GHC ==8.2.2 GHC ==8.4.4 GHC ==8.6.5 GHC ==8.8.3 GHC ==8.10.7 GHC ==9.0.2 GHC ==9.2.1 +tested-with: GHC ==8.0.2 GHC ==8.2.2 GHC ==8.4.4 GHC ==8.6.5 GHC ==8.8.1 extra-source-files: changelog.md README.md @@ -30,20 +30,20 @@ library build-depends: - base >=4.10 && <5, - deepseq + base >=4.9 && <5, + deepseq, + integer-gmp <1.1 if flag(semirings) build-depends: semirings >= 0.5 exposed-modules: Data.Mod - Data.Mod.Word default-language: Haskell2010 - ghc-options: -Wall -O2 -Wno-deprecations -Wcompat + ghc-options: -Wall test-suite mod-tests build-depends: - base >=4.10 && <5, + base >=4.9 && <5, mod, quickcheck-classes-base, tasty >=0.10, @@ -56,19 +56,4 @@ main-is: Test.hs default-language: Haskell2010 hs-source-dirs: test - ghc-options: -Wall -threaded -rtsopts -Wcompat - -benchmark mod-bench - build-depends: - base, - mod, - -- finite-field, - -- finite-typelits, - -- modular, - -- modular-arithmetic, - tasty-bench >= 0.2.5 - type: exitcode-stdio-1.0 - main-is: Bench.hs - default-language: Haskell2010 - hs-source-dirs: bench - ghc-options: -Wall -O2 -Wcompat + ghc-options: -Wall diff --git a/test/Test.hs b/test/Test.hs --- a/test/Test.hs +++ b/test/Test.hs @@ -1,97 +1,39 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -module Main (main) where +module Main where -import Data.Bits import Data.Mod -import qualified Data.Mod.Word as Word import Data.Proxy -import Data.Semigroup -import GHC.TypeNats (KnownNat, SomeNat(..), natVal, someNatVal) import Test.Tasty import Test.Tasty.QuickCheck import Test.QuickCheck.Classes.Base #ifdef MIN_VERSION_semirings import Data.Semiring (Ring) -import Test.QuickCheck.Classes (semiringLaws, ringLaws) +import Test.QuickCheck.Classes #endif +#if MIN_VERSION_base(4,11,0) +import GHC.TypeNats hiding (Mod) +#elif MIN_VERSION_base(4,10,0) +import GHC.TypeNats +#else +import GHC.TypeLits +#endif + main :: IO () main = defaultMain $ testGroup "All" [ testGroup "Mod 1" $ - testProperty "fromInteger" - (fromIntegerProp (Proxy :: Proxy 1)) : - map lawsToTest (laws1 (Proxy :: Proxy (Mod 1))) + map lawsToTest $ laws1 (Proxy :: Proxy (Mod 1)) , testGroup "Mod 2310" $ - testProperty "fromInteger" - (fromIntegerProp (Proxy :: Proxy 2310)) : - testProperty "invertMod" (invertModProp @2310) : - testProperty "powMod" (powModProp @2310) : - map lawsToTest (laws (Proxy :: Proxy (Mod 2310))) - , testGroup "Mod 18446744073709551615" $ - testProperty "fromInteger" - (fromIntegerProp (Proxy :: Proxy 18446744073709551615)) : - testProperty "invertMod" (invertModProp @18446744073709551615) : - testProperty "powMod" (powModProp @18446744073709551615) : - map lawsToTest (laws (Proxy :: Proxy (Mod 18446744073709551615))) + map lawsToTest $ laws (Proxy :: Proxy (Mod 2310)) , testGroup "Mod 18446744073709551626" $ - testProperty "fromInteger" - (fromIntegerProp (Proxy :: Proxy 18446744073709551626)) : - testProperty "powMod" (powModProp @18446744073709551626) : - testProperty "invertMod" (invertModProp @18446744073709551626) : - map lawsToTest (laws (Proxy :: Proxy (Mod 18446744073709551626))) + map lawsToTest $ laws (Proxy :: Proxy (Mod 18446744073709551626)) , testGroup "Mod 123456789012345678901234567890" $ - testProperty "fromInteger" - (fromIntegerProp (Proxy :: Proxy 123456789012345678901234567890)) : - testProperty "powMod" (powModProp @123456789012345678901234567890) : - testProperty "invertMod" (invertModProp @123456789012345678901234567890) : - map lawsToTest (laws (Proxy :: Proxy (Mod 123456789012345678901234567890))) - , testGroup "Random Mod" - [ testProperty "fromInteger" fromIntegerRandomProp - , testProperty "invertMod" invertModRandomProp - , testProperty "powMod" powModRandomProp - , testProperty "powMod on sum" powModRandomAdditiveProp - , testProperty "powMod special case" powModCase - ] - - , testGroup "Word.Mod 1" $ - testProperty "fromInteger" - (fromIntegerWordProp (Proxy :: Proxy 1)) : - map lawsToTest (laws1 (Proxy :: Proxy (Word.Mod 1))) - , testGroup "Word.Mod 2310" $ - testProperty "fromInteger" - (fromIntegerWordProp (Proxy :: Proxy 2310)) : - testProperty "powMod" (powModWordProp @2310) : - testProperty "invertMod" (invertModWordProp @2310) : - map lawsToTest (laws (Proxy :: Proxy (Word.Mod 2310))) - , if finiteBitSize (0 :: Word) == 64 then - testGroup "Word.Mod 18446744073709551615" $ - testProperty "fromInteger" - (fromIntegerWordProp (Proxy :: Proxy 18446744073709551615)) : - testProperty "powMod" (powModWordProp @18446744073709551615) : - testProperty "invertMod" (invertModWordProp @18446744073709551615) : - map lawsToTest (laws (Proxy :: Proxy (Word.Mod 18446744073709551615))) - else - testGroup "Word.Mod 4294967295" $ - testProperty "fromInteger" - (fromIntegerWordProp (Proxy :: Proxy 4294967295)) : - testProperty "powMod" (powModWordProp @4294967295) : - testProperty "invertMod" (invertModWordProp @4294967295) : - map lawsToTest (laws (Proxy :: Proxy (Word.Mod 4294967295))) - , testGroup "Random Word.Mod" - [ testProperty "fromInteger" fromIntegerWordRandomProp - , testProperty "invertMod" invertModWordRandomProp - , testProperty "invertMod near maxBound" invertModWordRandomPropNearMaxBound - , testProperty "powMod" powModWordRandomProp - , testProperty "powMod on sum" powModWordRandomAdditiveProp - , testProperty "powMod special case" powModWordCase - ] + map lawsToTest $ laws (Proxy :: Proxy (Mod 123456789012345678901234567890)) ] #ifdef MIN_VERSION_semirings @@ -122,129 +64,4 @@ testGroup name $ map (uncurry testProperty) props instance KnownNat m => Arbitrary (Mod m) where - arbitrary = oneof [arbitraryBoundedEnum, negate <$> arbitraryBoundedEnum, fromInteger <$> arbitrary] - shrink = map fromInteger . shrink . toInteger . unMod - -instance KnownNat m => Arbitrary (Word.Mod m) where - arbitrary = oneof [arbitraryBoundedEnum, negate <$> arbitraryBoundedEnum, fromInteger <$> arbitrary] - shrink = map fromIntegral . shrink . Word.unMod - -------------------------------------------------------------------------------- --- fromInteger - -fromIntegerRandomProp :: Positive Integer -> Integer -> Property -fromIntegerRandomProp (Positive m) n = m > 1 ==> case someNatVal (fromInteger m) of - SomeNat p -> fromIntegerProp p n - -fromIntegerProp :: forall m. KnownNat m => Proxy m -> Integer -> Property -fromIntegerProp p n = unMod m === fromInteger (n `mod` toInteger (natVal p)) - where - m :: Mod m - m = fromInteger n - -fromIntegerWordRandomProp :: Word -> Integer -> Property -fromIntegerWordRandomProp m n = m > 1 ==> case someNatVal (fromIntegral m) of - SomeNat p -> fromIntegerWordProp p n - -fromIntegerWordProp :: forall m. KnownNat m => Proxy m -> Integer -> Property -fromIntegerWordProp p n = Word.unMod m === fromInteger (n `mod` toInteger (natVal p)) - where - m :: Word.Mod m - m = fromInteger n - -------------------------------------------------------------------------------- --- invertMod - -invertModRandomProp :: Positive Integer -> Integer -> Property -invertModRandomProp (Positive m) n = m > 1 ==> case someNatVal (fromInteger m) of - SomeNat (Proxy :: Proxy m) -> invertModProp (fromInteger n :: Mod m) - -invertModProp :: KnownNat m => Mod m -> Property -invertModProp x = case invertMod x of - Nothing -> g =/= 1 - Just x' -> g === 1 .&&. x * x' === 1 .&&. x' * x === 1 .&&. x' === x ^% (-1 :: Int) - where - g = gcd (unMod x) (fromIntegral (natVal x)) - -invertModWordRandomProp :: Word -> Integer -> Property -invertModWordRandomProp m n = m > 1 ==> case someNatVal (fromIntegral m) of - SomeNat (Proxy :: Proxy m) -> invertModWordProp (fromInteger n :: Word.Mod m) - -invertModWordRandomPropNearMaxBound :: Word -> Integer -> Property -invertModWordRandomPropNearMaxBound m n = m < maxBound ==> - case someNatVal (fromIntegral (maxBound - m)) of - SomeNat (Proxy :: Proxy m) -> invertModWordProp (fromInteger n :: Word.Mod m) - -invertModWordProp :: KnownNat m => Word.Mod m -> Property -invertModWordProp x = case Word.invertMod x of - Nothing -> g =/= 1 - Just x' -> g === 1 .&&. x * x' === 1 .&&. x' * x === 1 .&&. x' === x Word.^% (-1 :: Int) - where - g = gcd (Word.unMod x) (fromIntegral (natVal x)) - -------------------------------------------------------------------------------- --- powMod - -powModRandomProp :: Positive Integer -> Integer -> Int -> Property -powModRandomProp (Positive m) x n = m > 1 ==> case someNatVal (fromInteger m) of - SomeNat (Proxy :: Proxy m) -> powModProp (fromInteger x :: Mod m) n - -powModProp :: KnownNat m => Mod m -> Int -> Property -powModProp x n - | n >= 0 = x ^% n === getProduct (stimes n (Product x)) - | otherwise = case invertMod x of - Nothing -> property True - Just x' -> x ^% n === getProduct (stimes (-n) (Product x')) - -powModRandomAdditiveProp :: Positive Integer -> Integer -> Huge Integer -> Huge Integer -> Property -powModRandomAdditiveProp (Positive m) x (Huge n1) (Huge n2) = m > 1 ==> case someNatVal (fromInteger m) of - SomeNat (Proxy :: Proxy m) -> powModAdditiveProp (fromInteger x :: Mod m) n1 n2 - -powModAdditiveProp :: KnownNat m => Mod m -> Integer -> Integer -> Property -powModAdditiveProp x n1 n2 - | invertMod x == Nothing, n1 < 0 || n2 < 0 - = property True - | otherwise - = (x ^% n1) * (x ^% n2) === x ^% (n1 + n2) - -powModCase :: Property -powModCase = once $ 0 ^% n === (0 :: Mod 2) - where - n = 1 `shiftL` 64 :: Integer - -powModWordRandomProp :: Word -> Integer -> Int -> Property -powModWordRandomProp m x k = m > 1 ==> case someNatVal (fromIntegral m) of - SomeNat (Proxy :: Proxy m) -> powModWordProp (fromInteger x :: Word.Mod m) k - -powModWordProp :: KnownNat m => Word.Mod m -> Int -> Property -powModWordProp x n - | n >= 0 = x Word.^% n === getProduct (stimes n (Product x)) - | otherwise = case Word.invertMod x of - Nothing -> property True - Just x' -> x Word.^% n === getProduct (stimes (-n) (Product x')) - -powModWordRandomAdditiveProp :: Word -> Integer -> Huge Integer -> Huge Integer -> Property -powModWordRandomAdditiveProp m x (Huge n1) (Huge n2) = m > 1 ==> case someNatVal (fromIntegral m) of - SomeNat (Proxy :: Proxy m) -> powModWordAdditiveProp (fromInteger x :: Word.Mod m) n1 n2 - -powModWordAdditiveProp :: KnownNat m => Word.Mod m -> Integer -> Integer -> Property -powModWordAdditiveProp x n1 n2 - | Word.invertMod x == Nothing, n1 < 0 || n2 < 0 - = property True - | otherwise - = (x Word.^% n1) * (x Word.^% n2) === x Word.^% (n1 + n2) - -powModWordCase :: Property -powModWordCase = once $ 0 Word.^% n === (0 :: Word.Mod 2) - where - n = 1 `shiftL` 64 :: Integer - -newtype Huge a = Huge { _getHuge :: a } - deriving (Show) - -instance (Bits a, Num a, Arbitrary a) => Arbitrary (Huge a) where - arbitrary = do - Positive l <- arbitrary - ds <- vector l - return $ Huge $ foldl1 (\acc n -> acc `shiftL` 63 + n) ds - shrink (Huge n) = Huge <$> shrink n + arbitrary = oneof [arbitraryBoundedEnum, fromInteger <$> arbitrary]