Push 'MajorProtocolVersion' into 'MachineParameters'

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

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

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

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

plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/ExBudgetingDefaults.hs

@@ -84,16 +84,17 @@ 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
 matter. Otherwise compilation for this module is slower and GHC may end up exhausting simplifier
 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 $

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)

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

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

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

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