{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeApplications #-}
module PlutusCore.Evaluation.Machine.ExMemory
( CostingInteger
, ExMemory(..)
, ExCPU(..)
) where
import Codec.Serialise (Serialise)
import Control.DeepSeq
import Data.Aeson
import Data.SatInt
import Data.Semigroup
import GHC.Generics
import Language.Haskell.TH.Syntax (Lift)
import NoThunks.Class
import Text.Pretty
import Text.PrettyBy
type CostingInteger = SatInt
newtype ExMemory = ExMemory CostingInteger
deriving stock (ExMemory -> ExMemory -> Bool
(ExMemory -> ExMemory -> Bool)
-> (ExMemory -> ExMemory -> Bool) -> Eq ExMemory
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExMemory -> ExMemory -> Bool
== :: ExMemory -> ExMemory -> Bool
$c/= :: ExMemory -> ExMemory -> Bool
/= :: ExMemory -> ExMemory -> Bool
Eq, Eq ExMemory
Eq ExMemory =>
(ExMemory -> ExMemory -> Ordering)
-> (ExMemory -> ExMemory -> Bool)
-> (ExMemory -> ExMemory -> Bool)
-> (ExMemory -> ExMemory -> Bool)
-> (ExMemory -> ExMemory -> Bool)
-> (ExMemory -> ExMemory -> ExMemory)
-> (ExMemory -> ExMemory -> ExMemory)
-> Ord ExMemory
ExMemory -> ExMemory -> Bool
ExMemory -> ExMemory -> Ordering
ExMemory -> ExMemory -> ExMemory
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ExMemory -> ExMemory -> Ordering
compare :: ExMemory -> ExMemory -> Ordering
$c< :: ExMemory -> ExMemory -> Bool
< :: ExMemory -> ExMemory -> Bool
$c<= :: ExMemory -> ExMemory -> Bool
<= :: ExMemory -> ExMemory -> Bool
$c> :: ExMemory -> ExMemory -> Bool
> :: ExMemory -> ExMemory -> Bool
$c>= :: ExMemory -> ExMemory -> Bool
>= :: ExMemory -> ExMemory -> Bool
$cmax :: ExMemory -> ExMemory -> ExMemory
max :: ExMemory -> ExMemory -> ExMemory
$cmin :: ExMemory -> ExMemory -> ExMemory
min :: ExMemory -> ExMemory -> ExMemory
Ord, Int -> ExMemory -> ShowS
[ExMemory] -> ShowS
ExMemory -> String
(Int -> ExMemory -> ShowS)
-> (ExMemory -> String) -> ([ExMemory] -> ShowS) -> Show ExMemory
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExMemory -> ShowS
showsPrec :: Int -> ExMemory -> ShowS
$cshow :: ExMemory -> String
show :: ExMemory -> String
$cshowList :: [ExMemory] -> ShowS
showList :: [ExMemory] -> ShowS
Show, (forall x. ExMemory -> Rep ExMemory x)
-> (forall x. Rep ExMemory x -> ExMemory) -> Generic ExMemory
forall x. Rep ExMemory x -> ExMemory
forall x. ExMemory -> Rep ExMemory x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ExMemory -> Rep ExMemory x
from :: forall x. ExMemory -> Rep ExMemory x
$cto :: forall x. Rep ExMemory x -> ExMemory
to :: forall x. Rep ExMemory x -> ExMemory
Generic, (forall (m :: * -> *). Quote m => ExMemory -> m Exp)
-> (forall (m :: * -> *). Quote m => ExMemory -> Code m ExMemory)
-> Lift ExMemory
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => ExMemory -> m Exp
forall (m :: * -> *). Quote m => ExMemory -> Code m ExMemory
$clift :: forall (m :: * -> *). Quote m => ExMemory -> m Exp
lift :: forall (m :: * -> *). Quote m => ExMemory -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => ExMemory -> Code m ExMemory
liftTyped :: forall (m :: * -> *). Quote m => ExMemory -> Code m ExMemory
Lift)
deriving newtype (Integer -> ExMemory
ExMemory -> ExMemory
ExMemory -> ExMemory -> ExMemory
(ExMemory -> ExMemory -> ExMemory)
-> (ExMemory -> ExMemory -> ExMemory)
-> (ExMemory -> ExMemory -> ExMemory)
-> (ExMemory -> ExMemory)
-> (ExMemory -> ExMemory)
-> (ExMemory -> ExMemory)
-> (Integer -> ExMemory)
-> Num ExMemory
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: ExMemory -> ExMemory -> ExMemory
+ :: ExMemory -> ExMemory -> ExMemory
$c- :: ExMemory -> ExMemory -> ExMemory
- :: ExMemory -> ExMemory -> ExMemory
$c* :: ExMemory -> ExMemory -> ExMemory
* :: ExMemory -> ExMemory -> ExMemory
$cnegate :: ExMemory -> ExMemory
negate :: ExMemory -> ExMemory
$cabs :: ExMemory -> ExMemory
abs :: ExMemory -> ExMemory
$csignum :: ExMemory -> ExMemory
signum :: ExMemory -> ExMemory
$cfromInteger :: Integer -> ExMemory
fromInteger :: Integer -> ExMemory
Num, ExMemory -> ()
(ExMemory -> ()) -> NFData ExMemory
forall a. (a -> ()) -> NFData a
$crnf :: ExMemory -> ()
rnf :: ExMemory -> ()
NFData, ReadPrec [ExMemory]
ReadPrec ExMemory
Int -> ReadS ExMemory
ReadS [ExMemory]
(Int -> ReadS ExMemory)
-> ReadS [ExMemory]
-> ReadPrec ExMemory
-> ReadPrec [ExMemory]
-> Read ExMemory
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ExMemory
readsPrec :: Int -> ReadS ExMemory
$creadList :: ReadS [ExMemory]
readList :: ReadS [ExMemory]
$creadPrec :: ReadPrec ExMemory
readPrec :: ReadPrec ExMemory
$creadListPrec :: ReadPrec [ExMemory]
readListPrec :: ReadPrec [ExMemory]
Read, ExMemory
ExMemory -> ExMemory -> Bounded ExMemory
forall a. a -> a -> Bounded a
$cminBound :: ExMemory
minBound :: ExMemory
$cmaxBound :: ExMemory
maxBound :: ExMemory
Bounded)
deriving (Maybe ExMemory
Value -> Parser [ExMemory]
Value -> Parser ExMemory
(Value -> Parser ExMemory)
-> (Value -> Parser [ExMemory])
-> Maybe ExMemory
-> FromJSON ExMemory
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser ExMemory
parseJSON :: Value -> Parser ExMemory
$cparseJSONList :: Value -> Parser [ExMemory]
parseJSONList :: Value -> Parser [ExMemory]
$comittedField :: Maybe ExMemory
omittedField :: Maybe ExMemory
FromJSON, [ExMemory] -> Value
[ExMemory] -> Encoding
ExMemory -> Bool
ExMemory -> Value
ExMemory -> Encoding
(ExMemory -> Value)
-> (ExMemory -> Encoding)
-> ([ExMemory] -> Value)
-> ([ExMemory] -> Encoding)
-> (ExMemory -> Bool)
-> ToJSON ExMemory
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: ExMemory -> Value
toJSON :: ExMemory -> Value
$ctoEncoding :: ExMemory -> Encoding
toEncoding :: ExMemory -> Encoding
$ctoJSONList :: [ExMemory] -> Value
toJSONList :: [ExMemory] -> Value
$ctoEncodingList :: [ExMemory] -> Encoding
toEncodingList :: [ExMemory] -> Encoding
$comitField :: ExMemory -> Bool
omitField :: ExMemory -> Bool
ToJSON) via CostingInteger
deriving [ExMemory] -> Encoding
ExMemory -> Encoding
(ExMemory -> Encoding)
-> (forall s. Decoder s ExMemory)
-> ([ExMemory] -> Encoding)
-> (forall s. Decoder s [ExMemory])
-> Serialise ExMemory
forall s. Decoder s [ExMemory]
forall s. Decoder s ExMemory
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
$cencode :: ExMemory -> Encoding
encode :: ExMemory -> Encoding
$cdecode :: forall s. Decoder s ExMemory
decode :: forall s. Decoder s ExMemory
$cencodeList :: [ExMemory] -> Encoding
encodeList :: [ExMemory] -> Encoding
$cdecodeList :: forall s. Decoder s [ExMemory]
decodeList :: forall s. Decoder s [ExMemory]
Serialise via CostingInteger
deriving anyclass Context -> ExMemory -> IO (Maybe ThunkInfo)
Proxy ExMemory -> String
(Context -> ExMemory -> IO (Maybe ThunkInfo))
-> (Context -> ExMemory -> IO (Maybe ThunkInfo))
-> (Proxy ExMemory -> String)
-> NoThunks ExMemory
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> ExMemory -> IO (Maybe ThunkInfo)
noThunks :: Context -> ExMemory -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> ExMemory -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> ExMemory -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy ExMemory -> String
showTypeOf :: Proxy ExMemory -> String
NoThunks
instance Pretty ExMemory where
pretty :: forall ann. ExMemory -> Doc ann
pretty (ExMemory CostingInteger
i) = Int -> Doc ann
forall ann. Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (CostingInteger -> Int
unSatInt CostingInteger
i)
instance PrettyBy config ExMemory where
prettyBy :: forall ann. config -> ExMemory -> Doc ann
prettyBy config
_ ExMemory
m = ExMemory -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ExMemory -> Doc ann
pretty ExMemory
m
instance Semigroup ExMemory where
<> :: ExMemory -> ExMemory -> ExMemory
(<>) = ExMemory -> ExMemory -> ExMemory
forall a. Num a => a -> a -> a
(+)
{-# INLINE (<>) #-}
stimes :: forall b. Integral b => b -> ExMemory -> ExMemory
stimes b
n ExMemory
mem = b -> ExMemory
forall a b. (Integral a, Num b) => a -> b
fromIntegral b
n ExMemory -> ExMemory -> ExMemory
forall a. Num a => a -> a -> a
* ExMemory
mem
{-# INLINE stimes #-}
instance Monoid ExMemory where
mempty :: ExMemory
mempty = CostingInteger -> ExMemory
ExMemory CostingInteger
0
{-# INLINE mempty #-}
newtype ExCPU = ExCPU CostingInteger
deriving stock (ExCPU -> ExCPU -> Bool
(ExCPU -> ExCPU -> Bool) -> (ExCPU -> ExCPU -> Bool) -> Eq ExCPU
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExCPU -> ExCPU -> Bool
== :: ExCPU -> ExCPU -> Bool
$c/= :: ExCPU -> ExCPU -> Bool
/= :: ExCPU -> ExCPU -> Bool
Eq, Eq ExCPU
Eq ExCPU =>
(ExCPU -> ExCPU -> Ordering)
-> (ExCPU -> ExCPU -> Bool)
-> (ExCPU -> ExCPU -> Bool)
-> (ExCPU -> ExCPU -> Bool)
-> (ExCPU -> ExCPU -> Bool)
-> (ExCPU -> ExCPU -> ExCPU)
-> (ExCPU -> ExCPU -> ExCPU)
-> Ord ExCPU
ExCPU -> ExCPU -> Bool
ExCPU -> ExCPU -> Ordering
ExCPU -> ExCPU -> ExCPU
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ExCPU -> ExCPU -> Ordering
compare :: ExCPU -> ExCPU -> Ordering
$c< :: ExCPU -> ExCPU -> Bool
< :: ExCPU -> ExCPU -> Bool
$c<= :: ExCPU -> ExCPU -> Bool
<= :: ExCPU -> ExCPU -> Bool
$c> :: ExCPU -> ExCPU -> Bool
> :: ExCPU -> ExCPU -> Bool
$c>= :: ExCPU -> ExCPU -> Bool
>= :: ExCPU -> ExCPU -> Bool
$cmax :: ExCPU -> ExCPU -> ExCPU
max :: ExCPU -> ExCPU -> ExCPU
$cmin :: ExCPU -> ExCPU -> ExCPU
min :: ExCPU -> ExCPU -> ExCPU
Ord, Int -> ExCPU -> ShowS
[ExCPU] -> ShowS
ExCPU -> String
(Int -> ExCPU -> ShowS)
-> (ExCPU -> String) -> ([ExCPU] -> ShowS) -> Show ExCPU
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExCPU -> ShowS
showsPrec :: Int -> ExCPU -> ShowS
$cshow :: ExCPU -> String
show :: ExCPU -> String
$cshowList :: [ExCPU] -> ShowS
showList :: [ExCPU] -> ShowS
Show, (forall x. ExCPU -> Rep ExCPU x)
-> (forall x. Rep ExCPU x -> ExCPU) -> Generic ExCPU
forall x. Rep ExCPU x -> ExCPU
forall x. ExCPU -> Rep ExCPU x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ExCPU -> Rep ExCPU x
from :: forall x. ExCPU -> Rep ExCPU x
$cto :: forall x. Rep ExCPU x -> ExCPU
to :: forall x. Rep ExCPU x -> ExCPU
Generic, (forall (m :: * -> *). Quote m => ExCPU -> m Exp)
-> (forall (m :: * -> *). Quote m => ExCPU -> Code m ExCPU)
-> Lift ExCPU
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => ExCPU -> m Exp
forall (m :: * -> *). Quote m => ExCPU -> Code m ExCPU
$clift :: forall (m :: * -> *). Quote m => ExCPU -> m Exp
lift :: forall (m :: * -> *). Quote m => ExCPU -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => ExCPU -> Code m ExCPU
liftTyped :: forall (m :: * -> *). Quote m => ExCPU -> Code m ExCPU
Lift)
deriving newtype (Integer -> ExCPU
ExCPU -> ExCPU
ExCPU -> ExCPU -> ExCPU
(ExCPU -> ExCPU -> ExCPU)
-> (ExCPU -> ExCPU -> ExCPU)
-> (ExCPU -> ExCPU -> ExCPU)
-> (ExCPU -> ExCPU)
-> (ExCPU -> ExCPU)
-> (ExCPU -> ExCPU)
-> (Integer -> ExCPU)
-> Num ExCPU
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: ExCPU -> ExCPU -> ExCPU
+ :: ExCPU -> ExCPU -> ExCPU
$c- :: ExCPU -> ExCPU -> ExCPU
- :: ExCPU -> ExCPU -> ExCPU
$c* :: ExCPU -> ExCPU -> ExCPU
* :: ExCPU -> ExCPU -> ExCPU
$cnegate :: ExCPU -> ExCPU
negate :: ExCPU -> ExCPU
$cabs :: ExCPU -> ExCPU
abs :: ExCPU -> ExCPU
$csignum :: ExCPU -> ExCPU
signum :: ExCPU -> ExCPU
$cfromInteger :: Integer -> ExCPU
fromInteger :: Integer -> ExCPU
Num, ExCPU -> ()
(ExCPU -> ()) -> NFData ExCPU
forall a. (a -> ()) -> NFData a
$crnf :: ExCPU -> ()
rnf :: ExCPU -> ()
NFData, ReadPrec [ExCPU]
ReadPrec ExCPU
Int -> ReadS ExCPU
ReadS [ExCPU]
(Int -> ReadS ExCPU)
-> ReadS [ExCPU]
-> ReadPrec ExCPU
-> ReadPrec [ExCPU]
-> Read ExCPU
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ExCPU
readsPrec :: Int -> ReadS ExCPU
$creadList :: ReadS [ExCPU]
readList :: ReadS [ExCPU]
$creadPrec :: ReadPrec ExCPU
readPrec :: ReadPrec ExCPU
$creadListPrec :: ReadPrec [ExCPU]
readListPrec :: ReadPrec [ExCPU]
Read, ExCPU
ExCPU -> ExCPU -> Bounded ExCPU
forall a. a -> a -> Bounded a
$cminBound :: ExCPU
minBound :: ExCPU
$cmaxBound :: ExCPU
maxBound :: ExCPU
Bounded)
deriving (Maybe ExCPU
Value -> Parser [ExCPU]
Value -> Parser ExCPU
(Value -> Parser ExCPU)
-> (Value -> Parser [ExCPU]) -> Maybe ExCPU -> FromJSON ExCPU
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser ExCPU
parseJSON :: Value -> Parser ExCPU
$cparseJSONList :: Value -> Parser [ExCPU]
parseJSONList :: Value -> Parser [ExCPU]
$comittedField :: Maybe ExCPU
omittedField :: Maybe ExCPU
FromJSON, [ExCPU] -> Value
[ExCPU] -> Encoding
ExCPU -> Bool
ExCPU -> Value
ExCPU -> Encoding
(ExCPU -> Value)
-> (ExCPU -> Encoding)
-> ([ExCPU] -> Value)
-> ([ExCPU] -> Encoding)
-> (ExCPU -> Bool)
-> ToJSON ExCPU
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: ExCPU -> Value
toJSON :: ExCPU -> Value
$ctoEncoding :: ExCPU -> Encoding
toEncoding :: ExCPU -> Encoding
$ctoJSONList :: [ExCPU] -> Value
toJSONList :: [ExCPU] -> Value
$ctoEncodingList :: [ExCPU] -> Encoding
toEncodingList :: [ExCPU] -> Encoding
$comitField :: ExCPU -> Bool
omitField :: ExCPU -> Bool
ToJSON) via CostingInteger
deriving [ExCPU] -> Encoding
ExCPU -> Encoding
(ExCPU -> Encoding)
-> (forall s. Decoder s ExCPU)
-> ([ExCPU] -> Encoding)
-> (forall s. Decoder s [ExCPU])
-> Serialise ExCPU
forall s. Decoder s [ExCPU]
forall s. Decoder s ExCPU
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
$cencode :: ExCPU -> Encoding
encode :: ExCPU -> Encoding
$cdecode :: forall s. Decoder s ExCPU
decode :: forall s. Decoder s ExCPU
$cencodeList :: [ExCPU] -> Encoding
encodeList :: [ExCPU] -> Encoding
$cdecodeList :: forall s. Decoder s [ExCPU]
decodeList :: forall s. Decoder s [ExCPU]
Serialise via CostingInteger
deriving anyclass Context -> ExCPU -> IO (Maybe ThunkInfo)
Proxy ExCPU -> String
(Context -> ExCPU -> IO (Maybe ThunkInfo))
-> (Context -> ExCPU -> IO (Maybe ThunkInfo))
-> (Proxy ExCPU -> String)
-> NoThunks ExCPU
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> ExCPU -> IO (Maybe ThunkInfo)
noThunks :: Context -> ExCPU -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> ExCPU -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> ExCPU -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy ExCPU -> String
showTypeOf :: Proxy ExCPU -> String
NoThunks
instance Pretty ExCPU where
pretty :: forall ann. ExCPU -> Doc ann
pretty (ExCPU CostingInteger
i) = Int -> Doc ann
forall ann. Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (CostingInteger -> Int
unSatInt CostingInteger
i)
instance PrettyBy config ExCPU where
prettyBy :: forall ann. config -> ExCPU -> Doc ann
prettyBy config
_ ExCPU
m = ExCPU -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ExCPU -> Doc ann
pretty ExCPU
m
instance Semigroup ExCPU where
<> :: ExCPU -> ExCPU -> ExCPU
(<>) = ExCPU -> ExCPU -> ExCPU
forall a. Num a => a -> a -> a
(+)
{-# INLINE (<>) #-}
stimes :: forall b. Integral b => b -> ExCPU -> ExCPU
stimes b
n ExCPU
mem = b -> ExCPU
forall a b. (Integral a, Num b) => a -> b
fromIntegral b
n ExCPU -> ExCPU -> ExCPU
forall a. Num a => a -> a -> a
* ExCPU
mem
{-# INLINE stimes #-}
instance Monoid ExCPU where
mempty :: ExCPU
mempty = CostingInteger -> ExCPU
ExCPU CostingInteger
0
{-# INLINE mempty #-}