mod-0.2.0.1/0000755000000000000000000000000007346545000010620 5ustar0000000000000000mod-0.2.0.1/Data/0000755000000000000000000000000007346545000011471 5ustar0000000000000000mod-0.2.0.1/Data/Mod.hs0000644000000000000000000005757507346545000012567 0ustar0000000000000000-- | -- Module: Data.Mod -- Copyright: (c) 2017-2022 Andrew Lelechenko -- Licence: MIT -- Maintainer: Andrew Lelechenko -- -- , -- promoting moduli to the type level, with an emphasis on performance. -- Originally part of the package. -- -- This module supports moduli of arbitrary size. -- Use "Data.Mod.Word" to achieve better performance, -- when your moduli fit into 'Word'. {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UnboxedTuples #-} module Data.Mod ( Mod , unMod , invertMod , (^%) ) where import Control.Exception import Control.DeepSeq import Control.Monad import Data.Bits import Data.Mod.Compat (timesWord2#, remWord2#) import Data.Ratio import Data.Word (Word8) #ifdef MIN_VERSION_semirings import Data.Euclidean (GcdDomain(..), Euclidean(..), Field) 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) #endif import Foreign.Storable (Storable(..)) import GHC.Exts hiding (timesWord2#, quotRemWord2#) import GHC.Generics import GHC.IO (IO(..)) import GHC.Natural (Natural(..), powModNatural) import GHC.Num.BigNat import GHC.Num.Integer import GHC.TypeNats (Nat, KnownNat, natVal, natVal') import Text.Read (Read(readPrec)) -- | This data type represents -- , -- equipped with useful instances. -- -- For example, 3 :: 'Mod' 10 stands for the class of integers -- congruent to \( 3 \bmod 10 \colon \ldots {−17}, −7, 3, 13, 23 \ldots \) -- -- >>> :set -XDataKinds -- >>> 3 + 8 :: Mod 10 -- 3 + 8 = 11 ≡ 1 (mod 10) -- 1 -- -- __Note:__ 'Mod' 0 has no inhabitants, eventhough \( \mathbb{Z}/0\mathbb{Z} \) is technically isomorphic to \( \mathbb{Z} \). newtype Mod (m :: Nat) = Mod { unMod :: Natural -- ^ The canonical representative of the residue class, -- always between 0 and \( m - 1 \) (inclusively). -- -- >>> :set -XDataKinds -- >>> -1 :: Mod 10 -- 9 } deriving (Eq, Ord, Generic) instance NFData (Mod m) instance Show (Mod m) where show (Mod x) = show x -- | Wrapping behaviour, similar to -- the existing @instance@ 'Read' 'Int'. instance KnownNat m => Read (Mod m) where readPrec = fromInteger <$> readPrec instance KnownNat m => Real (Mod m) where toRational (Mod x) = toRational x instance KnownNat m => Enum (Mod m) where succ x = if x == maxBound then throw Overflow else coerce (succ @Natural) x pred x = if x == minBound then throw Underflow else coerce (pred @Natural) x toEnum = fromIntegral :: Int -> Mod m fromEnum = (fromIntegral :: Natural -> Int) . unMod enumFrom x = enumFromTo x maxBound enumFromThen x y = enumFromThenTo x y (if y >= x then maxBound else minBound) enumFromTo = coerce (enumFromTo @Natural) enumFromThenTo = coerce (enumFromThenTo @Natural) instance KnownNat m => Bounded (Mod m) where minBound = mx where mx = if natVal mx > 0 then Mod 0 else throw DivideByZero maxBound = mx where mx = if m > 0 then Mod (m - 1) else throw DivideByZero m = natVal mx bigNatToNat :: BigNat# -> Natural bigNatToNat r# = if isTrue# (bigNatSize# r# <=# 1#) then NatS# (bigNatToWord# r#) else NatJ# (BN# r#) subIfGe :: BigNat# -> BigNat# -> Natural subIfGe z# m# = case z# `bigNatSub` m# of (# (# #) | #) -> NatJ# (BN# z#) (# | zm# #) -> bigNatToNat zm# addMod :: Natural -> Natural -> Natural -> Natural addMod (NatS# m#) (NatS# x#) (NatS# y#) = if isTrue# c# || isTrue# (z# `geWord#` m#) then NatS# (z# `minusWord#` m#) else NatS# z# where !(# z#, c# #) = x# `addWordC#` y# addMod NatS#{} _ _ = brokenInvariant addMod (NatJ# (BN# m#)) (NatS# x#) (NatS# y#) = if isTrue# c# then subIfGe (bigNatFromWord2# 1## z#) m# else NatS# z# where !(# z#, c# #) = x# `addWordC#` y# addMod (NatJ# (BN# m#)) (NatS# x#) (NatJ# (BN# y#)) = subIfGe (y# `bigNatAddWord#` x#) m# addMod (NatJ# (BN# m#)) (NatJ# (BN# x#)) (NatS# y#) = subIfGe (x# `bigNatAddWord#` y#) m# addMod (NatJ# (BN# m#)) (NatJ# (BN# x#)) (NatJ# (BN# y#)) = subIfGe (x# `bigNatAdd` y#) m# subMod :: Natural -> Natural -> Natural -> Natural subMod (NatS# m#) (NatS# x#) (NatS# y#) = if isTrue# (x# `geWord#` y#) then NatS# z# else NatS# (z# `plusWord#` m#) where z# = x# `minusWord#` y# subMod NatS#{} _ _ = brokenInvariant subMod (NatJ# (BN# m#)) (NatS# x#) (NatS# y#) = if isTrue# (x# `geWord#` y#) then NatS# (x# `minusWord#` y#) else bigNatToNat (m# `bigNatSubWordUnsafe#` (y# `minusWord#` x#)) subMod (NatJ# (BN# m#)) (NatS# x#) (NatJ# (BN# y#)) = bigNatToNat (m# `bigNatSubUnsafe` y# `bigNatAddWord#` x#) subMod NatJ#{} (NatJ# (BN# x#)) (NatS# y#) = bigNatToNat (x# `bigNatSubWordUnsafe#` y#) subMod (NatJ# (BN# m#)) (NatJ# (BN# x#)) (NatJ# (BN# y#)) = case x# `bigNatSub` y# of (# (# #) | #) -> bigNatToNat (m# `bigNatSubUnsafe` y# `bigNatAdd` x#) (# | xy# #) -> bigNatToNat xy# negateMod :: Natural -> Natural -> Natural negateMod _ (NatS# 0##) = NatS# 0## negateMod (NatS# m#) (NatS# x#) = NatS# (m# `minusWord#` x#) negateMod NatS#{} _ = brokenInvariant negateMod (NatJ# (BN# m#)) (NatS# x#) = bigNatToNat (m# `bigNatSubWordUnsafe#` x#) negateMod (NatJ# (BN# m#)) (NatJ# (BN# x#)) = bigNatToNat (m# `bigNatSubUnsafe` x#) halfWord :: Word halfWord = 1 `shiftL` (finiteBitSize (0 :: Word) `shiftR` 1) mulMod :: Natural -> Natural -> Natural -> Natural mulMod (NatS# m#) (NatS# x#) (NatS# y#) | W# m# <= halfWord = NatS# (timesWord# x# y# `remWord#` m#) | otherwise = NatS# r# where !(# hi#, lo# #) = timesWord2# x# y# !r# = remWord2# lo# hi# m# mulMod NatS#{} _ _ = brokenInvariant mulMod (NatJ# (BN# m#)) (NatS# x#) (NatS# y#) = bigNatToNat (bigNatFromWord2# z1# z2# `bigNatRem` m#) where !(# z1#, z2# #) = timesWord2# x# y# mulMod (NatJ# (BN# m#)) (NatS# x#) (NatJ# (BN# y#)) = bigNatToNat ((y# `bigNatMulWord#` x#) `bigNatRem` m#) mulMod (NatJ# (BN# m#)) (NatJ# (BN# x#)) (NatS# y#) = bigNatToNat ((x# `bigNatMulWord#` y#) `bigNatRem` m#) mulMod (NatJ# (BN# m#)) (NatJ# (BN# x#)) (NatJ# (BN# y#)) = bigNatToNat ((x# `bigNatMul` y#) `bigNatRem` m#) brokenInvariant :: a brokenInvariant = error "argument is larger than modulus" instance KnownNat m => Num (Mod m) where mx@(Mod !x) + (Mod !y) = Mod $ addMod (natVal mx) x y {-# INLINE (+) #-} mx@(Mod !x) - (Mod !y) = Mod $ subMod (natVal mx) x y {-# INLINE (-) #-} negate mx@(Mod !x) = Mod $ negateMod (natVal mx) x {-# INLINE negate #-} mx@(Mod !x) * (Mod !y) = Mod $ mulMod (natVal mx) x y {-# INLINE (*) #-} abs = id {-# INLINE abs #-} signum = const x where x = if natVal x > 1 then Mod 1 else Mod 0 {-# INLINE signum #-} fromInteger x = mx where mx = Mod $ fromInteger $ x `mod` toInteger (natVal mx) {-# INLINE fromInteger #-} #ifdef MIN_VERSION_semirings instance KnownNat m => Semiring (Mod m) where plus = (+) {-# INLINE plus #-} times = (*) {-# INLINE times #-} zero = mx where mx = if natVal mx > 0 then Mod 0 else throw DivideByZero {-# INLINE zero #-} one = mx where mx = case m `compare` 1 of LT -> throw DivideByZero EQ -> Mod 0 GT -> Mod 1 m = natVal mx {-# INLINE one #-} fromNatural x = mx where mx = Mod $ x `mod` natVal mx {-# INLINE fromNatural #-} instance KnownNat m => Ring (Mod m) where negate = Prelude.negate {-# INLINE negate #-} -- | 'Mod' @m@ is not even an -- for -- @m@, -- much less a . -- However, 'Data.Euclidean.gcd' and 'Data.Euclidean.lcm' are still meaningful -- even for composite @m@, corresponding to a sum and an intersection of -- . -- -- The instance is lawful only for -- @m@, otherwise -- @'Data.Euclidean.divide' x y@ tries to return any @Just z@ such that @x == y * z@. -- instance KnownNat m => GcdDomain (Mod m) where divide (Mod 0) _ = Just (Mod 0) divide _ (Mod 0) = Nothing divide mx@(Mod x) (Mod y) = case mry of Just ry -> if xr == 0 then Just (Mod xq * Mod ry) else Nothing Nothing -> Nothing where m = natVal mx gmy = Prelude.gcd m y (xq, xr) = Prelude.quotRem x gmy mry = invertModInternal (y `Prelude.quot` gmy) (m `Prelude.quot` gmy) gcd (Mod x) (Mod y) = g where m = natVal g g = Mod $ if m > 1 then Prelude.gcd (Prelude.gcd m x) y else 0 lcm (Mod x) (Mod y) = l where m = natVal l l = Mod $ if m > 1 then Prelude.lcm (Prelude.gcd m x) (Prelude.gcd m y) else 0 coprime x y = Data.Euclidean.gcd x y == one -- | 'Mod' @m@ is not even an -- for -- @m@, -- much less a . -- -- The instance is lawful only for -- @m@, otherwise -- we try to do our best: -- @'Data.Euclidean.quot' x y@ returns any @z@ such that @x == y * z@, -- 'Data.Euclidean.rem' is not always 0, and both can throw 'DivideByZero'. -- instance KnownNat m => Euclidean (Mod m) where degree = unMod {-# INLINABLE degree #-} quotRem (Mod 0) _ = (Mod 0, Mod 0) quotRem _ (Mod 0) = throw DivideByZero quotRem mx@(Mod x) (Mod y) = case mry of Just ry -> (Mod xq * Mod ry, Mod xr) Nothing -> throw DivideByZero where m = natVal mx gmy = Prelude.gcd m y (xq, xr) = Prelude.quotRem x gmy mry = invertModInternal (y `Prelude.quot` gmy) (m `Prelude.quot` gmy) -- | 'Mod' @m@ is not even an -- for -- @m@, -- much less a . -- -- The instance is lawful only for -- @m@, otherwise -- division by a residue, which is not -- -- with the modulus, throws 'DivideByZero'. -- Consider using 'invertMod' for non-prime moduli. -- instance KnownNat m => Field (Mod m) #endif -- | Division by a residue, which is not -- -- with the modulus, throws 'DivideByZero'. -- Consider using 'invertMod' for non-prime moduli. -- instance KnownNat m => Fractional (Mod m) where fromRational r = case denominator r of 1 -> num den -> num / fromInteger den where num = fromInteger (numerator r) {-# INLINE fromRational #-} recip mx = case invertMod mx of Nothing -> throw DivideByZero Just y -> y {-# INLINE recip #-} -- | If an argument is -- -- with the modulus, return its modular inverse. -- Otherwise return 'Nothing'. -- -- >>> :set -XDataKinds -- >>> invertMod 3 :: Mod 10 -- 3 * 7 = 21 ≡ 1 (mod 10) -- Just 7 -- >>> invertMod 4 :: Mod 10 -- 4 and 10 are not coprime -- Nothing invertMod :: KnownNat m => Mod m -> Maybe (Mod m) invertMod x = Mod <$> invertModInternal (unMod x) (natVal x) {-# INLINABLE invertMod #-} invertModInternal :: Natural -- Value -> Natural -- Modulo -> Maybe Natural invertModInternal x m = case integerRecipMod# (toInteger x) m of (# | () #) -> Nothing (# y | #) -> Just y {-# INLINABLE invertModInternal #-} -- | Drop-in replacement for 'Prelude.^' with much better performance. -- Negative powers are allowed, but may throw 'DivideByZero', if an argument -- is not with the modulus. -- -- >>> :set -XDataKinds -- >>> 3 ^% 4 :: Mod 10 -- 3 ^ 4 = 81 ≡ 1 (mod 10) -- 1 -- >>> 3 ^% (-1) :: Mod 10 -- 3 * 7 = 21 ≡ 1 (mod 10) -- 7 -- >>> 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 Nothing -> throw DivideByZero Just my -> Mod $ powModNatural (unMod my) (fromIntegral' (-a)) (natVal mx) | otherwise = Mod $ powModNatural (unMod mx) (fromIntegral' a) (natVal mx) where #if __GLASGOW_HASKELL__ == 900 && __GLASGOW_HASKELL_PATCHLEVEL1__ == 1 -- Cannot use fromIntegral because of https://gitlab.haskell.org/ghc/ghc/-/issues/19411 fromIntegral' = fromInteger . toInteger #else fromIntegral' = fromIntegral #endif {-# INLINABLE [1] (^%) #-} {-# SPECIALISE [1] (^%) :: KnownNat m => Mod m -> Integer -> Mod m, KnownNat m => Mod m -> Natural -> Mod m, KnownNat m => Mod m -> Int -> Mod m, KnownNat m => Mod m -> Word -> Mod m #-} {-# RULES "powMod/2/Integer" forall x. x ^% (2 :: Integer) = let u = x in u*u "powMod/3/Integer" forall x. x ^% (3 :: Integer) = let u = x in u*u*u "powMod/2/Int" forall x. x ^% (2 :: Int) = let u = x in u*u "powMod/3/Int" forall x. x ^% (3 :: Int) = let u = x in u*u*u "powMod/2/Word" forall x. x ^% (2 :: Word) = let u = x in u*u "powMod/3/Word" forall x. x ^% (3 :: Word) = let u = x in u*u*u #-} infixr 8 ^% 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" -- | No validation checks are performed; -- reading untrusted data may corrupt internal invariants. instance KnownNat m => Storable (Mod m) where sizeOf _ = case natVal' (proxy# :: Proxy# m) of NatS#{} -> sizeOf (0 :: Word) NatJ# (BN# m#) -> I# (bigNatSize# 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# (BN# m#) -> do let !(I# lgWordSize#) = lgWordSize sz# = bigNatSize# m# `iShiftL#` lgWordSize# BN# bn <- IO (\token -> case bigNatFromAddrLE# (int2Word# sz#) addr# token of (# newToken, bn# #) -> (# newToken, BN# bn# #)) 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# (BN# 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# bn) -> do l <- IO (\token -> case bigNatToAddrLE# bn addr# token of (# newToken, l# #) -> (# newToken, W# l# #)) forM_ [(fromIntegral :: Word -> Int) l .. (sz `shiftL` lgWordSize) - 1] $ \off -> pokeElemOff (Ptr addr#) off (0 :: Word8) where sz = I# (bigNatSize# m#) {-# INLINE poke #-} #ifdef MIN_VERSION_vector -- | No validation checks are performed; -- reading untrusted data may corrupt internal invariants. 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# (BN# m#) -> Mod $ bigNatToNat (runRW# (\token -> case bigNatFromByteArrayLE# (int2Word# sz#) arr# (int2Word# i#) token of (# _, bn# #) -> bn#)) where !(I# lgWordSize#) = lgWordSize sz# = bigNatSize# 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# (BN# m#) -> Mod $ bigNatToNat (runRW# (\token -> case bigNatFromAddrLE# (int2Word# sz#) (arr# `plusAddr#` i#) token of (# _, bn# #) -> bn#)) where !(I# lgWordSize#) = lgWordSize sz# = bigNatSize# 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# (BN# m#) -> case unsafeFreezeByteArray# marr token of (# newToken, arr #) -> case bigNatFromByteArrayLE# (int2Word# sz#) arr (int2Word# i#) newToken of (# veryNewToken, bn# #) -> (# veryNewToken,Mod (bigNatToNat bn#) #) where !(I# lgWordSize#) = lgWordSize sz# = bigNatSize# 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# (BN# m#) -> case bigNatFromAddrLE# (int2Word# sz#) (marr `plusAddr#` i#) token of (# newToken, bn #) -> (# newToken, Mod (bigNatToNat bn) #) where !(I# lgWordSize#) = lgWordSize sz# = bigNatSize# 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 modulus" NatJ# (BN# 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# bn) -> case bigNatToMutableByteArrayLE# bn (unsafeCoerce# marr) (int2Word# (i# `iShiftL#` lgWordSize#)) token of (# newToken, 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# (bigNatSize# 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 modulus" NatJ# (BN# 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# bn) -> case bigNatToAddrLE# bn (marr `plusAddr#` (i# `iShiftL#` lgWordSize#)) token of (# newToken, 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# (bigNatSize# 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 modulus" NatJ# (BN# m#) -> case P.writeByteArray# marr off mx token of newToken -> doSet (sz `iShiftL#` lgWordSize#) newToken where !(I# lgWordSize#) = lgWordSize sz = bigNatSize# 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 modulus" NatJ# (BN# m#) -> case P.writeOffAddr# marr off mx token of newToken -> doSet (sz `iShiftL#` lgWordSize#) newToken where !(I# lgWordSize#) = lgWordSize sz = bigNatSize# 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 the 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 the garbage collector, -- especially for large vectors. newtype instance U.Vector (Mod m) = ModVec (P.Vector (Mod m)) -- | No validation checks are performed; -- reading untrusted data may corrupt internal invariants. instance KnownNat m => U.Unbox (Mod m) -- | No validation checks are performed; -- reading untrusted data may corrupt internal invariants. 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 -- | No validation checks are performed; -- reading untrusted data may corrupt internal invariants. 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 mod-0.2.0.1/Data/Mod/0000755000000000000000000000000007346545000012210 5ustar0000000000000000mod-0.2.0.1/Data/Mod/Compat.hs0000644000000000000000000000213107346545000013764 0ustar0000000000000000-- | See https://gitlab.haskell.org/ghc/ghc/-/issues/22933 -- and https://gitlab.haskell.org/ghc/ghc/-/issues/22966 -- {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CApiFFI #-} {-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE UnliftedFFITypes #-} module Data.Mod.Compat ( timesWord2# , remWord2# ) where #ifdef aarch64_HOST_ARCH import GHC.Exts (Word(..), Word#, timesWord#) timesWord2# :: Word# -> Word# -> (# Word#, Word# #) timesWord2# x y = (# z, timesWord# x y #) where !(W# z) = c_umulh (W# x) (W# y) {-# INLINE timesWord2# #-} foreign import capi unsafe "aarch64.h umulh" c_umulh :: Word -> Word -> Word remWord2# :: Word# -> Word# -> Word# -> Word# remWord2# lo hi m = r where !(W# r) = c_umodh (W# lo) (W# hi) (W# m) {-# INLINE remWord2# #-} foreign import capi unsafe "aarch64.h umodh" c_umodh :: Word -> Word -> Word -> Word #else import GHC.Exts (Word#, timesWord2#, quotRemWord2#) remWord2# :: Word# -> Word# -> Word# -> Word# remWord2# lo hi m = r where !(# _, r #) = quotRemWord2# hi lo m {-# INLINE remWord2# #-} #endif mod-0.2.0.1/Data/Mod/Word.hs0000644000000000000000000004227607346545000013472 0ustar0000000000000000-- | -- Module: Data.Mod.Word -- Copyright: (c) 2017-2022 Andrew Lelechenko -- Licence: MIT -- Maintainer: Andrew Lelechenko -- -- , -- promoting moduli to the type level, with an emphasis on performance. -- Originally part of the package. -- -- This module supports only moduli, which fit into 'Word'. -- Use the (slower) "Data.Mod" module for handling arbitrary-sized moduli. {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UnboxedTuples #-} module Data.Mod.Word ( Mod , unMod , invertMod , (^%) ) where import Prelude as P hiding (even) import Control.Exception import Control.DeepSeq import Data.Bits import Data.Mod.Compat (timesWord2#, remWord2#) import Data.Ratio #ifdef MIN_VERSION_semirings import Data.Euclidean (GcdDomain(..), Euclidean(..), Field) 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 hiding (timesWord2#, quotRemWord2#) import GHC.Generics import GHC.Natural (Natural(..)) import GHC.Num.BigNat import GHC.Num.Integer import GHC.TypeNats (Nat, KnownNat, natVal) import Text.Read (Read(readPrec)) -- | This data type represents -- , -- equipped with useful instances. -- -- For example, 3 :: 'Mod' 10 stands for the class of integers -- congruent to \( 3 \bmod 10 \colon \ldots {−17}, −7, 3, 13, 23 \ldots \) -- -- >>> :set -XDataKinds -- >>> 3 + 8 :: Mod 10 -- 3 + 8 = 11 ≡ 1 (mod 10) -- 1 -- -- __Note:__ 'Mod' 0 has no inhabitants, eventhough \( \mathbb{Z}/0\mathbb{Z} \) is technically isomorphic to \( \mathbb{Z} \). newtype Mod (m :: Nat) = Mod { unMod :: Word -- ^ The canonical representative of the residue class, -- always between 0 and \( m - 1 \) (inclusively). -- -- >>> :set -XDataKinds -- >>> -1 :: Mod 10 -- 9 } deriving (Eq, Ord, Generic) deriving Storable -- ^ No validation checks are performed; -- reading untrusted data may corrupt internal invariants. #ifdef MIN_VERSION_vector deriving Prim -- ^ No validation checks are performed; -- reading untrusted data may corrupt internal invariants. #endif instance NFData (Mod m) instance Show (Mod m) where show (Mod x) = show x -- | Wrapping behaviour, similar to -- the existing @instance@ 'Read' 'Int'. instance KnownNat m => Read (Mod m) where readPrec = fromInteger <$> readPrec instance KnownNat m => Real (Mod m) where toRational (Mod x) = toRational x instance KnownNat m => Enum (Mod m) where succ x = if x == maxBound then throw Overflow else coerce (succ @Word) x pred x = if x == minBound then throw Underflow else coerce (pred @Word) x toEnum = fromIntegral fromEnum = fromIntegral . unMod enumFrom x = enumFromTo x maxBound enumFromThen x y = enumFromThenTo x y (if y >= x then maxBound else minBound) enumFromTo = coerce (enumFromTo @Word) enumFromThenTo = coerce (enumFromThenTo @Word) instance KnownNat m => Bounded (Mod m) where minBound = mx where mx = if natVal mx > 0 then Mod 0 else throw DivideByZero maxBound = mx where mx = if m > 0 then Mod (fromIntegral (m - 1)) else throw DivideByZero m = natVal mx addMod :: Natural -> Word -> Word -> Word addMod (NatS# m#) (W# x#) (W# y#) = if isTrue# c# || isTrue# (z# `geWord#` m#) then W# (z# `minusWord#` m#) else W# z# where !(# z#, c# #) = x# `addWordC#` y# addMod NatJ#{} _ _ = tooLargeModulus subMod :: Natural -> Word -> Word -> Word subMod (NatS# m#) (W# x#) (W# y#) = if isTrue# (x# `geWord#` y#) then W# z# else W# (z# `plusWord#` m#) where z# = x# `minusWord#` y# subMod NatJ#{} _ _ = tooLargeModulus negateMod :: Natural -> Word -> Word negateMod _ (W# 0##) = W# 0## negateMod (NatS# m#) (W# x#) = W# (m# `minusWord#` x#) negateMod NatJ#{} _ = tooLargeModulus halfWord :: Word halfWord = 1 `shiftL` (finiteBitSize (0 :: Word) `shiftR` 1) mulMod :: Natural -> Word -> Word -> Word mulMod (NatS# m#) (W# x#) (W# y#) | W# m# <= halfWord = W# (timesWord# x# y# `remWord#` m#) | otherwise = W# r# where !(# hi#, lo# #) = timesWord2# x# y# !r# = remWord2# lo# hi# m# mulMod NatJ#{} _ _ = tooLargeModulus fromIntegerMod :: Natural -> Integer -> Word fromIntegerMod (NatS# 0##) !_ = throw DivideByZero fromIntegerMod (NatS# m#) (IS x#) = if isTrue# (x# >=# 0#) then W# (int2Word# x# `remWord#` m#) else negateMod (NatS# m#) (W# (int2Word# (negateInt# x#) `remWord#` m#)) fromIntegerMod (NatS# m#) (IP x#) = W# (x# `bigNatRemWord#` m#) fromIntegerMod (NatS# m#) (IN x#) = negateMod (NatS# m#) (W# (x# `bigNatRemWord#` m#)) fromIntegerMod NatJ#{} _ = tooLargeModulus #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# (BN# x#)) = W# (x# `bigNatRemWord#` m#) fromNaturalMod NatJ#{} _ = tooLargeModulus getModulus :: Natural -> Word getModulus (NatS# m#) = W# m# getModulus NatJ#{} = tooLargeModulus #endif tooLargeModulus :: a tooLargeModulus = error "modulus does not fit into a machine word" instance KnownNat m => Num (Mod m) where mx@(Mod !x) + (Mod !y) = Mod $ addMod (natVal mx) x y {-# INLINE (+) #-} mx@(Mod !x) - (Mod !y) = Mod $ subMod (natVal mx) x y {-# INLINE (-) #-} negate mx@(Mod !x) = Mod $ negateMod (natVal mx) x {-# INLINE negate #-} mx@(Mod !x) * (Mod !y) = Mod $ mulMod (natVal mx) x y {-# INLINE (*) #-} abs = id {-# INLINE abs #-} signum = const x where x = if natVal x > 1 then Mod 1 else Mod 0 {-# INLINE signum #-} fromInteger x = mx where mx = Mod $ fromIntegerMod (natVal mx) x {-# INLINE fromInteger #-} #ifdef MIN_VERSION_semirings instance KnownNat m => Semiring (Mod m) where plus = (+) {-# INLINE plus #-} times = (*) {-# INLINE times #-} zero = mx where mx = if natVal mx > 0 then Mod 0 else throw DivideByZero {-# INLINE zero #-} one = mx where mx = case m `compare` 1 of LT -> throw DivideByZero EQ -> Mod 0 GT -> Mod 1 m = natVal mx {-# INLINE one #-} fromNatural x = mx where mx = Mod $ fromNaturalMod (natVal mx) x {-# INLINE fromNatural #-} instance KnownNat m => Ring (Mod m) where negate = P.negate {-# INLINE negate #-} -- | 'Mod' @m@ is not even an -- for -- @m@, -- much less a . -- However, 'Data.Euclidean.gcd' and 'Data.Euclidean.lcm' are still meaningful -- even for composite @m@, corresponding to a sum and an intersection of -- . -- -- The instance is lawful only for -- @m@, otherwise -- @'Data.Euclidean.divide' x y@ tries to return any @Just z@ such that @x == y * z@. -- instance KnownNat m => GcdDomain (Mod m) where divide (Mod 0) !_ = Just (Mod 0) divide _ (Mod 0) = Nothing divide mx@(Mod x) (Mod y) = case mry of Just ry -> if xr == 0 then Just (Mod xq * Mod ry) else Nothing Nothing -> Nothing where m = getModulus (natVal mx) gmy = P.gcd m y (xq, xr) = P.quotRem x gmy mry = invertModWord (y `P.quot` gmy) (m `P.quot` gmy) gcd (Mod !x) (Mod !y) = g where m = getModulus (natVal g) g = Mod $ if m > 1 then P.gcd (P.gcd m x) y else 0 lcm (Mod !x) (Mod !y) = l where m = getModulus (natVal l) l = Mod $ if m > 1 then P.lcm (P.gcd m x) (P.gcd m y) else 0 coprime x y = Data.Euclidean.gcd x y == one -- | 'Mod' @m@ is not even an -- for -- @m@, -- much less a . -- -- The instance is lawful only for -- @m@, otherwise -- we try to do our best: -- @'Data.Euclidean.quot' x y@ returns any @z@ such that @x == y * z@, -- 'Data.Euclidean.rem' is not always 0, and both can throw 'DivideByZero'. -- instance KnownNat m => Euclidean (Mod m) where degree = fromIntegral . unMod quotRem (Mod 0) !_ = (Mod 0, Mod 0) quotRem _ (Mod 0) = throw DivideByZero quotRem mx@(Mod x) (Mod y) = case mry of Just ry -> (Mod xq * Mod ry, Mod xr) Nothing -> throw DivideByZero where m = getModulus (natVal mx) gmy = P.gcd m y (xq, xr) = P.quotRem x gmy mry = invertModWord (y `P.quot` gmy) (m `P.quot` gmy) -- | 'Mod' @m@ is not even an -- for -- @m@, -- much less a . -- -- The instance is lawful only for -- @m@, otherwise -- division by a residue, which is not -- -- with the modulus, throws 'DivideByZero'. -- Consider using 'invertMod' for non-prime moduli. -- instance KnownNat m => Field (Mod m) #endif -- | Division by a residue, which is not -- -- with the modulus, throws 'DivideByZero'. -- Consider using 'invertMod' for non-prime moduli. instance KnownNat m => Fractional (Mod m) where fromRational r = case denominator r of 1 -> num den -> num / fromInteger den where num = fromInteger (numerator r) {-# INLINE fromRational #-} recip mx = case invertMod mx of Nothing -> throw DivideByZero Just y -> y {-# INLINE recip #-} -- | If an argument is -- -- with the modulus, return its modular inverse. -- Otherwise return 'Nothing'. -- -- >>> :set -XDataKinds -- >>> invertMod 3 :: Mod 10 -- 3 * 7 = 21 ≡ 1 (mod 10) -- Just 7 -- >>> 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#{} -> tooLargeModulus NatS# 0## -> Nothing NatS# m# -> Mod <$> invertModWord x (W# m#) invertModWord :: Word -> Word -> Maybe Word invertModWord x m@(W# m#) -- If both x and m are even, no inverse exists | even x, isTrue# (k# `gtWord#` 0##) = Nothing | otherwise = case invertModWordOdd x m' of Nothing -> Nothing -- goDouble cares only about mod 2^k, -- so overflows and underflows in (1 - x * y) are fine Just y -> Just $ goDouble y (1 - x * y) where k# = ctz# m# m' = m `unsafeShiftR` I# (word2Int# k#) xm' = x * m' goDouble :: Word -> Word -> Word goDouble acc r@(W# r#) | isTrue# (tz# `geWord#` k#) = acc | otherwise = goDouble (acc + m' `unsafeShiftL` tz) (r - xm' `unsafeShiftL` tz) where tz# = ctz# r# tz = I# (word2Int# tz#) -- | Extended binary gcd. -- The second argument must be odd. invertModWordOdd :: Word -> Word -> Maybe Word invertModWordOdd 0 !_ = Nothing invertModWordOdd !x !m = go00 0 m 1 x where halfMp1 :: Word halfMp1 = half m + 1 -- Both s and s' may be even go00 :: Word -> Word -> Word -> Word -> Maybe Word go00 !r !s !r' !s' | even s = let (# hr, hs #) = doHalf r s in go00 hr hs r' s' | otherwise = go10 r s r' s' -- Here s is odd, s' may be even go10 :: Word -> Word -> Word -> Word -> Maybe Word go10 !r !s !r' !s' | even s' = let (# hr', hs' #) = doHalf r' s' in go10 r s hr' hs' | otherwise = go11 r s r' s' -- Here s may be even, s' is odd go01 :: Word -> Word -> Word -> Word -> Maybe Word go01 !r !s !r' !s' | even s = let (# hr, hs #) = doHalf r s in go01 hr hs r' s' | otherwise = go11 r s r' s' -- Both s and s' are odd go11 :: Word -> Word -> Word -> Word -> Maybe Word go11 !r !s !r' !s' = case s `compare` s' of EQ -> if s == 1 then Just r else Nothing LT -> let newR' = r' - r + (r `ge` r') * m in let newS' = s' - s in let (# hr', hs' #) = doHalf newR' newS' in go10 r s hr' hs' GT -> let newR = r - r' + (r' `ge` r) * m in let newS = s - s' in let (# hr, hs #) = doHalf newR newS in go01 hr hs r' s' doHalf :: Word -> Word -> (# Word, Word #) doHalf r s = (# half r + (r .&. 1) * halfMp1, half s #) {-# INLINE doHalf #-} -- | ge x y returns 1 is x >= y and 0 otherwise. ge :: Word -> Word -> Word ge (W# x) (W# y) = W# (int2Word# (x `geWord#` y)) even :: Word -> Bool even x = (x .&. 1) == 0 {-# INLINE even #-} half :: Word -> Word half x = x `shiftR` 1 {-# INLINE half #-} -- | Drop-in replacement for 'Prelude.^' with a bit better performance. -- Negative powers are allowed, but may throw 'DivideByZero', if an argument -- is not with the modulus. -- -- >>> :set -XDataKinds -- >>> 3 ^% 4 :: Mod 10 -- 3 ^ 4 = 81 ≡ 1 (mod 10) -- 1 -- >>> 3 ^% (-1) :: Mod 10 -- 3 * 7 = 21 ≡ 1 (mod 10) -- 7 -- >>> 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 !x) ^% a = case natVal mx of NatJ#{} -> tooLargeModulus m@(NatS# _) | a < 0 -> case invertMod mx of Nothing -> throw DivideByZero Just (Mod y) -> Mod $ f y (-a) 1 | otherwise -> Mod $ f x a 1 where f !_ 0 acc = acc f b e acc = f (mulMod m b b) (e `P.quot` 2) (if odd e then mulMod m b acc else acc) {-# INLINABLE [1] (^%) #-} {-# SPECIALISE [1] (^%) :: KnownNat m => Mod m -> Integer -> Mod m, KnownNat m => Mod m -> Natural -> Mod m, KnownNat m => Mod m -> Int -> Mod m, KnownNat m => Mod m -> Word -> Mod m #-} {-# RULES "powMod/2/Integer" forall x. x ^% (2 :: Integer) = let u = x in u*u "powMod/3/Integer" forall x. x ^% (3 :: Integer) = let u = x in u*u*u "powMod/2/Int" forall x. x ^% (2 :: Int) = let u = x in u*u "powMod/3/Int" forall x. x ^% (3 :: Int) = let u = x in u*u*u "powMod/2/Word" forall x. x ^% (2 :: Word) = let u = x in u*u "powMod/3/Word" forall x. x ^% (3 :: Word) = let u = x in u*u*u #-} infixr 8 ^% #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) -- | No validation checks are performed; -- reading untrusted data may corrupt internal invariants. instance U.Unbox (Mod m) -- | No validation checks are performed; -- reading untrusted data may corrupt internal invariants. 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 -- | No validation checks are performed; -- reading untrusted data may corrupt internal invariants. 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 mod-0.2.0.1/LICENSE0000644000000000000000000000206107346545000011624 0ustar0000000000000000Copyright (c) 2017-2022 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, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. mod-0.2.0.1/README.md0000644000000000000000000001237607346545000012110 0ustar0000000000000000# mod [![Hackage](https://img.shields.io/hackage/v/mod.svg)](https://hackage.haskell.org/package/mod) [![Stackage LTS](https://www.stackage.org/package/mod/badge/lts)](https://www.stackage.org/lts/package/mod) [![Stackage Nightly](https://www.stackage.org/package/mod/badge/nightly)](https://www.stackage.org/nightly/package/mod) [Modular arithmetic](https://en.wikipedia.org/wiki/Modular_arithmetic), promoting moduli to the type level, with an emphasis on performance. Originally a part of the [arithmoi](https://hackage.haskell.org/package/arithmoi) package. ```haskell > :set -XDataKinds > 4 + 5 :: Mod 7 2 > 4 - 5 :: Mod 7 6 > 4 * 5 :: Mod 7 6 > 4 / 5 :: Mod 7 5 > 4 ^ 5 :: Mod 7 2 ``` ## Competitors There are other Haskell packages, employing the very same idea of moduli on the type level, namely `modular`, `modular-arithmetic` and `finite-field`. One can also use `finite-typelits`, which covers some elementary modular arithmetic as well. Unfortunately, all of them fall behind in terms of performance. Here is a brief comparison: | Discipline | `mod` | `modular` | `modular-arithmetic` | `finite-typelits` | `finite-field` | :---------- | :----: | :-------: | :------------------: | :---------------: | :------------: | Addition | Fast | Slow | Slow | Slow | Slow | Small `(*)` | Fast | Slow | Slow | Slow | Slow | Inversion | Fast | N/A | Slow | N/A | Slow | Power | Fast | Slow | Slow | Slow | Slow | Overflows | Safe | Safe | Unsafe | Safe | Safe * __Addition.__ All competing implementations of the modular addition involve divisions, while `mod` completely avoids this costly operation. This makes a difference even for small numbers; e. g., `sum [1..10^7]` becomes 5x faster. For larger integers the speed up is even more significant, because the computational complexity of division is not linear. * __Small `(*)`.__ When a modulus fits in a machine word (which is quite a common case on 64-bit architectures), `mod` implements the modular multiplication as a couple of CPU instructions and neither allocates intermediate arbitrary-precision values, nor calls `libgmp` at all. For computations like `product [1..10^7]` this gives a 3x boost to performance in comparison to other libraries. * __Inversion.__ This package relies on `libgmp` for modular inversions. Even for small arguments it is about 5x faster than the native implementation of modular inversion in `modular-arithmetic`. * __Power.__ This package relies on `libgmp` for modular exponentiation. Even for small arguments it is about 2x faster than competitors. * __Overflows.__ At first glance `modular-arithmetic` is more flexible than `mod`, because it allows to specify the underlying representation of a modular residue, e. g., `Mod Integer 100`, `Mod Int 100`, `Mod Word8 100`. We argue that this is a dangerous freedom, vulnerable to overflows. For instance, `20 ^ 2 :: Mod Word8 100` returns `44` instead of the expected `0`. Even less expected is that `50 :: Mod Word8 300` appears to be `6` (remember that type-level numbers are always `Natural`). ### What is the difference between `mod` and `finite-typelits`? `mod` is specifically designed to represent modular residues for mathematical applications (__wrapping-around__ finite numbers) and provides modular inversion and exponentiation. The main focus of `finite-typelits` is on __non-wrapping-around__ finite numbers, like indices of arrays in `vector-sized`. It features a `Num` instance only for the sake of overloading numeric literals. There is no lawful way to define `Num` except modular arithmetic, but from `finite-typelits`' viewpoint this is a by-product. ## Citius, altius, fortius! If you are looking for an ultimate performance and your moduli fit into `Word`, try `Data.Mod.Word`, which is a drop-in replacement of `Data.Mod`, offering better performance and much less allocations. ## Benchmarks Here are some relative benchmarks (less is better), which can be reproduced by running `cabal bench`. | Discipline | `Data.Mod.Word` | `Data.Mod` | `modular` | `modular-arithmetic` | `finite-typelits` | `finite-field` | :---------- | :--------------: | :---------: | :-------: | :------------------: | :---------------: | :------------: | Sum | 0.44x | 1x | 16.6x | 8.9x | 14.7x | 14.2x | Product | 0.95x | 1x | 7.8x | 4.5x | 7.0x | 7.0x | Inversion | 0.54x | 1x | N/A | 3.2x | N/A | 1.8x | Power | 0.29x | 1x | 2.0x | 1.2x | 1.4x | 1.5x ## What's next? This package was cut out of [`arithmoi`](https://hackage.haskell.org/package/arithmoi) to provide modular arithmetic with a light dependency footprint. This goal certainly limits the scope of the API to the bare minimum. If you need more advanced tools (the Chinese remainder theorem, cyclic groups, modular equations, etc.) please refer to the [Math.NumberTheory.Moduli](https://hackage.haskell.org/package/arithmoi/docs/Math-NumberTheory-Moduli.html) module. mod-0.2.0.1/bench/0000755000000000000000000000000007346545000011677 5ustar0000000000000000mod-0.2.0.1/bench/Bench.hs0000644000000000000000000001523007346545000013253 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE ViewPatterns #-} {-# OPTIONS_GHC -fno-warn-type-defaults -fno-warn-name-shadowing #-} module Main where import Data.Proxy import Test.Tasty.Bench import qualified Data.Mod import qualified Data.Mod.Word #ifdef MIN_VERSION_finite_field import qualified Data.FiniteField.PrimeField #endif #ifdef MIN_VERSION_finite_typelits import qualified Data.Finite #endif #ifdef MIN_VERSION_modular_arithmetic import qualified Data.Modular #endif #ifdef MIN_VERSION_modular import qualified Numeric.Modular #endif type P = 20000003 #ifdef MIN_VERSION_modular forceModular :: Numeric.Modular.Mod P -> Numeric.Modular.Mod P forceModular a = (a == a) `seq` a #endif benchSum :: Benchmark benchSum = bgroup "Sum" [ measure "Data.Mod" (Proxy @Data.Mod.Mod) , cmp $ measure "Data.Mod.Word" (Proxy @Data.Mod.Word.Mod) #ifdef MIN_VERSION_finite_field , cmp $ measure "finite-field" (Proxy @Data.FiniteField.PrimeField.PrimeField) #endif #ifdef MIN_VERSION_finite_typelits , cmp $ measure "finite-typelits" (Proxy @Data.Finite.Finite) #endif #ifdef MIN_VERSION_modular_arithmetic , cmp $ measure "modular-arithmetic" (Proxy @(Data.Modular.Mod Integer)) #endif #ifdef MIN_VERSION_modular , cmp $ bench "modular" $ nf (show . sumNModular) lim #endif ] where cmp = bcompare "$NF == \"Data.Mod\" && $(NF-1) == \"Sum\"" lim = 20000000 measure :: (Eq (t P), Num (t P)) => String -> Proxy t -> Benchmark measure name p = bench name $ whnf (sumN p) lim {-# INLINE measure #-} sumN :: forall t. (Eq (t P), Num (t P)) => Proxy t -> Int -> t P sumN = const $ \n -> go 0 (fromIntegral n) where go :: t P -> t P -> t P go !acc 0 = acc go acc n = go (acc + n) (n - 1) {-# INLINE sumN #-} #ifdef MIN_VERSION_modular sumNModular :: Int -> Numeric.Modular.Mod P sumNModular = \n -> go 0 (fromIntegral n) where go :: Numeric.Modular.Mod P -> Numeric.Modular.Mod P -> Numeric.Modular.Mod P go acc@(forceModular -> !_) 0 = acc go acc n = go (acc + n) (n - 1) {-# INLINE sumNModular #-} #endif benchProduct :: Benchmark benchProduct = bgroup "Product" [ measure "Data.Mod" (Proxy @Data.Mod.Mod) , cmp $ measure "Data.Mod.Word" (Proxy @Data.Mod.Word.Mod) #ifdef MIN_VERSION_finite_field , cmp $ measure "finite-field" (Proxy @Data.FiniteField.PrimeField.PrimeField) #endif #ifdef MIN_VERSION_finite_typelits , cmp $ measure "finite-typelits" (Proxy @Data.Finite.Finite) #endif #ifdef MIN_VERSION_modular_arithmetic , cmp $ measure "modular-arithmetic" (Proxy @(Data.Modular.Mod Integer)) #endif #ifdef MIN_VERSION_modular , cmp $ bench "modular" $ nf (show . productNModular) lim #endif ] where cmp = bcompare "$NF == \"Data.Mod\" && $(NF-1) == \"Product\"" lim = 20000000 measure :: (Eq (t P), Num (t P)) => String -> Proxy t -> Benchmark measure name p = bench name $ whnf (productN p) lim {-# INLINE measure #-} productN :: forall t. (Eq (t P), Num (t P)) => Proxy t -> Int -> t P productN = const $ \n -> go 1 (fromIntegral n) where go :: t P -> t P -> t P go !acc 0 = acc go acc n = go (acc * n) (n - 1) {-# INLINE productN #-} #ifdef MIN_VERSION_modular productNModular :: Int -> Numeric.Modular.Mod P productNModular = \n -> go 1 (fromIntegral n) where go :: Numeric.Modular.Mod P -> Numeric.Modular.Mod P -> Numeric.Modular.Mod P go acc@(forceModular -> !_) 0 = acc go acc n = go (acc * n) (n - 1) {-# INLINE productNModular #-} #endif benchInversion :: Benchmark benchInversion = bgroup "Inversion" [ measure "Data.Mod" (Proxy @Data.Mod.Mod) , cmp $ measure "Data.Mod.Word" (Proxy @Data.Mod.Word.Mod) #ifdef MIN_VERSION_finite_field , cmp $ measure "finite-field" (Proxy @Data.FiniteField.PrimeField.PrimeField) #endif #ifdef MIN_VERSION_modular_arithmetic , cmp $ measure "modular-arithmetic" (Proxy @(Data.Modular.Mod Integer)) #endif ] where cmp = bcompare "$NF == \"Data.Mod\" && $(NF-1) == \"Inversion\"" lim = 1500000 measure :: (Eq (t P), Fractional (t P)) => String -> Proxy t -> Benchmark measure name p = bench name $ whnf (invertN p) lim {-# INLINE measure #-} invertN :: forall t. (Eq (t P), Fractional (t P)) => Proxy t -> Int -> t P invertN = const $ \n -> go 0 (fromIntegral n) where go :: t P -> t P -> t P go !acc 0 = acc go acc n = go (acc + recip n) (n - 1) {-# INLINE invertN #-} benchPower :: Benchmark benchPower = bgroup "Power" [ bench "Data.Mod" $ nf powerNMod lim , cmp $ bench "Data.Mod.Word" $ nf powerNModWord lim #ifdef MIN_VERSION_finite_field , cmp $ measure "finite-field" (Proxy @Data.FiniteField.PrimeField.PrimeField) #endif #ifdef MIN_VERSION_finite_typelits , cmp $ measure "finite-typelits" (Proxy @Data.Finite.Finite) #endif #ifdef MIN_VERSION_modular_arithmetic , cmp $ measure "modular-arithmetic" (Proxy @(Data.Modular.Mod Integer)) #endif #ifdef MIN_VERSION_modular , cmp $ bench "modular" $ nf (show . powerNModular) lim #endif ] where cmp = bcompare "$NF == \"Data.Mod\" && $(NF-1) == \"Power\"" lim = 1000000 powerNMod :: Int -> Data.Mod.Mod P powerNMod = go 0 where go :: Data.Mod.Mod P -> Int -> Data.Mod.Mod P go !acc 0 = acc go acc n = go (acc + 2 Data.Mod.^% n) (n - 1) {-# INLINE powerNMod #-} powerNModWord :: Int -> Data.Mod.Word.Mod P powerNModWord = go 0 where go :: Data.Mod.Word.Mod P -> Int -> Data.Mod.Word.Mod P go !acc 0 = acc go acc n = go (acc + 2 Data.Mod.Word.^% n) (n - 1) {-# INLINE powerNModWord #-} #if defined(MIN_VERSION_finite_field) || defined(MIN_VERSION_modular_arithmetic) measure :: (Eq (t P), Num (t P)) => String -> Proxy t -> Benchmark measure name p = bench name $ whnf (powerN p) lim {-# INLINE measure #-} powerN :: forall t. (Eq (t P), Num (t P)) => Proxy t -> Int -> t P powerN = const $ go 0 where go :: t P -> Int -> t P go !acc 0 = acc go acc n = go (acc + 2 ^ n) (n - 1) {-# INLINE powerN #-} #endif #ifdef MIN_VERSION_modular powerNModular :: Int -> Numeric.Modular.Mod P powerNModular = go 0 where go :: Numeric.Modular.Mod P -> Int -> Numeric.Modular.Mod P go acc@(forceModular -> !_) 0 = acc go acc n = go (acc + 2 ^ n) (n - 1) {-# INLINE powerNModular #-} #endif main :: IO () main = defaultMain [ benchSum , benchProduct , benchInversion , benchPower ] mod-0.2.0.1/cbits/0000755000000000000000000000000007346545000011724 5ustar0000000000000000mod-0.2.0.1/cbits/aarch64.c0000644000000000000000000000033007346545000013314 0ustar0000000000000000#include uint64_t umulh(uint64_t x, uint64_t y) { return ((unsigned __int128)x * y) >> 64; } uint64_t umodh(uint64_t lo, uint64_t hi, uint64_t m) { return (((unsigned __int128)hi << 64) + lo) % m; } mod-0.2.0.1/cbits/aarch64.h0000644000000000000000000000016407346545000013326 0ustar0000000000000000#include uint64_t umulh(uint64_t x, uint64_t y); uint64_t umodh(uint64_t lo, uint64_t hi, uint64_t m); mod-0.2.0.1/changelog.md0000644000000000000000000000116707346545000013076 0ustar0000000000000000# 0.2.0.1 * Fix build on `aarch64`. # 0.2.0.0 * Breaking change: redesign `GcdDomain` and `Euclidean` instances. * Add `instance Read` and `instance Real`. * Migrate from `integer-gmp` to `ghc-bignum`. * Remove `(^) -> (^%)` rewrite rule, it does not fire. * Plug loopholes to inhabit `Mod 0`. * Work around performance degradation on ARM. # 0.1.2.2 * Work around an issue with [`fromIntegral`](https://gitlab.haskell.org/ghc/ghc/-/issues/19411) in GHC 9.0.1. # 0.1.2.1 * Support `integer-gmp-1.1`. # 0.1.2.0 * Add `Storable`, `Prim` and `Unbox` instances. # 0.1.1.0 * Add `Data.Mod.Word`. # 0.1.0.0 * Initial release mod-0.2.0.1/mod.cabal0000644000000000000000000000455107346545000012370 0ustar0000000000000000name: mod version: 0.2.0.1 cabal-version: >=1.10 build-type: Simple license: MIT license-file: LICENSE copyright: 2017-2022 Andrew Lelechenko maintainer: Andrew Lelechenko homepage: https://github.com/Bodigrim/mod bug-reports: https://github.com/Bodigrim/mod/issues synopsis: Fast type-safe modular arithmetic description: , promoting moduli to the type level, with an emphasis on performance. Originally part of the package. category: Math, Number Theory author: Andrew Lelechenko tested-with: GHC ==9.0.2 GHC ==9.2.5 GHC ==9.4.4 GHC ==9.6.1 extra-source-files: changelog.md README.md cbits/aarch64.h source-repository head type: git location: https://github.com/Bodigrim/mod flag semirings description: Derive semiring instances default: True flag vector description: Derive unboxed and primitive vector instances default: True library build-depends: base >=4.15 && <5, deepseq, ghc-bignum if flag(semirings) build-depends: semirings >= 0.5 if flag(vector) build-depends: primitive, vector >= 0.12 exposed-modules: Data.Mod Data.Mod.Word other-modules: Data.Mod.Compat default-language: Haskell2010 ghc-options: -Wall -O2 -Wno-deprecations -Wcompat if(arch(aarch64)) c-sources: cbits/aarch64.c include-dirs: cbits test-suite mod-tests build-depends: base >=4.10 && <5, mod, quickcheck-classes-base, tasty >=0.10, tasty-quickcheck >=0.9 && <0.11 if flag(semirings) build-depends: containers, 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 -threaded -rtsopts -Wcompat benchmark mod-bench build-depends: base, mod, -- finite-field >= 0.9, -- finite-typelits, -- modular, -- modular-arithmetic >= 2, tasty-bench >= 0.2.5 type: exitcode-stdio-1.0 main-is: Bench.hs default-language: Haskell2010 hs-source-dirs: bench ghc-options: -Wall -O2 -Wcompat mod-0.2.0.1/test/0000755000000000000000000000000007346545000011577 5ustar0000000000000000mod-0.2.0.1/test/Test.hs0000644000000000000000000004524507346545000013064 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeOperators #-} {-# OPTIONS_GHC -Wno-orphans -Wno-type-defaults #-} module Main (main) where import Control.Exception (evaluate, try, ArithException(..)) 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, type (^), type (+), type (-)) import Test.Tasty import Test.Tasty.QuickCheck import Test.QuickCheck.Classes.Base #ifdef MIN_VERSION_semirings import qualified Data.Euclidean as E import Data.Semiring (Ring, Semiring(..)) import qualified Data.Set as S 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 #define testModLabeled(lbl, n) \ testGroup ("Mod " ++ lbl) $ \ testProperty "fromInteger" \ (fromIntegerProp (Proxy :: Proxy (n))) : \ testProperty "invertMod" (invertModProp @(n)) : \ testProperty "powMod" (powModProp @(n)) : \ map lawsToTest (laws (Proxy :: Proxy (Mod (n)))) #define testMod(n) testModLabeled(show (n :: Integer), n) #define testModWordLabeled(lbl, n) \ testGroup ("Word.Mod" ++ lbl) $ \ testProperty "fromInteger" \ (fromIntegerWordProp (Proxy :: Proxy (n))) : \ testProperty "powMod" (powModWordProp @(n)) : \ testProperty "invertMod" (invertModWordProp @(n)) : \ map lawsToTest (laws (Proxy :: Proxy (Word.Mod (n)))) #define testModWord(n) testModWordLabeled(show (n :: Integer), n) main :: IO () main = defaultMain $ testGroup "All" $ [ testGroup "Mod 1" $ testProperty "fromInteger" (fromIntegerProp (Proxy :: Proxy 1)) : map lawsToTest (laws1 (Proxy :: Proxy (Mod 1))) , testMod(2310) , testMod(2^16-1) , testMod(2^16) , testMod(2^16+1) , testMod(2^32-1) , testMod(2^32) , testMod(2^32+1) , testMod(2^64-1) , testMod(2^64) , testMod(2^64+1) , testMod(123456789012345678901234567890) , testModLabeled("2^40000", 2^40000) , testGroup "Random Mod" [ testProperty "fromInteger" fromIntegerRandomProp , testProperty "invertMod" invertModRandomProp , testProperty "powMod" powModRandomProp , testProperty "powMod on sum" powModRandomAdditiveProp , testProperty "powMod special case" powModCase #ifdef MIN_VERSION_semirings , testProperty "divide" dividePropRandom , testProperty "gcd" gcdIsPrincipalIdealRandom , testProperty "lcm" lcmIsIntersectionOfIdealsRandom , testProperty "coprime" coprimeGeneratorsRandom , testProperty "quotRem" quotRemPropRandom , testProperty "degree" degreePropRandom #endif ] , testGroup "Mod 0" [ testProperty "0" (isDivideByZero 0) , testProperty "1" (isDivideByZero 1) , testProperty "minBound" (isDivideByZero minBound) , testProperty "maxBound" (isDivideByZero maxBound) , testProperty "toEnum" (isDivideByZero (toEnum 0)) , testProperty "fromRational" (isDivideByZero (fromRational 0)) #ifdef MIN_VERSION_semirings , testProperty "zero" (isDivideByZero zero) , testProperty "one" (isDivideByZero one) , testProperty "fromNatural" (isDivideByZero (fromNatural 0)) #endif ] , testGroup "Word.Mod 1" $ testProperty "fromInteger" (fromIntegerWordProp (Proxy :: Proxy 1)) : map lawsToTest (laws1 (Proxy :: Proxy (Word.Mod 1))) , testMod(2310) , testMod(2^16-1) , testMod(2^16) , testMod(2^16+1) , testMod(2^32-1) ] ++ if finiteBitSize (0 :: Word) /= 64 then [] else [ testMod(2^32) , testMod(2^32+1) , testMod(2^64-1) , testMod(2^64) , testMod(2^64+1) ] ++ [ testGroup "Random Word.Mod" [ testProperty "fromInteger" fromIntegerWordRandomProp , testProperty "invertMod" invertModWordRandomProp , testProperty "invertMod near maxBound" invertModWordRandomPropNearMaxBound , testProperty "powMod" powModWordRandomProp , testProperty "powMod on sum" powModWordRandomAdditiveProp , testProperty "powMod special case" powModWordCase #ifdef MIN_VERSION_semirings , testProperty "divide" divideWordPropRandom , testProperty "gcd" gcdIsPrincipalIdealWordRandom , testProperty "lcm" lcmIsIntersectionOfIdealsWordRandom , testProperty "coprime" coprimeGeneratorsWordRandom , testProperty "quotRem" quotRemWordPropRandom , testProperty "degree" degreeWordPropRandom #endif ] , testGroup "Word.Mod 0" [ testProperty "0" (isDivideByZeroWord 0) , testProperty "1" (isDivideByZeroWord 1) , testProperty "minBound" (isDivideByZeroWord minBound) , testProperty "maxBound" (isDivideByZeroWord maxBound) , testProperty "toEnum" (isDivideByZeroWord (toEnum 0)) , testProperty "fromRational" (isDivideByZeroWord (fromRational 0)) #ifdef MIN_VERSION_semirings , testProperty "zero" (isDivideByZeroWord zero) , testProperty "one" (isDivideByZeroWord one) , testProperty "fromNatural" (isDivideByZeroWord (fromNatural 0)) #endif ] ] #ifdef MIN_VERSION_semirings #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, 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 #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, 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 lawsToTest (Laws name props) = testGroup name $ map (uncurry testProperty) props instance KnownNat m => Arbitrary (Mod m) where arbitrary = oneof [arbitraryBoundedEnum, negate <$> arbitraryBoundedEnum, fromInteger <$> arbitrary] shrink = map fromInteger . shrink . toInteger . unMod instance KnownNat m => Arbitrary (Word.Mod m) where arbitrary = oneof [arbitraryBoundedEnum, negate <$> arbitraryBoundedEnum, fromInteger <$> arbitrary] shrink = map fromIntegral . shrink . Word.unMod ------------------------------------------------------------------------------- -- fromInteger fromIntegerRandomProp :: Positive Integer -> Integer -> Property fromIntegerRandomProp (Positive m) n = m > 1 ==> case someNatVal (fromInteger m) of SomeNat p -> fromIntegerProp p n fromIntegerProp :: forall m. KnownNat m => Proxy m -> Integer -> Property fromIntegerProp p n = unMod m === fromInteger (n `mod` toInteger (natVal p)) where m :: Mod m m = fromInteger n fromIntegerWordRandomProp :: Word -> Integer -> Property fromIntegerWordRandomProp m n = m > 1 ==> case someNatVal (fromIntegral m) of SomeNat p -> fromIntegerWordProp p n fromIntegerWordProp :: forall m. KnownNat m => Proxy m -> Integer -> Property fromIntegerWordProp p n = Word.unMod m === fromInteger (n `mod` toInteger (natVal p)) where m :: Word.Mod m m = fromInteger n ------------------------------------------------------------------------------- -- invertMod invertModRandomProp :: Positive Integer -> Integer -> Property invertModRandomProp (Positive m) n = m > 1 ==> case someNatVal (fromInteger m) of SomeNat (Proxy :: Proxy m) -> invertModProp (fromInteger n :: Mod m) invertModProp :: KnownNat m => Mod m -> Property invertModProp x = case invertMod x of Nothing -> g =/= 1 Just x' -> g === 1 .&&. x * x' === 1 .&&. x' * x === 1 .&&. x' === x ^% (-1 :: Int) where g = gcd (unMod x) (fromIntegral (natVal x)) invertModWordRandomProp :: Word -> Integer -> Property invertModWordRandomProp m n = m > 1 ==> case someNatVal (fromIntegral m) of SomeNat (Proxy :: Proxy m) -> invertModWordProp (fromInteger n :: Word.Mod m) invertModWordRandomPropNearMaxBound :: Word -> Integer -> Property invertModWordRandomPropNearMaxBound m n = m < maxBound ==> case someNatVal (fromIntegral (maxBound - m)) of SomeNat (Proxy :: Proxy m) -> invertModWordProp (fromInteger n :: Word.Mod m) invertModWordProp :: KnownNat m => Word.Mod m -> Property invertModWordProp x = case Word.invertMod x of Nothing -> g =/= 1 Just x' -> g === 1 .&&. x * x' === 1 .&&. x' * x === 1 .&&. x' === x Word.^% (-1 :: Int) where g = gcd (Word.unMod x) (fromIntegral (natVal x)) ------------------------------------------------------------------------------- -- powMod powModRandomProp :: Positive Integer -> Integer -> Int -> Property powModRandomProp (Positive m) x n = m > 1 ==> case someNatVal (fromInteger m) of SomeNat (Proxy :: Proxy m) -> powModProp (fromInteger x :: Mod m) n powModProp :: KnownNat m => Mod m -> Int -> Property powModProp x n | n >= 0 = x ^% n === getProduct (stimes n (Product x)) | otherwise = case invertMod x of Nothing -> property True Just x' -> x ^% n === getProduct (stimes (-n) (Product x')) powModRandomAdditiveProp :: Positive Integer -> Integer -> Huge Integer -> Huge Integer -> Property powModRandomAdditiveProp (Positive m) x (Huge n1) (Huge n2) = m > 1 ==> case someNatVal (fromInteger m) of SomeNat (Proxy :: Proxy m) -> powModAdditiveProp (fromInteger x :: Mod m) n1 n2 powModAdditiveProp :: KnownNat m => Mod m -> Integer -> Integer -> Property powModAdditiveProp x n1 n2 | invertMod x == Nothing, n1 < 0 || n2 < 0 = property True | otherwise = (x ^% n1) * (x ^% n2) === x ^% (n1 + n2) powModCase :: Property powModCase = once $ 0 ^% n === (0 :: Mod 2) where n = 1 `shiftL` 64 :: Integer powModWordRandomProp :: Word -> Integer -> Int -> Property powModWordRandomProp m x k = m > 1 ==> case someNatVal (fromIntegral m) of SomeNat (Proxy :: Proxy m) -> powModWordProp (fromInteger x :: Word.Mod m) k powModWordProp :: KnownNat m => Word.Mod m -> Int -> Property powModWordProp x n | n >= 0 = x Word.^% n === getProduct (stimes n (Product x)) | otherwise = case Word.invertMod x of Nothing -> property True Just x' -> x Word.^% n === getProduct (stimes (-n) (Product x')) powModWordRandomAdditiveProp :: Word -> Integer -> Huge Integer -> Huge Integer -> Property powModWordRandomAdditiveProp m x (Huge n1) (Huge n2) = m > 1 ==> case someNatVal (fromIntegral m) of SomeNat (Proxy :: Proxy m) -> powModWordAdditiveProp (fromInteger x :: Word.Mod m) n1 n2 powModWordAdditiveProp :: KnownNat m => Word.Mod m -> Integer -> Integer -> Property powModWordAdditiveProp x n1 n2 | Word.invertMod x == Nothing, n1 < 0 || n2 < 0 = property True | otherwise = (x Word.^% n1) * (x Word.^% n2) === x Word.^% (n1 + n2) powModWordCase :: Property powModWordCase = once $ 0 Word.^% n === (0 :: Word.Mod 2) where n = 1 `shiftL` 64 :: Integer newtype Huge a = Huge { _getHuge :: a } deriving (Show) instance (Bits a, Num a, Arbitrary a) => Arbitrary (Huge a) where arbitrary = do Positive l <- arbitrary ds <- vector l return $ Huge $ foldl1 (\acc n -> acc `shiftL` 63 + n) ds shrink (Huge n) = Huge <$> shrink n ------------------------------------------------------------------------------- -- DivideByZero isDivideByZero :: Mod 0 -> Property isDivideByZero x = ioProperty ((=== Left DivideByZero) <$> try (evaluate x)) isDivideByZeroWord :: Word.Mod 0 -> Property isDivideByZeroWord x = ioProperty ((=== Left DivideByZero) <$> try (evaluate x)) ------------------------------------------------------------------------------- -- Ideals #ifdef MIN_VERSION_semirings dividePropRandom :: Positive (Small Integer) -> Positive Integer -> Positive Integer -> Property dividePropRandom (Positive (Small m)) (Positive x) (Positive y) = case someNatVal (fromInteger m) of SomeNat (Proxy :: Proxy m) -> divideProp (fromInteger x :: Mod m) (fromInteger y) divideProp :: KnownNat m => Mod m -> Mod m -> Property divideProp x y = case E.divide x y of Just z -> x === y * z Nothing -> filter ((== x) . (* y)) [minBound .. maxBound] === [] gcdIsPrincipalIdealRandom :: Positive (Small Integer) -> Integer -> Integer -> Property gcdIsPrincipalIdealRandom (Positive (Small m)) x y = case someNatVal (fromInteger m) of SomeNat (Proxy :: Proxy m) -> gcdIsPrincipalIdeal (fromInteger x :: Mod m) (fromInteger y) gcdIsPrincipalIdeal :: KnownNat m => Mod m -> Mod m -> Property gcdIsPrincipalIdeal x y = addIdeals (genIdeal x) (genIdeal y) === genIdeal (E.gcd x y) where genIdeal t = S.fromList $ map (* t) [minBound .. maxBound] addIdeals us vs = S.fromList [ u + v | u <- S.toList us, v <- S.toList vs ] lcmIsIntersectionOfIdealsRandom :: Positive (Small Integer) -> Integer -> Integer -> Property lcmIsIntersectionOfIdealsRandom (Positive (Small m)) x y = case someNatVal (fromInteger m) of SomeNat (Proxy :: Proxy m) -> lcmIsIntersectionOfIdeals (fromInteger x :: Mod m) (fromInteger y) lcmIsIntersectionOfIdeals :: KnownNat m => Mod m -> Mod m -> Property lcmIsIntersectionOfIdeals x y = S.intersection (genIdeal x) (genIdeal y) === genIdeal (E.lcm x y) where genIdeal t = S.fromList $ map (* t) [minBound .. maxBound] coprimeGeneratorsRandom :: Positive (Small Integer) -> Integer -> Integer -> Property coprimeGeneratorsRandom (Positive (Small m)) x y = case someNatVal (fromInteger m) of SomeNat (Proxy :: Proxy m) -> coprimeGenerators (fromInteger x :: Mod m) (fromInteger y) coprimeGenerators :: KnownNat m => Mod m -> Mod m -> Property coprimeGenerators x y = E.coprime x y === (addIdeals (genIdeal x) (genIdeal y) == S.fromList [minBound .. maxBound]) where genIdeal t = S.fromList $ map (* t) [minBound .. maxBound] addIdeals us vs = S.fromList [ u + v | u <- S.toList us, v <- S.toList vs ] quotRemPropRandom :: Positive (Small Integer) -> Positive Integer -> Positive Integer -> Property quotRemPropRandom (Positive (Small m)) (Positive x) (Positive y) = case someNatVal (fromInteger m) of SomeNat (Proxy :: Proxy m) -> quotRemProp (fromInteger x :: Mod m) (fromInteger y) quotRemProp :: KnownNat m => Mod m -> Mod m -> Property quotRemProp x y = case E.divide x y of Just z -> E.quotRem x y === (z, 0) Nothing -> y /= 0 ==> let (q, r) = E.quotRem x y in counterexample (show (q, r)) $ x === q * y + r degreePropRandom :: Positive (Small Integer) -> Positive Integer -> Positive Integer -> Property degreePropRandom (Positive (Small m)) (Positive x) (Positive y) = case someNatVal (fromInteger m) of SomeNat (Proxy :: Proxy m) -> degreeProp (fromInteger x :: Mod m) (fromInteger y) degreeProp :: KnownNat m => Mod m -> Mod m -> Property degreeProp x y = ioProperty $ do ret <- try (evaluate (E.quotRem x y)) pure $ case ret of Left DivideByZero -> property True Left{} -> property False Right (_, r) -> r === 0 .||. property (E.degree r < E.degree y) divideWordPropRandom :: Positive Word -> Word -> Word -> Property divideWordPropRandom (Positive m) x y = case someNatVal (fromIntegral m) of SomeNat (Proxy :: Proxy m) -> divideWordProp (fromIntegral x :: Word.Mod m) (fromIntegral y) divideWordProp :: KnownNat m => Word.Mod m -> Word.Mod m -> Property divideWordProp x y = case E.divide x y of Just z -> x === y * z Nothing -> filter ((== x) . (* y)) [minBound .. maxBound] === [] gcdIsPrincipalIdealWordRandom :: Positive Word -> Word -> Word -> Property gcdIsPrincipalIdealWordRandom (Positive m) x y = case someNatVal (fromIntegral m) of SomeNat (Proxy :: Proxy m) -> gcdIsPrincipalIdealWord (fromIntegral x :: Word.Mod m) (fromIntegral y) gcdIsPrincipalIdealWord :: KnownNat m => Word.Mod m -> Word.Mod m -> Property gcdIsPrincipalIdealWord x y = addIdeals (genIdeal x) (genIdeal y) === genIdeal (E.gcd x y) where genIdeal t = S.fromList $ map (* t) [minBound .. maxBound] addIdeals us vs = S.fromList [ u + v | u <- S.toList us, v <- S.toList vs ] lcmIsIntersectionOfIdealsWordRandom :: Positive Word -> Word -> Word -> Property lcmIsIntersectionOfIdealsWordRandom (Positive m) x y = case someNatVal (fromIntegral m) of SomeNat (Proxy :: Proxy m) -> lcmIsIntersectionOfIdealsWord (fromIntegral x :: Word.Mod m) (fromIntegral y) lcmIsIntersectionOfIdealsWord :: KnownNat m => Word.Mod m -> Word.Mod m -> Property lcmIsIntersectionOfIdealsWord x y = S.intersection (genIdeal x) (genIdeal y) === genIdeal (E.lcm x y) where genIdeal t = S.fromList $ map (* t) [minBound .. maxBound] coprimeGeneratorsWordRandom :: Positive Word -> Word -> Word -> Property coprimeGeneratorsWordRandom (Positive m) x y = case someNatVal (fromIntegral m) of SomeNat (Proxy :: Proxy m) -> coprimeGeneratorsWord (fromIntegral x :: Word.Mod m) (fromIntegral y) coprimeGeneratorsWord :: KnownNat m => Word.Mod m -> Word.Mod m -> Property coprimeGeneratorsWord x y = E.coprime x y === (addIdeals (genIdeal x) (genIdeal y) == S.fromList [minBound .. maxBound]) where genIdeal t = S.fromList $ map (* t) [minBound .. maxBound] addIdeals us vs = S.fromList [ u + v | u <- S.toList us, v <- S.toList vs ] quotRemWordPropRandom :: Positive Word -> Word -> Word -> Property quotRemWordPropRandom (Positive m) x y = case someNatVal (fromIntegral m) of SomeNat (Proxy :: Proxy m) -> quotRemWordProp (fromIntegral x :: Word.Mod m) (fromIntegral y) quotRemWordProp :: KnownNat m => Word.Mod m -> Word.Mod m -> Property quotRemWordProp x y = case E.divide x y of Just z -> E.quotRem x y === (z, 0) Nothing -> y /= 0 ==> let (q, r) = E.quotRem x y in counterexample (show (q, r)) $ x === q * y + r degreeWordPropRandom :: Positive Word -> Word -> Word -> Property degreeWordPropRandom (Positive m) x y = case someNatVal (fromIntegral m) of SomeNat (Proxy :: Proxy m) -> degreeWordProp (fromIntegral x :: Word.Mod m) (fromIntegral y) degreeWordProp :: KnownNat m => Word.Mod m -> Word.Mod m -> Property degreeWordProp x y = ioProperty $ do ret <- try (evaluate (E.quotRem x y)) pure $ case ret of Left DivideByZero -> property True Left{} -> property False Right (_, r) -> r === 0 .||. property (E.degree r < E.degree y) #endif