Add Enum Rational to PlutusTx stdlib.

Remove Ratio: half/toGHC/fromGHC
Remove v3 toGHC/fromGHC

Author: bezirg

plutus-benchmark/cardano-loans/src/CardanoLoans/Validator.hs

@@ -41,7 +41,6 @@ module CardanoLoans.Validator
   tokenAsPubKey,
   adaSymbol,
   adaToken,
-  fromGHC,
   unsafeRatio,
   (-),(*),(+),
   loanValidatorCode,

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

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,

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,

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)

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

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 -}

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,30 +43,57 @@ constructionLaws =
       "denominator (unsafeRatio x y) > 0"
       "propUnsafeRatioDenomPos"
       propUnsafeRatioDenomPos
-  ]
+  , testPropertyNamed "succ(r)>r"
+      "propSuccGt"
+      propSuccGt
+  , testPropertyNamed "pred(r)<r"
+      "propPredLt"
+      propPredLt
+  , testPropertyNamed "fromEnum . toEnum n = n"
+      "propFromToEnumId"
+      propFromToEnumId
+  , testPropertyNamed "denominator . toEnum = 1"
+      "propDenomToEnum"
+      propDenomToEnum
+  , testPropertyNamed "n<=m ==> 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
   (n, d) <- forAllWithPP go
   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