{-# LANGUAGE FlexibleInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Plutarch.Rational (
  PRational (PRational),
  preduce,
  pnumerator,
  pdenominator,
  Plutarch.Rational.pfromInteger,
  pround,
  ptruncate,
  pproperFraction,
  PFractional (..),
) where

import Data.Ratio (denominator, numerator)
import GHC.Generics (Generic)
import Plutarch (
  DPTStrat,
  DerivePlutusType,
  PType,
  PlutusType,
  PlutusTypeScott,
  Term,
  pcon,
  pfix,
  phoistAcyclic,
  plam,
  plet,
  pmatch,
  pto,
  runTermCont,
  (#),
  (#$),
  type (:-->),
 )
import Plutarch.Bool (PEq, POrd, PPartialOrd, pif, (#<), (#<=), (#==))
import Plutarch.Builtin (
  PAsData,
  PBuiltinList,
  PData,
  PIsData,
  pasInt,
  pasList,
  pdata,
  pdataImpl,
  pforgetData,
  pfromDataImpl,
 )
import Plutarch.Integer (PInteger, PIntegral (pquot), pdiv, pmod)
import Plutarch.Lift (pconstant)
import Plutarch.List (pcons, phead, pnil, ptail)
import Plutarch.Num (PNum, pabs, pfromInteger, pnegate, psignum, (#*), (#+), (#-))
import Plutarch.Pair (PPair (PPair))
import Plutarch.Positive (PPositive, ptryPositive)
import Plutarch.Show (PShow, pshow, pshow')
import Plutarch.TermCont (tcont, unTermCont)
import Plutarch.Trace (ptraceError)
import Plutarch.TryFrom (PTryFrom (PTryFromExcess, ptryFrom'), ptryFrom)
import Plutarch.Unsafe (punsafeCoerce, punsafeDowncast)

class PFractional (a :: PType) where
  (#/) :: Term s a -> Term s a -> Term s a
  precip :: Term s (a :--> a)
  pfromRational :: Term s (PRational :--> a)

-- | Note: This type is _not_ the synonym of 'PlutusTx.Rational'.
data PRational s
  = PRational (Term s PInteger) (Term s PPositive)
  deriving stock (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (s :: S) x. Rep (PRational s) x -> PRational s
forall (s :: S) x. PRational s -> Rep (PRational s) x
$cto :: forall (s :: S) x. Rep (PRational s) x -> PRational s
$cfrom :: forall (s :: S) x. PRational s -> Rep (PRational s) x
Generic)
  deriving anyclass (forall (s :: S). PRational s -> Term s (PInner PRational)
forall (s :: S) (b :: PType).
Term s (PInner PRational) -> (PRational s -> Term s b) -> Term s b
forall (a :: PType).
(forall (s :: S). a s -> Term s (PInner a))
-> (forall (s :: S) (b :: PType).
    Term s (PInner a) -> (a s -> Term s b) -> Term s b)
-> PlutusType a
pmatch' :: forall (s :: S) (b :: PType).
Term s (PInner PRational) -> (PRational s -> Term s b) -> Term s b
$cpmatch' :: forall (s :: S) (b :: PType).
Term s (PInner PRational) -> (PRational s -> Term s b) -> Term s b
pcon' :: forall (s :: S). PRational s -> Term s (PInner PRational)
$cpcon' :: forall (s :: S). PRational s -> Term s (PInner PRational)
PlutusType)

instance DerivePlutusType PRational where type DPTStrat _ = PlutusTypeScott

instance PEq PRational where
  Term s PRational
l' #== :: forall (s :: S).
Term s PRational -> Term s PRational -> Term s PBool
#== Term s PRational
r' =
    forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic
      ( forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
plam forall a b. (a -> b) -> a -> b
$ \Term s PRational
l Term s PRational
r ->
          forall (a :: PType) (s :: S) (b :: PType).
PlutusType a =>
Term s a -> (a s -> Term s b) -> Term s b
pmatch Term s PRational
l forall a b. (a -> b) -> a -> b
$ \(PRational Term s PInteger
ln Term s PPositive
ld) ->
            forall (a :: PType) (s :: S) (b :: PType).
PlutusType a =>
Term s a -> (a s -> Term s b) -> Term s b
pmatch Term s PRational
r forall a b. (a -> b) -> a -> b
$ \(PRational Term s PInteger
rn Term s PPositive
rd) ->
              forall (s :: S) (a :: PType). Term s a -> Term s (PInner a)
pto Term s PPositive
rd forall a. Num a => a -> a -> a
* Term s PInteger
ln forall (t :: PType) (s :: S).
PEq t =>
Term s t -> Term s t -> Term s PBool
#== Term s PInteger
rn forall a. Num a => a -> a -> a
* forall (s :: S) (a :: PType). Term s a -> Term s (PInner a)
pto Term s PPositive
ld
      )
      # l'
      # r'

instance (PNum a, PFractional a) => Fractional (Term s a) where
  / :: Term s a -> Term s a -> Term s a
(/) = forall (a :: PType) (s :: S).
PFractional a =>
Term s a -> Term s a -> Term s a
(#/)
  recip :: Term s a -> Term s a
recip Term s a
x = forall (a :: PType) (s :: S). PFractional a => Term s (a :--> a)
precip forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s a
x
  fromRational :: Rational -> Term s a
fromRational Rational
x =
    forall (a :: PType) (s :: S).
PFractional a =>
Term s (PRational :--> a)
pfromRational forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
#$ forall (a :: PType) (s :: S). PlutusType a => a s -> Term s a
pcon forall a b. (a -> b) -> a -> b
$
      forall (s :: S). Term s PInteger -> Term s PPositive -> PRational s
PRational
        (forall (p :: PType) (s :: S). PLift p => PLifted p -> Term s p
pconstant forall a b. (a -> b) -> a -> b
$ forall a. Ratio a -> a
numerator Rational
x)
        (forall (s :: S) (a :: PType). Term s (PInner a) -> Term s a
punsafeDowncast forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: PType) (s :: S). PLift p => PLifted p -> Term s p
pconstant forall a b. (a -> b) -> a -> b
$ forall a. Ratio a -> a
denominator Rational
x)

instance PShow PRational where
  pshow' :: forall (s :: S). Bool -> Term s PRational -> Term s PString
pshow' Bool
_ Term s PRational
x =
    forall {s :: S}. Term s (PRational :--> PString)
pshowRat forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PRational
x
    where
      pshowRat :: Term s (PRational :--> PString)
pshowRat = forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic forall a b. (a -> b) -> a -> b
$
        forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
plam forall a b. (a -> b) -> a -> b
$ \Term s PRational
n -> forall (a :: PType) (s :: S) (b :: PType).
PlutusType a =>
Term s a -> (a s -> Term s b) -> Term s b
pmatch Term s PRational
n forall a b. (a -> b) -> a -> b
$ \(PRational Term s PInteger
x Term s PPositive
y) ->
          forall (a :: PType) (s :: S). PShow a => Term s a -> Term s PString
pshow Term s PInteger
x forall a. Semigroup a => a -> a -> a
<> Term s PString
"/" forall a. Semigroup a => a -> a -> a
<> forall (a :: PType) (s :: S). PShow a => Term s a -> Term s PString
pshow (forall (s :: S) (a :: PType). Term s a -> Term s (PInner a)
pto Term s PPositive
y)

-- | This instance _does not_ correspond to 'PlutusTx.Rational's data encoding.
instance PIsData PRational where
  pfromDataImpl :: forall (s :: S). Term s (PAsData PRational) -> Term s PRational
pfromDataImpl Term s (PAsData PRational)
x' = forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic (forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
plam forall a b. (a -> b) -> a -> b
$ \Term s (PAsData PRational)
x -> forall (s :: S). Term s (PBuiltinList PData :--> PRational)
plistToRat forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
#$ forall (s :: S). Term s (PData :--> PBuiltinList PData)
pasList forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# forall (s :: S) (a :: PType). Term s (PAsData a) -> Term s PData
pforgetData Term s (PAsData PRational)
x) forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s (PAsData PRational)
x'
    where
      plistToRat :: Term s (PBuiltinList PData :--> PRational)
      plistToRat :: forall (s :: S). Term s (PBuiltinList PData :--> PRational)
plistToRat = forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
plam forall a b. (a -> b) -> a -> b
$ \Term s (PBuiltinList PData)
x ->
        forall (a :: PType) (s :: S). PlutusType a => a s -> Term s a
pcon
          forall a b. (a -> b) -> a -> b
$ forall (s :: S). Term s PInteger -> Term s PPositive -> PRational s
PRational (forall (s :: S). Term s (PData :--> PInteger)
pasInt forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
#$ forall (list :: PType -> PType) (a :: PType) (s :: S).
(PListLike list, PElemConstraint list a) =>
Term s (list a :--> a)
phead forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s (PBuiltinList PData)
x)
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: S) (a :: PType). Term s (PInner a) -> Term s a
punsafeDowncast
          forall a b. (a -> b) -> a -> b
$ forall (s :: S). Term s (PData :--> PInteger)
pasInt forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
#$ forall (list :: PType -> PType) (a :: PType) (s :: S).
(PListLike list, PElemConstraint list a) =>
Term s (list a :--> a)
phead forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
#$ forall (list :: PType -> PType) (a :: PType) (s :: S).
(PListLike list, PElemConstraint list a) =>
Term s (list a :--> list a)
ptail forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s (PBuiltinList PData)
x
  pdataImpl :: forall (s :: S). Term s PRational -> Term s PData
pdataImpl Term s PRational
x' =
    forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic
      ( forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
plam forall a b. (a -> b) -> a -> b
$ \Term s PRational
x -> forall (a :: PType) (s :: S). TermCont @a s (Term s a) -> Term s a
unTermCont forall a b. (a -> b) -> a -> b
$ do
          PRational Term s PInteger
a Term s PPositive
b <- forall a (s :: S) (r :: PType).
((a -> Term s r) -> Term s r) -> TermCont @r s a
tcont forall a b. (a -> b) -> a -> b
$ forall (a :: PType) (s :: S) (b :: PType).
PlutusType a =>
Term s a -> (a s -> Term s b) -> Term s b
pmatch Term s PRational
x
          let res :: Term _ (PBuiltinList (PAsData PInteger))
              res :: Term s (PBuiltinList (PAsData PInteger))
res = forall (list :: PType -> PType) (a :: PType) (s :: S).
(PListLike list, PElemConstraint list a) =>
Term s (a :--> (list a :--> list a))
pcons forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# forall (a :: PType) (s :: S).
PIsData a =>
Term s a -> Term s (PAsData a)
pdata Term s PInteger
a forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
#$ forall (list :: PType -> PType) (a :: PType) (s :: S).
(PListLike list, PElemConstraint list a) =>
Term s (a :--> (list a :--> list a))
pcons forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# forall (a :: PType) (s :: S).
PIsData a =>
Term s a -> Term s (PAsData a)
pdata (forall (s :: S) (a :: PType). Term s a -> Term s (PInner a)
pto Term s PPositive
b) forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
#$ forall (list :: PType -> PType) (a :: PType) (s :: S).
(PListLike list, PElemConstraint list a) =>
Term s (list a)
pnil
          forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (a :: PType) (s :: S). PIsData a => Term s a -> Term s PData
pdataImpl Term s (PBuiltinList (PAsData PInteger))
res
      )
      # x'

newtype Flip f a b = Flip (f b a) deriving stock (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k k (f :: k -> k -> Type) (a :: k) (b :: k) x.
Rep (Flip @k @k f a b) x -> Flip @k @k f a b
forall k k (f :: k -> k -> Type) (a :: k) (b :: k) x.
Flip @k @k f a b -> Rep (Flip @k @k f a b) x
$cto :: forall k k (f :: k -> k -> Type) (a :: k) (b :: k) x.
Rep (Flip @k @k f a b) x -> Flip @k @k f a b
$cfrom :: forall k k (f :: k -> k -> Type) (a :: k) (b :: k) x.
Flip @k @k f a b -> Rep (Flip @k @k f a b) x
Generic)

-- | NOTE: This instance produces a verified 'PPositive' as the excess output.
instance PTryFrom PData (PAsData PRational) where
  type PTryFromExcess PData (PAsData PRational) = Flip Term PPositive
  ptryFrom' :: forall (s :: S) (r :: PType).
Term s PData
-> ((Term s (PAsData PRational),
     Reduce (PTryFromExcess PData (PAsData PRational) s))
    -> Term s r)
-> Term s r
ptryFrom' Term s PData
opq = forall (r :: PType) (s :: S) a.
TermCont @r s a -> (a -> Term s r) -> Term s r
runTermCont forall a b. (a -> b) -> a -> b
$ do
    (Term s (PAsData (PBuiltinList PData))
_, Term s (PBuiltinList PData)
ld) <- forall a (s :: S) (r :: PType).
((a -> Term s r) -> Term s r) -> TermCont @r s a
tcont forall a b. (a -> b) -> a -> b
$ forall (b :: PType) (a :: PType) (s :: S) (r :: PType).
PTryFrom a b =>
Term s a
-> ((Term s b, Reduce (PTryFromExcess a b s)) -> Term s r)
-> Term s r
ptryFrom @(PAsData (PBuiltinList PData)) Term s PData
opq
    Term s (PBuiltinList PData)
ratTail <- forall a (s :: S) (r :: PType).
((a -> Term s r) -> Term s r) -> TermCont @r s a
tcont forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: S) (a :: PType) (b :: PType).
Term s a -> (Term s a -> Term s b) -> Term s b
plet forall a b. (a -> b) -> a -> b
$ forall (list :: PType -> PType) (a :: PType) (s :: S).
(PListLike list, PElemConstraint list a) =>
Term s (list a :--> list a)
ptail forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s (PBuiltinList PData)
ld
    forall a (s :: S) (r :: PType).
((a -> Term s r) -> Term s r) -> TermCont @r s a
tcont forall a b. (a -> b) -> a -> b
$ \() -> Term s r
f -> forall (s :: S) (a :: PType).
Term s PBool -> Term s a -> Term s a -> Term s a
pif (forall (list :: PType -> PType) (a :: PType) (s :: S).
(PListLike list, PElemConstraint list a) =>
Term s (list a :--> list a)
ptail forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s (PBuiltinList PData)
ratTail forall (t :: PType) (s :: S).
PEq t =>
Term s t -> Term s t -> Term s PBool
#== forall (list :: PType -> PType) (a :: PType) (s :: S).
(PListLike list, PElemConstraint list a) =>
Term s (list a)
pnil) (() -> Term s r
f ()) forall a b. (a -> b) -> a -> b
$ forall (s :: S) (a :: PType). Term s PString -> Term s a
ptraceError Term s PString
"ptryFrom(PRational): data list length should be 2"
    (Term s (PAsData PInteger)
_, Term s PInteger
denm) <- forall a (s :: S) (r :: PType).
((a -> Term s r) -> Term s r) -> TermCont @r s a
tcont forall a b. (a -> b) -> a -> b
$ forall (b :: PType) (a :: PType) (s :: S) (r :: PType).
PTryFrom a b =>
Term s a
-> ((Term s b, Reduce (PTryFromExcess a b s)) -> Term s r)
-> Term s r
ptryFrom @(PAsData PInteger) forall a b. (a -> b) -> a -> b
$ forall (list :: PType -> PType) (a :: PType) (s :: S).
(PListLike list, PElemConstraint list a) =>
Term s (list a :--> a)
phead forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s (PBuiltinList PData)
ratTail
    Term s PPositive
res <- forall a (s :: S) (r :: PType).
((a -> Term s r) -> Term s r) -> TermCont @r s a
tcont forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: S) (a :: PType) (b :: PType).
Term s a -> (Term s a -> Term s b) -> Term s b
plet forall a b. (a -> b) -> a -> b
$ forall (s :: S). Term s (PInteger :--> PPositive)
ptryPositive forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PInteger
denm
    forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (forall (s :: S) (a :: PType) (b :: PType). Term s a -> Term s b
punsafeCoerce Term s PData
opq, Term s PPositive
res)

instance PPartialOrd PRational where
  Term s PRational
l' #<= :: forall (s :: S).
Term s PRational -> Term s PRational -> Term s PBool
#<= Term s PRational
r' =
    forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic
      ( forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
plam forall a b. (a -> b) -> a -> b
$ \Term s PRational
l Term s PRational
r -> forall (a :: PType) (s :: S). TermCont @a s (Term s a) -> Term s a
unTermCont forall a b. (a -> b) -> a -> b
$ do
          PRational Term s PInteger
ln Term s PPositive
ld <- forall a (s :: S) (r :: PType).
((a -> Term s r) -> Term s r) -> TermCont @r s a
tcont forall a b. (a -> b) -> a -> b
$ forall (a :: PType) (s :: S) (b :: PType).
PlutusType a =>
Term s a -> (a s -> Term s b) -> Term s b
pmatch Term s PRational
l
          PRational Term s PInteger
rn Term s PPositive
rd <- forall a (s :: S) (r :: PType).
((a -> Term s r) -> Term s r) -> TermCont @r s a
tcont forall a b. (a -> b) -> a -> b
$ forall (a :: PType) (s :: S) (b :: PType).
PlutusType a =>
Term s a -> (a s -> Term s b) -> Term s b
pmatch Term s PRational
r
          forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (s :: S) (a :: PType). Term s a -> Term s (PInner a)
pto Term s PPositive
rd forall a. Num a => a -> a -> a
* Term s PInteger
ln forall (t :: PType) (s :: S).
PPartialOrd t =>
Term s t -> Term s t -> Term s PBool
#<= Term s PInteger
rn forall a. Num a => a -> a -> a
* forall (s :: S) (a :: PType). Term s a -> Term s (PInner a)
pto Term s PPositive
ld
      )
      # l'
      # r'

  Term s PRational
l' #< :: forall (s :: S).
Term s PRational -> Term s PRational -> Term s PBool
#< Term s PRational
r' =
    forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic
      ( forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
plam forall a b. (a -> b) -> a -> b
$ \Term s PRational
l Term s PRational
r -> forall (a :: PType) (s :: S). TermCont @a s (Term s a) -> Term s a
unTermCont forall a b. (a -> b) -> a -> b
$ do
          PRational Term s PInteger
ln Term s PPositive
ld <- forall a (s :: S) (r :: PType).
((a -> Term s r) -> Term s r) -> TermCont @r s a
tcont forall a b. (a -> b) -> a -> b
$ forall (a :: PType) (s :: S) (b :: PType).
PlutusType a =>
Term s a -> (a s -> Term s b) -> Term s b
pmatch Term s PRational
l
          PRational Term s PInteger
rn Term s PPositive
rd <- forall a (s :: S) (r :: PType).
((a -> Term s r) -> Term s r) -> TermCont @r s a
tcont forall a b. (a -> b) -> a -> b
$ forall (a :: PType) (s :: S) (b :: PType).
PlutusType a =>
Term s a -> (a s -> Term s b) -> Term s b
pmatch Term s PRational
r
          forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (s :: S) (a :: PType). Term s a -> Term s (PInner a)
pto Term s PPositive
rd forall a. Num a => a -> a -> a
* Term s PInteger
ln forall (t :: PType) (s :: S).
PPartialOrd t =>
Term s t -> Term s t -> Term s PBool
#< Term s PInteger
rn forall a. Num a => a -> a -> a
* forall (s :: S) (a :: PType). Term s a -> Term s (PInner a)
pto Term s PPositive
ld
      )
      # l'
      # r'

instance POrd PRational

instance PNum PRational where
  Term s PRational
x' #+ :: forall (s :: S).
Term s PRational -> Term s PRational -> Term s PRational
#+ Term s PRational
y' =
    forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic
      ( forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
plam forall a b. (a -> b) -> a -> b
$ \Term s PRational
x Term s PRational
y -> forall (a :: PType) (s :: S). TermCont @a s (Term s a) -> Term s a
unTermCont forall a b. (a -> b) -> a -> b
$ do
          PRational Term s PInteger
xn Term s PPositive
xd' <- forall a (s :: S) (r :: PType).
((a -> Term s r) -> Term s r) -> TermCont @r s a
tcont forall a b. (a -> b) -> a -> b
$ forall (a :: PType) (s :: S) (b :: PType).
PlutusType a =>
Term s a -> (a s -> Term s b) -> Term s b
pmatch Term s PRational
x
          PRational Term s PInteger
yn Term s PPositive
yd' <- forall a (s :: S) (r :: PType).
((a -> Term s r) -> Term s r) -> TermCont @r s a
tcont forall a b. (a -> b) -> a -> b
$ forall (a :: PType) (s :: S) (b :: PType).
PlutusType a =>
Term s a -> (a s -> Term s b) -> Term s b
pmatch Term s PRational
y
          Term s PPositive
xd <- forall a (s :: S) (r :: PType).
((a -> Term s r) -> Term s r) -> TermCont @r s a
tcont forall a b. (a -> b) -> a -> b
$ forall (s :: S) (a :: PType) (b :: PType).
Term s a -> (Term s a -> Term s b) -> Term s b
plet Term s PPositive
xd'
          Term s PPositive
yd <- forall a (s :: S) (r :: PType).
((a -> Term s r) -> Term s r) -> TermCont @r s a
tcont forall a b. (a -> b) -> a -> b
$ forall (s :: S) (a :: PType) (b :: PType).
Term s a -> (Term s a -> Term s b) -> Term s b
plet Term s PPositive
yd'
          forall (f :: Type -> Type) a. Applicative f => a -> f a
pure
            forall a b. (a -> b) -> a -> b
$ forall (s :: S). Term s (PRational :--> PRational)
preduce
              #$ pcon
            $ PRational (xn * pto yd + yn * pto xd)
            $ punsafeDowncast
            $ pto xd * pto yd
      )
      # x'
      # y'

  -- TODO (Optimize): Could this be optimized with an impl in terms of `#+`.
  Term s PRational
x' #- :: forall (s :: S).
Term s PRational -> Term s PRational -> Term s PRational
#- Term s PRational
y' =
    forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic
      ( forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
plam forall a b. (a -> b) -> a -> b
$ \Term s PRational
x Term s PRational
y -> forall (a :: PType) (s :: S). TermCont @a s (Term s a) -> Term s a
unTermCont forall a b. (a -> b) -> a -> b
$ do
          PRational Term s PInteger
xn Term s PPositive
xd' <- forall a (s :: S) (r :: PType).
((a -> Term s r) -> Term s r) -> TermCont @r s a
tcont forall a b. (a -> b) -> a -> b
$ forall (a :: PType) (s :: S) (b :: PType).
PlutusType a =>
Term s a -> (a s -> Term s b) -> Term s b
pmatch Term s PRational
x
          PRational Term s PInteger
yn Term s PPositive
yd' <- forall a (s :: S) (r :: PType).
((a -> Term s r) -> Term s r) -> TermCont @r s a
tcont forall a b. (a -> b) -> a -> b
$ forall (a :: PType) (s :: S) (b :: PType).
PlutusType a =>
Term s a -> (a s -> Term s b) -> Term s b
pmatch Term s PRational
y
          Term s PPositive
xd <- forall a (s :: S) (r :: PType).
((a -> Term s r) -> Term s r) -> TermCont @r s a
tcont forall a b. (a -> b) -> a -> b
$ forall (s :: S) (a :: PType) (b :: PType).
Term s a -> (Term s a -> Term s b) -> Term s b
plet Term s PPositive
xd'
          Term s PPositive
yd <- forall a (s :: S) (r :: PType).
((a -> Term s r) -> Term s r) -> TermCont @r s a
tcont forall a b. (a -> b) -> a -> b
$ forall (s :: S) (a :: PType) (b :: PType).
Term s a -> (Term s a -> Term s b) -> Term s b
plet Term s PPositive
yd'
          forall (f :: Type -> Type) a. Applicative f => a -> f a
pure
            forall a b. (a -> b) -> a -> b
$ forall (s :: S). Term s (PRational :--> PRational)
preduce
              #$ pcon
            $ PRational (xn * pto yd - yn * pto xd)
            $ punsafeDowncast
            $ pto xd * pto yd
      )
      # x'
      # y'

  Term s PRational
x' #* :: forall (s :: S).
Term s PRational -> Term s PRational -> Term s PRational
#* Term s PRational
y' =
    forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic
      ( forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
plam forall a b. (a -> b) -> a -> b
$ \Term s PRational
x Term s PRational
y -> forall (a :: PType) (s :: S). TermCont @a s (Term s a) -> Term s a
unTermCont forall a b. (a -> b) -> a -> b
$ do
          PRational Term s PInteger
xn Term s PPositive
xd <- forall a (s :: S) (r :: PType).
((a -> Term s r) -> Term s r) -> TermCont @r s a
tcont forall a b. (a -> b) -> a -> b
$ forall (a :: PType) (s :: S) (b :: PType).
PlutusType a =>
Term s a -> (a s -> Term s b) -> Term s b
pmatch Term s PRational
x
          PRational Term s PInteger
yn Term s PPositive
yd <- forall a (s :: S) (r :: PType).
((a -> Term s r) -> Term s r) -> TermCont @r s a
tcont forall a b. (a -> b) -> a -> b
$ forall (a :: PType) (s :: S) (b :: PType).
PlutusType a =>
Term s a -> (a s -> Term s b) -> Term s b
pmatch Term s PRational
y
          forall (f :: Type -> Type) a. Applicative f => a -> f a
pure
            forall a b. (a -> b) -> a -> b
$ forall (s :: S). Term s (PRational :--> PRational)
preduce
              #$ pcon
            $ PRational (xn * yn)
            $ punsafeDowncast
            $ pto xd * pto yd
      )
      # x'
      # y'

  pnegate :: forall (s :: S). Term s (PRational :--> PRational)
pnegate =
    forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic forall a b. (a -> b) -> a -> b
$
      forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
plam forall a b. (a -> b) -> a -> b
$ \Term s PRational
x ->
        forall (a :: PType) (s :: S) (b :: PType).
PlutusType a =>
Term s a -> (a s -> Term s b) -> Term s b
pmatch Term s PRational
x forall a b. (a -> b) -> a -> b
$ \(PRational Term s PInteger
xn Term s PPositive
xd) ->
          forall (a :: PType) (s :: S). PlutusType a => a s -> Term s a
pcon forall a b. (a -> b) -> a -> b
$ forall (s :: S). Term s PInteger -> Term s PPositive -> PRational s
PRational (forall a. Num a => a -> a
negate Term s PInteger
xn) Term s PPositive
xd

  pabs :: forall (s :: S). Term s (PRational :--> PRational)
pabs =
    forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic forall a b. (a -> b) -> a -> b
$
      forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
plam forall a b. (a -> b) -> a -> b
$ \Term s PRational
x ->
        forall (a :: PType) (s :: S) (b :: PType).
PlutusType a =>
Term s a -> (a s -> Term s b) -> Term s b
pmatch Term s PRational
x forall a b. (a -> b) -> a -> b
$ \(PRational Term s PInteger
xn Term s PPositive
xd) ->
          forall (a :: PType) (s :: S). PlutusType a => a s -> Term s a
pcon forall a b. (a -> b) -> a -> b
$ forall (s :: S). Term s PInteger -> Term s PPositive -> PRational s
PRational (forall a. Num a => a -> a
abs Term s PInteger
xn) (forall a. Num a => a -> a
abs Term s PPositive
xd)

  psignum :: forall (s :: S). Term s (PRational :--> PRational)
psignum =
    forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic forall a b. (a -> b) -> a -> b
$
      forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
plam forall a b. (a -> b) -> a -> b
$ \Term s PRational
x' -> forall (s :: S) (a :: PType) (b :: PType).
Term s a -> (Term s a -> Term s b) -> Term s b
plet Term s PRational
x' forall a b. (a -> b) -> a -> b
$ \Term s PRational
x ->
        forall (s :: S) (a :: PType).
Term s PBool -> Term s a -> Term s a -> Term s a
pif
          (Term s PRational
x forall (t :: PType) (s :: S).
PEq t =>
Term s t -> Term s t -> Term s PBool
#== Term s PRational
0)
          Term s PRational
0
          forall a b. (a -> b) -> a -> b
$ forall (s :: S) (a :: PType).
Term s PBool -> Term s a -> Term s a -> Term s a
pif
            (Term s PRational
x forall (t :: PType) (s :: S).
PPartialOrd t =>
Term s t -> Term s t -> Term s PBool
#< Term s PRational
0)
            (Term s PRational
-1)
            Term s PRational
1

  pfromInteger :: forall (s :: S). Integer -> Term s PRational
pfromInteger Integer
n = forall (a :: PType) (s :: S). PlutusType a => a s -> Term s a
pcon forall a b. (a -> b) -> a -> b
$ forall (s :: S). Term s PInteger -> Term s PPositive -> PRational s
PRational (forall a. Num a => Integer -> a
fromInteger Integer
n) Term s PPositive
1

instance PFractional PRational where
  precip :: forall (s :: S). Term s (PRational :--> PRational)
precip =
    forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic forall a b. (a -> b) -> a -> b
$
      forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
plam forall a b. (a -> b) -> a -> b
$ \Term s PRational
x ->
        forall (a :: PType) (s :: S) (b :: PType).
PlutusType a =>
Term s a -> (a s -> Term s b) -> Term s b
pmatch Term s PRational
x forall a b. (a -> b) -> a -> b
$ \(PRational Term s PInteger
xn Term s PPositive
xd) ->
          forall (a :: PType) (s :: S). PlutusType a => a s -> Term s a
pcon forall a b. (a -> b) -> a -> b
$ forall (s :: S). Term s PInteger -> Term s PPositive -> PRational s
PRational (forall (s :: S) (a :: PType). Term s a -> Term s (PInner a)
pto Term s PPositive
xd) forall a b. (a -> b) -> a -> b
$ forall (s :: S). Term s (PInteger :--> PPositive)
ptryPositive forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PInteger
xn

  -- TODO (Optimize): Could this be optimized with an impl in terms of `#*`.
  Term s PRational
x' #/ :: forall (s :: S).
Term s PRational -> Term s PRational -> Term s PRational
#/ Term s PRational
y' =
    forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic
      ( forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
plam forall a b. (a -> b) -> a -> b
$ \Term s PRational
x Term s PRational
y -> forall (a :: PType) (s :: S). TermCont @a s (Term s a) -> Term s a
unTermCont forall a b. (a -> b) -> a -> b
$ do
          PRational Term s PInteger
xn Term s PPositive
xd <- forall a (s :: S) (r :: PType).
((a -> Term s r) -> Term s r) -> TermCont @r s a
tcont forall a b. (a -> b) -> a -> b
$ forall (a :: PType) (s :: S) (b :: PType).
PlutusType a =>
Term s a -> (a s -> Term s b) -> Term s b
pmatch Term s PRational
x
          PRational Term s PInteger
yn Term s PPositive
yd <- forall a (s :: S) (r :: PType).
((a -> Term s r) -> Term s r) -> TermCont @r s a
tcont forall a b. (a -> b) -> a -> b
$ forall (a :: PType) (s :: S) (b :: PType).
PlutusType a =>
Term s a -> (a s -> Term s b) -> Term s b
pmatch Term s PRational
y
          Term s PPositive
denm <- forall a (s :: S) (r :: PType).
((a -> Term s r) -> Term s r) -> TermCont @r s a
tcont forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: S) (a :: PType) (b :: PType).
Term s a -> (Term s a -> Term s b) -> Term s b
plet forall a b. (a -> b) -> a -> b
$ forall (s :: S). Term s (PInteger :--> PPositive)
ptryPositive forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
#$ forall (s :: S) (a :: PType). Term s a -> Term s (PInner a)
pto Term s PPositive
xd forall a. Num a => a -> a -> a
* Term s PInteger
yn
          forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (s :: S). Term s (PRational :--> PRational)
preduce forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
#$ forall (a :: PType) (s :: S). PlutusType a => a s -> Term s a
pcon forall a b. (a -> b) -> a -> b
$ forall (s :: S). Term s PInteger -> Term s PPositive -> PRational s
PRational (Term s PInteger
xn forall a. Num a => a -> a -> a
* forall (s :: S) (a :: PType). Term s a -> Term s (PInner a)
pto Term s PPositive
yd) Term s PPositive
denm
      )
      # x'
      # y'

  pfromRational :: forall (s :: S). Term s (PRational :--> PRational)
pfromRational = forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic forall a b. (a -> b) -> a -> b
$ forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
plam forall a. a -> a
id

preduce :: Term s (PRational :--> PRational)
preduce :: forall (s :: S). Term s (PRational :--> PRational)
preduce = forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic forall a b. (a -> b) -> a -> b
$
  forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
plam forall a b. (a -> b) -> a -> b
$ \Term s PRational
x -> forall (a :: PType) (s :: S). TermCont @a s (Term s a) -> Term s a
unTermCont forall a b. (a -> b) -> a -> b
$ do
    PRational Term s PInteger
xn Term s PPositive
xd' <- forall a (s :: S) (r :: PType).
((a -> Term s r) -> Term s r) -> TermCont @r s a
tcont forall a b. (a -> b) -> a -> b
$ forall (a :: PType) (s :: S) (b :: PType).
PlutusType a =>
Term s a -> (a s -> Term s b) -> Term s b
pmatch Term s PRational
x
    Term s PInteger
xd <- forall a (s :: S) (r :: PType).
((a -> Term s r) -> Term s r) -> TermCont @r s a
tcont forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: S) (a :: PType) (b :: PType).
Term s a -> (Term s a -> Term s b) -> Term s b
plet forall a b. (a -> b) -> a -> b
$ forall (s :: S) (a :: PType). Term s a -> Term s (PInner a)
pto Term s PPositive
xd'
    Term s PInteger
r <- forall a (s :: S) (r :: PType).
((a -> Term s r) -> Term s r) -> TermCont @r s a
tcont forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: S) (a :: PType) (b :: PType).
Term s a -> (Term s a -> Term s b) -> Term s b
plet forall a b. (a -> b) -> a -> b
$ forall (s :: S). Term s (PInteger :--> (PInteger :--> PInteger))
pgcd forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PInteger
xn forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PInteger
xd
    Term s PInteger
s <- forall a (s :: S) (r :: PType).
((a -> Term s r) -> Term s r) -> TermCont @r s a
tcont forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: S) (a :: PType) (b :: PType).
Term s a -> (Term s a -> Term s b) -> Term s b
plet forall a b. (a -> b) -> a -> b
$ forall (a :: PType) (s :: S). PNum a => Term s (a :--> a)
psignum forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PInteger
xd
    forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: PType) (s :: S). PlutusType a => a s -> Term s a
pcon forall a b. (a -> b) -> a -> b
$ forall (s :: S). Term s PInteger -> Term s PPositive -> PRational s
PRational (Term s PInteger
s forall a. Num a => a -> a -> a
* forall (a :: PType) (s :: S).
PIntegral a =>
Term s (a :--> (a :--> a))
pdiv forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PInteger
xn forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PInteger
r) forall a b. (a -> b) -> a -> b
$ forall (s :: S) (a :: PType). Term s (PInner a) -> Term s a
punsafeDowncast forall a b. (a -> b) -> a -> b
$ Term s PInteger
s forall a. Num a => a -> a -> a
* forall (a :: PType) (s :: S).
PIntegral a =>
Term s (a :--> (a :--> a))
pdiv forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PInteger
xd forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PInteger
r

pgcd :: Term s (PInteger :--> PInteger :--> PInteger)
pgcd :: forall (s :: S). Term s (PInteger :--> (PInteger :--> PInteger))
pgcd = forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic forall a b. (a -> b) -> a -> b
$
  forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
plam forall a b. (a -> b) -> a -> b
$ \Term s PInteger
x' Term s PInteger
y' -> forall (a :: PType) (s :: S). TermCont @a s (Term s a) -> Term s a
unTermCont forall a b. (a -> b) -> a -> b
$ do
    Term s PInteger
x <- forall a (s :: S) (r :: PType).
((a -> Term s r) -> Term s r) -> TermCont @r s a
tcont forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: S) (a :: PType) (b :: PType).
Term s a -> (Term s a -> Term s b) -> Term s b
plet forall a b. (a -> b) -> a -> b
$ forall (a :: PType) (s :: S). PNum a => Term s (a :--> a)
pabs forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PInteger
x'
    Term s PInteger
y <- forall a (s :: S) (r :: PType).
((a -> Term s r) -> Term s r) -> TermCont @r s a
tcont forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: S) (a :: PType) (b :: PType).
Term s a -> (Term s a -> Term s b) -> Term s b
plet forall a b. (a -> b) -> a -> b
$ forall (a :: PType) (s :: S). PNum a => Term s (a :--> a)
pabs forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PInteger
y'
    forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (s :: S). Term s (PInteger :--> (PInteger :--> PInteger))
pgcd' forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# (forall (a :: PType) (s :: S). POrd a => Term s (a :--> (a :--> a))
pmax forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PInteger
x forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PInteger
y) forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
#$ forall (a :: PType) (s :: S). POrd a => Term s (a :--> (a :--> a))
pmin forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PInteger
x forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PInteger
y

-- assumes inputs are non negative and a >= b
pgcd' :: Term s (PInteger :--> PInteger :--> PInteger)
pgcd' :: forall (s :: S). Term s (PInteger :--> (PInteger :--> PInteger))
pgcd' = forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic forall a b. (a -> b) -> a -> b
$ forall (s :: S) (a :: PType) (b :: PType).
Term s (((a :--> b) :--> (a :--> b)) :--> (a :--> b))
pfix forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
#$ forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
plam forall {b :: PType} {s :: S}.
(PEq b, PNum b, PIntegral b) =>
Term s (b :--> (b :--> b)) -> Term s b -> Term s b -> Term s b
f
  where
    f :: Term s (b :--> (b :--> b)) -> Term s b -> Term s b -> Term s b
f Term s (b :--> (b :--> b))
self Term s b
a Term s b
b =
      forall (s :: S) (a :: PType).
Term s PBool -> Term s a -> Term s a -> Term s a
pif
        (Term s b
b forall (t :: PType) (s :: S).
PEq t =>
Term s t -> Term s t -> Term s PBool
#== Term s b
0)
        Term s b
a
        forall a b. (a -> b) -> a -> b
$ Term s (b :--> (b :--> b))
self forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s b
b forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
#$ forall (a :: PType) (s :: S).
PIntegral a =>
Term s (a :--> (a :--> a))
pmod forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s b
a forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s b
b

pmin :: POrd a => Term s (a :--> a :--> a)
pmin :: forall (a :: PType) (s :: S). POrd a => Term s (a :--> (a :--> a))
pmin = forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic forall a b. (a -> b) -> a -> b
$ forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
plam forall a b. (a -> b) -> a -> b
$ \Term s a
a Term s a
b -> forall (s :: S) (a :: PType).
Term s PBool -> Term s a -> Term s a -> Term s a
pif (Term s a
a forall (t :: PType) (s :: S).
PPartialOrd t =>
Term s t -> Term s t -> Term s PBool
#<= Term s a
b) Term s a
a Term s a
b

pmax :: POrd a => Term s (a :--> a :--> a)
pmax :: forall (a :: PType) (s :: S). POrd a => Term s (a :--> (a :--> a))
pmax = forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic forall a b. (a -> b) -> a -> b
$ forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
plam forall a b. (a -> b) -> a -> b
$ \Term s a
a Term s a
b -> forall (s :: S) (a :: PType).
Term s PBool -> Term s a -> Term s a -> Term s a
pif (Term s a
a forall (t :: PType) (s :: S).
PPartialOrd t =>
Term s t -> Term s t -> Term s PBool
#<= Term s a
b) Term s a
b Term s a
a

pnumerator :: Term s (PRational :--> PInteger)
pnumerator :: forall (s :: S). Term s (PRational :--> PInteger)
pnumerator = forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic forall a b. (a -> b) -> a -> b
$ forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
plam forall a b. (a -> b) -> a -> b
$ \Term s PRational
x -> forall (a :: PType) (s :: S) (b :: PType).
PlutusType a =>
Term s a -> (a s -> Term s b) -> Term s b
pmatch Term s PRational
x forall a b. (a -> b) -> a -> b
$ \(PRational Term s PInteger
n Term s PPositive
_) -> Term s PInteger
n

pdenominator :: Term s (PRational :--> PPositive)
pdenominator :: forall (s :: S). Term s (PRational :--> PPositive)
pdenominator = forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic forall a b. (a -> b) -> a -> b
$ forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
plam forall a b. (a -> b) -> a -> b
$ \Term s PRational
x -> forall (a :: PType) (s :: S) (b :: PType).
PlutusType a =>
Term s a -> (a s -> Term s b) -> Term s b
pmatch Term s PRational
x forall a b. (a -> b) -> a -> b
$ \(PRational Term s PInteger
_ Term s PPositive
d) -> Term s PPositive
d

pfromInteger :: Term s (PInteger :--> PRational)
pfromInteger :: forall (s :: S). Term s (PInteger :--> PRational)
pfromInteger = forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic forall a b. (a -> b) -> a -> b
$ forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
plam forall a b. (a -> b) -> a -> b
$ \Term s PInteger
n -> forall (a :: PType) (s :: S). PlutusType a => a s -> Term s a
pcon forall a b. (a -> b) -> a -> b
$ forall (s :: S). Term s PInteger -> Term s PPositive -> PRational s
PRational Term s PInteger
n Term s PPositive
1

pround :: Term s (PRational :--> PInteger)
pround :: forall (s :: S). Term s (PRational :--> PInteger)
pround = forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic forall a b. (a -> b) -> a -> b
$
  forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
plam forall a b. (a -> b) -> a -> b
$ \Term s PRational
x -> forall (a :: PType) (s :: S). TermCont @a s (Term s a) -> Term s a
unTermCont forall a b. (a -> b) -> a -> b
$ do
    PRational Term s PInteger
a' Term s PPositive
b' <- forall a (s :: S) (r :: PType).
((a -> Term s r) -> Term s r) -> TermCont @r s a
tcont forall a b. (a -> b) -> a -> b
$ forall (a :: PType) (s :: S) (b :: PType).
PlutusType a =>
Term s a -> (a s -> Term s b) -> Term s b
pmatch Term s PRational
x
    Term s PInteger
a <- forall a (s :: S) (r :: PType).
((a -> Term s r) -> Term s r) -> TermCont @r s a
tcont forall a b. (a -> b) -> a -> b
$ forall (s :: S) (a :: PType) (b :: PType).
Term s a -> (Term s a -> Term s b) -> Term s b
plet Term s PInteger
a'
    Term s PPositive
b <- forall a (s :: S) (r :: PType).
((a -> Term s r) -> Term s r) -> TermCont @r s a
tcont forall a b. (a -> b) -> a -> b
$ forall (s :: S) (a :: PType) (b :: PType).
Term s a -> (Term s a -> Term s b) -> Term s b
plet Term s PPositive
b'
    Term s PInteger
base <- forall a (s :: S) (r :: PType).
((a -> Term s r) -> Term s r) -> TermCont @r s a
tcont forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: S) (a :: PType) (b :: PType).
Term s a -> (Term s a -> Term s b) -> Term s b
plet forall a b. (a -> b) -> a -> b
$ forall (a :: PType) (s :: S).
PIntegral a =>
Term s (a :--> (a :--> a))
pdiv forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PInteger
a forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# forall (s :: S) (a :: PType). Term s a -> Term s (PInner a)
pto Term s PPositive
b
    Term s PInteger
rem <- forall a (s :: S) (r :: PType).
((a -> Term s r) -> Term s r) -> TermCont @r s a
tcont forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: S) (a :: PType) (b :: PType).
Term s a -> (Term s a -> Term s b) -> Term s b
plet forall a b. (a -> b) -> a -> b
$ forall (a :: PType) (s :: S).
PIntegral a =>
Term s (a :--> (a :--> a))
pmod forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PInteger
a forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# forall (s :: S) (a :: PType). Term s a -> Term s (PInner a)
pto Term s PPositive
b
    let result :: Term s PInteger
result =
          forall (s :: S) (a :: PType).
Term s PBool -> Term s a -> Term s a -> Term s a
pif
            (forall (a :: PType) (s :: S).
PIntegral a =>
Term s (a :--> (a :--> a))
pmod forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# forall (s :: S) (a :: PType). Term s a -> Term s (PInner a)
pto Term s PPositive
b forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PInteger
2 forall (t :: PType) (s :: S).
PEq t =>
Term s t -> Term s t -> Term s PBool
#== Term s PInteger
1)
            (forall (s :: S) (a :: PType).
Term s PBool -> Term s a -> Term s a -> Term s a
pif (forall (a :: PType) (s :: S).
PIntegral a =>
Term s (a :--> (a :--> a))
pdiv forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# forall (s :: S) (a :: PType). Term s a -> Term s (PInner a)
pto Term s PPositive
b forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PInteger
2 forall (t :: PType) (s :: S).
PPartialOrd t =>
Term s t -> Term s t -> Term s PBool
#< Term s PInteger
rem) Term s PInteger
1 Term s PInteger
0)
            forall a b. (a -> b) -> a -> b
$ forall (s :: S) (a :: PType).
Term s PBool -> Term s a -> Term s a -> Term s a
pif
              (forall (a :: PType) (s :: S).
PIntegral a =>
Term s (a :--> (a :--> a))
pdiv forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# forall (s :: S) (a :: PType). Term s a -> Term s (PInner a)
pto Term s PPositive
b forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PInteger
2 forall (t :: PType) (s :: S).
PEq t =>
Term s t -> Term s t -> Term s PBool
#== Term s PInteger
rem)
              (forall (a :: PType) (s :: S).
PIntegral a =>
Term s (a :--> (a :--> a))
pmod forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PInteger
base forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PInteger
2)
              (forall (s :: S) (a :: PType).
Term s PBool -> Term s a -> Term s a -> Term s a
pif (Term s PInteger
rem forall (t :: PType) (s :: S).
PPartialOrd t =>
Term s t -> Term s t -> Term s PBool
#< forall (a :: PType) (s :: S).
PIntegral a =>
Term s (a :--> (a :--> a))
pdiv forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# forall (s :: S) (a :: PType). Term s a -> Term s (PInner a)
pto Term s PPositive
b forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PInteger
2) Term s PInteger
0 Term s PInteger
1)
    forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Term s PInteger
base forall a. Num a => a -> a -> a
+ Term s PInteger
result

ptruncate :: Term s (PRational :--> PInteger)
ptruncate :: forall (s :: S). Term s (PRational :--> PInteger)
ptruncate = forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic forall a b. (a -> b) -> a -> b
$
  forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
plam forall a b. (a -> b) -> a -> b
$ \Term s PRational
x ->
    forall (a :: PType) (s :: S) (b :: PType).
PlutusType a =>
Term s a -> (a s -> Term s b) -> Term s b
pmatch Term s PRational
x forall a b. (a -> b) -> a -> b
$ \(PRational Term s PInteger
a Term s PPositive
b) ->
      forall (a :: PType) (s :: S).
PIntegral a =>
Term s (a :--> (a :--> a))
pquot forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PInteger
a forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# forall (s :: S) (a :: PType). Term s a -> Term s (PInner a)
pto Term s PPositive
b

pproperFraction :: Term s (PRational :--> PPair PInteger PRational)
pproperFraction :: forall (s :: S). Term s (PRational :--> PPair PInteger PRational)
pproperFraction = forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic forall a b. (a -> b) -> a -> b
$
  forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
plam forall a b. (a -> b) -> a -> b
$ \Term s PRational
x ->
    forall (s :: S) (a :: PType) (b :: PType).
Term s a -> (Term s a -> Term s b) -> Term s b
plet (forall (s :: S). Term s (PRational :--> PInteger)
ptruncate forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PRational
x) forall a b. (a -> b) -> a -> b
$ \Term s PInteger
q ->
      forall (a :: PType) (s :: S). PlutusType a => a s -> Term s a
pcon forall a b. (a -> b) -> a -> b
$ forall (a :: PType) (b :: PType) (s :: S).
Term s a -> Term s b -> PPair a b s
PPair Term s PInteger
q (Term s PRational
x forall a. Num a => a -> a -> a
- forall (s :: S). Term s (PInteger :--> PRational)
Plutarch.Rational.pfromInteger forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PInteger
q)