module PlutusLedgerApi.MachineParameters where

import PlutusLedgerApi.Common

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
vanRossemPV
        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 -> HeadSpine Text term (Some (ValueOf DefaultUni)))
-> CaserBuiltin DefaultUni
forall (uni :: * -> *).
(forall term.
 (UniOf term ~ uni) =>
 Some (ValueOf uni)
 -> Vector term -> HeadSpine Text term (Some (ValueOf uni)))
-> CaserBuiltin uni
CaserBuiltin Some (ValueOf DefaultUni)
-> Vector term -> HeadSpine Text term (Some (ValueOf DefaultUni))
forall term.
(UniOf term ~ DefaultUni) =>
Some (ValueOf DefaultUni)
-> Vector term -> HeadSpine Text term (Some (ValueOf DefaultUni))
forall (uni :: * -> *) term.
(CaseBuiltin uni, UniOf term ~ uni) =>
Some (ValueOf uni)
-> Vector term -> HeadSpine Text term (Some (ValueOf uni))
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
    -- See Note [Mapping of protocol versions and ledger languages to semantics variants].
    builtinSemVar :: BuiltinSemanticsVariant DefaultFun
builtinSemVar =
      if MajorProtocolVersion
majorPV MajorProtocolVersion -> MajorProtocolVersion -> Bool
forall a. Ord a => a -> a -> Bool
< MajorProtocolVersion
vanRossemPV
        then case PlutusLedgerLanguage
ledgerLang of
          PlutusLedgerLanguage
PlutusV1 -> BuiltinSemanticsVariant DefaultFun
conwayDependentVariant
          PlutusLedgerLanguage
PlutusV2 -> BuiltinSemanticsVariant DefaultFun
conwayDependentVariant
          PlutusLedgerLanguage
PlutusV3 -> BuiltinSemanticsVariant DefaultFun
DefaultFunSemanticsVariantC
          -- 'PlutusV4' doesn't exist before the Dijkstra HF, which comes after
          -- van Rossem, so this case is vacuous.
          PlutusLedgerLanguage
PlutusV4 -> BuiltinSemanticsVariant DefaultFun
DefaultFunSemanticsVariantE
        else case PlutusLedgerLanguage
ledgerLang of
          PlutusLedgerLanguage
PlutusV1 -> BuiltinSemanticsVariant DefaultFun
DefaultFunSemanticsVariantD
          PlutusLedgerLanguage
PlutusV2 -> BuiltinSemanticsVariant DefaultFun
DefaultFunSemanticsVariantD
          PlutusLedgerLanguage
PlutusV3 -> BuiltinSemanticsVariant DefaultFun
DefaultFunSemanticsVariantE
          PlutusLedgerLanguage
PlutusV4 -> BuiltinSemanticsVariant DefaultFun
DefaultFunSemanticsVariantE
    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