Spec.Data.Value.Budget — non-builtin valueOf evidence (NOT FOR MERGE)

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.

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

plutus-tx-plugin/plutus-tx-plugin.cabal

@@ -273,6 +273,7 @@ test-suite plutus-ledger-api-plugin-test
     Spec.Data.MintValue.V3
     Spec.Data.ScriptContext
     Spec.Data.Value
+    Spec.Data.Value.Budget
     Spec.Envelope
     Spec.MintValue.V3
     Spec.ReturnUnit.V1

plutus-tx-plugin/test-ledger-api/Spec.hs

@@ -5,6 +5,7 @@ import Spec.Data.Budget qualified
 import Spec.Data.MintValue.V3 qualified
 import Spec.Data.ScriptContext qualified
 import Spec.Data.Value qualified
+import Spec.Data.Value.Budget qualified
 import Spec.Envelope qualified
 import Spec.MintValue.V3 qualified
 import Spec.ReturnUnit.V1 qualified
@@ -27,6 +28,8 @@ tests =
     , Spec.Data.Budget.tests
     , Spec.Data.ScriptContext.tests
     , Spec.Data.Value.test_EqValue
+    , Spec.Data.Value.test_valueOf
+    , Spec.Data.Value.Budget.tests
     , Spec.Data.MintValue.V3.tests
     , Spec.Envelope.tests
     , Spec.ReturnUnit.V1.tests

plutus-tx-plugin/test-ledger-api/Spec/Data/Value.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE BlockArguments #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TemplateHaskell #-}
@@ -12,16 +13,21 @@ 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
 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