module PlutusLedgerApi.MachineParameters where

import PlutusLedgerApi.Common
import PlutusLedgerApi.Common.ProtocolVersions (futurePV)

import PlutusCore.Builtin (CaserBuiltin (..), caseBuiltin, unavailableCaserBuiltin)
import PlutusCore.Default (BuiltinSemanticsVariant (..))
import PlutusCore.Evaluation.Machine.ExBudgetingDefaults (cekCostModelForVariant)
import PlutusCore.Evaluation.Machine.MachineParameters (MachineParameters (..),
                                                        mkMachineVariantParameters)
import PlutusCore.Evaluation.Machine.MachineParameters.Default (DefaultMachineParameters)

machineParametersFor
  :: PlutusLedgerLanguage
  -> MajorProtocolVersion
  -> DefaultMachineParameters
machineParametersFor :: PlutusLedgerLanguage
-> MajorProtocolVersion -> DefaultMachineParameters
machineParametersFor PlutusLedgerLanguage
ledgerLang MajorProtocolVersion
majorPV =
  CaserBuiltin (UniOf (CekValue DefaultUni DefaultFun ()))
-> MachineVariantParameters
     CekMachineCosts DefaultFun (CekValue DefaultUni DefaultFun ())
-> DefaultMachineParameters
forall machineCosts fun val.
CaserBuiltin (UniOf val)
-> MachineVariantParameters machineCosts fun val
-> MachineParameters machineCosts fun val
MachineParameters
      (if MajorProtocolVersion
majorPV MajorProtocolVersion -> MajorProtocolVersion -> Bool
forall a. Ord a => a -> a -> Bool
< MajorProtocolVersion
futurePV
        then Int -> CaserBuiltin (UniOf (CekValue DefaultUni DefaultFun ()))
forall (uni :: * -> *). Int -> CaserBuiltin uni
unavailableCaserBuiltin (Int -> CaserBuiltin (UniOf (CekValue DefaultUni DefaultFun ())))
-> Int -> CaserBuiltin (UniOf (CekValue DefaultUni DefaultFun ()))
forall a b. (a -> b) -> a -> b
$ MajorProtocolVersion -> Int
getMajorProtocolVersion MajorProtocolVersion
majorPV
        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
-> CostModel CekMachineCosts BuiltinCostModel
-> MachineVariantParameters
     CekMachineCosts DefaultFun (CekValue DefaultUni DefaultFun ())
forall (uni :: * -> *) fun builtincosts val machineCosts.
(CostingPart uni fun ~ builtincosts, HasMeaningIn uni val,
 ToBuiltinMeaning uni fun) =>
BuiltinSemanticsVariant fun
-> CostModel machineCosts builtincosts
-> MachineVariantParameters machineCosts fun val
mkMachineVariantParameters BuiltinSemanticsVariant DefaultFun
builtinSemVar (CostModel CekMachineCosts BuiltinCostModel
 -> MachineVariantParameters
      CekMachineCosts DefaultFun (CekValue DefaultUni DefaultFun ()))
-> CostModel CekMachineCosts BuiltinCostModel
-> MachineVariantParameters
     CekMachineCosts DefaultFun (CekValue DefaultUni DefaultFun ())
forall a b. (a -> b) -> a -> b
$ BuiltinSemanticsVariant DefaultFun
-> CostModel CekMachineCosts BuiltinCostModel
cekCostModelForVariant BuiltinSemanticsVariant DefaultFun
builtinSemVar)
 where
  builtinSemVar :: BuiltinSemanticsVariant DefaultFun
builtinSemVar =
    case PlutusLedgerLanguage
ledgerLang of
      PlutusLedgerLanguage
PlutusV1 -> BuiltinSemanticsVariant DefaultFun
conwayDependentVariant
      PlutusLedgerLanguage
PlutusV2 -> BuiltinSemanticsVariant DefaultFun
conwayDependentVariant
      PlutusLedgerLanguage
PlutusV3 -> BuiltinSemanticsVariant DefaultFun
DefaultFunSemanticsVariantC
  conwayDependentVariant :: BuiltinSemanticsVariant DefaultFun
conwayDependentVariant =
    if MajorProtocolVersion
majorPV MajorProtocolVersion -> MajorProtocolVersion -> Bool
forall a. Ord a => a -> a -> Bool
< MajorProtocolVersion
changPV
      then BuiltinSemanticsVariant DefaultFun
DefaultFunSemanticsVariantA
      else BuiltinSemanticsVariant DefaultFun
DefaultFunSemanticsVariantB