From f2742c451cd10c1eb17db0330ef518b46ea35981 Mon Sep 17 00:00:00 2001 From: zeme Date: Thu, 23 Apr 2026 12:19:39 +0200 Subject: [PATCH 1/2] Use UArray DefaultFun Bool for availability check in scriptCBORDecoder The builtin availability check in `scriptCBORDecoder` was using `Set DefaultFun` for O(log n) membership, with a TODO suggesting `IntSet`. A `UArray DefaultFun Bool` is a better fit: since `DefaultFun` derives `Ix`, lookup is a true O(1) unboxed array index with no conversion at the lookup site. The array is built once per call via `runSTUArray`, folding over the `Set` through its `Foldable` instance (no intermediate list). The array covers all ~100 `DefaultFun` constructors. --- plutus-ledger-api/plutus-ledger-api.cabal | 1 + .../src/PlutusLedgerApi/Common/SerialisedScript.hs | 13 +++++++++---- 2 files changed, 10 insertions(+), 4 deletions(-) diff --git a/plutus-ledger-api/plutus-ledger-api.cabal b/plutus-ledger-api/plutus-ledger-api.cabal index 662f40594d8..a6fdb6c5b02 100644 --- a/plutus-ledger-api/plutus-ledger-api.cabal +++ b/plutus-ledger-api/plutus-ledger-api.cabal @@ -109,6 +109,7 @@ library build-depends: , aeson , aeson-pretty + , array , base >=4.9 && <5 , base16-bytestring >=1 , bytestring diff --git a/plutus-ledger-api/src/PlutusLedgerApi/Common/SerialisedScript.hs b/plutus-ledger-api/src/PlutusLedgerApi/Common/SerialisedScript.hs index dd8853dbada..741be5ce2e9 100644 --- a/plutus-ledger-api/src/PlutusLedgerApi/Common/SerialisedScript.hs +++ b/plutus-ledger-api/src/PlutusLedgerApi/Common/SerialisedScript.hs @@ -45,7 +45,8 @@ import Control.Monad.Except (MonadError) import Data.ByteString.Lazy qualified as BSL import Data.ByteString.Short import Data.Coerce -import Data.Set as Set +import Data.Array.ST (newArray, runSTUArray, writeArray) +import Data.Array.Unboxed (UArray, (!)) import GHC.Generics import NoThunks.Class import Prettyprinter @@ -197,10 +198,14 @@ scriptCBORDecoder -> CBOR.Decoder s ScriptNamedDeBruijn scriptCBORDecoder ll pv = -- See Note [New builtins/language versions and protocol versions] - let availableBuiltins = builtinsAvailableIn ll pv + let available = builtinsAvailableIn ll pv + availableArr :: UArray DefaultFun Bool + availableArr = runSTUArray $ do + arr <- newArray (minBound, maxBound) False + mapM_ (\f -> writeArray arr f True) available + return arr flatDecoder = UPLC.decodeProgram checkBuiltin - -- TODO: optimize this by using a better datastructure e.g. 'IntSet' - checkBuiltin f | f `Set.member` availableBuiltins = Nothing + checkBuiltin f | availableArr ! f = Nothing checkBuiltin f = Just $ "Builtin function " From fce40f38554bf0bd5be0bf8cccecdf249df5045c Mon Sep 17 00:00:00 2001 From: zeme Date: Tue, 26 May 2026 13:05:32 +0200 Subject: [PATCH 2/2] Applied requested changes --- .../Common/SerialisedScript.hs | 13 +--- .../src/PlutusLedgerApi/Common/Versions.hs | 65 +++++++++++++++---- plutus-ledger-api/test/Spec/Data/Versions.hs | 2 +- plutus-ledger-api/test/Spec/Versions.hs | 2 +- 4 files changed, 56 insertions(+), 26 deletions(-) diff --git a/plutus-ledger-api/src/PlutusLedgerApi/Common/SerialisedScript.hs b/plutus-ledger-api/src/PlutusLedgerApi/Common/SerialisedScript.hs index 9189a577da3..76f67905f39 100644 --- a/plutus-ledger-api/src/PlutusLedgerApi/Common/SerialisedScript.hs +++ b/plutus-ledger-api/src/PlutusLedgerApi/Common/SerialisedScript.hs @@ -43,11 +43,10 @@ import Control.Lens import Control.Monad (unless, when) import Control.Monad.Error.Lens import Control.Monad.Except (MonadError) +import Data.Array.Unboxed ((!)) import Data.ByteString.Lazy qualified as BSL import Data.ByteString.Short import Data.Coerce -import Data.Array.ST (newArray, runSTUArray, writeArray) -import Data.Array.Unboxed (UArray, (!)) import GHC.Generics import NoThunks.Class import Prettyprinter @@ -199,13 +198,7 @@ scriptCBORDecoder -> CBOR.Decoder s ScriptNamedDeBruijn scriptCBORDecoder ll pv = -- See Note [New builtins/language versions and protocol versions] - let available = builtinsAvailableIn ll pv - - availableArr :: UArray DefaultFun Bool - availableArr = runSTUArray $ do - arr <- newArray (minBound, maxBound) False - mapM_ (\f -> writeArray arr f True) available - return arr + let availableBuiltins = builtinsAvailableIn ll pv flatDecoder = UPLC.decodeProgram checkConstant checkBuiltin checkConstr @@ -222,7 +215,7 @@ scriptCBORDecoder ll pv = ++ " is not available in protocol version " ++ show (pretty pv) - checkBuiltin f | availableArr ! f = Nothing + checkBuiltin f | availableBuiltins ! f = Nothing checkBuiltin f = Just $ "Builtin function " diff --git a/plutus-ledger-api/src/PlutusLedgerApi/Common/Versions.hs b/plutus-ledger-api/src/PlutusLedgerApi/Common/Versions.hs index 281be0622fa..dad8fa989b4 100644 --- a/plutus-ledger-api/src/PlutusLedgerApi/Common/Versions.hs +++ b/plutus-ledger-api/src/PlutusLedgerApi/Common/Versions.hs @@ -24,6 +24,7 @@ module PlutusLedgerApi.Common.Versions , plcVersionsAvailableIn , builtinsIntroducedIn , builtinsAvailableIn + , builtinsAvailableInAsSet , batch1 , batch2 , batch3 @@ -40,6 +41,9 @@ import PlutusLedgerApi.Common.ProtocolVersions import PlutusPrelude import Codec.Serialise.Class (Serialise) +import Control.Monad (forM_, when) +import Data.Array.ST (newArray, runSTUArray, writeArray) +import Data.Array.Unboxed (UArray, accumArray, range, (!)) import Data.Map qualified as Map import Data.Set qualified as Set import NoThunks.Class (NoThunks) @@ -130,6 +134,22 @@ collectUpTo m thisPv = Map.elems $ Map.takeWhileAntitone (<= thisPv) m +{-| Build a @UArray DefaultFun Bool@ from a list of builtin functions: each +index in the list is set to @True@, every other index is @False@. Used to +represent a set of builtins for fast O(1) membership lookup. -} +toBuiltinArr :: [DefaultFun] -> UArray DefaultFun Bool +toBuiltinArr fs = accumArray (||) False (minBound, maxBound) [(f, True) | f <- fs] + +{-| Element-wise OR over a list of builtin-availability arrays. The result has +@True@ at index @f@ iff at least one of the input arrays has @True@ at @f@. -} +unionBuiltinArrs :: [UArray DefaultFun Bool] -> UArray DefaultFun Bool +unionBuiltinArrs arrs = runSTUArray $ do + acc <- newArray (minBound, maxBound) False + forM_ arrs $ \arr -> + forM_ (range (minBound, maxBound)) $ \i -> + when (arr ! i) $ writeArray acc i True + pure acc + {- Batches of builtins which were introduced in the same hard fork (but perhaps not for all LLs): see the Plutus Core specification and `builtinsIntroducedIn` below. @@ -307,32 +327,49 @@ batch6 = builtins are added. It is not necessary to add entries for protocol versions where no new builtins are added. See Note [New builtins/language versions and protocol versions] -} -builtinsIntroducedIn :: PlutusLedgerLanguage -> Map.Map MajorProtocolVersion (Set.Set DefaultFun) +builtinsIntroducedIn + :: PlutusLedgerLanguage -> Map.Map MajorProtocolVersion (UArray DefaultFun Bool) builtinsIntroducedIn = \case PlutusV1 -> Map.fromList - [ (alonzoPV, Set.fromList batch1) - , (vanRossemPV, Set.fromList (batch2 ++ batch3 ++ batch4 ++ batch5 ++ batch6)) + [ (alonzoPV, toBuiltinArr batch1) + , (vanRossemPV, toBuiltinArr (batch2 ++ batch3 ++ batch4 ++ batch5 ++ batch6)) ] PlutusV2 -> Map.fromList - [ (vasilPV, Set.fromList (batch1 ++ batch2)) - , (valentinePV, Set.fromList batch3) - , (plominPV, Set.fromList batch4b) - , (vanRossemPV, Set.fromList (batch4a ++ batch5 ++ batch6)) + [ (vasilPV, toBuiltinArr (batch1 ++ batch2)) + , (valentinePV, toBuiltinArr batch3) + , (plominPV, toBuiltinArr batch4b) + , (vanRossemPV, toBuiltinArr (batch4a ++ batch5 ++ batch6)) ] PlutusV3 -> Map.fromList - [ (changPV, Set.fromList (batch1 ++ batch2 ++ batch3 ++ batch4)) - , (plominPV, Set.fromList batch5) - , (vanRossemPV, Set.fromList batch6) + [ (changPV, toBuiltinArr (batch1 ++ batch2 ++ batch3 ++ batch4)) + , (plominPV, toBuiltinArr batch5) + , (vanRossemPV, toBuiltinArr batch6) ] -{-| Return a set containing the builtins which are available in a given LL in a -given PV. All builtins are available in all LLs from `vanRossemPV` onwards. -} -builtinsAvailableIn :: PlutusLedgerLanguage -> MajorProtocolVersion -> Set.Set DefaultFun -builtinsAvailableIn = collectUpTo . builtinsIntroducedIn +{-| Return a @UArray DefaultFun Bool@ marking which builtins are available in a +given LL in a given PV. All builtins are available in all LLs from +`vanRossemPV` onwards. The returned array is indexed by 'DefaultFun' for O(1) +membership lookup. -} +builtinsAvailableIn :: PlutusLedgerLanguage -> MajorProtocolVersion -> UArray DefaultFun Bool +builtinsAvailableIn ll pv = + unionBuiltinArrs $ + Map.elems $ + Map.takeWhileAntitone (<= pv) $ + builtinsIntroducedIn ll + +{-| The set of builtins available for a given LL in a given PV. This is the +@Set@ view of 'builtinsAvailableIn' (which itself returns a +@UArray DefaultFun Bool@ for O(1) membership lookup), provided for callers +that prefer to work with @Set@. -} +builtinsAvailableInAsSet + :: PlutusLedgerLanguage -> MajorProtocolVersion -> Set.Set DefaultFun +builtinsAvailableInAsSet ll pv = + let arr = builtinsAvailableIn ll pv + in Set.fromList [f | f <- range (minBound, maxBound), arr ! f] {-| A map indicating which Plutus Core versions were introduced in which 'MajorProtocolVersion' and 'PlutusLedgerLanguage'. Each version should appear at most once. diff --git a/plutus-ledger-api/test/Spec/Data/Versions.hs b/plutus-ledger-api/test/Spec/Data/Versions.hs index fe4f906fb78..86aebf4261a 100644 --- a/plutus-ledger-api/test/Spec/Data/Versions.hs +++ b/plutus-ledger-api/test/Spec/Data/Versions.hs @@ -433,7 +433,7 @@ testBuiltinAvailabilityCompatibility = ++ " @PV" ++ show pv ) - $ builtinsAvailableIn ll pv == builtinsAvailableIn_old ll pv + $ builtinsAvailableInAsSet ll pv == builtinsAvailableIn_old ll pv | pv <- [shelleyPV .. plominPV] , ll <- Set.toList (ledgerLanguagesAvailableIn pv) ] diff --git a/plutus-ledger-api/test/Spec/Versions.hs b/plutus-ledger-api/test/Spec/Versions.hs index ceb229acfcb..87cbdb18259 100644 --- a/plutus-ledger-api/test/Spec/Versions.hs +++ b/plutus-ledger-api/test/Spec/Versions.hs @@ -443,7 +443,7 @@ testBuiltinAvailabilityCompatibility = ++ " @PV" ++ show pv ) - $ builtinsAvailableIn ll pv == builtinsAvailableIn_old ll pv + $ builtinsAvailableInAsSet ll pv == builtinsAvailableIn_old ll pv | pv <- [shelleyPV .. plominPV] , ll <- Set.toList (ledgerLanguagesAvailableIn pv) ]