{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE DefaultSignatures #-}
module Basement.Numerical.Multiplicative
( Multiplicative(..)
, IDivisible(..)
, Divisible(..)
, recip
) where
import Basement.Compat.Base
import Basement.Compat.C.Types
import Basement.Compat.Natural
import Basement.Compat.NumLiteral
import Basement.Numerical.Number
import Basement.Numerical.Additive
import Basement.Types.Word128 (Word128)
import Basement.Types.Word256 (Word256)
import qualified Basement.Types.Word128 as Word128
import qualified Basement.Types.Word256 as Word256
import qualified Prelude
class Multiplicative a where
{-# MINIMAL midentity, (*) #-}
midentity :: a
(*) :: a -> a -> a
(^) :: (IsNatural n, Enum n, IDivisible n) => a -> n -> a
(^) = forall n a.
(Enum n, IsNatural n, IDivisible n, Multiplicative a) =>
a -> n -> a
power
class (Additive a, Multiplicative a) => IDivisible a where
{-# MINIMAL (div, mod) | divMod #-}
div :: a -> a -> a
div a
a a
b = forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. IDivisible a => a -> a -> (a, a)
divMod a
a a
b
mod :: a -> a -> a
mod a
a a
b = forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a. IDivisible a => a -> a -> (a, a)
divMod a
a a
b
divMod :: a -> a -> (a, a)
divMod a
a a
b = (forall a. IDivisible a => a -> a -> a
div a
a a
b, forall a. IDivisible a => a -> a -> a
mod a
a a
b)
class Multiplicative a => Divisible a where
{-# MINIMAL (/) #-}
(/) :: a -> a -> a
infixl 7 *, /
infixr 8 ^
instance Multiplicative Integer where
midentity :: Integer
midentity = Integer
1
* :: Integer -> Integer -> Integer
(*) = forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative Int where
midentity :: Int
midentity = Int
1
* :: Int -> Int -> Int
(*) = forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative Int8 where
midentity :: Int8
midentity = Int8
1
* :: Int8 -> Int8 -> Int8
(*) = forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative Int16 where
midentity :: Int16
midentity = Int16
1
* :: Int16 -> Int16 -> Int16
(*) = forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative Int32 where
midentity :: Int32
midentity = Int32
1
* :: Int32 -> Int32 -> Int32
(*) = forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative Int64 where
midentity :: Int64
midentity = Int64
1
* :: Int64 -> Int64 -> Int64
(*) = forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative Natural where
midentity :: Natural
midentity = Natural
1
* :: Natural -> Natural -> Natural
(*) = forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative Word where
midentity :: Word
midentity = Word
1
* :: Word -> Word -> Word
(*) = forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative Word8 where
midentity :: Word8
midentity = Word8
1
* :: Word8 -> Word8 -> Word8
(*) = forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative Word16 where
midentity :: Word16
midentity = Word16
1
* :: Word16 -> Word16 -> Word16
(*) = forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative Word32 where
midentity :: Word32
midentity = Word32
1
* :: Word32 -> Word32 -> Word32
(*) = forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative Word64 where
midentity :: Word64
midentity = Word64
1
* :: Word64 -> Word64 -> Word64
(*) = forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative Word128 where
midentity :: Word128
midentity = Word128
1
* :: Word128 -> Word128 -> Word128
(*) = Word128 -> Word128 -> Word128
(Word128.*)
instance Multiplicative Word256 where
midentity :: Word256
midentity = Word256
1
* :: Word256 -> Word256 -> Word256
(*) = Word256 -> Word256 -> Word256
(Word256.*)
instance Multiplicative Prelude.Float where
midentity :: Float
midentity = Float
1.0
* :: Float -> Float -> Float
(*) = forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative Prelude.Double where
midentity :: Double
midentity = Double
1.0
* :: Double -> Double -> Double
(*) = forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative Prelude.Rational where
midentity :: Rational
midentity = Rational
1.0
* :: Rational -> Rational -> Rational
(*) = forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative CChar where
midentity :: CChar
midentity = CChar
1
* :: CChar -> CChar -> CChar
(*) = forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative CSChar where
midentity :: CSChar
midentity = CSChar
1
* :: CSChar -> CSChar -> CSChar
(*) = forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative CUChar where
midentity :: CUChar
midentity = CUChar
1
* :: CUChar -> CUChar -> CUChar
(*) = forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative CShort where
midentity :: CShort
midentity = CShort
1
* :: CShort -> CShort -> CShort
(*) = forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative CUShort where
midentity :: CUShort
midentity = CUShort
1
* :: CUShort -> CUShort -> CUShort
(*) = forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative CInt where
midentity :: CInt
midentity = CInt
1
* :: CInt -> CInt -> CInt
(*) = forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative CUInt where
midentity :: CUInt
midentity = CUInt
1
* :: CUInt -> CUInt -> CUInt
(*) = forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative CLong where
midentity :: CLong
midentity = CLong
1
* :: CLong -> CLong -> CLong
(*) = forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative CULong where
midentity :: CULong
midentity = CULong
1
* :: CULong -> CULong -> CULong
(*) = forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative CPtrdiff where
midentity :: CPtrdiff
midentity = CPtrdiff
1
* :: CPtrdiff -> CPtrdiff -> CPtrdiff
(*) = forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative CSize where
midentity :: CSize
midentity = CSize
1
* :: CSize -> CSize -> CSize
(*) = forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative CWchar where
midentity :: CWchar
midentity = CWchar
1
* :: CWchar -> CWchar -> CWchar
(*) = forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative CSigAtomic where
midentity :: CSigAtomic
midentity = CSigAtomic
1
* :: CSigAtomic -> CSigAtomic -> CSigAtomic
(*) = forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative CLLong where
midentity :: CLLong
midentity = CLLong
1
* :: CLLong -> CLLong -> CLLong
(*) = forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative CULLong where
midentity :: CULLong
midentity = CULLong
1
* :: CULLong -> CULLong -> CULLong
(*) = forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative CIntPtr where
midentity :: CIntPtr
midentity = CIntPtr
1
* :: CIntPtr -> CIntPtr -> CIntPtr
(*) = forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative CUIntPtr where
midentity :: CUIntPtr
midentity = CUIntPtr
1
* :: CUIntPtr -> CUIntPtr -> CUIntPtr
(*) = forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative CIntMax where
midentity :: CIntMax
midentity = CIntMax
1
* :: CIntMax -> CIntMax -> CIntMax
(*) = forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative CUIntMax where
midentity :: CUIntMax
midentity = CUIntMax
1
* :: CUIntMax -> CUIntMax -> CUIntMax
(*) = forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative CClock where
midentity :: CClock
midentity = CClock
1
* :: CClock -> CClock -> CClock
(*) = forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative CTime where
midentity :: CTime
midentity = CTime
1
* :: CTime -> CTime -> CTime
(*) = forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative CUSeconds where
midentity :: CUSeconds
midentity = CUSeconds
1
* :: CUSeconds -> CUSeconds -> CUSeconds
(*) = forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative CSUSeconds where
midentity :: CSUSeconds
midentity = CSUSeconds
1
* :: CSUSeconds -> CSUSeconds -> CSUSeconds
(*) = forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative COff where
midentity :: COff
midentity = COff
1
* :: COff -> COff -> COff
(*) = forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative CFloat where
midentity :: CFloat
midentity = CFloat
1.0
* :: CFloat -> CFloat -> CFloat
(*) = forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative CDouble where
midentity :: CDouble
midentity = CDouble
1.0
* :: CDouble -> CDouble -> CDouble
(*) = forall a. Num a => a -> a -> a
(Prelude.*)
instance IDivisible Integer where
div :: Integer -> Integer -> Integer
div = forall a. Integral a => a -> a -> a
Prelude.div
mod :: Integer -> Integer -> Integer
mod = forall a. Integral a => a -> a -> a
Prelude.mod
instance IDivisible Int where
div :: Int -> Int -> Int
div = forall a. Integral a => a -> a -> a
Prelude.div
mod :: Int -> Int -> Int
mod = forall a. Integral a => a -> a -> a
Prelude.mod
instance IDivisible Int8 where
div :: Int8 -> Int8 -> Int8
div = forall a. Integral a => a -> a -> a
Prelude.div
mod :: Int8 -> Int8 -> Int8
mod = forall a. Integral a => a -> a -> a
Prelude.mod
instance IDivisible Int16 where
div :: Int16 -> Int16 -> Int16
div = forall a. Integral a => a -> a -> a
Prelude.div
mod :: Int16 -> Int16 -> Int16
mod = forall a. Integral a => a -> a -> a
Prelude.mod
instance IDivisible Int32 where
div :: Int32 -> Int32 -> Int32
div = forall a. Integral a => a -> a -> a
Prelude.div
mod :: Int32 -> Int32 -> Int32
mod = forall a. Integral a => a -> a -> a
Prelude.mod
instance IDivisible Int64 where
div :: Int64 -> Int64 -> Int64
div = forall a. Integral a => a -> a -> a
Prelude.div
mod :: Int64 -> Int64 -> Int64
mod = forall a. Integral a => a -> a -> a
Prelude.mod
instance IDivisible Natural where
div :: Natural -> Natural -> Natural
div = forall a. Integral a => a -> a -> a
Prelude.quot
mod :: Natural -> Natural -> Natural
mod = forall a. Integral a => a -> a -> a
Prelude.rem
instance IDivisible Word where
div :: Word -> Word -> Word
div = forall a. Integral a => a -> a -> a
Prelude.quot
mod :: Word -> Word -> Word
mod = forall a. Integral a => a -> a -> a
Prelude.rem
instance IDivisible Word8 where
div :: Word8 -> Word8 -> Word8
div = forall a. Integral a => a -> a -> a
Prelude.quot
mod :: Word8 -> Word8 -> Word8
mod = forall a. Integral a => a -> a -> a
Prelude.rem
instance IDivisible Word16 where
div :: Word16 -> Word16 -> Word16
div = forall a. Integral a => a -> a -> a
Prelude.quot
mod :: Word16 -> Word16 -> Word16
mod = forall a. Integral a => a -> a -> a
Prelude.rem
instance IDivisible Word32 where
div :: Word32 -> Word32 -> Word32
div = forall a. Integral a => a -> a -> a
Prelude.quot
mod :: Word32 -> Word32 -> Word32
mod = forall a. Integral a => a -> a -> a
Prelude.rem
instance IDivisible Word64 where
div :: Word64 -> Word64 -> Word64
div = forall a. Integral a => a -> a -> a
Prelude.quot
mod :: Word64 -> Word64 -> Word64
mod = forall a. Integral a => a -> a -> a
Prelude.rem
instance IDivisible Word128 where
div :: Word128 -> Word128 -> Word128
div = Word128 -> Word128 -> Word128
Word128.quot
mod :: Word128 -> Word128 -> Word128
mod = Word128 -> Word128 -> Word128
Word128.rem
instance IDivisible Word256 where
div :: Word256 -> Word256 -> Word256
div = Word256 -> Word256 -> Word256
Word256.quot
mod :: Word256 -> Word256 -> Word256
mod = Word256 -> Word256 -> Word256
Word256.rem
instance IDivisible CChar where
div :: CChar -> CChar -> CChar
div = forall a. Integral a => a -> a -> a
Prelude.quot
mod :: CChar -> CChar -> CChar
mod = forall a. Integral a => a -> a -> a
Prelude.rem
instance IDivisible CSChar where
div :: CSChar -> CSChar -> CSChar
div = forall a. Integral a => a -> a -> a
Prelude.quot
mod :: CSChar -> CSChar -> CSChar
mod = forall a. Integral a => a -> a -> a
Prelude.rem
instance IDivisible CUChar where
div :: CUChar -> CUChar -> CUChar
div = forall a. Integral a => a -> a -> a
Prelude.quot
mod :: CUChar -> CUChar -> CUChar
mod = forall a. Integral a => a -> a -> a
Prelude.rem
instance IDivisible CShort where
div :: CShort -> CShort -> CShort
div = forall a. Integral a => a -> a -> a
Prelude.quot
mod :: CShort -> CShort -> CShort
mod = forall a. Integral a => a -> a -> a
Prelude.rem
instance IDivisible CUShort where
div :: CUShort -> CUShort -> CUShort
div = forall a. Integral a => a -> a -> a
Prelude.quot
mod :: CUShort -> CUShort -> CUShort
mod = forall a. Integral a => a -> a -> a
Prelude.rem
instance IDivisible CInt where
div :: CInt -> CInt -> CInt
div = forall a. Integral a => a -> a -> a
Prelude.quot
mod :: CInt -> CInt -> CInt
mod = forall a. Integral a => a -> a -> a
Prelude.rem
instance IDivisible CUInt where
div :: CUInt -> CUInt -> CUInt
div = forall a. Integral a => a -> a -> a
Prelude.quot
mod :: CUInt -> CUInt -> CUInt
mod = forall a. Integral a => a -> a -> a
Prelude.rem
instance IDivisible CLong where
div :: CLong -> CLong -> CLong
div = forall a. Integral a => a -> a -> a
Prelude.quot
mod :: CLong -> CLong -> CLong
mod = forall a. Integral a => a -> a -> a
Prelude.rem
instance IDivisible CULong where
div :: CULong -> CULong -> CULong
div = forall a. Integral a => a -> a -> a
Prelude.quot
mod :: CULong -> CULong -> CULong
mod = forall a. Integral a => a -> a -> a
Prelude.rem
instance IDivisible CPtrdiff where
div :: CPtrdiff -> CPtrdiff -> CPtrdiff
div = forall a. Integral a => a -> a -> a
Prelude.quot
mod :: CPtrdiff -> CPtrdiff -> CPtrdiff
mod = forall a. Integral a => a -> a -> a
Prelude.rem
instance IDivisible CSize where
div :: CSize -> CSize -> CSize
div = forall a. Integral a => a -> a -> a
Prelude.quot
mod :: CSize -> CSize -> CSize
mod = forall a. Integral a => a -> a -> a
Prelude.rem
instance IDivisible CWchar where
div :: CWchar -> CWchar -> CWchar
div = forall a. Integral a => a -> a -> a
Prelude.quot
mod :: CWchar -> CWchar -> CWchar
mod = forall a. Integral a => a -> a -> a
Prelude.rem
instance IDivisible CSigAtomic where
div :: CSigAtomic -> CSigAtomic -> CSigAtomic
div = forall a. Integral a => a -> a -> a
Prelude.quot
mod :: CSigAtomic -> CSigAtomic -> CSigAtomic
mod = forall a. Integral a => a -> a -> a
Prelude.rem
instance IDivisible CLLong where
div :: CLLong -> CLLong -> CLLong
div = forall a. Integral a => a -> a -> a
Prelude.quot
mod :: CLLong -> CLLong -> CLLong
mod = forall a. Integral a => a -> a -> a
Prelude.rem
instance IDivisible CULLong where
div :: CULLong -> CULLong -> CULLong
div = forall a. Integral a => a -> a -> a
Prelude.quot
mod :: CULLong -> CULLong -> CULLong
mod = forall a. Integral a => a -> a -> a
Prelude.rem
instance IDivisible CIntPtr where
div :: CIntPtr -> CIntPtr -> CIntPtr
div = forall a. Integral a => a -> a -> a
Prelude.quot
mod :: CIntPtr -> CIntPtr -> CIntPtr
mod = forall a. Integral a => a -> a -> a
Prelude.rem
instance IDivisible CUIntPtr where
div :: CUIntPtr -> CUIntPtr -> CUIntPtr
div = forall a. Integral a => a -> a -> a
Prelude.quot
mod :: CUIntPtr -> CUIntPtr -> CUIntPtr
mod = forall a. Integral a => a -> a -> a
Prelude.rem
instance IDivisible CIntMax where
div :: CIntMax -> CIntMax -> CIntMax
div = forall a. Integral a => a -> a -> a
Prelude.quot
mod :: CIntMax -> CIntMax -> CIntMax
mod = forall a. Integral a => a -> a -> a
Prelude.rem
instance IDivisible CUIntMax where
div :: CUIntMax -> CUIntMax -> CUIntMax
div = forall a. Integral a => a -> a -> a
Prelude.quot
mod :: CUIntMax -> CUIntMax -> CUIntMax
mod = forall a. Integral a => a -> a -> a
Prelude.rem
instance Divisible Prelude.Rational where
/ :: Rational -> Rational -> Rational
(/) = forall a. Fractional a => a -> a -> a
(Prelude./)
instance Divisible Float where
/ :: Float -> Float -> Float
(/) = forall a. Fractional a => a -> a -> a
(Prelude./)
instance Divisible Double where
/ :: Double -> Double -> Double
(/) = forall a. Fractional a => a -> a -> a
(Prelude./)
instance Divisible CFloat where
/ :: CFloat -> CFloat -> CFloat
(/) = forall a. Fractional a => a -> a -> a
(Prelude./)
instance Divisible CDouble where
/ :: CDouble -> CDouble -> CDouble
(/) = forall a. Fractional a => a -> a -> a
(Prelude./)
recip :: Divisible a => a -> a
recip :: forall a. Divisible a => a -> a
recip a
x = forall a. Multiplicative a => a
midentity forall a. Divisible a => a -> a -> a
/ a
x
power :: (Enum n, IsNatural n, IDivisible n, Multiplicative a) => a -> n -> a
power :: forall n a.
(Enum n, IsNatural n, IDivisible n, Multiplicative a) =>
a -> n -> a
power a
a n
n
| n
n forall a. Eq a => a -> a -> Bool
== n
0 = forall a. Multiplicative a => a
midentity
| Bool
otherwise = forall {t} {t}.
(IDivisible t, IsIntegral t, Enum t, Multiplicative t) =>
t -> t -> t -> t
squaring forall a. Multiplicative a => a
midentity a
a n
n
where
squaring :: t -> t -> t -> t
squaring t
y t
x t
i
| t
i forall a. Eq a => a -> a -> Bool
== t
0 = t
y
| t
i forall a. Eq a => a -> a -> Bool
== t
1 = t
x forall a. Multiplicative a => a -> a -> a
* t
y
| forall n. (IDivisible n, IsIntegral n) => n -> Bool
even t
i = t -> t -> t -> t
squaring t
y (t
xforall a. Multiplicative a => a -> a -> a
*t
x) (t
iforall a. IDivisible a => a -> a -> a
`div`t
2)
| Bool
otherwise = t -> t -> t -> t
squaring (t
xforall a. Multiplicative a => a -> a -> a
*t
y) (t
xforall a. Multiplicative a => a -> a -> a
*t
x) (forall a. Enum a => a -> a
pred t
iforall a. IDivisible a => a -> a -> a
`div` t
2)
even :: (IDivisible n, IsIntegral n) => n -> Bool
even :: forall n. (IDivisible n, IsIntegral n) => n -> Bool
even n
n = (n
n forall a. IDivisible a => a -> a -> a
`mod` n
2) forall a. Eq a => a -> a -> Bool
== n
0