Back to 'ExMemoryUsage' in 'HasMeaningIn'

plutus-core/plutus-core/src/PlutusCore/Builtin/Meaning.hs

@@ -7,7 +7,6 @@
 {-# LANGUAGE FlexibleInstances         #-}
 {-# LANGUAGE MultiParamTypeClasses     #-}
 {-# LANGUAGE PolyKinds                 #-}
-{-# LANGUAGE RankNTypes                #-}
 {-# LANGUAGE StandaloneKindSignatures  #-}
 {-# LANGUAGE TypeApplications          #-}
 {-# LANGUAGE TypeFamilies              #-}
@@ -65,10 +64,10 @@ data BuiltinMeaning val cost =
     forall args res. BuiltinMeaning
         (TypeScheme val args res)
         ~(FoldArgs args res)
-        (ExMemoryUsage val => BuiltinRuntimeOptions val cost)
+        (BuiltinRuntimeOptions val cost)
 
 -- | Constraints available when defining a built-in function.
-type HasMeaningIn uni val = (Typeable val, HasConstantIn uni val)
+type HasMeaningIn uni val = (Typeable val, ExMemoryUsage val, HasConstantIn uni val)
 
 -- | A type class for \"each function from a set of built-in functions has a 'BuiltinMeaning'\".
 class (Typeable uni, Typeable fun, Bounded fun, Enum fun, Ix fun) => ToBuiltinMeaning uni fun where
@@ -217,7 +216,7 @@ instance
     knownMonotype = TypeSchemeArrow knownMonotype
 
     -- See Note [One-shotting runtime denotations].
-    -- Unlift, then recurse.
+     -- Unlift, then recurse.
     toMonoImmediateF (f, exF) = BuiltinArrow . oneShot $
         -- See Note [Strict application in runtime denotations].
         fmap (\x -> toMonoImmediateF @val @args @res . (,) (f x) $! exF x) . readKnown
@@ -316,10 +315,7 @@ class MakeBuiltinMeaning a val where
     --
     -- 1. the denotation of the builtin
     -- 2. an uninstantiated costing function
-    makeBuiltinMeaning
-        :: a
-        -> (ExMemoryUsage val => cost -> FoldArgs (GetArgs a) ExBudget)
-        -> BuiltinMeaning val cost
+    makeBuiltinMeaning :: a -> (cost -> FoldArgs (GetArgs a) ExBudget) -> BuiltinMeaning val cost
 instance
         ( binds ~ ToBinds a, args ~ GetArgs a, a ~ FoldArgs args res
         , ThrowOnBothEmpty binds args (IsBuiltin a) a
@@ -339,9 +335,7 @@ instance
     {-# INLINE makeBuiltinMeaning #-}
 
 -- | Convert a 'BuiltinMeaning' to a 'BuiltinRuntime' given an 'UnliftingMode' and a cost model.
-toBuiltinRuntime
-    :: ExMemoryUsage val
-    => UnliftingMode -> cost -> BuiltinMeaning val cost -> BuiltinRuntime val
+toBuiltinRuntime :: UnliftingMode -> cost -> BuiltinMeaning val cost -> BuiltinRuntime val
 toBuiltinRuntime unlMode cost (BuiltinMeaning _ _ runtimeOpts) =
     fromBuiltinRuntimeOptions unlMode cost runtimeOpts
 {-# INLINE toBuiltinRuntime #-}
@@ -350,9 +344,7 @@ toBuiltinRuntime unlMode cost (BuiltinMeaning _ _ runtimeOpts) =
 -- | Calculate runtime info for all built-in functions given denotations of builtins,
 -- an 'UnliftingMode' and a cost model.
 toBuiltinsRuntime
-    :: ( cost ~ CostingPart uni fun, ToBuiltinMeaning uni fun
-       , HasMeaningIn uni val, ExMemoryUsage val
-       )
+    :: (cost ~ CostingPart uni fun, ToBuiltinMeaning uni fun, HasMeaningIn uni val)
     => UnliftingMode -> cost -> BuiltinsRuntime fun val
 toBuiltinsRuntime unlMode cost =
     let arr = tabulateArray $ toBuiltinRuntime unlMode cost . inline toBuiltinMeaning

plutus-core/plutus-core/src/PlutusCore/Core/Type.hs

@@ -10,6 +10,7 @@
 {-# LANGUAGE TemplateHaskell          #-}
 {-# LANGUAGE TypeApplications         #-}
 {-# LANGUAGE TypeFamilies             #-}
+{-# LANGUAGE TypeOperators            #-}
 {-# LANGUAGE UndecidableInstances     #-}
 
 module PlutusCore.Core.Type
@@ -48,6 +49,7 @@ where
 
 import PlutusPrelude
 
+import PlutusCore.Evaluation.Machine.ExMemory
 import PlutusCore.Name
 
 import Control.Lens
@@ -91,6 +93,9 @@ data Term tyname name uni fun ann
     deriving stock (Show, Functor, Generic)
     deriving anyclass (NFData)
 
+instance ExMemoryUsage (Term tyname name uni fun ann) where
+    memoryUsage = error "Internal error: 'memoryUsage' for Core 'Term' is not supposed to be forced"
+
 {- |
 The version of Plutus Core used by this program.
 

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

@@ -143,7 +143,7 @@ data Frame uni fun
 type Context uni fun = [Frame uni fun]
 
 instance ExMemoryUsage (CkValue uni fun) where
-    memoryUsage = error "The CK machine does not support costing"
+    memoryUsage = error "Internal error: 'memoryUsage' for 'CkValue' is not supposed to be forced"
 
 runCkM
     :: BuiltinsRuntime fun (CkValue uni fun)

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

@@ -23,7 +23,6 @@ import PlutusCore.DataFilePaths qualified as DFP
 import PlutusCore.Default
 import PlutusCore.Evaluation.Machine.BuiltinCostModel
 import PlutusCore.Evaluation.Machine.CostModelInterface
-import PlutusCore.Evaluation.Machine.ExMemory
 import PlutusCore.Evaluation.Machine.MachineParameters
 
 import UntypedPlutusCore.Evaluation.Machine.Cek.CekMachineCosts
@@ -86,8 +85,7 @@ unitCekParameters =
     mkMachineParameters defaultUnliftingMode $
         CostModel unitCekMachineCosts unitCostBuiltinCostModel
 
-defaultBuiltinsRuntime
-    :: (HasMeaningIn DefaultUni val, ExMemoryUsage val) => BuiltinsRuntime DefaultFun val
+defaultBuiltinsRuntime :: HasMeaningIn DefaultUni term => BuiltinsRuntime DefaultFun term
 defaultBuiltinsRuntime = toBuiltinsRuntime defaultUnliftingMode defaultBuiltinCostModel
 
 

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

@@ -9,7 +9,6 @@ module PlutusCore.Evaluation.Machine.MachineParameters
 where
 
 import PlutusCore.Builtin
-import PlutusCore.Evaluation.Machine.ExMemory
 
 import Control.DeepSeq
 import Control.Lens
@@ -49,7 +48,7 @@ data MachineParameters machinecosts term (uni :: Type -> Type) (fun :: Type) =
 -- See Note [Inlining meanings of builtins].
 {-| This just uses 'toBuiltinsRuntime' function to convert a BuiltinCostModel to a BuiltinsRuntime. -}
 mkMachineParameters
-    :: (ToBuiltinMeaning uni fun, HasMeaningIn uni (val uni fun), ExMemoryUsage (val uni fun))
+    :: (ToBuiltinMeaning uni fun, HasMeaningIn uni (val uni fun))
     => UnliftingMode
     -> CostModel machinecosts (CostingPart uni fun)
     -> MachineParameters machinecosts val uni fun

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

@@ -2,6 +2,7 @@
 -- We keep them separate, because the function unfolds into multiple thousands of lines of Core and
 -- we want to instantiate it in two different ways on top of that, which gives another ton of Core
 -- that we need to inspect, hence we dedicate an entire folder to that.
+
 module PlutusCore.Evaluation.Machine.MachineParameters.Default where
 
 import PlutusCore.Builtin

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

@@ -22,6 +22,7 @@ import GHC.Exts (inline)
 immediateMachineParameters
     :: MonadError CostModelApplyError m => CostModelParams -> m DefaultMachineParameters
 immediateMachineParameters = inline mkMachineParametersFor UnliftingImmediate
+{-# INLINE immediateMachineParameters #-}
 -- No need to mark this as 'INLINE', since a 'CostModelParams' comes in at runtime and so we can't
 -- get the builtins to optimize any further. We don't need to optimize the 'MonadError' part, since
 -- it's only computed when the parameters change, not multiple times (not even once) per contract

plutus-core/plutus-ir/src/PlutusIR/Core/Type.hs

@@ -33,6 +33,7 @@ import PlutusCore (Kind, Name, TyName, Type (..))
 import PlutusCore qualified as PLC
 import PlutusCore.Builtin (HasConstant (..), throwNotAConstant)
 import PlutusCore.Core (UniOf)
+import PlutusCore.Evaluation.Machine.ExMemory
 import PlutusCore.Flat ()
 import PlutusCore.MkPlc (Def (..), TermLike (..), TyVarDecl (..), VarDecl (..))
 import PlutusCore.Name qualified as PLC
@@ -128,6 +129,10 @@ data Term tyname name uni fun a =
                         | Unwrap a (Term tyname name uni fun a)
                         deriving stock (Functor, Show, Generic)
 
+instance ExMemoryUsage (Term tyname name uni fun ann) where
+    memoryUsage =
+        Prelude.error "Internal error: 'memoryUsage' for IR 'Term' is not supposed to be forced"
+
 type instance UniOf (Term tyname name uni fun ann) = uni
 
 instance HasConstant (Term tyname name uni fun ()) where

plutus-core/untyped-plutus-core/test/Evaluation/Builtins.hs

@@ -1,6 +1,5 @@
 module Evaluation.Builtins (test_builtins) where
 
-import Evaluation.Builtins.Coherence (test_TypeSchemesAndRuntimeSchemesAgree)
 import Evaluation.Builtins.Definition (test_definition)
 import Evaluation.Builtins.MakeRead (test_makeRead)
 
@@ -11,5 +10,4 @@ test_builtins =
     testGroup "builtins"
         [ test_definition
         , test_makeRead
-        , test_TypeSchemesAndRuntimeSchemesAgree
         ]