{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# OPTIONS_GHC -fno-omit-interface-pragmas #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module PlutusTx.Numeric (
AdditiveSemigroup (..),
AdditiveMonoid (..),
AdditiveGroup (..),
MultiplicativeSemigroup (..),
MultiplicativeMonoid (..),
Semiring,
Ring,
Module (..),
Additive (..),
Multiplicative (..),
negate,
divMod,
quotRem,
abs,
) where
import Data.Coerce (coerce)
import Data.Semigroup (Product (Product), Sum (Sum))
import PlutusTx.Bool (Bool (False, True), (&&), (||))
import PlutusTx.Builtins (Integer, addInteger, divideInteger, modInteger, multiplyInteger,
quotientInteger, remainderInteger, subtractInteger)
import PlutusTx.Monoid (Group, Monoid (mempty), gsub)
import PlutusTx.Ord (Ord ((<)))
import PlutusTx.Semigroup (Semigroup ((<>)))
infixl 7 *
infixl 6 +, -
class AdditiveSemigroup a where
(+) :: a -> a -> a
class AdditiveSemigroup a => AdditiveMonoid a where
zero :: a
class AdditiveMonoid a => AdditiveGroup a where
(-) :: a -> a -> a
negate :: AdditiveGroup a => a -> a
negate :: forall a. AdditiveGroup a => a -> a
negate a
x = a
forall a. AdditiveMonoid a => a
zero a -> a -> a
forall a. AdditiveGroup a => a -> a -> a
- a
x
{-# INLINABLE negate #-}
newtype Additive a = Additive a
instance Semigroup a => AdditiveSemigroup (Additive a) where
{-# INLINABLE (+) #-}
+ :: Additive a -> Additive a -> Additive a
(+) = (a -> a -> a) -> Additive a -> Additive a -> Additive a
forall a b. Coercible a b => a -> b
coerce (a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>) :: a -> a -> a)
instance Monoid a => AdditiveMonoid (Additive a) where
{-# INLINABLE zero #-}
zero :: Additive a
zero = a -> Additive a
forall a. a -> Additive a
Additive a
forall a. Monoid a => a
mempty
instance Group a => AdditiveGroup (Additive a) where
{-# INLINABLE (-) #-}
(-) = (a -> a -> a) -> Additive a -> Additive a -> Additive a
forall a b. Coercible a b => a -> b
coerce (a -> a -> a
forall a. Group a => a -> a -> a
gsub :: a -> a -> a)
class MultiplicativeSemigroup a where
(*) :: a -> a -> a
class MultiplicativeSemigroup a => MultiplicativeMonoid a where
one :: a
newtype Multiplicative a = Multiplicative a
instance Semigroup a => MultiplicativeSemigroup (Multiplicative a) where
{-# INLINABLE (*) #-}
* :: Multiplicative a -> Multiplicative a -> Multiplicative a
(*) = (a -> a -> a)
-> Multiplicative a -> Multiplicative a -> Multiplicative a
forall a b. Coercible a b => a -> b
coerce (a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>) :: a -> a -> a)
instance Monoid a => MultiplicativeMonoid (Multiplicative a) where
{-# INLINABLE one #-}
one :: Multiplicative a
one = a -> Multiplicative a
forall a. a -> Multiplicative a
Multiplicative a
forall a. Monoid a => a
mempty
type Semiring a = (AdditiveMonoid a, MultiplicativeMonoid a)
type Ring a = (AdditiveGroup a, MultiplicativeMonoid a)
instance AdditiveSemigroup Integer where
{-# INLINABLE (+) #-}
+ :: Integer -> Integer -> Integer
(+) = Integer -> Integer -> Integer
addInteger
instance AdditiveMonoid Integer where
{-# INLINABLE zero #-}
zero :: Integer
zero = Integer
0
instance AdditiveGroup Integer where
{-# INLINABLE (-) #-}
(-) = Integer -> Integer -> Integer
subtractInteger
instance MultiplicativeSemigroup Integer where
{-# INLINABLE (*) #-}
* :: Integer -> Integer -> Integer
(*) = Integer -> Integer -> Integer
multiplyInteger
instance MultiplicativeMonoid Integer where
{-# INLINABLE one #-}
one :: Integer
one = Integer
1
instance AdditiveSemigroup Bool where
{-# INLINABLE (+) #-}
+ :: Bool -> Bool -> Bool
(+) = Bool -> Bool -> Bool
(||)
instance AdditiveMonoid Bool where
{-# INLINABLE zero #-}
zero :: Bool
zero = Bool
False
instance MultiplicativeSemigroup Bool where
{-# INLINABLE (*) #-}
* :: Bool -> Bool -> Bool
(*) = Bool -> Bool -> Bool
(&&)
instance MultiplicativeMonoid Bool where
{-# INLINABLE one #-}
one :: Bool
one = Bool
True
class (Ring s, AdditiveGroup v) => Module s v | v -> s where
scale :: s -> v -> v
instance AdditiveSemigroup a => Semigroup (Sum a) where
{-# INLINABLE (<>) #-}
<> :: Sum a -> Sum a -> Sum a
(<>) = (a -> a -> a) -> Sum a -> Sum a -> Sum a
forall a b. Coercible a b => a -> b
coerce (a -> a -> a
forall a. AdditiveSemigroup a => a -> a -> a
(+) :: a -> a -> a)
instance AdditiveMonoid a => Monoid (Sum a) where
{-# INLINABLE mempty #-}
mempty :: Sum a
mempty = a -> Sum a
forall a. a -> Sum a
Sum a
forall a. AdditiveMonoid a => a
zero
instance MultiplicativeSemigroup a => Semigroup (Product a) where
{-# INLINABLE (<>) #-}
<> :: Product a -> Product a -> Product a
(<>) = (a -> a -> a) -> Product a -> Product a -> Product a
forall a b. Coercible a b => a -> b
coerce (a -> a -> a
forall a. MultiplicativeSemigroup a => a -> a -> a
(*) :: a -> a -> a)
instance MultiplicativeMonoid a => Monoid (Product a) where
{-# INLINABLE mempty #-}
mempty :: Product a
mempty = a -> Product a
forall a. a -> Product a
Product a
forall a. MultiplicativeMonoid a => a
one
divMod :: Integer -> Integer -> (Integer, Integer)
divMod :: Integer -> Integer -> (Integer, Integer)
divMod Integer
x Integer
y = ( Integer
x Integer -> Integer -> Integer
`divideInteger` Integer
y, Integer
x Integer -> Integer -> Integer
`modInteger` Integer
y)
{-# INLINABLE divMod #-}
quotRem :: Integer -> Integer -> (Integer, Integer)
quotRem :: Integer -> Integer -> (Integer, Integer)
quotRem Integer
x Integer
y = ( Integer
x Integer -> Integer -> Integer
`quotientInteger` Integer
y, Integer
x Integer -> Integer -> Integer
`remainderInteger` Integer
y)
{-# INLINABLE quotRem #-}
abs :: (Ord n, AdditiveGroup n) => n -> n
abs :: forall n. (Ord n, AdditiveGroup n) => n -> n
abs n
x = if n
x n -> n -> Bool
forall a. Ord a => a -> a -> Bool
< n
forall a. AdditiveMonoid a => a
zero then n -> n
forall a. AdditiveGroup a => a -> a
negate n
x else n
x
{-# INLINABLE abs #-}