[Costing] Drop 'uni' and 'ann' from 'MachineParameters

IntersectMBO · Jan 31, 2023 · fefb9f6 · fefb9f6
1 parent 34031af
commit fefb9f6
Show file tree

Hide file tree

Showing 5 changed files with 24 additions and 20 deletions.
diff --git a/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/ExBudgetingDefaults.hs b/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/ExBudgetingDefaults.hs
@@ -28,9 +28,10 @@ import UntypedPlutusCore.Evaluation.Machine.Cek.CekMachineCosts
 import UntypedPlutusCore.Evaluation.Machine.Cek.Internal
 
 import Data.Aeson.THReader
+-- Not using 'noinline' from "GHC.Exts", because our CI was unable to find it there, somehow.
+import GHC.Magic (noinline)
 import PlutusPrelude
 
-
 -- | The default cost model for built-in functions.
 defaultBuiltinCostModel :: BuiltinCostModel
 defaultBuiltinCostModel =
@@ -74,12 +75,15 @@ defaultCekCostModel = CostModel defaultCekMachineCosts defaultBuiltinCostModel
 defaultCostModelParams :: Maybe CostModelParams
 defaultCostModelParams = extractCostModelParams defaultCekCostModel
 
-defaultCekParameters :: Typeable ann => MachineParameters CekMachineCosts CekValue DefaultUni DefaultFun ann
+defaultCekParameters :: Typeable ann => MachineParameters CekMachineCosts DefaultFun (CekValue DefaultUni DefaultFun ann)
 defaultCekParameters = mkMachineParameters def defaultCekCostModel
 
-unitCekParameters :: Typeable ann => MachineParameters CekMachineCosts CekValue DefaultUni DefaultFun ann
+unitCekParameters :: Typeable ann => MachineParameters CekMachineCosts DefaultFun (CekValue DefaultUni DefaultFun ann)
 unitCekParameters =
-    mkMachineParameters def $
+    -- @noinline@ is purely for saving on simplifier ticks, since we don't care about the
+    -- performance of this definition. Otherwise compilation for this module is slower and GHC may
+    -- end up exhausting simplifier ticks leading to a compilation error.
+    noinline . mkMachineParameters def $
         CostModel unitCekMachineCosts unitCostBuiltinCostModel
 
 defaultBuiltinsRuntime :: HasMeaningIn DefaultUni term => BuiltinsRuntime DefaultFun term

diff --git a/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/MachineParameters.hs b/plutus-core/plutus-core/src/PlutusCore/Evaluation/Machine/MachineParameters.hs
@@ -14,7 +14,6 @@ import Control.DeepSeq
 import Control.Lens
 import GHC.Exts (inline)
 import GHC.Generics
-import GHC.Types (Type)
 import NoThunks.Class
 
 {-| We need to account for the costs of evaluator steps and also built-in function
@@ -37,10 +36,10 @@ 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 term (uni :: Type -> Type) (fun :: Type) (ann :: Type) =
+data MachineParameters machinecosts fun val =
     MachineParameters {
       machineCosts    :: machinecosts
-    , builtinsRuntime :: BuiltinsRuntime fun (term uni fun ann)
+    , builtinsRuntime :: BuiltinsRuntime fun val
     }
     deriving stock Generic
     deriving anyclass (NFData, NoThunks)
@@ -76,12 +75,12 @@ 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 uni fun ann)
+    , HasMeaningIn uni val
     , ToBuiltinMeaning uni fun
     )
     => BuiltinVersion fun
     -> CostModel machinecosts builtincosts
-    -> MachineParameters machinecosts val uni fun ann
+    -> MachineParameters machinecosts fun val
 mkMachineParameters ver (CostModel mchnCosts builtinCosts) =
     MachineParameters mchnCosts (inline toBuiltinsRuntime ver 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
@@ -14,7 +14,8 @@ import UntypedPlutusCore.Evaluation.Machine.Cek
 import Control.Monad.Except
 import GHC.Exts (inline)
 
-type DefaultMachineParameters = MachineParameters CekMachineCosts 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

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
@@ -92,7 +92,7 @@ A wrapper around the internal runCek to debruijn input and undebruijn output.
 -}
 runCek
     :: PrettyUni uni fun
-    => MachineParameters CekMachineCosts CekValue uni fun ann
+    => MachineParameters CekMachineCosts fun (CekValue uni fun ann)
     -> ExBudgetMode cost uni fun
     -> EmitterMode uni fun
     -> Term Name uni fun ann
@@ -123,7 +123,7 @@ runCek params mode emitMode term =
 -- *THIS FUNCTION IS PARTIAL if the input term contains free variables*
 runCekNoEmit
     :: PrettyUni uni fun
-    => MachineParameters CekMachineCosts 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)
@@ -140,7 +140,7 @@ unsafeRunCekNoEmit
        , Closed uni, uni `Everywhere` PrettyConst
        , Pretty fun, Typeable fun
        )
-    => MachineParameters CekMachineCosts 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)
@@ -153,7 +153,7 @@ unsafeRunCekNoEmit params mode =
 evaluateCek
     :: PrettyUni uni fun
     => EmitterMode uni fun
-    -> MachineParameters CekMachineCosts 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 emitMode params =
@@ -164,7 +164,7 @@ evaluateCek emitMode params =
 -- *THIS FUNCTION IS PARTIAL if the input term contains free variables*
 evaluateCekNoEmit
     :: PrettyUni uni fun
-    => MachineParameters CekMachineCosts 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 params = fst . runCekNoEmit params restrictingEnormous
@@ -177,7 +177,7 @@ unsafeEvaluateCek
        , Pretty fun, Typeable fun
        )
     => EmitterMode uni fun
-    -> MachineParameters CekMachineCosts CekValue uni fun ann
+    -> MachineParameters CekMachineCosts fun (CekValue uni fun ann)
     -> Term Name uni fun ann
     -> (EvaluationResult (Term Name uni fun ()), [Text])
 unsafeEvaluateCek emitTime params =
@@ -191,7 +191,7 @@ unsafeEvaluateCekNoEmit
        , Closed uni, uni `Everywhere` PrettyConst
        , Pretty fun, Typeable fun
        )
-    => MachineParameters CekMachineCosts CekValue uni fun ann
+    => MachineParameters CekMachineCosts fun (CekValue uni fun ann)
     -> Term Name uni fun ann
     -> EvaluationResult (Term Name uni fun ())
 unsafeEvaluateCekNoEmit params = unsafeExtractEvaluationResult . evaluateCekNoEmit params
@@ -202,7 +202,7 @@ readKnownCek
     :: ( ReadKnown (Term Name uni fun ()) a
        , PrettyUni uni fun
        )
-    => MachineParameters CekMachineCosts CekValue uni fun ann
+    => MachineParameters CekMachineCosts fun (CekValue uni fun ann)
     -> Term Name uni fun ann
     -> Either (CekEvaluationException Name uni fun) a
 readKnownCek params = evaluateCekNoEmit params >=> readKnownSelf
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
@@ -550,7 +550,7 @@ tryError a = (Right <$> a) `catchError` (pure . Left)
 runCekM
     :: forall a cost uni fun ann.
     (PrettyUni uni fun)
-    => MachineParameters CekMachineCosts 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)
@@ -774,7 +774,7 @@ enterComputeCek = computeCek (toWordArray 0) where
 -- | Evaluate a term using the CEK machine and keep track of costing, logging is optional.
 runCekDeBruijn
     :: PrettyUni uni fun
-    => MachineParameters CekMachineCosts CekValue uni fun ann
+    => MachineParameters CekMachineCosts fun (CekValue uni fun ann)
     -> ExBudgetMode cost uni fun
     -> EmitterMode uni fun
     -> Term NamedDeBruijn uni fun ann