diff --git a/Data/Mod.hs b/Data/Mod.hs --- a/Data/Mod.hs +++ b/Data/Mod.hs @@ -1,6 +1,6 @@ -- | -- Module: Data.Mod --- Copyright: (c) 2017-2019 Andrew Lelechenko +-- Copyright: (c) 2017-2020 Andrew Lelechenko -- Licence: MIT -- Maintainer: Andrew Lelechenko -- @@ -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 -- , -- 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 -- @@ -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 diff --git a/Data/Mod/Word.hs b/Data/Mod/Word.hs --- a/Data/Mod/Word.hs +++ b/Data/Mod/Word.hs @@ -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 -- @@ -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 -- @@ -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 diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -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, diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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). diff --git a/bench/Bench.hs b/bench/Bench.hs --- a/bench/Bench.hs +++ b/bench/Bench.hs @@ -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 diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,7 @@ +# 0.1.2.0 + +* Add `Storable`, `Prim` and `Unbox` instances. + # 0.1.1.0 * Add `Data.Mod.Word`. diff --git a/mod.cabal b/mod.cabal --- a/mod.cabal +++ b/mod.cabal @@ -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 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.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 diff --git a/test/Test.hs b/test/Test.hs --- a/test/Test.hs +++ b/test/Test.hs @@ -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)