From a9a71bd60af2a47c42265ef7224bf743dbae4081 Mon Sep 17 00:00:00 2001 From: effectfully Date: Fri, 22 Mar 2024 17:55:59 +0100 Subject: [PATCH] Provide support for multiple 'CostModel's --- plutus-benchmark/validation/bench/Common.hs | 14 +++++--- plutus-conformance/haskell/Spec.hs | 4 +-- .../budgeting-bench/Benchmarks/Nops.hs | 3 +- .../cost-model/budgeting-bench/Common.hs | 2 +- .../src/PlutusCore/Default/Builtins.hs | 2 +- .../Evaluation/Machine/ExBudgetingDefaults.hs | 8 +++-- .../Evaluation/Machine/MachineParameters.hs | 31 +++++------------ .../Machine/MachineParameters/Default.hs | 34 +++++++++++++------ .../Evaluation/Machine/Cek.hs | 16 ++++----- .../Evaluation/Machine/Cek/Internal.hs | 4 +-- .../Evaluation/Machine/CommonAPI.hs | 18 +++++----- .../Evaluation/Machine/SteppableCek.hs | 16 ++++----- .../Machine/SteppableCek/Internal.hs | 4 +-- .../test/Evaluation/Builtins/Common.hs | 2 +- .../src/PlutusLedgerApi/Common/Eval.hs | 19 ++++------- .../PlutusLedgerApi/V1/EvaluationContext.hs | 1 + .../PlutusLedgerApi/V2/EvaluationContext.hs | 1 + .../PlutusLedgerApi/V3/EvaluationContext.hs | 9 +++-- 18 files changed, 99 insertions(+), 89 deletions(-) diff --git a/plutus-benchmark/validation/bench/Common.hs b/plutus-benchmark/validation/bench/Common.hs index 5f1c2691015..345abdbb250 100644 --- a/plutus-benchmark/validation/bench/Common.hs +++ b/plutus-benchmark/validation/bench/Common.hs @@ -138,10 +138,16 @@ benchWith act = do mkEvalCtx :: EvaluationContext mkEvalCtx = case PLC.defaultCostModelParams of - -- The validation benchmarks were all created from PlutusV1 scripts - Just p -> case mkDynEvaluationContext (const PLC.DefaultFunSemanticsVariant1) p of - Right ec -> ec - Left err -> error $ show err + Just p -> + let errOrCtx = + -- The validation benchmarks were all created from PlutusV1 scripts + mkDynEvaluationContext + [PLC.DefaultFunSemanticsVariant1] + (const PLC.DefaultFunSemanticsVariant1) + p + in case errOrCtx of + Right ec -> ec + Left err -> error $ show err Nothing -> error "Couldn't get cost model params" -- | Evaluate a term as it would be evaluated using the on-chain evaluator. diff --git a/plutus-conformance/haskell/Spec.hs b/plutus-conformance/haskell/Spec.hs index 9c8d8156ad5..d94d4dbebe9 100644 --- a/plutus-conformance/haskell/Spec.hs +++ b/plutus-conformance/haskell/Spec.hs @@ -12,9 +12,9 @@ import UntypedPlutusCore.Evaluation.Machine.Cek (CountingSt (..), counting, runC evalUplcProg :: UplcEvaluator evalUplcProg = UplcEvaluatorWithCosting $ \modelParams (UPLC.Program a v t) -> do - params <- case mkMachineParametersFor (const def) modelParams of + params <- case mkMachineParametersFor [def] (const def) modelParams of Left _ -> Nothing - Right p -> Just $ ($ ()) <$> p + Right p -> Just $ p () -- runCek-like functions (e.g. evaluateCekNoEmit) are partial on term's with free variables, -- that is why we manually check first for any free vars case UPLC.deBruijnTerm t of diff --git a/plutus-core/cost-model/budgeting-bench/Benchmarks/Nops.hs b/plutus-core/cost-model/budgeting-bench/Benchmarks/Nops.hs index 295eb1106b8..feeaa4cf3b6 100644 --- a/plutus-core/cost-model/budgeting-bench/Benchmarks/Nops.hs +++ b/plutus-core/cost-model/budgeting-bench/Benchmarks/Nops.hs @@ -120,8 +120,7 @@ nopCostModel = (ModelSixArgumentsConstantCost 600) } -nopCostParameters :: - MachineParameters CekMachineCosts (BuiltinsRuntime NopFun (CekValue DefaultUni NopFun ())) +nopCostParameters :: MachineParameters CekMachineCosts NopFun (CekValue DefaultUni NopFun ()) nopCostParameters = mkMachineParameters def $ CostModel defaultCekMachineCosts nopCostModel diff --git a/plutus-core/cost-model/budgeting-bench/Common.hs b/plutus-core/cost-model/budgeting-bench/Common.hs index 9d261c83c6e..a314102ffda 100644 --- a/plutus-core/cost-model/budgeting-bench/Common.hs +++ b/plutus-core/cost-model/budgeting-bench/Common.hs @@ -74,7 +74,7 @@ copyData = benchWith :: (Pretty fun, Typeable fun) - => MachineParameters CekMachineCosts (BuiltinsRuntime fun (CekValue DefaultUni fun ())) + => MachineParameters CekMachineCosts fun (CekValue DefaultUni fun ()) -> String -> PlainTerm DefaultUni fun -> Benchmark diff --git a/plutus-core/plutus-core/src/PlutusCore/Default/Builtins.hs b/plutus-core/plutus-core/src/PlutusCore/Default/Builtins.hs index 8b1c1bac8f9..fe5d1a1942d 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Default/Builtins.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Default/Builtins.hs @@ -1079,7 +1079,7 @@ instance uni ~ DefaultUni => ToBuiltinMeaning uni DefaultFun where = DefaultFunSemanticsVariant0 | DefaultFunSemanticsVariant1 | DefaultFunSemanticsVariant2 - deriving stock (Enum, Bounded, Show) + deriving stock (Eq, Enum, Bounded, Show) -- Integers toBuiltinMeaning diff --git a/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/ExBudgetingDefaults.hs b/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/ExBudgetingDefaults.hs index 9a2843e7412..6ed3b1fa62f 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/ExBudgetingDefaults.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/ExBudgetingDefaults.hs @@ -7,6 +7,7 @@ module PlutusCore.Evaluation.Machine.ExBudgetingDefaults ( defaultBuiltinsRuntimeForSemanticsVariant , defaultBuiltinsRuntime , defaultCekCostModel + , toCekCostModel , defaultCekMachineCosts , defaultCekParameters , defaultCostModelParams @@ -79,12 +80,15 @@ defaultCekMachineCosts = defaultCekCostModel :: CostModel CekMachineCosts BuiltinCostModel defaultCekCostModel = CostModel defaultCekMachineCosts defaultBuiltinCostModel +toCekCostModel :: BuiltinSemanticsVariant DefaultFun -> CostModel CekMachineCosts BuiltinCostModel +toCekCostModel _ = defaultCekCostModel + -- | The default cost model data. This is exposed to the ledger, so let's not -- confuse anybody by mentioning the CEK machine defaultCostModelParams :: Maybe CostModelParams defaultCostModelParams = extractCostModelParams defaultCekCostModel -defaultCekParameters :: Typeable ann => MachineParameters CekMachineCosts (BuiltinsRuntime DefaultFun (CekValue DefaultUni DefaultFun ann)) +defaultCekParameters :: Typeable ann => MachineParameters CekMachineCosts DefaultFun (CekValue DefaultUni DefaultFun ann) -- See Note [noinline for saving on ticks]. defaultCekParameters = noinline mkMachineParameters def defaultCekCostModel @@ -94,7 +98,7 @@ matter. Otherwise compilation for this module is slower and GHC may end up exhau ticks leading to a compilation error. -} -unitCekParameters :: Typeable ann => MachineParameters CekMachineCosts (BuiltinsRuntime DefaultFun (CekValue DefaultUni DefaultFun ann)) +unitCekParameters :: Typeable ann => MachineParameters CekMachineCosts DefaultFun (CekValue DefaultUni DefaultFun ann) unitCekParameters = -- See Note [noinline for saving on ticks]. noinline mkMachineParameters def $ diff --git a/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/MachineParameters.hs b/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/MachineParameters.hs index f2f86687fce..d820bed04b1 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/MachineParameters.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/MachineParameters.hs @@ -14,8 +14,6 @@ import Control.DeepSeq import Control.Lens import GHC.Exts (inline) import GHC.Generics -import GHC.Magic (noinline) -import NoThunks.Class {-| We need to account for the costs of evaluator steps and also built-in function evaluation. The models for these have different structures and are used in @@ -37,13 +35,13 @@ makeLenses ''CostModel cost model for builtins and their denotations. This bundles one of those together with the cost model for evaluator steps. The 'term' type will be CekValue when we're using this with the CEK machine. -} -data MachineParameters machinecosts builtinsRuntime = +data MachineParameters machinecosts fun val = MachineParameters { machineCosts :: machinecosts - , builtinsRuntime :: builtinsRuntime + , builtinsRuntime :: BuiltinsRuntime fun val } - deriving stock (Generic, Functor, Foldable, Traversable) - deriving anyclass (NFData, NoThunks) + deriving stock Generic + deriving anyclass (NFData) {- Note [The CostingPart constraint in mkMachineParameters] Discharging the @CostingPart uni fun ~ builtincosts@ constraint in 'mkMachineParameters' causes GHC @@ -72,27 +70,16 @@ which makes sense: if @f@ receives all its type and term args then there's less -- See Note [Inlining meanings of builtins]. {-| This just uses 'toBuiltinsRuntime' function to convert a BuiltinCostModel to a BuiltinsRuntime. -} -mkMachineParametersFun :: +mkMachineParameters :: ( -- WARNING: do not discharge the equality constraint as that causes GHC to fail to inline the -- function at its call site, see Note [The CostingPart constraint in mkMachineParameters]. CostingPart uni fun ~ builtincosts , HasMeaningIn uni val , ToBuiltinMeaning uni fun ) - => (a -> BuiltinSemanticsVariant fun) - -> CostModel machinecosts builtincosts - -> MachineParameters machinecosts (a -> BuiltinsRuntime fun val) -mkMachineParametersFun toSemVar (CostModel mchnCosts builtinCosts) = - MachineParameters mchnCosts $ \x -> inline toBuiltinsRuntime (toSemVar x) builtinCosts -{-# INLINE mkMachineParameters #-} - -mkMachineParameters :: - ( CostingPart uni fun ~ builtincosts - , HasMeaningIn uni val - , ToBuiltinMeaning uni fun - ) => BuiltinSemanticsVariant fun -> CostModel machinecosts builtincosts - -> MachineParameters machinecosts (BuiltinsRuntime fun val) --- See Note [noinline for saving on ticks]. -mkMachineParameters semVar = fmap ($ ()) . noinline mkMachineParametersFun (const semVar) + -> MachineParameters machinecosts fun val +mkMachineParameters semVar (CostModel mchnCosts builtinCosts) = + MachineParameters mchnCosts (inline toBuiltinsRuntime semVar builtinCosts) +{-# INLINE mkMachineParameters #-} diff --git a/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/MachineParameters/Default.hs b/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/MachineParameters/Default.hs index 119e08a1f87..ae47e7cd452 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/MachineParameters/Default.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/MachineParameters/Default.hs @@ -1,10 +1,15 @@ +{-# LANGUAGE BangPatterns #-} + -- | Defines the type of default machine parameters and a function for creating a value of the type. -- We keep them separate, because the function unfolds into multiple thousands of lines of Core that -- we need to be able to visually inspect, hence we dedicate a separate file to it. module PlutusCore.Evaluation.Machine.MachineParameters.Default where +import PlutusPrelude + import PlutusCore.Builtin import PlutusCore.Default +import PlutusCore.Evaluation.Machine.BuiltinCostModel import PlutusCore.Evaluation.Machine.CostModelInterface import PlutusCore.Evaluation.Machine.ExBudgetingDefaults import PlutusCore.Evaluation.Machine.MachineParameters @@ -16,10 +21,8 @@ import GHC.Exts (inline) -- | 'MachineParameters' instantiated at CEK-machine-specific types and default builtins. -- Encompasses everything we need for evaluating a UPLC program with default builtins using the CEK -- machine. -type DefaultMachineParameters a = - MachineParameters - CekMachineCosts - (a -> BuiltinsRuntime DefaultFun (CekValue DefaultUni DefaultFun ())) +type DefaultMachineParameters = + MachineParameters CekMachineCosts DefaultFun (CekValue DefaultUni DefaultFun ()) {- Note [Inlining meanings of builtins] It's vitally important to inline the 'toBuiltinMeaning' method of a set of built-in functions as @@ -58,13 +61,24 @@ inlining). -- This function is expensive, so its result needs to be cached if it's going to be used multiple -- times. mkMachineParametersFor - :: MonadError CostModelApplyError m - => (a -> BuiltinSemanticsVariant DefaultFun) + :: forall m a. MonadError CostModelApplyError m + => [BuiltinSemanticsVariant DefaultFun] + -> (a -> BuiltinSemanticsVariant DefaultFun) -> CostModelParams - -> m (DefaultMachineParameters a) -mkMachineParametersFor toSemVar newCMP = - inline mkMachineParametersFun toSemVar <$> - applyCostModelParams defaultCekCostModel newCMP + -> m (a -> DefaultMachineParameters) +mkMachineParametersFor semVars toSemVar newCMP = + getToCostModel <&> \toCostModel x -> + let !semVar = toSemVar x + in inline mkMachineParameters semVar $ toCostModel semVar + where + getToCostModel + :: m (BuiltinSemanticsVariant DefaultFun -> CostModel CekMachineCosts BuiltinCostModel) + getToCostModel = do + costModels <- for semVars $ \semVar -> + (,) semVar <$> applyCostModelParams (toCekCostModel semVar) newCMP + pure $ \semVar -> + fromMaybe (error "semantics variant not found") $ + lookup semVar costModels -- Not marking this function with @INLINE@, since at this point everything we wanted to be inlined -- is inlined and there's zero reason to duplicate thousands and thousands of lines of Core down -- the line. diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/Cek.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/Cek.hs index 221b0d00aa5..ee43e07dc11 100644 --- a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/Cek.hs +++ b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/Cek.hs @@ -71,7 +71,7 @@ A wrapper around the internal runCek to debruijn input and undebruijn output. -} runCek :: ThrowableBuiltins uni fun - => MachineParameters CekMachineCosts (BuiltinsRuntime fun (CekValue uni fun ann)) + => MachineParameters CekMachineCosts fun (CekValue uni fun ann) -> ExBudgetMode cost uni fun -> EmitterMode uni fun -> Term Name uni fun ann @@ -82,7 +82,7 @@ runCek = Common.runCek runCekDeBruijn -- *THIS FUNCTION IS PARTIAL if the input term contains free variables* runCekNoEmit :: ThrowableBuiltins uni fun - => MachineParameters CekMachineCosts (BuiltinsRuntime fun (CekValue uni fun ann)) + => MachineParameters CekMachineCosts fun (CekValue uni fun ann) -> ExBudgetMode cost uni fun -> Term Name uni fun ann -> (Either (CekEvaluationException Name uni fun) (Term Name uni fun ()), cost) @@ -94,7 +94,7 @@ May throw a 'CekMachineException'. -} unsafeRunCekNoEmit :: ThrowableBuiltins uni fun - => MachineParameters CekMachineCosts (BuiltinsRuntime fun (CekValue uni fun ann)) + => MachineParameters CekMachineCosts fun (CekValue uni fun ann) -> ExBudgetMode cost uni fun -> Term Name uni fun ann -> (EvaluationResult (Term Name uni fun ()), cost) @@ -105,7 +105,7 @@ unsafeRunCekNoEmit = Common.unsafeRunCekNoEmit runCekDeBruijn evaluateCek :: ThrowableBuiltins uni fun => EmitterMode uni fun - -> MachineParameters CekMachineCosts (BuiltinsRuntime fun (CekValue uni fun ann)) + -> MachineParameters CekMachineCosts fun (CekValue uni fun ann) -> Term Name uni fun ann -> (Either (CekEvaluationException Name uni fun) (Term Name uni fun ()), [Text]) evaluateCek = Common.evaluateCek runCekDeBruijn @@ -114,7 +114,7 @@ evaluateCek = Common.evaluateCek runCekDeBruijn -- *THIS FUNCTION IS PARTIAL if the input term contains free variables* evaluateCekNoEmit :: ThrowableBuiltins uni fun - => MachineParameters CekMachineCosts (BuiltinsRuntime fun (CekValue uni fun ann)) + => MachineParameters CekMachineCosts fun (CekValue uni fun ann) -> Term Name uni fun ann -> Either (CekEvaluationException Name uni fun) (Term Name uni fun ()) evaluateCekNoEmit = Common.evaluateCekNoEmit runCekDeBruijn @@ -124,7 +124,7 @@ evaluateCekNoEmit = Common.evaluateCekNoEmit runCekDeBruijn unsafeEvaluateCek :: ThrowableBuiltins uni fun => EmitterMode uni fun - -> MachineParameters CekMachineCosts (BuiltinsRuntime fun (CekValue uni fun ann)) + -> MachineParameters CekMachineCosts fun (CekValue uni fun ann) -> Term Name uni fun ann -> (EvaluationResult (Term Name uni fun ()), [Text]) unsafeEvaluateCek = Common.unsafeEvaluateCek runCekDeBruijn @@ -133,7 +133,7 @@ unsafeEvaluateCek = Common.unsafeEvaluateCek runCekDeBruijn -- *THIS FUNCTION IS PARTIAL if the input term contains free variables* unsafeEvaluateCekNoEmit :: ThrowableBuiltins uni fun - => MachineParameters CekMachineCosts (BuiltinsRuntime fun (CekValue uni fun ann)) + => MachineParameters CekMachineCosts fun (CekValue uni fun ann) -> Term Name uni fun ann -> EvaluationResult (Term Name uni fun ()) unsafeEvaluateCekNoEmit = Common.unsafeEvaluateCekNoEmit runCekDeBruijn @@ -142,7 +142,7 @@ unsafeEvaluateCekNoEmit = Common.unsafeEvaluateCekNoEmit runCekDeBruijn -- *THIS FUNCTION IS PARTIAL if the input term contains free variables* readKnownCek :: (ThrowableBuiltins uni fun, ReadKnown (Term Name uni fun ()) a) - => MachineParameters CekMachineCosts (BuiltinsRuntime fun (CekValue uni fun ann)) + => MachineParameters CekMachineCosts fun (CekValue uni fun ann) -> Term Name uni fun ann -> Either (CekEvaluationException Name uni fun) a readKnownCek = Common.readKnownCek runCekDeBruijn diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/Cek/Internal.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/Cek/Internal.hs index 22d7bca83fe..d310786a018 100644 --- a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/Cek/Internal.hs +++ b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/Cek/Internal.hs @@ -599,7 +599,7 @@ transferArgStack (ConsStack arg rest) c = transferArgStack rest (FrameAwaitFunVa runCekM :: forall a cost uni fun ann . ThrowableBuiltins uni fun - => MachineParameters CekMachineCosts (BuiltinsRuntime fun (CekValue uni fun ann)) + => MachineParameters CekMachineCosts fun (CekValue uni fun ann) -> ExBudgetMode cost uni fun -> EmitterMode uni fun -> (forall s. GivenCekReqs uni fun ann s => CekM uni fun s a) @@ -868,7 +868,7 @@ enterComputeCek = computeCek -- | Evaluate a term using the CEK machine and keep track of costing, logging is optional. runCekDeBruijn :: ThrowableBuiltins uni fun - => MachineParameters CekMachineCosts (BuiltinsRuntime fun (CekValue uni fun ann)) + => MachineParameters CekMachineCosts fun (CekValue uni fun ann) -> ExBudgetMode cost uni fun -> EmitterMode uni fun -> NTerm uni fun ann diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/CommonAPI.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/CommonAPI.hs index 3415380ae4b..fa24c961b5c 100644 --- a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/CommonAPI.hs +++ b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/CommonAPI.hs @@ -75,7 +75,7 @@ import Data.Text (Text) -- The type of the machine (runner function). type MachineRunner cost uni fun ann = - MachineParameters CekMachineCosts (BuiltinsRuntime fun (CekValue uni fun ann)) + MachineParameters CekMachineCosts fun (CekValue uni fun ann) -> ExBudgetMode cost uni fun -> EmitterMode uni fun -> NTerm uni fun ann @@ -98,7 +98,7 @@ A wrapper around the internal runCek to debruijn input and undebruijn output. -} runCek :: MachineRunner cost uni fun ann - -> MachineParameters CekMachineCosts (BuiltinsRuntime fun (CekValue uni fun ann)) + -> MachineParameters CekMachineCosts fun (CekValue uni fun ann) -> ExBudgetMode cost uni fun -> EmitterMode uni fun -> Term Name uni fun ann @@ -129,7 +129,7 @@ runCek runner params mode emitMode term = -- *THIS FUNCTION IS PARTIAL if the input term contains free variables* runCekNoEmit :: MachineRunner cost uni fun ann - -> MachineParameters CekMachineCosts (BuiltinsRuntime fun (CekValue uni fun ann)) + -> MachineParameters CekMachineCosts fun (CekValue uni fun ann) -> ExBudgetMode cost uni fun -> Term Name uni fun ann -> (Either (CekEvaluationException Name uni fun) (Term Name uni fun ()), cost) @@ -144,7 +144,7 @@ May throw a 'CekMachineException'. unsafeRunCekNoEmit :: ThrowableBuiltins uni fun => MachineRunner cost uni fun ann - -> MachineParameters CekMachineCosts (BuiltinsRuntime fun (CekValue uni fun ann)) + -> MachineParameters CekMachineCosts fun (CekValue uni fun ann) -> ExBudgetMode cost uni fun -> Term Name uni fun ann -> (EvaluationResult (Term Name uni fun ()), cost) @@ -158,7 +158,7 @@ evaluateCek :: ThrowableBuiltins uni fun => MachineRunner RestrictingSt uni fun ann -> EmitterMode uni fun - -> MachineParameters CekMachineCosts (BuiltinsRuntime fun (CekValue uni fun ann)) + -> MachineParameters CekMachineCosts fun (CekValue uni fun ann) -> Term Name uni fun ann -> (Either (CekEvaluationException Name uni fun) (Term Name uni fun ()), [Text]) evaluateCek runner emitMode params = @@ -170,7 +170,7 @@ evaluateCek runner emitMode params = evaluateCekNoEmit :: ThrowableBuiltins uni fun => MachineRunner RestrictingSt uni fun ann - -> MachineParameters CekMachineCosts (BuiltinsRuntime fun (CekValue uni fun ann)) + -> MachineParameters CekMachineCosts fun (CekValue uni fun ann) -> Term Name uni fun ann -> Either (CekEvaluationException Name uni fun) (Term Name uni fun ()) evaluateCekNoEmit runner params = fst . runCekNoEmit runner params restrictingEnormous @@ -181,7 +181,7 @@ unsafeEvaluateCek :: ThrowableBuiltins uni fun => MachineRunner RestrictingSt uni fun ann -> EmitterMode uni fun - -> MachineParameters CekMachineCosts (BuiltinsRuntime fun (CekValue uni fun ann)) + -> MachineParameters CekMachineCosts fun (CekValue uni fun ann) -> Term Name uni fun ann -> (EvaluationResult (Term Name uni fun ()), [Text]) unsafeEvaluateCek runner emitTime params = @@ -193,7 +193,7 @@ unsafeEvaluateCek runner emitTime params = unsafeEvaluateCekNoEmit :: ThrowableBuiltins uni fun => MachineRunner RestrictingSt uni fun ann - -> MachineParameters CekMachineCosts (BuiltinsRuntime fun (CekValue uni fun ann)) + -> MachineParameters CekMachineCosts fun (CekValue uni fun ann) -> Term Name uni fun ann -> EvaluationResult (Term Name uni fun ()) unsafeEvaluateCekNoEmit runner params = unsafeExtractEvaluationResult . evaluateCekNoEmit runner params @@ -203,7 +203,7 @@ unsafeEvaluateCekNoEmit runner params = unsafeExtractEvaluationResult . evaluate readKnownCek :: (ThrowableBuiltins uni fun, ReadKnown (Term Name uni fun ()) a) => MachineRunner RestrictingSt uni fun ann - -> MachineParameters CekMachineCosts (BuiltinsRuntime fun (CekValue uni fun ann)) + -> MachineParameters CekMachineCosts fun (CekValue uni fun ann) -> Term Name uni fun ann -> Either (CekEvaluationException Name uni fun) a readKnownCek runner params = evaluateCekNoEmit runner params >=> readKnownSelf diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/SteppableCek.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/SteppableCek.hs index a7d9aabe14a..e81bf9ac973 100644 --- a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/SteppableCek.hs +++ b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/SteppableCek.hs @@ -69,7 +69,7 @@ A wrapper around the internal runCek to debruijn input and undebruijn output. -} runCek :: ThrowableBuiltins uni fun - => MachineParameters CekMachineCosts (BuiltinsRuntime fun (CekValue uni fun ann)) + => MachineParameters CekMachineCosts fun (CekValue uni fun ann) -> ExBudgetMode cost uni fun -> EmitterMode uni fun -> Term Name uni fun ann @@ -81,7 +81,7 @@ runCek = Common.runCek S.runCekDeBruijn -- *THIS FUNCTION IS PARTIAL if the input term contains free variables* runCekNoEmit :: ThrowableBuiltins uni fun - => MachineParameters CekMachineCosts (BuiltinsRuntime fun (CekValue uni fun ann)) + => MachineParameters CekMachineCosts fun (CekValue uni fun ann) -> ExBudgetMode cost uni fun -> Term Name uni fun ann -> (Either (CekEvaluationException Name uni fun) (Term Name uni fun ()), cost) @@ -94,7 +94,7 @@ May throw a 'CekMachineException'. -} unsafeRunCekNoEmit :: ThrowableBuiltins uni fun - => MachineParameters CekMachineCosts (BuiltinsRuntime fun (CekValue uni fun ann)) + => MachineParameters CekMachineCosts fun (CekValue uni fun ann) -> ExBudgetMode cost uni fun -> Term Name uni fun ann -> (EvaluationResult (Term Name uni fun ()), cost) @@ -105,7 +105,7 @@ unsafeRunCekNoEmit = Common.unsafeRunCekNoEmit S.runCekDeBruijn evaluateCek :: ThrowableBuiltins uni fun => EmitterMode uni fun - -> MachineParameters CekMachineCosts (BuiltinsRuntime fun (CekValue uni fun ann)) + -> MachineParameters CekMachineCosts fun (CekValue uni fun ann) -> Term Name uni fun ann -> (Either (CekEvaluationException Name uni fun) (Term Name uni fun ()), [Text]) evaluateCek = Common.evaluateCek S.runCekDeBruijn @@ -114,7 +114,7 @@ evaluateCek = Common.evaluateCek S.runCekDeBruijn -- *THIS FUNCTION IS PARTIAL if the input term contains free variables* evaluateCekNoEmit :: ThrowableBuiltins uni fun - => MachineParameters CekMachineCosts (BuiltinsRuntime fun (CekValue uni fun ann)) + => MachineParameters CekMachineCosts fun (CekValue uni fun ann) -> Term Name uni fun ann -> Either (CekEvaluationException Name uni fun) (Term Name uni fun ()) evaluateCekNoEmit = Common.evaluateCekNoEmit S.runCekDeBruijn @@ -125,7 +125,7 @@ evaluateCekNoEmit = Common.evaluateCekNoEmit S.runCekDeBruijn unsafeEvaluateCek :: ThrowableBuiltins uni fun => EmitterMode uni fun - -> MachineParameters CekMachineCosts (BuiltinsRuntime fun (CekValue uni fun ann)) + -> MachineParameters CekMachineCosts fun (CekValue uni fun ann) -> Term Name uni fun ann -> (EvaluationResult (Term Name uni fun ()), [Text]) unsafeEvaluateCek = Common.unsafeEvaluateCek S.runCekDeBruijn @@ -135,7 +135,7 @@ unsafeEvaluateCek = Common.unsafeEvaluateCek S.runCekDeBruijn -- *THIS FUNCTION IS PARTIAL if the input term contains free variables* unsafeEvaluateCekNoEmit :: ThrowableBuiltins uni fun - => MachineParameters CekMachineCosts (BuiltinsRuntime fun (CekValue uni fun ann)) + => MachineParameters CekMachineCosts fun (CekValue uni fun ann) -> Term Name uni fun ann -> EvaluationResult (Term Name uni fun ()) unsafeEvaluateCekNoEmit = Common.unsafeEvaluateCekNoEmit S.runCekDeBruijn @@ -144,7 +144,7 @@ unsafeEvaluateCekNoEmit = Common.unsafeEvaluateCekNoEmit S.runCekDeBruijn -- *THIS FUNCTION IS PARTIAL if the input term contains free variables* readKnownCek :: (ThrowableBuiltins uni fun, ReadKnown (Term Name uni fun ()) a) - => MachineParameters CekMachineCosts (BuiltinsRuntime fun (CekValue uni fun ann)) + => MachineParameters CekMachineCosts fun (CekValue uni fun ann) -> Term Name uni fun ann -> Either (CekEvaluationException Name uni fun) a readKnownCek = Common.readKnownCek S.runCekDeBruijn diff --git a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/SteppableCek/Internal.hs b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/SteppableCek/Internal.hs index f2b076008a4..5cf72765816 100644 --- a/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/SteppableCek/Internal.hs +++ b/plutus-core/untyped-plutus-core/src/UntypedPlutusCore/Evaluation/Machine/SteppableCek/Internal.hs @@ -270,7 +270,7 @@ applyEvaluate !_ val _ = -- MAYBE: runCekDeBruijn can be shared between original&debug ceks by passing a `enterComputeCek` func. runCekDeBruijn :: ThrowableBuiltins uni fun - => MachineParameters CekMachineCosts (BuiltinsRuntime fun (CekValue uni fun ann)) + => MachineParameters CekMachineCosts fun (CekValue uni fun ann) -> ExBudgetMode cost uni fun -> EmitterMode uni fun -> NTerm uni fun ann @@ -327,7 +327,7 @@ mkCekTrans :: forall cost uni fun ann m s . ( ThrowableBuiltins uni fun , PrimMonad m, s ~ PrimState m) -- the outer monad that initializes the transition function - => MachineParameters CekMachineCosts (BuiltinsRuntime fun (CekValue uni fun ann)) + => MachineParameters CekMachineCosts fun (CekValue uni fun ann) -> ExBudgetMode cost uni fun -> EmitterMode uni fun -> Slippage diff --git a/plutus-core/untyped-plutus-core/test/Evaluation/Builtins/Common.hs b/plutus-core/untyped-plutus-core/test/Evaluation/Builtins/Common.hs index d9fe24f8487..285059ed8f2 100644 --- a/plutus-core/untyped-plutus-core/test/Evaluation/Builtins/Common.hs +++ b/plutus-core/untyped-plutus-core/test/Evaluation/Builtins/Common.hs @@ -35,7 +35,7 @@ typecheckAnd , Closed uni, uni `Everywhere` ExMemoryUsage ) => BuiltinSemanticsVariant fun - -> (MachineParameters CekMachineCosts (BuiltinsRuntime fun (CekValue uni fun ())) -> + -> (MachineParameters CekMachineCosts fun (CekValue uni fun ()) -> UPLC.Term Name uni fun () -> a) -> CostingPart uni fun -> TPLC.Term TyName Name uni fun () -> m a typecheckAnd semvar action costingPart term = TPLC.runQuoteT $ do diff --git a/plutus-ledger-api/src/PlutusLedgerApi/Common/Eval.hs b/plutus-ledger-api/src/PlutusLedgerApi/Common/Eval.hs index fed2012fa00..f4712ad3906 100644 --- a/plutus-ledger-api/src/PlutusLedgerApi/Common/Eval.hs +++ b/plutus-ledger-api/src/PlutusLedgerApi/Common/Eval.hs @@ -27,7 +27,6 @@ import PlutusCore.Default import PlutusCore.Evaluation.Machine.CostModelInterface as Plutus import PlutusCore.Evaluation.Machine.ExBudget as Plutus import PlutusCore.Evaluation.Machine.ExBudgetingDefaults qualified as Plutus -import PlutusCore.Evaluation.Machine.MachineParameters (MachineParameters) import PlutusCore.Evaluation.Machine.MachineParameters.Default import PlutusCore.MkPlc qualified as UPLC import PlutusCore.Pretty @@ -106,20 +105,15 @@ mkTermToEvaluate ll pv script args = do -- make sure that term is closed, i.e. well-scoped through (liftEither . first DeBruijnError . UPLC.checkScope) appliedT -toMachineParameters - :: MajorProtocolVersion - -> EvaluationContext - -> MachineParameters - CekMachineCosts - (UPLC.BuiltinsRuntime DefaultFun (UPLC.CekValue DefaultUni DefaultFun ())) -toMachineParameters pv ctx = ($ pv) <$> machineParameters ctx +toMachineParameters :: MajorProtocolVersion -> EvaluationContext -> DefaultMachineParameters +toMachineParameters pv ctx = machineParameters ctx pv {-| An opaque type that contains all the static parameters that the evaluator needs to evaluate a script. This is so that they can be computed once and cached, rather than being recomputed on every evaluation. -} newtype EvaluationContext = EvaluationContext - { machineParameters :: DefaultMachineParameters MajorProtocolVersion + { machineParameters :: MajorProtocolVersion -> DefaultMachineParameters } deriving stock Generic deriving anyclass (NFData, NoThunks) @@ -134,11 +128,12 @@ with the updated cost model parameters. -} mkDynEvaluationContext :: MonadError CostModelApplyError m - => (MajorProtocolVersion -> BuiltinSemanticsVariant DefaultFun) + => [BuiltinSemanticsVariant DefaultFun] + -> (MajorProtocolVersion -> BuiltinSemanticsVariant DefaultFun) -> Plutus.CostModelParams -> m EvaluationContext -mkDynEvaluationContext toSemVar newCMP = - EvaluationContext <$> mkMachineParametersFor toSemVar newCMP +mkDynEvaluationContext semVars toSemVar newCMP = + EvaluationContext <$> mkMachineParametersFor semVars toSemVar newCMP -- FIXME: remove this function assertWellFormedCostModelParams :: MonadError CostModelApplyError m => Plutus.CostModelParams -> m () diff --git a/plutus-ledger-api/src/PlutusLedgerApi/V1/EvaluationContext.hs b/plutus-ledger-api/src/PlutusLedgerApi/V1/EvaluationContext.hs index 518a5abbf05..0bf2054eb18 100644 --- a/plutus-ledger-api/src/PlutusLedgerApi/V1/EvaluationContext.hs +++ b/plutus-ledger-api/src/PlutusLedgerApi/V1/EvaluationContext.hs @@ -38,6 +38,7 @@ mkEvaluationContext = tagWithParamNames @V1.ParamName >=> pure . toCostModelParams >=> mkDynEvaluationContext + [DefaultFunSemanticsVariant0, DefaultFunSemanticsVariant1] (\pv -> if pv < conwayPV then DefaultFunSemanticsVariant0 else DefaultFunSemanticsVariant1) diff --git a/plutus-ledger-api/src/PlutusLedgerApi/V2/EvaluationContext.hs b/plutus-ledger-api/src/PlutusLedgerApi/V2/EvaluationContext.hs index 653d88cc5d2..89f7e3438a9 100644 --- a/plutus-ledger-api/src/PlutusLedgerApi/V2/EvaluationContext.hs +++ b/plutus-ledger-api/src/PlutusLedgerApi/V2/EvaluationContext.hs @@ -38,6 +38,7 @@ mkEvaluationContext = tagWithParamNames @V2.ParamName >=> pure . toCostModelParams >=> mkDynEvaluationContext + [DefaultFunSemanticsVariant0, DefaultFunSemanticsVariant1] (\pv -> if pv < conwayPV then Plutus.DefaultFunSemanticsVariant0 else Plutus.DefaultFunSemanticsVariant1) diff --git a/plutus-ledger-api/src/PlutusLedgerApi/V3/EvaluationContext.hs b/plutus-ledger-api/src/PlutusLedgerApi/V3/EvaluationContext.hs index 24aa8b15be3..e010c50c8ff 100644 --- a/plutus-ledger-api/src/PlutusLedgerApi/V3/EvaluationContext.hs +++ b/plutus-ledger-api/src/PlutusLedgerApi/V3/EvaluationContext.hs @@ -32,6 +32,9 @@ a protocol update with the updated cost model parameters. mkEvaluationContext :: (MonadError CostModelApplyError m, MonadWriter [CostModelApplyWarn] m) => [Integer] -- ^ the (updated) cost model parameters of the protocol -> m EvaluationContext -mkEvaluationContext = tagWithParamNames @V3.ParamName - >=> pure . toCostModelParams - >=> mkDynEvaluationContext (const Plutus.DefaultFunSemanticsVariant2) +mkEvaluationContext = + tagWithParamNames @V3.ParamName + >=> pure . toCostModelParams + >=> mkDynEvaluationContext + [DefaultFunSemanticsVariant2] + (const Plutus.DefaultFunSemanticsVariant2)