Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
Original file line number Diff line number Diff line change
Expand Up @@ -41,7 +41,7 @@ module CardanoLoans.Validator
tokenAsPubKey,
adaSymbol,
adaToken,
fromGHC,
fromHaskellRatio,
unsafeRatio,
(-),(*),(+),
loanValidatorCode,
Expand Down
Original file line number Diff line number Diff line change
@@ -0,0 +1,7 @@
### Added

- To v3: numerator,denominator,unsafeRatio

### Changed

- In v3: renamed fromGHC/toGHC to fromRatioHaskell/toRatioHaskell
7 changes: 5 additions & 2 deletions plutus-ledger-api/src/PlutusLedgerApi/Data/V3.hs
Original file line number Diff line number Diff line change
Expand Up @@ -229,8 +229,11 @@ module PlutusLedgerApi.Data.V3 (
-- *** Ratio
Ratio.Rational,
Ratio.ratio,
Ratio.fromGHC,
Ratio.toGHC,
Ratio.unsafeRatio,
Ratio.numerator,
Ratio.denominator,
Ratio.fromHaskellRatio,
Ratio.toHaskellRatio,

-- *** Association maps
V2.Map,
Expand Down
8 changes: 5 additions & 3 deletions plutus-ledger-api/src/PlutusLedgerApi/V3.hs
Original file line number Diff line number Diff line change
Expand Up @@ -121,10 +121,12 @@ module PlutusLedgerApi.V3 (
V2.strictUpperBound,

-- *** Ratio
Ratio.Rational,
Ratio.ratio,
Ratio.fromGHC,
Ratio.toGHC,
Ratio.unsafeRatio,
Ratio.numerator,
Ratio.denominator,
Ratio.fromHaskellRatio,
Ratio.toHaskellRatio,

-- *** Association maps
V2.Map,
Expand Down
8 changes: 4 additions & 4 deletions plutus-tx-plugin/test/StdLib/Spec.hs
Original file line number Diff line number Diff line change
Expand Up @@ -50,7 +50,7 @@ tests =
[ embed testRatioInterop
, testRatioProperty "round" Ratio.round round
, testRatioProperty "truncate" Ratio.truncate truncate
, testRatioProperty "abs" (fmap Ratio.toGHC Ratio.abs) abs
, testRatioProperty "abs" (fmap Ratio.toHaskellRatio Ratio.abs) abs
, embed $ testPropertyNamed "ord" "testOrd" testOrd
, embed $ testPropertyNamed "divMod" "testDivMod" testDivMod
, embed $ testPropertyNamed "quotRem" "testQuotRem" testQuotRem
Expand All @@ -71,7 +71,7 @@ tryHard ~a = reoption <$> (liftIO $ try @SomeException $ evaluate $ force a)

testRatioInterop :: TestTree
testRatioInterop = testCase "ratioInterop" do
runExceptT (runUPlc [getPlcNoAnn roundPlc, snd (Lift.liftProgramDef (Ratio.fromGHC 3.75))])
runExceptT (runUPlc [getPlcNoAnn roundPlc, snd (Lift.liftProgramDef (Ratio.fromHaskellRatio 3.75))])
>>= \case
Left e -> assertFailure (show e)
Right r -> r @?= Core.mkConstant () (4 :: Integer)
Expand All @@ -82,7 +82,7 @@ testRatioProperty nm plutusFunc ghcFunc =
embed $ testPropertyNamed nm (fromString nm) $ Hedgehog.property $ do
rat <- Hedgehog.forAll $ Gen.realFrac_ (Range.linearFrac (-10000) 100000)
let ghcResult = ghcFunc rat
plutusResult = plutusFunc $ Ratio.fromGHC rat
plutusResult = plutusFunc $ Ratio.fromHaskellRatio rat
Hedgehog.annotateShow ghcResult
Hedgehog.annotateShow plutusResult
Hedgehog.assert (ghcResult == plutusResult)
Expand Down Expand Up @@ -117,7 +117,7 @@ testOrd = Hedgehog.property $ do
n1 <- Hedgehog.forAll $ (%) <$> gen <*> gen'
n2 <- Hedgehog.forAll $ (%) <$> gen <*> gen'
ghcResult <- tryHard $ n1 <= n2
plutusResult <- tryHard $ (PlutusTx.<=) (Ratio.fromGHC n1) (Ratio.fromGHC n2)
plutusResult <- tryHard $ (PlutusTx.<=) (Ratio.fromHaskellRatio n1) (Ratio.fromHaskellRatio n2)
Hedgehog.annotateShow ghcResult
Hedgehog.annotateShow plutusResult
Hedgehog.assert (ghcResult == plutusResult)
Expand Down
11 changes: 11 additions & 0 deletions plutus-tx/changelog.d/20251106_085646_bezirg_enum_ratio.md
Original file line number Diff line number Diff line change
@@ -0,0 +1,11 @@
### Removed

- PlutusTx.Ratio: half

### Added

- Enum Ratio instance that mimicks Haskell's instance

### Changed

- Renamed Ratio's fromGHC/toGHC to fromRatioHaskell/toRatioHaskell
76 changes: 56 additions & 20 deletions plutus-tx/src/PlutusTx/Ratio.hs
Original file line number Diff line number Diff line change
Expand Up @@ -31,10 +31,11 @@ module PlutusTx.Ratio (
recip,
abs,
negate,
half,
fromGHC,
toGHC,
gcd,

-- * Conversion from/to Haskell
fromHaskellRatio,
toHaskellRatio,
) where

import PlutusTx.Applicative qualified as P
Expand All @@ -49,13 +50,14 @@ 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.Enum

import Data.Ratio qualified as HS
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, (*))
Expand All @@ -72,6 +74,8 @@ The following two invariants are maintained:
data Rational = Rational Integer Integer
deriving stock (Haskell.Eq, Show, Generic)

makeLift ''Rational

instance Pretty Rational where
pretty (Rational a b) = "Rational:" <+> pretty a <+> pretty b

Expand Down Expand Up @@ -228,12 +232,6 @@ ratio n d
(d `Builtins.quotientInteger` gcd')
{-# INLINEABLE ratio #-}

{-| Converts a 'Rational' to a GHC 'Ratio.Rational', preserving value. Does not
work on-chain.
-}
toGHC :: Rational -> Ratio.Rational
toGHC (Rational n d) = n Ratio.% d

{-| Returns the numerator of its argument.

= Note
Expand All @@ -259,20 +257,11 @@ denominator :: Rational -> Integer
denominator (Rational _ d) = d
{-# INLINEABLE denominator #-}

-- | 0.5
half :: Rational
half = Rational 1 2
{-# INLINEABLE half #-}

-- | Converts an 'Integer' into the equivalent 'Rational'.
fromInteger :: Integer -> Rational
fromInteger num = Rational num P.one
{-# INLINEABLE fromInteger #-}

-- | Converts a GHC 'Ratio.Rational', preserving value. Does not work on-chain.
fromGHC :: Ratio.Rational -> Rational
fromGHC r = unsafeRatio (Ratio.numerator r) (Ratio.denominator r)

{-| Produces the additive inverse of its argument.

= Note
Expand Down Expand Up @@ -342,6 +331,7 @@ round :: Rational -> Integer
round x =
let (n, r) = properFraction x
m = if r P.< P.zero then n P.- P.one else n P.+ P.one
half = Rational 1 2
flag = abs r P.- half
in if
| flag P.< P.zero -> n
Expand Down Expand Up @@ -375,7 +365,53 @@ euclid x y
| P.True = euclid y (x `Builtins.modInteger` y)
{-# INLINEABLE euclid #-}

$(makeLift ''Rational)
instance Enum Rational where
{-# INLINEABLE succ #-}
succ (Rational n d) = Rational (n P.+ d) d
{-# INLINEABLE pred #-}
pred (Rational n d) = Rational (n P.- d) d
{-# INLINEABLE toEnum #-}
toEnum = fromInteger
{-# INLINEABLE fromEnum #-}
fromEnum = truncate
{-# INLINEABLE enumFromTo #-}
enumFromTo x lim
-- See why adding half is needed in the Haskell report: https://www.haskell.org/onlinereport/haskell2010/haskellch6.html
| x > lim P.+ Rational 1 2 = []
| P.True = x : enumFromTo (succ x) lim
{-# INLINEABLE enumFromThenTo #-}
enumFromThenTo x y lim =
if delta >= P.zero
then up_list x
else dn_list x
where
delta = y P.- x
-- denominator of delta cannot be zero because it is constructed from two well-formed ratios. So it is safe to use unsafeRatio
mid = numerator delta `unsafeRatio` (denominator delta P.* 2)
up_list x1 =
-- See why adding mid is needed in the Haskell report: https://www.haskell.org/onlinereport/haskell2010/haskellch6.html
if x1 > lim P.+ mid
then []
else x1 : up_list (x1 P.+ delta)
dn_list x1 =
-- See why adding mid is needed in the Haskell report: https://www.haskell.org/onlinereport/haskell2010/haskellch6.html
if x1 < lim P.+ mid
then []
else x1 : dn_list (x1 P.+ delta)

{-| Converts a GHC 'Ratio.Rational', preserving value.

Note: Does not work on-chain.
-}
fromHaskellRatio :: HS.Rational -> Rational
fromHaskellRatio r = unsafeRatio (HS.numerator r) (HS.denominator r)

{-| Converts a 'Rational' to a GHC 'Ratio.Rational', preserving value.

Note: Does not work on-chain.
-}
toHaskellRatio :: Rational -> HS.Rational
toHaskellRatio (Rational n d) = n HS.% d

{- HLINT ignore -}

Expand Down
Loading