{-# 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

-- | Represent class of things that can be multiplied together
--
-- > x * midentity = x
-- > midentity * x = x
class Multiplicative a where
    {-# MINIMAL midentity, (*) #-}
    -- | Identity element over multiplication
    midentity :: a

    -- | Multiplication of 2 elements that result in another element
    (*) :: a -> a -> a

    -- | Raise to power, repeated multiplication
    -- e.g.
    -- > a ^ 2 = a * a
    -- > a ^ 10 = (a ^ 5) * (a ^ 5) ..
    --(^) :: (IsNatural n) => a -> n -> 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

-- | Represent types that supports an euclidian division
--
-- > (x ‘div‘ y) * y + (x ‘mod‘ y) == x
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)

-- | Support for division between same types
--
-- This is likely to change to represent specific mathematic divisions
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