[Builtins] Generalize 'evaluateTerm'

plutus-benchmark/common/PlutusBenchmark/Common.hs

@@ -38,14 +38,15 @@ import PlutusCore.Default
 import PlutusCore.Evaluation.Machine.ExBudget (ExBudget (..))
 import PlutusCore.Evaluation.Machine.ExBudgetingDefaults qualified as PLC
 import PlutusCore.Evaluation.Machine.ExMemory (ExCPU (..), ExMemory (..))
+import PlutusCore.Pretty (Pretty)
 
 import PlutusTx.Test.Util.Compiled (Program, Term, cekResultMatchesHaskellValue, compiledCodeToTerm,
                                     toAnonDeBruijnProg, toAnonDeBruijnTerm, toNamedDeBruijnTerm)
 import UntypedPlutusCore qualified as UPLC
 import UntypedPlutusCore.Evaluation.Machine.Cek as Cek
 import UntypedPlutusCore.Evaluation.Machine.Cek qualified as UPLC
 
-import Control.DeepSeq (force)
+import Control.DeepSeq (NFData, force)
 import Criterion.Main
 import Criterion.Types (Config (..))
 import Data.ByteString qualified as BS
@@ -91,7 +92,7 @@ getCostsCek (UPLC.Program _ _ prog) =
 mkEvalCtx
   :: LedgerApi.PlutusLedgerLanguage
   -> BuiltinSemanticsVariant DefaultFun
-  -> LedgerApi.EvaluationContext
+  -> LedgerApi.EvaluationContext DefaultFun
 mkEvalCtx ll semvar =
     case PLC.defaultCostModelParamsForVariant semvar of
         Just p ->
@@ -109,16 +110,17 @@ mkEvalCtx ll semvar =
 
 -- Many of our benchmarks should use an evaluation context for the most recent
 -- Plutus language version and the ost recent semantic variant.
-mkMostRecentEvalCtx :: LedgerApi.EvaluationContext
+mkMostRecentEvalCtx :: LedgerApi.EvaluationContext DefaultFun
 mkMostRecentEvalCtx = mkEvalCtx maxBound maxBound
 
 -- | Evaluate a term as it would be evaluated using the on-chain evaluator.
 evaluateCekLikeInProd
-    :: LedgerApi.EvaluationContext
-    -> UPLC.Term PLC.NamedDeBruijn PLC.DefaultUni PLC.DefaultFun ()
+    :: (Pretty fun, PLC.Typeable fun, Eq (BuiltinSemanticsVariant fun))
+    => LedgerApi.EvaluationContext fun
+    -> UPLC.Term PLC.NamedDeBruijn PLC.DefaultUni fun ()
     -> Either
-            (UPLC.CekEvaluationException UPLC.NamedDeBruijn UPLC.DefaultUni UPLC.DefaultFun)
-            (UPLC.Term UPLC.NamedDeBruijn UPLC.DefaultUni UPLC.DefaultFun ())
+            (UPLC.CekEvaluationException UPLC.NamedDeBruijn UPLC.DefaultUni fun)
+            (UPLC.Term UPLC.NamedDeBruijn UPLC.DefaultUni fun ())
 evaluateCekLikeInProd evalCtx term =
     let -- The validation benchmarks were all created from PlutusV1 scripts
         pv = LedgerApi.ledgerLanguageIntroducedIn LedgerApi.PlutusV1
@@ -128,17 +130,26 @@ evaluateCekLikeInProd evalCtx term =
 -- | Evaluate a term and either throw if evaluation fails or discard the result and return '()'.
 -- Useful for benchmarking.
 evaluateCekForBench
-    :: LedgerApi.EvaluationContext
-    -> UPLC.Term PLC.NamedDeBruijn PLC.DefaultUni PLC.DefaultFun ()
+    :: (Pretty fun, PLC.Typeable fun, Eq (BuiltinSemanticsVariant fun))
+    => LedgerApi.EvaluationContext fun
+    -> UPLC.Term PLC.NamedDeBruijn PLC.DefaultUni fun ()
     -> ()
 evaluateCekForBench evalCtx = either (error . show) (\_ -> ()) . evaluateCekLikeInProd evalCtx
 
-benchTermCek :: LedgerApi.EvaluationContext -> Term -> Benchmarkable
+benchTermCek
+    :: (NFData fun, Pretty fun, PLC.Typeable fun, Eq (BuiltinSemanticsVariant fun))
+    => LedgerApi.EvaluationContext fun
+    -> UPLC.Term PLC.NamedDeBruijn PLC.DefaultUni fun ()
+    -> Benchmarkable
 benchTermCek evalCtx term =
     let !term' = force term
     in whnf (evaluateCekForBench evalCtx) term'
 
-benchProgramCek :: LedgerApi.EvaluationContext -> Program -> Benchmarkable
+benchProgramCek
+    :: (NFData fun, Pretty fun, PLC.Typeable fun, Eq (BuiltinSemanticsVariant fun))
+    => LedgerApi.EvaluationContext fun
+    -> UPLC.Program UPLC.NamedDeBruijn DefaultUni fun ()
+    -> Benchmarkable
 benchProgramCek evalCtx (UPLC.Program _ _ term) =
   benchTermCek evalCtx term
 

plutus-benchmark/marlowe/src/PlutusBenchmark/Marlowe/BenchUtil.hs

@@ -282,7 +282,7 @@ executeBenchmark serialisedValidator Benchmark{..} =
               [bDatum, bRedeemer, toData bScriptContext]
 
 -- | The execution context for benchmarking.
-evaluationContext :: Either String EvaluationContext
+evaluationContext :: Either String (EvaluationContext PLC.DefaultFun)
 evaluationContext =
   bimap show fst . runExcept . runWriterT . mkEvaluationContext $
     snd <$> testCostModel

plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/MachineParameters/Default.hs

@@ -17,14 +17,14 @@ import Control.Monad.Except
 import GHC.Exts (inline)
 
 -- | The semantics-variant-dependent part of 'MachineParameters'.
-type DefaultMachineVariantParameters =
-    MachineVariantParameters CekMachineCosts DefaultFun (CekValue DefaultUni DefaultFun ())
+type DefaultMachineVariantParameters fun =
+    MachineVariantParameters CekMachineCosts fun (CekValue DefaultUni fun ())
 
 -- | '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 fun =
+    MachineParameters CekMachineCosts fun (CekValue DefaultUni fun ())
 
 {- Note [Inlining meanings of builtins]
 It's vitally important to inline the 'toBuiltinMeaning' method of a set of built-in functions as
@@ -67,7 +67,7 @@ mkMachineVariantParametersFor
     :: MonadError CostModelApplyError m
     => [BuiltinSemanticsVariant DefaultFun]
     -> CostModelParams
-    -> m [(BuiltinSemanticsVariant DefaultFun, DefaultMachineVariantParameters)]
+    -> m [(BuiltinSemanticsVariant DefaultFun, DefaultMachineVariantParameters DefaultFun)]
 mkMachineVariantParametersFor semVars newCMP = do
     res <- for semVars $ \semVar ->
         -- See Note [Inlining meanings of builtins].

plutus-core/plutus-ir/test/PlutusIR/Transform/StrictLetRec/Tests/Lib.hs

@@ -92,7 +92,7 @@ evaluateUplcProgramWithTraces uplcProg =
   costModel =
       CostModel defaultCekMachineCostsForTesting defaultBuiltinCostModelForTesting
 
-  machineParameters :: DefaultMachineParameters
+  machineParameters :: DefaultMachineParameters DefaultFun
   machineParameters =
       MachineParameters def $ mkMachineVariantParameters def costModel
 

plutus-core/untyped-plutus-core/testlib/Transform/CaseOfCase/Spec.hs

@@ -133,7 +133,7 @@ evaluateUplc = unsafeSplitStructuralOperational . fst <$> evaluateCek noEmitter
   costModel =
       CostModel defaultCekMachineCostsForTesting defaultBuiltinCostModelForTesting
 
-  machineParameters :: DefaultMachineParameters
+  machineParameters :: DefaultMachineParameters DefaultFun
   machineParameters =
       -- TODO: proper semantic variant. What should def be?
       MachineParameters def $ mkMachineVariantParameters def costModel

plutus-ledger-api/src/PlutusLedgerApi/Common.hs

@@ -74,6 +74,7 @@ module PlutusLedgerApi.Common (
 
   -- ** Evaluation context
   Eval.EvaluationContext (..),
+  Eval.DefaultFun,
   Eval.mkDynEvaluationContext,
   Eval.toMachineParameters,
   -- While not strictly used by the ledger, this is useful for people trying to

plutus-ledger-api/src/PlutusLedgerApi/Common/Eval.hs

@@ -1,18 +1,20 @@
 -- editorconfig-checker-disable-file
-{-# LANGUAGE DeriveAnyClass    #-}
-{-# LANGUAGE GADTs             #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE StrictData        #-}
-{-# LANGUAGE TemplateHaskell   #-}
-{-# LANGUAGE TypeApplications  #-}
-{-# LANGUAGE ViewPatterns      #-}
+{-# LANGUAGE DeriveAnyClass       #-}
+{-# LANGUAGE GADTs                #-}
+{-# LANGUAGE OverloadedStrings    #-}
+{-# LANGUAGE StrictData           #-}
+{-# LANGUAGE TemplateHaskell      #-}
+{-# LANGUAGE TypeApplications     #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE ViewPatterns         #-}
 
 module PlutusLedgerApi.Common.Eval
     ( EvaluationError (..)
     , EvaluationContext (..)
     , AsScriptDecodeError (..)
     , LogOutput
     , VerboseMode (..)
+    , DefaultFun
     , evaluateScriptRestricting
     , evaluateScriptCounting
     , evaluateTerm
@@ -113,7 +115,9 @@ 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
+    :: Eq (BuiltinSemanticsVariant fun)
+    => MajorProtocolVersion -> EvaluationContext fun -> DefaultMachineParameters fun
 toMachineParameters pv (EvaluationContext ll toCaser toSemVar machParsList) =
     case lookup (toSemVar pv) machParsList of
         Nothing -> error $ Prelude.concat
@@ -148,7 +152,7 @@ protocol version are
    more semantically precise to associate bundles of machine parameters with semantics variants than
    with protocol versions
 -}
-data EvaluationContext = EvaluationContext
+data EvaluationContext fun = EvaluationContext
     { _evalCtxLedgerLang    :: PlutusLedgerLanguage
       -- ^ Specifies what language versions the 'EvaluationContext' is for.
     , _evalCtxCaserBuiltin  :: MajorProtocolVersion -> CaserBuiltin DefaultUni
@@ -159,16 +163,19 @@ data EvaluationContext = EvaluationContext
       -- is available.
       -- FIXME: do we need to test that it fails for older PVs?  We can't submit
       -- transactions in old PVs, so maybe it doesn't matter.
-    , _evalCtxToSemVar      :: MajorProtocolVersion -> BuiltinSemanticsVariant DefaultFun
+    , _evalCtxToSemVar      :: MajorProtocolVersion -> BuiltinSemanticsVariant fun
       -- ^ Specifies how to get a semantics variant for this ledger language given a
       -- 'MajorProtocolVersion'.
     , _evalCtxMachParsCache ::
-        [(BuiltinSemanticsVariant DefaultFun, DefaultMachineVariantParameters)]
+        [(BuiltinSemanticsVariant fun, DefaultMachineVariantParameters fun)]
       -- ^ The cache of 'DefaultMachineParameters' for each semantics variant supported by the
       -- current language version.
     }
     deriving stock Generic
-    deriving anyclass (NFData, NoThunks)
+
+instance (NFData (BuiltinSemanticsVariant fun), Enum fun, Bounded fun) => NFData (EvaluationContext fun)
+
+instance (NoThunks (BuiltinSemanticsVariant fun), Enum fun, Bounded fun) => NoThunks (EvaluationContext fun)
 
 {-|  Create an 'EvaluationContext' given all builtin semantics variants supported by the provided
 language version.
@@ -190,7 +197,7 @@ mkDynEvaluationContext
     -> [BuiltinSemanticsVariant DefaultFun]
     -> (MajorProtocolVersion -> BuiltinSemanticsVariant DefaultFun)
     -> Plutus.CostModelParams
-    -> m EvaluationContext
+    -> m (EvaluationContext DefaultFun)
 mkDynEvaluationContext ll toCaser semVars toSemVar newCMP = do
     machPars <- mkMachineVariantParametersFor semVars newCMP
     pure $ EvaluationContext ll toCaser toSemVar machPars
@@ -202,12 +209,13 @@ assertWellFormedCostModelParams = void . Plutus.applyCostModelParams Plutus.defa
 -- | Evaluate a fully-applied term using the CEK machine. Useful for mimicking the behaviour of the
 -- on-chain evaluator.
 evaluateTerm
-    :: UPLC.ExBudgetMode cost DefaultUni DefaultFun
+    :: (ThrowableBuiltins DefaultUni fun, Eq (BuiltinSemanticsVariant fun))
+    => UPLC.ExBudgetMode cost DefaultUni fun
     -> MajorProtocolVersion
     -> VerboseMode
-    -> EvaluationContext
-    -> UPLC.Term UPLC.NamedDeBruijn DefaultUni DefaultFun ()
-    -> UPLC.CekReport cost NamedDeBruijn DefaultUni DefaultFun
+    -> EvaluationContext fun
+    -> UPLC.Term UPLC.NamedDeBruijn DefaultUni fun ()
+    -> UPLC.CekReport cost NamedDeBruijn DefaultUni fun
 evaluateTerm budgetMode pv verbose ectx =
     UPLC.runCekDeBruijn
         (toMachineParameters pv ectx)
@@ -231,7 +239,7 @@ evaluateScriptRestricting
     :: PlutusLedgerLanguage -- ^ The Plutus ledger language of the script under execution.
     -> MajorProtocolVersion -- ^ Which major protocol version to run the operation in
     -> VerboseMode          -- ^ Whether to produce log output
-    -> EvaluationContext    -- ^ Includes the cost model to use for tallying up the execution costs
+    -> EvaluationContext DefaultFun -- ^ Includes the cost model to use for tallying up the execution costs
     -> ExBudget             -- ^ The resource budget which must not be exceeded during evaluation
     -> ScriptForEvaluation  -- ^ The script to evaluate
     -> [Plutus.Data]        -- ^ The arguments to the script
@@ -254,7 +262,7 @@ evaluateScriptCounting
     :: PlutusLedgerLanguage -- ^ The Plutus ledger language of the script under execution.
     -> MajorProtocolVersion -- ^ Which major protocol version to run the operation in
     -> VerboseMode          -- ^ Whether to produce log output
-    -> EvaluationContext    -- ^ Includes the cost model to use for tallying up the execution costs
+    -> EvaluationContext DefaultFun -- ^ Includes the cost model to use for tallying up the execution costs
     -> ScriptForEvaluation  -- ^ The script to evaluate
     -> [Plutus.Data]        -- ^ The arguments to the script
     -> (LogOutput, Either EvaluationError ExBudget)

plutus-ledger-api/src/PlutusLedgerApi/Data/V1.hs

@@ -238,7 +238,7 @@ evaluateScriptCounting
   -- ^ Which major protocol version to run the operation in
   -> VerboseMode
   -- ^ Whether to produce log output
-  -> EvaluationContext
+  -> EvaluationContext DefaultFun
   -- ^ Includes the cost model to use for tallying up the execution costs
   -> ScriptForEvaluation
   -- ^ The script to evaluate
@@ -259,7 +259,7 @@ evaluateScriptRestricting
   -- ^ Which major protocol version to run the operation in
   -> VerboseMode
   -- ^ Whether to produce log output
-  -> EvaluationContext
+  -> EvaluationContext DefaultFun
   -- ^ Includes the cost model to use for tallying up the execution costs
   -> ExBudget
   -- ^ The resource budget which must not be exceeded during evaluation

plutus-ledger-api/src/PlutusLedgerApi/Data/V2.hs

@@ -230,7 +230,7 @@ evaluateScriptCounting
   -- ^ Which major protocol version to run the operation in
   -> Common.VerboseMode
   -- ^ Whether to produce log output
-  -> Common.EvaluationContext
+  -> Common.EvaluationContext Common.DefaultFun
   -- ^ Includes the cost model to use for tallying up the execution costs
   -> Common.ScriptForEvaluation
   -- ^ The script to evaluate
@@ -251,7 +251,7 @@ evaluateScriptRestricting
   -- ^ Which major protocol version to run the operation in
   -> Common.VerboseMode
   -- ^ Whether to produce log output
-  -> Common.EvaluationContext
+  -> Common.EvaluationContext Common.DefaultFun
   -- ^ Includes the cost model to use for tallying up the execution costs
   -> Common.ExBudget
   -- ^ The resource budget which must not be exceeded during evaluation

plutus-ledger-api/src/PlutusLedgerApi/Data/V3.hs

@@ -300,7 +300,7 @@ evaluateScriptCounting
   -- ^ Which protocol version to run the operation in
   -> Common.VerboseMode
   -- ^ Whether to produce log output
-  -> EvaluationContext.EvaluationContext
+  -> EvaluationContext.EvaluationContext Common.DefaultFun
   -- ^ Includes the cost model to use for tallying up the execution costs
   -> Common.ScriptForEvaluation
   -- ^ The script to evaluate
@@ -322,7 +322,7 @@ evaluateScriptRestricting
   -- ^ Which protocol version to run the operation in
   -> Common.VerboseMode
   -- ^ Whether to produce log output
-  -> EvaluationContext.EvaluationContext
+  -> EvaluationContext.EvaluationContext Common.DefaultFun
   -- ^ Includes the cost model to use for tallying up the execution costs
   -> Common.ExBudget
   -- ^ The resource budget which must not be exceeded during evaluation

plutus-ledger-api/src/PlutusLedgerApi/MachineParameters.hs

@@ -12,7 +12,7 @@ import PlutusCore.Evaluation.Machine.MachineParameters.Default (DefaultMachinePa
 machineParametersFor
   :: PlutusLedgerLanguage
   -> MajorProtocolVersion
-  -> DefaultMachineParameters
+  -> DefaultMachineParameters DefaultFun
 machineParametersFor ledgerLang majorPV =
   MachineParameters
       (if majorPV < pv11PV

plutus-ledger-api/src/PlutusLedgerApi/V1.hs

@@ -251,7 +251,7 @@ evaluateScriptCounting ::
   -- | Whether to produce log output
   Common.VerboseMode ->
   -- | Includes the cost model to use for tallying up the execution costs
-  EvaluationContext.EvaluationContext ->
+  EvaluationContext.EvaluationContext Eval.DefaultFun ->
   -- | The script to evaluate
   Common.ScriptForEvaluation ->
   -- | The arguments to the script
@@ -272,7 +272,7 @@ evaluateScriptRestricting ::
   -- | Whether to produce log output
   Common.VerboseMode ->
   -- | Includes the cost model to use for tallying up the execution costs
-  EvaluationContext.EvaluationContext ->
+  EvaluationContext.EvaluationContext Eval.DefaultFun ->
   -- | The resource budget which must not be exceeded during evaluation
   Common.ExBudget ->
   -- | The script to evaluate

plutus-ledger-api/src/PlutusLedgerApi/V1/EvaluationContext.hs

@@ -35,7 +35,7 @@ a protocol update with the updated cost model parameters.
 mkEvaluationContext
   :: (MonadError CostModelApplyError m, MonadWriter [CostModelApplyWarn] m)
   => [Int64] -- ^ the (updated) cost model parameters of the protocol
-  -> m EvaluationContext
+  -> m (EvaluationContext DefaultFun)
 mkEvaluationContext =
   tagWithParamNames @V1.ParamName
     >=> pure . toCostModelParams

plutus-ledger-api/src/PlutusLedgerApi/V2.hs

@@ -169,7 +169,7 @@ evaluateScriptCounting ::
   -- | Whether to produce log output
   Common.VerboseMode ->
   -- | Includes the cost model to use for tallying up the execution costs
-  Common.EvaluationContext ->
+  Common.EvaluationContext Common.DefaultFun ->
   -- | The script to evaluate
   Common.ScriptForEvaluation ->
   -- | The arguments to the script
@@ -190,7 +190,7 @@ evaluateScriptRestricting ::
   -- | Whether to produce log output
   Common.VerboseMode ->
   -- | Includes the cost model to use for tallying up the execution costs
-  Common.EvaluationContext ->
+  Common.EvaluationContext Common.DefaultFun ->
   -- | The resource budget which must not be exceeded during evaluation
   Common.ExBudget ->
   -- | The script to evaluate

plutus-ledger-api/src/PlutusLedgerApi/V2/EvaluationContext.hs

@@ -34,7 +34,7 @@ a protocol update with the updated cost model parameters.
 mkEvaluationContext
   :: (MonadError CostModelApplyError m, MonadWriter [CostModelApplyWarn] m)
   => [Int64] -- ^ the (updated) cost model parameters of the protocol
-  -> m EvaluationContext
+  -> m (EvaluationContext DefaultFun)
 mkEvaluationContext =
   tagWithParamNames @V2.ParamName
     >=> pure . toCostModelParams

plutus-ledger-api/src/PlutusLedgerApi/V3.hs

@@ -195,7 +195,7 @@ evaluateScriptCounting ::
   -- | Whether to produce log output
   Common.VerboseMode ->
   -- | Includes the cost model to use for tallying up the execution costs
-  EvaluationContext.EvaluationContext ->
+  EvaluationContext.EvaluationContext Common.DefaultFun ->
   -- | The script to evaluate
   Common.ScriptForEvaluation ->
   -- | The @ScriptContext@ argument to the script
@@ -217,7 +217,7 @@ evaluateScriptRestricting ::
   -- | Whether to produce log output
   Common.VerboseMode ->
   -- | Includes the cost model to use for tallying up the execution costs
-  EvaluationContext.EvaluationContext ->
+  EvaluationContext.EvaluationContext Common.DefaultFun ->
   -- | The resource budget which must not be exceeded during evaluation
   Common.ExBudget ->
   -- | The script to evaluate