{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:context-level=3 #-}
module PlutusTx.Ratio(
Rational
, unsafeRatio
, fromInteger
, ratio
, numerator
, denominator
, round
, truncate
, properFraction
, recip
, abs
, negate
, half
, fromGHC
, toGHC
, gcd
) where
import PlutusTx.Applicative qualified as P
import PlutusTx.Base qualified as P
import PlutusTx.Bool qualified as P
import PlutusTx.Eq qualified as P
import PlutusTx.ErrorCodes qualified as P
import PlutusTx.Integer (Integer)
import PlutusTx.IsData qualified as P
import PlutusTx.Lift (makeLift)
import PlutusTx.Maybe qualified as P
import PlutusTx.Numeric qualified as P
import PlutusTx.Ord qualified as P
import PlutusTx.Trace qualified as P
import PlutusTx.Builtins qualified as Builtins
import Control.Monad (guard)
import Data.Aeson (FromJSON (parseJSON), ToJSON (toJSON), object, withObject, (.:))
import GHC.Generics
import GHC.Real qualified as Ratio
import PlutusTx.Blueprint.Class (HasBlueprintSchema (..))
import PlutusTx.Blueprint.Definition (HasBlueprintDefinition (..), HasSchemaDefinition)
import Prelude (Ord (..), Show, (*))
import Prelude qualified as Haskell
import Prettyprinter (Pretty (..), (<+>))
data Rational = Rational Integer Integer
deriving stock (Rational -> Rational -> Bool
(Rational -> Rational -> Bool)
-> (Rational -> Rational -> Bool) -> Eq Rational
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Rational -> Rational -> Bool
== :: Rational -> Rational -> Bool
$c/= :: Rational -> Rational -> Bool
/= :: Rational -> Rational -> Bool
Haskell.Eq, Int -> Rational -> ShowS
[Rational] -> ShowS
Rational -> String
(Int -> Rational -> ShowS)
-> (Rational -> String) -> ([Rational] -> ShowS) -> Show Rational
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Rational -> ShowS
showsPrec :: Int -> Rational -> ShowS
$cshow :: Rational -> String
show :: Rational -> String
$cshowList :: [Rational] -> ShowS
showList :: [Rational] -> ShowS
Show, (forall x. Rational -> Rep Rational x)
-> (forall x. Rep Rational x -> Rational) -> Generic Rational
forall x. Rep Rational x -> Rational
forall x. Rational -> Rep Rational x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Rational -> Rep Rational x
from :: forall x. Rational -> Rep Rational x
$cto :: forall x. Rep Rational x -> Rational
to :: forall x. Rep Rational x -> Rational
Generic)
instance Pretty Rational where
pretty :: forall ann. Rational -> Doc ann
pretty (Rational Integer
a Integer
b) = Doc ann
"Rational:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Integer -> Doc ann
forall ann. Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Integer
a Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Integer -> Doc ann
forall ann. Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Integer
b
instance P.Eq Rational where
{-# INLINABLE (==) #-}
Rational Integer
n Integer
d == :: Rational -> Rational -> Bool
== Rational Integer
n' Integer
d' = Integer
n Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
P.== Integer
n' Bool -> Bool -> Bool
P.&& Integer
d Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
P.== Integer
d'
instance P.Ord Rational where
{-# INLINABLE compare #-}
compare :: Rational -> Rational -> Ordering
compare (Rational Integer
n Integer
d) (Rational Integer
n' Integer
d') = Integer -> Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
P.compare (Integer
n Integer -> Integer -> Integer
forall a. MultiplicativeSemigroup a => a -> a -> a
P.* Integer
d') (Integer
n' Integer -> Integer -> Integer
forall a. MultiplicativeSemigroup a => a -> a -> a
P.* Integer
d)
{-# INLINABLE (<=) #-}
Rational Integer
n Integer
d <= :: Rational -> Rational -> Bool
<= Rational Integer
n' Integer
d' = (Integer
n Integer -> Integer -> Integer
forall a. MultiplicativeSemigroup a => a -> a -> a
P.* Integer
d') Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
P.<= (Integer
n' Integer -> Integer -> Integer
forall a. MultiplicativeSemigroup a => a -> a -> a
P.* Integer
d)
{-# INLINABLE (>=) #-}
Rational Integer
n Integer
d >= :: Rational -> Rational -> Bool
>= Rational Integer
n' Integer
d' = (Integer
n Integer -> Integer -> Integer
forall a. MultiplicativeSemigroup a => a -> a -> a
P.* Integer
d') Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
P.>= (Integer
n' Integer -> Integer -> Integer
forall a. MultiplicativeSemigroup a => a -> a -> a
P.* Integer
d)
{-# INLINABLE (<) #-}
Rational Integer
n Integer
d < :: Rational -> Rational -> Bool
< Rational Integer
n' Integer
d' = (Integer
n Integer -> Integer -> Integer
forall a. MultiplicativeSemigroup a => a -> a -> a
P.* Integer
d') Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
P.< (Integer
n' Integer -> Integer -> Integer
forall a. MultiplicativeSemigroup a => a -> a -> a
P.* Integer
d)
{-# INLINABLE (>) #-}
Rational Integer
n Integer
d > :: Rational -> Rational -> Bool
> Rational Integer
n' Integer
d' = (Integer
n Integer -> Integer -> Integer
forall a. MultiplicativeSemigroup a => a -> a -> a
P.* Integer
d') Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
P.> (Integer
n' Integer -> Integer -> Integer
forall a. MultiplicativeSemigroup a => a -> a -> a
P.* Integer
d)
instance Ord Rational where
compare :: Rational -> Rational -> Ordering
compare (Rational Integer
n Integer
d) (Rational Integer
n' Integer
d') = Integer -> Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
d') (Integer
n' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
d)
Rational Integer
n Integer
d <= :: Rational -> Rational -> Bool
<= Rational Integer
n' Integer
d' = (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
d') Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= (Integer
n' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
d)
Rational Integer
n Integer
d >= :: Rational -> Rational -> Bool
>= Rational Integer
n' Integer
d' = (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
d') Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= (Integer
n' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
d)
Rational Integer
n Integer
d < :: Rational -> Rational -> Bool
< Rational Integer
n' Integer
d' = (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
d') Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< (Integer
n' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
d)
Rational Integer
n Integer
d > :: Rational -> Rational -> Bool
> Rational Integer
n' Integer
d' = (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
d') Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> (Integer
n' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
d)
instance P.AdditiveSemigroup Rational where
{-# INLINABLE (+) #-}
Rational Integer
n Integer
d + :: Rational -> Rational -> Rational
+ Rational Integer
n' Integer
d' =
let newNum :: Integer
newNum = (Integer
n Integer -> Integer -> Integer
forall a. MultiplicativeSemigroup a => a -> a -> a
P.* Integer
d') Integer -> Integer -> Integer
forall a. AdditiveSemigroup a => a -> a -> a
P.+ (Integer
n' Integer -> Integer -> Integer
forall a. MultiplicativeSemigroup a => a -> a -> a
P.* Integer
d)
newDen :: Integer
newDen = Integer
d Integer -> Integer -> Integer
forall a. MultiplicativeSemigroup a => a -> a -> a
P.* Integer
d'
gcd' :: Integer
gcd' = Integer -> Integer -> Integer
euclid Integer
newNum Integer
newDen
in Integer -> Integer -> Rational
Rational (Integer
newNum Integer -> Integer -> Integer
`Builtins.quotientInteger` Integer
gcd')
(Integer
newDen Integer -> Integer -> Integer
`Builtins.quotientInteger` Integer
gcd')
instance P.AdditiveMonoid Rational where
{-# INLINABLE zero #-}
zero :: Rational
zero = Integer -> Integer -> Rational
Rational Integer
forall a. AdditiveMonoid a => a
P.zero Integer
forall a. MultiplicativeMonoid a => a
P.one
instance P.AdditiveGroup Rational where
{-# INLINABLE (-) #-}
Rational Integer
n Integer
d - :: Rational -> Rational -> Rational
- Rational Integer
n' Integer
d' =
let newNum :: Integer
newNum = (Integer
n Integer -> Integer -> Integer
forall a. MultiplicativeSemigroup a => a -> a -> a
P.* Integer
d') Integer -> Integer -> Integer
forall a. AdditiveGroup a => a -> a -> a
P.- (Integer
n' Integer -> Integer -> Integer
forall a. MultiplicativeSemigroup a => a -> a -> a
P.* Integer
d)
newDen :: Integer
newDen = Integer
d Integer -> Integer -> Integer
forall a. MultiplicativeSemigroup a => a -> a -> a
P.* Integer
d'
gcd' :: Integer
gcd' = Integer -> Integer -> Integer
euclid Integer
newNum Integer
newDen
in Integer -> Integer -> Rational
Rational (Integer
newNum Integer -> Integer -> Integer
`Builtins.quotientInteger` Integer
gcd')
(Integer
newDen Integer -> Integer -> Integer
`Builtins.quotientInteger` Integer
gcd')
instance P.MultiplicativeSemigroup Rational where
{-# INLINABLE (*) #-}
Rational Integer
n Integer
d * :: Rational -> Rational -> Rational
* Rational Integer
n' Integer
d' =
let newNum :: Integer
newNum = Integer
n Integer -> Integer -> Integer
forall a. MultiplicativeSemigroup a => a -> a -> a
P.* Integer
n'
newDen :: Integer
newDen = Integer
d Integer -> Integer -> Integer
forall a. MultiplicativeSemigroup a => a -> a -> a
P.* Integer
d'
gcd' :: Integer
gcd' = Integer -> Integer -> Integer
euclid Integer
newNum Integer
newDen
in Integer -> Integer -> Rational
Rational (Integer
newNum Integer -> Integer -> Integer
`Builtins.quotientInteger` Integer
gcd')
(Integer
newDen Integer -> Integer -> Integer
`Builtins.quotientInteger` Integer
gcd')
instance P.MultiplicativeMonoid Rational where
{-# INLINABLE one #-}
one :: Rational
one = Integer -> Integer -> Rational
Rational Integer
forall a. MultiplicativeMonoid a => a
P.one Integer
forall a. MultiplicativeMonoid a => a
P.one
instance P.Module Integer Rational where
{-# INLINABLE scale #-}
scale :: Integer -> Rational -> Rational
scale Integer
i (Rational Integer
n Integer
d) = let newNum :: Integer
newNum = Integer
i Integer -> Integer -> Integer
forall a. MultiplicativeSemigroup a => a -> a -> a
P.* Integer
n
gcd' :: Integer
gcd' = Integer -> Integer -> Integer
euclid Integer
newNum Integer
d in
Integer -> Integer -> Rational
Rational (Integer
newNum Integer -> Integer -> Integer
`Builtins.quotientInteger` Integer
gcd')
(Integer
d Integer -> Integer -> Integer
`Builtins.quotientInteger` Integer
gcd')
instance HasBlueprintDefinition Rational where
type Unroll Rational = '[Rational, Integer]
instance
(HasSchemaDefinition Integer referencedTypes) =>
HasBlueprintSchema Rational referencedTypes
where
schema :: Schema referencedTypes
schema = forall t (referencedTypes :: [*]).
HasBlueprintSchema t referencedTypes =>
Schema referencedTypes
schema @(Integer, Integer)
instance P.ToData Rational where
{-# INLINABLE toBuiltinData #-}
toBuiltinData :: Rational -> BuiltinData
toBuiltinData (Rational Integer
n Integer
d) = (Integer, Integer) -> BuiltinData
forall a. ToData a => a -> BuiltinData
P.toBuiltinData (Integer
n, Integer
d)
instance P.FromData Rational where
{-# INLINABLE fromBuiltinData #-}
fromBuiltinData :: BuiltinData -> Maybe Rational
fromBuiltinData BuiltinData
dat = do
(Integer
n, Integer
d) <- BuiltinData -> Maybe (Integer, Integer)
forall a. FromData a => BuiltinData -> Maybe a
P.fromBuiltinData BuiltinData
dat
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Integer
d Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
P./= Integer
forall a. AdditiveMonoid a => a
P.zero)
Rational -> Maybe Rational
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
P.pure (Rational -> Maybe Rational)
-> (Integer -> Rational) -> Integer -> Maybe Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
P.. Integer -> Integer -> Rational
unsafeRatio Integer
n (Integer -> Maybe Rational) -> Integer -> Maybe Rational
forall a b. (a -> b) -> a -> b
P.$ Integer
d
instance P.UnsafeFromData Rational where
{-# INLINABLE unsafeFromBuiltinData #-}
unsafeFromBuiltinData :: BuiltinData -> Rational
unsafeFromBuiltinData = (Integer -> Integer -> Rational) -> (Integer, Integer) -> Rational
forall a b c. (a -> b -> c) -> (a, b) -> c
P.uncurry Integer -> Integer -> Rational
unsafeRatio ((Integer, Integer) -> Rational)
-> (BuiltinData -> (Integer, Integer)) -> BuiltinData -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
P.. BuiltinData -> (Integer, Integer)
forall a. UnsafeFromData a => BuiltinData -> a
P.unsafeFromBuiltinData
instance ToJSON Rational where
toJSON :: Rational -> Value
toJSON (Rational Integer
n Integer
d) =
[Pair] -> Value
object
[ (Key
"numerator", Integer -> Value
forall a. ToJSON a => a -> Value
toJSON Integer
n)
, (Key
"denominator", Integer -> Value
forall a. ToJSON a => a -> Value
toJSON Integer
d)
]
instance FromJSON Rational where
parseJSON :: Value -> Parser Rational
parseJSON = String -> (Object -> Parser Rational) -> Value -> Parser Rational
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Rational" ((Object -> Parser Rational) -> Value -> Parser Rational)
-> (Object -> Parser Rational) -> Value -> Parser Rational
forall a b. (a -> b) -> a -> b
Haskell.$ \Object
obj -> do
Integer
n <- Object
obj Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"numerator"
Integer
d <- Object
obj Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"denominator"
case Integer -> Integer -> Maybe Rational
ratio Integer
n Integer
d of
Maybe Rational
Haskell.Nothing -> String -> Parser Rational
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
Haskell.fail String
"Zero denominator is invalid."
Haskell.Just Rational
r -> Rational -> Parser Rational
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
Haskell.pure Rational
r
{-# INLINABLE unsafeRatio #-}
unsafeRatio :: Integer -> Integer -> Rational
unsafeRatio :: Integer -> Integer -> Rational
unsafeRatio Integer
n Integer
d
| Integer
d Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
P.== Integer
forall a. AdditiveMonoid a => a
P.zero = BuiltinString -> Rational
forall a. BuiltinString -> a
P.traceError BuiltinString
P.ratioHasZeroDenominatorError
| Integer
d Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
P.< Integer
forall a. AdditiveMonoid a => a
P.zero = Integer -> Integer -> Rational
unsafeRatio (Integer -> Integer
forall a. AdditiveGroup a => a -> a
P.negate Integer
n) (Integer -> Integer
forall a. AdditiveGroup a => a -> a
P.negate Integer
d)
| Bool
P.True =
let gcd' :: Integer
gcd' = Integer -> Integer -> Integer
euclid Integer
n Integer
d
in Integer -> Integer -> Rational
Rational (Integer
n Integer -> Integer -> Integer
`Builtins.quotientInteger` Integer
gcd')
(Integer
d Integer -> Integer -> Integer
`Builtins.quotientInteger` Integer
gcd')
{-# INLINABLE ratio #-}
ratio :: Integer -> Integer -> P.Maybe Rational
ratio :: Integer -> Integer -> Maybe Rational
ratio Integer
n Integer
d
| Integer
d Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
P.== Integer
forall a. AdditiveMonoid a => a
P.zero = Maybe Rational
forall a. Maybe a
P.Nothing
| Integer
d Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
P.< Integer
forall a. AdditiveMonoid a => a
P.zero = Rational -> Maybe Rational
forall a. a -> Maybe a
P.Just (Integer -> Integer -> Rational
unsafeRatio (Integer -> Integer
forall a. AdditiveGroup a => a -> a
P.negate Integer
n) (Integer -> Integer
forall a. AdditiveGroup a => a -> a
P.negate Integer
d))
| Bool
P.True =
let gcd' :: Integer
gcd' = Integer -> Integer -> Integer
euclid Integer
n Integer
d
in Rational -> Maybe Rational
forall a. a -> Maybe a
P.Just (Rational -> Maybe Rational) -> Rational -> Maybe Rational
forall a b. (a -> b) -> a -> b
P.$
Integer -> Integer -> Rational
Rational (Integer
n Integer -> Integer -> Integer
`Builtins.quotientInteger` Integer
gcd')
(Integer
d Integer -> Integer -> Integer
`Builtins.quotientInteger` Integer
gcd')
toGHC :: Rational -> Ratio.Rational
toGHC :: Rational -> Rational
toGHC (Rational Integer
n Integer
d) = Integer
n Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
Ratio.% Integer
d
{-# INLINABLE numerator #-}
numerator :: Rational -> Integer
numerator :: Rational -> Integer
numerator (Rational Integer
n Integer
_) = Integer
n
{-# INLINABLE denominator #-}
denominator :: Rational -> Integer
denominator :: Rational -> Integer
denominator (Rational Integer
_ Integer
d) = Integer
d
{-# INLINABLE half #-}
half :: Rational
half :: Rational
half = Integer -> Integer -> Rational
Rational Integer
1 Integer
2
{-# INLINABLE fromInteger #-}
fromInteger :: Integer -> Rational
fromInteger :: Integer -> Rational
fromInteger Integer
num = Integer -> Integer -> Rational
Rational Integer
num Integer
forall a. MultiplicativeMonoid a => a
P.one
fromGHC :: Ratio.Rational -> Rational
fromGHC :: Rational -> Rational
fromGHC Rational
r = Integer -> Integer -> Rational
unsafeRatio (Rational -> Integer
forall a. Ratio a -> a
Ratio.numerator Rational
r) (Rational -> Integer
forall a. Ratio a -> a
Ratio.denominator Rational
r)
{-# INLINABLE negate #-}
negate :: Rational -> Rational
negate :: Rational -> Rational
negate (Rational Integer
n Integer
d) = Integer -> Integer -> Rational
Rational (Integer -> Integer
forall a. AdditiveGroup a => a -> a
P.negate Integer
n) Integer
d
{-# INLINABLE abs #-}
abs :: Rational -> Rational
abs :: Rational -> Rational
abs rat :: Rational
rat@(Rational Integer
n Integer
d)
| Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
P.< Integer
forall a. AdditiveMonoid a => a
P.zero = Integer -> Integer -> Rational
Rational (Integer -> Integer
forall a. AdditiveGroup a => a -> a
P.negate Integer
n) Integer
d
| Bool
P.True = Rational
rat
{-# INLINABLE properFraction #-}
properFraction :: Rational -> (Integer, Rational)
properFraction :: Rational -> (Integer, Rational)
properFraction (Rational Integer
n Integer
d) =
(Integer
n Integer -> Integer -> Integer
`Builtins.quotientInteger` Integer
d,
Integer -> Integer -> Rational
Rational (Integer
n Integer -> Integer -> Integer
`Builtins.remainderInteger` Integer
d) Integer
d)
{-# INLINABLE recip #-}
recip :: Rational -> Rational
recip :: Rational -> Rational
recip (Rational Integer
n Integer
d)
| Integer
n Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
P.== Integer
forall a. AdditiveMonoid a => a
P.zero = BuiltinString -> Rational
forall a. BuiltinString -> a
P.traceError BuiltinString
P.reciprocalOfZeroError
| Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
P.< Integer
forall a. AdditiveMonoid a => a
P.zero = Integer -> Integer -> Rational
Rational (Integer -> Integer
forall a. AdditiveGroup a => a -> a
P.negate Integer
d) (Integer -> Integer
forall a. AdditiveGroup a => a -> a
P.negate Integer
n)
| Bool
P.True = Integer -> Integer -> Rational
Rational Integer
d Integer
n
{-# INLINABLE truncate #-}
truncate :: Rational -> Integer
truncate :: Rational -> Integer
truncate (Rational Integer
n Integer
d) = Integer
n Integer -> Integer -> Integer
`Builtins.quotientInteger` Integer
d
{-# INLINABLE round #-}
round :: Rational -> Integer
round :: Rational -> Integer
round Rational
x =
let (Integer
n, Rational
r) = Rational -> (Integer, Rational)
properFraction Rational
x
m :: Integer
m = if Rational
r Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
P.< Rational
forall a. AdditiveMonoid a => a
P.zero then Integer
n Integer -> Integer -> Integer
forall a. AdditiveGroup a => a -> a -> a
P.- Integer
forall a. MultiplicativeMonoid a => a
P.one else Integer
n Integer -> Integer -> Integer
forall a. AdditiveSemigroup a => a -> a -> a
P.+ Integer
forall a. MultiplicativeMonoid a => a
P.one
flag :: Rational
flag = Rational -> Rational
abs Rational
r Rational -> Rational -> Rational
forall a. AdditiveGroup a => a -> a -> a
P.- Rational
half
in if
| Rational
flag Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
P.< Rational
forall a. AdditiveMonoid a => a
P.zero -> Integer
n
| Rational
flag Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
P.== Rational
forall a. AdditiveMonoid a => a
P.zero -> if Integer -> Integer -> Integer
Builtins.modInteger Integer
n Integer
2 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
P.== Integer
forall a. AdditiveMonoid a => a
P.zero
then Integer
n
else Integer
m
| Bool
P.True -> Integer
m
{-# INLINABLE gcd #-}
gcd :: Integer -> Integer -> Integer
gcd :: Integer -> Integer -> Integer
gcd Integer
a Integer
b = Integer -> Integer -> Integer
gcd' (Integer -> Integer
forall n. (Ord n, AdditiveGroup n) => n -> n
P.abs Integer
a) (Integer -> Integer
forall n. (Ord n, AdditiveGroup n) => n -> n
P.abs Integer
b) where
gcd' :: Integer -> Integer -> Integer
gcd' Integer
a' Integer
b'
| Integer
b' Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
P.== Integer
forall a. AdditiveMonoid a => a
P.zero = Integer
a'
| Bool
P.True = Integer -> Integer -> Integer
gcd' Integer
b' (Integer
a' Integer -> Integer -> Integer
`Builtins.remainderInteger` Integer
b')
{-# INLINABLE euclid #-}
euclid :: Integer -> Integer -> Integer
euclid :: Integer -> Integer -> Integer
euclid Integer
x Integer
y
| Integer
y Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
P.== Integer
forall a. AdditiveMonoid a => a
P.zero = Integer
x
| Bool
P.True = Integer -> Integer -> Integer
euclid Integer
y (Integer
x Integer -> Integer -> Integer
`Builtins.modInteger` Integer
y)
$(makeLift ''Rational)