From b4d1df4762b189bbf14c7de9467ca803bf90d8ae Mon Sep 17 00:00:00 2001 From: Yuriy Lazaryev Date: Wed, 27 May 2026 14:01:09 +0200 Subject: [PATCH] Optimal non-builtin valueOf in plutus-ledger-api Data.Value MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Rewrites `PlutusLedgerApi.V1.Data.Value.valueOf` so the non-builtin lookup path walks the underlying `BuiltinList` directly via `unsafeDataAsMap` / `unsafeDataAsB` / `unsafeDataAsI`, compares keys with `equalsByteString`, and short-circuits on the first match. No `Maybe` is materialised: the "absent" answer is `0`, returned in-place by the `nilCase` of each traversal. Avoids `withCurrencySymbol`'s continuation + `Map.lookup`'s `Maybe`-wrapping, and bypasses the `ToData k`/`UnsafeFromData a` dictionary work that `AssocMap.lookup` does per element. Semantics preserved. Adds `Spec.Data.Value.test_valueOf`: a QuickCheck property that compiles `valueOf` via TH, evaluates it on the CEK machine, and compares the result against the host-Haskell `valueOf` for the same inputs. Differential test against the Plinth compiler — any divergence is a compilation bug, not a semantics bug. Budget evidence (lookup matrix, `unsafeDataAsValue` baseline) lives on the companion experimental branch `yura/issue-2242-valueof-evidence`, kept out of this PR to avoid carrying ~96 golden files that would only ever regenerate on upstream plugin/cost-model changes. For IntersectMBO/plutus-private#2242. --- ...riy.lazaryev_issue_2242_optimal_valueof.md | 3 + .../src/PlutusLedgerApi/V1/Data/Value.hs | 17 ++++-- plutus-tx-plugin/test-ledger-api/Spec.hs | 1 + .../test-ledger-api/Spec/Data/Value.hs | 60 +++++++++++++++++++ 4 files changed, 76 insertions(+), 5 deletions(-) create mode 100644 plutus-ledger-api/changelog.d/20260527_123507_yuriy.lazaryev_issue_2242_optimal_valueof.md 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/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