{-# LANGUAGE PackageImports #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}

module Plutarch.Extra.Rational (
  PRationalNoReduce (..),
  pnoReduce,
  preduce',
  mulTruncate,
  mulDivTruncate,
  divTruncate,
  mulRational,
  divRational,
  pliftTaggedRational,
  (#%),
) where

-------------------------------------------------------------------------------

import Data.Maybe (fromJust)
import Data.Tagged (Tagged)
import GHC.Stack (HasCallStack)
import Plutarch.Builtin (pforgetData)
import Plutarch.Extra.Tagged (PTagged)
import "plutarch-extra" Plutarch.Extra.TermCont (pmatchC)
import Plutarch.Num (PNum (pabs, pfromInteger, pnegate, psignum, (#*), (#+), (#-)))
import Plutarch.Orphans ()
import Plutarch.Positive (PPositive)
import Plutarch.Rational (preduce)
import Plutarch.Unsafe (punsafeCoerce, punsafeDowncast)
import PlutusTx (fromData)

-------------------------------------------------------------------------------

{- | Wrapper for 'PRational'. Numeric instances of this don't reduce the
 fraction after each operation.
-}
newtype PRationalNoReduce (s :: S)
  = PRationalNoReduce (Term s PRational)
  deriving stock
    ( -- | @since 3.12.2
      forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (s :: S) x.
Rep (PRationalNoReduce s) x -> PRationalNoReduce s
forall (s :: S) x.
PRationalNoReduce s -> Rep (PRationalNoReduce s) x
$cto :: forall (s :: S) x.
Rep (PRationalNoReduce s) x -> PRationalNoReduce s
$cfrom :: forall (s :: S) x.
PRationalNoReduce s -> Rep (PRationalNoReduce s) x
Generic
    )
  deriving anyclass
    ( -- | @since 3.12.2
      forall (s :: S).
PRationalNoReduce s -> Term s (PInner PRationalNoReduce)
forall (s :: S) (b :: PType).
Term s (PInner PRationalNoReduce)
-> (PRationalNoReduce 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 PRationalNoReduce)
-> (PRationalNoReduce s -> Term s b) -> Term s b
$cpmatch' :: forall (s :: S) (b :: PType).
Term s (PInner PRationalNoReduce)
-> (PRationalNoReduce s -> Term s b) -> Term s b
pcon' :: forall (s :: S).
PRationalNoReduce s -> Term s (PInner PRationalNoReduce)
$cpcon' :: forall (s :: S).
PRationalNoReduce s -> Term s (PInner PRationalNoReduce)
PlutusType
    , -- | @since 3.12.2
      forall (s :: S).
Term s (PAsData PRationalNoReduce) -> Term s PRationalNoReduce
forall (s :: S). Term s PRationalNoReduce -> Term s PData
forall (a :: PType).
(forall (s :: S). Term s (PAsData a) -> Term s a)
-> (forall (s :: S). Term s a -> Term s PData) -> PIsData a
pdataImpl :: forall (s :: S). Term s PRationalNoReduce -> Term s PData
$cpdataImpl :: forall (s :: S). Term s PRationalNoReduce -> Term s PData
pfromDataImpl :: forall (s :: S).
Term s (PAsData PRationalNoReduce) -> Term s PRationalNoReduce
$cpfromDataImpl :: forall (s :: S).
Term s (PAsData PRationalNoReduce) -> Term s PRationalNoReduce
PIsData
    , -- | @since 3.12.2
      forall (s :: S).
Term s PRationalNoReduce
-> Term s PRationalNoReduce -> Term s PBool
forall (t :: PType).
(forall (s :: S). Term s t -> Term s t -> Term s PBool) -> PEq t
#== :: forall (s :: S).
Term s PRationalNoReduce
-> Term s PRationalNoReduce -> Term s PBool
$c#== :: forall (s :: S).
Term s PRationalNoReduce
-> Term s PRationalNoReduce -> Term s PBool
PEq
    , -- | @since 3.12.2
      PEq PRationalNoReduce
forall (s :: S).
Term s PRationalNoReduce
-> Term s PRationalNoReduce -> Term s PBool
forall (t :: PType).
PEq t
-> (forall (s :: S). Term s t -> Term s t -> Term s PBool)
-> (forall (s :: S). Term s t -> Term s t -> Term s PBool)
-> PPartialOrd t
#< :: forall (s :: S).
Term s PRationalNoReduce
-> Term s PRationalNoReduce -> Term s PBool
$c#< :: forall (s :: S).
Term s PRationalNoReduce
-> Term s PRationalNoReduce -> Term s PBool
#<= :: forall (s :: S).
Term s PRationalNoReduce
-> Term s PRationalNoReduce -> Term s PBool
$c#<= :: forall (s :: S).
Term s PRationalNoReduce
-> Term s PRationalNoReduce -> Term s PBool
PPartialOrd
    , -- | @since 3.12.2
      PPartialOrd PRationalNoReduce
forall (t :: PType). PPartialOrd t -> POrd t
POrd
    )

-- | @since 3.12.2
instance DerivePlutusType PRationalNoReduce where
  type DPTStrat _ = PlutusTypeNewtype

{- | Put a 'PRational' into a wrapper that prevents reducing after every numeric operation.

 @since 3.12.2
-}
pnoReduce :: forall (s :: S). Term s PRational -> Term s PRationalNoReduce
pnoReduce :: forall (s :: S). Term s PRational -> Term s PRationalNoReduce
pnoReduce = forall (a :: PType) (s :: S). PlutusType a => a s -> Term s a
pcon forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: S). Term s PRational -> PRationalNoReduce s
PRationalNoReduce

{- | Free a 'PRational' from its no-reduce-wrapper and reduce it.

 @since 3.12.2
-}
preduce' :: forall (s :: S). Term s PRationalNoReduce -> Term s PRational
preduce' :: forall (s :: S). Term s PRationalNoReduce -> Term s PRational
preduce' Term s PRationalNoReduce
nr = 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 (s :: S) (a :: PType). Term s a -> Term s (PInner a)
pto Term s PRationalNoReduce
nr

-- | @since 3.12.2
instance PNum PRationalNoReduce where
  Term s PRationalNoReduce
x' #+ :: forall (s :: S).
Term s PRationalNoReduce
-> Term s PRationalNoReduce -> Term s PRationalNoReduce
#+ Term s PRationalNoReduce
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 PRationalNoReduce
x Term s PRationalNoReduce
y -> forall (a :: PType) (s :: S). TermCont 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 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 forall a b. (a -> b) -> a -> b
$ forall (s :: S) (a :: PType). Term s a -> Term s (PInner a)
pto Term s PRationalNoReduce
x
          PRational Term s PInteger
yn Term s PPositive
yd' <- forall a (s :: S) (r :: PType).
((a -> Term s r) -> Term s r) -> TermCont 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 forall a b. (a -> b) -> a -> b
$ forall (s :: S) (a :: PType). Term s a -> Term s (PInner a)
pto Term s PRationalNoReduce
y
          Term s PPositive
xd <- forall a (s :: S) (r :: PType).
((a -> Term s r) -> Term s r) -> TermCont 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 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 (a :: PType) (s :: S). PlutusType a => a s -> Term s a
pcon forall a b. (a -> b) -> a -> b
$
              forall (s :: S). Term s PRational -> PRationalNoReduce s
PRationalNoReduce forall a b. (a -> b) -> a -> 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 forall a. Num a => a -> a -> a
+ Term s PInteger
yn forall a. Num a => a -> a -> a
* 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) (a :: PType). Term s (PInner a) -> Term s a
punsafeDowncast forall a b. (a -> b) -> a -> 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
* forall (s :: S) (a :: PType). Term s a -> Term s (PInner a)
pto Term s PPositive
yd
      )
      # x'
      # y'

  Term s PRationalNoReduce
x' #- :: forall (s :: S).
Term s PRationalNoReduce
-> Term s PRationalNoReduce -> Term s PRationalNoReduce
#- Term s PRationalNoReduce
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 PRationalNoReduce
x Term s PRationalNoReduce
y -> forall (a :: PType) (s :: S). TermCont 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 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 forall a b. (a -> b) -> a -> b
$ forall (s :: S) (a :: PType). Term s a -> Term s (PInner a)
pto Term s PRationalNoReduce
x
          PRational Term s PInteger
yn Term s PPositive
yd' <- forall a (s :: S) (r :: PType).
((a -> Term s r) -> Term s r) -> TermCont 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 forall a b. (a -> b) -> a -> b
$ forall (s :: S) (a :: PType). Term s a -> Term s (PInner a)
pto Term s PRationalNoReduce
y
          Term s PPositive
xd <- forall a (s :: S) (r :: PType).
((a -> Term s r) -> Term s r) -> TermCont 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 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 (a :: PType) (s :: S). PlutusType a => a s -> Term s a
pcon forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: S). Term s PRational -> PRationalNoReduce s
PRationalNoReduce forall a b. (a -> b) -> a -> 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 forall a. Num a => a -> a -> a
- Term s PInteger
yn forall a. Num a => a -> a -> a
* 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) (a :: PType). Term s (PInner a) -> Term s a
punsafeDowncast forall a b. (a -> b) -> a -> 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
* forall (s :: S) (a :: PType). Term s a -> Term s (PInner a)
pto Term s PPositive
yd
      )
      # x'
      # y'

  Term s PRationalNoReduce
x' #* :: forall (s :: S).
Term s PRationalNoReduce
-> Term s PRationalNoReduce -> Term s PRationalNoReduce
#* Term s PRationalNoReduce
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 PRationalNoReduce
x Term s PRationalNoReduce
y -> forall (a :: PType) (s :: S). TermCont 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 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 forall a b. (a -> b) -> a -> b
$ forall (s :: S) (a :: PType). Term s a -> Term s (PInner a)
pto Term s PRationalNoReduce
x
          PRational Term s PInteger
yn Term s PPositive
yd <- forall a (s :: S) (r :: PType).
((a -> Term s r) -> Term s r) -> TermCont 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 forall a b. (a -> b) -> a -> b
$ forall (s :: S) (a :: PType). Term s a -> Term s (PInner a)
pto Term s PRationalNoReduce
y
          forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
            forall (a :: PType) (s :: S). PlutusType a => a s -> Term s a
pcon forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: S). Term s PRational -> PRationalNoReduce s
PRationalNoReduce forall a b. (a -> b) -> a -> 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
* Term s PInteger
yn) 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
$
                    forall (s :: S) (a :: PType). Term s a -> Term s (PInner a)
pto Term s PPositive
xd forall a. Num a => a -> a -> a
* forall (s :: S) (a :: PType). Term s a -> Term s (PInner a)
pto Term s PPositive
yd
      )
      # x'
      # y'

  pnegate :: forall (s :: S). Term s (PRationalNoReduce :--> PRationalNoReduce)
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 PRationalNoReduce
x ->
        forall (a :: PType) (s :: S) (b :: PType).
PlutusType a =>
Term s a -> (a s -> Term s b) -> Term s b
pmatch Term s PRationalNoReduce
x forall a b. (a -> b) -> a -> b
$ \(PRationalNoReduce Term s PRational
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 PRational -> PRationalNoReduce s
PRationalNoReduce (forall (a :: PType) (s :: S). PNum a => Term s (a :--> a)
pnegate forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PRational
x')

  pabs :: forall (s :: S). Term s (PRationalNoReduce :--> PRationalNoReduce)
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 PRationalNoReduce
x ->
        forall (a :: PType) (s :: S) (b :: PType).
PlutusType a =>
Term s a -> (a s -> Term s b) -> Term s b
pmatch Term s PRationalNoReduce
x forall a b. (a -> b) -> a -> b
$ \(PRationalNoReduce Term s PRational
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 PRational -> PRationalNoReduce s
PRationalNoReduce (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 PRational
x')

  psignum :: forall (s :: S). Term s (PRationalNoReduce :--> PRationalNoReduce)
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 PRationalNoReduce
x ->
        forall (a :: PType) (s :: S) (b :: PType).
PlutusType a =>
Term s a -> (a s -> Term s b) -> Term s b
pmatch Term s PRationalNoReduce
x forall a b. (a -> b) -> a -> b
$ \(PRationalNoReduce Term s PRational
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 PRational -> PRationalNoReduce s
PRationalNoReduce (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 PRational
x')

  pfromInteger :: forall (s :: S). Integer -> Term s PRationalNoReduce
pfromInteger Integer
n = forall (a :: PType) (s :: S). PlutusType a => a s -> Term s a
pcon forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: S). Term s PRational -> PRationalNoReduce s
PRationalNoReduce forall a b. (a -> b) -> a -> b
$ forall (a :: PType) (s :: S). PNum a => Integer -> Term s a
pfromInteger Integer
n

--------------------------------------------------------------------------------

{- | Combined multiply-truncate.

 @since 3.9.0
-}
mulTruncate ::
  forall (s :: S).
  Term s (PRational :--> PInteger :--> PInteger)
mulTruncate :: forall (s :: S). Term s (PRational :--> (PInteger :--> PInteger))
mulTruncate =
  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
ex Term s PInteger
x -> forall (a :: PType) (s :: S). TermCont s (Term s a) -> Term s a
unTermCont forall a b. (a -> b) -> a -> b
$ do
      (PRational Term s PInteger
num Term s PPositive
denom) <- forall {r :: PType} (a :: PType) (s :: S).
PlutusType a =>
Term s a -> TermCont s (a s)
pmatchC Term s PRational
ex
      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 :--> PInteger)))
mulDivTruncate 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
num 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
denom

{- | Multiply the first argument by the second argument, divide by the third,
 truncating.

 @since 3.9.0
-}
mulDivTruncate ::
  forall (s :: S).
  Term s (PInteger :--> PInteger :--> PInteger :--> PInteger)
mulDivTruncate :: forall (s :: S).
Term s (PInteger :--> (PInteger :--> (PInteger :--> PInteger)))
mulDivTruncate =
  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
num Term s PInteger
denom ->
      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
num forall a. Num a => a -> a -> a
* 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
denom

{- | Combined divide-truncate.

 @since 3.9.0
-}
divTruncate ::
  forall (s :: S).
  Term s (PRational :--> PInteger :--> PInteger)
divTruncate :: forall (s :: S). Term s (PRational :--> (PInteger :--> PInteger))
divTruncate =
  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
ex Term s PInteger
x -> forall (a :: PType) (s :: S). TermCont s (Term s a) -> Term s a
unTermCont forall a b. (a -> b) -> a -> b
$ do
      (PRational Term s PInteger
num Term s PPositive
denom) <- forall {r :: PType} (a :: PType) (s :: S).
PlutusType a =>
Term s a -> TermCont s (a s)
pmatchC Term s PRational
ex
      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 :--> PInteger)))
mulDivTruncate 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
# forall (s :: S) (a :: PType). Term s a -> Term s (PInner a)
pto Term s PPositive
denom forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PInteger
num

{- | Scale a 'PRational' up by a factor indicated by a 'PInteger',
 without reducing the fraction.

 = Note

 This merely \'defers\' the reduction until later, with possibly a (very)
 large numerator. Use this only in cases where you know that this won't
 cause a performance blow-up later.

 @since 3.9.0
-}
mulRational ::
  forall (s :: S).
  Term s (PInteger :--> PRational :--> PRational)
mulRational :: forall (s :: S). Term s (PInteger :--> (PRational :--> PRational))
mulRational =
  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 PRational
r -> forall (a :: PType) (s :: S). TermCont s (Term s a) -> Term s a
unTermCont forall a b. (a -> b) -> a -> b
$ do
      (PRational Term s PInteger
num Term s PPositive
denom) <- forall {r :: PType} (a :: PType) (s :: S).
PlutusType a =>
Term s a -> TermCont s (a s)
pmatchC Term s PRational
r
      forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> 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
num forall a. Num a => a -> a -> a
* Term s PInteger
x) Term s PPositive
denom

{- | Scale a 'PRational' down by a factor indicated by a 'PInteger', without
 reducing the fraction.

 = Note

 This has the same performance caveats as 'mulRational'.

 @since 3.9.0
-}
divRational ::
  forall (s :: S).
  Term s (PInteger :--> PRational :--> PRational)
divRational :: forall (s :: S). Term s (PInteger :--> (PRational :--> PRational))
divRational =
  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 PRational
r -> forall (a :: PType) (s :: S). TermCont s (Term s a) -> Term s a
unTermCont forall a b. (a -> b) -> a -> b
$ do
      (PRational Term s PInteger
num Term s PPositive
denom) <- forall {r :: PType} (a :: PType) (s :: S).
PlutusType a =>
Term s a -> TermCont s (a s)
pmatchC 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
denom forall a. Num a => a -> a -> a
* Term s PInteger
x) forall (s :: S).
Term s PInteger -> Term s PInteger -> Term s PRational
#% Term s PInteger
num

infixl 7 #%

{- | Create a 'PRational' out of two 'PIntegers'. Will error if the denominator
 is zero.

 @since 3.9.0
-}
(#%) ::
  forall (s :: S).
  Term s PInteger ->
  Term s PInteger ->
  Term s PRational
Term s PInteger
x #% :: forall (s :: S).
Term s PInteger -> Term s PInteger -> Term s PRational
#% Term s PInteger
y =
  forall (s :: S) (r :: PType).
Term s PInteger
-> (Term s PPositive -> Term s r)
-> (Term s PPositive -> Term s r)
-> Term s r
ptoPositiveCases
    Term s PInteger
y
    (forall (a :: PType) (s :: S). PlutusType a => a s -> Term s a
pcon forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: S). Term s PInteger -> Term s PPositive -> PRational s
PRational (Term s PInteger
x forall a. Num a => a -> a -> a
* (-Term s PInteger
1)))
    (forall (a :: PType) (s :: S). PlutusType a => a s -> Term s a
pcon forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: S). Term s PInteger -> Term s PPositive -> PRational s
PRational Term s PInteger
x)

{- | Absolute 'PInteger' as 'PPositive', distinguishing the @< 0@ and @> 0@ cases.

 Will error on 0.
-}
ptoPositiveCases ::
  forall (s :: S) (r :: PType).
  Term s PInteger ->
  (Term s PPositive -> Term s r) ->
  (Term s PPositive -> Term s r) ->
  Term s r
ptoPositiveCases :: forall (s :: S) (r :: PType).
Term s PInteger
-> (Term s PPositive -> Term s r)
-> (Term s PPositive -> Term s r)
-> Term s r
ptoPositiveCases Term s PInteger
n Term s PPositive -> Term s r
contNeg Term s PPositive -> Term s r
contPos =
  forall (s :: S) (a :: PType).
Term s PBool -> Term s a -> Term s a -> Term s a
pif
    (Term s PInteger
n forall (t :: PType) (s :: S).
PPartialOrd t =>
Term s t -> Term s t -> Term s PBool
#<= Term s PInteger
0)
    ( forall (s :: S) (a :: PType).
Term s PBool -> Term s a -> Term s a -> Term s a
pif
        (Term s PInteger
n forall (t :: PType) (s :: S).
PEq t =>
Term s t -> Term s t -> Term s PBool
#== Term s PInteger
0)
        (forall (s :: S) (a :: PType). Term s PString -> Term s a
ptraceError Term s PString
"ptoPositiveCases with 0")
        -- The PPositive constructor is not exported, so we need coercion
        (Term s PPositive -> Term s r
contNeg (forall (s :: S) (a :: PType) (b :: PType). Term s a -> Term s b
punsafeCoerce forall a b. (a -> b) -> a -> b
$ -Term s PInteger
n))
    )
    (Term s PPositive -> Term s r
contPos (forall (s :: S) (a :: PType) (b :: PType). Term s a -> Term s b
punsafeCoerce Term s PInteger
n))

-- | `plift` for Tagged Rationals (kind polymorphic)
pliftTaggedRational ::
  forall k (tag :: k).
  HasCallStack =>
  ClosedTerm (PTagged tag PRational) ->
  Tagged tag Rational
pliftTaggedRational :: forall k (tag :: k).
HasCallStack =>
ClosedTerm (PTagged tag PRational) -> Tagged tag Rational
pliftTaggedRational ClosedTerm (PTagged tag PRational)
term =
  forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$
    forall a. FromData a => Data -> Maybe a
PlutusTx.fromData forall a b. (a -> b) -> a -> b
$
      forall (p :: PType).
(HasCallStack, PLift p) =>
ClosedTerm p -> PLifted p
plift (forall (s :: S) (a :: PType). Term s (PAsData a) -> Term s PData
pforgetData forall a b. (a -> b) -> a -> b
$ forall (a :: PType) (s :: S).
PIsData a =>
Term s a -> Term s (PAsData a)
pdata ClosedTerm (PTagged tag PRational)
term)