{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StrictData #-}
module PlutusCore.Evaluation.Machine.ExBudget
( ExBudget(..)
, minusExBudget
, ExBudgetBuiltin(..)
, ExRestrictingBudget(..)
, LowerInitialCharacter
, enormousBudget
) where
import PlutusCore.Evaluation.Machine.ExMemory
import PlutusPrelude hiding (toList)
import Codec.Serialise (Serialise (..))
import Data.Semigroup
import Deriving.Aeson
import Language.Haskell.TH.Lift (Lift)
import NoThunks.Class
import Prettyprinter
data LowerInitialCharacter
instance StringModifier LowerInitialCharacter where
getStringModifier :: String -> String
getStringModifier = String -> String
lowerInitialChar
class ExBudgetBuiltin fun exBudgetCat where
exBudgetBuiltin :: fun -> exBudgetCat
instance ExBudgetBuiltin fun () where
exBudgetBuiltin :: fun -> ()
exBudgetBuiltin fun
_ = ()
data ExBudget = ExBudget { ExBudget -> ExCPU
exBudgetCPU :: ExCPU, ExBudget -> ExMemory
exBudgetMemory :: ExMemory }
deriving stock (ExBudget -> ExBudget -> Bool
(ExBudget -> ExBudget -> Bool)
-> (ExBudget -> ExBudget -> Bool) -> Eq ExBudget
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExBudget -> ExBudget -> Bool
== :: ExBudget -> ExBudget -> Bool
$c/= :: ExBudget -> ExBudget -> Bool
/= :: ExBudget -> ExBudget -> Bool
Eq, Int -> ExBudget -> String -> String
[ExBudget] -> String -> String
ExBudget -> String
(Int -> ExBudget -> String -> String)
-> (ExBudget -> String)
-> ([ExBudget] -> String -> String)
-> Show ExBudget
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> ExBudget -> String -> String
showsPrec :: Int -> ExBudget -> String -> String
$cshow :: ExBudget -> String
show :: ExBudget -> String
$cshowList :: [ExBudget] -> String -> String
showList :: [ExBudget] -> String -> String
Show, (forall x. ExBudget -> Rep ExBudget x)
-> (forall x. Rep ExBudget x -> ExBudget) -> Generic ExBudget
forall x. Rep ExBudget x -> ExBudget
forall x. ExBudget -> Rep ExBudget x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ExBudget -> Rep ExBudget x
from :: forall x. ExBudget -> Rep ExBudget x
$cto :: forall x. Rep ExBudget x -> ExBudget
to :: forall x. Rep ExBudget x -> ExBudget
Generic, (forall (m :: * -> *). Quote m => ExBudget -> m Exp)
-> (forall (m :: * -> *). Quote m => ExBudget -> Code m ExBudget)
-> Lift ExBudget
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => ExBudget -> m Exp
forall (m :: * -> *). Quote m => ExBudget -> Code m ExBudget
$clift :: forall (m :: * -> *). Quote m => ExBudget -> m Exp
lift :: forall (m :: * -> *). Quote m => ExBudget -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => ExBudget -> Code m ExBudget
liftTyped :: forall (m :: * -> *). Quote m => ExBudget -> Code m ExBudget
Lift)
deriving anyclass (PrettyBy config, ExBudget -> ()
(ExBudget -> ()) -> NFData ExBudget
forall a. (a -> ()) -> NFData a
$crnf :: ExBudget -> ()
rnf :: ExBudget -> ()
NFData, Context -> ExBudget -> IO (Maybe ThunkInfo)
Proxy ExBudget -> String
(Context -> ExBudget -> IO (Maybe ThunkInfo))
-> (Context -> ExBudget -> IO (Maybe ThunkInfo))
-> (Proxy ExBudget -> String)
-> NoThunks ExBudget
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> ExBudget -> IO (Maybe ThunkInfo)
noThunks :: Context -> ExBudget -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> ExBudget -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> ExBudget -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy ExBudget -> String
showTypeOf :: Proxy ExBudget -> String
NoThunks, [ExBudget] -> Encoding
ExBudget -> Encoding
(ExBudget -> Encoding)
-> (forall s. Decoder s ExBudget)
-> ([ExBudget] -> Encoding)
-> (forall s. Decoder s [ExBudget])
-> Serialise ExBudget
forall s. Decoder s [ExBudget]
forall s. Decoder s ExBudget
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
$cencode :: ExBudget -> Encoding
encode :: ExBudget -> Encoding
$cdecode :: forall s. Decoder s ExBudget
decode :: forall s. Decoder s ExBudget
$cencodeList :: [ExBudget] -> Encoding
encodeList :: [ExBudget] -> Encoding
$cdecodeList :: forall s. Decoder s [ExBudget]
decodeList :: forall s. Decoder s [ExBudget]
Serialise)
deriving (Maybe ExBudget
Value -> Parser [ExBudget]
Value -> Parser ExBudget
(Value -> Parser ExBudget)
-> (Value -> Parser [ExBudget])
-> Maybe ExBudget
-> FromJSON ExBudget
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser ExBudget
parseJSON :: Value -> Parser ExBudget
$cparseJSONList :: Value -> Parser [ExBudget]
parseJSONList :: Value -> Parser [ExBudget]
$comittedField :: Maybe ExBudget
omittedField :: Maybe ExBudget
FromJSON, [ExBudget] -> Value
[ExBudget] -> Encoding
ExBudget -> Bool
ExBudget -> Value
ExBudget -> Encoding
(ExBudget -> Value)
-> (ExBudget -> Encoding)
-> ([ExBudget] -> Value)
-> ([ExBudget] -> Encoding)
-> (ExBudget -> Bool)
-> ToJSON ExBudget
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: ExBudget -> Value
toJSON :: ExBudget -> Value
$ctoEncoding :: ExBudget -> Encoding
toEncoding :: ExBudget -> Encoding
$ctoJSONList :: [ExBudget] -> Value
toJSONList :: [ExBudget] -> Value
$ctoEncodingList :: [ExBudget] -> Encoding
toEncodingList :: [ExBudget] -> Encoding
$comitField :: ExBudget -> Bool
omitField :: ExBudget -> Bool
ToJSON) via CustomJSON '[FieldLabelModifier LowerInitialCharacter] ExBudget
minusExBudget :: ExBudget -> ExBudget -> ExBudget
minusExBudget :: ExBudget -> ExBudget -> ExBudget
minusExBudget (ExBudget ExCPU
c1 ExMemory
m1) (ExBudget ExCPU
c2 ExMemory
m2) = ExCPU -> ExMemory -> ExBudget
ExBudget (ExCPU
c1ExCPU -> ExCPU -> ExCPU
forall a. Num a => a -> a -> a
-ExCPU
c2) (ExMemory
m1ExMemory -> ExMemory -> ExMemory
forall a. Num a => a -> a -> a
-ExMemory
m2)
{-# INLINE minusExBudget #-}
instance Semigroup ExBudget where
{-# INLINE (<>) #-}
(ExBudget ExCPU
cpu1 ExMemory
mem1) <> :: ExBudget -> ExBudget -> ExBudget
<> (ExBudget ExCPU
cpu2 ExMemory
mem2) = ExCPU -> ExMemory -> ExBudget
ExBudget (ExCPU
cpu1 ExCPU -> ExCPU -> ExCPU
forall a. Semigroup a => a -> a -> a
<> ExCPU
cpu2) (ExMemory
mem1 ExMemory -> ExMemory -> ExMemory
forall a. Semigroup a => a -> a -> a
<> ExMemory
mem2)
{-# INLINE stimes #-}
stimes :: forall b. Integral b => b -> ExBudget -> ExBudget
stimes b
r (ExBudget (ExCPU CostingInteger
cpu) (ExMemory CostingInteger
mem)) = ExCPU -> ExMemory -> ExBudget
ExBudget (CostingInteger -> ExCPU
ExCPU (b -> CostingInteger
forall a b. (Integral a, Num b) => a -> b
fromIntegral b
r CostingInteger -> CostingInteger -> CostingInteger
forall a. Num a => a -> a -> a
* CostingInteger
cpu)) (CostingInteger -> ExMemory
ExMemory (b -> CostingInteger
forall a b. (Integral a, Num b) => a -> b
fromIntegral b
r CostingInteger -> CostingInteger -> CostingInteger
forall a. Num a => a -> a -> a
* CostingInteger
mem))
instance Monoid ExBudget where
mempty :: ExBudget
mempty = ExCPU -> ExMemory -> ExBudget
ExBudget ExCPU
forall a. Monoid a => a
mempty ExMemory
forall a. Monoid a => a
mempty
{-# INLINE mempty #-}
instance Pretty ExBudget where
pretty :: forall ann. ExBudget -> Doc ann
pretty (ExBudget ExCPU
cpu ExMemory
memory) = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
braces (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep
[ Doc ann
"cpu:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ExCPU -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ExCPU -> Doc ann
pretty ExCPU
cpu
, Doc ann
"| mem:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ExMemory -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ExMemory -> Doc ann
pretty ExMemory
memory
]
newtype ExRestrictingBudget = ExRestrictingBudget
{ ExRestrictingBudget -> ExBudget
unExRestrictingBudget :: ExBudget
} deriving stock (Int -> ExRestrictingBudget -> String -> String
[ExRestrictingBudget] -> String -> String
ExRestrictingBudget -> String
(Int -> ExRestrictingBudget -> String -> String)
-> (ExRestrictingBudget -> String)
-> ([ExRestrictingBudget] -> String -> String)
-> Show ExRestrictingBudget
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> ExRestrictingBudget -> String -> String
showsPrec :: Int -> ExRestrictingBudget -> String -> String
$cshow :: ExRestrictingBudget -> String
show :: ExRestrictingBudget -> String
$cshowList :: [ExRestrictingBudget] -> String -> String
showList :: [ExRestrictingBudget] -> String -> String
Show, ExRestrictingBudget -> ExRestrictingBudget -> Bool
(ExRestrictingBudget -> ExRestrictingBudget -> Bool)
-> (ExRestrictingBudget -> ExRestrictingBudget -> Bool)
-> Eq ExRestrictingBudget
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExRestrictingBudget -> ExRestrictingBudget -> Bool
== :: ExRestrictingBudget -> ExRestrictingBudget -> Bool
$c/= :: ExRestrictingBudget -> ExRestrictingBudget -> Bool
/= :: ExRestrictingBudget -> ExRestrictingBudget -> Bool
Eq)
deriving newtype (NonEmpty ExRestrictingBudget -> ExRestrictingBudget
ExRestrictingBudget -> ExRestrictingBudget -> ExRestrictingBudget
(ExRestrictingBudget -> ExRestrictingBudget -> ExRestrictingBudget)
-> (NonEmpty ExRestrictingBudget -> ExRestrictingBudget)
-> (forall b.
Integral b =>
b -> ExRestrictingBudget -> ExRestrictingBudget)
-> Semigroup ExRestrictingBudget
forall b.
Integral b =>
b -> ExRestrictingBudget -> ExRestrictingBudget
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: ExRestrictingBudget -> ExRestrictingBudget -> ExRestrictingBudget
<> :: ExRestrictingBudget -> ExRestrictingBudget -> ExRestrictingBudget
$csconcat :: NonEmpty ExRestrictingBudget -> ExRestrictingBudget
sconcat :: NonEmpty ExRestrictingBudget -> ExRestrictingBudget
$cstimes :: forall b.
Integral b =>
b -> ExRestrictingBudget -> ExRestrictingBudget
stimes :: forall b.
Integral b =>
b -> ExRestrictingBudget -> ExRestrictingBudget
Semigroup, Semigroup ExRestrictingBudget
ExRestrictingBudget
Semigroup ExRestrictingBudget =>
ExRestrictingBudget
-> (ExRestrictingBudget
-> ExRestrictingBudget -> ExRestrictingBudget)
-> ([ExRestrictingBudget] -> ExRestrictingBudget)
-> Monoid ExRestrictingBudget
[ExRestrictingBudget] -> ExRestrictingBudget
ExRestrictingBudget -> ExRestrictingBudget -> ExRestrictingBudget
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: ExRestrictingBudget
mempty :: ExRestrictingBudget
$cmappend :: ExRestrictingBudget -> ExRestrictingBudget -> ExRestrictingBudget
mappend :: ExRestrictingBudget -> ExRestrictingBudget -> ExRestrictingBudget
$cmconcat :: [ExRestrictingBudget] -> ExRestrictingBudget
mconcat :: [ExRestrictingBudget] -> ExRestrictingBudget
Monoid)
deriving newtype ((forall ann. ExRestrictingBudget -> Doc ann)
-> (forall ann. [ExRestrictingBudget] -> Doc ann)
-> Pretty ExRestrictingBudget
forall ann. [ExRestrictingBudget] -> Doc ann
forall ann. ExRestrictingBudget -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
$cpretty :: forall ann. ExRestrictingBudget -> Doc ann
pretty :: forall ann. ExRestrictingBudget -> Doc ann
$cprettyList :: forall ann. [ExRestrictingBudget] -> Doc ann
prettyList :: forall ann. [ExRestrictingBudget] -> Doc ann
Pretty, PrettyBy config, ExRestrictingBudget -> ()
(ExRestrictingBudget -> ()) -> NFData ExRestrictingBudget
forall a. (a -> ()) -> NFData a
$crnf :: ExRestrictingBudget -> ()
rnf :: ExRestrictingBudget -> ()
NFData)
enormousBudget :: ExRestrictingBudget
enormousBudget :: ExRestrictingBudget
enormousBudget = ExBudget -> ExRestrictingBudget
ExRestrictingBudget (ExBudget -> ExRestrictingBudget)
-> ExBudget -> ExRestrictingBudget
forall a b. (a -> b) -> a -> b
$ ExCPU -> ExMemory -> ExBudget
ExBudget ExCPU
forall a. Bounded a => a
maxBound ExMemory
forall a. Bounded a => a
maxBound