{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
module PlutusCore.Evaluation.Machine.ExMemoryUsage
( CostRose(..)
, singletonRose
, ExMemoryUsage(..)
, flattenCostRose
, NumBytesCostedAsNumWords(..)
, IntegerCostedLiterally(..)
, ValueTotalSize(..)
, ValueOuterOrMaxInner(..)
) where
import PlutusCore.Crypto.BLS12_381.G1 as BLS12_381.G1
import PlutusCore.Crypto.BLS12_381.G2 as BLS12_381.G2
import PlutusCore.Crypto.BLS12_381.Pairing as BLS12_381.Pairing
import PlutusCore.Data
import PlutusCore.Evaluation.Machine.CostStream
import PlutusCore.Evaluation.Machine.ExMemory
import PlutusCore.Value (Value)
import PlutusCore.Value qualified as Value
import Data.ByteString qualified as BS
import Data.Functor
import Data.Map.Strict qualified as Map
import Data.Proxy
import Data.SatInt
import Data.Text qualified as T
import Data.Vector.Strict (Vector)
import Data.Vector.Strict qualified as Vector
import Data.Word
import GHC.Exts (Int (I#))
import GHC.Integer
import GHC.Integer.Logarithms
import GHC.Natural
import GHC.Prim
import Universe
data CostRose = CostRose {-# UNPACK #-} !CostingInteger ![CostRose]
deriving stock (Int -> CostRose -> ShowS
[CostRose] -> ShowS
CostRose -> String
(Int -> CostRose -> ShowS)
-> (CostRose -> String) -> ([CostRose] -> ShowS) -> Show CostRose
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CostRose -> ShowS
showsPrec :: Int -> CostRose -> ShowS
$cshow :: CostRose -> String
show :: CostRose -> String
$cshowList :: [CostRose] -> ShowS
showList :: [CostRose] -> ShowS
Show)
singletonRose :: CostingInteger -> CostRose
singletonRose :: CostingInteger -> CostRose
singletonRose CostingInteger
cost = CostingInteger -> [CostRose] -> CostRose
CostRose CostingInteger
cost []
{-# INLINE singletonRose #-}
flattenCostRoseGo :: CostRose -> [CostRose] -> CostStream
flattenCostRoseGo :: CostRose -> [CostRose] -> CostStream
flattenCostRoseGo (CostRose CostingInteger
cost1 [CostRose]
forest1) [CostRose]
forest2 =
case [CostRose]
forest1 of
[] -> case [CostRose]
forest2 of
[] -> CostingInteger -> CostStream
CostLast CostingInteger
cost1
CostRose
rose2' : [CostRose]
forest2' -> CostingInteger -> CostStream -> CostStream
CostCons CostingInteger
cost1 (CostStream -> CostStream) -> CostStream -> CostStream
forall a b. (a -> b) -> a -> b
$ CostRose -> [CostRose] -> CostStream
flattenCostRoseGo CostRose
rose2' [CostRose]
forest2'
CostRose
rose1' : [CostRose]
forest1' ->
CostingInteger -> CostStream -> CostStream
CostCons CostingInteger
cost1 (CostStream -> CostStream) -> CostStream -> CostStream
forall a b. (a -> b) -> a -> b
$ case [CostRose]
forest1' of
[] -> CostRose -> [CostRose] -> CostStream
flattenCostRoseGo CostRose
rose1' [CostRose]
forest2
[CostRose]
_ -> CostRose -> [CostRose] -> CostStream
flattenCostRoseGo CostRose
rose1' ([CostRose] -> CostStream) -> [CostRose] -> CostStream
forall a b. (a -> b) -> a -> b
$ [CostRose]
forest1' [CostRose] -> [CostRose] -> [CostRose]
forall a. [a] -> [a] -> [a]
++ [CostRose]
forest2
flattenCostRose :: CostRose -> CostStream
flattenCostRose :: CostRose -> CostStream
flattenCostRose (CostRose CostingInteger
cost []) = CostingInteger -> CostStream
CostLast CostingInteger
cost
flattenCostRose (CostRose CostingInteger
cost (CostRose
rose : [CostRose]
forest)) = CostingInteger -> CostStream -> CostStream
CostCons CostingInteger
cost (CostStream -> CostStream) -> CostStream -> CostStream
forall a b. (a -> b) -> a -> b
$ CostRose -> [CostRose] -> CostStream
flattenCostRoseGo CostRose
rose [CostRose]
forest
{-# INLINE flattenCostRose #-}
class ExMemoryUsage a where
memoryUsage :: a -> CostRose
instance ExMemoryUsage (a, b) where
memoryUsage :: (a, b) -> CostRose
memoryUsage (a, b)
_ = CostingInteger -> CostRose
singletonRose CostingInteger
forall a. Bounded a => a
maxBound
{-# INLINE memoryUsage #-}
instance ExMemoryUsage [a] where
memoryUsage :: [a] -> CostRose
memoryUsage [a]
l = CostingInteger -> CostRose
singletonRose (CostingInteger -> CostRose)
-> (Int -> CostingInteger) -> Int -> CostRose
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CostingInteger
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CostRose) -> Int -> CostRose
forall a b. (a -> b) -> a -> b
$ [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
l
{-# INLINE memoryUsage #-}
instance ExMemoryUsage (Vector a) where
memoryUsage :: Vector a -> CostRose
memoryUsage Vector a
l = CostingInteger -> CostRose
singletonRose (CostingInteger -> CostRose)
-> (Int -> CostingInteger) -> Int -> CostRose
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CostingInteger
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CostRose) -> Int -> CostRose
forall a b. (a -> b) -> a -> b
$ Vector a -> Int
forall a. Vector a -> Int
Vector.length Vector a
l
{-# INLINE memoryUsage #-}
instance (Closed uni, uni `Everywhere` ExMemoryUsage) => ExMemoryUsage (Some (ValueOf uni)) where
memoryUsage :: Some (ValueOf uni) -> CostRose
memoryUsage (Some (ValueOf uni (Esc a)
uni a
x)) = Proxy ExMemoryUsage
-> uni (Esc a) -> (ExMemoryUsage a => CostRose) -> CostRose
forall (uni :: * -> *) (constr :: * -> Constraint)
(proxy :: (* -> Constraint) -> *) a r.
(Closed uni, Everywhere uni constr) =>
proxy constr -> uni (Esc a) -> (constr a => r) -> r
forall (constr :: * -> Constraint)
(proxy :: (* -> Constraint) -> *) a r.
Everywhere uni constr =>
proxy constr -> uni (Esc a) -> (constr a => r) -> r
bring (forall {k} (t :: k). Proxy t
forall (t :: * -> Constraint). Proxy t
Proxy @ExMemoryUsage) uni (Esc a)
uni (a -> CostRose
forall a. ExMemoryUsage a => a -> CostRose
memoryUsage a
x)
{-# INLINE memoryUsage #-}
instance ExMemoryUsage () where
memoryUsage :: () -> CostRose
memoryUsage () = CostingInteger -> CostRose
singletonRose CostingInteger
1
{-# INLINE memoryUsage #-}
memoryUsageInteger :: Integer -> CostingInteger
memoryUsageInteger :: Integer -> CostingInteger
memoryUsageInteger Integer
0 = CostingInteger
1
memoryUsageInteger Integer
i = Int -> CostingInteger
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CostingInteger) -> Int -> CostingInteger
forall a b. (a -> b) -> a -> b
$ Int# -> Int
I# (Integer -> Int#
integerLog2# (Integer -> Integer
forall a. Num a => a -> a
abs Integer
i) Int# -> Int# -> Int#
`quotInt#` Integer -> Int#
integerToInt Integer
64) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
{-# OPAQUE memoryUsageInteger #-}
instance ExMemoryUsage Integer where
memoryUsage :: Integer -> CostRose
memoryUsage Integer
i = CostingInteger -> CostRose
singletonRose (CostingInteger -> CostRose) -> CostingInteger -> CostRose
forall a b. (a -> b) -> a -> b
$ Integer -> CostingInteger
memoryUsageInteger Integer
i
{-# INLINE memoryUsage #-}
instance ExMemoryUsage Natural where
memoryUsage :: Natural -> CostRose
memoryUsage Natural
n = Integer -> CostRose
forall a. ExMemoryUsage a => a -> CostRose
memoryUsage (Integer -> CostRose) -> Integer -> CostRose
forall a b. (a -> b) -> a -> b
$ Natural -> Integer
forall a. Integral a => a -> Integer
toInteger Natural
n
{-# INLINE memoryUsage #-}
instance ExMemoryUsage Word8 where
memoryUsage :: Word8 -> CostRose
memoryUsage Word8
_ = CostingInteger -> CostRose
singletonRose CostingInteger
1
{-# INLINE memoryUsage #-}
newtype NumBytesCostedAsNumWords = NumBytesCostedAsNumWords { NumBytesCostedAsNumWords -> Integer
unNumBytesCostedAsNumWords :: Integer }
instance ExMemoryUsage NumBytesCostedAsNumWords where
memoryUsage :: NumBytesCostedAsNumWords -> CostRose
memoryUsage (NumBytesCostedAsNumWords Integer
n) = CostingInteger -> CostRose
singletonRose (CostingInteger -> CostRose)
-> (Integer -> CostingInteger) -> Integer -> CostRose
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> CostingInteger
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> CostRose) -> Integer -> CostRose
forall a b. (a -> b) -> a -> b
$ ((Integer
nInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
1) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
8) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1
{-# INLINE memoryUsage #-}
newtype IntegerCostedLiterally = IntegerCostedLiterally { IntegerCostedLiterally -> Integer
unIntegerCostedLiterally :: Integer }
instance ExMemoryUsage IntegerCostedLiterally where
memoryUsage :: IntegerCostedLiterally -> CostRose
memoryUsage (IntegerCostedLiterally Integer
n) = CostingInteger -> CostRose
singletonRose (CostingInteger -> CostRose)
-> (Integer -> CostingInteger) -> Integer -> CostRose
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> CostingInteger
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> CostRose) -> Integer -> CostRose
forall a b. (a -> b) -> a -> b
$ Integer -> Integer
forall a. Num a => a -> a
abs Integer
n
{-# INLINE memoryUsage #-}
instance ExMemoryUsage BS.ByteString where
memoryUsage :: ByteString -> CostRose
memoryUsage ByteString
bs = CostingInteger -> CostRose
singletonRose (CostingInteger -> CostRose)
-> (Int -> CostingInteger) -> Int -> CostRose
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CostingInteger
unsafeToSatInt (Int -> CostRose) -> Int -> CostRose
forall a b. (a -> b) -> a -> b
$ ((Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
8) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 where
n :: Int
n = ByteString -> Int
BS.length ByteString
bs
{-# INLINE memoryUsage #-}
instance ExMemoryUsage T.Text where
memoryUsage :: Text -> CostRose
memoryUsage = CostingInteger -> CostRose
singletonRose (CostingInteger -> CostRose)
-> (Text -> CostingInteger) -> Text -> CostRose
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CostingInteger
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CostingInteger) -> (Text -> Int) -> Text -> CostingInteger
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int
T.length
{-# INLINE memoryUsage #-}
instance ExMemoryUsage Int where
memoryUsage :: Int -> CostRose
memoryUsage Int
_ = CostingInteger -> CostRose
singletonRose CostingInteger
1
{-# INLINE memoryUsage #-}
instance ExMemoryUsage Char where
memoryUsage :: Char -> CostRose
memoryUsage Char
_ = CostingInteger -> CostRose
singletonRose CostingInteger
1
{-# INLINE memoryUsage #-}
instance ExMemoryUsage Bool where
memoryUsage :: Bool -> CostRose
memoryUsage Bool
_ = CostingInteger -> CostRose
singletonRose CostingInteger
1
{-# INLINE memoryUsage #-}
addConstantRose :: CostRose -> CostRose -> CostRose
addConstantRose :: CostRose -> CostRose -> CostRose
addConstantRose (CostRose CostingInteger
cost1 [CostRose]
forest1) (CostRose CostingInteger
cost2 [CostRose]
forest2) =
CostingInteger -> [CostRose] -> CostRose
CostRose (CostingInteger
cost1 CostingInteger -> CostingInteger -> CostingInteger
forall a. Num a => a -> a -> a
+ CostingInteger
cost2) ([CostRose]
forest1 [CostRose] -> [CostRose] -> [CostRose]
forall a. [a] -> [a] -> [a]
++ [CostRose]
forest2)
{-# INLINE addConstantRose #-}
instance ExMemoryUsage Data where
memoryUsage :: Data -> CostRose
memoryUsage = Data -> CostRose
sizeData where
dataNodeRose :: CostRose
dataNodeRose = CostingInteger -> CostRose
singletonRose CostingInteger
4
{-# INLINE dataNodeRose #-}
sizeData :: Data -> CostRose
sizeData Data
d = CostRose -> CostRose -> CostRose
addConstantRose CostRose
dataNodeRose (CostRose -> CostRose) -> CostRose -> CostRose
forall a b. (a -> b) -> a -> b
$ case Data
d of
Constr Integer
_ [Data]
l -> CostingInteger -> [CostRose] -> CostRose
CostRose CostingInteger
0 ([CostRose] -> CostRose) -> [CostRose] -> CostRose
forall a b. (a -> b) -> a -> b
$ [Data]
l [Data] -> (Data -> CostRose) -> [CostRose]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Data -> CostRose
sizeData
Map [(Data, Data)]
l -> CostingInteger -> [CostRose] -> CostRose
CostRose CostingInteger
0 ([CostRose] -> CostRose) -> [CostRose] -> CostRose
forall a b. (a -> b) -> a -> b
$ [(Data, Data)]
l [(Data, Data)] -> ((Data, Data) -> [CostRose]) -> [CostRose]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Data
d1, Data
d2) -> [Data
d1, Data
d2] [Data] -> (Data -> CostRose) -> [CostRose]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Data -> CostRose
sizeData
List [Data]
l -> CostingInteger -> [CostRose] -> CostRose
CostRose CostingInteger
0 ([CostRose] -> CostRose) -> [CostRose] -> CostRose
forall a b. (a -> b) -> a -> b
$ [Data]
l [Data] -> (Data -> CostRose) -> [CostRose]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Data -> CostRose
sizeData
I Integer
n -> Integer -> CostRose
forall a. ExMemoryUsage a => a -> CostRose
memoryUsage Integer
n
B ByteString
b -> ByteString -> CostRose
forall a. ExMemoryUsage a => a -> CostRose
memoryUsage ByteString
b
instance ExMemoryUsage Value where
memoryUsage :: Value -> CostRose
memoryUsage = CostingInteger -> CostRose
singletonRose (CostingInteger -> CostRose)
-> (Value -> CostingInteger) -> Value -> CostRose
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CostingInteger
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CostingInteger)
-> (Value -> Int) -> Value -> CostingInteger
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Int
Value.totalSize
newtype ValueTotalSize = ValueTotalSize { ValueTotalSize -> Value
unValueTotalSize :: Value }
instance ExMemoryUsage ValueTotalSize where
memoryUsage :: ValueTotalSize -> CostRose
memoryUsage = CostingInteger -> CostRose
singletonRose (CostingInteger -> CostRose)
-> (ValueTotalSize -> CostingInteger) -> ValueTotalSize -> CostRose
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CostingInteger
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CostingInteger)
-> (ValueTotalSize -> Int) -> ValueTotalSize -> CostingInteger
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Int
Value.totalSize (Value -> Int)
-> (ValueTotalSize -> Value) -> ValueTotalSize -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueTotalSize -> Value
unValueTotalSize
newtype ValueOuterOrMaxInner = ValueOuterOrMaxInner { ValueOuterOrMaxInner -> Value
unValueOuterOrMaxInner :: Value }
instance ExMemoryUsage ValueOuterOrMaxInner where
memoryUsage :: ValueOuterOrMaxInner -> CostRose
memoryUsage (ValueOuterOrMaxInner Value
v) = CostingInteger -> CostRose
singletonRose (Int -> CostingInteger
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size)
where
size :: Int
size = Map ByteString (Map ByteString Integer) -> Int
forall k a. Map k a -> Int
Map.size (Value -> Map ByteString (Map ByteString Integer)
Value.unpack Value
v) Int -> Int -> Int
forall a. Ord a => a -> a -> a
`max` Value -> Int
Value.maxInnerSize Value
v
g1ElementCost :: CostRose
g1ElementCost :: CostRose
g1ElementCost = CostingInteger -> CostRose
singletonRose (CostingInteger -> CostRose)
-> (Int -> CostingInteger) -> Int -> CostRose
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CostingInteger
unsafeToSatInt (Int -> CostRose) -> Int -> CostRose
forall a b. (a -> b) -> a -> b
$ Int
BLS12_381.G1.memSizeBytes Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8
{-# OPAQUE g1ElementCost #-}
instance ExMemoryUsage BLS12_381.G1.Element where
memoryUsage :: Element -> CostRose
memoryUsage Element
_ = CostRose
g1ElementCost
g2ElementCost :: CostRose
g2ElementCost :: CostRose
g2ElementCost = CostingInteger -> CostRose
singletonRose (CostingInteger -> CostRose)
-> (Int -> CostingInteger) -> Int -> CostRose
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CostingInteger
unsafeToSatInt (Int -> CostRose) -> Int -> CostRose
forall a b. (a -> b) -> a -> b
$ Int
BLS12_381.G2.memSizeBytes Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8
{-# OPAQUE g2ElementCost #-}
instance ExMemoryUsage BLS12_381.G2.Element where
memoryUsage :: Element -> CostRose
memoryUsage Element
_ = CostRose
g2ElementCost
mlResultElementCost :: CostRose
mlResultElementCost :: CostRose
mlResultElementCost = CostingInteger -> CostRose
singletonRose (CostingInteger -> CostRose)
-> (Int -> CostingInteger) -> Int -> CostRose
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CostingInteger
unsafeToSatInt (Int -> CostRose) -> Int -> CostRose
forall a b. (a -> b) -> a -> b
$ Int
BLS12_381.Pairing.mlResultMemSizeBytes Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8
{-# OPAQUE mlResultElementCost #-}
instance ExMemoryUsage BLS12_381.Pairing.MlResult where
memoryUsage :: MlResult -> CostRose
memoryUsage MlResult
_ = CostRose
mlResultElementCost