diff --git a/plutus-conformance/haskell/Spec.hs b/plutus-conformance/haskell/Spec.hs index b8ec55b58af..9c8d8156ad5 100644 --- a/plutus-conformance/haskell/Spec.hs +++ b/plutus-conformance/haskell/Spec.hs @@ -14,7 +14,7 @@ evalUplcProg = UplcEvaluatorWithCosting $ \modelParams (UPLC.Program a v t) -> do params <- case mkMachineParametersFor (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 feeaa4cf3b6..295eb1106b8 100644 --- a/plutus-core/cost-model/budgeting-bench/Benchmarks/Nops.hs +++ b/plutus-core/cost-model/budgeting-bench/Benchmarks/Nops.hs @@ -120,7 +120,8 @@ nopCostModel = (ModelSixArgumentsConstantCost 600) } -nopCostParameters :: MachineParameters CekMachineCosts NopFun (CekValue DefaultUni NopFun ()) +nopCostParameters :: + MachineParameters CekMachineCosts (BuiltinsRuntime 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 a314102ffda..9d261c83c6e 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 fun (CekValue DefaultUni fun ()) + => MachineParameters CekMachineCosts (BuiltinsRuntime fun (CekValue DefaultUni fun ())) -> String -> PlainTerm DefaultUni fun -> Benchmark diff --git a/plutus-core/plutus-core/src/PlutusCore/Builtin/Meaning.hs b/plutus-core/plutus-core/src/PlutusCore/Builtin/Meaning.hs index c103b7922c6..e84ef9cbec9 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Builtin/Meaning.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Builtin/Meaning.hs @@ -398,18 +398,5 @@ toBuiltinsRuntime -> cost -> BuiltinsRuntime fun val toBuiltinsRuntime semvar cost = - let runtime = BuiltinsRuntime $ toBuiltinRuntime cost . inline toBuiltinMeaning semvar - -- This pragma is very important, removing it destroys the carefully set up optimizations of - -- of costing functions (see Note [Optimizations of runCostingFun*]). The reason for that is - -- that if @runtime@ doesn't have a pragma, then GHC sees that it's only referenced once and - -- inlines it below, together with this entire function (since we tell GHC to), at which - -- point everything's inlined and we're completely at GHC's mercy to optimize things - -- properly. Unfortunately, GHC doesn't want to cooperate and push 'toBuiltinRuntime' to - -- the inside of the inlined to 'toBuiltinMeaning' call, creating lots of 'BuiltinMeaning's - -- instead of 'BuiltinRuntime's with the former hiding the costing optimizations behind a - -- lambda binding the @cost@ variable, which renders all the optimizations useless. By - -- using a @NOINLINE@ pragma we tell GHC to create a separate thunk, which it can properly - -- optimize, because the other bazillion things don't get in the way. - {-# NOINLINE runtime #-} - in runtime + BuiltinsRuntime $ toBuiltinRuntime cost . inline toBuiltinMeaning semvar {-# INLINE toBuiltinsRuntime #-} 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 3376f84cafb..9a2843e7412 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/ExBudgetingDefaults.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/ExBudgetingDefaults.hs @@ -84,8 +84,9 @@ defaultCekCostModel = CostModel defaultCekMachineCosts defaultBuiltinCostModel defaultCostModelParams :: Maybe CostModelParams defaultCostModelParams = extractCostModelParams defaultCekCostModel -defaultCekParameters :: Typeable ann => MachineParameters CekMachineCosts DefaultFun (CekValue DefaultUni DefaultFun ann) -defaultCekParameters = mkMachineParameters def defaultCekCostModel +defaultCekParameters :: Typeable ann => MachineParameters CekMachineCosts (BuiltinsRuntime DefaultFun (CekValue DefaultUni DefaultFun ann)) +-- See Note [noinline for saving on ticks]. +defaultCekParameters = noinline mkMachineParameters def defaultCekCostModel {- Note [noinline for saving on ticks] We use 'noinline' purely for saving on simplifier ticks for definitions, whose performance doesn't @@ -93,7 +94,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 DefaultFun (CekValue DefaultUni DefaultFun ann) +unitCekParameters :: Typeable ann => MachineParameters CekMachineCosts (BuiltinsRuntime 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 f830cf1a24a..f2f86687fce 100644 --- a/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/MachineParameters.hs +++ b/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/MachineParameters.hs @@ -14,6 +14,7 @@ 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 @@ -36,18 +37,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 fun val = +data MachineParameters machinecosts builtinsRuntime = MachineParameters { machineCosts :: machinecosts - , builtinsRuntime :: BuiltinsRuntime fun val + , builtinsRuntime :: builtinsRuntime } - deriving stock Generic - deriving anyclass (NFData) - --- For some reason the generic instance gives incorrect nothunk errors, --- see https://github.com/input-output-hk/nothunks/issues/24 -instance (NoThunks machinecosts, Bounded fun, Enum fun) => NoThunks (MachineParameters machinecosts fun val) where - wNoThunks ctx (MachineParameters costs runtime) = allNoThunks [ noThunks ctx costs, noThunks ctx runtime ] + deriving stock (Generic, Functor, Foldable, Traversable) + deriving anyclass (NFData, NoThunks) {- Note [The CostingPart constraint in mkMachineParameters] Discharging the @CostingPart uni fun ~ builtincosts@ constraint in 'mkMachineParameters' causes GHC @@ -76,16 +72,27 @@ 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. -} -mkMachineParameters :: +mkMachineParametersFun :: ( -- 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 ) - => BuiltinSemanticsVariant fun + => (a -> BuiltinSemanticsVariant fun) -> CostModel machinecosts builtincosts - -> MachineParameters machinecosts fun val -mkMachineParameters semvar (CostModel mchnCosts builtinCosts) = - MachineParameters mchnCosts (inline toBuiltinsRuntime semvar 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) 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 e86e12f679b..119e08a1f87 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 @@ -16,8 +16,10 @@ 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 = - MachineParameters CekMachineCosts DefaultFun (CekValue DefaultUni DefaultFun ()) +type DefaultMachineParameters a = + MachineParameters + CekMachineCosts + (a -> BuiltinsRuntime 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 @@ -59,9 +61,9 @@ mkMachineParametersFor :: MonadError CostModelApplyError m => (a -> BuiltinSemanticsVariant DefaultFun) -> CostModelParams - -> m (a -> DefaultMachineParameters) + -> m (DefaultMachineParameters a) mkMachineParametersFor toSemVar newCMP = - (\cost x -> inline mkMachineParameters (toSemVar x) cost) <$> + inline mkMachineParametersFun toSemVar <$> applyCostModelParams defaultCekCostModel newCMP -- 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 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 7a7639fcbb8..221b0d00aa5 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 @@ -43,7 +43,8 @@ module UntypedPlutusCore.Evaluation.Machine.Cek , logWithTimeEmitter , logWithBudgetEmitter -- * Misc - , CekValue(..) + , BuiltinsRuntime (..) + , CekValue (..) , readKnownCek , Hashable , ThrowableBuiltins @@ -70,7 +71,7 @@ A wrapper around the internal runCek to debruijn input and undebruijn output. -} runCek :: ThrowableBuiltins uni fun - => MachineParameters CekMachineCosts fun (CekValue uni fun ann) + => MachineParameters CekMachineCosts (BuiltinsRuntime fun (CekValue uni fun ann)) -> ExBudgetMode cost uni fun -> EmitterMode uni fun -> Term Name uni fun ann @@ -81,7 +82,7 @@ runCek = Common.runCek runCekDeBruijn -- *THIS FUNCTION IS PARTIAL if the input term contains free variables* runCekNoEmit :: ThrowableBuiltins uni fun - => MachineParameters CekMachineCosts fun (CekValue uni fun ann) + => MachineParameters CekMachineCosts (BuiltinsRuntime fun (CekValue uni fun ann)) -> ExBudgetMode cost uni fun -> Term Name uni fun ann -> (Either (CekEvaluationException Name uni fun) (Term Name uni fun ()), cost) @@ -93,7 +94,7 @@ May throw a 'CekMachineException'. -} unsafeRunCekNoEmit :: ThrowableBuiltins uni fun - => MachineParameters CekMachineCosts fun (CekValue uni fun ann) + => MachineParameters CekMachineCosts (BuiltinsRuntime fun (CekValue uni fun ann)) -> ExBudgetMode cost uni fun -> Term Name uni fun ann -> (EvaluationResult (Term Name uni fun ()), cost) @@ -104,7 +105,7 @@ unsafeRunCekNoEmit = Common.unsafeRunCekNoEmit runCekDeBruijn evaluateCek :: ThrowableBuiltins uni fun => EmitterMode uni fun - -> MachineParameters CekMachineCosts fun (CekValue uni fun ann) + -> MachineParameters CekMachineCosts (BuiltinsRuntime fun (CekValue uni fun ann)) -> Term Name uni fun ann -> (Either (CekEvaluationException Name uni fun) (Term Name uni fun ()), [Text]) evaluateCek = Common.evaluateCek runCekDeBruijn @@ -113,7 +114,7 @@ evaluateCek = Common.evaluateCek runCekDeBruijn -- *THIS FUNCTION IS PARTIAL if the input term contains free variables* evaluateCekNoEmit :: ThrowableBuiltins uni fun - => MachineParameters CekMachineCosts fun (CekValue uni fun ann) + => MachineParameters CekMachineCosts (BuiltinsRuntime fun (CekValue uni fun ann)) -> Term Name uni fun ann -> Either (CekEvaluationException Name uni fun) (Term Name uni fun ()) evaluateCekNoEmit = Common.evaluateCekNoEmit runCekDeBruijn @@ -123,7 +124,7 @@ evaluateCekNoEmit = Common.evaluateCekNoEmit runCekDeBruijn unsafeEvaluateCek :: ThrowableBuiltins uni fun => EmitterMode uni fun - -> MachineParameters CekMachineCosts fun (CekValue uni fun ann) + -> MachineParameters CekMachineCosts (BuiltinsRuntime fun (CekValue uni fun ann)) -> Term Name uni fun ann -> (EvaluationResult (Term Name uni fun ()), [Text]) unsafeEvaluateCek = Common.unsafeEvaluateCek runCekDeBruijn @@ -132,7 +133,7 @@ unsafeEvaluateCek = Common.unsafeEvaluateCek runCekDeBruijn -- *THIS FUNCTION IS PARTIAL if the input term contains free variables* unsafeEvaluateCekNoEmit :: ThrowableBuiltins uni fun - => MachineParameters CekMachineCosts fun (CekValue uni fun ann) + => MachineParameters CekMachineCosts (BuiltinsRuntime fun (CekValue uni fun ann)) -> Term Name uni fun ann -> EvaluationResult (Term Name uni fun ()) unsafeEvaluateCekNoEmit = Common.unsafeEvaluateCekNoEmit runCekDeBruijn @@ -141,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 fun (CekValue uni fun ann) + => MachineParameters CekMachineCosts (BuiltinsRuntime 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 d310786a018..22d7bca83fe 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 fun (CekValue uni fun ann) + => MachineParameters CekMachineCosts (BuiltinsRuntime 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 fun (CekValue uni fun ann) + => MachineParameters CekMachineCosts (BuiltinsRuntime 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 fa24c961b5c..3415380ae4b 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 fun (CekValue uni fun ann) + MachineParameters CekMachineCosts (BuiltinsRuntime 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 fun (CekValue uni fun ann) + -> MachineParameters CekMachineCosts (BuiltinsRuntime 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 fun (CekValue uni fun ann) + -> MachineParameters CekMachineCosts (BuiltinsRuntime 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 fun (CekValue uni fun ann) + -> MachineParameters CekMachineCosts (BuiltinsRuntime 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 fun (CekValue uni fun ann) + -> MachineParameters CekMachineCosts (BuiltinsRuntime 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 fun (CekValue uni fun ann) + -> MachineParameters CekMachineCosts (BuiltinsRuntime 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 fun (CekValue uni fun ann) + -> MachineParameters CekMachineCosts (BuiltinsRuntime 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 fun (CekValue uni fun ann) + -> MachineParameters CekMachineCosts (BuiltinsRuntime 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 fun (CekValue uni fun ann) + -> MachineParameters CekMachineCosts (BuiltinsRuntime 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 e81bf9ac973..a7d9aabe14a 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 fun (CekValue uni fun ann) + => MachineParameters CekMachineCosts (BuiltinsRuntime 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 fun (CekValue uni fun ann) + => MachineParameters CekMachineCosts (BuiltinsRuntime 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 fun (CekValue uni fun ann) + => MachineParameters CekMachineCosts (BuiltinsRuntime 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 fun (CekValue uni fun ann) + -> MachineParameters CekMachineCosts (BuiltinsRuntime 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 fun (CekValue uni fun ann) + => MachineParameters CekMachineCosts (BuiltinsRuntime 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 fun (CekValue uni fun ann) + -> MachineParameters CekMachineCosts (BuiltinsRuntime 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 fun (CekValue uni fun ann) + => MachineParameters CekMachineCosts (BuiltinsRuntime 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 fun (CekValue uni fun ann) + => MachineParameters CekMachineCosts (BuiltinsRuntime 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 5cf72765816..f2b076008a4 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 fun (CekValue uni fun ann) + => MachineParameters CekMachineCosts (BuiltinsRuntime 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 fun (CekValue uni fun ann) + => MachineParameters CekMachineCosts (BuiltinsRuntime 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 285059ed8f2..d9fe24f8487 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 fun (CekValue uni fun ()) -> + -> (MachineParameters CekMachineCosts (BuiltinsRuntime 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 3e710e759af..fed2012fa00 100644 --- a/plutus-ledger-api/src/PlutusLedgerApi/Common/Eval.hs +++ b/plutus-ledger-api/src/PlutusLedgerApi/Common/Eval.hs @@ -27,6 +27,7 @@ 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 @@ -105,15 +106,20 @@ 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 -> DefaultMachineParameters -toMachineParameters pv ctx = machineParameters ctx pv +toMachineParameters + :: MajorProtocolVersion + -> EvaluationContext + -> MachineParameters + CekMachineCosts + (UPLC.BuiltinsRuntime DefaultFun (UPLC.CekValue DefaultUni DefaultFun ())) +toMachineParameters pv ctx = ($ pv) <$> machineParameters ctx {-| 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 :: MajorProtocolVersion -> DefaultMachineParameters + { machineParameters :: DefaultMachineParameters MajorProtocolVersion } deriving stock Generic deriving anyclass (NFData, NoThunks)