From 5b497a7daf1460f0d3f7314f5b3907113e4cb5ef Mon Sep 17 00:00:00 2001 From: Nikolaos Bezirgiannis Date: Thu, 6 Nov 2025 11:23:55 +0100 Subject: [PATCH] Add Enum Rational to PlutusTx stdlib. Remove Ratio: half/toGHC/fromGHC Remove v3 toGHC/fromGHC --- .../src/CardanoLoans/Validator.hs | 1 - .../20251106_104633_bezirg_enum_ratio.md | 7 + .../src/PlutusLedgerApi/Data/V3.hs | 5 +- plutus-ledger-api/src/PlutusLedgerApi/V3.hs | 6 +- plutus-tx-plugin/test/StdLib/Spec.hs | 13 +- .../20251106_085646_bezirg_enum_ratio.md | 7 + plutus-tx/src/PlutusTx/Ratio.hs | 55 +++++--- plutus-tx/test/Rational/Laws/Construction.hs | 122 +++++++++++++++--- plutus-tx/test/Rational/Laws/Other.hs | 8 +- 9 files changed, 175 insertions(+), 49 deletions(-) create mode 100644 plutus-ledger-api/changelog.d/20251106_104633_bezirg_enum_ratio.md create mode 100644 plutus-tx/changelog.d/20251106_085646_bezirg_enum_ratio.md diff --git a/plutus-benchmark/cardano-loans/src/CardanoLoans/Validator.hs b/plutus-benchmark/cardano-loans/src/CardanoLoans/Validator.hs index 7eb832bd049..835d09a96c8 100644 --- a/plutus-benchmark/cardano-loans/src/CardanoLoans/Validator.hs +++ b/plutus-benchmark/cardano-loans/src/CardanoLoans/Validator.hs @@ -41,7 +41,6 @@ module CardanoLoans.Validator tokenAsPubKey, adaSymbol, adaToken, - fromGHC, unsafeRatio, (-),(*),(+), loanValidatorCode, diff --git a/plutus-ledger-api/changelog.d/20251106_104633_bezirg_enum_ratio.md b/plutus-ledger-api/changelog.d/20251106_104633_bezirg_enum_ratio.md new file mode 100644 index 00000000000..ed2375c124e --- /dev/null +++ b/plutus-ledger-api/changelog.d/20251106_104633_bezirg_enum_ratio.md @@ -0,0 +1,7 @@ +### Removed + +- From v3: fromGHC,toGHC + +### Added + +- To v3: numerator,denominator,unsafeRatio diff --git a/plutus-ledger-api/src/PlutusLedgerApi/Data/V3.hs b/plutus-ledger-api/src/PlutusLedgerApi/Data/V3.hs index 6367f5e707e..17dd1d8f831 100644 --- a/plutus-ledger-api/src/PlutusLedgerApi/Data/V3.hs +++ b/plutus-ledger-api/src/PlutusLedgerApi/Data/V3.hs @@ -229,8 +229,9 @@ module PlutusLedgerApi.Data.V3 ( -- *** Ratio Ratio.Rational, Ratio.ratio, - Ratio.fromGHC, - Ratio.toGHC, + Ratio.unsafeRatio, + Ratio.numerator, + Ratio.denominator, -- *** Association maps V2.Map, diff --git a/plutus-ledger-api/src/PlutusLedgerApi/V3.hs b/plutus-ledger-api/src/PlutusLedgerApi/V3.hs index 6b00a3dff89..227dd4efd0d 100644 --- a/plutus-ledger-api/src/PlutusLedgerApi/V3.hs +++ b/plutus-ledger-api/src/PlutusLedgerApi/V3.hs @@ -121,10 +121,10 @@ module PlutusLedgerApi.V3 ( V2.strictUpperBound, -- *** Ratio - Ratio.Rational, Ratio.ratio, - Ratio.fromGHC, - Ratio.toGHC, + Ratio.unsafeRatio, + Ratio.numerator, + Ratio.denominator, -- *** Association maps V2.Map, diff --git a/plutus-tx-plugin/test/StdLib/Spec.hs b/plutus-tx-plugin/test/StdLib/Spec.hs index 735cae00100..4ba1634a5b0 100644 --- a/plutus-tx-plugin/test/StdLib/Spec.hs +++ b/plutus-tx-plugin/test/StdLib/Spec.hs @@ -17,7 +17,7 @@ import Control.Exception (SomeException, evaluate, try) import Control.Monad.Except (runExceptT) import Control.Monad.IO.Class (MonadIO (liftIO)) import Data.Proxy (Proxy (..)) -import Data.Ratio ((%)) +import Data.Ratio (Ratio,(%), numerator, denominator) import GHC.Exts (fromString) import Hedgehog (MonadGen, Property) import Hedgehog qualified @@ -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 (\ r -> Ratio.numerator r % Ratio.denominator r) Ratio.abs) abs , embed $ testPropertyNamed "ord" "testOrd" testOrd , embed $ testPropertyNamed "divMod" "testDivMod" testDivMod , embed $ testPropertyNamed "quotRem" "testQuotRem" testQuotRem @@ -69,9 +69,12 @@ tryHard :: (MonadIO m, NFData a) => a -> m (Maybe a) -- the body, i.e. outside of the call to 'try', defeating the whole purpose. tryHard ~a = reoption <$> (liftIO $ try @SomeException $ evaluate $ force a) +fromGHC :: Ratio Integer -> Ratio.Rational +fromGHC r = Ratio.unsafeRatio (numerator r) (denominator r) + testRatioInterop :: TestTree testRatioInterop = testCase "ratioInterop" do - runExceptT (runUPlc [getPlcNoAnn roundPlc, snd (Lift.liftProgramDef (Ratio.fromGHC 3.75))]) + runExceptT (runUPlc [getPlcNoAnn roundPlc, snd (Lift.liftProgramDef (fromGHC 3.75))]) >>= \case Left e -> assertFailure (show e) Right r -> r @?= Core.mkConstant () (4 :: Integer) @@ -82,7 +85,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 $ fromGHC rat Hedgehog.annotateShow ghcResult Hedgehog.annotateShow plutusResult Hedgehog.assert (ghcResult == plutusResult) @@ -117,7 +120,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.<=) (fromGHC n1) (fromGHC n2) Hedgehog.annotateShow ghcResult Hedgehog.annotateShow plutusResult Hedgehog.assert (ghcResult == plutusResult) diff --git a/plutus-tx/changelog.d/20251106_085646_bezirg_enum_ratio.md b/plutus-tx/changelog.d/20251106_085646_bezirg_enum_ratio.md new file mode 100644 index 00000000000..555c62d3c25 --- /dev/null +++ b/plutus-tx/changelog.d/20251106_085646_bezirg_enum_ratio.md @@ -0,0 +1,7 @@ +### Removed + +- PlutusTx.Ratio: half, toGHC, fromGHC + +### Added + +- Enum Ratio instance that mimicks GHC instance diff --git a/plutus-tx/src/PlutusTx/Ratio.hs b/plutus-tx/src/PlutusTx/Ratio.hs index 7b648687c58..1a7bf75f26d 100644 --- a/plutus-tx/src/PlutusTx/Ratio.hs +++ b/plutus-tx/src/PlutusTx/Ratio.hs @@ -31,9 +31,6 @@ module PlutusTx.Ratio ( recip, abs, negate, - half, - fromGHC, - toGHC, gcd, ) where @@ -49,13 +46,13 @@ 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 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, (*)) @@ -228,12 +225,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 @@ -259,20 +250,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 @@ -342,6 +324,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 @@ -375,6 +358,40 @@ euclid x y | P.True = euclid y (x `Builtins.modInteger` y) {-# INLINEABLE euclid #-} +instance Enum Rational where + {-# INLINEABLE succ #-} + succ (Rational n d) = Rational (n `Builtins.addInteger` d) d + {-# INLINEABLE pred #-} + pred (Rational n d) = Rational (n `Builtins.subtractInteger` 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) + $(makeLift ''Rational) {- HLINT ignore -} diff --git a/plutus-tx/test/Rational/Laws/Construction.hs b/plutus-tx/test/Rational/Laws/Construction.hs index f20ae784250..3e0b1a486c0 100644 --- a/plutus-tx/test/Rational/Laws/Construction.hs +++ b/plutus-tx/test/Rational/Laws/Construction.hs @@ -1,18 +1,24 @@ -- editorconfig-checker-disable-file {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TupleSections #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE TypeApplications #-} module Rational.Laws.Construction (constructionLaws) where import Hedgehog (Gen, Property, assert, cover, property, (===)) import Hedgehog.Gen qualified as Gen import PlutusTx.Prelude qualified as Plutus -import PlutusTx.Ratio qualified as Ratio -import Prelude -import Rational.Laws.Helpers (forAllWithPP, genInteger, genIntegerPos, normalAndEquivalentToMaybe, +import PlutusTx.Ratio qualified as P +import PlutusTx.Numeric qualified as P +import PlutusTx.Enum qualified as P +import PlutusTx.List qualified as P +import Prelude hiding (succ, pred) +import Rational.Laws.Helpers (forAllWithPP, genRational, genInteger, genIntegerPos, normalAndEquivalentToMaybe, testCoverProperty) import Test.Tasty (TestTree) import Test.Tasty.Hedgehog (testPropertyNamed) +import Data.Ratio qualified as GHC constructionLaws :: [TestTree] constructionLaws = @@ -37,22 +43,49 @@ constructionLaws = "denominator (unsafeRatio x y) > 0" "propUnsafeRatioDenomPos" propUnsafeRatioDenomPos - ] + , testPropertyNamed "succ(r)>r" + "propSuccGt" + propSuccGt + , testPropertyNamed "pred(r) length(enumFromTo n m) = abs(n-m)+1" + "propEnumFromToInteger" + propEnumFromToInteger + , testPropertyNamed "enumFromTo = GHC.enumFromTo" + "propEnumFromToGHC" + propEnumFromToGHC + , testPropertyNamed "x/=y ==> enumFromThenTo x y x = [x]" + "propEnumFromThenToLim" + propEnumFromThenToLim + , testPropertyNamed "x/=y ==> enumFromThenTo = GHC.enumFromThenTo" + "propEnumFromThenToGHC" + propEnumFromThenToGHC + , testPropertyNamed "enumFromTo x y = enumFromThenTo x (x+1) y" + "propEnumFromToThenTo" + propEnumFromToThenTo + ] propZeroDenom :: Property propZeroDenom = property $ do x <- forAllWithPP genInteger - Ratio.ratio x Plutus.zero `normalAndEquivalentToMaybe` Nothing + P.ratio x Plutus.zero `normalAndEquivalentToMaybe` Nothing propOneDenom :: Property propOneDenom = property $ do x <- forAllWithPP genInteger - Ratio.ratio x Plutus.one `normalAndEquivalentToMaybe` (Just . Ratio.fromInteger $ x) + P.ratio x Plutus.one `normalAndEquivalentToMaybe` (Just . P.fromInteger $ x) propRatioSelf :: Property propRatioSelf = property $ do x <- forAllWithPP . Gen.filter (/= Plutus.zero) $ genInteger - Ratio.ratio x x `normalAndEquivalentToMaybe` Just Plutus.one + P.ratio x x `normalAndEquivalentToMaybe` Just Plutus.one propRatioSign :: Property propRatioSign = property $ do @@ -60,7 +93,7 @@ propRatioSign = property $ do cover 30 "zero numerator" $ n == 0 cover 30 "same signs" $ signum n == signum d cover 30 "different signs" $ (signum n /= signum d) && n /= 0 - let r = Ratio.ratio n d + let r = P.ratio n d let signIndicator = Plutus.compare <$> r <*> pure Plutus.zero case (signum n, signum d) of (0, _) -> signIndicator === Just Plutus.EQ @@ -89,31 +122,88 @@ propConstructionAgreement :: Property propConstructionAgreement = property $ do n <- forAllWithPP genInteger d <- forAllWithPP . Gen.filter (/= Plutus.zero) $ genInteger - Ratio.ratio n d `normalAndEquivalentToMaybe` (Just . Ratio.unsafeRatio n $ d) + P.ratio n d `normalAndEquivalentToMaybe` (Just . P.unsafeRatio n $ d) propFromIntegerNum :: Property propFromIntegerNum = property $ do x <- forAllWithPP genInteger - let r = Ratio.fromInteger x - Ratio.numerator r === x + let r = P.fromInteger x + P.numerator r === x propFromIntegerDen :: Property propFromIntegerDen = property $ do x <- forAllWithPP genInteger - let r = Ratio.fromInteger x - Ratio.denominator r === Plutus.one + let r = P.fromInteger x + P.denominator r === Plutus.one propRatioScale :: Property propRatioScale = property $ do x <- forAllWithPP genInteger y <- forAllWithPP genInteger z <- forAllWithPP . Gen.filter (/= Plutus.zero) $ genInteger - let lhs = Ratio.ratio x y - let rhs = Ratio.ratio (x Plutus.* z) (y Plutus.* z) + let lhs = P.ratio x y + let rhs = P.ratio (x Plutus.* z) (y Plutus.* z) lhs `normalAndEquivalentToMaybe` rhs propUnsafeRatioDenomPos :: Property propUnsafeRatioDenomPos = property $ do n <- forAllWithPP genInteger d <- forAllWithPP $ Gen.filter (/= Plutus.zero) genInteger - assert $ Ratio.denominator (Ratio.unsafeRatio n d) > 0 + assert $ P.denominator (P.unsafeRatio n d) > 0 + +propSuccGt :: Property +propSuccGt = property $ do + n <- forAllWithPP genRational + assert $ P.succ n > n + +propPredLt :: Property +propPredLt = property $ do + n <- forAllWithPP genRational + assert $ P.pred n < n + +propDenomToEnum :: Property +propDenomToEnum = property $ do + n <- forAllWithPP genInteger + P.denominator (P.toEnum n) === 1 + +propFromToEnumId :: Property +propFromToEnumId = property $ do + n <- forAllWithPP genInteger + P.fromEnum @P.Rational (P.toEnum n) === n + +propEnumFromToInteger :: Property +propEnumFromToInteger = property $ do + n <- forAllWithPP genInteger + m <- forAllWithPP $ Gen.filter (>=n) genInteger + P.length(P.enumFromTo @P.Rational (P.toEnum n) (P.toEnum m)) === abs (n - m) + 1 + +propEnumFromThenToLim :: Property +propEnumFromThenToLim = property $ do + x <- forAllWithPP genRational + y <- forAllWithPP $ Gen.filter (/=x) genRational + P.enumFromThenTo x y x === [x] + +propEnumFromToGHC :: Property +propEnumFromToGHC = property $ do + x <- forAllWithPP genRational + y <- forAllWithPP genRational + fmap toGHC (P.enumFromTo x y) === enumFromTo (toGHC x) (toGHC y) + +propEnumFromThenToGHC :: Property +propEnumFromThenToGHC = property $ do + x <- forAllWithPP genRational + y <- forAllWithPP $ Gen.filter (/=x) genRational + z <- forAllWithPP genRational + fmap toGHC (P.enumFromThenTo x y z) === enumFromThenTo (toGHC x) (toGHC y) (toGHC z) + +propEnumFromToThenTo :: Property +propEnumFromToThenTo = property $ do + x <- forAllWithPP genRational + y <- forAllWithPP genRational + P.enumFromTo x y === P.enumFromThenTo x (x P.+ Plutus.one) y + +{-| Converts a 'Rational' to a GHC 'Rational', preserving value. Does not +work on-chain. +-} +toGHC :: P.Rational -> Rational +toGHC r = P.numerator r GHC.% P.denominator r diff --git a/plutus-tx/test/Rational/Laws/Other.hs b/plutus-tx/test/Rational/Laws/Other.hs index b4e369f6276..99ec983917b 100644 --- a/plutus-tx/test/Rational/Laws/Other.hs +++ b/plutus-tx/test/Rational/Laws/Other.hs @@ -141,13 +141,15 @@ propRoundHalf = property $ do (1, False) -> rounded === n Plutus.+ Plutus.one _ -> rounded === n where + half = Ratio.unsafeRatio 1 2 + go :: Gen (Integer, Plutus.Rational) go = do n <- genInteger f <- case signum n of - (-1) -> pure . Ratio.negate $ Ratio.half - 0 -> Gen.element [Ratio.half, Ratio.negate Ratio.half] - _ -> pure Ratio.half + (-1) -> pure . Ratio.negate $ half + 0 -> Gen.element [half, Ratio.negate half] + _ -> pure half pure (n, f) propRoundLow :: Property