mod 0.1.1.0 → 0.1.2.0
raw patch · 8 files changed
+626/−141 lines, 8 filesdep +primitivedep +vectorPVP ok
version bump matches the API change (PVP)
Dependencies added: primitive, vector
API changes (from Hackage documentation)
+ Data.Mod: instance GHC.TypeNats.KnownNat m => Data.Primitive.Types.Prim (Data.Mod.Mod m)
+ Data.Mod: instance GHC.TypeNats.KnownNat m => Data.Vector.Generic.Base.Vector Data.Vector.Unboxed.Base.Vector (Data.Mod.Mod m)
+ Data.Mod: instance GHC.TypeNats.KnownNat m => Data.Vector.Generic.Mutable.Base.MVector Data.Vector.Unboxed.Base.MVector (Data.Mod.Mod m)
+ Data.Mod: instance GHC.TypeNats.KnownNat m => Data.Vector.Unboxed.Base.Unbox (Data.Mod.Mod m)
+ Data.Mod: instance GHC.TypeNats.KnownNat m => Foreign.Storable.Storable (Data.Mod.Mod m)
+ Data.Mod.Word: instance Data.Primitive.Types.Prim (Data.Mod.Word.Mod m)
+ Data.Mod.Word: instance Data.Vector.Generic.Base.Vector Data.Vector.Unboxed.Base.Vector (Data.Mod.Word.Mod m)
+ Data.Mod.Word: instance Data.Vector.Generic.Mutable.Base.MVector Data.Vector.Unboxed.Base.MVector (Data.Mod.Word.Mod m)
+ Data.Mod.Word: instance Data.Vector.Unboxed.Base.Unbox (Data.Mod.Word.Mod m)
+ Data.Mod.Word: instance Foreign.Storable.Storable (Data.Mod.Word.Mod m)
Files
- Data/Mod.hs +268/−27
- Data/Mod/Word.hs +107/−31
- LICENSE +1/−1
- README.md +37/−12
- bench/Bench.hs +133/−46
- changelog.md +4/−0
- mod.cabal +21/−6
- test/Test.hs +55/−18
Data/Mod.hs view
@@ -1,6 +1,6 @@ -- | -- Module: Data.Mod--- Copyright: (c) 2017-2019 Andrew Lelechenko+-- Copyright: (c) 2017-2020 Andrew Lelechenko -- Licence: MIT -- Maintainer: Andrew Lelechenko <andrew.lelechenko@gmail.com> --@@ -12,15 +12,16 @@ -- Use "Data.Mod.Word" to achieve better performance, -- when your moduli fit into 'Word'. -{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE CPP #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UnboxedTuples #-} module Data.Mod ( Mod@@ -31,27 +32,42 @@ import Control.Exception import Control.DeepSeq+import Control.Monad+import Data.Bits+import Data.Word (Word8) #ifdef MIN_VERSION_semirings import Data.Euclidean (GcdDomain(..), Euclidean(..), Field) import Data.Ratio import Data.Semiring (Semiring(..), Ring(..)) #endif+#ifdef MIN_VERSION_vector+import Control.Monad.Primitive+import Control.Monad.ST+import qualified Data.Primitive.Types as P+import qualified Data.Vector.Generic as G+import qualified Data.Vector.Generic.Mutable as M+import qualified Data.Vector.Unboxed as U+import qualified Data.Vector.Primitive as P+import Foreign (copyBytes)+import GHC.IO.Unsafe (unsafeDupablePerformIO)+#endif+import Foreign.Storable (Storable(..)) import GHC.Exts import GHC.Generics import GHC.Integer.GMP.Internals import GHC.Natural (Natural(..), powModNatural)-import GHC.TypeNats (Nat, KnownNat, natVal)+import GHC.TypeNats (Nat, KnownNat, natVal, natVal') -- | This data type represents -- <https://en.wikipedia.org/wiki/Modular_arithmetic#Integers_modulo_n integers modulo m>, -- equipped with useful instances. -- -- For example, 3 :: 'Mod' 10 stands for the class of integers--- congruent to 3 modulo 10: …−17, −7, 3, 13, 23…+-- congruent to \( 3 \bmod 10 \colon \ldots {}−17, −7, 3, 13, 23 \ldots \) -- -- >>> :set -XDataKinds--- >>> 3 + 8 :: Mod 10--- (1 `modulo` 10) -- because 3 + 8 = 11 ≡ 1 (mod 10)+-- >>> 3 + 8 :: Mod 10 -- 3 + 8 = 11 ≡ 1 (mod 10)+-- (1 `modulo` 10) -- -- __Warning:__ division by residue, which is not -- <https://en.wikipedia.org/wiki/Coprime_integers coprime>@@ -60,7 +76,11 @@ newtype Mod (m :: Nat) = Mod { unMod :: Natural -- ^ The canonical representative of the residue class,- -- always between 0 and m - 1 inclusively.+ -- always between 0 and \( m - 1 \) inclusively.+ --+ -- >>> :set -XDataKinds+ -- >>> -1 :: Mod 10+ -- (9 `modulo` 10) } deriving (Eq, Ord, Generic) @@ -243,10 +263,10 @@ -- Otherwise return 'Nothing'. -- -- >>> :set -XDataKinds--- >>> 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 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 = if y <= 0@@ -263,12 +283,12 @@ -- Building with @-O@ triggers a rewrite rule 'Prelude.^' = '^%'. -- -- >>> :set -XDataKinds--- >>> 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+-- >>> 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 ^% a | a < 0 = case invertMod mx of@@ -291,7 +311,228 @@ "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 ^%++wordSize :: Int+wordSize = finiteBitSize (0 :: Word)++lgWordSize :: Int+lgWordSize = case wordSize of+ 32 -> 2 -- 2^2 bytes in word+ 64 -> 3 -- 2^3 bytes in word+ _ -> error "lgWordSize: unknown architecture"++instance KnownNat m => Storable (Mod m) where+ sizeOf _ = case natVal' (proxy# :: Proxy# m) of+ NatS#{} -> sizeOf (0 :: Word)+ NatJ# m# -> I# (sizeofBigNat# m#) `shiftL` lgWordSize+ {-# INLINE sizeOf #-}++ alignment _ = alignment (0 :: Word)+ {-# INLINE alignment #-}++ peek (Ptr addr#) = case natVal' (proxy# :: Proxy# m) of+ NatS#{} -> do+ W# w# <- peek (Ptr addr#)+ pure . Mod $! NatS# w#+ NatJ# m# -> do+ let !(I# lgWordSize#) = lgWordSize+ sz# = sizeofBigNat# m# `iShiftL#` lgWordSize#+ bn <- importBigNatFromAddr addr# (int2Word# sz#) 0#+ pure . Mod $! bigNatToNat bn+ {-# INLINE peek #-}++ poke (Ptr addr#) (Mod x) = case natVal' (proxy# :: Proxy# m) of+ NatS#{} -> case x of+ NatS# x# -> poke (Ptr addr#) (W# x#)+ _ -> brokenInvariant+ NatJ# m# -> case x of+ NatS# x# -> do+ poke (Ptr addr#) (W# x#)+ forM_ [1 .. sz - 1] $ \off ->+ pokeElemOff (Ptr addr#) off (0 :: Word)+ NatJ# bn -> do+ l <- exportBigNatToAddr bn addr# 0#+ forM_ [fromIntegral l .. (sz `shiftL` lgWordSize) - 1] $ \off ->+ pokeElemOff (Ptr addr#) off (0 :: Word8)+ where+ sz = I# (sizeofBigNat# m#)+ {-# INLINE poke #-}++#ifdef MIN_VERSION_vector++instance KnownNat m => P.Prim (Mod m) where+ sizeOf# x = let !(I# sz#) = sizeOf x in sz#+ {-# INLINE sizeOf# #-}++ alignment# x = let !(I# a#) = alignment x in a#+ {-# INLINE alignment# #-}++ indexByteArray# arr# i' = case natVal' (proxy# :: Proxy# m) of+ NatS#{} -> Mod (NatS# w#)+ where+ !(W# w#) = P.indexByteArray# arr# i'+ NatJ# m# -> Mod $ bigNatToNat $ importBigNatFromByteArray arr# (int2Word# i#) (int2Word# sz#) 0#+ where+ !(I# lgWordSize#) = lgWordSize+ sz# = sizeofBigNat# m# `iShiftL#` lgWordSize#+ i# = i' *# sz#+ {-# INLINE indexByteArray# #-}++ indexOffAddr# arr# i' = case natVal' (proxy# :: Proxy# m) of+ NatS#{} -> Mod (NatS# w#)+ where+ !(W# w#) = P.indexOffAddr# arr# i'+ NatJ# m# -> Mod $ bigNatToNat $ unsafeDupablePerformIO $ importBigNatFromAddr (arr# `plusAddr#` i#) (int2Word# sz#) 0#+ where+ !(I# lgWordSize#) = lgWordSize+ sz# = sizeofBigNat# m# `iShiftL#` lgWordSize#+ i# = i' *# sz#+ {-# INLINE indexOffAddr# #-}++ readByteArray# marr !i' token = case natVal' (proxy# :: Proxy# m) of+ NatS#{} -> case P.readByteArray# marr i' token of+ (# newToken, W# w# #) -> (# newToken, Mod (NatS# w#) #)+ NatJ# m# -> case unsafeFreezeByteArray# marr token of+ (# newToken, arr #) -> (# newToken, Mod (bigNatToNat (importBigNatFromByteArray arr (int2Word# i#) (int2Word# sz#) 0#)) #)+ where+ !(I# lgWordSize#) = lgWordSize+ sz# = sizeofBigNat# m# `iShiftL#` lgWordSize#+ i# = i' *# sz#+ {-# INLINE readByteArray# #-}++ readOffAddr# marr !i' token = case natVal' (proxy# :: Proxy# m) of+ NatS#{} -> case P.readOffAddr# marr i' token of+ (# newToken, W# w# #) -> (# newToken, Mod (NatS# w#) #)+ NatJ# m# -> case internal (unsafeIOToPrim (importBigNatFromAddr (marr `plusAddr#` i#) (int2Word# sz#) 0#) :: ST s BigNat) token of+ (# newToken, bn #) -> (# newToken, Mod (bigNatToNat bn) #)+ where+ !(I# lgWordSize#) = lgWordSize+ sz# = sizeofBigNat# m# `iShiftL#` lgWordSize#+ i# = i' *# sz#+ {-# INLINE readOffAddr# #-}++ writeByteArray# marr !i' !(Mod x) token = case natVal' (proxy# :: Proxy# m) of+ NatS#{} -> case x of+ NatS# x# -> P.writeByteArray# marr i' (W# x#) token+ _ -> error "argument is larger than modulo"+ NatJ# m# -> case x of+ NatS# x# -> case P.writeByteArray# marr i# (W# x#) token of+ newToken -> P.setByteArray# marr (i# +# 1#) (sz# -# 1#) (0 :: Word) newToken+ NatJ# bn -> case internal (unsafeIOToPrim (exportBigNatToMutableByteArray bn (unsafeCoerce# marr) (int2Word# (i# `iShiftL#` lgWordSize#)) 0#) :: ST s Word) token of+ (# newToken, W# l# #) -> P.setByteArray# marr (i# `iShiftL#` lgWordSize# +# word2Int# l#) (sz# `iShiftL#` lgWordSize# -# word2Int# l#) (0 :: Word8) newToken+ where+ !(I# lgWordSize#) = lgWordSize+ !sz@(I# sz#) = I# (sizeofBigNat# m#)+ !(I# i#) = I# i' * sz+ {-# INLINE writeByteArray# #-}++ writeOffAddr# marr !i' !(Mod x) token = case natVal' (proxy# :: Proxy# m) of+ NatS#{} -> case x of+ NatS# x# -> P.writeOffAddr# marr i' (W# x#) token+ _ -> error "argument is larger than modulo"+ NatJ# m# -> case x of+ NatS# x# -> case P.writeOffAddr# marr i# (W# x#) token of+ newToken -> P.setOffAddr# marr (i# +# 1#) (sz# -# 1#) (0 :: Word) newToken+ NatJ# bn -> case internal (unsafeIOToPrim (exportBigNatToAddr bn (marr `plusAddr#` (i# `iShiftL#` lgWordSize#)) 0#) :: ST s Word) token of+ (# newToken, W# l# #) -> P.setOffAddr# marr (i# `iShiftL#` lgWordSize# +# word2Int# l#) (sz# `iShiftL#` lgWordSize# -# word2Int# l#) (0 :: Word8) newToken+ where+ !(I# lgWordSize#) = lgWordSize+ !sz@(I# sz#) = I# (sizeofBigNat# m#)+ !(I# i#) = I# i' * sz+ {-# INLINE writeOffAddr# #-}++ setByteArray# !_ !_ 0# !_ token = token+ setByteArray# marr off len mx@(Mod x) token = case natVal' (proxy# :: Proxy# m) of+ NatS#{} -> case x of+ NatS# x# -> P.setByteArray# marr off len (W# x#) token+ _ -> error "argument is larger than modulo"+ NatJ# m# -> case P.writeByteArray# marr off mx token of+ newToken -> doSet (sz `iShiftL#` lgWordSize#) newToken+ where+ !(I# lgWordSize#) = lgWordSize+ sz = sizeofBigNat# m#+ off' = (off *# sz) `iShiftL#` lgWordSize#+ len' = (len *# sz) `iShiftL#` lgWordSize#+ doSet i tkn+ | isTrue# (2# *# i <# len') = case copyMutableByteArray# marr off' marr (off' +# i) i tkn of+ tkn' -> doSet (2# *# i) tkn'+ | otherwise = copyMutableByteArray# marr off' marr (off' +# i) (len' -# i) tkn+ {-# INLINE setByteArray# #-}++ setOffAddr# !_ !_ 0# !_ token = token+ setOffAddr# marr off len mx@(Mod x) token = case natVal' (proxy# :: Proxy# m) of+ NatS#{} -> case x of+ NatS# x# -> P.setOffAddr# marr off len (W# x#) token+ _ -> error "argument is larger than modulo"+ NatJ# m# -> case P.writeOffAddr# marr off mx token of+ newToken -> doSet (sz `iShiftL#` lgWordSize#) newToken+ where+ !(I# lgWordSize#) = lgWordSize+ sz = sizeofBigNat# m#+ off' = (off *# sz) `iShiftL#` lgWordSize#+ len' = (len *# sz) `iShiftL#` lgWordSize#+ doSet i tkn -- = tkn+ | isTrue# (2# *# i <# len') = case internal (unsafeIOToPrim (copyBytes (Ptr (marr `plusAddr#` (off' +# i))) (Ptr (marr `plusAddr#` off')) (I# i)) :: ST s ()) tkn of+ (# tkn', () #) -> doSet (2# *# i) tkn'+ | otherwise = case internal (unsafeIOToPrim (copyBytes (Ptr (marr `plusAddr#` (off' +# i))) (Ptr (marr `plusAddr#` off')) (I# (len' -# i))) :: ST s ()) tkn of+ (# tkn', () #) -> tkn'+ {-# INLINE setOffAddr# #-}++-- | Unboxed vectors of 'Mod' cause more nursery allocations+-- than boxed ones, but reduce pressure on garbage collector,+-- especially for large vectors.+newtype instance U.MVector s (Mod m) = ModMVec (P.MVector s (Mod m))++-- | Unboxed vectors of 'Mod' cause more nursery allocations+-- than boxed ones, but reduce pressure on garbage collector,+-- especially for large vectors.+newtype instance U.Vector (Mod m) = ModVec (P.Vector (Mod m))++instance KnownNat m => U.Unbox (Mod m)++instance KnownNat m => M.MVector U.MVector (Mod m) where+ {-# INLINE basicLength #-}+ {-# INLINE basicUnsafeSlice #-}+ {-# INLINE basicOverlaps #-}+ {-# INLINE basicUnsafeNew #-}+ {-# INLINE basicInitialize #-}+ {-# INLINE basicUnsafeReplicate #-}+ {-# INLINE basicUnsafeRead #-}+ {-# INLINE basicUnsafeWrite #-}+ {-# INLINE basicClear #-}+ {-# INLINE basicSet #-}+ {-# INLINE basicUnsafeCopy #-}+ {-# INLINE basicUnsafeGrow #-}+ basicLength (ModMVec v) = M.basicLength v+ basicUnsafeSlice i n (ModMVec v) = ModMVec $ M.basicUnsafeSlice i n v+ basicOverlaps (ModMVec v1) (ModMVec v2) = M.basicOverlaps v1 v2+ basicUnsafeNew n = ModMVec `liftM` M.basicUnsafeNew n+ basicInitialize (ModMVec v) = M.basicInitialize v+ basicUnsafeReplicate n x = ModMVec `liftM` M.basicUnsafeReplicate n x+ basicUnsafeRead (ModMVec v) i = M.basicUnsafeRead v i+ basicUnsafeWrite (ModMVec v) i x = M.basicUnsafeWrite v i x+ basicClear (ModMVec v) = M.basicClear v+ basicSet (ModMVec v) x = M.basicSet v x+ basicUnsafeCopy (ModMVec v1) (ModMVec v2) = M.basicUnsafeCopy v1 v2+ basicUnsafeMove (ModMVec v1) (ModMVec v2) = M.basicUnsafeMove v1 v2+ basicUnsafeGrow (ModMVec v) n = ModMVec `liftM` M.basicUnsafeGrow v n++instance KnownNat m => G.Vector U.Vector (Mod m) where+ {-# INLINE basicUnsafeFreeze #-}+ {-# INLINE basicUnsafeThaw #-}+ {-# INLINE basicLength #-}+ {-# INLINE basicUnsafeSlice #-}+ {-# INLINE basicUnsafeIndexM #-}+ {-# INLINE elemseq #-}+ basicUnsafeFreeze (ModMVec v) = ModVec `liftM` G.basicUnsafeFreeze v+ basicUnsafeThaw (ModVec v) = ModMVec `liftM` G.basicUnsafeThaw v+ basicLength (ModVec v) = G.basicLength v+ basicUnsafeSlice i n (ModVec v) = ModVec $ G.basicUnsafeSlice i n v+ basicUnsafeIndexM (ModVec v) i = G.basicUnsafeIndexM v i+ basicUnsafeCopy (ModMVec mv) (ModVec v) = G.basicUnsafeCopy mv v+ elemseq _ = seq++#endif
Data/Mod/Word.hs view
@@ -1,6 +1,6 @@ -- | -- Module: Data.Mod.Word--- Copyright: (c) 2017-2019 Andrew Lelechenko+-- Copyright: (c) 2017-2020 Andrew Lelechenko -- Licence: MIT -- Maintainer: Andrew Lelechenko <andrew.lelechenko@gmail.com> --@@ -11,15 +11,16 @@ -- This module supports only moduli, which fit into 'Word'. -- Use (slower) "Data.Mod" to handle arbitrary-sized moduli. -{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE CPP #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE UnboxedTuples #-}+{-# 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@@ -37,6 +38,14 @@ import Data.Ratio import Data.Semiring (Semiring(..), Ring(..)) #endif+#ifdef MIN_VERSION_vector+import Data.Primitive (Prim)+import qualified Data.Vector.Generic as G+import qualified Data.Vector.Generic.Mutable as M+import qualified Data.Vector.Primitive as P+import qualified Data.Vector.Unboxed as U+#endif+import Foreign.Storable (Storable) import GHC.Exts import GHC.Generics import GHC.Integer.GMP.Internals@@ -48,11 +57,11 @@ -- equipped with useful instances. -- -- For example, 3 :: 'Mod' 10 stands for the class of integers--- congruent to 3 modulo 10: …−17, −7, 3, 13, 23…+-- congruent to \( 3 \bmod 10 \colon \ldots {−17}, −7, 3, 13, 23 \ldots \) -- -- >>> :set -XDataKinds--- >>> 3 + 8 :: Mod 10--- (1 `modulo` 10) -- because 3 + 8 = 11 ≡ 1 (mod 10)+-- >>> 3 + 8 :: Mod 10 -- 3 + 8 = 11 ≡ 1 (mod 10)+-- (1 `modulo` 10) -- -- __Warning:__ division by residue, which is not -- <https://en.wikipedia.org/wiki/Coprime_integers coprime>@@ -61,9 +70,17 @@ newtype Mod (m :: Nat) = Mod { unMod :: Word -- ^ The canonical representative of the residue class,- -- always between 0 and m - 1 inclusively.+ -- always between 0 and \( m - 1 \) inclusively.+ --+ -- >>> :set -XDataKinds+ -- >>> -1 :: Mod 10+ -- (9 `modulo` 10) }- deriving (Eq, Ord, Generic)+#ifdef MIN_VERSION_vector+ deriving (Eq, Ord, Generic, Storable, Prim)+#else+ deriving (Eq, Ord, Generic, Storable)+#endif instance NFData (Mod m) @@ -132,12 +149,16 @@ negateMod (NatS# m#) (W# (x# `remBigNatWord` m#)) fromIntegerMod NatJ#{} _ = tooLargeModulo +#ifdef MIN_VERSION_semirings+ fromNaturalMod :: Natural -> Natural -> Word fromNaturalMod (NatS# 0##) !_ = throw DivideByZero fromNaturalMod (NatS# m#) (NatS# x#) = W# (x# `remWord#` m#) fromNaturalMod (NatS# m#) (NatJ# x#) = W# (x# `remBigNatWord` m#) fromNaturalMod NatJ#{} _ = tooLargeModulo +#endif+ tooLargeModulo :: a tooLargeModulo = error "modulo does not fit into a machine word" @@ -221,10 +242,10 @@ -- Otherwise return 'Nothing'. -- -- >>> :set -XDataKinds--- >>> 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 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@@ -242,7 +263,7 @@ Just y -> Just $ goDouble y (1 - x * y) where k# = ctz# m#- m' = m `unsafeShiftR` (I# (word2Int# k#))+ m' = m `unsafeShiftR` I# (word2Int# k#) xm' = x * m' @@ -257,6 +278,7 @@ 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@@ -286,19 +308,23 @@ 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 + if r' >= r then 0 else m in+ 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' + if r >= r' then 0 else m in+ 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 + if even r then 0 else halfMp1, half s #)+ 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 #-}@@ -314,12 +340,12 @@ -- Building with @-O@ triggers a rewrite rule 'Prelude.^' = '^%'. -- -- >>> :set -XDataKinds--- >>> 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+-- >>> 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@@ -353,7 +379,57 @@ "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 ^%++#ifdef MIN_VERSION_vector++newtype instance U.MVector s (Mod m) = MV_Mod (P.MVector s Word)+newtype instance U.Vector (Mod m) = V_Mod (P.Vector Word)++instance U.Unbox (Mod m)++instance M.MVector U.MVector (Mod m) where+ {-# INLINE basicLength #-}+ {-# INLINE basicUnsafeSlice #-}+ {-# INLINE basicOverlaps #-}+ {-# INLINE basicUnsafeNew #-}+ {-# INLINE basicInitialize #-}+ {-# INLINE basicUnsafeReplicate #-}+ {-# INLINE basicUnsafeRead #-}+ {-# INLINE basicUnsafeWrite #-}+ {-# INLINE basicClear #-}+ {-# INLINE basicSet #-}+ {-# INLINE basicUnsafeCopy #-}+ {-# INLINE basicUnsafeGrow #-}+ basicLength (MV_Mod v) = M.basicLength v+ basicUnsafeSlice i n (MV_Mod v) = MV_Mod $ M.basicUnsafeSlice i n v+ basicOverlaps (MV_Mod v1) (MV_Mod v2) = M.basicOverlaps v1 v2+ basicUnsafeNew n = MV_Mod <$> M.basicUnsafeNew n+ basicInitialize (MV_Mod v) = M.basicInitialize v+ basicUnsafeReplicate n x = MV_Mod <$> M.basicUnsafeReplicate n (unMod x)+ basicUnsafeRead (MV_Mod v) i = Mod <$> M.basicUnsafeRead v i+ basicUnsafeWrite (MV_Mod v) i x = M.basicUnsafeWrite v i (unMod x)+ basicClear (MV_Mod v) = M.basicClear v+ basicSet (MV_Mod v) x = M.basicSet v (unMod x)+ basicUnsafeCopy (MV_Mod v1) (MV_Mod v2) = M.basicUnsafeCopy v1 v2+ basicUnsafeMove (MV_Mod v1) (MV_Mod v2) = M.basicUnsafeMove v1 v2+ basicUnsafeGrow (MV_Mod v) n = MV_Mod <$> M.basicUnsafeGrow v n++instance G.Vector U.Vector (Mod m) where+ {-# INLINE basicUnsafeFreeze #-}+ {-# INLINE basicUnsafeThaw #-}+ {-# INLINE basicLength #-}+ {-# INLINE basicUnsafeSlice #-}+ {-# INLINE basicUnsafeIndexM #-}+ {-# INLINE elemseq #-}+ basicUnsafeFreeze (MV_Mod v) = V_Mod <$> G.basicUnsafeFreeze v+ basicUnsafeThaw (V_Mod v) = MV_Mod <$> G.basicUnsafeThaw v+ basicLength (V_Mod v) = G.basicLength v+ basicUnsafeSlice i n (V_Mod v) = V_Mod $ G.basicUnsafeSlice i n v+ basicUnsafeIndexM (V_Mod v) i = Mod <$> G.basicUnsafeIndexM v i+ basicUnsafeCopy (MV_Mod mv) (V_Mod v) = G.basicUnsafeCopy mv v+ elemseq _ = seq++#endif
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2019 Andrew Lelechenko+Copyright (c) 2017-2020 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,
README.md view
@@ -21,19 +21,21 @@ ## Competitors There are other Haskell packages, employing the very same idea of moduli on the type level,-namely `modular` and `modular-arithmetic`. Unfortunately, both of them fall behind+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 in terms of performance. Here is a brief comparison: -| 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+| 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 * __Addition.__- It appears that `modular` and `modular-arithmetic` implementations of+ All competing 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@@ -66,15 +68,38 @@ 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`,-but offers 3x faster addition,-2x faster multiplication and much less allocations.+but offers almost twice faster addition and multiplication, 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.4x | 1x | 4.5x | 6.1x | 3.3x | 5.0x+| Product | 0.6x | 1x | 3.6x | 5.4x | 3.1x | 4.5x+| Inversion | 0.8x | 1x | N/A | 6.1x | N/A | 4.1x+| Power | 0.9x | 1x | 6.0x | 1.8x | 1.9x | 2.1x+ ## What's next? This package was cut out of [`arithmoi`](https://hackage.haskell.org/package/arithmoi)@@ -82,4 +107,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](hackage.haskell.org/package/arithmoi/docs/Math-NumberTheory-Moduli.html).+please refer to [Math.NumberTheory.Moduli](https://hackage.haskell.org/package/arithmoi/docs/Math-NumberTheory-Moduli.html).
bench/Bench.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# OPTIONS_GHC -fno-warn-type-defaults -fno-warn-name-shadowing #-}@@ -10,99 +11,185 @@ import qualified Data.Mod import qualified Data.Mod.Word--- import qualified Data.Modular--- import qualified Numeric.Modular+#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 +import Text.Printf++normalize :: NominalDiffTime -> NominalDiffTime -> String+normalize unit t = printf "%.2fx" (fromRational (toRational t / toRational unit) :: Double)+ benchAddition :: IO () benchAddition = do- putStrLn "Addition"+ putStrLn "Sum" t0 <- getCurrentTime- print (sum [1..10^7] :: Data.Mod.Word.Mod 1000000007)+ print (sum [1..10^8] :: Data.Mod.Mod 1000000007) t1 <- getCurrentTime- putStrLn $ "Data.Mod.Word " ++ show (diffUTCTime t1 t0)+ let unit = diffUTCTime t1 t0 t0 <- getCurrentTime- print (sum [1..10^7] :: Data.Mod.Mod 1000000007)+ print (sum [1..10^8] :: Data.Mod.Word.Mod 1000000007) t1 <- getCurrentTime- putStrLn $ "Data.Mod " ++ show (diffUTCTime t1 t0)+ putStrLn $ "Data.Mod.Word " ++ normalize unit (diffUTCTime t1 t0) - -- t0 <- getCurrentTime- -- print (sum [1..10^7] :: Data.Modular.Mod Integer 1000000007)- -- t1 <- getCurrentTime- -- putStrLn $ "Data.Modular " ++ show (diffUTCTime t1 t0)+ putStrLn "Data.Mod 1x" - -- t0 <- getCurrentTime- -- print (sum (map fromIntegral [1..10^7]) :: Numeric.Modular.Mod 1000000007)- -- t1 <- getCurrentTime- -- putStrLn $ "Numeric.Modular " ++ show (diffUTCTime t1 t0)+#ifdef MIN_VERSION_finite_field+ t0 <- getCurrentTime+ print (sum [1..10^8] :: Data.FiniteField.PrimeField.PrimeField 1000000007)+ t1 <- getCurrentTime+ putStrLn $ "finite-field " ++ normalize unit (diffUTCTime t1 t0)+#endif +#ifdef MIN_VERSION_finite_typelits+ t0 <- getCurrentTime+ print (sum [1..10^8] :: Data.Finite.Finite 1000000007)+ t1 <- getCurrentTime+ putStrLn $ "finite-typelits " ++ normalize unit (diffUTCTime t1 t0)+#endif++#ifdef MIN_VERSION_modular_arithmetic+ t0 <- getCurrentTime+ print (sum [1..10^8] :: Data.Modular.Mod Integer 1000000007)+ t1 <- getCurrentTime+ putStrLn $ "modular-arithmetic " ++ normalize unit (diffUTCTime t1 t0)+#endif++#ifdef MIN_VERSION_modular+ t0 <- getCurrentTime+ print (sum (map fromIntegral [1..10^8]) :: Numeric.Modular.Mod 1000000007)+ t1 <- getCurrentTime+ putStrLn $ "modular " ++ normalize unit (diffUTCTime t1 t0)+#endif+ benchProduct :: IO () benchProduct = do putStrLn "Product" t0 <- getCurrentTime- print (product [1..10^7] :: Data.Mod.Word.Mod 1000000007)+ print (product [1..10^8] :: Data.Mod.Mod 1000000007) t1 <- getCurrentTime- putStrLn $ "Data.Mod.Word " ++ show (diffUTCTime t1 t0)+ let unit = diffUTCTime t1 t0 t0 <- getCurrentTime- print (product [1..10^7] :: Data.Mod.Mod 1000000007)+ print (product [1..10^8] :: Data.Mod.Word.Mod 1000000007) t1 <- getCurrentTime- putStrLn $ "Data.Mod " ++ show (diffUTCTime t1 t0)+ putStrLn $ "Data.Mod.Word " ++ normalize unit (diffUTCTime t1 t0) - -- t0 <- getCurrentTime- -- print (product [1..10^7] :: Data.Modular.Mod Integer 1000000007)- -- t1 <- getCurrentTime- -- putStrLn $ "Data.Modular " ++ show (diffUTCTime t1 t0)+ putStrLn "Data.Mod 1x" - -- t0 <- getCurrentTime- -- print (product (map fromIntegral [1..10^7]) :: Numeric.Modular.Mod 1000000007)- -- t1 <- getCurrentTime- -- putStrLn $ "Numeric.Modular " ++ show (diffUTCTime t1 t0)+#ifdef MIN_VERSION_finite_field+ t0 <- getCurrentTime+ print (product [1..10^8] :: Data.FiniteField.PrimeField.PrimeField 1000000007)+ t1 <- getCurrentTime+ putStrLn $ "finite-field " ++ normalize unit (diffUTCTime t1 t0)+#endif +#ifdef MIN_VERSION_finite_typelits+ t0 <- getCurrentTime+ print (product [1..10^8] :: Data.Finite.Finite 1000000007)+ t1 <- getCurrentTime+ putStrLn $ "finite-typelits " ++ normalize unit (diffUTCTime t1 t0)+#endif++#ifdef MIN_VERSION_modular_arithmetic+ t0 <- getCurrentTime+ print (product [1..10^8] :: Data.Modular.Mod Integer 1000000007)+ t1 <- getCurrentTime+ putStrLn $ "modular-arithmetic " ++ normalize unit (diffUTCTime t1 t0)+#endif++#ifdef MIN_VERSION_modular+ t0 <- getCurrentTime+ print (product (map fromIntegral [1..10^8]) :: Numeric.Modular.Mod 1000000007)+ t1 <- getCurrentTime+ putStrLn $ "modular " ++ normalize unit (diffUTCTime t1 t0)+#endif+ benchInversion :: IO () benchInversion = do putStrLn "Inversion" t0 <- getCurrentTime- print (sum (map (fromJust . Data.Mod.Word.invertMod) [1 ..10^6]) :: Data.Mod.Word.Mod 1000000007)+ print (sum (map (fromJust . Data.Mod.invertMod) [1..10^7]) :: Data.Mod.Mod 1000000007) t1 <- getCurrentTime- putStrLn $ "Data.Mod.Word " ++ show (diffUTCTime t1 t0)+ let unit = diffUTCTime t1 t0 t0 <- getCurrentTime- print (sum (map (fromJust . Data.Mod.invertMod) [1 ..10^6]) :: Data.Mod.Mod 1000000007)+ print (sum (map (fromJust . Data.Mod.Word.invertMod) [1..10^7]) :: Data.Mod.Word.Mod 1000000007) t1 <- getCurrentTime- putStrLn $ "Data.Mod " ++ show (diffUTCTime t1 t0)+ putStrLn $ "Data.Mod.Word " ++ normalize unit (diffUTCTime t1 t0) - -- t0 <- getCurrentTime- -- print (sum (map Data.Modular.inv [1..10^6]) :: Data.Modular.Mod Integer 1000000007)- -- t1 <- getCurrentTime- -- putStrLn $ "Data.Modular " ++ show (diffUTCTime t1 t0)+ putStrLn "Data.Mod 1x" +#ifdef MIN_VERSION_finite_field+ t0 <- getCurrentTime+ print (sum (map recip [1..10^7]) :: Data.FiniteField.PrimeField.PrimeField 1000000007)+ t1 <- getCurrentTime+ putStrLn $ "finite-field " ++ normalize unit (diffUTCTime t1 t0)+#endif++#ifdef MIN_VERSION_modular_arithmetic+ t0 <- getCurrentTime+ print (sum (map Data.Modular.inv [1..10^7]) :: Data.Modular.Mod Integer 1000000007)+ t1 <- getCurrentTime+ putStrLn $ "modular-arithmetic " ++ normalize unit (diffUTCTime t1 t0)+#endif+ benchPower :: IO () benchPower = do putStrLn "Power" t0 <- getCurrentTime+ print (sum (map (2 ^) [1..10^6]) :: Data.Mod.Mod 1000000007)+ t1 <- getCurrentTime+ let unit = diffUTCTime t1 t0++ t0 <- getCurrentTime print (sum (map (2 ^) [1..10^6]) :: Data.Mod.Word.Mod 1000000007) t1 <- getCurrentTime- putStrLn $ "Data.Mod.Word " ++ show (diffUTCTime t1 t0)+ putStrLn $ "Data.Mod.Word " ++ normalize unit (diffUTCTime t1 t0) + putStrLn "Data.Mod 1x"++#ifdef MIN_VERSION_finite_field t0 <- getCurrentTime- print (sum (map (2 ^) [1..10^6]) :: Data.Mod.Mod 1000000007)+ print (sum (map (2 ^) [1..10^6]) :: Data.FiniteField.PrimeField.PrimeField 1000000007) t1 <- getCurrentTime- putStrLn $ "Data.Mod " ++ show (diffUTCTime t1 t0)+ putStrLn $ "finite-field " ++ normalize unit (diffUTCTime t1 t0)+#endif - -- t0 <- getCurrentTime- -- print (sum (map (2 ^) [1..10^6]) :: Data.Modular.Mod Integer 1000000007)- -- t1 <- getCurrentTime- -- putStrLn $ "Data.Modular " ++ show (diffUTCTime t1 t0)+#ifdef MIN_VERSION_finite_typelits+ t0 <- getCurrentTime+ print (sum (map (2 ^) [1..10^6]) :: Data.Finite.Finite 1000000007)+ t1 <- getCurrentTime+ putStrLn $ "finite-typelits " ++ normalize unit (diffUTCTime t1 t0)+#endif - -- t0 <- getCurrentTime- -- print (sum (map (2 ^) [1..10^6]) :: Numeric.Modular.Mod 1000000007)- -- t1 <- getCurrentTime- -- putStrLn $ "Numeric.Modular " ++ show (diffUTCTime t1 t0)+#ifdef MIN_VERSION_modular_arithmetic+ t0 <- getCurrentTime+ print (sum (map (2 ^) [1..10^6]) :: Data.Modular.Mod Integer 1000000007)+ t1 <- getCurrentTime+ putStrLn $ "modular-arithmetic " ++ normalize unit (diffUTCTime t1 t0)+#endif++#ifdef MIN_VERSION_modular+ t0 <- getCurrentTime+ print (sum (map (2 ^) [1..10^6]) :: Numeric.Modular.Mod 1000000007)+ t1 <- getCurrentTime+ putStrLn $ "modular " ++ normalize unit (diffUTCTime t1 t0)+#endif main :: IO () main = do
changelog.md view
@@ -1,3 +1,7 @@+# 0.1.2.0++* Add `Storable`, `Prim` and `Unbox` instances.+ # 0.1.1.0 * Add `Data.Mod.Word`.
mod.cabal view
@@ -1,10 +1,10 @@ name: mod-version: 0.1.1.0+version: 0.1.2.0 cabal-version: >=1.10 build-type: Simple license: MIT license-file: LICENSE-copyright: 2019 Andrew Lelechenko+copyright: 2017-2020 Andrew Lelechenko maintainer: Andrew Lelechenko <andrew.lelechenko@gmail.com> homepage: https://github.com/Bodigrim/mod bug-reports: https://github.com/Bodigrim/mod/issues@@ -15,7 +15,7 @@ Originally part of <https://hackage.haskell.org/package/arithmoi arithmoi> package. category: Math, Number Theory author: Andrew Lelechenko <andrew.lelechenko@gmail.com>-tested-with: GHC ==8.2.2 GHC ==8.4.4 GHC ==8.6.5 GHC ==8.8.1+tested-with: GHC ==8.2.2 GHC ==8.4.4 GHC ==8.6.5 GHC ==8.8.3 GHC ==8.10.1 extra-source-files: changelog.md README.md@@ -28,6 +28,10 @@ description: Derive semiring instances default: True +flag vector+ description: Derive unboxed and primitive vector instances+ default: True+ library build-depends: base >=4.10 && <5,@@ -36,11 +40,15 @@ if flag(semirings) build-depends: semirings >= 0.5+ if flag(vector)+ build-depends:+ primitive,+ vector >= 0.12 exposed-modules: Data.Mod Data.Mod.Word default-language: Haskell2010- ghc-options: -Wall+ ghc-options: -Wall -O2 test-suite mod-tests build-depends:@@ -53,16 +61,23 @@ build-depends: quickcheck-classes >=0.6.3, semirings >= 0.5+ if flag(vector)+ build-depends:+ primitive,+ quickcheck-classes >=0.6.3,+ vector >= 0.12 type: exitcode-stdio-1.0 main-is: Test.hs default-language: Haskell2010 hs-source-dirs: test- ghc-options: -Wall+ ghc-options: -Wall -threaded -rtsopts benchmark mod-bench build-depends: base, mod,+ -- finite-field,+ -- finite-typelits, -- modular, -- modular-arithmetic, time@@ -70,4 +85,4 @@ main-is: Bench.hs default-language: Haskell2010 hs-source-dirs: bench- ghc-options: -Wall+ ghc-options: -Wall -O2
test/Test.hs view
@@ -7,10 +7,12 @@ module Main where +import Data.Bits import Data.Mod import qualified Data.Mod.Word as Word import Data.Proxy import Data.Semigroup+import Foreign.Storable (Storable(..)) import GHC.TypeNats (KnownNat, SomeNat(..), natVal, someNatVal) import Test.Tasty import Test.Tasty.QuickCheck@@ -18,9 +20,15 @@ #ifdef MIN_VERSION_semirings import Data.Semiring (Ring)-import Test.QuickCheck.Classes+import Test.QuickCheck.Classes (semiringLaws, ringLaws) #endif +#ifdef MIN_VERSION_vector+import Data.Primitive (Prim)+import Data.Vector.Unboxed (Unbox)+import Test.QuickCheck.Classes (muvectorLaws, primLaws)+#endif+ main :: IO () main = defaultMain $ testGroup "All" [ testGroup "Mod 1" $@@ -51,7 +59,7 @@ testProperty "powMod" (powModProp @123456789012345678901234567890) : testProperty "invertMod" (invertModProp @123456789012345678901234567890) : map lawsToTest (laws (Proxy :: Proxy (Mod 123456789012345678901234567890)))- , testGroup "Random Mod" $+ , testGroup "Random Mod" [ testProperty "fromInteger" fromIntegerRandomProp , testProperty "invertMod" invertModRandomProp , testProperty "powMod" powModRandomProp@@ -67,41 +75,70 @@ testProperty "powMod" (powModWordProp @2310) : testProperty "invertMod" (invertModWordProp @2310) : map lawsToTest (laws (Proxy :: Proxy (Word.Mod 2310)))- , 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)))- , testGroup "Random Word.Mod" $+ , 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" invertModWordRandomProp_nearMaxBound+ , testProperty "invertMod near maxBound" invertModWordRandomPropNearMaxBound , testProperty "powMod" powModWordRandomProp ] ] #ifdef MIN_VERSION_semirings-laws1 :: (Eq a, Ord a, Show a, Num a, Ring a, Arbitrary a) => Proxy a -> [Laws]+#ifdef MIN_VERSION_vector+laws1 :: (Eq a, Ord a, Show a, Num a, Storable a, Ring a, Prim a, Unbox a, Arbitrary a) => Proxy a -> [Laws] #else-laws1 :: (Eq a, Ord a, Show a, Num a, Arbitrary a) => Proxy a -> [Laws]+laws1 :: (Eq a, Ord a, Show a, Num a, Storable a, Ring a, Arbitrary a) => Proxy a -> [Laws] #endif+#else+#ifdef MIN_VERSION_vector+laws1 :: (Eq a, Ord a, Show a, Num a, Storable a, Prim a, Unbox a, Arbitrary a) => Proxy a -> [Laws]+#else+laws1 :: (Eq a, Ord a, Show a, Num a, Storable a, Arbitrary a) => Proxy a -> [Laws]+#endif+#endif laws1 p = [ eqLaws p , ordLaws p , numLaws p , showLaws p+ , storableLaws p #ifdef MIN_VERSION_semirings , semiringLaws p , ringLaws p #endif+#ifdef MIN_VERSION_vector+ , primLaws p+ , muvectorLaws p+#endif ] #ifdef MIN_VERSION_semirings-laws :: (Eq a, Ord a, Show a, Num a, Ring a, Enum a, Bounded a, Arbitrary a) => Proxy a -> [Laws]+#ifdef MIN_VERSION_vector+laws :: (Eq a, Ord a, Show a, Num a, Storable a, Ring a, Enum a, Bounded a, Prim a, Unbox a, Arbitrary a) => Proxy a -> [Laws] #else-laws :: (Eq a, Ord a, Show a, Num a, Enum a, Bounded a, Arbitrary a) => Proxy a -> [Laws]+laws :: (Eq a, Ord a, Show a, Num a, Storable a, Ring a, Enum a, Bounded a, Arbitrary a) => Proxy a -> [Laws] #endif+#else+#ifdef MIN_VERSION_vector+laws :: (Eq a, Ord a, Show a, Num a, Storable a, Enum a, Bounded a, Prim a, Unbox a, Arbitrary a) => Proxy a -> [Laws]+#else+laws :: (Eq a, Ord a, Show a, Num a, Storable a, Enum a, Bounded a, Arbitrary a) => Proxy a -> [Laws]+#endif+#endif laws p = boundedEnumLaws p : laws1 p lawsToTest :: Laws -> TestTree@@ -109,11 +146,11 @@ testGroup name $ map (uncurry testProperty) props instance KnownNat m => Arbitrary (Mod m) where- arbitrary = oneof [arbitraryBoundedEnum, fromInteger <$> arbitrary]+ arbitrary = oneof [arbitraryBoundedEnum, negate <$> arbitraryBoundedEnum, fromInteger <$> arbitrary] shrink = map fromInteger . shrink . toInteger . unMod instance KnownNat m => Arbitrary (Word.Mod m) where- arbitrary = oneof [arbitraryBoundedEnum, fromInteger <$> arbitrary]+ arbitrary = oneof [arbitraryBoundedEnum, negate <$> arbitraryBoundedEnum, fromInteger <$> arbitrary] shrink = map fromIntegral . shrink . Word.unMod -------------------------------------------------------------------------------@@ -157,8 +194,8 @@ invertModWordRandomProp m n = m > 1 ==> case someNatVal (fromIntegral m) of SomeNat (Proxy :: Proxy m) -> invertModWordProp (fromInteger n :: Word.Mod m) -invertModWordRandomProp_nearMaxBound :: Word -> Integer -> Property-invertModWordRandomProp_nearMaxBound m n = m < maxBound ==>+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)