{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
module PlutusCore.Evaluation.Machine.ExMemoryUsage
( CostRose(..)
, singletonRose
, ExMemoryUsage(..)
, flattenCostRose
, NumBytesCostedAsNumWords(..)
, IntegerCostedLiterally(..)
, ListCostedByLength(..)
) 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 Data.ByteString qualified as BS
import Data.Functor
import Data.Proxy
import Data.SatInt
import Data.Text qualified as T
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, ExMemoryUsage b) => ExMemoryUsage (a, b) where
memoryUsage :: (a, b) -> CostRose
memoryUsage (a
a, b
b) = CostingInteger -> [CostRose] -> CostRose
CostRose CostingInteger
1 [a -> CostRose
forall a. ExMemoryUsage a => a -> CostRose
memoryUsage a
a, b -> CostRose
forall a. ExMemoryUsage a => a -> CostRose
memoryUsage b
b]
{-# 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 #-}
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 #-}
newtype ListCostedByLength a = ListCostedByLength { forall a. ListCostedByLength a -> [a]
unListCostedByLength :: [a] }
instance ExMemoryUsage (ListCostedByLength a) where
memoryUsage :: ListCostedByLength a -> CostRose
memoryUsage (ListCostedByLength [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 #-}
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 #-}
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 a => ExMemoryUsage [a] where
memoryUsage :: [a] -> CostRose
memoryUsage = CostingInteger -> [CostRose] -> CostRose
CostRose CostingInteger
nilCost ([CostRose] -> CostRose) -> ([a] -> [CostRose]) -> [a] -> CostRose
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> CostRose) -> [a] -> [CostRose]
forall a b. (a -> b) -> [a] -> [b]
map (CostRose -> CostRose -> CostRose
addConstantRose CostRose
consRose (CostRose -> CostRose) -> (a -> CostRose) -> a -> CostRose
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> CostRose
forall a. ExMemoryUsage a => a -> CostRose
memoryUsage) where
nilCost :: CostingInteger
nilCost = CostingInteger
1
{-# INLINE nilCost #-}
consRose :: CostRose
consRose = CostingInteger -> CostRose
singletonRose CostingInteger
3
{-# INLINE consRose #-}
{-# INLINE memoryUsage #-}
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
{-# OPAQUE g1ElementCost #-}
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
instance ExMemoryUsage BLS12_381.G1.Element where
memoryUsage :: Element -> CostRose
memoryUsage Element
_ = CostRose
g1ElementCost
{-# OPAQUE g2ElementCost #-}
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
instance ExMemoryUsage BLS12_381.G2.Element where
memoryUsage :: Element -> CostRose
memoryUsage Element
_ = CostRose
g2ElementCost
{-# OPAQUE mlResultElementCost #-}
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
instance ExMemoryUsage BLS12_381.Pairing.MlResult where
memoryUsage :: MlResult -> CostRose
memoryUsage MlResult
_ = CostRose
mlResultElementCost