Provide support for multiple 'CostModel's

plutus-benchmark/validation/bench/Common.hs

@@ -138,10 +138,15 @@ 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.

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

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

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

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

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 = undefined
+
 -- | 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 $

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 #-}

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.

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

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

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