{-# LANGUAGE TypeApplications #-}
module PlutusLedgerApi.V3.EvaluationContext
( EvaluationContext
, mkEvaluationContext
, CostModelParams
, assertWellFormedCostModelParams
, toMachineParameters
, CostModelApplyError (..)
) where
import PlutusLedgerApi.Common
import PlutusLedgerApi.Common.ProtocolVersions (futurePV)
import PlutusLedgerApi.V3.ParamName as V3
import PlutusCore.Builtin (CaserBuiltin (..), caseBuiltin, unavailableCaserBuiltin)
import PlutusCore.Default (BuiltinSemanticsVariant (DefaultFunSemanticsVariantC))
import Control.Monad
import Control.Monad.Writer.Strict
import Data.Int (Int64)
mkEvaluationContext
:: (MonadError CostModelApplyError m, MonadWriter [CostModelApplyWarn] m)
=> [Int64]
-> m EvaluationContext
mkEvaluationContext :: forall (m :: * -> *).
(MonadError CostModelApplyError m,
MonadWriter [CostModelApplyWarn] m) =>
[Int64] -> m EvaluationContext
mkEvaluationContext =
forall k (m :: * -> *).
(Enum k, Bounded k, MonadError CostModelApplyError m,
MonadWriter [CostModelApplyWarn] m) =>
[Int64] -> m [(k, Int64)]
tagWithParamNames @V3.ParamName
([Int64] -> m [(ParamName, Int64)])
-> ([(ParamName, Int64)] -> m EvaluationContext)
-> [Int64]
-> m EvaluationContext
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> CostModelParams -> m CostModelParams
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CostModelParams -> m CostModelParams)
-> ([(ParamName, Int64)] -> CostModelParams)
-> [(ParamName, Int64)]
-> m CostModelParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(ParamName, Int64)] -> CostModelParams
forall p. IsParamName p => [(p, Int64)] -> CostModelParams
toCostModelParams
([(ParamName, Int64)] -> m CostModelParams)
-> (CostModelParams -> m EvaluationContext)
-> [(ParamName, Int64)]
-> m EvaluationContext
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> PlutusLedgerLanguage
-> (MajorProtocolVersion -> CaserBuiltin DefaultUni)
-> [BuiltinSemanticsVariant DefaultFun]
-> (MajorProtocolVersion -> BuiltinSemanticsVariant DefaultFun)
-> CostModelParams
-> m EvaluationContext
forall (m :: * -> *).
MonadError CostModelApplyError m =>
PlutusLedgerLanguage
-> (MajorProtocolVersion -> CaserBuiltin DefaultUni)
-> [BuiltinSemanticsVariant DefaultFun]
-> (MajorProtocolVersion -> BuiltinSemanticsVariant DefaultFun)
-> CostModelParams
-> m EvaluationContext
mkDynEvaluationContext
PlutusLedgerLanguage
PlutusV3
(\MajorProtocolVersion
pv ->
if MajorProtocolVersion
pv MajorProtocolVersion -> MajorProtocolVersion -> Bool
forall a. Ord a => a -> a -> Bool
< MajorProtocolVersion
futurePV
then Int -> CaserBuiltin DefaultUni
forall (uni :: * -> *). Int -> CaserBuiltin uni
unavailableCaserBuiltin (Int -> CaserBuiltin DefaultUni) -> Int -> CaserBuiltin DefaultUni
forall a b. (a -> b) -> a -> b
$ MajorProtocolVersion -> Int
getMajorProtocolVersion MajorProtocolVersion
pv
else (forall term.
(UniOf term ~ DefaultUni) =>
Some (ValueOf DefaultUni) -> Vector term -> Either Text term)
-> CaserBuiltin DefaultUni
forall (uni :: * -> *).
(forall term.
(UniOf term ~ uni) =>
Some (ValueOf uni) -> Vector term -> Either Text term)
-> CaserBuiltin uni
CaserBuiltin Some (ValueOf DefaultUni) -> Vector term -> Either Text term
forall term.
(UniOf term ~ DefaultUni) =>
Some (ValueOf DefaultUni) -> Vector term -> Either Text term
forall (uni :: * -> *) term.
(CaseBuiltin uni, UniOf term ~ uni) =>
Some (ValueOf uni) -> Vector term -> Either Text term
caseBuiltin)
[BuiltinSemanticsVariant DefaultFun
DefaultFunSemanticsVariantC]
(BuiltinSemanticsVariant DefaultFun
-> MajorProtocolVersion -> BuiltinSemanticsVariant DefaultFun
forall a b. a -> b -> a
const BuiltinSemanticsVariant DefaultFun
DefaultFunSemanticsVariantC)