packages feed

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 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)