{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# OPTIONS_GHC -Wno-orphans #-}
{-# OPTIONS_GHC -fno-omit-interface-pragmas #-}
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
{-# INLINEABLE negate #-}
newtype Additive a = Additive a
instance (Semigroup a) => AdditiveSemigroup (Additive a) where
{-# INLINEABLE (+) #-}
+ :: 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
{-# INLINEABLE 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
{-# INLINEABLE (-) #-}
(-) = (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
{-# INLINEABLE (*) #-}
* :: 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
{-# INLINEABLE 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
{-# INLINEABLE (+) #-}
+ :: Integer -> Integer -> Integer
(+) = Integer -> Integer -> Integer
addInteger
instance AdditiveMonoid Integer where
{-# INLINEABLE zero #-}
zero :: Integer
zero = Integer
0
instance AdditiveGroup Integer where
{-# INLINEABLE (-) #-}
(-) = Integer -> Integer -> Integer
subtractInteger
instance MultiplicativeSemigroup Integer where
{-# INLINEABLE (*) #-}
* :: Integer -> Integer -> Integer
(*) = Integer -> Integer -> Integer
multiplyInteger
instance MultiplicativeMonoid Integer where
{-# INLINEABLE one #-}
one :: Integer
one = Integer
1
instance AdditiveSemigroup Bool where
{-# INLINEABLE (+) #-}
+ :: Bool -> Bool -> Bool
(+) = Bool -> Bool -> Bool
(||)
instance AdditiveMonoid Bool where
{-# INLINEABLE zero #-}
zero :: Bool
zero = Bool
False
instance MultiplicativeSemigroup Bool where
{-# INLINEABLE (*) #-}
* :: Bool -> Bool -> Bool
(*) = Bool -> Bool -> Bool
(&&)
instance MultiplicativeMonoid Bool where
{-# INLINEABLE 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
{-# INLINEABLE (<>) #-}
<> :: 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
{-# INLINEABLE 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
{-# INLINEABLE (<>) #-}
<> :: 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
{-# INLINEABLE 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)
{-# INLINEABLE 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)
{-# INLINEABLE 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
{-# INLINEABLE abs #-}