{-# LANGUAGE CPP                   #-}
{-# LANGUAGE DeriveAnyClass        #-}
{-# LANGUAGE DerivingVia           #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE MagicHash             #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeApplications      #-}
{-# LANGUAGE TypeOperators         #-}
{-# LANGUAGE UndecidableInstances  #-}

module PlutusCore.Evaluation.Machine.ExMemory
( CostingInteger
, ExMemory(..)
, ExCPU(..)
, ExMemoryUsage(..)
) where

import PlutusCore.Data
import PlutusCore.Name
import PlutusCore.Pretty
import PlutusPrelude

import Control.Monad.RWS.Strict
import Data.Aeson
import Data.ByteString qualified as BS
import Data.Proxy
import Data.SatInt
import Data.Text qualified as T
import GHC.Exts (Int (I#))
import GHC.Integer
import GHC.Integer.Logarithms
import GHC.Prim
import Language.Haskell.TH.Syntax (Lift)
import NoThunks.Class
import Universe

{-
 ************************************************************************************
 *  WARNING: exercise caution when altering the ExMemoryUsage instances here.       *
 *                                                                                  *
 *  The instances defined in this file will be used to calculate script validation  *
 *  costs, and if an instance is changed then any scripts which were deployed when  *
 *  a previous instance was in effect MUST STILL VALIDATE using the new instance.   *
 *  It is unsafe to increase the memory usage of a type because that may increase   *
 *  the resource usage of existing scripts beyond the limits set (and paid for)     *
 *  when they were uploaded to the chain, but because our costing functions are all *
 *  monotone) it is safe to decrease memory usage, as long it decreases for *all*   *
 *  possible values of the type.                                                    *
 ************************************************************************************
-}


{- Note [Memory Usage for Plutus]

The base unit is 'ExMemory', which corresponds to machine words. For primitives,
we use static values for the size, see the corresponding instances. For
composite data types, the Generic instance is used, + 1 for the constructor tag.
For ADTs, the currently selected branch is counted, not the maximum value.
Memory usage of the annotation is not counted, because this should be
abstractly specifiable. It's an implementation detail.

-}

{- Note [Integer types for costing]
We care about the speed of our integer operations for costing, this has a significant effect on speed.
But we also need to care about overflow: the cost counters overflowing is a potential attack!

We have a few choices here for what to do with an overflow:
- Don't (this is what 'Integer' does, it's unbounded)
- Wrap (this is what 'Int'/'Int64' and friends do)
- Throw an overflow error (this is what 'Data.SafeInt' does)
- Saturate (i.e. return max/min bound, this is what 'Data.SatInt does)

In our case
- Not overflowing would be nice, but 'Integer' is significantly slower than the other types.
- Wrapping is quite dangerous, as it could lead to us getting attacked by someone wrapping
their cost around to something that looks below the budget.
- Throwing would be okay, but we'd have to worry about exception catching.
- Saturating is actually quite nice: we care about whether `a op b < budget`. So long as `budget < maxBound`,
  then `a op b < budget` will have the same truth value *regardless* of whether the operation overflows and saturates,
  since saturating implies `a op b >= maxBound > budget`. Plus, it means we don't need to deal with
  exceptions.

So we use 'Data.SatInt', a variant of 'Data.SafeInt' that does saturating arithmetic.

'SatInt' is quite fast, but not quite as fast as using 'Int64' directly (I don't know
why that would be, apart from maybe just the overflow checks), but the wrapping behaviour
of 'Int64' is unacceptable.

One other wrinkle is that 'SatInt' is backed by an 'Int' (i.e. a machine integer
with platform-dependent size), rather than an 'Int64' since the primops that we
need are only available for 'Int' until GHC 9.2 or so. So on 32bit platforms, we
would have much less headroom.

However, we don't build on 32bit platforms anyway, so we can ignore that.
-}

-- See Note [Integer types for costing]
-- See also Note [Budgeting units] in ExBudget.hs
type CostingInteger = SatInt

-- | Counts size in machine words.
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
/= :: ExMemory -> ExMemory -> Bool
$c/= :: ExMemory -> ExMemory -> Bool
== :: ExMemory -> ExMemory -> Bool
$c== :: 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
min :: ExMemory -> ExMemory -> ExMemory
$cmin :: ExMemory -> ExMemory -> ExMemory
max :: ExMemory -> ExMemory -> ExMemory
$cmax :: ExMemory -> ExMemory -> ExMemory
>= :: ExMemory -> ExMemory -> Bool
$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
compare :: ExMemory -> ExMemory -> Ordering
$ccompare :: ExMemory -> ExMemory -> Ordering
$cp1Ord :: Eq 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
showList :: [ExMemory] -> ShowS
$cshowList :: [ExMemory] -> ShowS
show :: ExMemory -> String
$cshow :: ExMemory -> String
showsPrec :: Int -> ExMemory -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep ExMemory x -> ExMemory
$cfrom :: forall x. ExMemory -> Rep ExMemory x
Generic, ExMemory -> Q Exp
ExMemory -> Q (TExp ExMemory)
(ExMemory -> Q Exp)
-> (ExMemory -> Q (TExp ExMemory)) -> Lift ExMemory
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: ExMemory -> Q (TExp ExMemory)
$cliftTyped :: ExMemory -> Q (TExp ExMemory)
lift :: ExMemory -> Q Exp
$clift :: ExMemory -> Q Exp
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
fromInteger :: Integer -> ExMemory
$cfromInteger :: Integer -> ExMemory
signum :: ExMemory -> ExMemory
$csignum :: ExMemory -> ExMemory
abs :: ExMemory -> ExMemory
$cabs :: ExMemory -> ExMemory
negate :: ExMemory -> ExMemory
$cnegate :: ExMemory -> ExMemory
* :: ExMemory -> ExMemory -> ExMemory
$c* :: ExMemory -> ExMemory -> ExMemory
- :: ExMemory -> ExMemory -> ExMemory
$c- :: ExMemory -> ExMemory -> ExMemory
+ :: ExMemory -> ExMemory -> ExMemory
$c+ :: ExMemory -> ExMemory -> ExMemory
Num, ExMemory -> ()
(ExMemory -> ()) -> NFData ExMemory
forall a. (a -> ()) -> NFData a
rnf :: ExMemory -> ()
$crnf :: ExMemory -> ()
NFData)
  deriving (b -> ExMemory -> ExMemory
NonEmpty ExMemory -> ExMemory
ExMemory -> ExMemory -> ExMemory
(ExMemory -> ExMemory -> ExMemory)
-> (NonEmpty ExMemory -> ExMemory)
-> (forall b. Integral b => b -> ExMemory -> ExMemory)
-> Semigroup ExMemory
forall b. Integral b => b -> ExMemory -> ExMemory
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> ExMemory -> ExMemory
$cstimes :: forall b. Integral b => b -> ExMemory -> ExMemory
sconcat :: NonEmpty ExMemory -> ExMemory
$csconcat :: NonEmpty ExMemory -> ExMemory
<> :: ExMemory -> ExMemory -> ExMemory
$c<> :: ExMemory -> ExMemory -> ExMemory
Semigroup, Semigroup ExMemory
ExMemory
Semigroup ExMemory
-> ExMemory
-> (ExMemory -> ExMemory -> ExMemory)
-> ([ExMemory] -> ExMemory)
-> Monoid ExMemory
[ExMemory] -> ExMemory
ExMemory -> ExMemory -> ExMemory
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [ExMemory] -> ExMemory
$cmconcat :: [ExMemory] -> ExMemory
mappend :: ExMemory -> ExMemory -> ExMemory
$cmappend :: ExMemory -> ExMemory -> ExMemory
mempty :: ExMemory
$cmempty :: ExMemory
$cp1Monoid :: Semigroup ExMemory
Monoid) via (Sum CostingInteger)
  deriving (Value -> Parser [ExMemory]
Value -> Parser ExMemory
(Value -> Parser ExMemory)
-> (Value -> Parser [ExMemory]) -> FromJSON ExMemory
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ExMemory]
$cparseJSONList :: Value -> Parser [ExMemory]
parseJSON :: Value -> Parser ExMemory
$cparseJSON :: Value -> Parser ExMemory
FromJSON, [ExMemory] -> Encoding
[ExMemory] -> Value
ExMemory -> Encoding
ExMemory -> Value
(ExMemory -> Value)
-> (ExMemory -> Encoding)
-> ([ExMemory] -> Value)
-> ([ExMemory] -> Encoding)
-> ToJSON ExMemory
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ExMemory] -> Encoding
$ctoEncodingList :: [ExMemory] -> Encoding
toJSONList :: [ExMemory] -> Value
$ctoJSONList :: [ExMemory] -> Value
toEncoding :: ExMemory -> Encoding
$ctoEncoding :: ExMemory -> Encoding
toJSON :: ExMemory -> Value
$ctoJSON :: ExMemory -> Value
ToJSON) 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
showTypeOf :: Proxy ExMemory -> String
$cshowTypeOf :: Proxy ExMemory -> String
wNoThunks :: Context -> ExMemory -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> ExMemory -> IO (Maybe ThunkInfo)
noThunks :: Context -> ExMemory -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> ExMemory -> IO (Maybe ThunkInfo)
NoThunks
instance Pretty ExMemory where
    pretty :: ExMemory -> Doc ann
pretty (ExMemory CostingInteger
i) = Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (CostingInteger -> Integer
forall a. Integral a => a -> Integer
toInteger CostingInteger
i)
instance PrettyBy config ExMemory where
    prettyBy :: config -> ExMemory -> Doc ann
prettyBy config
_ ExMemory
m = ExMemory -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ExMemory
m

-- | Counts CPU units in picoseconds: maximum value for SatInt is 2^63 ps, or
-- appproximately 106 days.
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
/= :: ExCPU -> ExCPU -> Bool
$c/= :: ExCPU -> ExCPU -> Bool
== :: ExCPU -> ExCPU -> Bool
$c== :: 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
min :: ExCPU -> ExCPU -> ExCPU
$cmin :: ExCPU -> ExCPU -> ExCPU
max :: ExCPU -> ExCPU -> ExCPU
$cmax :: ExCPU -> ExCPU -> ExCPU
>= :: ExCPU -> ExCPU -> Bool
$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
compare :: ExCPU -> ExCPU -> Ordering
$ccompare :: ExCPU -> ExCPU -> Ordering
$cp1Ord :: Eq 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
showList :: [ExCPU] -> ShowS
$cshowList :: [ExCPU] -> ShowS
show :: ExCPU -> String
$cshow :: ExCPU -> String
showsPrec :: Int -> ExCPU -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep ExCPU x -> ExCPU
$cfrom :: forall x. ExCPU -> Rep ExCPU x
Generic, ExCPU -> Q Exp
ExCPU -> Q (TExp ExCPU)
(ExCPU -> Q Exp) -> (ExCPU -> Q (TExp ExCPU)) -> Lift ExCPU
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: ExCPU -> Q (TExp ExCPU)
$cliftTyped :: ExCPU -> Q (TExp ExCPU)
lift :: ExCPU -> Q Exp
$clift :: ExCPU -> Q Exp
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
fromInteger :: Integer -> ExCPU
$cfromInteger :: Integer -> ExCPU
signum :: ExCPU -> ExCPU
$csignum :: ExCPU -> ExCPU
abs :: ExCPU -> ExCPU
$cabs :: ExCPU -> ExCPU
negate :: ExCPU -> ExCPU
$cnegate :: ExCPU -> ExCPU
* :: ExCPU -> ExCPU -> ExCPU
$c* :: ExCPU -> ExCPU -> ExCPU
- :: ExCPU -> ExCPU -> ExCPU
$c- :: ExCPU -> ExCPU -> ExCPU
+ :: ExCPU -> ExCPU -> ExCPU
$c+ :: ExCPU -> ExCPU -> ExCPU
Num, ExCPU -> ()
(ExCPU -> ()) -> NFData ExCPU
forall a. (a -> ()) -> NFData a
rnf :: ExCPU -> ()
$crnf :: ExCPU -> ()
NFData)
  deriving (b -> ExCPU -> ExCPU
NonEmpty ExCPU -> ExCPU
ExCPU -> ExCPU -> ExCPU
(ExCPU -> ExCPU -> ExCPU)
-> (NonEmpty ExCPU -> ExCPU)
-> (forall b. Integral b => b -> ExCPU -> ExCPU)
-> Semigroup ExCPU
forall b. Integral b => b -> ExCPU -> ExCPU
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> ExCPU -> ExCPU
$cstimes :: forall b. Integral b => b -> ExCPU -> ExCPU
sconcat :: NonEmpty ExCPU -> ExCPU
$csconcat :: NonEmpty ExCPU -> ExCPU
<> :: ExCPU -> ExCPU -> ExCPU
$c<> :: ExCPU -> ExCPU -> ExCPU
Semigroup, Semigroup ExCPU
ExCPU
Semigroup ExCPU
-> ExCPU
-> (ExCPU -> ExCPU -> ExCPU)
-> ([ExCPU] -> ExCPU)
-> Monoid ExCPU
[ExCPU] -> ExCPU
ExCPU -> ExCPU -> ExCPU
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [ExCPU] -> ExCPU
$cmconcat :: [ExCPU] -> ExCPU
mappend :: ExCPU -> ExCPU -> ExCPU
$cmappend :: ExCPU -> ExCPU -> ExCPU
mempty :: ExCPU
$cmempty :: ExCPU
$cp1Monoid :: Semigroup ExCPU
Monoid) via (Sum CostingInteger)
  deriving (Value -> Parser [ExCPU]
Value -> Parser ExCPU
(Value -> Parser ExCPU)
-> (Value -> Parser [ExCPU]) -> FromJSON ExCPU
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ExCPU]
$cparseJSONList :: Value -> Parser [ExCPU]
parseJSON :: Value -> Parser ExCPU
$cparseJSON :: Value -> Parser ExCPU
FromJSON, [ExCPU] -> Encoding
[ExCPU] -> Value
ExCPU -> Encoding
ExCPU -> Value
(ExCPU -> Value)
-> (ExCPU -> Encoding)
-> ([ExCPU] -> Value)
-> ([ExCPU] -> Encoding)
-> ToJSON ExCPU
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ExCPU] -> Encoding
$ctoEncodingList :: [ExCPU] -> Encoding
toJSONList :: [ExCPU] -> Value
$ctoJSONList :: [ExCPU] -> Value
toEncoding :: ExCPU -> Encoding
$ctoEncoding :: ExCPU -> Encoding
toJSON :: ExCPU -> Value
$ctoJSON :: ExCPU -> Value
ToJSON) 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
showTypeOf :: Proxy ExCPU -> String
$cshowTypeOf :: Proxy ExCPU -> String
wNoThunks :: Context -> ExCPU -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> ExCPU -> IO (Maybe ThunkInfo)
noThunks :: Context -> ExCPU -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> ExCPU -> IO (Maybe ThunkInfo)
NoThunks
instance Pretty ExCPU where
    pretty :: ExCPU -> Doc ann
pretty (ExCPU CostingInteger
i) = Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (CostingInteger -> Integer
forall a. Integral a => a -> Integer
toInteger CostingInteger
i)
instance PrettyBy config ExCPU where
    prettyBy :: config -> ExCPU -> Doc ann
prettyBy config
_ ExCPU
m = ExCPU -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ExCPU
m

class ExMemoryUsage a where
    memoryUsage :: a -> ExMemory -- ^ How much memory does 'a' use?

instance (ExMemoryUsage a, ExMemoryUsage b) => ExMemoryUsage (a, b) where
    memoryUsage :: (a, b) -> ExMemory
memoryUsage (a
a, b
b) = ExMemory
1 ExMemory -> ExMemory -> ExMemory
forall a. Semigroup a => a -> a -> a
<> a -> ExMemory
forall a. ExMemoryUsage a => a -> ExMemory
memoryUsage a
a ExMemory -> ExMemory -> ExMemory
forall a. Semigroup a => a -> a -> a
<> b -> ExMemory
forall a. ExMemoryUsage a => a -> ExMemory
memoryUsage b
b
instance ExMemoryUsage SatInt where
    memoryUsage :: CostingInteger -> ExMemory
memoryUsage CostingInteger
n = Int -> ExMemory
forall a. ExMemoryUsage a => a -> ExMemory
memoryUsage (CostingInteger -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral @SatInt @Int CostingInteger
n)
deriving newtype instance ExMemoryUsage ExMemory
deriving newtype instance ExMemoryUsage Unique

-- See https://github.com/input-output-hk/plutus/issues/1861
instance ExMemoryUsage (SomeTypeIn uni) where
  memoryUsage :: SomeTypeIn uni -> ExMemory
memoryUsage SomeTypeIn uni
_ = ExMemory
1 -- TODO things like @list (list (list integer))@ take up a non-constant amount of space.

-- See https://github.com/input-output-hk/plutus/issues/1861
instance (Closed uni, uni `Everywhere` ExMemoryUsage) => ExMemoryUsage (Some (ValueOf uni)) where
  -- TODO this is just to match up with existing golden tests. We probably need to account for @uni@ as well.
  memoryUsage :: Some (ValueOf uni) -> ExMemory
memoryUsage (Some (ValueOf uni (Esc a)
uni a
x)) = Proxy ExMemoryUsage
-> uni (Esc a) -> (ExMemoryUsage a => ExMemory) -> ExMemory
forall (uni :: * -> *) (constr :: * -> Constraint)
       (proxy :: (* -> Constraint) -> *) a r.
(Closed uni, Everywhere uni constr) =>
proxy constr -> uni (Esc a) -> (constr a => r) -> r
bring (Proxy ExMemoryUsage
forall k (t :: k). Proxy t
Proxy @ExMemoryUsage) uni (Esc a)
uni (a -> ExMemory
forall a. ExMemoryUsage a => a -> ExMemory
memoryUsage a
x)

instance ExMemoryUsage () where
  memoryUsage :: () -> ExMemory
memoryUsage () = ExMemory
1

instance ExMemoryUsage Integer where
  memoryUsage :: Integer -> ExMemory
memoryUsage Integer
0 = CostingInteger -> ExMemory
ExMemory CostingInteger
1  -- integerLog2# is unspecified for 0 (but in practice returns -1)
  memoryUsage Integer
i = CostingInteger -> ExMemory
ExMemory (CostingInteger -> ExMemory) -> CostingInteger -> ExMemory
forall a b. (a -> b) -> a -> b
$ 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# Int#
n) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                               where n :: Int#
n = (Integer -> Int#
integerLog2# (Integer -> Integer
forall a. Num a => a -> a
abs Integer
i) Int# -> Int# -> Int#
`quotInt#` Integer -> Int#
integerToInt Integer
64) :: Int#
                               -- Assume 64-bit size for Integer

{- Bytestrings: we want things of length 0 to have size 0, 1-8 to have size 1,
   9-16 to have size 2, etc.  Note that (-1) div 8 == -1, so the code below
   gives the correct answer for the empty bytestring.  Maybe we should just use
   1 + (toInteger $ BS.length bs) `div` 8, which would count one extra for
   things whose sizes are multiples of 8. -}
instance ExMemoryUsage BS.ByteString where
  memoryUsage :: ByteString -> ExMemory
memoryUsage ByteString
bs = CostingInteger -> ExMemory
ExMemory (CostingInteger -> ExMemory) -> CostingInteger -> ExMemory
forall a b. (a -> b) -> a -> b
$ ((CostingInteger
nCostingInteger -> CostingInteger -> CostingInteger
forall a. Num a => a -> a -> a
-CostingInteger
1) CostingInteger -> CostingInteger -> CostingInteger
forall a. Integral a => a -> a -> a
`quot` CostingInteger
8) CostingInteger -> CostingInteger -> CostingInteger
forall a. Num a => a -> a -> a
+ CostingInteger
1  -- Don't use `div` here!  That gives 1 instead of 0 for n=0.
      where n :: CostingInteger
n = Int -> CostingInteger
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CostingInteger) -> Int -> CostingInteger
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BS.length ByteString
bs :: SatInt

instance ExMemoryUsage T.Text where
  -- This is slow and inaccurate, but matches the version that was originally deployed.
  -- We may try and improve this in future so long as the new version matches this exactly.
  memoryUsage :: Text -> ExMemory
memoryUsage Text
text = String -> ExMemory
forall a. ExMemoryUsage a => a -> ExMemory
memoryUsage (String -> ExMemory) -> String -> ExMemory
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
text

instance ExMemoryUsage Int where
  memoryUsage :: Int -> ExMemory
memoryUsage Int
_ = ExMemory
1

instance ExMemoryUsage Char where
  memoryUsage :: Char -> ExMemory
memoryUsage Char
_ = ExMemory
1

instance ExMemoryUsage Bool where
  memoryUsage :: Bool -> ExMemory
memoryUsage Bool
_ = ExMemory
1

-- Memory usage for lists: let's just go for a naive traversal for now.
instance ExMemoryUsage a => ExMemoryUsage [a] where
    memoryUsage :: [a] -> ExMemory
memoryUsage = [a] -> ExMemory
sizeList
        where sizeList :: [a] -> ExMemory
sizeList =
                  \case
                   []   -> ExMemory
0
                   a
x:[a]
xs -> a -> ExMemory
forall a. ExMemoryUsage a => a -> ExMemory
memoryUsage a
x ExMemory -> ExMemory -> ExMemory
forall a. Num a => a -> a -> a
+ [a] -> ExMemory
sizeList [a]
xs

{- Another naive traversal for size.  This accounts for the number of nodes in
   a Data object, and also the sizes of the contents of the nodes.  This is not
   ideal, but it seems to be the best we can do.  At present this only comes
   into play for 'equalsData', which is implemented using the derived
   implementation of '==' (fortunately the costing functions are lazy, so this
   won't be called for things like 'unBData' which have constant costing
   functions because they only have to look at the top node).  The problem is
   that when we call 'equalsData' the comparison will take place entirely in
   Haskell, so the costing functions for the contents of 'I' and 'B' nodes
   won't be called.  Thus if we just counted the number of nodes the sizes of
   'I 2' and 'B <huge bytestring>' would be the same but they'd take different
   amounts of time to compare.  It's not clear how to trade off the costs of
   processing a node and processing the contents of nodes: the implementation
   below compromises by charging four units per node, but we may wish to revise
   this after experimentation.
-}
{- This code runs on the chain and hence should be as efficient as possible. To
   that end it's tempting to make these functions strict and tail recursive (and
   similarly in the instance for lists above), but experiments showed that that
   didn't improve matters and in fact some versions led to a slight slowdown.
-}
instance ExMemoryUsage Data where
    memoryUsage :: Data -> ExMemory
memoryUsage = Data -> ExMemory
sizeData
        where sizeData :: Data -> ExMemory
sizeData Data
d =
                  ExMemory
nodeMem ExMemory -> ExMemory -> ExMemory
forall a. Num a => a -> a -> a
+
                     case Data
d of
                       Constr Integer
_ [Data]
l -> [Data] -> ExMemory
sizeDataList [Data]
l
                       Map [(Data, Data)]
l      -> [(Data, Data)] -> ExMemory
sizeDataPairs [(Data, Data)]
l
                       List [Data]
l     -> [Data] -> ExMemory
sizeDataList [Data]
l
                       I Integer
n        -> Integer -> ExMemory
forall a. ExMemoryUsage a => a -> ExMemory
memoryUsage Integer
n
                       B ByteString
b        -> ByteString -> ExMemory
forall a. ExMemoryUsage a => a -> ExMemory
memoryUsage ByteString
b
              nodeMem :: ExMemory
nodeMem = ExMemory
4
              sizeDataList :: [Data] -> ExMemory
sizeDataList []     = ExMemory
0
              sizeDataList (Data
d:[Data]
ds) = Data -> ExMemory
sizeData Data
d ExMemory -> ExMemory -> ExMemory
forall a. Num a => a -> a -> a
+ [Data] -> ExMemory
sizeDataList [Data]
ds
              sizeDataPairs :: [(Data, Data)] -> ExMemory
sizeDataPairs []           = ExMemory
0
              sizeDataPairs ((Data
d1,Data
d2):[(Data, Data)]
ps) = Data -> ExMemory
sizeData Data
d1 ExMemory -> ExMemory -> ExMemory
forall a. Num a => a -> a -> a
+ Data -> ExMemory
sizeData Data
d2 ExMemory -> ExMemory -> ExMemory
forall a. Num a => a -> a -> a
+ [(Data, Data)] -> ExMemory
sizeDataPairs [(Data, Data)]
ps