{-# 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
    (^) = 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 = (a, a) -> a
forall a b. (a, b) -> a
fst ((a, a) -> a) -> (a, a) -> a
forall a b. (a -> b) -> a -> b
$ a -> a -> (a, a)
forall a. IDivisible a => a -> a -> (a, a)
divMod a
a a
b
    mod :: a -> a -> a
    mod a
a a
b = (a, a) -> a
forall a b. (a, b) -> b
snd ((a, a) -> a) -> (a, a) -> a
forall a b. (a -> b) -> a -> b
$ a -> a -> (a, a)
forall a. IDivisible a => a -> a -> (a, a)
divMod a
a a
b
    divMod :: a -> a -> (a, a)
    divMod a
a a
b = (a -> a -> a
forall a. IDivisible a => a -> a -> a
div a
a a
b, a -> a -> a
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
(*) = Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative Int where
    midentity :: Int
midentity = Int
1
    * :: Int -> Int -> Int
(*) = Int -> Int -> Int
forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative Int8 where
    midentity :: Int8
midentity = Int8
1
    * :: Int8 -> Int8 -> Int8
(*) = Int8 -> Int8 -> Int8
forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative Int16 where
    midentity :: Int16
midentity = Int16
1
    * :: Int16 -> Int16 -> Int16
(*) = Int16 -> Int16 -> Int16
forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative Int32 where
    midentity :: Int32
midentity = Int32
1
    * :: Int32 -> Int32 -> Int32
(*) = Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative Int64 where
    midentity :: Int64
midentity = Int64
1
    * :: Int64 -> Int64 -> Int64
(*) = Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative Natural where
    midentity :: Natural
midentity = Natural
1
    * :: Natural -> Natural -> Natural
(*) = Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative Word where
    midentity :: Word
midentity = Word
1
    * :: Word -> Word -> Word
(*) = Word -> Word -> Word
forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative Word8 where
    midentity :: Word8
midentity = Word8
1
    * :: Word8 -> Word8 -> Word8
(*) = Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative Word16 where
    midentity :: Word16
midentity = Word16
1
    * :: Word16 -> Word16 -> Word16
(*) = Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative Word32 where
    midentity :: Word32
midentity = Word32
1
    * :: Word32 -> Word32 -> Word32
(*) = Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative Word64 where
    midentity :: Word64
midentity = Word64
1
    * :: Word64 -> Word64 -> Word64
(*) = 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
(*) = 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
(*) = 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
(*) = Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
(Prelude.*)

instance Multiplicative CChar where
    midentity :: CChar
midentity = CChar
1
    * :: CChar -> CChar -> CChar
(*) = CChar -> CChar -> CChar
forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative CSChar where
    midentity :: CSChar
midentity = CSChar
1
    * :: CSChar -> CSChar -> CSChar
(*) = CSChar -> CSChar -> CSChar
forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative CUChar where
    midentity :: CUChar
midentity = CUChar
1
    * :: CUChar -> CUChar -> CUChar
(*) = CUChar -> CUChar -> CUChar
forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative CShort where
    midentity :: CShort
midentity = CShort
1
    * :: CShort -> CShort -> CShort
(*) = CShort -> CShort -> CShort
forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative CUShort where
    midentity :: CUShort
midentity = CUShort
1
    * :: CUShort -> CUShort -> CUShort
(*) = CUShort -> CUShort -> CUShort
forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative CInt where
    midentity :: CInt
midentity = CInt
1
    * :: CInt -> CInt -> CInt
(*) = CInt -> CInt -> CInt
forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative CUInt where
    midentity :: CUInt
midentity = CUInt
1
    * :: CUInt -> CUInt -> CUInt
(*) = CUInt -> CUInt -> CUInt
forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative CLong where
    midentity :: CLong
midentity = CLong
1
    * :: CLong -> CLong -> CLong
(*) = CLong -> CLong -> CLong
forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative CULong where
    midentity :: CULong
midentity = CULong
1
    * :: CULong -> CULong -> CULong
(*) = CULong -> CULong -> CULong
forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative CPtrdiff where
    midentity :: CPtrdiff
midentity = CPtrdiff
1
    * :: CPtrdiff -> CPtrdiff -> CPtrdiff
(*) = CPtrdiff -> CPtrdiff -> CPtrdiff
forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative CSize where
    midentity :: CSize
midentity = CSize
1
    * :: CSize -> CSize -> CSize
(*) = CSize -> CSize -> CSize
forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative CWchar where
    midentity :: CWchar
midentity = CWchar
1
    * :: CWchar -> CWchar -> CWchar
(*) = CWchar -> CWchar -> CWchar
forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative CSigAtomic where
    midentity :: CSigAtomic
midentity = CSigAtomic
1
    * :: CSigAtomic -> CSigAtomic -> CSigAtomic
(*) = CSigAtomic -> CSigAtomic -> CSigAtomic
forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative CLLong where
    midentity :: CLLong
midentity = CLLong
1
    * :: CLLong -> CLLong -> CLLong
(*) = CLLong -> CLLong -> CLLong
forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative CULLong where
    midentity :: CULLong
midentity = CULLong
1
    * :: CULLong -> CULLong -> CULLong
(*) = CULLong -> CULLong -> CULLong
forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative CIntPtr where
    midentity :: CIntPtr
midentity = CIntPtr
1
    * :: CIntPtr -> CIntPtr -> CIntPtr
(*) = CIntPtr -> CIntPtr -> CIntPtr
forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative CUIntPtr where
    midentity :: CUIntPtr
midentity = CUIntPtr
1
    * :: CUIntPtr -> CUIntPtr -> CUIntPtr
(*) = CUIntPtr -> CUIntPtr -> CUIntPtr
forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative CIntMax where
    midentity :: CIntMax
midentity = CIntMax
1
    * :: CIntMax -> CIntMax -> CIntMax
(*) = CIntMax -> CIntMax -> CIntMax
forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative CUIntMax where
    midentity :: CUIntMax
midentity = CUIntMax
1
    * :: CUIntMax -> CUIntMax -> CUIntMax
(*) = CUIntMax -> CUIntMax -> CUIntMax
forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative CClock where
    midentity :: CClock
midentity = CClock
1
    * :: CClock -> CClock -> CClock
(*) = CClock -> CClock -> CClock
forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative CTime where
    midentity :: CTime
midentity = CTime
1
    * :: CTime -> CTime -> CTime
(*) = CTime -> CTime -> CTime
forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative CUSeconds where
    midentity :: CUSeconds
midentity = CUSeconds
1
    * :: CUSeconds -> CUSeconds -> CUSeconds
(*) = CUSeconds -> CUSeconds -> CUSeconds
forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative CSUSeconds where
    midentity :: CSUSeconds
midentity = CSUSeconds
1
    * :: CSUSeconds -> CSUSeconds -> CSUSeconds
(*) = CSUSeconds -> CSUSeconds -> CSUSeconds
forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative COff where
    midentity :: COff
midentity = COff
1
    * :: COff -> COff -> COff
(*) = COff -> COff -> COff
forall a. Num a => a -> a -> a
(Prelude.*)

instance Multiplicative CFloat where
    midentity :: CFloat
midentity = CFloat
1.0
    * :: CFloat -> CFloat -> CFloat
(*) = CFloat -> CFloat -> CFloat
forall a. Num a => a -> a -> a
(Prelude.*)
instance Multiplicative CDouble where
    midentity :: CDouble
midentity = CDouble
1.0
    * :: CDouble -> CDouble -> CDouble
(*) = CDouble -> CDouble -> CDouble
forall a. Num a => a -> a -> a
(Prelude.*)

instance IDivisible Integer where
    div :: Integer -> Integer -> Integer
div = Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
Prelude.div
    mod :: Integer -> Integer -> Integer
mod = Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
Prelude.mod
instance IDivisible Int where
    div :: Int -> Int -> Int
div = Int -> Int -> Int
forall a. Integral a => a -> a -> a
Prelude.div
    mod :: Int -> Int -> Int
mod = Int -> Int -> Int
forall a. Integral a => a -> a -> a
Prelude.mod
instance IDivisible Int8 where
    div :: Int8 -> Int8 -> Int8
div = Int8 -> Int8 -> Int8
forall a. Integral a => a -> a -> a
Prelude.div
    mod :: Int8 -> Int8 -> Int8
mod = Int8 -> Int8 -> Int8
forall a. Integral a => a -> a -> a
Prelude.mod
instance IDivisible Int16 where
    div :: Int16 -> Int16 -> Int16
div = Int16 -> Int16 -> Int16
forall a. Integral a => a -> a -> a
Prelude.div
    mod :: Int16 -> Int16 -> Int16
mod = Int16 -> Int16 -> Int16
forall a. Integral a => a -> a -> a
Prelude.mod
instance IDivisible Int32 where
    div :: Int32 -> Int32 -> Int32
div = Int32 -> Int32 -> Int32
forall a. Integral a => a -> a -> a
Prelude.div
    mod :: Int32 -> Int32 -> Int32
mod = Int32 -> Int32 -> Int32
forall a. Integral a => a -> a -> a
Prelude.mod
instance IDivisible Int64 where
    div :: Int64 -> Int64 -> Int64
div = Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
Prelude.div
    mod :: Int64 -> Int64 -> Int64
mod = Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
Prelude.mod
instance IDivisible Natural where
    div :: Natural -> Natural -> Natural
div = Natural -> Natural -> Natural
forall a. Integral a => a -> a -> a
Prelude.quot
    mod :: Natural -> Natural -> Natural
mod = Natural -> Natural -> Natural
forall a. Integral a => a -> a -> a
Prelude.rem
instance IDivisible Word where
    div :: Word -> Word -> Word
div = Word -> Word -> Word
forall a. Integral a => a -> a -> a
Prelude.quot
    mod :: Word -> Word -> Word
mod = Word -> Word -> Word
forall a. Integral a => a -> a -> a
Prelude.rem
instance IDivisible Word8 where
    div :: Word8 -> Word8 -> Word8
div = Word8 -> Word8 -> Word8
forall a. Integral a => a -> a -> a
Prelude.quot
    mod :: Word8 -> Word8 -> Word8
mod = Word8 -> Word8 -> Word8
forall a. Integral a => a -> a -> a
Prelude.rem
instance IDivisible Word16 where
    div :: Word16 -> Word16 -> Word16
div = Word16 -> Word16 -> Word16
forall a. Integral a => a -> a -> a
Prelude.quot
    mod :: Word16 -> Word16 -> Word16
mod = Word16 -> Word16 -> Word16
forall a. Integral a => a -> a -> a
Prelude.rem
instance IDivisible Word32 where
    div :: Word32 -> Word32 -> Word32
div = Word32 -> Word32 -> Word32
forall a. Integral a => a -> a -> a
Prelude.quot
    mod :: Word32 -> Word32 -> Word32
mod = Word32 -> Word32 -> Word32
forall a. Integral a => a -> a -> a
Prelude.rem
instance IDivisible Word64 where
    div :: Word64 -> Word64 -> Word64
div = Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
Prelude.quot
    mod :: Word64 -> Word64 -> Word64
mod = Word64 -> Word64 -> Word64
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 = CChar -> CChar -> CChar
forall a. Integral a => a -> a -> a
Prelude.quot
    mod :: CChar -> CChar -> CChar
mod = CChar -> CChar -> CChar
forall a. Integral a => a -> a -> a
Prelude.rem
instance IDivisible CSChar where
    div :: CSChar -> CSChar -> CSChar
div = CSChar -> CSChar -> CSChar
forall a. Integral a => a -> a -> a
Prelude.quot
    mod :: CSChar -> CSChar -> CSChar
mod = CSChar -> CSChar -> CSChar
forall a. Integral a => a -> a -> a
Prelude.rem
instance IDivisible CUChar where
    div :: CUChar -> CUChar -> CUChar
div = CUChar -> CUChar -> CUChar
forall a. Integral a => a -> a -> a
Prelude.quot
    mod :: CUChar -> CUChar -> CUChar
mod = CUChar -> CUChar -> CUChar
forall a. Integral a => a -> a -> a
Prelude.rem
instance IDivisible CShort where
    div :: CShort -> CShort -> CShort
div = CShort -> CShort -> CShort
forall a. Integral a => a -> a -> a
Prelude.quot
    mod :: CShort -> CShort -> CShort
mod = CShort -> CShort -> CShort
forall a. Integral a => a -> a -> a
Prelude.rem
instance IDivisible CUShort where
    div :: CUShort -> CUShort -> CUShort
div = CUShort -> CUShort -> CUShort
forall a. Integral a => a -> a -> a
Prelude.quot
    mod :: CUShort -> CUShort -> CUShort
mod = CUShort -> CUShort -> CUShort
forall a. Integral a => a -> a -> a
Prelude.rem
instance IDivisible CInt where
    div :: CInt -> CInt -> CInt
div = CInt -> CInt -> CInt
forall a. Integral a => a -> a -> a
Prelude.quot
    mod :: CInt -> CInt -> CInt
mod = CInt -> CInt -> CInt
forall a. Integral a => a -> a -> a
Prelude.rem
instance IDivisible CUInt where
    div :: CUInt -> CUInt -> CUInt
div = CUInt -> CUInt -> CUInt
forall a. Integral a => a -> a -> a
Prelude.quot
    mod :: CUInt -> CUInt -> CUInt
mod = CUInt -> CUInt -> CUInt
forall a. Integral a => a -> a -> a
Prelude.rem
instance IDivisible CLong where
    div :: CLong -> CLong -> CLong
div = CLong -> CLong -> CLong
forall a. Integral a => a -> a -> a
Prelude.quot
    mod :: CLong -> CLong -> CLong
mod = CLong -> CLong -> CLong
forall a. Integral a => a -> a -> a
Prelude.rem
instance IDivisible CULong where
    div :: CULong -> CULong -> CULong
div = CULong -> CULong -> CULong
forall a. Integral a => a -> a -> a
Prelude.quot
    mod :: CULong -> CULong -> CULong
mod = CULong -> CULong -> CULong
forall a. Integral a => a -> a -> a
Prelude.rem
instance IDivisible CPtrdiff where
    div :: CPtrdiff -> CPtrdiff -> CPtrdiff
div = CPtrdiff -> CPtrdiff -> CPtrdiff
forall a. Integral a => a -> a -> a
Prelude.quot
    mod :: CPtrdiff -> CPtrdiff -> CPtrdiff
mod = CPtrdiff -> CPtrdiff -> CPtrdiff
forall a. Integral a => a -> a -> a
Prelude.rem
instance IDivisible CSize where
    div :: CSize -> CSize -> CSize
div = CSize -> CSize -> CSize
forall a. Integral a => a -> a -> a
Prelude.quot
    mod :: CSize -> CSize -> CSize
mod = CSize -> CSize -> CSize
forall a. Integral a => a -> a -> a
Prelude.rem
instance IDivisible CWchar where
    div :: CWchar -> CWchar -> CWchar
div = CWchar -> CWchar -> CWchar
forall a. Integral a => a -> a -> a
Prelude.quot
    mod :: CWchar -> CWchar -> CWchar
mod = CWchar -> CWchar -> CWchar
forall a. Integral a => a -> a -> a
Prelude.rem
instance IDivisible CSigAtomic where
    div :: CSigAtomic -> CSigAtomic -> CSigAtomic
div = CSigAtomic -> CSigAtomic -> CSigAtomic
forall a. Integral a => a -> a -> a
Prelude.quot
    mod :: CSigAtomic -> CSigAtomic -> CSigAtomic
mod = CSigAtomic -> CSigAtomic -> CSigAtomic
forall a. Integral a => a -> a -> a
Prelude.rem
instance IDivisible CLLong where
    div :: CLLong -> CLLong -> CLLong
div = CLLong -> CLLong -> CLLong
forall a. Integral a => a -> a -> a
Prelude.quot
    mod :: CLLong -> CLLong -> CLLong
mod = CLLong -> CLLong -> CLLong
forall a. Integral a => a -> a -> a
Prelude.rem
instance IDivisible CULLong where
    div :: CULLong -> CULLong -> CULLong
div = CULLong -> CULLong -> CULLong
forall a. Integral a => a -> a -> a
Prelude.quot
    mod :: CULLong -> CULLong -> CULLong
mod = CULLong -> CULLong -> CULLong
forall a. Integral a => a -> a -> a
Prelude.rem
instance IDivisible CIntPtr where
    div :: CIntPtr -> CIntPtr -> CIntPtr
div = CIntPtr -> CIntPtr -> CIntPtr
forall a. Integral a => a -> a -> a
Prelude.quot
    mod :: CIntPtr -> CIntPtr -> CIntPtr
mod = CIntPtr -> CIntPtr -> CIntPtr
forall a. Integral a => a -> a -> a
Prelude.rem
instance IDivisible CUIntPtr where
    div :: CUIntPtr -> CUIntPtr -> CUIntPtr
div = CUIntPtr -> CUIntPtr -> CUIntPtr
forall a. Integral a => a -> a -> a
Prelude.quot
    mod :: CUIntPtr -> CUIntPtr -> CUIntPtr
mod = CUIntPtr -> CUIntPtr -> CUIntPtr
forall a. Integral a => a -> a -> a
Prelude.rem
instance IDivisible CIntMax where
    div :: CIntMax -> CIntMax -> CIntMax
div = CIntMax -> CIntMax -> CIntMax
forall a. Integral a => a -> a -> a
Prelude.quot
    mod :: CIntMax -> CIntMax -> CIntMax
mod = CIntMax -> CIntMax -> CIntMax
forall a. Integral a => a -> a -> a
Prelude.rem
instance IDivisible CUIntMax where
    div :: CUIntMax -> CUIntMax -> CUIntMax
div = CUIntMax -> CUIntMax -> CUIntMax
forall a. Integral a => a -> a -> a
Prelude.quot
    mod :: CUIntMax -> CUIntMax -> CUIntMax
mod = CUIntMax -> CUIntMax -> CUIntMax
forall a. Integral a => a -> a -> a
Prelude.rem

instance Divisible Prelude.Rational where
    / :: Rational -> Rational -> Rational
(/) = Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
(Prelude./)
instance Divisible Float where
    / :: Float -> Float -> Float
(/) = Float -> Float -> Float
forall a. Fractional a => a -> a -> a
(Prelude./)
instance Divisible Double where
    / :: Double -> Double -> Double
(/) = Double -> Double -> Double
forall a. Fractional a => a -> a -> a
(Prelude./)

instance Divisible CFloat where
    / :: CFloat -> CFloat -> CFloat
(/) = CFloat -> CFloat -> CFloat
forall a. Fractional a => a -> a -> a
(Prelude./)
instance Divisible CDouble where
    / :: CDouble -> CDouble -> CDouble
(/) = CDouble -> CDouble -> CDouble
forall a. Fractional a => a -> a -> a
(Prelude./)

recip :: Divisible a => a -> a
recip :: a -> a
recip a
x = a
forall a. Multiplicative a => a
midentity a -> a -> a
forall a. Divisible a => a -> a -> a
/ a
x

power :: (Enum n, IsNatural n, IDivisible n, Multiplicative a) => a -> n -> a
power :: a -> n -> a
power a
a n
n
    | n
n n -> n -> Bool
forall a. Eq a => a -> a -> Bool
== n
0    = a
forall a. Multiplicative a => a
midentity
    | Bool
otherwise = a -> a -> n -> a
forall a a.
(IDivisible a, IsIntegral a, Enum a, Multiplicative a) =>
a -> a -> a -> a
squaring a
forall a. Multiplicative a => a
midentity a
a n
n
  where
    squaring :: a -> a -> a -> a
squaring a
y a
x a
i
        | a
i a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0    = a
y
        | a
i a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
1    = a
x a -> a -> a
forall a. Multiplicative a => a -> a -> a
* a
y
        | a -> Bool
forall n. (IDivisible n, IsIntegral n) => n -> Bool
even a
i    = a -> a -> a -> a
squaring a
y (a
xa -> a -> a
forall a. Multiplicative a => a -> a -> a
*a
x) (a
ia -> a -> a
forall a. IDivisible a => a -> a -> a
`div`a
2)
        | Bool
otherwise = a -> a -> a -> a
squaring (a
xa -> a -> a
forall a. Multiplicative a => a -> a -> a
*a
y) (a
xa -> a -> a
forall a. Multiplicative a => a -> a -> a
*a
x) (a -> a
forall a. Enum a => a -> a
pred a
ia -> a -> a
forall a. IDivisible a => a -> a -> a
`div` a
2)

even :: (IDivisible n, IsIntegral n) => n -> Bool
even :: n -> Bool
even n
n = (n
n n -> n -> n
forall a. IDivisible a => a -> a -> a
`mod` n
2) n -> n -> Bool
forall a. Eq a => a -> a -> Bool
== n
0