diff --git a/plutus-ledger-api/changelog.d/20260527_123507_yuriy.lazaryev_issue_2242_optimal_valueof.md b/plutus-ledger-api/changelog.d/20260527_123507_yuriy.lazaryev_issue_2242_optimal_valueof.md new file mode 100644 index 00000000000..a3bc3ceb4c7 --- /dev/null +++ b/plutus-ledger-api/changelog.d/20260527_123507_yuriy.lazaryev_issue_2242_optimal_valueof.md @@ -0,0 +1,3 @@ +### Changed + +- `PlutusLedgerApi.V1.Data.Value.valueOf` rewritten to walk the underlying `BuiltinList` directly via `unsafeDataAsMap` / `unsafeDataAsB` / `unsafeDataAsI` and short-circuit on the first match. The previous implementation went through `Map.lookup`, which materialised a `Maybe` only to deconstruct it immediately. Semantics are unchanged. diff --git a/plutus-ledger-api/src/PlutusLedgerApi/V1/Data/Value.hs b/plutus-ledger-api/src/PlutusLedgerApi/V1/Data/Value.hs index 12f70850204..2d868ac6134 100644 --- a/plutus-ledger-api/src/PlutusLedgerApi/V1/Data/Value.hs +++ b/plutus-ledger-api/src/PlutusLedgerApi/V1/Data/Value.hs @@ -336,11 +336,18 @@ instance MeetSemiLattice Value where {-| Get the quantity of the given currency in the 'Value'. Assumes that the underlying map doesn't contain duplicate keys. -} valueOf :: Value -> CurrencySymbol -> TokenName -> Integer -valueOf value cur tn = - withCurrencySymbol cur value 0 \tokens -> - case Map.lookup tn tokens of - Nothing -> 0 - Just v -> v +valueOf (Value mp) (CurrencySymbol curBs) (TokenName tnBs) = + goOuter (Map.toBuiltinList mp) + where + goOuter = B.caseList' 0 \hd -> + if B.equalsByteString curBs (BI.unsafeDataAsB (BI.fst hd)) + then \_ -> goInner (BI.unsafeDataAsMap (BI.snd hd)) + else goOuter + + goInner = B.caseList' 0 \hd -> + if B.equalsByteString tnBs (BI.unsafeDataAsB (BI.fst hd)) + then \_ -> BI.unsafeDataAsI (BI.snd hd) + else goInner {-# INLINEABLE valueOf #-} {-| Apply a continuation function to the token quantities of the given currency diff --git a/plutus-tx-plugin/test-ledger-api/Spec.hs b/plutus-tx-plugin/test-ledger-api/Spec.hs index 3c7aebe63a2..8b9cd6c4005 100644 --- a/plutus-tx-plugin/test-ledger-api/Spec.hs +++ b/plutus-tx-plugin/test-ledger-api/Spec.hs @@ -27,6 +27,7 @@ tests = , Spec.Data.Budget.tests , Spec.Data.ScriptContext.tests , Spec.Data.Value.test_EqValue + , Spec.Data.Value.test_valueOf , Spec.Data.MintValue.V3.tests , Spec.Envelope.tests , Spec.ReturnUnit.V1.tests diff --git a/plutus-tx-plugin/test-ledger-api/Spec/Data/Budget.hs b/plutus-tx-plugin/test-ledger-api/Spec/Data/Budget.hs index 3e9a1e63b14..2c28a42b600 100644 --- a/plutus-tx-plugin/test-ledger-api/Spec/Data/Budget.hs +++ b/plutus-tx-plugin/test-ledger-api/Spec/Data/Budget.hs @@ -31,6 +31,7 @@ tests = runTestNested ["test-ledger-api", "Spec", "Data", "Budget"] . pure . testNestedGhc $ [ goldenPirReadable "gt" compiledGt , goldenPirReadable "currencySymbolValueOf" compiledCurrencySymbolValueOf + , goldenPirReadable "valueOf" compiledValueOf ] ++ testCases @@ -49,6 +50,9 @@ compiledMintValueBurned = $$(compile [||MintValue.mintValueBurned||]) compiledCurrencySymbolValueOf :: CompiledCode (Value -> CurrencySymbol -> Integer) compiledCurrencySymbolValueOf = $$(compile [||currencySymbolValueOf||]) +compiledValueOf :: CompiledCode (Value -> CurrencySymbol -> TokenName -> Integer) +compiledValueOf = $$(compile [||valueOf||]) + mkValue :: [(Integer, [(Integer, Integer)])] -> Value mkValue = Value . mkCurrencyMap @@ -177,6 +181,34 @@ testCases = `unsafeApplyCode` liftCodeDef value2 `unsafeApplyCode` liftCodeDef (toSymbol 6) ) + , goldenEvalCekCatchBudget + "valueOf_hit_first" + ( compiledValueOf + `unsafeApplyCode` liftCodeDef value1 + `unsafeApplyCode` liftCodeDef (toSymbol 1) + `unsafeApplyCode` liftCodeDef (toToken 100) + ) + , goldenEvalCekCatchBudget + "valueOf_hit_middle" + ( compiledValueOf + `unsafeApplyCode` liftCodeDef value1 + `unsafeApplyCode` liftCodeDef (toSymbol 3) + `unsafeApplyCode` liftCodeDef (toToken 302) + ) + , goldenEvalCekCatchBudget + "valueOf_hit_last" + ( compiledValueOf + `unsafeApplyCode` liftCodeDef value1 + `unsafeApplyCode` liftCodeDef (toSymbol 5) + `unsafeApplyCode` liftCodeDef (toToken 508) + ) + , goldenEvalCekCatchBudget + "valueOf_miss" + ( compiledValueOf + `unsafeApplyCode` liftCodeDef value1 + `unsafeApplyCode` liftCodeDef (toSymbol 99) + `unsafeApplyCode` liftCodeDef (toToken 999) + ) , goldenEvalCekCatchBudget "mintValueMinted" ( compiledMintValueMinted diff --git a/plutus-tx-plugin/test-ledger-api/Spec/Data/Budget/9.6/valueOf.golden.pir b/plutus-tx-plugin/test-ledger-api/Spec/Data/Budget/9.6/valueOf.golden.pir new file mode 100644 index 00000000000..db803a61d8c --- /dev/null +++ b/plutus-tx-plugin/test-ledger-api/Spec/Data/Budget/9.6/valueOf.golden.pir @@ -0,0 +1,51 @@ +\(ds : + (\k a -> list (pair data data)) + bytestring + ((\k a -> list (pair data data)) bytestring integer)) + (ds : bytestring) + (ds : bytestring) -> + letrec + !goInner : list (pair data data) -> integer + = \(xs : list (pair data data)) -> + case + integer + xs + [ (\(hd : pair data data) -> + case + (all dead. list (pair data data) -> integer) + (equalsByteString + ds + (unBData (case data hd [(\(l : data) (r : data) -> l)]))) + [ (/\dead -> goInner) + , (/\dead -> + \(ds : list (pair data data)) -> + unIData + (case data hd [(\(l : data) (r : data) -> r)])) ] + {all dead. dead}) + , 0 ] + in + letrec + !goOuter : list (pair data data) -> integer + = \(xs : list (pair data data)) -> + case + integer + xs + [ (\(hd : pair data data) -> + case + (all dead. list (pair data data) -> integer) + (equalsByteString + ds + (unBData (case data hd [(\(l : data) (r : data) -> l)]))) + [ (/\dead -> goOuter) + , (/\dead -> + \(ds : list (pair data data)) -> + goInner + (unMapData + (case + data + hd + [(\(l : data) (r : data) -> r)]))) ] + {all dead. dead}) + , 0 ] + in + goOuter ds \ No newline at end of file diff --git a/plutus-tx-plugin/test-ledger-api/Spec/Data/Budget/9.6/valueOf_hit_first.golden.eval b/plutus-tx-plugin/test-ledger-api/Spec/Data/Budget/9.6/valueOf_hit_first.golden.eval new file mode 100644 index 00000000000..f6df72b796e --- /dev/null +++ b/plutus-tx-plugin/test-ledger-api/Spec/Data/Budget/9.6/valueOf_hit_first.golden.eval @@ -0,0 +1,6 @@ +CPU: 1_343_411 +Memory: 7_730 +AST Size: 89 +Flat Size: 248 + +(con integer 101) \ No newline at end of file diff --git a/plutus-tx-plugin/test-ledger-api/Spec/Data/Budget/9.6/valueOf_hit_last.golden.eval b/plutus-tx-plugin/test-ledger-api/Spec/Data/Budget/9.6/valueOf_hit_last.golden.eval new file mode 100644 index 00000000000..a4251fb407d --- /dev/null +++ b/plutus-tx-plugin/test-ledger-api/Spec/Data/Budget/9.6/valueOf_hit_last.golden.eval @@ -0,0 +1,6 @@ +CPU: 4_551_187 +Memory: 25_594 +AST Size: 89 +Flat Size: 248 + +(con integer 509) \ No newline at end of file diff --git a/plutus-tx-plugin/test-ledger-api/Spec/Data/Budget/9.6/valueOf_hit_middle.golden.eval b/plutus-tx-plugin/test-ledger-api/Spec/Data/Budget/9.6/valueOf_hit_middle.golden.eval new file mode 100644 index 00000000000..600f334e38b --- /dev/null +++ b/plutus-tx-plugin/test-ledger-api/Spec/Data/Budget/9.6/valueOf_hit_middle.golden.eval @@ -0,0 +1,6 @@ +CPU: 2_546_327 +Memory: 14_429 +AST Size: 89 +Flat Size: 248 + +(con integer 303) \ No newline at end of file diff --git a/plutus-tx-plugin/test-ledger-api/Spec/Data/Budget/9.6/valueOf_miss.golden.eval b/plutus-tx-plugin/test-ledger-api/Spec/Data/Budget/9.6/valueOf_miss.golden.eval new file mode 100644 index 00000000000..8c390d5dd60 --- /dev/null +++ b/plutus-tx-plugin/test-ledger-api/Spec/Data/Budget/9.6/valueOf_miss.golden.eval @@ -0,0 +1,6 @@ +CPU: 2_484_960 +Memory: 14_265 +AST Size: 89 +Flat Size: 249 + +(con integer 0) \ No newline at end of file diff --git a/plutus-tx-plugin/test-ledger-api/Spec/Data/Value.hs b/plutus-tx-plugin/test-ledger-api/Spec/Data/Value.hs index a3809caf4df..3b321e3c516 100644 --- a/plutus-tx-plugin/test-ledger-api/Spec/Data/Value.hs +++ b/plutus-tx-plugin/test-ledger-api/Spec/Data/Value.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE BlockArguments #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} @@ -12,9 +13,13 @@ import Prelude qualified as Haskell import PlutusLedgerApi.V1.Data.Value +import Plinth.Plugin (plinthc) import PlutusTx.Base +import PlutusTx.Builtins qualified as B +import PlutusTx.Builtins.Internal qualified as BI import PlutusTx.Code (CompiledCode, getPlc, unsafeApplyCode) import PlutusTx.Data.AssocMap qualified as AssocMap +import PlutusTx.IsData qualified as Tx import PlutusTx.Lift import PlutusTx.List qualified as List import PlutusTx.Maybe @@ -22,6 +27,7 @@ import PlutusTx.Numeric import PlutusTx.Prelude hiding (integerToByteString) import PlutusTx.Show (toDigits) import PlutusTx.TH (compile) +import PlutusTx.Test.Run.Code (evalResult, evaluateCompiledCode) import PlutusTx.Traversable qualified as Tx import PlutusCore.Builtin qualified as PLC @@ -31,12 +37,16 @@ import UntypedPlutusCore qualified as PLC import UntypedPlutusCore.Evaluation.Machine.Cek qualified as PLC import Control.Exception qualified as Haskell +import Data.ByteString qualified as BS import Data.Functor qualified as Haskell import Data.List qualified as Haskell import Data.Map qualified as Map +import PlutusLedgerApi.Test.V1.Data.Value qualified as ListToValue import Prettyprinter qualified as Pretty +import Test.QuickCheck (Arbitrary (arbitrary), forAll, (===)) import Test.Tasty import Test.Tasty.Extras +import Test.Tasty.QuickCheck (testProperty) scalingFactor :: Integer scalingFactor = 4 @@ -258,3 +268,53 @@ test_EqValue = $ [ test_EqCurrencyList "Short" currencyListOptions , test_EqCurrencyList "Long" currencyLongListOptions ] + +-- | Compiled non-builtin 'valueOf', evaluated on CEK by the property test. +compiledValueOf :: CompiledCode (Value -> CurrencySymbol -> TokenName -> Integer) +compiledValueOf = plinthc valueOf + +{-| Compiled builtin lookup: @\\bd cs tn -> lookupCoin cs tn (unsafeDataAsValue bd)@. +Used as the independent oracle in the differential property test for 'valueOf'. -} +compiledBuiltinLookup + :: CompiledCode (BI.BuiltinData -> BI.BuiltinByteString -> BI.BuiltinByteString -> Integer) +compiledBuiltinLookup = + plinthc (\bd c t -> B.lookupCoin c t (B.unsafeDataAsValue bd)) + +{-| Check that the non-builtin 'valueOf' agrees with the builtin lookup path +('unsafeDataAsValue' + 'lookupCoin') when both are evaluated on the CEK machine. -} +test_valueOf :: TestTree +test_valueOf = + testProperty "non-builtin valueOf matches builtin lookupCoin on CEK" \rawValue -> + let value = + ListToValue.listsToValue + . Haskell.sortOn fst + . Haskell.filter (Haskell.not . Haskell.null . snd) + . Haskell.map + ( Haskell.fmap + ( Haskell.sortOn fst + . Haskell.filter ((Haskell./= 0) . snd) + ) + ) + $ ListToValue.valueToLists rawValue + genBytes = Haskell.fmap BS.pack arbitrary + genKeyPair = + Haskell.liftA2 + (\bs1 bs2 -> (currencySymbol bs1, tokenName bs2)) + genBytes + genBytes + in forAll genKeyPair \(cs, tn) -> + let nonBuiltin = + evalResult + . evaluateCompiledCode + $ compiledValueOf + `unsafeApplyCode` liftCodeDef value + `unsafeApplyCode` liftCodeDef cs + `unsafeApplyCode` liftCodeDef tn + builtin = + evalResult + . evaluateCompiledCode + $ compiledBuiltinLookup + `unsafeApplyCode` liftCodeDef (Tx.toBuiltinData value) + `unsafeApplyCode` liftCodeDef (unCurrencySymbol cs) + `unsafeApplyCode` liftCodeDef (unTokenName tn) + in nonBuiltin === builtin