{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ImplicitParams #-}

module EVM where

import Prelude hiding (exponent)

import Optics.Core
import Optics.State
import Optics.State.Operators
import Optics.Zoom
import Optics.Operators.Unsafe

import EVM.ABI
import EVM.Expr (readStorage, writeStorage, readByte, readWord, writeWord,
  writeByte, bufLength, indexWord, litAddr, readBytes, word256At, copySlice, wordToAddr)
import EVM.Expr qualified as Expr
import EVM.FeeSchedule (FeeSchedule (..))
import EVM.Op
import EVM.Precompiled qualified
import EVM.Solidity
import EVM.Types
import EVM.Types qualified as Expr (Expr(Gas))
import EVM.Sign qualified
import EVM.Concrete qualified as Concrete

import Control.Monad.ST (ST)
import Control.Monad.State.Strict hiding (state)
import Data.Bits (FiniteBits, countLeadingZeros, finiteBitSize)
import Data.ByteArray qualified as BA
import Data.ByteString (ByteString)
import Data.ByteString qualified as BS
import Data.ByteString.Lazy (fromStrict)
import Data.ByteString.Lazy qualified as LS
import Data.ByteString.Char8 qualified as Char8
import Data.Foldable (toList)
import Data.List (find)
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.Maybe (fromMaybe, fromJust, isJust)
import Data.Set (insert, member, fromList)
import Data.Sequence (Seq)
import Data.Sequence qualified as Seq
import Data.Text (unpack, pack)
import Data.Text.Encoding (decodeUtf8)
import Data.Tree
import Data.Tree.Zipper qualified as Zipper
import Data.Typeable
import Data.Vector qualified as V
import Data.Vector.Storable qualified as SV
import Data.Vector.Storable.Mutable qualified as SV
import Data.Vector.Unboxed qualified as VUnboxed
import Data.Vector.Unboxed.Mutable qualified as VUnboxed.Mutable
import Data.Word (Word8, Word32, Word64)
import Witch (into, tryFrom, unsafeInto)

import Crypto.Hash (Digest, SHA256, RIPEMD160)
import Crypto.Hash qualified as Crypto
import Crypto.Number.ModArithmetic (expFast)

blankState :: VMOps t => ST s (FrameState t s)
blankState :: forall (t :: VMType) s. VMOps t => ST s (FrameState t s)
blankState = do
  Memory s
memory <- MutableMemory s -> Memory s
forall s. MutableMemory s -> Memory s
ConcreteMemory (MutableMemory s -> Memory s)
-> ST s (MutableMemory s) -> ST s (Memory s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ST s (MVector (PrimState (ST s)) Word8)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> m (MVector (PrimState m) a)
VUnboxed.Mutable.new Int
0
  FrameState t s -> ST s (FrameState t s)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FrameState t s -> ST s (FrameState t s))
-> FrameState t s -> ST s (FrameState t s)
forall a b. (a -> b) -> a -> b
$ FrameState
    { $sel:contract:FrameState :: Expr 'EAddr
contract     = Addr -> Expr 'EAddr
LitAddr Addr
0
    , $sel:codeContract:FrameState :: Expr 'EAddr
codeContract = Addr -> Expr 'EAddr
LitAddr Addr
0
    , $sel:code:FrameState :: ContractCode
code         = RuntimeCode -> ContractCode
RuntimeCode (ByteString -> RuntimeCode
ConcreteRuntimeCode ByteString
"")
    , $sel:pc:FrameState :: Int
pc           = Int
0
    , $sel:stack:FrameState :: [Expr 'EWord]
stack        = [Expr 'EWord]
forall a. Monoid a => a
mempty
    , Memory s
memory :: Memory s
$sel:memory:FrameState :: Memory s
memory
    , $sel:memorySize:FrameState :: Word64
memorySize   = Word64
0
    , $sel:calldata:FrameState :: Expr 'Buf
calldata     = Expr 'Buf
forall a. Monoid a => a
mempty
    , $sel:callvalue:FrameState :: Expr 'EWord
callvalue    = W256 -> Expr 'EWord
Lit W256
0
    , $sel:caller:FrameState :: Expr 'EAddr
caller       = Addr -> Expr 'EAddr
LitAddr Addr
0
    , $sel:gas:FrameState :: Gas t
gas          = Gas t
forall (t :: VMType). VMOps t => Gas t
initialGas
    , $sel:returndata:FrameState :: Expr 'Buf
returndata   = Expr 'Buf
forall a. Monoid a => a
mempty
    , $sel:static:FrameState :: Bool
static       = Bool
False
    }

-- | An "external" view of a contract's bytecode, appropriate for
-- e.g. @EXTCODEHASH@.
bytecode :: Getter Contract (Maybe (Expr Buf))
bytecode :: Getter Contract (Maybe (Expr 'Buf))
bytecode = Optic A_Lens '[] Contract Contract ContractCode ContractCode
#code Optic A_Lens '[] Contract Contract ContractCode ContractCode
-> Optic
     A_Getter
     '[]
     ContractCode
     ContractCode
     (Maybe (Expr 'Buf))
     (Maybe (Expr 'Buf))
-> Getter Contract (Maybe (Expr 'Buf))
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% (ContractCode -> Maybe (Expr 'Buf))
-> Optic
     A_Getter
     '[]
     ContractCode
     ContractCode
     (Maybe (Expr 'Buf))
     (Maybe (Expr 'Buf))
forall s a. (s -> a) -> Getter s a
to ContractCode -> Maybe (Expr 'Buf)
f
  where f :: ContractCode -> Maybe (Expr 'Buf)
f (InitCode ByteString
_ Expr 'Buf
_) = Expr 'Buf -> Maybe (Expr 'Buf)
forall a. a -> Maybe a
Just Expr 'Buf
forall a. Monoid a => a
mempty
        f (RuntimeCode (ConcreteRuntimeCode ByteString
bs)) = Expr 'Buf -> Maybe (Expr 'Buf)
forall a. a -> Maybe a
Just (Expr 'Buf -> Maybe (Expr 'Buf)) -> Expr 'Buf -> Maybe (Expr 'Buf)
forall a b. (a -> b) -> a -> b
$ ByteString -> Expr 'Buf
ConcreteBuf ByteString
bs
        f (RuntimeCode (SymbolicRuntimeCode Vector (Expr 'Byte)
ops)) = Expr 'Buf -> Maybe (Expr 'Buf)
forall a. a -> Maybe a
Just (Expr 'Buf -> Maybe (Expr 'Buf)) -> Expr 'Buf -> Maybe (Expr 'Buf)
forall a b. (a -> b) -> a -> b
$ Vector (Expr 'Byte) -> Expr 'Buf
Expr.fromList Vector (Expr 'Byte)
ops
        f (UnknownCode Expr 'EAddr
_) = Maybe (Expr 'Buf)
forall a. Maybe a
Nothing

-- * Data accessors

currentContract :: VM t s -> Maybe Contract
currentContract :: forall (t :: VMType) s. VM t s -> Maybe Contract
currentContract VM t s
vm =
  Expr 'EAddr -> Map (Expr 'EAddr) Contract -> Maybe Contract
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup VM t s
vm.state.codeContract VM t s
vm.env.contracts

-- * Data constructors

makeVm :: VMOps t => VMOpts t -> ST s (VM t s)
makeVm :: forall (t :: VMType) s. VMOps t => VMOpts t -> ST s (VM t s)
makeVm VMOpts t
o = do
  let txaccessList :: Map (Expr 'EAddr) [W256]
txaccessList = VMOpts t
o.txAccessList
      txorigin :: Expr 'EAddr
txorigin = VMOpts t
o.origin
      txtoAddr :: Expr 'EAddr
txtoAddr = VMOpts t
o.address
      initialAccessedAddrs :: Set (Expr 'EAddr)
initialAccessedAddrs = [Expr 'EAddr] -> Set (Expr 'EAddr)
forall a. Ord a => [a] -> Set a
fromList ([Expr 'EAddr] -> Set (Expr 'EAddr))
-> [Expr 'EAddr] -> Set (Expr 'EAddr)
forall a b. (a -> b) -> a -> b
$
           [Expr 'EAddr
txorigin, Expr 'EAddr
txtoAddr, VMOpts t
o.coinbase]
        [Expr 'EAddr] -> [Expr 'EAddr] -> [Expr 'EAddr]
forall a. [a] -> [a] -> [a]
++ ((Addr -> Expr 'EAddr) -> [Addr] -> [Expr 'EAddr]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Addr -> Expr 'EAddr
LitAddr [Addr
1..Addr
9])
        [Expr 'EAddr] -> [Expr 'EAddr] -> [Expr 'EAddr]
forall a. [a] -> [a] -> [a]
++ (Map (Expr 'EAddr) [W256] -> [Expr 'EAddr]
forall k a. Map k a -> [k]
Map.keys Map (Expr 'EAddr) [W256]
txaccessList)
      initialAccessedStorageKeys :: Set (Expr 'EAddr, W256)
initialAccessedStorageKeys = [(Expr 'EAddr, W256)] -> Set (Expr 'EAddr, W256)
forall a. Ord a => [a] -> Set a
fromList ([(Expr 'EAddr, W256)] -> Set (Expr 'EAddr, W256))
-> [(Expr 'EAddr, W256)] -> Set (Expr 'EAddr, W256)
forall a b. (a -> b) -> a -> b
$ ((Expr 'EAddr, [W256]) -> [(Expr 'EAddr, W256)])
-> [(Expr 'EAddr, [W256])] -> [(Expr 'EAddr, W256)]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Expr 'EAddr -> [W256] -> [(Expr 'EAddr, W256)])
-> (Expr 'EAddr, [W256]) -> [(Expr 'EAddr, W256)]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((W256 -> (Expr 'EAddr, W256)) -> [W256] -> [(Expr 'EAddr, W256)]
forall a b. (a -> b) -> [a] -> [b]
map ((W256 -> (Expr 'EAddr, W256)) -> [W256] -> [(Expr 'EAddr, W256)])
-> (Expr 'EAddr -> W256 -> (Expr 'EAddr, W256))
-> Expr 'EAddr
-> [W256]
-> [(Expr 'EAddr, W256)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,))) (Map (Expr 'EAddr) [W256] -> [(Expr 'EAddr, [W256])]
forall k a. Map k a -> [(k, a)]
Map.toList Map (Expr 'EAddr) [W256]
txaccessList)
      touched :: [Expr 'EAddr]
touched = if VMOpts t
o.create then [Expr 'EAddr
txorigin] else [Expr 'EAddr
txorigin, Expr 'EAddr
txtoAddr]
  Memory s
memory <- MutableMemory s -> Memory s
forall s. MutableMemory s -> Memory s
ConcreteMemory (MutableMemory s -> Memory s)
-> ST s (MutableMemory s) -> ST s (Memory s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ST s (MVector (PrimState (ST s)) Word8)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> m (MVector (PrimState m) a)
VUnboxed.Mutable.new Int
0
  VM t s -> ST s (VM t s)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VM t s -> ST s (VM t s)) -> VM t s -> ST s (VM t s)
forall a b. (a -> b) -> a -> b
$ VM
    { $sel:result:VM :: Maybe (VMResult t s)
result = Maybe (VMResult t s)
forall a. Maybe a
Nothing
    , $sel:frames:VM :: [Frame t s]
frames = [Frame t s]
forall a. Monoid a => a
mempty
    , $sel:tx:VM :: TxState
tx = TxState
      { $sel:gasprice:TxState :: W256
gasprice = VMOpts t
o.gasprice
      , $sel:gaslimit:TxState :: Word64
gaslimit = VMOpts t
o.gaslimit
      , $sel:priorityFee:TxState :: W256
priorityFee = VMOpts t
o.priorityFee
      , $sel:origin:TxState :: Expr 'EAddr
origin = Expr 'EAddr
txorigin
      , $sel:toAddr:TxState :: Expr 'EAddr
toAddr = Expr 'EAddr
txtoAddr
      , $sel:value:TxState :: Expr 'EWord
value = VMOpts t
o.value
      , $sel:substate:TxState :: SubState
substate = [Expr 'EAddr]
-> [Expr 'EAddr]
-> Set (Expr 'EAddr)
-> Set (Expr 'EAddr, W256)
-> [(Expr 'EAddr, Word64)]
-> SubState
SubState [Expr 'EAddr]
forall a. Monoid a => a
mempty [Expr 'EAddr]
touched Set (Expr 'EAddr)
initialAccessedAddrs Set (Expr 'EAddr, W256)
initialAccessedStorageKeys [(Expr 'EAddr, Word64)]
forall a. Monoid a => a
mempty
      , $sel:isCreate:TxState :: Bool
isCreate = VMOpts t
o.create
      , $sel:txReversion:TxState :: Map (Expr 'EAddr) Contract
txReversion = [(Expr 'EAddr, Contract)] -> Map (Expr 'EAddr) Contract
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ((VMOpts t
o.address,VMOpts t
o.contract)(Expr 'EAddr, Contract)
-> [(Expr 'EAddr, Contract)] -> [(Expr 'EAddr, Contract)]
forall a. a -> [a] -> [a]
:VMOpts t
o.otherContracts)
      }
    , $sel:logs:VM :: [Expr 'Log]
logs = []
    , $sel:traces:VM :: TreePos Empty Trace
traces = Forest Trace -> TreePos Empty Trace
forall a. Forest a -> TreePos Empty a
Zipper.fromForest []
    , $sel:block:VM :: Block
block = Block
block
    , $sel:state:VM :: FrameState t s
state = FrameState
      { $sel:pc:FrameState :: Int
pc = Int
0
      , $sel:stack:FrameState :: [Expr 'EWord]
stack = [Expr 'EWord]
forall a. Monoid a => a
mempty
      , Memory s
$sel:memory:FrameState :: Memory s
memory :: Memory s
memory
      , $sel:memorySize:FrameState :: Word64
memorySize = Word64
0
      , $sel:code:FrameState :: ContractCode
code = VMOpts t
o.contract.code
      , $sel:contract:FrameState :: Expr 'EAddr
contract = VMOpts t
o.address
      , $sel:codeContract:FrameState :: Expr 'EAddr
codeContract = VMOpts t
o.address
      , $sel:calldata:FrameState :: Expr 'Buf
calldata = (Expr 'Buf, [Prop]) -> Expr 'Buf
forall a b. (a, b) -> a
fst VMOpts t
o.calldata
      , $sel:callvalue:FrameState :: Expr 'EWord
callvalue = VMOpts t
o.value
      , $sel:caller:FrameState :: Expr 'EAddr
caller = VMOpts t
o.caller
      , $sel:gas:FrameState :: Gas t
gas = VMOpts t
o.gas
      , $sel:returndata:FrameState :: Expr 'Buf
returndata = Expr 'Buf
forall a. Monoid a => a
mempty
      , $sel:static:FrameState :: Bool
static = Bool
False
      }
    , $sel:env:VM :: Env
env = Env
env
    , $sel:cache:VM :: Cache
cache = Cache
cache
    , $sel:burned:VM :: Gas t
burned = Gas t
forall (t :: VMType). VMOps t => Gas t
initialGas
    , $sel:constraints:VM :: [Prop]
constraints = (Expr 'Buf, [Prop]) -> [Prop]
forall a b. (a, b) -> b
snd VMOpts t
o.calldata
    , $sel:iterations:VM :: Map CodeLocation (Int, [Expr 'EWord])
iterations = Map CodeLocation (Int, [Expr 'EWord])
forall a. Monoid a => a
mempty
    , $sel:config:VM :: RuntimeConfig
config = RuntimeConfig
      { $sel:allowFFI:RuntimeConfig :: Bool
allowFFI = VMOpts t
o.allowFFI
      , $sel:overrideCaller:RuntimeConfig :: Maybe (Expr 'EAddr)
overrideCaller = Maybe (Expr 'EAddr)
forall a. Maybe a
Nothing
      , $sel:baseState:RuntimeConfig :: BaseState
baseState = VMOpts t
o.baseState
      }
    , $sel:forks:VM :: Seq ForkState
forks = ForkState -> Seq ForkState
forall a. a -> Seq a
Seq.singleton (Env -> Block -> Cache -> [Char] -> ForkState
ForkState Env
env Block
block Cache
cache [Char]
"")
    , $sel:currentFork:VM :: Int
currentFork = Int
0
    }
    where
    env :: Env
env = Env
      { $sel:chainId:Env :: W256
chainId = VMOpts t
o.chainId
      , $sel:contracts:Env :: Map (Expr 'EAddr) Contract
contracts = [(Expr 'EAddr, Contract)] -> Map (Expr 'EAddr) Contract
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ((VMOpts t
o.address,VMOpts t
o.contract)(Expr 'EAddr, Contract)
-> [(Expr 'EAddr, Contract)] -> [(Expr 'EAddr, Contract)]
forall a. a -> [a] -> [a]
:VMOpts t
o.otherContracts)
      , $sel:freshAddresses:Env :: Int
freshAddresses = Int
0
      , $sel:freshGasVals:Env :: Int
freshGasVals = Int
0
      }
    block :: Block
block = Block
      { $sel:coinbase:Block :: Expr 'EAddr
coinbase = VMOpts t
o.coinbase
      , $sel:timestamp:Block :: Expr 'EWord
timestamp = VMOpts t
o.timestamp
      , $sel:number:Block :: W256
number = VMOpts t
o.number
      , $sel:prevRandao:Block :: W256
prevRandao = VMOpts t
o.prevRandao
      , $sel:maxCodeSize:Block :: W256
maxCodeSize = VMOpts t
o.maxCodeSize
      , $sel:gaslimit:Block :: Word64
gaslimit = VMOpts t
o.blockGaslimit
      , $sel:baseFee:Block :: W256
baseFee = VMOpts t
o.baseFee
      , $sel:schedule:Block :: FeeSchedule Word64
schedule = VMOpts t
o.schedule
      }
    cache :: Cache
cache = Map Addr Contract -> Map (CodeLocation, Int) Bool -> Cache
Cache Map Addr Contract
forall a. Monoid a => a
mempty Map (CodeLocation, Int) Bool
forall a. Monoid a => a
mempty

-- | Initialize an abstract contract with unknown code
unknownContract :: Expr EAddr -> Contract
unknownContract :: Expr 'EAddr -> Contract
unknownContract Expr 'EAddr
addr = Contract
  { $sel:code:Contract :: ContractCode
code        = Expr 'EAddr -> ContractCode
UnknownCode Expr 'EAddr
addr
  , $sel:storage:Contract :: Expr 'Storage
storage     = Expr 'EAddr -> Maybe W256 -> Expr 'Storage
AbstractStore Expr 'EAddr
addr Maybe W256
forall a. Maybe a
Nothing
  , $sel:origStorage:Contract :: Expr 'Storage
origStorage = Expr 'EAddr -> Maybe W256 -> Expr 'Storage
AbstractStore Expr 'EAddr
addr Maybe W256
forall a. Maybe a
Nothing
  , $sel:balance:Contract :: Expr 'EWord
balance     = Expr 'EAddr -> Expr 'EWord
Balance Expr 'EAddr
addr
  , $sel:nonce:Contract :: Maybe W64
nonce       = Maybe W64
forall a. Maybe a
Nothing
  , $sel:codehash:Contract :: Expr 'EWord
codehash    = ContractCode -> Expr 'EWord
hashcode (Expr 'EAddr -> ContractCode
UnknownCode Expr 'EAddr
addr)
  , $sel:opIxMap:Contract :: Vector Int
opIxMap     = Vector Int
forall a. Monoid a => a
mempty
  , $sel:codeOps:Contract :: Vector (Int, Op)
codeOps     = Vector (Int, Op)
forall a. Monoid a => a
mempty
  , $sel:external:Contract :: Bool
external    = Bool
False
  }

-- | Initialize an abstract contract with known code
abstractContract :: ContractCode -> Expr EAddr -> Contract
abstractContract :: ContractCode -> Expr 'EAddr -> Contract
abstractContract ContractCode
code Expr 'EAddr
addr = Contract
  { $sel:code:Contract :: ContractCode
code        = ContractCode
code
  , $sel:storage:Contract :: Expr 'Storage
storage     = Expr 'EAddr -> Maybe W256 -> Expr 'Storage
AbstractStore Expr 'EAddr
addr Maybe W256
forall a. Maybe a
Nothing
  , $sel:origStorage:Contract :: Expr 'Storage
origStorage = Expr 'EAddr -> Maybe W256 -> Expr 'Storage
AbstractStore Expr 'EAddr
addr Maybe W256
forall a. Maybe a
Nothing
  , $sel:balance:Contract :: Expr 'EWord
balance     = Expr 'EAddr -> Expr 'EWord
Balance Expr 'EAddr
addr
  , $sel:nonce:Contract :: Maybe W64
nonce       = if ContractCode -> Bool
isCreation ContractCode
code then W64 -> Maybe W64
forall a. a -> Maybe a
Just W64
1 else W64 -> Maybe W64
forall a. a -> Maybe a
Just W64
0
  , $sel:codehash:Contract :: Expr 'EWord
codehash    = ContractCode -> Expr 'EWord
hashcode ContractCode
code
  , $sel:opIxMap:Contract :: Vector Int
opIxMap     = ContractCode -> Vector Int
mkOpIxMap ContractCode
code
  , $sel:codeOps:Contract :: Vector (Int, Op)
codeOps     = ContractCode -> Vector (Int, Op)
mkCodeOps ContractCode
code
  , $sel:external:Contract :: Bool
external    = Bool
False
  }

-- | Initialize an empty contract without code
emptyContract :: Contract
emptyContract :: Contract
emptyContract = ContractCode -> Contract
initialContract (RuntimeCode -> ContractCode
RuntimeCode (ByteString -> RuntimeCode
ConcreteRuntimeCode ByteString
""))

-- | Initialize empty contract with given code
initialContract :: ContractCode -> Contract
initialContract :: ContractCode -> Contract
initialContract ContractCode
code = Contract
  { $sel:code:Contract :: ContractCode
code        = ContractCode
code
  , $sel:storage:Contract :: Expr 'Storage
storage     = Map W256 W256 -> Expr 'Storage
ConcreteStore Map W256 W256
forall a. Monoid a => a
mempty
  , $sel:origStorage:Contract :: Expr 'Storage
origStorage = Map W256 W256 -> Expr 'Storage
ConcreteStore Map W256 W256
forall a. Monoid a => a
mempty
  , $sel:balance:Contract :: Expr 'EWord
balance     = W256 -> Expr 'EWord
Lit W256
0
  , $sel:nonce:Contract :: Maybe W64
nonce       = if ContractCode -> Bool
isCreation ContractCode
code then W64 -> Maybe W64
forall a. a -> Maybe a
Just W64
1 else W64 -> Maybe W64
forall a. a -> Maybe a
Just W64
0
  , $sel:codehash:Contract :: Expr 'EWord
codehash    = ContractCode -> Expr 'EWord
hashcode ContractCode
code
  , $sel:opIxMap:Contract :: Vector Int
opIxMap     = ContractCode -> Vector Int
mkOpIxMap ContractCode
code
  , $sel:codeOps:Contract :: Vector (Int, Op)
codeOps     = ContractCode -> Vector (Int, Op)
mkCodeOps ContractCode
code
  , $sel:external:Contract :: Bool
external    = Bool
False
  }

isCreation :: ContractCode -> Bool
isCreation :: ContractCode -> Bool
isCreation = \case
  InitCode ByteString
_ Expr 'Buf
_  -> Bool
True
  RuntimeCode RuntimeCode
_ -> Bool
False
  UnknownCode Expr 'EAddr
_ -> Bool
False

-- * Opcode dispatch (exec1)

-- | Update program counter
next :: (?op :: Word8) => EVM t s ()
next :: forall (t :: VMType) s. (?op::Word8) => EVM t s ()
next = Optic A_Lens '[] (VM t s) (VM t s) Int Int
-> (Int -> Int) -> StateT (VM t s) (ST s) ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic A_Lens '[] (FrameState t s) (FrameState t s) Int Int
-> Optic A_Lens '[] (VM t s) (VM t s) Int Int
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens '[] (FrameState t s) (FrameState t s) Int Int
#pc) (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Word8 -> Int
opSize ?op::Word8
Word8
?op))

-- | Executes the EVM one step
exec1 :: forall (t :: VMType) s. VMOps t => EVM t s ()
exec1 :: forall (t :: VMType) s. VMOps t => EVM t s ()
exec1 = do
  VM t s
vm <- StateT (VM t s) (ST s) (VM t s)
forall s (m :: * -> *). MonadState s m => m s
get

  let
    -- Convenient aliases
    stk :: [Expr 'EWord]
stk  = VM t s
vm.state.stack
    self :: Expr 'EAddr
self = VM t s
vm.state.contract
    this :: Contract
this = Contract -> Maybe Contract -> Contract
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> Contract
forall a. HasCallStack => [Char] -> a
internalError [Char]
"state contract") (Expr 'EAddr -> Map (Expr 'EAddr) Contract -> Maybe Contract
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Expr 'EAddr
self VM t s
vm.env.contracts)

    fees :: FeeSchedule Word64
fees@FeeSchedule {Word64
g_zero :: Word64
g_base :: Word64
g_verylow :: Word64
g_low :: Word64
g_mid :: Word64
g_high :: Word64
g_extcode :: Word64
g_balance :: Word64
g_sload :: Word64
g_jumpdest :: Word64
g_sset :: Word64
g_sreset :: Word64
r_sclear :: Word64
g_selfdestruct :: Word64
g_selfdestruct_newaccount :: Word64
r_selfdestruct :: Word64
g_create :: Word64
g_codedeposit :: Word64
g_call :: Word64
g_callvalue :: Word64
g_callstipend :: Word64
g_newaccount :: Word64
g_exp :: Word64
g_expbyte :: Word64
g_memory :: Word64
g_txcreate :: Word64
g_txdatazero :: Word64
g_txdatanonzero :: Word64
g_transaction :: Word64
g_log :: Word64
g_logdata :: Word64
g_logtopic :: Word64
g_sha3 :: Word64
g_sha3word :: Word64
g_initcodeword :: Word64
g_copy :: Word64
g_blockhash :: Word64
g_extcodehash :: Word64
g_quaddivisor :: Word64
g_ecadd :: Word64
g_ecmul :: Word64
g_pairing_point :: Word64
g_pairing_base :: Word64
g_fround :: Word64
r_block :: Word64
g_cold_sload :: Word64
g_cold_account_access :: Word64
g_warm_storage_read :: Word64
g_access_list_address :: Word64
g_access_list_storage_key :: Word64
$sel:g_zero:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_base:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_verylow:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_low:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_mid:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_high:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_extcode:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_balance:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sload:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_jumpdest:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sset:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sreset:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:r_sclear:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_selfdestruct:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_selfdestruct_newaccount:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:r_selfdestruct:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_create:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_codedeposit:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_call:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_callvalue:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_callstipend:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_newaccount:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_exp:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_expbyte:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_memory:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_txcreate:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_txdatazero:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_txdatanonzero:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_transaction:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_log:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_logdata:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_logtopic:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sha3:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sha3word:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_initcodeword:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_copy:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_blockhash:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_extcodehash:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_quaddivisor:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_ecadd:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_ecmul:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_pairing_point:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_pairing_base:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_fround:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:r_block:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_cold_sload:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_cold_account_access:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_warm_storage_read:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_access_list_address:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_access_list_storage_key:FeeSchedule :: forall n. FeeSchedule n -> n
..} = VM t s
vm.block.schedule

    doStop :: EVM t s ()
doStop = FrameResult -> EVM t s ()
forall (t :: VMType) s. VMOps t => FrameResult -> EVM t s ()
finishFrame (Expr 'Buf -> FrameResult
FrameReturned Expr 'Buf
forall a. Monoid a => a
mempty)

    litSelf :: Maybe Addr
litSelf = Expr 'EAddr -> Maybe Addr
maybeLitAddr Expr 'EAddr
self

  if Maybe Addr -> Bool
forall a. Maybe a -> Bool
isJust Maybe Addr
litSelf Bool -> Bool -> Bool
&& (Maybe Addr -> Addr
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Addr
litSelf) Addr -> Addr -> Bool
forall a. Ord a => a -> a -> Bool
> Addr
0x0 Bool -> Bool -> Bool
&& (Maybe Addr -> Addr
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Addr
litSelf) Addr -> Addr -> Bool
forall a. Ord a => a -> a -> Bool
<= Addr
0x9 then do
    -- call to precompile
    let ?op = ?op::Word8
Word8
0x00 -- dummy value
    let calldatasize :: Expr 'EWord
calldatasize = Expr 'Buf -> Expr 'EWord
bufLength VM t s
vm.state.calldata
    Expr 'Buf
-> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM t s ()
forall (t :: VMType) s.
Expr 'Buf
-> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM t s ()
copyBytesToMemory VM t s
vm.state.calldata Expr 'EWord
calldatasize (W256 -> Expr 'EWord
Lit W256
0) (W256 -> Expr 'EWord
Lit W256
0)
    Addr
-> Gas t
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> [Expr 'EWord]
-> EVM t s ()
forall (t :: VMType) s.
(?op::Word8, VMOps t) =>
Addr
-> Gas t
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> [Expr 'EWord]
-> EVM t s ()
executePrecompile (Maybe Addr -> Addr
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Addr
litSelf) VM t s
vm.state.gas (W256 -> Expr 'EWord
Lit W256
0) Expr 'EWord
calldatasize (W256 -> Expr 'EWord
Lit W256
0) (W256 -> Expr 'EWord
Lit W256
0) []
    VM t s
vmx <- StateT (VM t s) (ST s) (VM t s)
forall s (m :: * -> *). MonadState s m => m s
get
    case VM t s
vmx.state.stack of
      Expr 'EWord
x:[Expr 'EWord]
_ -> case Expr 'EWord
x of
        Lit W256
0 ->
          Expr 'EAddr -> (Contract -> EVM t s ()) -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EAddr -> (Contract -> EVM t s ()) -> EVM t s ()
fetchAccount Expr 'EAddr
self ((Contract -> EVM t s ()) -> EVM t s ())
-> (Contract -> EVM t s ()) -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ \Contract
_ -> do
            Expr 'EAddr -> EVM t s ()
forall (t :: VMType) s. Expr 'EAddr -> EVM t s ()
touchAccount Expr 'EAddr
self
            EvmError -> EVM t s ()
forall (t :: VMType) s. VMOps t => EvmError -> EVM t s ()
vmError EvmError
PrecompileFailure
        Lit W256
_ ->
          Expr 'EAddr -> (Contract -> EVM t s ()) -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EAddr -> (Contract -> EVM t s ()) -> EVM t s ()
fetchAccount Expr 'EAddr
self ((Contract -> EVM t s ()) -> EVM t s ())
-> (Contract -> EVM t s ()) -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ \Contract
_ -> do
            Expr 'EAddr -> EVM t s ()
forall (t :: VMType) s. Expr 'EAddr -> EVM t s ()
touchAccount Expr 'EAddr
self
            Expr 'Buf
out <- Optic' A_Lens '[] (VM t s) (Expr 'Buf)
-> StateT (VM t s) (ST s) (Expr 'Buf)
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     (Expr 'Buf)
     (Expr 'Buf)
-> Optic' A_Lens '[] (VM t s) (Expr 'Buf)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  (Expr 'Buf)
  (Expr 'Buf)
#returndata)
            FrameResult -> EVM t s ()
forall (t :: VMType) s. VMOps t => FrameResult -> EVM t s ()
finishFrame (Expr 'Buf -> FrameResult
FrameReturned Expr 'Buf
out)
        Expr 'EWord
e -> PartialExec -> EVM t s ()
forall s. PartialExec -> EVM t s ()
forall (t :: VMType) s. VMOps t => PartialExec -> EVM t s ()
partial (PartialExec -> EVM t s ()) -> PartialExec -> EVM t s ()
forall a b. (a -> b) -> a -> b
$
               Int -> [Char] -> [SomeExpr] -> PartialExec
UnexpectedSymbolicArg VM t s
vmx.state.pc [Char]
"precompile returned a symbolic value" ([Expr 'EWord] -> [SomeExpr]
forall (a :: EType). Typeable a => [Expr a] -> [SomeExpr]
wrap [Expr 'EWord
e])
      [Expr 'EWord]
_ ->
        EVM t s ()
forall (t :: VMType) s. VMOps t => EVM t s ()
underrun

  else if VM t s
vm.state.pc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= ContractCode -> Int
opslen VM t s
vm.state.code
    then EVM t s ()
forall {s}. EVM t s ()
doStop

    else do
      let ?op = case VM t s
vm.state.code of
                  UnknownCode Expr 'EAddr
_ -> [Char] -> Word8
forall a. HasCallStack => [Char] -> a
internalError [Char]
"Cannot execute unknown code"
                  InitCode ByteString
conc Expr 'Buf
_ -> HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
conc VM t s
vm.state.pc
                  RuntimeCode (ConcreteRuntimeCode ByteString
bs) -> HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
bs VM t s
vm.state.pc
                  RuntimeCode (SymbolicRuntimeCode Vector (Expr 'Byte)
ops) ->
                    Word8 -> Maybe Word8 -> Word8
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> Word8
forall a. HasCallStack => [Char] -> a
internalError [Char]
"could not analyze symbolic code") (Maybe Word8 -> Word8) -> Maybe Word8 -> Word8
forall a b. (a -> b) -> a -> b
$
                      Expr 'Byte -> Maybe Word8
maybeLitByte (Expr 'Byte -> Maybe Word8) -> Expr 'Byte -> Maybe Word8
forall a b. (a -> b) -> a -> b
$ Vector (Expr 'Byte)
ops Vector (Expr 'Byte) -> Int -> Expr 'Byte
forall a. Vector a -> Int -> a
V.! VM t s
vm.state.pc

      case Word8 -> GenericOp Word8
getOp (?op::Word8
Word8
?op) of

        GenericOp Word8
OpPush0 -> do
          Int -> EVM t s () -> EVM t s ()
forall (t :: VMType) s. VMOps t => Int -> EVM t s () -> EVM t s ()
limitStack Int
1 (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$
            Word64 -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Word64 -> EVM t s () -> EVM t s ()
burn Word64
g_base (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ do
              EVM t s ()
forall (t :: VMType) s. (?op::Word8) => EVM t s ()
next
              Expr 'EWord -> EVM t s ()
forall (t :: VMType) s. Expr 'EWord -> EVM t s ()
pushSym (W256 -> Expr 'EWord
Lit W256
0)

        OpPush Word8
n' -> do
          let n :: Int
n = Word8 -> Int
forall target source. From source target => source -> target
into Word8
n'
              !xs :: Expr 'EWord
xs = case VM t s
vm.state.code of
                UnknownCode Expr 'EAddr
_ -> [Char] -> Expr 'EWord
forall a. HasCallStack => [Char] -> a
internalError [Char]
"Cannot execute unknown code"
                InitCode ByteString
conc Expr 'Buf
_ -> W256 -> Expr 'EWord
Lit (W256 -> Expr 'EWord) -> W256 -> Expr 'EWord
forall a b. (a -> b) -> a -> b
$ ByteString -> W256
word (ByteString -> W256) -> ByteString -> W256
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
padRight Int
n (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.take Int
n (Int -> ByteString -> ByteString
BS.drop (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ VM t s
vm.state.pc) ByteString
conc)
                RuntimeCode (ConcreteRuntimeCode ByteString
bs) -> W256 -> Expr 'EWord
Lit (W256 -> Expr 'EWord) -> W256 -> Expr 'EWord
forall a b. (a -> b) -> a -> b
$ ByteString -> W256
word (ByteString -> W256) -> ByteString -> W256
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.take Int
n (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.drop (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ VM t s
vm.state.pc) ByteString
bs
                RuntimeCode (SymbolicRuntimeCode Vector (Expr 'Byte)
ops) ->
                  let bytes :: Vector (Expr 'Byte)
bytes = Int -> Vector (Expr 'Byte) -> Vector (Expr 'Byte)
forall a. Int -> Vector a -> Vector a
V.take Int
n (Vector (Expr 'Byte) -> Vector (Expr 'Byte))
-> Vector (Expr 'Byte) -> Vector (Expr 'Byte)
forall a b. (a -> b) -> a -> b
$ Int -> Vector (Expr 'Byte) -> Vector (Expr 'Byte)
forall a. Int -> Vector a -> Vector a
V.drop (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ VM t s
vm.state.pc) Vector (Expr 'Byte)
ops
                  in Expr 'EWord -> Expr 'Buf -> Expr 'EWord
readWord (W256 -> Expr 'EWord
Lit W256
0) (Expr 'Buf -> Expr 'EWord) -> Expr 'Buf -> Expr 'EWord
forall a b. (a -> b) -> a -> b
$ Vector (Expr 'Byte) -> Expr 'Buf
Expr.fromList (Vector (Expr 'Byte) -> Expr 'Buf)
-> Vector (Expr 'Byte) -> Expr 'Buf
forall a b. (a -> b) -> a -> b
$ Int -> Vector (Expr 'Byte) -> Vector (Expr 'Byte)
padLeft' Int
32 Vector (Expr 'Byte)
bytes
          Int -> EVM t s () -> EVM t s ()
forall (t :: VMType) s. VMOps t => Int -> EVM t s () -> EVM t s ()
limitStack Int
1 (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$
            Word64 -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Word64 -> EVM t s () -> EVM t s ()
burn Word64
g_verylow (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ do
              EVM t s ()
forall (t :: VMType) s. (?op::Word8) => EVM t s ()
next
              Expr 'EWord -> EVM t s ()
forall (t :: VMType) s. Expr 'EWord -> EVM t s ()
pushSym Expr 'EWord
xs

        OpDup Word8
i ->
          case Optic' An_AffineTraversal '[] [Expr 'EWord] (Expr 'EWord)
-> [Expr 'EWord] -> Maybe (Expr 'EWord)
forall k (is :: IxList) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview (Index [Expr 'EWord]
-> Optic'
     (IxKind [Expr 'EWord]) '[] [Expr 'EWord] (IxValue [Expr 'EWord])
forall m. Ixed m => Index m -> Optic' (IxKind m) '[] m (IxValue m)
ix (Word8 -> Int
forall target source. From source target => source -> target
into Word8
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) [Expr 'EWord]
stk of
            Maybe (Expr 'EWord)
Nothing -> EVM t s ()
forall (t :: VMType) s. VMOps t => EVM t s ()
underrun
            Just Expr 'EWord
y ->
              Int -> EVM t s () -> EVM t s ()
forall (t :: VMType) s. VMOps t => Int -> EVM t s () -> EVM t s ()
limitStack Int
1 (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$
                Word64 -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Word64 -> EVM t s () -> EVM t s ()
burn Word64
g_verylow (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ do
                  EVM t s ()
forall (t :: VMType) s. (?op::Word8) => EVM t s ()
next
                  Expr 'EWord -> EVM t s ()
forall (t :: VMType) s. Expr 'EWord -> EVM t s ()
pushSym Expr 'EWord
y

        OpSwap Word8
i ->
          if [Expr 'EWord] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Expr 'EWord]
stk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< (Word8 -> Int
forall target source. From source target => source -> target
into Word8
i) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
            then EVM t s ()
forall (t :: VMType) s. VMOps t => EVM t s ()
underrun
            else
              Word64 -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Word64 -> EVM t s () -> EVM t s ()
burn Word64
g_verylow (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ do
                EVM t s ()
forall (t :: VMType) s. (?op::Word8) => EVM t s ()
next
                Optic' A_Lens '[] (VM t s) [Expr 'EWord]
-> StateT [Expr 'EWord] (ST s) () -> EVM t s ()
forall k (is :: IxList) c.
Is k A_Lens =>
Optic' k is (VM t s) [Expr 'EWord]
-> StateT [Expr 'EWord] (ST s) c -> StateT (VM t s) (ST s) c
forall (m :: * -> *) (n :: * -> *) s t k (is :: IxList) c.
(Zoom m n s t, Is k A_Lens) =>
Optic' k is t s -> m c -> n c
zoom (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     [Expr 'EWord]
     [Expr 'EWord]
-> Optic' A_Lens '[] (VM t s) [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  [Expr 'EWord]
  [Expr 'EWord]
#stack) (StateT [Expr 'EWord] (ST s) () -> EVM t s ())
-> StateT [Expr 'EWord] (ST s) () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ do
                  Optic'
  (IxKind [Expr 'EWord]) '[] [Expr 'EWord] (IxValue [Expr 'EWord])
-> IxValue [Expr 'EWord] -> StateT [Expr 'EWord] (ST s) ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Index [Expr 'EWord]
-> Optic'
     (IxKind [Expr 'EWord]) '[] [Expr 'EWord] (IxValue [Expr 'EWord])
forall m. Ixed m => Index m -> Optic' (IxKind m) '[] m (IxValue m)
ix Index [Expr 'EWord]
0) ([Expr 'EWord]
stk [Expr 'EWord]
-> Optic'
     An_AffineTraversal '[] [Expr 'EWord] (IxValue [Expr 'EWord])
-> IxValue [Expr 'EWord]
forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! Index [Expr 'EWord]
-> Optic'
     (IxKind [Expr 'EWord]) '[] [Expr 'EWord] (IxValue [Expr 'EWord])
forall m. Ixed m => Index m -> Optic' (IxKind m) '[] m (IxValue m)
ix (Word8 -> Int
forall target source. From source target => source -> target
into Word8
i))
                  Optic'
  (IxKind [Expr 'EWord]) '[] [Expr 'EWord] (IxValue [Expr 'EWord])
-> IxValue [Expr 'EWord] -> StateT [Expr 'EWord] (ST s) ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Index [Expr 'EWord]
-> Optic'
     (IxKind [Expr 'EWord]) '[] [Expr 'EWord] (IxValue [Expr 'EWord])
forall m. Ixed m => Index m -> Optic' (IxKind m) '[] m (IxValue m)
ix (Word8 -> Index [Expr 'EWord]
forall target source. From source target => source -> target
into Word8
i)) ([Expr 'EWord]
stk [Expr 'EWord]
-> Optic'
     An_AffineTraversal '[] [Expr 'EWord] (IxValue [Expr 'EWord])
-> IxValue [Expr 'EWord]
forall k s (is :: IxList) a.
(HasCallStack, Is k An_AffineFold) =>
s -> Optic' k is s a -> a
^?! Index [Expr 'EWord]
-> Optic'
     (IxKind [Expr 'EWord]) '[] [Expr 'EWord] (IxValue [Expr 'EWord])
forall m. Ixed m => Index m -> Optic' (IxKind m) '[] m (IxValue m)
ix Int
Index [Expr 'EWord]
0)

        OpLog Word8
n ->
          EVM t s () -> EVM t s ()
forall (t :: VMType) s. VMOps t => EVM t s () -> EVM t s ()
notStatic (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$
          case [Expr 'EWord]
stk of
            (Expr 'EWord
xOffset:Expr 'EWord
xSize:[Expr 'EWord]
xs) ->
              if [Expr 'EWord] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Expr 'EWord]
xs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< (Word8 -> Int
forall target source. From source target => source -> target
into Word8
n)
              then EVM t s ()
forall (t :: VMType) s. VMOps t => EVM t s ()
underrun
              else do
                Expr 'Buf
bytes <- Expr 'EWord -> Expr 'EWord -> StateT (VM t s) (ST s) (Expr 'Buf)
forall (t :: VMType) s.
Expr 'EWord -> Expr 'EWord -> EVM t s (Expr 'Buf)
readMemory Expr 'EWord
xOffset Expr 'EWord
xSize
                let ([Expr 'EWord]
topics, [Expr 'EWord]
xs') = Int -> [Expr 'EWord] -> ([Expr 'EWord], [Expr 'EWord])
forall a. Int -> [a] -> ([a], [a])
splitAt (Word8 -> Int
forall target source. From source target => source -> target
into Word8
n) [Expr 'EWord]
xs
                    logs' :: [Expr 'Log]
logs'         = (Expr 'EWord -> Expr 'Buf -> [Expr 'EWord] -> Expr 'Log
LogEntry (Expr 'EAddr -> Expr 'EWord
WAddr Expr 'EAddr
self) Expr 'Buf
bytes [Expr 'EWord]
topics) Expr 'Log -> [Expr 'Log] -> [Expr 'Log]
forall a. a -> [a] -> [a]
: VM t s
vm.logs
                Expr 'EWord -> Word8 -> EVM t s () -> EVM t s ()
forall s. Expr 'EWord -> Word8 -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EWord -> Word8 -> EVM t s () -> EVM t s ()
burnLog Expr 'EWord
xSize Word8
n (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$
                  Expr 'EWord -> Expr 'EWord -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EWord -> Expr 'EWord -> EVM t s () -> EVM t s ()
accessMemoryRange Expr 'EWord
xOffset Expr 'EWord
xSize (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ do
                    [Expr 'Log] -> EVM t s ()
forall (t :: VMType) s. [Expr 'Log] -> EVM t s ()
traceTopLog [Expr 'Log]
logs'
                    EVM t s ()
forall (t :: VMType) s. (?op::Word8) => EVM t s ()
next
                    Optic' A_Lens '[] (VM t s) [Expr 'EWord]
-> [Expr 'EWord] -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     [Expr 'EWord]
     [Expr 'EWord]
-> Optic' A_Lens '[] (VM t s) [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  [Expr 'EWord]
  [Expr 'EWord]
#stack) [Expr 'EWord]
xs'
                    Optic A_Lens '[] (VM t s) (VM t s) [Expr 'Log] [Expr 'Log]
-> [Expr 'Log] -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign Optic A_Lens '[] (VM t s) (VM t s) [Expr 'Log] [Expr 'Log]
#logs [Expr 'Log]
logs'
            [Expr 'EWord]
_ ->
              EVM t s ()
forall (t :: VMType) s. VMOps t => EVM t s ()
underrun

        GenericOp Word8
OpStop -> EVM t s ()
forall {s}. EVM t s ()
doStop

        GenericOp Word8
OpAdd -> Word64 -> (Expr 'EWord -> Expr 'EWord -> Expr 'EWord) -> EVM t s ()
forall (t :: VMType) s.
(?op::Word8, VMOps t) =>
Word64 -> (Expr 'EWord -> Expr 'EWord -> Expr 'EWord) -> EVM t s ()
stackOp2 Word64
g_verylow Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.add
        GenericOp Word8
OpMul -> Word64 -> (Expr 'EWord -> Expr 'EWord -> Expr 'EWord) -> EVM t s ()
forall (t :: VMType) s.
(?op::Word8, VMOps t) =>
Word64 -> (Expr 'EWord -> Expr 'EWord -> Expr 'EWord) -> EVM t s ()
stackOp2 Word64
g_low Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.mul
        GenericOp Word8
OpSub -> Word64 -> (Expr 'EWord -> Expr 'EWord -> Expr 'EWord) -> EVM t s ()
forall (t :: VMType) s.
(?op::Word8, VMOps t) =>
Word64 -> (Expr 'EWord -> Expr 'EWord -> Expr 'EWord) -> EVM t s ()
stackOp2 Word64
g_verylow Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.sub

        GenericOp Word8
OpDiv -> Word64 -> (Expr 'EWord -> Expr 'EWord -> Expr 'EWord) -> EVM t s ()
forall (t :: VMType) s.
(?op::Word8, VMOps t) =>
Word64 -> (Expr 'EWord -> Expr 'EWord -> Expr 'EWord) -> EVM t s ()
stackOp2 Word64
g_low Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.div

        GenericOp Word8
OpSdiv -> Word64 -> (Expr 'EWord -> Expr 'EWord -> Expr 'EWord) -> EVM t s ()
forall (t :: VMType) s.
(?op::Word8, VMOps t) =>
Word64 -> (Expr 'EWord -> Expr 'EWord -> Expr 'EWord) -> EVM t s ()
stackOp2 Word64
g_low Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.sdiv

        GenericOp Word8
OpMod -> Word64 -> (Expr 'EWord -> Expr 'EWord -> Expr 'EWord) -> EVM t s ()
forall (t :: VMType) s.
(?op::Word8, VMOps t) =>
Word64 -> (Expr 'EWord -> Expr 'EWord -> Expr 'EWord) -> EVM t s ()
stackOp2 Word64
g_low Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.mod

        GenericOp Word8
OpSmod -> Word64 -> (Expr 'EWord -> Expr 'EWord -> Expr 'EWord) -> EVM t s ()
forall (t :: VMType) s.
(?op::Word8, VMOps t) =>
Word64 -> (Expr 'EWord -> Expr 'EWord -> Expr 'EWord) -> EVM t s ()
stackOp2 Word64
g_low Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.smod
        GenericOp Word8
OpAddmod -> Word64
-> (Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> Expr 'EWord)
-> EVM t s ()
forall (t :: VMType) s.
(?op::Word8, VMOps t) =>
Word64
-> (Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> Expr 'EWord)
-> EVM t s ()
stackOp3 Word64
g_mid Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.addmod
        GenericOp Word8
OpMulmod -> Word64
-> (Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> Expr 'EWord)
-> EVM t s ()
forall (t :: VMType) s.
(?op::Word8, VMOps t) =>
Word64
-> (Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> Expr 'EWord)
-> EVM t s ()
stackOp3 Word64
g_mid Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.mulmod

        GenericOp Word8
OpLt -> Word64 -> (Expr 'EWord -> Expr 'EWord -> Expr 'EWord) -> EVM t s ()
forall (t :: VMType) s.
(?op::Word8, VMOps t) =>
Word64 -> (Expr 'EWord -> Expr 'EWord -> Expr 'EWord) -> EVM t s ()
stackOp2 Word64
g_verylow Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.lt
        GenericOp Word8
OpGt -> Word64 -> (Expr 'EWord -> Expr 'EWord -> Expr 'EWord) -> EVM t s ()
forall (t :: VMType) s.
(?op::Word8, VMOps t) =>
Word64 -> (Expr 'EWord -> Expr 'EWord -> Expr 'EWord) -> EVM t s ()
stackOp2 Word64
g_verylow Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.gt
        GenericOp Word8
OpSlt -> Word64 -> (Expr 'EWord -> Expr 'EWord -> Expr 'EWord) -> EVM t s ()
forall (t :: VMType) s.
(?op::Word8, VMOps t) =>
Word64 -> (Expr 'EWord -> Expr 'EWord -> Expr 'EWord) -> EVM t s ()
stackOp2 Word64
g_verylow Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.slt
        GenericOp Word8
OpSgt -> Word64 -> (Expr 'EWord -> Expr 'EWord -> Expr 'EWord) -> EVM t s ()
forall (t :: VMType) s.
(?op::Word8, VMOps t) =>
Word64 -> (Expr 'EWord -> Expr 'EWord -> Expr 'EWord) -> EVM t s ()
stackOp2 Word64
g_verylow Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.sgt

        GenericOp Word8
OpEq -> Word64 -> (Expr 'EWord -> Expr 'EWord -> Expr 'EWord) -> EVM t s ()
forall (t :: VMType) s.
(?op::Word8, VMOps t) =>
Word64 -> (Expr 'EWord -> Expr 'EWord -> Expr 'EWord) -> EVM t s ()
stackOp2 Word64
g_verylow Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.eq
        GenericOp Word8
OpIszero -> Word64 -> (Expr 'EWord -> Expr 'EWord) -> EVM t s ()
forall (t :: VMType) s.
(?op::Word8, VMOps t) =>
Word64 -> (Expr 'EWord -> Expr 'EWord) -> EVM t s ()
stackOp1 Word64
g_verylow Expr 'EWord -> Expr 'EWord
Expr.iszero

        GenericOp Word8
OpAnd -> Word64 -> (Expr 'EWord -> Expr 'EWord -> Expr 'EWord) -> EVM t s ()
forall (t :: VMType) s.
(?op::Word8, VMOps t) =>
Word64 -> (Expr 'EWord -> Expr 'EWord -> Expr 'EWord) -> EVM t s ()
stackOp2 Word64
g_verylow Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.and
        GenericOp Word8
OpOr -> Word64 -> (Expr 'EWord -> Expr 'EWord -> Expr 'EWord) -> EVM t s ()
forall (t :: VMType) s.
(?op::Word8, VMOps t) =>
Word64 -> (Expr 'EWord -> Expr 'EWord -> Expr 'EWord) -> EVM t s ()
stackOp2 Word64
g_verylow Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.or
        GenericOp Word8
OpXor -> Word64 -> (Expr 'EWord -> Expr 'EWord -> Expr 'EWord) -> EVM t s ()
forall (t :: VMType) s.
(?op::Word8, VMOps t) =>
Word64 -> (Expr 'EWord -> Expr 'EWord -> Expr 'EWord) -> EVM t s ()
stackOp2 Word64
g_verylow Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.xor
        GenericOp Word8
OpNot -> Word64 -> (Expr 'EWord -> Expr 'EWord) -> EVM t s ()
forall (t :: VMType) s.
(?op::Word8, VMOps t) =>
Word64 -> (Expr 'EWord -> Expr 'EWord) -> EVM t s ()
stackOp1 Word64
g_verylow Expr 'EWord -> Expr 'EWord
Expr.not

        GenericOp Word8
OpByte -> Word64 -> (Expr 'EWord -> Expr 'EWord -> Expr 'EWord) -> EVM t s ()
forall (t :: VMType) s.
(?op::Word8, VMOps t) =>
Word64 -> (Expr 'EWord -> Expr 'EWord -> Expr 'EWord) -> EVM t s ()
stackOp2 Word64
g_verylow (\Expr 'EWord
i Expr 'EWord
w -> Expr 'Byte -> Expr 'EWord
Expr.padByte (Expr 'Byte -> Expr 'EWord) -> Expr 'Byte -> Expr 'EWord
forall a b. (a -> b) -> a -> b
$ Expr 'EWord -> Expr 'EWord -> Expr 'Byte
Expr.indexWord Expr 'EWord
i Expr 'EWord
w)

        GenericOp Word8
OpShl -> Word64 -> (Expr 'EWord -> Expr 'EWord -> Expr 'EWord) -> EVM t s ()
forall (t :: VMType) s.
(?op::Word8, VMOps t) =>
Word64 -> (Expr 'EWord -> Expr 'EWord -> Expr 'EWord) -> EVM t s ()
stackOp2 Word64
g_verylow Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.shl
        GenericOp Word8
OpShr -> Word64 -> (Expr 'EWord -> Expr 'EWord -> Expr 'EWord) -> EVM t s ()
forall (t :: VMType) s.
(?op::Word8, VMOps t) =>
Word64 -> (Expr 'EWord -> Expr 'EWord -> Expr 'EWord) -> EVM t s ()
stackOp2 Word64
g_verylow Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.shr
        GenericOp Word8
OpSar -> Word64 -> (Expr 'EWord -> Expr 'EWord -> Expr 'EWord) -> EVM t s ()
forall (t :: VMType) s.
(?op::Word8, VMOps t) =>
Word64 -> (Expr 'EWord -> Expr 'EWord -> Expr 'EWord) -> EVM t s ()
stackOp2 Word64
g_verylow Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.sar

        -- more accurately referred to as KECCAK
        GenericOp Word8
OpSha3 ->
          case [Expr 'EWord]
stk of
            Expr 'EWord
xOffset:Expr 'EWord
xSize:[Expr 'EWord]
xs ->
              Expr 'EWord -> EVM t s () -> EVM t s ()
forall s. Expr 'EWord -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EWord -> EVM t s () -> EVM t s ()
burnSha3 Expr 'EWord
xSize (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$
                Expr 'EWord -> Expr 'EWord -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EWord -> Expr 'EWord -> EVM t s () -> EVM t s ()
accessMemoryRange Expr 'EWord
xOffset Expr 'EWord
xSize (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ do
                  Expr 'EWord
hash <- Expr 'EWord -> Expr 'EWord -> StateT (VM t s) (ST s) (Expr 'Buf)
forall (t :: VMType) s.
Expr 'EWord -> Expr 'EWord -> EVM t s (Expr 'Buf)
readMemory Expr 'EWord
xOffset Expr 'EWord
xSize StateT (VM t s) (ST s) (Expr 'Buf)
-> (Expr 'Buf -> StateT (VM t s) (ST s) (Expr 'EWord))
-> StateT (VM t s) (ST s) (Expr 'EWord)
forall a b.
StateT (VM t s) (ST s) a
-> (a -> StateT (VM t s) (ST s) b) -> StateT (VM t s) (ST s) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                    orig :: Expr 'Buf
orig@(ConcreteBuf ByteString
bs) ->
                      StateT (VM t s) (ST s) (Expr 'EWord)
-> StateT (VM t s) (ST s) (Expr 'EWord)
-> StateT (VM t s) (ST s) (Expr 'EWord)
forall s a. EVM t s a -> EVM t s a -> EVM t s a
forall (t :: VMType) s a.
VMOps t =>
EVM t s a -> EVM t s a -> EVM t s a
whenSymbolicElse
                        (Expr 'EWord -> StateT (VM t s) (ST s) (Expr 'EWord)
forall a. a -> StateT (VM t s) (ST s) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expr 'EWord -> StateT (VM t s) (ST s) (Expr 'EWord))
-> Expr 'EWord -> StateT (VM t s) (ST s) (Expr 'EWord)
forall a b. (a -> b) -> a -> b
$ Expr 'Buf -> Expr 'EWord
Keccak Expr 'Buf
orig)
                        (Expr 'EWord -> StateT (VM t s) (ST s) (Expr 'EWord)
forall a. a -> StateT (VM t s) (ST s) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expr 'EWord -> StateT (VM t s) (ST s) (Expr 'EWord))
-> Expr 'EWord -> StateT (VM t s) (ST s) (Expr 'EWord)
forall a b. (a -> b) -> a -> b
$ W256 -> Expr 'EWord
Lit (ByteString -> W256
keccak' ByteString
bs))
                    Expr 'Buf
buf -> Expr 'EWord -> StateT (VM t s) (ST s) (Expr 'EWord)
forall a. a -> StateT (VM t s) (ST s) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expr 'EWord -> StateT (VM t s) (ST s) (Expr 'EWord))
-> Expr 'EWord -> StateT (VM t s) (ST s) (Expr 'EWord)
forall a b. (a -> b) -> a -> b
$ Expr 'Buf -> Expr 'EWord
Keccak Expr 'Buf
buf
                  EVM t s ()
forall (t :: VMType) s. (?op::Word8) => EVM t s ()
next
                  Optic' A_Lens '[] (VM t s) [Expr 'EWord]
-> [Expr 'EWord] -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     [Expr 'EWord]
     [Expr 'EWord]
-> Optic' A_Lens '[] (VM t s) [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  [Expr 'EWord]
  [Expr 'EWord]
#stack) (Expr 'EWord
hash Expr 'EWord -> [Expr 'EWord] -> [Expr 'EWord]
forall a. a -> [a] -> [a]
: [Expr 'EWord]
xs)
            [Expr 'EWord]
_ -> EVM t s ()
forall (t :: VMType) s. VMOps t => EVM t s ()
underrun

        GenericOp Word8
OpAddress ->
          Int -> EVM t s () -> EVM t s ()
forall (t :: VMType) s. VMOps t => Int -> EVM t s () -> EVM t s ()
limitStack Int
1 (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$
            Word64 -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Word64 -> EVM t s () -> EVM t s ()
burn Word64
g_base (EVM t s ()
forall (t :: VMType) s. (?op::Word8) => EVM t s ()
next EVM t s () -> EVM t s () -> EVM t s ()
forall a b.
StateT (VM t s) (ST s) a
-> StateT (VM t s) (ST s) b -> StateT (VM t s) (ST s) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Expr 'EAddr -> EVM t s ()
forall (t :: VMType) s. Expr 'EAddr -> EVM t s ()
pushAddr Expr 'EAddr
self)

        GenericOp Word8
OpBalance ->
          case [Expr 'EWord]
stk of
            Expr 'EWord
x:[Expr 'EWord]
xs -> Expr 'EWord -> [Char] -> (Expr 'EAddr -> EVM t s ()) -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EWord -> [Char] -> (Expr 'EAddr -> EVM t s ()) -> EVM t s ()
forceAddr Expr 'EWord
x [Char]
"BALANCE" ((Expr 'EAddr -> EVM t s ()) -> EVM t s ())
-> (Expr 'EAddr -> EVM t s ()) -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ \Expr 'EAddr
a ->
              Expr 'EAddr -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EAddr -> EVM t s () -> EVM t s ()
accessAndBurn Expr 'EAddr
a (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$
                Expr 'EAddr -> (Contract -> EVM t s ()) -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EAddr -> (Contract -> EVM t s ()) -> EVM t s ()
fetchAccount Expr 'EAddr
a ((Contract -> EVM t s ()) -> EVM t s ())
-> (Contract -> EVM t s ()) -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ \Contract
c -> do
                  EVM t s ()
forall (t :: VMType) s. (?op::Word8) => EVM t s ()
next
                  Optic' A_Lens '[] (VM t s) [Expr 'EWord]
-> [Expr 'EWord] -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     [Expr 'EWord]
     [Expr 'EWord]
-> Optic' A_Lens '[] (VM t s) [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  [Expr 'EWord]
  [Expr 'EWord]
#stack) [Expr 'EWord]
xs
                  Expr 'EWord -> EVM t s ()
forall (t :: VMType) s. Expr 'EWord -> EVM t s ()
pushSym Contract
c.balance
            [] ->
              EVM t s ()
forall (t :: VMType) s. VMOps t => EVM t s ()
underrun

        GenericOp Word8
OpOrigin ->
          Int -> EVM t s () -> EVM t s ()
forall (t :: VMType) s. VMOps t => Int -> EVM t s () -> EVM t s ()
limitStack Int
1 (EVM t s () -> EVM t s ())
-> (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Word64 -> EVM t s () -> EVM t s ()
burn Word64
g_base (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$
            EVM t s ()
forall (t :: VMType) s. (?op::Word8) => EVM t s ()
next EVM t s () -> EVM t s () -> EVM t s ()
forall a b.
StateT (VM t s) (ST s) a
-> StateT (VM t s) (ST s) b -> StateT (VM t s) (ST s) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Expr 'EAddr -> EVM t s ()
forall (t :: VMType) s. Expr 'EAddr -> EVM t s ()
pushAddr VM t s
vm.tx.origin

        GenericOp Word8
OpCaller ->
          Int -> EVM t s () -> EVM t s ()
forall (t :: VMType) s. VMOps t => Int -> EVM t s () -> EVM t s ()
limitStack Int
1 (EVM t s () -> EVM t s ())
-> (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Word64 -> EVM t s () -> EVM t s ()
burn Word64
g_base (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$
            EVM t s ()
forall (t :: VMType) s. (?op::Word8) => EVM t s ()
next EVM t s () -> EVM t s () -> EVM t s ()
forall a b.
StateT (VM t s) (ST s) a
-> StateT (VM t s) (ST s) b -> StateT (VM t s) (ST s) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Expr 'EAddr -> EVM t s ()
forall (t :: VMType) s. Expr 'EAddr -> EVM t s ()
pushAddr VM t s
vm.state.caller

        GenericOp Word8
OpCallvalue ->
          Int -> EVM t s () -> EVM t s ()
forall (t :: VMType) s. VMOps t => Int -> EVM t s () -> EVM t s ()
limitStack Int
1 (EVM t s () -> EVM t s ())
-> (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Word64 -> EVM t s () -> EVM t s ()
burn Word64
g_base (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$
            EVM t s ()
forall (t :: VMType) s. (?op::Word8) => EVM t s ()
next EVM t s () -> EVM t s () -> EVM t s ()
forall a b.
StateT (VM t s) (ST s) a
-> StateT (VM t s) (ST s) b -> StateT (VM t s) (ST s) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Expr 'EWord -> EVM t s ()
forall (t :: VMType) s. Expr 'EWord -> EVM t s ()
pushSym VM t s
vm.state.callvalue

        GenericOp Word8
OpCalldataload -> Word64 -> (Expr 'EWord -> Expr 'EWord) -> EVM t s ()
forall (t :: VMType) s.
(?op::Word8, VMOps t) =>
Word64 -> (Expr 'EWord -> Expr 'EWord) -> EVM t s ()
stackOp1 Word64
g_verylow ((Expr 'EWord -> Expr 'EWord) -> EVM t s ())
-> (Expr 'EWord -> Expr 'EWord) -> EVM t s ()
forall a b. (a -> b) -> a -> b
$
          \Expr 'EWord
ind -> Expr 'EWord -> Expr 'Buf -> Expr 'EWord
Expr.readWord Expr 'EWord
ind VM t s
vm.state.calldata

        GenericOp Word8
OpCalldatasize ->
          Int -> EVM t s () -> EVM t s ()
forall (t :: VMType) s. VMOps t => Int -> EVM t s () -> EVM t s ()
limitStack Int
1 (EVM t s () -> EVM t s ())
-> (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Word64 -> EVM t s () -> EVM t s ()
burn Word64
g_base (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$
            EVM t s ()
forall (t :: VMType) s. (?op::Word8) => EVM t s ()
next EVM t s () -> EVM t s () -> EVM t s ()
forall a b.
StateT (VM t s) (ST s) a
-> StateT (VM t s) (ST s) b -> StateT (VM t s) (ST s) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Expr 'EWord -> EVM t s ()
forall (t :: VMType) s. Expr 'EWord -> EVM t s ()
pushSym (Expr 'Buf -> Expr 'EWord
bufLength VM t s
vm.state.calldata)

        GenericOp Word8
OpCalldatacopy ->
          case [Expr 'EWord]
stk of
            Expr 'EWord
xTo:Expr 'EWord
xFrom:Expr 'EWord
xSize:[Expr 'EWord]
xs ->
              Expr 'EWord -> EVM t s () -> EVM t s ()
forall s. Expr 'EWord -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EWord -> EVM t s () -> EVM t s ()
burnCalldatacopy Expr 'EWord
xSize (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$
                Expr 'EWord -> Expr 'EWord -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EWord -> Expr 'EWord -> EVM t s () -> EVM t s ()
accessMemoryRange Expr 'EWord
xTo Expr 'EWord
xSize (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ do
                  EVM t s ()
forall (t :: VMType) s. (?op::Word8) => EVM t s ()
next
                  Optic' A_Lens '[] (VM t s) [Expr 'EWord]
-> [Expr 'EWord] -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     [Expr 'EWord]
     [Expr 'EWord]
-> Optic' A_Lens '[] (VM t s) [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  [Expr 'EWord]
  [Expr 'EWord]
#stack) [Expr 'EWord]
xs
                  Expr 'Buf
-> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM t s ()
forall (t :: VMType) s.
Expr 'Buf
-> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM t s ()
copyBytesToMemory VM t s
vm.state.calldata Expr 'EWord
xSize Expr 'EWord
xFrom Expr 'EWord
xTo
            [Expr 'EWord]
_ -> EVM t s ()
forall (t :: VMType) s. VMOps t => EVM t s ()
underrun

        GenericOp Word8
OpCodesize ->
          Int -> EVM t s () -> EVM t s ()
forall (t :: VMType) s. VMOps t => Int -> EVM t s () -> EVM t s ()
limitStack Int
1 (EVM t s () -> EVM t s ())
-> (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Word64 -> EVM t s () -> EVM t s ()
burn Word64
g_base (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$
            EVM t s ()
forall (t :: VMType) s. (?op::Word8) => EVM t s ()
next EVM t s () -> EVM t s () -> EVM t s ()
forall a b.
StateT (VM t s) (ST s) a
-> StateT (VM t s) (ST s) b -> StateT (VM t s) (ST s) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Expr 'EWord -> EVM t s ()
forall (t :: VMType) s. Expr 'EWord -> EVM t s ()
pushSym (ContractCode -> Expr 'EWord
codelen VM t s
vm.state.code)

        GenericOp Word8
OpCodecopy ->
          case [Expr 'EWord]
stk of
            Expr 'EWord
memOffset:Expr 'EWord
codeOffset:Expr 'EWord
n:[Expr 'EWord]
xs ->
              Expr 'EWord -> EVM t s () -> EVM t s ()
forall s. Expr 'EWord -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EWord -> EVM t s () -> EVM t s ()
burnCodecopy Expr 'EWord
n (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ do
                Expr 'EWord -> Expr 'EWord -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EWord -> Expr 'EWord -> EVM t s () -> EVM t s ()
accessMemoryRange Expr 'EWord
memOffset Expr 'EWord
n (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ do
                  EVM t s ()
forall (t :: VMType) s. (?op::Word8) => EVM t s ()
next
                  Optic' A_Lens '[] (VM t s) [Expr 'EWord]
-> [Expr 'EWord] -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     [Expr 'EWord]
     [Expr 'EWord]
-> Optic' A_Lens '[] (VM t s) [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  [Expr 'EWord]
  [Expr 'EWord]
#stack) [Expr 'EWord]
xs
                  case ContractCode -> Maybe (Expr 'Buf)
toBuf VM t s
vm.state.code of
                    Just Expr 'Buf
b -> Expr 'Buf
-> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM t s ()
forall (t :: VMType) s.
Expr 'Buf
-> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM t s ()
copyBytesToMemory Expr 'Buf
b Expr 'EWord
n Expr 'EWord
codeOffset Expr 'EWord
memOffset
                    Maybe (Expr 'Buf)
Nothing -> [Char] -> EVM t s ()
forall a. HasCallStack => [Char] -> a
internalError [Char]
"Cannot produce a buffer from UnknownCode"
            [Expr 'EWord]
_ -> EVM t s ()
forall (t :: VMType) s. VMOps t => EVM t s ()
underrun

        GenericOp Word8
OpGasprice ->
          Int -> EVM t s () -> EVM t s ()
forall (t :: VMType) s. VMOps t => Int -> EVM t s () -> EVM t s ()
limitStack Int
1 (EVM t s () -> EVM t s ())
-> (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Word64 -> EVM t s () -> EVM t s ()
burn Word64
g_base (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$
            EVM t s ()
forall (t :: VMType) s. (?op::Word8) => EVM t s ()
next EVM t s () -> EVM t s () -> EVM t s ()
forall a b.
StateT (VM t s) (ST s) a
-> StateT (VM t s) (ST s) b -> StateT (VM t s) (ST s) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> W256 -> EVM t s ()
forall (t :: VMType) s. W256 -> EVM t s ()
push VM t s
vm.tx.gasprice

        GenericOp Word8
OpExtcodesize ->
          case [Expr 'EWord]
stk of
            Expr 'EWord
x':[Expr 'EWord]
xs -> Expr 'EWord -> [Char] -> (Expr 'EAddr -> EVM t s ()) -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EWord -> [Char] -> (Expr 'EAddr -> EVM t s ()) -> EVM t s ()
forceAddr Expr 'EWord
x' [Char]
"EXTCODESIZE" ((Expr 'EAddr -> EVM t s ()) -> EVM t s ())
-> (Expr 'EAddr -> EVM t s ()) -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ \Expr 'EAddr
x -> do
              let impl :: EVM t s ()
impl = Expr 'EAddr -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EAddr -> EVM t s () -> EVM t s ()
accessAndBurn Expr 'EAddr
x (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$
                           Expr 'EAddr -> (Contract -> EVM t s ()) -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EAddr -> (Contract -> EVM t s ()) -> EVM t s ()
fetchAccount Expr 'EAddr
x ((Contract -> EVM t s ()) -> EVM t s ())
-> (Contract -> EVM t s ()) -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ \Contract
c -> do
                             EVM t s ()
forall (t :: VMType) s. (?op::Word8) => EVM t s ()
next
                             Optic' A_Lens '[] (VM t s) [Expr 'EWord]
-> [Expr 'EWord] -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     [Expr 'EWord]
     [Expr 'EWord]
-> Optic' A_Lens '[] (VM t s) [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  [Expr 'EWord]
  [Expr 'EWord]
#stack) [Expr 'EWord]
xs
                             case Getter Contract (Maybe (Expr 'Buf))
-> Contract -> Maybe (Expr 'Buf)
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Getter Contract (Maybe (Expr 'Buf))
bytecode Contract
c of
                               Just Expr 'Buf
b -> Expr 'EWord -> EVM t s ()
forall (t :: VMType) s. Expr 'EWord -> EVM t s ()
pushSym (Expr 'Buf -> Expr 'EWord
bufLength Expr 'Buf
b)
                               Maybe (Expr 'Buf)
Nothing -> Expr 'EWord -> EVM t s ()
forall (t :: VMType) s. Expr 'EWord -> EVM t s ()
pushSym (Expr 'EWord -> EVM t s ()) -> Expr 'EWord -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ Expr 'EAddr -> Expr 'EWord
CodeSize Expr 'EAddr
x
              case Expr 'EAddr
x of
                a :: Expr 'EAddr
a@(LitAddr Addr
_) -> if Expr 'EAddr
a Expr 'EAddr -> Expr 'EAddr -> Bool
forall a. Eq a => a -> a -> Bool
== Expr 'EAddr
cheatCode
                  then do
                    EVM t s ()
forall (t :: VMType) s. (?op::Word8) => EVM t s ()
next
                    Optic' A_Lens '[] (VM t s) [Expr 'EWord]
-> [Expr 'EWord] -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     [Expr 'EWord]
     [Expr 'EWord]
-> Optic' A_Lens '[] (VM t s) [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  [Expr 'EWord]
  [Expr 'EWord]
#stack) [Expr 'EWord]
xs
                    Expr 'EWord -> EVM t s ()
forall (t :: VMType) s. Expr 'EWord -> EVM t s ()
pushSym (W256 -> Expr 'EWord
Lit W256
1)
                  else EVM t s ()
impl
                Expr 'EAddr
_ -> EVM t s ()
impl
            [] ->
              EVM t s ()
forall (t :: VMType) s. VMOps t => EVM t s ()
underrun

        GenericOp Word8
OpExtcodecopy ->
          case [Expr 'EWord]
stk of
            Expr 'EWord
extAccount':Expr 'EWord
memOffset:Expr 'EWord
codeOffset:Expr 'EWord
codeSize:[Expr 'EWord]
xs ->
              Expr 'EWord -> [Char] -> (Expr 'EAddr -> EVM t s ()) -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EWord -> [Char] -> (Expr 'EAddr -> EVM t s ()) -> EVM t s ()
forceAddr Expr 'EWord
extAccount' [Char]
"EXTCODECOPY" ((Expr 'EAddr -> EVM t s ()) -> EVM t s ())
-> (Expr 'EAddr -> EVM t s ()) -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ \Expr 'EAddr
extAccount -> do
                Expr 'EAddr -> Expr 'EWord -> EVM t s () -> EVM t s ()
forall s. Expr 'EAddr -> Expr 'EWord -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EAddr -> Expr 'EWord -> EVM t s () -> EVM t s ()
burnExtcodecopy Expr 'EAddr
extAccount Expr 'EWord
codeSize (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$
                  Expr 'EWord -> Expr 'EWord -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EWord -> Expr 'EWord -> EVM t s () -> EVM t s ()
accessMemoryRange Expr 'EWord
memOffset Expr 'EWord
codeSize (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$
                    Expr 'EAddr -> (Contract -> EVM t s ()) -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EAddr -> (Contract -> EVM t s ()) -> EVM t s ()
fetchAccount Expr 'EAddr
extAccount ((Contract -> EVM t s ()) -> EVM t s ())
-> (Contract -> EVM t s ()) -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ \Contract
c -> do
                      EVM t s ()
forall (t :: VMType) s. (?op::Word8) => EVM t s ()
next
                      Optic' A_Lens '[] (VM t s) [Expr 'EWord]
-> [Expr 'EWord] -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     [Expr 'EWord]
     [Expr 'EWord]
-> Optic' A_Lens '[] (VM t s) [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  [Expr 'EWord]
  [Expr 'EWord]
#stack) [Expr 'EWord]
xs
                      case Getter Contract (Maybe (Expr 'Buf))
-> Contract -> Maybe (Expr 'Buf)
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Getter Contract (Maybe (Expr 'Buf))
bytecode Contract
c of
                        Just Expr 'Buf
b -> Expr 'Buf
-> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM t s ()
forall (t :: VMType) s.
Expr 'Buf
-> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM t s ()
copyBytesToMemory Expr 'Buf
b Expr 'EWord
codeSize Expr 'EWord
codeOffset Expr 'EWord
memOffset
                        Maybe (Expr 'Buf)
Nothing -> do
                          Int
pc <- Optic' A_Lens '[] (VM t s) Int -> StateT (VM t s) (ST s) Int
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic A_Lens '[] (FrameState t s) (FrameState t s) Int Int
-> Optic' A_Lens '[] (VM t s) Int
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens '[] (FrameState t s) (FrameState t s) Int Int
#pc)
                          PartialExec -> EVM t s ()
forall s. PartialExec -> EVM t s ()
forall (t :: VMType) s. VMOps t => PartialExec -> EVM t s ()
partial (PartialExec -> EVM t s ()) -> PartialExec -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ Int -> [Char] -> [SomeExpr] -> PartialExec
UnexpectedSymbolicArg Int
pc [Char]
"Cannot copy from unknown code at" ([Expr 'EAddr] -> [SomeExpr]
forall (a :: EType). Typeable a => [Expr a] -> [SomeExpr]
wrap [Expr 'EAddr
extAccount])
            [Expr 'EWord]
_ -> EVM t s ()
forall (t :: VMType) s. VMOps t => EVM t s ()
underrun

        GenericOp Word8
OpReturndatasize ->
          Int -> EVM t s () -> EVM t s ()
forall (t :: VMType) s. VMOps t => Int -> EVM t s () -> EVM t s ()
limitStack Int
1 (EVM t s () -> EVM t s ())
-> (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Word64 -> EVM t s () -> EVM t s ()
burn Word64
g_base (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$
            EVM t s ()
forall (t :: VMType) s. (?op::Word8) => EVM t s ()
next EVM t s () -> EVM t s () -> EVM t s ()
forall a b.
StateT (VM t s) (ST s) a
-> StateT (VM t s) (ST s) b -> StateT (VM t s) (ST s) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Expr 'EWord -> EVM t s ()
forall (t :: VMType) s. Expr 'EWord -> EVM t s ()
pushSym (Expr 'Buf -> Expr 'EWord
bufLength VM t s
vm.state.returndata)

        GenericOp Word8
OpReturndatacopy ->
          case [Expr 'EWord]
stk of
            Expr 'EWord
xTo:Expr 'EWord
xFrom:Expr 'EWord
xSize:[Expr 'EWord]
xs ->
              Expr 'EWord -> EVM t s () -> EVM t s ()
forall s. Expr 'EWord -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EWord -> EVM t s () -> EVM t s ()
burnReturndatacopy Expr 'EWord
xSize (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$
                Expr 'EWord -> Expr 'EWord -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EWord -> Expr 'EWord -> EVM t s () -> EVM t s ()
accessMemoryRange Expr 'EWord
xTo Expr 'EWord
xSize (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ do
                  EVM t s ()
forall (t :: VMType) s. (?op::Word8) => EVM t s ()
next
                  Optic' A_Lens '[] (VM t s) [Expr 'EWord]
-> [Expr 'EWord] -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     [Expr 'EWord]
     [Expr 'EWord]
-> Optic' A_Lens '[] (VM t s) [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  [Expr 'EWord]
  [Expr 'EWord]
#stack) [Expr 'EWord]
xs

                  let jump :: Bool -> EVM t s ()
jump Bool
True = EvmError -> EVM t s ()
forall (t :: VMType) s. VMOps t => EvmError -> EVM t s ()
vmError EvmError
ReturnDataOutOfBounds
                      jump Bool
False = Expr 'Buf
-> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM t s ()
forall (t :: VMType) s.
Expr 'Buf
-> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM t s ()
copyBytesToMemory VM t s
vm.state.returndata Expr 'EWord
xSize Expr 'EWord
xFrom Expr 'EWord
xTo

                  case (Expr 'EWord
xFrom, Expr 'Buf -> Expr 'EWord
bufLength VM t s
vm.state.returndata, Expr 'EWord
xSize) of
                    (Lit W256
f, Lit W256
l, Lit W256
sz) ->
                      Bool -> EVM t s ()
jump (Bool -> EVM t s ()) -> Bool -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ W256
l W256 -> W256 -> Bool
forall a. Ord a => a -> a -> Bool
< W256
f W256 -> W256 -> W256
forall a. Num a => a -> a -> a
+ W256
sz Bool -> Bool -> Bool
|| W256
f W256 -> W256 -> W256
forall a. Num a => a -> a -> a
+ W256
sz W256 -> W256 -> Bool
forall a. Ord a => a -> a -> Bool
< W256
f
                    (Expr 'EWord, Expr 'EWord, Expr 'EWord)
_ -> do
                      let oob :: Expr 'EWord
oob = Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.lt (Expr 'Buf -> Expr 'EWord
bufLength VM t s
vm.state.returndata) (Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.add Expr 'EWord
xFrom Expr 'EWord
xSize)
                          overflow :: Expr 'EWord
overflow = Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.lt (Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.add Expr 'EWord
xFrom Expr 'EWord
xSize) (Expr 'EWord
xFrom)
                      Expr 'EWord -> (Bool -> EVM t s ()) -> EVM t s ()
forall s. Expr 'EWord -> (Bool -> EVM t s ()) -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EWord -> (Bool -> EVM t s ()) -> EVM t s ()
branch (Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.or Expr 'EWord
oob Expr 'EWord
overflow) Bool -> EVM t s ()
jump
            [Expr 'EWord]
_ -> EVM t s ()
forall (t :: VMType) s. VMOps t => EVM t s ()
underrun

        GenericOp Word8
OpExtcodehash ->
          case [Expr 'EWord]
stk of
            Expr 'EWord
x':[Expr 'EWord]
xs -> Expr 'EWord -> [Char] -> (Expr 'EAddr -> EVM t s ()) -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EWord -> [Char] -> (Expr 'EAddr -> EVM t s ()) -> EVM t s ()
forceAddr Expr 'EWord
x' [Char]
"EXTCODEHASH" ((Expr 'EAddr -> EVM t s ()) -> EVM t s ())
-> (Expr 'EAddr -> EVM t s ()) -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ \Expr 'EAddr
x ->
              Expr 'EAddr -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EAddr -> EVM t s () -> EVM t s ()
accessAndBurn Expr 'EAddr
x (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ do
                EVM t s ()
forall (t :: VMType) s. (?op::Word8) => EVM t s ()
next
                Optic' A_Lens '[] (VM t s) [Expr 'EWord]
-> [Expr 'EWord] -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     [Expr 'EWord]
     [Expr 'EWord]
-> Optic' A_Lens '[] (VM t s) [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  [Expr 'EWord]
  [Expr 'EWord]
#stack) [Expr 'EWord]
xs
                Expr 'EAddr -> (Contract -> EVM t s ()) -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EAddr -> (Contract -> EVM t s ()) -> EVM t s ()
fetchAccount Expr 'EAddr
x ((Contract -> EVM t s ()) -> EVM t s ())
-> (Contract -> EVM t s ()) -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ \Contract
c ->
                   if Contract -> Bool
accountEmpty Contract
c
                     then W256 -> EVM t s ()
forall (t :: VMType) s. W256 -> EVM t s ()
push (Word256 -> W256
W256 Word256
0)
                     else case Getter Contract (Maybe (Expr 'Buf))
-> Contract -> Maybe (Expr 'Buf)
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Getter Contract (Maybe (Expr 'Buf))
bytecode Contract
c of
                            Just Expr 'Buf
b -> Expr 'EWord -> EVM t s ()
forall (t :: VMType) s. Expr 'EWord -> EVM t s ()
pushSym (Expr 'EWord -> EVM t s ()) -> Expr 'EWord -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ Expr 'Buf -> Expr 'EWord
keccak Expr 'Buf
b
                            Maybe (Expr 'Buf)
Nothing -> Expr 'EWord -> EVM t s ()
forall (t :: VMType) s. Expr 'EWord -> EVM t s ()
pushSym (Expr 'EWord -> EVM t s ()) -> Expr 'EWord -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ Expr 'EAddr -> Expr 'EWord
CodeHash Expr 'EAddr
x
            [] ->
              EVM t s ()
forall (t :: VMType) s. VMOps t => EVM t s ()
underrun

        GenericOp Word8
OpBlockhash -> do
          -- We adopt the fake block hash scheme of the VMTests,
          -- so that blockhash(i) is the hash of i as decimal ASCII.
          Word64 -> (Expr 'EWord -> Expr 'EWord) -> EVM t s ()
forall (t :: VMType) s.
(?op::Word8, VMOps t) =>
Word64 -> (Expr 'EWord -> Expr 'EWord) -> EVM t s ()
stackOp1 Word64
g_blockhash ((Expr 'EWord -> Expr 'EWord) -> EVM t s ())
-> (Expr 'EWord -> Expr 'EWord) -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ \case
            Lit W256
i -> if W256
i W256 -> W256 -> W256
forall a. Num a => a -> a -> a
+ W256
256 W256 -> W256 -> Bool
forall a. Ord a => a -> a -> Bool
< VM t s
vm.block.number Bool -> Bool -> Bool
|| W256
i W256 -> W256 -> Bool
forall a. Ord a => a -> a -> Bool
>= VM t s
vm.block.number
                     then W256 -> Expr 'EWord
Lit W256
0
                     else (W256 -> Integer
forall target source. From source target => source -> target
into W256
i :: Integer) Integer -> (Integer -> [Char]) -> [Char]
forall a b. a -> (a -> b) -> b
& Integer -> [Char]
forall a. Show a => a -> [Char]
show [Char] -> ([Char] -> ByteString) -> ByteString
forall a b. a -> (a -> b) -> b
& [Char] -> ByteString
Char8.pack ByteString -> (ByteString -> W256) -> W256
forall a b. a -> (a -> b) -> b
& ByteString -> W256
keccak' W256 -> (W256 -> Expr 'EWord) -> Expr 'EWord
forall a b. a -> (a -> b) -> b
& W256 -> Expr 'EWord
Lit
            Expr 'EWord
i -> Expr 'EWord -> Expr 'EWord
BlockHash Expr 'EWord
i

        GenericOp Word8
OpCoinbase ->
          Int -> EVM t s () -> EVM t s ()
forall (t :: VMType) s. VMOps t => Int -> EVM t s () -> EVM t s ()
limitStack Int
1 (EVM t s () -> EVM t s ())
-> (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Word64 -> EVM t s () -> EVM t s ()
burn Word64
g_base (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$
            EVM t s ()
forall (t :: VMType) s. (?op::Word8) => EVM t s ()
next EVM t s () -> EVM t s () -> EVM t s ()
forall a b.
StateT (VM t s) (ST s) a
-> StateT (VM t s) (ST s) b -> StateT (VM t s) (ST s) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Expr 'EAddr -> EVM t s ()
forall (t :: VMType) s. Expr 'EAddr -> EVM t s ()
pushAddr VM t s
vm.block.coinbase

        GenericOp Word8
OpTimestamp ->
          Int -> EVM t s () -> EVM t s ()
forall (t :: VMType) s. VMOps t => Int -> EVM t s () -> EVM t s ()
limitStack Int
1 (EVM t s () -> EVM t s ())
-> (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Word64 -> EVM t s () -> EVM t s ()
burn Word64
g_base (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$
            EVM t s ()
forall (t :: VMType) s. (?op::Word8) => EVM t s ()
next EVM t s () -> EVM t s () -> EVM t s ()
forall a b.
StateT (VM t s) (ST s) a
-> StateT (VM t s) (ST s) b -> StateT (VM t s) (ST s) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Expr 'EWord -> EVM t s ()
forall (t :: VMType) s. Expr 'EWord -> EVM t s ()
pushSym VM t s
vm.block.timestamp

        GenericOp Word8
OpNumber ->
          Int -> EVM t s () -> EVM t s ()
forall (t :: VMType) s. VMOps t => Int -> EVM t s () -> EVM t s ()
limitStack Int
1 (EVM t s () -> EVM t s ())
-> (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Word64 -> EVM t s () -> EVM t s ()
burn Word64
g_base (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$
            EVM t s ()
forall (t :: VMType) s. (?op::Word8) => EVM t s ()
next EVM t s () -> EVM t s () -> EVM t s ()
forall a b.
StateT (VM t s) (ST s) a
-> StateT (VM t s) (ST s) b -> StateT (VM t s) (ST s) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> W256 -> EVM t s ()
forall (t :: VMType) s. W256 -> EVM t s ()
push VM t s
vm.block.number

        GenericOp Word8
OpPrevRandao -> do
          Int -> EVM t s () -> EVM t s ()
forall (t :: VMType) s. VMOps t => Int -> EVM t s () -> EVM t s ()
limitStack Int
1 (EVM t s () -> EVM t s ())
-> (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Word64 -> EVM t s () -> EVM t s ()
burn Word64
g_base (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$
            EVM t s ()
forall (t :: VMType) s. (?op::Word8) => EVM t s ()
next EVM t s () -> EVM t s () -> EVM t s ()
forall a b.
StateT (VM t s) (ST s) a
-> StateT (VM t s) (ST s) b -> StateT (VM t s) (ST s) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> W256 -> EVM t s ()
forall (t :: VMType) s. W256 -> EVM t s ()
push VM t s
vm.block.prevRandao

        GenericOp Word8
OpGaslimit ->
          Int -> EVM t s () -> EVM t s ()
forall (t :: VMType) s. VMOps t => Int -> EVM t s () -> EVM t s ()
limitStack Int
1 (EVM t s () -> EVM t s ())
-> (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Word64 -> EVM t s () -> EVM t s ()
burn Word64
g_base (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$
            EVM t s ()
forall (t :: VMType) s. (?op::Word8) => EVM t s ()
next EVM t s () -> EVM t s () -> EVM t s ()
forall a b.
StateT (VM t s) (ST s) a
-> StateT (VM t s) (ST s) b -> StateT (VM t s) (ST s) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> W256 -> EVM t s ()
forall (t :: VMType) s. W256 -> EVM t s ()
push (Word64 -> W256
forall target source. From source target => source -> target
into VM t s
vm.block.gaslimit)

        GenericOp Word8
OpChainid ->
          Int -> EVM t s () -> EVM t s ()
forall (t :: VMType) s. VMOps t => Int -> EVM t s () -> EVM t s ()
limitStack Int
1 (EVM t s () -> EVM t s ())
-> (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Word64 -> EVM t s () -> EVM t s ()
burn Word64
g_base (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$
            EVM t s ()
forall (t :: VMType) s. (?op::Word8) => EVM t s ()
next EVM t s () -> EVM t s () -> EVM t s ()
forall a b.
StateT (VM t s) (ST s) a
-> StateT (VM t s) (ST s) b -> StateT (VM t s) (ST s) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> W256 -> EVM t s ()
forall (t :: VMType) s. W256 -> EVM t s ()
push VM t s
vm.env.chainId

        GenericOp Word8
OpSelfbalance ->
          Int -> EVM t s () -> EVM t s ()
forall (t :: VMType) s. VMOps t => Int -> EVM t s () -> EVM t s ()
limitStack Int
1 (EVM t s () -> EVM t s ())
-> (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Word64 -> EVM t s () -> EVM t s ()
burn Word64
g_low (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$
            EVM t s ()
forall (t :: VMType) s. (?op::Word8) => EVM t s ()
next EVM t s () -> EVM t s () -> EVM t s ()
forall a b.
StateT (VM t s) (ST s) a
-> StateT (VM t s) (ST s) b -> StateT (VM t s) (ST s) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Expr 'EWord -> EVM t s ()
forall (t :: VMType) s. Expr 'EWord -> EVM t s ()
pushSym Contract
this.balance

        GenericOp Word8
OpBaseFee ->
          Int -> EVM t s () -> EVM t s ()
forall (t :: VMType) s. VMOps t => Int -> EVM t s () -> EVM t s ()
limitStack Int
1 (EVM t s () -> EVM t s ())
-> (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Word64 -> EVM t s () -> EVM t s ()
burn Word64
g_base (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$
            EVM t s ()
forall (t :: VMType) s. (?op::Word8) => EVM t s ()
next EVM t s () -> EVM t s () -> EVM t s ()
forall a b.
StateT (VM t s) (ST s) a
-> StateT (VM t s) (ST s) b -> StateT (VM t s) (ST s) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> W256 -> EVM t s ()
forall (t :: VMType) s. W256 -> EVM t s ()
push VM t s
vm.block.baseFee

        GenericOp Word8
OpPop ->
          case [Expr 'EWord]
stk of
            Expr 'EWord
_:[Expr 'EWord]
xs -> Word64 -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Word64 -> EVM t s () -> EVM t s ()
burn Word64
g_base (EVM t s ()
forall (t :: VMType) s. (?op::Word8) => EVM t s ()
next EVM t s () -> EVM t s () -> EVM t s ()
forall a b.
StateT (VM t s) (ST s) a
-> StateT (VM t s) (ST s) b -> StateT (VM t s) (ST s) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Optic' A_Lens '[] (VM t s) [Expr 'EWord]
-> [Expr 'EWord] -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     [Expr 'EWord]
     [Expr 'EWord]
-> Optic' A_Lens '[] (VM t s) [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  [Expr 'EWord]
  [Expr 'EWord]
#stack) [Expr 'EWord]
xs)
            [Expr 'EWord]
_    -> EVM t s ()
forall (t :: VMType) s. VMOps t => EVM t s ()
underrun

        GenericOp Word8
OpMload ->
          case [Expr 'EWord]
stk of
            Expr 'EWord
x:[Expr 'EWord]
xs ->
              Word64 -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Word64 -> EVM t s () -> EVM t s ()
burn Word64
g_verylow (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$
                Expr 'EWord -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EWord -> EVM t s () -> EVM t s ()
accessMemoryWord Expr 'EWord
x (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ do
                  EVM t s ()
forall (t :: VMType) s. (?op::Word8) => EVM t s ()
next
                  Expr 'Buf
buf <- Expr 'EWord -> Expr 'EWord -> StateT (VM t s) (ST s) (Expr 'Buf)
forall (t :: VMType) s.
Expr 'EWord -> Expr 'EWord -> EVM t s (Expr 'Buf)
readMemory Expr 'EWord
x (W256 -> Expr 'EWord
Lit W256
32)
                  let w :: Expr 'EWord
w = Expr 'EWord -> Expr 'Buf -> Expr 'EWord
Expr.readWordFromBytes (W256 -> Expr 'EWord
Lit W256
0) Expr 'Buf
buf
                  Optic' A_Lens '[] (VM t s) [Expr 'EWord]
-> [Expr 'EWord] -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     [Expr 'EWord]
     [Expr 'EWord]
-> Optic' A_Lens '[] (VM t s) [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  [Expr 'EWord]
  [Expr 'EWord]
#stack) (Expr 'EWord
w Expr 'EWord -> [Expr 'EWord] -> [Expr 'EWord]
forall a. a -> [a] -> [a]
: [Expr 'EWord]
xs)
            [Expr 'EWord]
_ -> EVM t s ()
forall (t :: VMType) s. VMOps t => EVM t s ()
underrun

        GenericOp Word8
OpMstore ->
          case [Expr 'EWord]
stk of
            Expr 'EWord
x:Expr 'EWord
y:[Expr 'EWord]
xs ->
              Word64 -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Word64 -> EVM t s () -> EVM t s ()
burn Word64
g_verylow (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$
                Expr 'EWord -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EWord -> EVM t s () -> EVM t s ()
accessMemoryWord Expr 'EWord
x (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ do
                  EVM t s ()
forall (t :: VMType) s. (?op::Word8) => EVM t s ()
next
                  (VM t s -> Memory s) -> StateT (VM t s) (ST s) (Memory s)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (.state.memory) StateT (VM t s) (ST s) (Memory s)
-> (Memory s -> EVM t s ()) -> EVM t s ()
forall a b.
StateT (VM t s) (ST s) a
-> (a -> StateT (VM t s) (ST s) b) -> StateT (VM t s) (ST s) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                    ConcreteMemory MutableMemory s
mem -> do
                      case Expr 'EWord
y of
                        Lit W256
w ->
                          Expr 'Buf
-> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM t s ()
forall (t :: VMType) s.
Expr 'Buf
-> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM t s ()
copyBytesToMemory (ByteString -> Expr 'Buf
ConcreteBuf (W256 -> ByteString
word256Bytes W256
w)) (W256 -> Expr 'EWord
Lit W256
32) (W256 -> Expr 'EWord
Lit W256
0) Expr 'EWord
x
                        Expr 'EWord
_ -> do
                          -- copy out and move to symbolic memory
                          Expr 'Buf
buf <- MutableMemory s -> StateT (VM t s) (ST s) (Expr 'Buf)
forall s (t :: VMType). MutableMemory s -> EVM t s (Expr 'Buf)
freezeMemory MutableMemory s
mem
                          Optic A_Lens '[] (VM t s) (VM t s) (Memory s) (Memory s)
-> Memory s -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens '[] (FrameState t s) (FrameState t s) (Memory s) (Memory s)
-> Optic A_Lens '[] (VM t s) (VM t s) (Memory s) (Memory s)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens '[] (FrameState t s) (FrameState t s) (Memory s) (Memory s)
#memory) (Expr 'Buf -> Memory s
forall s. Expr 'Buf -> Memory s
SymbolicMemory (Expr 'Buf -> Memory s) -> Expr 'Buf -> Memory s
forall a b. (a -> b) -> a -> b
$ Expr 'EWord -> Expr 'EWord -> Expr 'Buf -> Expr 'Buf
writeWord Expr 'EWord
x Expr 'EWord
y Expr 'Buf
buf)
                    SymbolicMemory Expr 'Buf
mem ->
                      Optic A_Lens '[] (VM t s) (VM t s) (Memory s) (Memory s)
-> Memory s -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens '[] (FrameState t s) (FrameState t s) (Memory s) (Memory s)
-> Optic A_Lens '[] (VM t s) (VM t s) (Memory s) (Memory s)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens '[] (FrameState t s) (FrameState t s) (Memory s) (Memory s)
#memory) (Expr 'Buf -> Memory s
forall s. Expr 'Buf -> Memory s
SymbolicMemory (Expr 'Buf -> Memory s) -> Expr 'Buf -> Memory s
forall a b. (a -> b) -> a -> b
$ Expr 'EWord -> Expr 'EWord -> Expr 'Buf -> Expr 'Buf
writeWord Expr 'EWord
x Expr 'EWord
y Expr 'Buf
mem)
                  Optic' A_Lens '[] (VM t s) [Expr 'EWord]
-> [Expr 'EWord] -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     [Expr 'EWord]
     [Expr 'EWord]
-> Optic' A_Lens '[] (VM t s) [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  [Expr 'EWord]
  [Expr 'EWord]
#stack) [Expr 'EWord]
xs
            [Expr 'EWord]
_ -> EVM t s ()
forall (t :: VMType) s. VMOps t => EVM t s ()
underrun

        GenericOp Word8
OpMstore8 ->
          case [Expr 'EWord]
stk of
            Expr 'EWord
x:Expr 'EWord
y:[Expr 'EWord]
xs ->
              Word64 -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Word64 -> EVM t s () -> EVM t s ()
burn Word64
g_verylow (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$
                Expr 'EWord -> Expr 'EWord -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EWord -> Expr 'EWord -> EVM t s () -> EVM t s ()
accessMemoryRange Expr 'EWord
x (W256 -> Expr 'EWord
Lit W256
1) (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ do
                  let yByte :: Expr 'Byte
yByte = Expr 'EWord -> Expr 'EWord -> Expr 'Byte
indexWord (W256 -> Expr 'EWord
Lit W256
31) Expr 'EWord
y
                  EVM t s ()
forall (t :: VMType) s. (?op::Word8) => EVM t s ()
next
                  (VM t s -> Memory s) -> StateT (VM t s) (ST s) (Memory s)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (.state.memory) StateT (VM t s) (ST s) (Memory s)
-> (Memory s -> EVM t s ()) -> EVM t s ()
forall a b.
StateT (VM t s) (ST s) a
-> (a -> StateT (VM t s) (ST s) b) -> StateT (VM t s) (ST s) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                    ConcreteMemory MutableMemory s
mem -> do
                      case Expr 'Byte
yByte of
                        LitByte Word8
byte ->
                          Expr 'Buf
-> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM t s ()
forall (t :: VMType) s.
Expr 'Buf
-> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM t s ()
copyBytesToMemory (ByteString -> Expr 'Buf
ConcreteBuf ([Word8] -> ByteString
BS.pack [Word8
byte])) (W256 -> Expr 'EWord
Lit W256
1) (W256 -> Expr 'EWord
Lit W256
0) Expr 'EWord
x
                        Expr 'Byte
_ -> do
                          -- copy out and move to symbolic memory
                          Expr 'Buf
buf <- MutableMemory s -> StateT (VM t s) (ST s) (Expr 'Buf)
forall s (t :: VMType). MutableMemory s -> EVM t s (Expr 'Buf)
freezeMemory MutableMemory s
mem
                          Optic A_Lens '[] (VM t s) (VM t s) (Memory s) (Memory s)
-> Memory s -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens '[] (FrameState t s) (FrameState t s) (Memory s) (Memory s)
-> Optic A_Lens '[] (VM t s) (VM t s) (Memory s) (Memory s)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens '[] (FrameState t s) (FrameState t s) (Memory s) (Memory s)
#memory) (Expr 'Buf -> Memory s
forall s. Expr 'Buf -> Memory s
SymbolicMemory (Expr 'Buf -> Memory s) -> Expr 'Buf -> Memory s
forall a b. (a -> b) -> a -> b
$ Expr 'EWord -> Expr 'Byte -> Expr 'Buf -> Expr 'Buf
writeByte Expr 'EWord
x Expr 'Byte
yByte Expr 'Buf
buf)
                    SymbolicMemory Expr 'Buf
mem ->
                      Optic A_Lens '[] (VM t s) (VM t s) (Memory s) (Memory s)
-> Memory s -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens '[] (FrameState t s) (FrameState t s) (Memory s) (Memory s)
-> Optic A_Lens '[] (VM t s) (VM t s) (Memory s) (Memory s)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens '[] (FrameState t s) (FrameState t s) (Memory s) (Memory s)
#memory) (Expr 'Buf -> Memory s
forall s. Expr 'Buf -> Memory s
SymbolicMemory (Expr 'Buf -> Memory s) -> Expr 'Buf -> Memory s
forall a b. (a -> b) -> a -> b
$ Expr 'EWord -> Expr 'Byte -> Expr 'Buf -> Expr 'Buf
writeByte Expr 'EWord
x Expr 'Byte
yByte Expr 'Buf
mem)

                  Optic' A_Lens '[] (VM t s) [Expr 'EWord]
-> [Expr 'EWord] -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     [Expr 'EWord]
     [Expr 'EWord]
-> Optic' A_Lens '[] (VM t s) [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  [Expr 'EWord]
  [Expr 'EWord]
#stack) [Expr 'EWord]
xs
            [Expr 'EWord]
_ -> EVM t s ()
forall (t :: VMType) s. VMOps t => EVM t s ()
underrun

        GenericOp Word8
OpSload ->
          case [Expr 'EWord]
stk of
            Expr 'EWord
x:[Expr 'EWord]
xs -> do
              Bool
acc <- Expr 'EAddr -> Expr 'EWord -> EVM t s Bool
forall (t :: VMType) s. Expr 'EAddr -> Expr 'EWord -> EVM t s Bool
accessStorageForGas Expr 'EAddr
self Expr 'EWord
x
              let cost :: Word64
cost = if Bool
acc then Word64
g_warm_storage_read else Word64
g_cold_sload
              Word64 -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Word64 -> EVM t s () -> EVM t s ()
burn Word64
cost (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$
                Expr 'EAddr
-> Expr 'EWord -> (Expr 'EWord -> EVM t s ()) -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EAddr
-> Expr 'EWord -> (Expr 'EWord -> EVM t s ()) -> EVM t s ()
accessStorage Expr 'EAddr
self Expr 'EWord
x ((Expr 'EWord -> EVM t s ()) -> EVM t s ())
-> (Expr 'EWord -> EVM t s ()) -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ \Expr 'EWord
y -> do
                  EVM t s ()
forall (t :: VMType) s. (?op::Word8) => EVM t s ()
next
                  Optic' A_Lens '[] (VM t s) [Expr 'EWord]
-> [Expr 'EWord] -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     [Expr 'EWord]
     [Expr 'EWord]
-> Optic' A_Lens '[] (VM t s) [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  [Expr 'EWord]
  [Expr 'EWord]
#stack) (Expr 'EWord
yExpr 'EWord -> [Expr 'EWord] -> [Expr 'EWord]
forall a. a -> [a] -> [a]
:[Expr 'EWord]
xs)
            [Expr 'EWord]
_ -> EVM t s ()
forall (t :: VMType) s. VMOps t => EVM t s ()
underrun

        GenericOp Word8
OpSstore ->
          EVM t s () -> EVM t s ()
forall (t :: VMType) s. VMOps t => EVM t s () -> EVM t s ()
notStatic (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$
          case [Expr 'EWord]
stk of
            Expr 'EWord
x:Expr 'EWord
new:[Expr 'EWord]
xs ->
              Expr 'EAddr
-> Expr 'EWord -> (Expr 'EWord -> EVM t s ()) -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EAddr
-> Expr 'EWord -> (Expr 'EWord -> EVM t s ()) -> EVM t s ()
accessStorage Expr 'EAddr
self Expr 'EWord
x ((Expr 'EWord -> EVM t s ()) -> EVM t s ())
-> (Expr 'EWord -> EVM t s ()) -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ \Expr 'EWord
current -> do
                Word64 -> EVM t s () -> EVM t s ()
forall s. Word64 -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Word64 -> EVM t s () -> EVM t s ()
ensureGas Word64
g_callstipend (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ do
                  let
                    original :: W256
original =
                      case Expr 'EWord -> Expr 'EWord
forall (a :: EType). Expr a -> Expr a
Expr.concKeccakSimpExpr (Expr 'EWord -> Expr 'EWord) -> Expr 'EWord -> Expr 'EWord
forall a b. (a -> b) -> a -> b
$ Expr 'EWord -> Expr 'Storage -> Expr 'EWord
SLoad Expr 'EWord
x Contract
this.origStorage of
                        Lit W256
v -> W256
v
                        Expr 'EWord
_ -> W256
0
                    storage_cost :: Word64
storage_cost =
                      case (Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
current, Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
new) of
                        (Just W256
current', Just W256
new') ->
                           if (W256
current' W256 -> W256 -> Bool
forall a. Eq a => a -> a -> Bool
== W256
new') then Word64
g_sload
                           else if (W256
current' W256 -> W256 -> Bool
forall a. Eq a => a -> a -> Bool
== W256
original) Bool -> Bool -> Bool
&& (W256
original W256 -> W256 -> Bool
forall a. Eq a => a -> a -> Bool
== W256
0) then Word64
g_sset
                           else if (W256
current' W256 -> W256 -> Bool
forall a. Eq a => a -> a -> Bool
== W256
original) then Word64
g_sreset
                           else Word64
g_sload

                        -- if any of the arguments are symbolic,
                        -- assume worst case scenario
                        (Maybe W256, Maybe W256)
_-> Word64
g_sset

                  Bool
acc <- Expr 'EAddr -> Expr 'EWord -> EVM t s Bool
forall (t :: VMType) s. Expr 'EAddr -> Expr 'EWord -> EVM t s Bool
accessStorageForGas Expr 'EAddr
self Expr 'EWord
x
                  let cold_storage_cost :: Word64
cold_storage_cost = if Bool
acc then Word64
0 else Word64
g_cold_sload
                  Word64 -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Word64 -> EVM t s () -> EVM t s ()
burn (Word64
storage_cost Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
cold_storage_cost) (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ do
                    EVM t s ()
forall (t :: VMType) s. (?op::Word8) => EVM t s ()
next
                    Optic' A_Lens '[] (VM t s) [Expr 'EWord]
-> [Expr 'EWord] -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     [Expr 'EWord]
     [Expr 'EWord]
-> Optic' A_Lens '[] (VM t s) [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  [Expr 'EWord]
  [Expr 'EWord]
#stack) [Expr 'EWord]
xs
                    Optic
  An_AffineTraversal
  '[]
  (VM t s)
  (VM t s)
  (Expr 'Storage)
  (Expr 'Storage)
-> (Expr 'Storage -> Expr 'Storage) -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying (Optic A_Lens '[] (VM t s) (VM t s) Env Env
#env Optic A_Lens '[] (VM t s) (VM t s) Env Env
-> Optic
     A_Lens
     '[]
     Env
     Env
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
-> Optic
     A_Lens
     '[]
     (VM t s)
     (VM t s)
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  Env
  Env
  (Map (Expr 'EAddr) Contract)
  (Map (Expr 'EAddr) Contract)
#contracts Optic
  A_Lens
  '[]
  (VM t s)
  (VM t s)
  (Map (Expr 'EAddr) Contract)
  (Map (Expr 'EAddr) Contract)
-> Optic
     (IxKind (Map (Expr 'EAddr) Contract))
     '[]
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
     (IxValue (Map (Expr 'EAddr) Contract))
     (IxValue (Map (Expr 'EAddr) Contract))
-> Optic
     An_AffineTraversal
     '[]
     (VM t s)
     (VM t s)
     (IxValue (Map (Expr 'EAddr) Contract))
     (IxValue (Map (Expr 'EAddr) Contract))
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Index (Map (Expr 'EAddr) Contract)
-> Optic
     (IxKind (Map (Expr 'EAddr) Contract))
     '[]
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
     (IxValue (Map (Expr 'EAddr) Contract))
     (IxValue (Map (Expr 'EAddr) Contract))
forall m. Ixed m => Index m -> Optic' (IxKind m) '[] m (IxValue m)
ix Index (Map (Expr 'EAddr) Contract)
Expr 'EAddr
self Optic
  An_AffineTraversal
  '[]
  (VM t s)
  (VM t s)
  (IxValue (Map (Expr 'EAddr) Contract))
  (IxValue (Map (Expr 'EAddr) Contract))
-> Optic
     A_Lens
     '[]
     (IxValue (Map (Expr 'EAddr) Contract))
     (IxValue (Map (Expr 'EAddr) Contract))
     (Expr 'Storage)
     (Expr 'Storage)
-> Optic
     An_AffineTraversal
     '[]
     (VM t s)
     (VM t s)
     (Expr 'Storage)
     (Expr 'Storage)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (IxValue (Map (Expr 'EAddr) Contract))
  (IxValue (Map (Expr 'EAddr) Contract))
  (Expr 'Storage)
  (Expr 'Storage)
#storage) (Expr 'EWord -> Expr 'EWord -> Expr 'Storage -> Expr 'Storage
writeStorage Expr 'EWord
x Expr 'EWord
new)

                    case (Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
current, Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
new) of
                       (Just W256
current', Just W256
new') ->
                          Bool -> EVM t s () -> EVM t s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (W256
current' W256 -> W256 -> Bool
forall a. Eq a => a -> a -> Bool
== W256
new') (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$
                            if W256
current' W256 -> W256 -> Bool
forall a. Eq a => a -> a -> Bool
== W256
original then
                              Bool -> EVM t s () -> EVM t s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (W256
original W256 -> W256 -> Bool
forall a. Eq a => a -> a -> Bool
/= W256
0 Bool -> Bool -> Bool
&& W256
new' W256 -> W256 -> Bool
forall a. Eq a => a -> a -> Bool
== W256
0) (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$
                                Word64 -> EVM t s ()
forall (t :: VMType) s. Word64 -> EVM t s ()
refund (Word64
g_sreset Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
g_access_list_storage_key)
                            else do
                              Bool -> EVM t s () -> EVM t s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (W256
original W256 -> W256 -> Bool
forall a. Eq a => a -> a -> Bool
/= W256
0) (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$
                                if W256
current' W256 -> W256 -> Bool
forall a. Eq a => a -> a -> Bool
== W256
0
                                then Word64 -> EVM t s ()
forall (t :: VMType) s. Word64 -> EVM t s ()
unRefund (Word64
g_sreset Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
g_access_list_storage_key)
                                else Bool -> EVM t s () -> EVM t s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (W256
new' W256 -> W256 -> Bool
forall a. Eq a => a -> a -> Bool
== W256
0) (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ Word64 -> EVM t s ()
forall (t :: VMType) s. Word64 -> EVM t s ()
refund (Word64
g_sreset Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
g_access_list_storage_key)
                              Bool -> EVM t s () -> EVM t s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (W256
original W256 -> W256 -> Bool
forall a. Eq a => a -> a -> Bool
== W256
new') (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$
                                if W256
original W256 -> W256 -> Bool
forall a. Eq a => a -> a -> Bool
== W256
0
                                then Word64 -> EVM t s ()
forall (t :: VMType) s. Word64 -> EVM t s ()
refund (Word64
g_sset Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
g_sload)
                                else Word64 -> EVM t s ()
forall (t :: VMType) s. Word64 -> EVM t s ()
refund (Word64
g_sreset Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
g_sload)
                       -- if any of the arguments are symbolic,
                       -- don't change the refund counter
                       (Maybe W256, Maybe W256)
_ -> EVM t s ()
forall (m :: * -> *). Monad m => m ()
noop
            [Expr 'EWord]
_ -> EVM t s ()
forall (t :: VMType) s. VMOps t => EVM t s ()
underrun

        GenericOp Word8
OpJump ->
          case [Expr 'EWord]
stk of
            Expr 'EWord
x:[Expr 'EWord]
xs ->
              Word64 -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Word64 -> EVM t s () -> EVM t s ()
burn Word64
g_mid (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ Expr 'EWord -> [Char] -> (W256 -> EVM t s ()) -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EWord -> [Char] -> (W256 -> EVM t s ()) -> EVM t s ()
forceConcrete Expr 'EWord
x [Char]
"JUMP: symbolic jumpdest" ((W256 -> EVM t s ()) -> EVM t s ())
-> (W256 -> EVM t s ()) -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ \W256
x' ->
                case W256 -> Maybe Int
toInt W256
x' of
                  Maybe Int
Nothing -> EvmError -> EVM t s ()
forall (t :: VMType) s. VMOps t => EvmError -> EVM t s ()
vmError EvmError
BadJumpDestination
                  Just Int
i -> Int -> [Expr 'EWord] -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Int -> [Expr 'EWord] -> EVM t s ()
checkJump Int
i [Expr 'EWord]
xs
            [Expr 'EWord]
_ -> EVM t s ()
forall (t :: VMType) s. VMOps t => EVM t s ()
underrun

        GenericOp Word8
OpJumpi ->
          case [Expr 'EWord]
stk of
            Expr 'EWord
x:Expr 'EWord
y:[Expr 'EWord]
xs -> Expr 'EWord -> [Char] -> (W256 -> EVM t s ()) -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EWord -> [Char] -> (W256 -> EVM t s ()) -> EVM t s ()
forceConcrete Expr 'EWord
x [Char]
"JUMPI: symbolic jumpdest" ((W256 -> EVM t s ()) -> EVM t s ())
-> (W256 -> EVM t s ()) -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ \W256
x' ->
              Word64 -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Word64 -> EVM t s () -> EVM t s ()
burn Word64
g_high (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$
                let jump :: Bool -> EVM t s ()
                    jump :: Bool -> EVM t s ()
jump Bool
False = Optic' A_Lens '[] (VM t s) [Expr 'EWord]
-> [Expr 'EWord] -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     [Expr 'EWord]
     [Expr 'EWord]
-> Optic' A_Lens '[] (VM t s) [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  [Expr 'EWord]
  [Expr 'EWord]
#stack) [Expr 'EWord]
xs EVM t s () -> EVM t s () -> EVM t s ()
forall a b.
StateT (VM t s) (ST s) a
-> StateT (VM t s) (ST s) b -> StateT (VM t s) (ST s) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EVM t s ()
forall (t :: VMType) s. (?op::Word8) => EVM t s ()
next
                    jump Bool
_    = case W256 -> Maybe Int
toInt W256
x' of
                      Maybe Int
Nothing -> EvmError -> EVM t s ()
forall (t :: VMType) s. VMOps t => EvmError -> EVM t s ()
vmError EvmError
BadJumpDestination
                      Just Int
i -> Int -> [Expr 'EWord] -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Int -> [Expr 'EWord] -> EVM t s ()
checkJump Int
i [Expr 'EWord]
xs
                in Expr 'EWord -> (Bool -> EVM t s ()) -> EVM t s ()
forall s. Expr 'EWord -> (Bool -> EVM t s ()) -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EWord -> (Bool -> EVM t s ()) -> EVM t s ()
branch Expr 'EWord
y Bool -> EVM t s ()
jump
            [Expr 'EWord]
_ -> EVM t s ()
forall (t :: VMType) s. VMOps t => EVM t s ()
underrun

        GenericOp Word8
OpPc ->
          Int -> EVM t s () -> EVM t s ()
forall (t :: VMType) s. VMOps t => Int -> EVM t s () -> EVM t s ()
limitStack Int
1 (EVM t s () -> EVM t s ())
-> (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Word64 -> EVM t s () -> EVM t s ()
burn Word64
g_base (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$
            EVM t s ()
forall (t :: VMType) s. (?op::Word8) => EVM t s ()
next EVM t s () -> EVM t s () -> EVM t s ()
forall a b.
StateT (VM t s) (ST s) a
-> StateT (VM t s) (ST s) b -> StateT (VM t s) (ST s) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> W256 -> EVM t s ()
forall (t :: VMType) s. W256 -> EVM t s ()
push (Int -> W256
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto VM t s
vm.state.pc)

        GenericOp Word8
OpMsize ->
          Int -> EVM t s () -> EVM t s ()
forall (t :: VMType) s. VMOps t => Int -> EVM t s () -> EVM t s ()
limitStack Int
1 (EVM t s () -> EVM t s ())
-> (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Word64 -> EVM t s () -> EVM t s ()
burn Word64
g_base (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$
            EVM t s ()
forall (t :: VMType) s. (?op::Word8) => EVM t s ()
next EVM t s () -> EVM t s () -> EVM t s ()
forall a b.
StateT (VM t s) (ST s) a
-> StateT (VM t s) (ST s) b -> StateT (VM t s) (ST s) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> W256 -> EVM t s ()
forall (t :: VMType) s. W256 -> EVM t s ()
push (Word64 -> W256
forall target source. From source target => source -> target
into VM t s
vm.state.memorySize)

        GenericOp Word8
OpGas ->
          Int -> EVM t s () -> EVM t s ()
forall (t :: VMType) s. VMOps t => Int -> EVM t s () -> EVM t s ()
limitStack Int
1 (EVM t s () -> EVM t s ())
-> (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Word64 -> EVM t s () -> EVM t s ()
burn Word64
g_base (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$
            EVM t s ()
forall (t :: VMType) s. (?op::Word8) => EVM t s ()
next EVM t s () -> EVM t s () -> EVM t s ()
forall a b.
StateT (VM t s) (ST s) a
-> StateT (VM t s) (ST s) b -> StateT (VM t s) (ST s) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EVM t s ()
forall {s}. EVM t s ()
forall (t :: VMType) s. VMOps t => EVM t s ()
pushGas

        GenericOp Word8
OpJumpdest -> Word64 -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Word64 -> EVM t s () -> EVM t s ()
burn Word64
g_jumpdest EVM t s ()
forall (t :: VMType) s. (?op::Word8) => EVM t s ()
next

        GenericOp Word8
OpExp ->
          -- NOTE: this can be done symbolically using unrolling like this:
          --       https://hackage.haskell.org/package/sbv-9.0/docs/src/Data.SBV.Core.Model.html#.%5E
          --       However, it requires symbolic gas, since the gas depends on the exponent
          case [Expr 'EWord]
stk of
            Expr 'EWord
base:Expr 'EWord
exponent:[Expr 'EWord]
xs ->
              Expr 'EWord -> EVM t s () -> EVM t s ()
forall s. Expr 'EWord -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EWord -> EVM t s () -> EVM t s ()
burnExp Expr 'EWord
exponent (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ do
                EVM t s ()
forall (t :: VMType) s. (?op::Word8) => EVM t s ()
next
                (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     [Expr 'EWord]
     [Expr 'EWord]
-> Optic' A_Lens '[] (VM t s) [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  [Expr 'EWord]
  [Expr 'EWord]
#stack) Optic' A_Lens '[] (VM t s) [Expr 'EWord]
-> [Expr 'EWord] -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
.= Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.exp Expr 'EWord
base Expr 'EWord
exponent Expr 'EWord -> [Expr 'EWord] -> [Expr 'EWord]
forall a. a -> [a] -> [a]
: [Expr 'EWord]
xs
            [Expr 'EWord]
_ -> EVM t s ()
forall (t :: VMType) s. VMOps t => EVM t s ()
underrun

        GenericOp Word8
OpSignextend -> Word64 -> (Expr 'EWord -> Expr 'EWord -> Expr 'EWord) -> EVM t s ()
forall (t :: VMType) s.
(?op::Word8, VMOps t) =>
Word64 -> (Expr 'EWord -> Expr 'EWord -> Expr 'EWord) -> EVM t s ()
stackOp2 Word64
g_low Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.sex

        GenericOp Word8
OpCreate ->
          EVM t s () -> EVM t s ()
forall (t :: VMType) s. VMOps t => EVM t s () -> EVM t s ()
notStatic (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$
          case [Expr 'EWord]
stk of
            Expr 'EWord
xValue:Expr 'EWord
xOffset:Expr 'EWord
xSize:[Expr 'EWord]
xs ->
              Expr 'EWord -> Expr 'EWord -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EWord -> Expr 'EWord -> EVM t s () -> EVM t s ()
accessMemoryRange Expr 'EWord
xOffset Expr 'EWord
xSize (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ do
                Gas t
availableGas <- Optic' A_Lens '[] (VM t s) (Gas t)
-> StateT (VM t s) (ST s) (Gas t)
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens '[] (FrameState t s) (FrameState t s) (Gas t) (Gas t)
-> Optic' A_Lens '[] (VM t s) (Gas t)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens '[] (FrameState t s) (FrameState t s) (Gas t) (Gas t)
#gas)
                let
                  (Gas t
cost, Gas t
gas') = FeeSchedule Word64
-> Gas t -> Expr 'EWord -> Bool -> (Gas t, Gas t)
forall (t :: VMType).
VMOps t =>
FeeSchedule Word64
-> Gas t -> Expr 'EWord -> Bool -> (Gas t, Gas t)
costOfCreate FeeSchedule Word64
fees Gas t
availableGas Expr 'EWord
xSize Bool
False
                Expr 'EAddr
newAddr <- Expr 'EAddr -> Maybe W64 -> EVM t s (Expr 'EAddr)
forall (t :: VMType) s.
Expr 'EAddr -> Maybe W64 -> EVM t s (Expr 'EAddr)
createAddress Expr 'EAddr
self Contract
this.nonce
                Bool
_ <- Expr 'EAddr -> EVM t s Bool
forall (t :: VMType) s. Expr 'EAddr -> EVM t s Bool
accessAccountForGas Expr 'EAddr
newAddr
                Gas t -> EVM t s () -> EVM t s ()
forall s. Gas t -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Gas t -> EVM t s () -> EVM t s ()
burn' Gas t
cost (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ do
                  Expr 'Buf
initCode <- Expr 'EWord -> Expr 'EWord -> StateT (VM t s) (ST s) (Expr 'Buf)
forall (t :: VMType) s.
Expr 'EWord -> Expr 'EWord -> EVM t s (Expr 'Buf)
readMemory Expr 'EWord
xOffset Expr 'EWord
xSize
                  Expr 'EAddr
-> Contract
-> Expr 'EWord
-> Gas t
-> Expr 'EWord
-> [Expr 'EWord]
-> Expr 'EAddr
-> Expr 'Buf
-> EVM t s ()
forall (t :: VMType) s.
(?op::Word8, VMOps t) =>
Expr 'EAddr
-> Contract
-> Expr 'EWord
-> Gas t
-> Expr 'EWord
-> [Expr 'EWord]
-> Expr 'EAddr
-> Expr 'Buf
-> EVM t s ()
create Expr 'EAddr
self Contract
this Expr 'EWord
xSize Gas t
gas' Expr 'EWord
xValue [Expr 'EWord]
xs Expr 'EAddr
newAddr Expr 'Buf
initCode
            [Expr 'EWord]
_ -> EVM t s ()
forall (t :: VMType) s. VMOps t => EVM t s ()
underrun

        GenericOp Word8
OpCall ->
          case [Expr 'EWord]
stk of
            Expr 'EWord
xGas:Expr 'EWord
xTo':Expr 'EWord
xValue:Expr 'EWord
xInOffset:Expr 'EWord
xInSize:Expr 'EWord
xOutOffset:Expr 'EWord
xOutSize:[Expr 'EWord]
xs ->
              Expr 'EWord -> (Bool -> EVM t s ()) -> EVM t s ()
forall s. Expr 'EWord -> (Bool -> EVM t s ()) -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EWord -> (Bool -> EVM t s ()) -> EVM t s ()
branch (Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.gt Expr 'EWord
xValue (W256 -> Expr 'EWord
Lit W256
0)) ((Bool -> EVM t s ()) -> EVM t s ())
-> (Bool -> EVM t s ()) -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ \Bool
gt0 -> do
                (if Bool
gt0 then EVM t s () -> EVM t s ()
forall (t :: VMType) s. VMOps t => EVM t s () -> EVM t s ()
notStatic else EVM t s () -> EVM t s ()
forall a. a -> a
id) (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$
                  Expr 'EWord -> [Char] -> (Expr 'EAddr -> EVM t s ()) -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EWord -> [Char] -> (Expr 'EAddr -> EVM t s ()) -> EVM t s ()
forceAddr Expr 'EWord
xTo' [Char]
"unable to determine a call target" ((Expr 'EAddr -> EVM t s ()) -> EVM t s ())
-> (Expr 'EAddr -> EVM t s ()) -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ \Expr 'EAddr
xTo ->
                    case Expr 'EWord -> Either () (Gas t)
forall (t :: VMType). VMOps t => Expr 'EWord -> Either () (Gas t)
gasTryFrom Expr 'EWord
xGas of
                      Left ()
_ -> EvmError -> EVM t s ()
forall (t :: VMType) s. VMOps t => EvmError -> EVM t s ()
vmError EvmError
IllegalOverflow
                      Right Gas t
gas ->
                        Contract
-> Gas t
-> Expr 'EAddr
-> Expr 'EAddr
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> [Expr 'EWord]
-> (Expr 'EAddr -> EVM t s ())
-> EVM t s ()
forall (t :: VMType) s.
(VMOps t, ?op::Word8) =>
Contract
-> Gas t
-> Expr 'EAddr
-> Expr 'EAddr
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> [Expr 'EWord]
-> (Expr 'EAddr -> EVM t s ())
-> EVM t s ()
delegateCall Contract
this Gas t
gas Expr 'EAddr
xTo Expr 'EAddr
xTo Expr 'EWord
xValue Expr 'EWord
xInOffset Expr 'EWord
xInSize Expr 'EWord
xOutOffset Expr 'EWord
xOutSize [Expr 'EWord]
xs ((Expr 'EAddr -> EVM t s ()) -> EVM t s ())
-> (Expr 'EAddr -> EVM t s ()) -> EVM t s ()
forall a b. (a -> b) -> a -> b
$
                          \Expr 'EAddr
callee -> do
                            let from' :: Expr 'EAddr
from' = Expr 'EAddr -> Maybe (Expr 'EAddr) -> Expr 'EAddr
forall a. a -> Maybe a -> a
fromMaybe Expr 'EAddr
self VM t s
vm.config.overrideCaller
                            Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> StateT (FrameState t s) (ST s) () -> EVM t s ()
forall k (is :: IxList) c.
Is k A_Lens =>
Optic' k is (VM t s) (FrameState t s)
-> StateT (FrameState t s) (ST s) c -> StateT (VM t s) (ST s) c
forall (m :: * -> *) (n :: * -> *) s t k (is :: IxList) c.
(Zoom m n s t, Is k A_Lens) =>
Optic' k is t s -> m c -> n c
zoom Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state (StateT (FrameState t s) (ST s) () -> EVM t s ())
-> StateT (FrameState t s) (ST s) () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ do
                              Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  (Expr 'EWord)
  (Expr 'EWord)
-> Expr 'EWord -> StateT (FrameState t s) (ST s) ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  (Expr 'EWord)
  (Expr 'EWord)
#callvalue Expr 'EWord
xValue
                              Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  (Expr 'EAddr)
  (Expr 'EAddr)
-> Expr 'EAddr -> StateT (FrameState t s) (ST s) ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  (Expr 'EAddr)
  (Expr 'EAddr)
#caller Expr 'EAddr
from'
                              Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  (Expr 'EAddr)
  (Expr 'EAddr)
-> Expr 'EAddr -> StateT (FrameState t s) (ST s) ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  (Expr 'EAddr)
  (Expr 'EAddr)
#contract Expr 'EAddr
callee
                            Optic
  A_Lens
  '[]
  (VM t s)
  (VM t s)
  (Maybe (Expr 'EAddr))
  (Maybe (Expr 'EAddr))
-> Maybe (Expr 'EAddr) -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens '[] (VM t s) (VM t s) RuntimeConfig RuntimeConfig
#config Optic A_Lens '[] (VM t s) (VM t s) RuntimeConfig RuntimeConfig
-> Optic
     A_Lens
     '[]
     RuntimeConfig
     RuntimeConfig
     (Maybe (Expr 'EAddr))
     (Maybe (Expr 'EAddr))
-> Optic
     A_Lens
     '[]
     (VM t s)
     (VM t s)
     (Maybe (Expr 'EAddr))
     (Maybe (Expr 'EAddr))
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  RuntimeConfig
  RuntimeConfig
  (Maybe (Expr 'EAddr))
  (Maybe (Expr 'EAddr))
#overrideCaller) Maybe (Expr 'EAddr)
forall a. Maybe a
Nothing
                            Expr 'EAddr -> EVM t s ()
forall (t :: VMType) s. Expr 'EAddr -> EVM t s ()
touchAccount Expr 'EAddr
from'
                            Expr 'EAddr -> EVM t s ()
forall (t :: VMType) s. Expr 'EAddr -> EVM t s ()
touchAccount Expr 'EAddr
callee
                            Expr 'EAddr -> Expr 'EAddr -> Expr 'EWord -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EAddr -> Expr 'EAddr -> Expr 'EWord -> EVM t s ()
transfer Expr 'EAddr
from' Expr 'EAddr
callee Expr 'EWord
xValue
            [Expr 'EWord]
_ ->
              EVM t s ()
forall (t :: VMType) s. VMOps t => EVM t s ()
underrun

        GenericOp Word8
OpCallcode ->
          case [Expr 'EWord]
stk of
            Expr 'EWord
xGas:Expr 'EWord
xTo':Expr 'EWord
xValue:Expr 'EWord
xInOffset:Expr 'EWord
xInSize:Expr 'EWord
xOutOffset:Expr 'EWord
xOutSize:[Expr 'EWord]
xs ->
              Expr 'EWord -> [Char] -> (Expr 'EAddr -> EVM t s ()) -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EWord -> [Char] -> (Expr 'EAddr -> EVM t s ()) -> EVM t s ()
forceAddr Expr 'EWord
xTo' [Char]
"unable to determine a call target" ((Expr 'EAddr -> EVM t s ()) -> EVM t s ())
-> (Expr 'EAddr -> EVM t s ()) -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ \Expr 'EAddr
xTo ->
                case Expr 'EWord -> Either () (Gas t)
forall (t :: VMType). VMOps t => Expr 'EWord -> Either () (Gas t)
gasTryFrom Expr 'EWord
xGas of
                  Left ()
_ -> EvmError -> EVM t s ()
forall (t :: VMType) s. VMOps t => EvmError -> EVM t s ()
vmError EvmError
IllegalOverflow
                  Right Gas t
gas ->
                    Contract
-> Gas t
-> Expr 'EAddr
-> Expr 'EAddr
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> [Expr 'EWord]
-> (Expr 'EAddr -> EVM t s ())
-> EVM t s ()
forall (t :: VMType) s.
(VMOps t, ?op::Word8) =>
Contract
-> Gas t
-> Expr 'EAddr
-> Expr 'EAddr
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> [Expr 'EWord]
-> (Expr 'EAddr -> EVM t s ())
-> EVM t s ()
delegateCall Contract
this Gas t
gas Expr 'EAddr
xTo Expr 'EAddr
self Expr 'EWord
xValue Expr 'EWord
xInOffset Expr 'EWord
xInSize Expr 'EWord
xOutOffset Expr 'EWord
xOutSize [Expr 'EWord]
xs ((Expr 'EAddr -> EVM t s ()) -> EVM t s ())
-> (Expr 'EAddr -> EVM t s ()) -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ \Expr 'EAddr
_ -> do
                      Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> StateT (FrameState t s) (ST s) () -> EVM t s ()
forall k (is :: IxList) c.
Is k A_Lens =>
Optic' k is (VM t s) (FrameState t s)
-> StateT (FrameState t s) (ST s) c -> StateT (VM t s) (ST s) c
forall (m :: * -> *) (n :: * -> *) s t k (is :: IxList) c.
(Zoom m n s t, Is k A_Lens) =>
Optic' k is t s -> m c -> n c
zoom Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state (StateT (FrameState t s) (ST s) () -> EVM t s ())
-> StateT (FrameState t s) (ST s) () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ do
                        Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  (Expr 'EWord)
  (Expr 'EWord)
-> Expr 'EWord -> StateT (FrameState t s) (ST s) ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  (Expr 'EWord)
  (Expr 'EWord)
#callvalue Expr 'EWord
xValue
                        Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  (Expr 'EAddr)
  (Expr 'EAddr)
-> Expr 'EAddr -> StateT (FrameState t s) (ST s) ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  (Expr 'EAddr)
  (Expr 'EAddr)
#caller (Expr 'EAddr -> StateT (FrameState t s) (ST s) ())
-> Expr 'EAddr -> StateT (FrameState t s) (ST s) ()
forall a b. (a -> b) -> a -> b
$ Expr 'EAddr -> Maybe (Expr 'EAddr) -> Expr 'EAddr
forall a. a -> Maybe a -> a
fromMaybe Expr 'EAddr
self VM t s
vm.config.overrideCaller
                      Optic
  A_Lens
  '[]
  (VM t s)
  (VM t s)
  (Maybe (Expr 'EAddr))
  (Maybe (Expr 'EAddr))
-> Maybe (Expr 'EAddr) -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens '[] (VM t s) (VM t s) RuntimeConfig RuntimeConfig
#config Optic A_Lens '[] (VM t s) (VM t s) RuntimeConfig RuntimeConfig
-> Optic
     A_Lens
     '[]
     RuntimeConfig
     RuntimeConfig
     (Maybe (Expr 'EAddr))
     (Maybe (Expr 'EAddr))
-> Optic
     A_Lens
     '[]
     (VM t s)
     (VM t s)
     (Maybe (Expr 'EAddr))
     (Maybe (Expr 'EAddr))
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  RuntimeConfig
  RuntimeConfig
  (Maybe (Expr 'EAddr))
  (Maybe (Expr 'EAddr))
#overrideCaller) Maybe (Expr 'EAddr)
forall a. Maybe a
Nothing
                      Expr 'EAddr -> EVM t s ()
forall (t :: VMType) s. Expr 'EAddr -> EVM t s ()
touchAccount Expr 'EAddr
self
            [Expr 'EWord]
_ ->
              EVM t s ()
forall (t :: VMType) s. VMOps t => EVM t s ()
underrun

        GenericOp Word8
OpReturn ->
          case [Expr 'EWord]
stk of
            Expr 'EWord
xOffset:Expr 'EWord
xSize:[Expr 'EWord]
_ ->
              Expr 'EWord -> Expr 'EWord -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EWord -> Expr 'EWord -> EVM t s () -> EVM t s ()
accessMemoryRange Expr 'EWord
xOffset Expr 'EWord
xSize (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ do
                Expr 'Buf
output <- Expr 'EWord -> Expr 'EWord -> StateT (VM t s) (ST s) (Expr 'Buf)
forall (t :: VMType) s.
Expr 'EWord -> Expr 'EWord -> EVM t s (Expr 'Buf)
readMemory Expr 'EWord
xOffset Expr 'EWord
xSize
                let
                  codesize :: W256
codesize = W256 -> Maybe W256 -> W256
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> W256
forall a. HasCallStack => [Char] -> a
internalError [Char]
"processing opcode RETURN. Cannot return dynamically sized abstract data")
                               (Maybe W256 -> W256)
-> (Expr 'Buf -> Maybe W256) -> Expr 'Buf -> W256
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr 'EWord -> Maybe W256
maybeLitWord (Expr 'EWord -> Maybe W256)
-> (Expr 'Buf -> Expr 'EWord) -> Expr 'Buf -> Maybe W256
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr 'Buf -> Expr 'EWord
bufLength (Expr 'Buf -> W256) -> Expr 'Buf -> W256
forall a b. (a -> b) -> a -> b
$ Expr 'Buf
output
                  maxsize :: W256
maxsize = VM t s
vm.block.maxCodeSize
                  creation :: Bool
creation = case VM t s
vm.frames of
                    [] -> VM t s
vm.tx.isCreate
                    Frame t s
frame:[Frame t s]
_ -> case Frame t s
frame.context of
                       CreationContext {} -> Bool
True
                       CallContext {} -> Bool
False
                if Bool
creation
                then
                  if W256
codesize W256 -> W256 -> Bool
forall a. Ord a => a -> a -> Bool
> W256
maxsize
                  then
                    FrameResult -> EVM t s ()
forall (t :: VMType) s. VMOps t => FrameResult -> EVM t s ()
finishFrame (EvmError -> FrameResult
FrameErrored (W256 -> W256 -> EvmError
MaxCodeSizeExceeded W256
maxsize W256
codesize))
                  else do
                    let frameReturned :: EVM t s ()
frameReturned = Word64 -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Word64 -> EVM t s () -> EVM t s ()
burn (Word64
g_codedeposit Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* W256 -> Word64
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto W256
codesize) (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$
                                          FrameResult -> EVM t s ()
forall (t :: VMType) s. VMOps t => FrameResult -> EVM t s ()
finishFrame (Expr 'Buf -> FrameResult
FrameReturned Expr 'Buf
output)
                        frameErrored :: EVM t s ()
frameErrored = FrameResult -> EVM t s ()
forall (t :: VMType) s. VMOps t => FrameResult -> EVM t s ()
finishFrame (FrameResult -> EVM t s ()) -> FrameResult -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ EvmError -> FrameResult
FrameErrored EvmError
InvalidFormat
                    case Expr 'EWord -> Expr 'Buf -> Expr 'Byte
readByte (W256 -> Expr 'EWord
Lit W256
0) Expr 'Buf
output of
                      LitByte Word8
0xef -> EVM t s ()
forall {s}. EVM t s ()
frameErrored
                      LitByte Word8
_ -> EVM t s ()
frameReturned
                      Expr 'Byte
y -> Expr 'EWord -> (Bool -> EVM t s ()) -> EVM t s ()
forall s. Expr 'EWord -> (Bool -> EVM t s ()) -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EWord -> (Bool -> EVM t s ()) -> EVM t s ()
branch (Expr 'Byte -> Expr 'Byte -> Expr 'EWord
Expr.eqByte Expr 'Byte
y (Word8 -> Expr 'Byte
LitByte Word8
0xef)) ((Bool -> EVM t s ()) -> EVM t s ())
-> (Bool -> EVM t s ()) -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ \case
                          Bool
True -> EVM t s ()
forall {s}. EVM t s ()
frameErrored
                          Bool
False -> EVM t s ()
frameReturned
                else
                   FrameResult -> EVM t s ()
forall (t :: VMType) s. VMOps t => FrameResult -> EVM t s ()
finishFrame (Expr 'Buf -> FrameResult
FrameReturned Expr 'Buf
output)
            [Expr 'EWord]
_ -> EVM t s ()
forall (t :: VMType) s. VMOps t => EVM t s ()
underrun

        GenericOp Word8
OpDelegatecall ->
          case [Expr 'EWord]
stk of
            Expr 'EWord
xGas:Expr 'EWord
xTo:Expr 'EWord
xInOffset:Expr 'EWord
xInSize:Expr 'EWord
xOutOffset:Expr 'EWord
xOutSize:[Expr 'EWord]
xs ->
              case Expr 'EWord -> Maybe (Expr 'EAddr)
wordToAddr Expr 'EWord
xTo of
                Maybe (Expr 'EAddr)
Nothing -> do
                  CodeLocation
loc <- EVM t s CodeLocation
forall (t :: VMType) s. EVM t s CodeLocation
codeloc
                  let msg :: [Char]
msg = [Char]
"Unable to determine a call target"
                  PartialExec -> EVM t s ()
forall s. PartialExec -> EVM t s ()
forall (t :: VMType) s. VMOps t => PartialExec -> EVM t s ()
partial (PartialExec -> EVM t s ()) -> PartialExec -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ Int -> [Char] -> [SomeExpr] -> PartialExec
UnexpectedSymbolicArg (CodeLocation -> Int
forall a b. (a, b) -> b
snd CodeLocation
loc) [Char]
msg [Expr 'EWord -> SomeExpr
forall (a :: EType). Typeable a => Expr a -> SomeExpr
SomeExpr Expr 'EWord
xTo]
                Just Expr 'EAddr
xTo' ->
                  case Expr 'EWord -> Either () (Gas t)
forall (t :: VMType). VMOps t => Expr 'EWord -> Either () (Gas t)
gasTryFrom Expr 'EWord
xGas of
                    Left ()
_ -> EvmError -> EVM t s ()
forall (t :: VMType) s. VMOps t => EvmError -> EVM t s ()
vmError EvmError
IllegalOverflow
                    Right Gas t
gas ->
                      Contract
-> Gas t
-> Expr 'EAddr
-> Expr 'EAddr
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> [Expr 'EWord]
-> (Expr 'EAddr -> EVM t s ())
-> EVM t s ()
forall (t :: VMType) s.
(VMOps t, ?op::Word8) =>
Contract
-> Gas t
-> Expr 'EAddr
-> Expr 'EAddr
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> [Expr 'EWord]
-> (Expr 'EAddr -> EVM t s ())
-> EVM t s ()
delegateCall Contract
this Gas t
gas Expr 'EAddr
xTo' Expr 'EAddr
self (W256 -> Expr 'EWord
Lit W256
0) Expr 'EWord
xInOffset Expr 'EWord
xInSize Expr 'EWord
xOutOffset Expr 'EWord
xOutSize [Expr 'EWord]
xs ((Expr 'EAddr -> EVM t s ()) -> EVM t s ())
-> (Expr 'EAddr -> EVM t s ()) -> EVM t s ()
forall a b. (a -> b) -> a -> b
$
                        \Expr 'EAddr
_ -> Expr 'EAddr -> EVM t s ()
forall (t :: VMType) s. Expr 'EAddr -> EVM t s ()
touchAccount Expr 'EAddr
self
            [Expr 'EWord]
_ -> EVM t s ()
forall (t :: VMType) s. VMOps t => EVM t s ()
underrun

        GenericOp Word8
OpCreate2 -> EVM t s () -> EVM t s ()
forall (t :: VMType) s. VMOps t => EVM t s () -> EVM t s ()
notStatic (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$
          case [Expr 'EWord]
stk of
            Expr 'EWord
xValue:Expr 'EWord
xOffset:Expr 'EWord
xSize:Expr 'EWord
xSalt':[Expr 'EWord]
xs ->
              Expr 'EWord -> [Char] -> (W256 -> EVM t s ()) -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EWord -> [Char] -> (W256 -> EVM t s ()) -> EVM t s ()
forceConcrete Expr 'EWord
xSalt' [Char]
"CREATE2" ((W256 -> EVM t s ()) -> EVM t s ())
-> (W256 -> EVM t s ()) -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ \(W256
xSalt) ->
                Expr 'EWord -> Expr 'EWord -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EWord -> Expr 'EWord -> EVM t s () -> EVM t s ()
accessMemoryRange Expr 'EWord
xOffset Expr 'EWord
xSize (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ do
                  Gas t
availableGas <- Optic' A_Lens '[] (VM t s) (Gas t)
-> StateT (VM t s) (ST s) (Gas t)
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens '[] (FrameState t s) (FrameState t s) (Gas t) (Gas t)
-> Optic' A_Lens '[] (VM t s) (Gas t)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens '[] (FrameState t s) (FrameState t s) (Gas t) (Gas t)
#gas)
                  Expr 'Buf
buf <- Expr 'EWord -> Expr 'EWord -> StateT (VM t s) (ST s) (Expr 'Buf)
forall (t :: VMType) s.
Expr 'EWord -> Expr 'EWord -> EVM t s (Expr 'Buf)
readMemory Expr 'EWord
xOffset Expr 'EWord
xSize
                  Expr 'Buf -> [Char] -> (ByteString -> EVM t s ()) -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'Buf -> [Char] -> (ByteString -> EVM t s ()) -> EVM t s ()
forceConcreteBuf Expr 'Buf
buf [Char]
"CREATE2" ((ByteString -> EVM t s ()) -> EVM t s ())
-> (ByteString -> EVM t s ()) -> EVM t s ()
forall a b. (a -> b) -> a -> b
$
                    \ByteString
initCode -> do
                      let
                        (Gas t
cost, Gas t
gas') = FeeSchedule Word64
-> Gas t -> Expr 'EWord -> Bool -> (Gas t, Gas t)
forall (t :: VMType).
VMOps t =>
FeeSchedule Word64
-> Gas t -> Expr 'EWord -> Bool -> (Gas t, Gas t)
costOfCreate FeeSchedule Word64
fees Gas t
availableGas Expr 'EWord
xSize Bool
True
                      Expr 'EAddr
newAddr <- Expr 'EAddr -> W256 -> ByteString -> EVM t s (Expr 'EAddr)
forall (t :: VMType) s.
Expr 'EAddr -> W256 -> ByteString -> EVM t s (Expr 'EAddr)
create2Address Expr 'EAddr
self W256
xSalt ByteString
initCode
                      Bool
_ <- Expr 'EAddr -> EVM t s Bool
forall (t :: VMType) s. Expr 'EAddr -> EVM t s Bool
accessAccountForGas Expr 'EAddr
newAddr
                      Gas t -> EVM t s () -> EVM t s ()
forall s. Gas t -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Gas t -> EVM t s () -> EVM t s ()
burn' Gas t
cost (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$
                        Expr 'EAddr
-> Contract
-> Expr 'EWord
-> Gas t
-> Expr 'EWord
-> [Expr 'EWord]
-> Expr 'EAddr
-> Expr 'Buf
-> EVM t s ()
forall (t :: VMType) s.
(?op::Word8, VMOps t) =>
Expr 'EAddr
-> Contract
-> Expr 'EWord
-> Gas t
-> Expr 'EWord
-> [Expr 'EWord]
-> Expr 'EAddr
-> Expr 'Buf
-> EVM t s ()
create Expr 'EAddr
self Contract
this Expr 'EWord
xSize Gas t
gas' Expr 'EWord
xValue [Expr 'EWord]
xs Expr 'EAddr
newAddr (ByteString -> Expr 'Buf
ConcreteBuf ByteString
initCode)
            [Expr 'EWord]
_ -> EVM t s ()
forall (t :: VMType) s. VMOps t => EVM t s ()
underrun

        GenericOp Word8
OpStaticcall ->
          case [Expr 'EWord]
stk of
            Expr 'EWord
xGas:Expr 'EWord
xTo:Expr 'EWord
xInOffset:Expr 'EWord
xInSize:Expr 'EWord
xOutOffset:Expr 'EWord
xOutSize:[Expr 'EWord]
xs ->
              case Expr 'EWord -> Maybe (Expr 'EAddr)
wordToAddr Expr 'EWord
xTo of
                Maybe (Expr 'EAddr)
Nothing -> do
                  CodeLocation
loc <- EVM t s CodeLocation
forall (t :: VMType) s. EVM t s CodeLocation
codeloc
                  let msg :: [Char]
msg = [Char]
"Unable to determine a call target"
                  PartialExec -> EVM t s ()
forall s. PartialExec -> EVM t s ()
forall (t :: VMType) s. VMOps t => PartialExec -> EVM t s ()
partial (PartialExec -> EVM t s ()) -> PartialExec -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ Int -> [Char] -> [SomeExpr] -> PartialExec
UnexpectedSymbolicArg (CodeLocation -> Int
forall a b. (a, b) -> b
snd CodeLocation
loc) [Char]
msg [Expr 'EWord -> SomeExpr
forall (a :: EType). Typeable a => Expr a -> SomeExpr
SomeExpr Expr 'EWord
xTo]
                Just Expr 'EAddr
xTo' ->
                  case Expr 'EWord -> Either () (Gas t)
forall (t :: VMType). VMOps t => Expr 'EWord -> Either () (Gas t)
gasTryFrom Expr 'EWord
xGas of
                    Left ()
_ -> EvmError -> EVM t s ()
forall (t :: VMType) s. VMOps t => EvmError -> EVM t s ()
vmError EvmError
IllegalOverflow
                    Right Gas t
gas ->
                      Contract
-> Gas t
-> Expr 'EAddr
-> Expr 'EAddr
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> [Expr 'EWord]
-> (Expr 'EAddr -> EVM t s ())
-> EVM t s ()
forall (t :: VMType) s.
(VMOps t, ?op::Word8) =>
Contract
-> Gas t
-> Expr 'EAddr
-> Expr 'EAddr
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> [Expr 'EWord]
-> (Expr 'EAddr -> EVM t s ())
-> EVM t s ()
delegateCall Contract
this Gas t
gas Expr 'EAddr
xTo' Expr 'EAddr
xTo' (W256 -> Expr 'EWord
Lit W256
0) Expr 'EWord
xInOffset Expr 'EWord
xInSize Expr 'EWord
xOutOffset Expr 'EWord
xOutSize [Expr 'EWord]
xs ((Expr 'EAddr -> EVM t s ()) -> EVM t s ())
-> (Expr 'EAddr -> EVM t s ()) -> EVM t s ()
forall a b. (a -> b) -> a -> b
$
                        \Expr 'EAddr
callee -> do
                          Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> StateT (FrameState t s) (ST s) () -> EVM t s ()
forall k (is :: IxList) c.
Is k A_Lens =>
Optic' k is (VM t s) (FrameState t s)
-> StateT (FrameState t s) (ST s) c -> StateT (VM t s) (ST s) c
forall (m :: * -> *) (n :: * -> *) s t k (is :: IxList) c.
(Zoom m n s t, Is k A_Lens) =>
Optic' k is t s -> m c -> n c
zoom Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state (StateT (FrameState t s) (ST s) () -> EVM t s ())
-> StateT (FrameState t s) (ST s) () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ do
                            Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  (Expr 'EWord)
  (Expr 'EWord)
-> Expr 'EWord -> StateT (FrameState t s) (ST s) ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  (Expr 'EWord)
  (Expr 'EWord)
#callvalue (W256 -> Expr 'EWord
Lit W256
0)
                            Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  (Expr 'EAddr)
  (Expr 'EAddr)
-> Expr 'EAddr -> StateT (FrameState t s) (ST s) ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  (Expr 'EAddr)
  (Expr 'EAddr)
#caller (Expr 'EAddr -> StateT (FrameState t s) (ST s) ())
-> Expr 'EAddr -> StateT (FrameState t s) (ST s) ()
forall a b. (a -> b) -> a -> b
$ Expr 'EAddr -> Maybe (Expr 'EAddr) -> Expr 'EAddr
forall a. a -> Maybe a -> a
fromMaybe Expr 'EAddr
self (VM t s
vm.config.overrideCaller)
                            Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  (Expr 'EAddr)
  (Expr 'EAddr)
-> Expr 'EAddr -> StateT (FrameState t s) (ST s) ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  (Expr 'EAddr)
  (Expr 'EAddr)
#contract Expr 'EAddr
callee
                            Optic A_Lens '[] (FrameState t s) (FrameState t s) Bool Bool
-> Bool -> StateT (FrameState t s) (ST s) ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign Optic A_Lens '[] (FrameState t s) (FrameState t s) Bool Bool
#static Bool
True
                          Optic
  A_Lens
  '[]
  (VM t s)
  (VM t s)
  (Maybe (Expr 'EAddr))
  (Maybe (Expr 'EAddr))
-> Maybe (Expr 'EAddr) -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens '[] (VM t s) (VM t s) RuntimeConfig RuntimeConfig
#config Optic A_Lens '[] (VM t s) (VM t s) RuntimeConfig RuntimeConfig
-> Optic
     A_Lens
     '[]
     RuntimeConfig
     RuntimeConfig
     (Maybe (Expr 'EAddr))
     (Maybe (Expr 'EAddr))
-> Optic
     A_Lens
     '[]
     (VM t s)
     (VM t s)
     (Maybe (Expr 'EAddr))
     (Maybe (Expr 'EAddr))
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  RuntimeConfig
  RuntimeConfig
  (Maybe (Expr 'EAddr))
  (Maybe (Expr 'EAddr))
#overrideCaller) Maybe (Expr 'EAddr)
forall a. Maybe a
Nothing
                          Expr 'EAddr -> EVM t s ()
forall (t :: VMType) s. Expr 'EAddr -> EVM t s ()
touchAccount Expr 'EAddr
self
                          Expr 'EAddr -> EVM t s ()
forall (t :: VMType) s. Expr 'EAddr -> EVM t s ()
touchAccount Expr 'EAddr
callee
            [Expr 'EWord]
_ ->
              EVM t s ()
forall (t :: VMType) s. VMOps t => EVM t s ()
underrun

        GenericOp Word8
OpSelfdestruct ->
          EVM t s () -> EVM t s ()
forall (t :: VMType) s. VMOps t => EVM t s () -> EVM t s ()
notStatic (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$
          case [Expr 'EWord]
stk of
            [] -> EVM t s ()
forall (t :: VMType) s. VMOps t => EVM t s ()
underrun
            (Expr 'EWord
xTo':[Expr 'EWord]
_) -> Expr 'EWord -> [Char] -> (Expr 'EAddr -> EVM t s ()) -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EWord -> [Char] -> (Expr 'EAddr -> EVM t s ()) -> EVM t s ()
forceAddr Expr 'EWord
xTo' [Char]
"SELFDESTRUCT" ((Expr 'EAddr -> EVM t s ()) -> EVM t s ())
-> (Expr 'EAddr -> EVM t s ()) -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ \case
              xTo :: Expr 'EAddr
xTo@(LitAddr Addr
_) -> do
                Bool
acc <- Expr 'EAddr -> EVM t s Bool
forall (t :: VMType) s. Expr 'EAddr -> EVM t s Bool
accessAccountForGas Expr 'EAddr
xTo
                let cost :: Word64
cost = if Bool
acc then Word64
0 else Word64
g_cold_account_access
                    funds :: Expr 'EWord
funds = Contract
this.balance
                    recipientExists :: Bool
recipientExists = Expr 'EAddr -> VM t s -> Bool
forall (t :: VMType) s. Expr 'EAddr -> VM t s -> Bool
accountExists Expr 'EAddr
xTo VM t s
vm
                Expr 'EWord -> (Bool -> EVM t s ()) -> EVM t s ()
forall s. Expr 'EWord -> (Bool -> EVM t s ()) -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EWord -> (Bool -> EVM t s ()) -> EVM t s ()
branch (Expr 'EWord -> Expr 'EWord
Expr.iszero (Expr 'EWord -> Expr 'EWord) -> Expr 'EWord -> Expr 'EWord
forall a b. (a -> b) -> a -> b
$ Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.eq Expr 'EWord
funds (W256 -> Expr 'EWord
Lit W256
0)) ((Bool -> EVM t s ()) -> EVM t s ())
-> (Bool -> EVM t s ()) -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ \Bool
hasFunds -> do
                  let c_new :: Word64
c_new = if (Bool -> Bool
not Bool
recipientExists) Bool -> Bool -> Bool
&& Bool
hasFunds
                              then Word64
g_selfdestruct_newaccount
                              else Word64
0
                  Word64 -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Word64 -> EVM t s () -> EVM t s ()
burn (Word64
g_selfdestruct Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
c_new Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
cost) (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ do
                    Expr 'EAddr -> EVM t s ()
forall (t :: VMType) s. Expr 'EAddr -> EVM t s ()
selfdestruct Expr 'EAddr
self
                    Expr 'EAddr -> EVM t s ()
forall (t :: VMType) s. Expr 'EAddr -> EVM t s ()
touchAccount Expr 'EAddr
xTo

                    if Bool
hasFunds
                    then Expr 'EAddr -> (Contract -> EVM t s ()) -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EAddr -> (Contract -> EVM t s ()) -> EVM t s ()
fetchAccount Expr 'EAddr
xTo ((Contract -> EVM t s ()) -> EVM t s ())
-> (Contract -> EVM t s ()) -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ \Contract
_ -> do
                           #env % #contracts % ix xTo % #balance %= (Expr.add funds)
                           assign (#env % #contracts % ix self % #balance) (Lit 0)
                           doStop
                    else do
                      EVM t s ()
forall {s}. EVM t s ()
doStop
              Expr 'EAddr
a -> do
                Int
pc <- Optic' A_Lens '[] (VM t s) Int -> StateT (VM t s) (ST s) Int
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic A_Lens '[] (FrameState t s) (FrameState t s) Int Int
-> Optic' A_Lens '[] (VM t s) Int
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens '[] (FrameState t s) (FrameState t s) Int Int
#pc)
                PartialExec -> EVM t s ()
forall s. PartialExec -> EVM t s ()
forall (t :: VMType) s. VMOps t => PartialExec -> EVM t s ()
partial (PartialExec -> EVM t s ()) -> PartialExec -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ Int -> [Char] -> [SomeExpr] -> PartialExec
UnexpectedSymbolicArg Int
pc [Char]
"trying to self destruct to a symbolic address" ([Expr 'EAddr] -> [SomeExpr]
forall (a :: EType). Typeable a => [Expr a] -> [SomeExpr]
wrap [Expr 'EAddr
a])

        GenericOp Word8
OpRevert ->
          case [Expr 'EWord]
stk of
            Expr 'EWord
xOffset:Expr 'EWord
xSize:[Expr 'EWord]
_ ->
              Expr 'EWord -> Expr 'EWord -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EWord -> Expr 'EWord -> EVM t s () -> EVM t s ()
accessMemoryRange Expr 'EWord
xOffset Expr 'EWord
xSize (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ do
                Expr 'Buf
output <- Expr 'EWord -> Expr 'EWord -> StateT (VM t s) (ST s) (Expr 'Buf)
forall (t :: VMType) s.
Expr 'EWord -> Expr 'EWord -> EVM t s (Expr 'Buf)
readMemory Expr 'EWord
xOffset Expr 'EWord
xSize
                FrameResult -> EVM t s ()
forall (t :: VMType) s. VMOps t => FrameResult -> EVM t s ()
finishFrame (Expr 'Buf -> FrameResult
FrameReverted Expr 'Buf
output)
            [Expr 'EWord]
_ -> EVM t s ()
forall (t :: VMType) s. VMOps t => EVM t s ()
underrun

        OpUnknown Word8
xxx ->
          EvmError -> EVM t s ()
forall (t :: VMType) s. VMOps t => EvmError -> EVM t s ()
vmError (EvmError -> EVM t s ()) -> EvmError -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ Word8 -> EvmError
UnrecognizedOpcode Word8
xxx

transfer :: VMOps t => Expr EAddr -> Expr EAddr -> Expr EWord -> EVM t s ()
transfer :: forall (t :: VMType) s.
VMOps t =>
Expr 'EAddr -> Expr 'EAddr -> Expr 'EWord -> EVM t s ()
transfer Expr 'EAddr
_ Expr 'EAddr
_ (Lit W256
0) = () -> StateT (VM t s) (ST s) ()
forall a. a -> StateT (VM t s) (ST s) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
transfer Expr 'EAddr
src Expr 'EAddr
dst Expr 'EWord
val = do
  Maybe (Expr 'EWord)
sb <- Optic' An_AffineTraversal '[] (VM t s) (Expr 'EWord)
-> StateT (VM t s) (ST s) (Maybe (Expr 'EWord))
forall k s (m :: * -> *) (is :: IxList) a.
(Is k An_AffineFold, MonadState s m) =>
Optic' k is s a -> m (Maybe a)
preuse (Optic' An_AffineTraversal '[] (VM t s) (Expr 'EWord)
 -> StateT (VM t s) (ST s) (Maybe (Expr 'EWord)))
-> Optic' An_AffineTraversal '[] (VM t s) (Expr 'EWord)
-> StateT (VM t s) (ST s) (Maybe (Expr 'EWord))
forall a b. (a -> b) -> a -> b
$ Optic A_Lens '[] (VM t s) (VM t s) Env Env
#env Optic A_Lens '[] (VM t s) (VM t s) Env Env
-> Optic
     A_Lens
     '[]
     Env
     Env
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
-> Optic
     A_Lens
     '[]
     (VM t s)
     (VM t s)
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  Env
  Env
  (Map (Expr 'EAddr) Contract)
  (Map (Expr 'EAddr) Contract)
#contracts Optic
  A_Lens
  '[]
  (VM t s)
  (VM t s)
  (Map (Expr 'EAddr) Contract)
  (Map (Expr 'EAddr) Contract)
-> Optic
     (IxKind (Map (Expr 'EAddr) Contract))
     '[]
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
     (IxValue (Map (Expr 'EAddr) Contract))
     (IxValue (Map (Expr 'EAddr) Contract))
-> Optic
     An_AffineTraversal
     '[]
     (VM t s)
     (VM t s)
     (IxValue (Map (Expr 'EAddr) Contract))
     (IxValue (Map (Expr 'EAddr) Contract))
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Index (Map (Expr 'EAddr) Contract)
-> Optic
     (IxKind (Map (Expr 'EAddr) Contract))
     '[]
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
     (IxValue (Map (Expr 'EAddr) Contract))
     (IxValue (Map (Expr 'EAddr) Contract))
forall m. Ixed m => Index m -> Optic' (IxKind m) '[] m (IxValue m)
ix Index (Map (Expr 'EAddr) Contract)
Expr 'EAddr
src Optic
  An_AffineTraversal
  '[]
  (VM t s)
  (VM t s)
  (IxValue (Map (Expr 'EAddr) Contract))
  (IxValue (Map (Expr 'EAddr) Contract))
-> Optic
     A_Lens
     '[]
     (IxValue (Map (Expr 'EAddr) Contract))
     (IxValue (Map (Expr 'EAddr) Contract))
     (Expr 'EWord)
     (Expr 'EWord)
-> Optic' An_AffineTraversal '[] (VM t s) (Expr 'EWord)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (IxValue (Map (Expr 'EAddr) Contract))
  (IxValue (Map (Expr 'EAddr) Contract))
  (Expr 'EWord)
  (Expr 'EWord)
#balance
  Maybe (Expr 'EWord)
db <- Optic' An_AffineTraversal '[] (VM t s) (Expr 'EWord)
-> StateT (VM t s) (ST s) (Maybe (Expr 'EWord))
forall k s (m :: * -> *) (is :: IxList) a.
(Is k An_AffineFold, MonadState s m) =>
Optic' k is s a -> m (Maybe a)
preuse (Optic' An_AffineTraversal '[] (VM t s) (Expr 'EWord)
 -> StateT (VM t s) (ST s) (Maybe (Expr 'EWord)))
-> Optic' An_AffineTraversal '[] (VM t s) (Expr 'EWord)
-> StateT (VM t s) (ST s) (Maybe (Expr 'EWord))
forall a b. (a -> b) -> a -> b
$ Optic A_Lens '[] (VM t s) (VM t s) Env Env
#env Optic A_Lens '[] (VM t s) (VM t s) Env Env
-> Optic
     A_Lens
     '[]
     Env
     Env
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
-> Optic
     A_Lens
     '[]
     (VM t s)
     (VM t s)
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  Env
  Env
  (Map (Expr 'EAddr) Contract)
  (Map (Expr 'EAddr) Contract)
#contracts Optic
  A_Lens
  '[]
  (VM t s)
  (VM t s)
  (Map (Expr 'EAddr) Contract)
  (Map (Expr 'EAddr) Contract)
-> Optic
     (IxKind (Map (Expr 'EAddr) Contract))
     '[]
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
     (IxValue (Map (Expr 'EAddr) Contract))
     (IxValue (Map (Expr 'EAddr) Contract))
-> Optic
     An_AffineTraversal
     '[]
     (VM t s)
     (VM t s)
     (IxValue (Map (Expr 'EAddr) Contract))
     (IxValue (Map (Expr 'EAddr) Contract))
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Index (Map (Expr 'EAddr) Contract)
-> Optic
     (IxKind (Map (Expr 'EAddr) Contract))
     '[]
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
     (IxValue (Map (Expr 'EAddr) Contract))
     (IxValue (Map (Expr 'EAddr) Contract))
forall m. Ixed m => Index m -> Optic' (IxKind m) '[] m (IxValue m)
ix Index (Map (Expr 'EAddr) Contract)
Expr 'EAddr
dst Optic
  An_AffineTraversal
  '[]
  (VM t s)
  (VM t s)
  (IxValue (Map (Expr 'EAddr) Contract))
  (IxValue (Map (Expr 'EAddr) Contract))
-> Optic
     A_Lens
     '[]
     (IxValue (Map (Expr 'EAddr) Contract))
     (IxValue (Map (Expr 'EAddr) Contract))
     (Expr 'EWord)
     (Expr 'EWord)
-> Optic' An_AffineTraversal '[] (VM t s) (Expr 'EWord)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (IxValue (Map (Expr 'EAddr) Contract))
  (IxValue (Map (Expr 'EAddr) Contract))
  (Expr 'EWord)
  (Expr 'EWord)
#balance
  BaseState
baseState <- Optic' A_Lens '[] (VM t s) BaseState
-> StateT (VM t s) (ST s) BaseState
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic A_Lens '[] (VM t s) (VM t s) RuntimeConfig RuntimeConfig
#config Optic A_Lens '[] (VM t s) (VM t s) RuntimeConfig RuntimeConfig
-> Optic A_Lens '[] RuntimeConfig RuntimeConfig BaseState BaseState
-> Optic' A_Lens '[] (VM t s) BaseState
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens '[] RuntimeConfig RuntimeConfig BaseState BaseState
#baseState)
  let mkc :: Expr 'EAddr -> Contract
mkc = case BaseState
baseState of
              BaseState
AbstractBase -> Expr 'EAddr -> Contract
unknownContract
              BaseState
EmptyBase -> Contract -> Expr 'EAddr -> Contract
forall a b. a -> b -> a
const Contract
emptyContract
  case (Maybe (Expr 'EWord)
sb, Maybe (Expr 'EWord)
db) of
    -- both sender and recipient in state
    (Just Expr 'EWord
srcBal, Just Expr 'EWord
_) ->
      Expr 'EWord
-> (Bool -> StateT (VM t s) (ST s) ()) -> StateT (VM t s) (ST s) ()
forall s. Expr 'EWord -> (Bool -> EVM t s ()) -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EWord -> (Bool -> EVM t s ()) -> EVM t s ()
branch (Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.gt Expr 'EWord
val Expr 'EWord
srcBal) ((Bool -> StateT (VM t s) (ST s) ()) -> StateT (VM t s) (ST s) ())
-> (Bool -> StateT (VM t s) (ST s) ()) -> StateT (VM t s) (ST s) ()
forall a b. (a -> b) -> a -> b
$ \case
        Bool
True -> EvmError -> StateT (VM t s) (ST s) ()
forall (t :: VMType) s. VMOps t => EvmError -> EVM t s ()
vmError (EvmError -> StateT (VM t s) (ST s) ())
-> EvmError -> StateT (VM t s) (ST s) ()
forall a b. (a -> b) -> a -> b
$ Expr 'EWord -> Expr 'EWord -> EvmError
BalanceTooLow Expr 'EWord
val Expr 'EWord
srcBal
        Bool
False -> do
          (Optic A_Lens '[] (VM t s) (VM t s) Env Env
#env Optic A_Lens '[] (VM t s) (VM t s) Env Env
-> Optic
     A_Lens
     '[]
     Env
     Env
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
-> Optic
     A_Lens
     '[]
     (VM t s)
     (VM t s)
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  Env
  Env
  (Map (Expr 'EAddr) Contract)
  (Map (Expr 'EAddr) Contract)
#contracts Optic
  A_Lens
  '[]
  (VM t s)
  (VM t s)
  (Map (Expr 'EAddr) Contract)
  (Map (Expr 'EAddr) Contract)
-> Optic
     (IxKind (Map (Expr 'EAddr) Contract))
     '[]
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
     (IxValue (Map (Expr 'EAddr) Contract))
     (IxValue (Map (Expr 'EAddr) Contract))
-> Optic
     An_AffineTraversal
     '[]
     (VM t s)
     (VM t s)
     (IxValue (Map (Expr 'EAddr) Contract))
     (IxValue (Map (Expr 'EAddr) Contract))
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Index (Map (Expr 'EAddr) Contract)
-> Optic
     (IxKind (Map (Expr 'EAddr) Contract))
     '[]
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
     (IxValue (Map (Expr 'EAddr) Contract))
     (IxValue (Map (Expr 'EAddr) Contract))
forall m. Ixed m => Index m -> Optic' (IxKind m) '[] m (IxValue m)
ix Index (Map (Expr 'EAddr) Contract)
Expr 'EAddr
src Optic
  An_AffineTraversal
  '[]
  (VM t s)
  (VM t s)
  (IxValue (Map (Expr 'EAddr) Contract))
  (IxValue (Map (Expr 'EAddr) Contract))
-> Optic
     A_Lens
     '[]
     (IxValue (Map (Expr 'EAddr) Contract))
     (IxValue (Map (Expr 'EAddr) Contract))
     (Expr 'EWord)
     (Expr 'EWord)
-> Optic' An_AffineTraversal '[] (VM t s) (Expr 'EWord)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (IxValue (Map (Expr 'EAddr) Contract))
  (IxValue (Map (Expr 'EAddr) Contract))
  (Expr 'EWord)
  (Expr 'EWord)
#balance) Optic' An_AffineTraversal '[] (VM t s) (Expr 'EWord)
-> (Expr 'EWord -> Expr 'EWord) -> StateT (VM t s) (ST s) ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
%= (Expr 'EWord -> Expr 'EWord -> Expr 'EWord
`Expr.sub` Expr 'EWord
val)
          (Optic A_Lens '[] (VM t s) (VM t s) Env Env
#env Optic A_Lens '[] (VM t s) (VM t s) Env Env
-> Optic
     A_Lens
     '[]
     Env
     Env
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
-> Optic
     A_Lens
     '[]
     (VM t s)
     (VM t s)
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  Env
  Env
  (Map (Expr 'EAddr) Contract)
  (Map (Expr 'EAddr) Contract)
#contracts Optic
  A_Lens
  '[]
  (VM t s)
  (VM t s)
  (Map (Expr 'EAddr) Contract)
  (Map (Expr 'EAddr) Contract)
-> Optic
     (IxKind (Map (Expr 'EAddr) Contract))
     '[]
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
     (IxValue (Map (Expr 'EAddr) Contract))
     (IxValue (Map (Expr 'EAddr) Contract))
-> Optic
     An_AffineTraversal
     '[]
     (VM t s)
     (VM t s)
     (IxValue (Map (Expr 'EAddr) Contract))
     (IxValue (Map (Expr 'EAddr) Contract))
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Index (Map (Expr 'EAddr) Contract)
-> Optic
     (IxKind (Map (Expr 'EAddr) Contract))
     '[]
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
     (IxValue (Map (Expr 'EAddr) Contract))
     (IxValue (Map (Expr 'EAddr) Contract))
forall m. Ixed m => Index m -> Optic' (IxKind m) '[] m (IxValue m)
ix Index (Map (Expr 'EAddr) Contract)
Expr 'EAddr
dst Optic
  An_AffineTraversal
  '[]
  (VM t s)
  (VM t s)
  (IxValue (Map (Expr 'EAddr) Contract))
  (IxValue (Map (Expr 'EAddr) Contract))
-> Optic
     A_Lens
     '[]
     (IxValue (Map (Expr 'EAddr) Contract))
     (IxValue (Map (Expr 'EAddr) Contract))
     (Expr 'EWord)
     (Expr 'EWord)
-> Optic' An_AffineTraversal '[] (VM t s) (Expr 'EWord)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (IxValue (Map (Expr 'EAddr) Contract))
  (IxValue (Map (Expr 'EAddr) Contract))
  (Expr 'EWord)
  (Expr 'EWord)
#balance) Optic' An_AffineTraversal '[] (VM t s) (Expr 'EWord)
-> (Expr 'EWord -> Expr 'EWord) -> StateT (VM t s) (ST s) ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
%= (Expr 'EWord -> Expr 'EWord -> Expr 'EWord
`Expr.add` Expr 'EWord
val)
    -- sender not in state
    (Maybe (Expr 'EWord)
Nothing, Just Expr 'EWord
_) -> do
      case Expr 'EAddr
src of
        LitAddr Addr
_ -> do
          (Optic A_Lens '[] (VM t s) (VM t s) Env Env
#env Optic A_Lens '[] (VM t s) (VM t s) Env Env
-> Optic
     A_Lens
     '[]
     Env
     Env
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
-> Optic
     A_Lens
     '[]
     (VM t s)
     (VM t s)
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  Env
  Env
  (Map (Expr 'EAddr) Contract)
  (Map (Expr 'EAddr) Contract)
#contracts) Optic
  A_Lens
  '[]
  (VM t s)
  (VM t s)
  (Map (Expr 'EAddr) Contract)
  (Map (Expr 'EAddr) Contract)
-> (Map (Expr 'EAddr) Contract -> Map (Expr 'EAddr) Contract)
-> StateT (VM t s) (ST s) ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
%= (Expr 'EAddr
-> Contract
-> Map (Expr 'EAddr) Contract
-> Map (Expr 'EAddr) Contract
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Expr 'EAddr
src (Expr 'EAddr -> Contract
mkc Expr 'EAddr
src))
          Expr 'EAddr
-> Expr 'EAddr -> Expr 'EWord -> StateT (VM t s) (ST s) ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EAddr -> Expr 'EAddr -> Expr 'EWord -> EVM t s ()
transfer Expr 'EAddr
src Expr 'EAddr
dst Expr 'EWord
val
        SymAddr Text
_ -> do
          Int
pc <- Optic' A_Lens '[] (VM t s) Int -> StateT (VM t s) (ST s) Int
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic A_Lens '[] (FrameState t s) (FrameState t s) Int Int
-> Optic' A_Lens '[] (VM t s) Int
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens '[] (FrameState t s) (FrameState t s) Int Int
#pc)
          PartialExec -> StateT (VM t s) (ST s) ()
forall s. PartialExec -> EVM t s ()
forall (t :: VMType) s. VMOps t => PartialExec -> EVM t s ()
partial (PartialExec -> StateT (VM t s) (ST s) ())
-> PartialExec -> StateT (VM t s) (ST s) ()
forall a b. (a -> b) -> a -> b
$ Int -> [Char] -> [SomeExpr] -> PartialExec
UnexpectedSymbolicArg Int
pc [Char]
"Attempting to transfer eth from a symbolic address that is not present in the state" ([Expr 'EAddr] -> [SomeExpr]
forall (a :: EType). Typeable a => [Expr a] -> [SomeExpr]
wrap [Expr 'EAddr
src])
        GVar GVar 'EAddr
_ -> [Char] -> StateT (VM t s) (ST s) ()
forall a. HasCallStack => [Char] -> a
internalError [Char]
"Unexpected GVar"
    -- recipient not in state
    (Maybe (Expr 'EWord)
_ , Maybe (Expr 'EWord)
Nothing) -> do
      case Expr 'EAddr
dst of
        LitAddr Addr
_ -> do
          (Optic A_Lens '[] (VM t s) (VM t s) Env Env
#env Optic A_Lens '[] (VM t s) (VM t s) Env Env
-> Optic
     A_Lens
     '[]
     Env
     Env
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
-> Optic
     A_Lens
     '[]
     (VM t s)
     (VM t s)
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  Env
  Env
  (Map (Expr 'EAddr) Contract)
  (Map (Expr 'EAddr) Contract)
#contracts) Optic
  A_Lens
  '[]
  (VM t s)
  (VM t s)
  (Map (Expr 'EAddr) Contract)
  (Map (Expr 'EAddr) Contract)
-> (Map (Expr 'EAddr) Contract -> Map (Expr 'EAddr) Contract)
-> StateT (VM t s) (ST s) ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
%= (Expr 'EAddr
-> Contract
-> Map (Expr 'EAddr) Contract
-> Map (Expr 'EAddr) Contract
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Expr 'EAddr
dst (Expr 'EAddr -> Contract
mkc Expr 'EAddr
dst))
          Expr 'EAddr
-> Expr 'EAddr -> Expr 'EWord -> StateT (VM t s) (ST s) ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EAddr -> Expr 'EAddr -> Expr 'EWord -> EVM t s ()
transfer Expr 'EAddr
src Expr 'EAddr
dst Expr 'EWord
val
        SymAddr Text
_ -> do
          Int
pc <- Optic' A_Lens '[] (VM t s) Int -> StateT (VM t s) (ST s) Int
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic A_Lens '[] (FrameState t s) (FrameState t s) Int Int
-> Optic' A_Lens '[] (VM t s) Int
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens '[] (FrameState t s) (FrameState t s) Int Int
#pc)
          PartialExec -> StateT (VM t s) (ST s) ()
forall s. PartialExec -> EVM t s ()
forall (t :: VMType) s. VMOps t => PartialExec -> EVM t s ()
partial (PartialExec -> StateT (VM t s) (ST s) ())
-> PartialExec -> StateT (VM t s) (ST s) ()
forall a b. (a -> b) -> a -> b
$ Int -> [Char] -> [SomeExpr] -> PartialExec
UnexpectedSymbolicArg Int
pc [Char]
"Attempting to transfer eth to a symbolic address that is not present in the state" ([Expr 'EAddr] -> [SomeExpr]
forall (a :: EType). Typeable a => [Expr a] -> [SomeExpr]
wrap [Expr 'EAddr
dst])
        GVar GVar 'EAddr
_ -> [Char] -> StateT (VM t s) (ST s) ()
forall a. HasCallStack => [Char] -> a
internalError [Char]
"Unexpected GVar"

-- | Checks a *CALL for failure; OOG, too many callframes, memory access etc.
callChecks
  :: forall (t :: VMType) s. (?op :: Word8, VMOps t)
  => Contract
  -> Gas t
  -> Expr EAddr
  -> Expr EAddr
  -> Expr EWord
  -> Expr EWord
  -> Expr EWord
  -> Expr EWord
  -> Expr EWord
  -> [Expr EWord]
  -- continuation with gas available for call
  -> (Gas t -> EVM t s ())
  -> EVM t s ()
callChecks :: forall (t :: VMType) s.
(?op::Word8, VMOps t) =>
Contract
-> Gas t
-> Expr 'EAddr
-> Expr 'EAddr
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> [Expr 'EWord]
-> (Gas t -> EVM t s ())
-> EVM t s ()
callChecks Contract
this Gas t
xGas Expr 'EAddr
xContext Expr 'EAddr
xTo Expr 'EWord
xValue Expr 'EWord
xInOffset Expr 'EWord
xInSize Expr 'EWord
xOutOffset Expr 'EWord
xOutSize [Expr 'EWord]
xs Gas t -> EVM t s ()
continue = do
  VM t s
vm <- StateT (VM t s) (ST s) (VM t s)
forall s (m :: * -> *). MonadState s m => m s
get
  let fees :: FeeSchedule Word64
fees = VM t s
vm.block.schedule
  Expr 'EWord -> Expr 'EWord -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EWord -> Expr 'EWord -> EVM t s () -> EVM t s ()
accessMemoryRange Expr 'EWord
xInOffset Expr 'EWord
xInSize (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$
    Expr 'EWord -> Expr 'EWord -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EWord -> Expr 'EWord -> EVM t s () -> EVM t s ()
accessMemoryRange Expr 'EWord
xOutOffset Expr 'EWord
xOutSize (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ do
      Gas t
availableGas <- Optic' A_Lens '[] (VM t s) (Gas t)
-> StateT (VM t s) (ST s) (Gas t)
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens '[] (FrameState t s) (FrameState t s) (Gas t) (Gas t)
-> Optic' A_Lens '[] (VM t s) (Gas t)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens '[] (FrameState t s) (FrameState t s) (Gas t) (Gas t)
#gas)
      let recipientExists :: Bool
recipientExists = Expr 'EAddr -> VM t s -> Bool
forall (t :: VMType) s. Expr 'EAddr -> VM t s -> Bool
accountExists Expr 'EAddr
xContext VM t s
vm
      let from :: Expr 'EAddr
from = Expr 'EAddr -> Maybe (Expr 'EAddr) -> Expr 'EAddr
forall a. a -> Maybe a -> a
fromMaybe VM t s
vm.state.contract VM t s
vm.config.overrideCaller
      Maybe (Expr 'EWord)
fromBal <- Optic' An_AffineTraversal '[] (VM t s) (Expr 'EWord)
-> StateT (VM t s) (ST s) (Maybe (Expr 'EWord))
forall k s (m :: * -> *) (is :: IxList) a.
(Is k An_AffineFold, MonadState s m) =>
Optic' k is s a -> m (Maybe a)
preuse (Optic' An_AffineTraversal '[] (VM t s) (Expr 'EWord)
 -> StateT (VM t s) (ST s) (Maybe (Expr 'EWord)))
-> Optic' An_AffineTraversal '[] (VM t s) (Expr 'EWord)
-> StateT (VM t s) (ST s) (Maybe (Expr 'EWord))
forall a b. (a -> b) -> a -> b
$ Optic A_Lens '[] (VM t s) (VM t s) Env Env
#env Optic A_Lens '[] (VM t s) (VM t s) Env Env
-> Optic
     A_Lens
     '[]
     Env
     Env
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
-> Optic
     A_Lens
     '[]
     (VM t s)
     (VM t s)
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  Env
  Env
  (Map (Expr 'EAddr) Contract)
  (Map (Expr 'EAddr) Contract)
#contracts Optic
  A_Lens
  '[]
  (VM t s)
  (VM t s)
  (Map (Expr 'EAddr) Contract)
  (Map (Expr 'EAddr) Contract)
-> Optic
     (IxKind (Map (Expr 'EAddr) Contract))
     '[]
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
     (IxValue (Map (Expr 'EAddr) Contract))
     (IxValue (Map (Expr 'EAddr) Contract))
-> Optic
     An_AffineTraversal
     '[]
     (VM t s)
     (VM t s)
     (IxValue (Map (Expr 'EAddr) Contract))
     (IxValue (Map (Expr 'EAddr) Contract))
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Index (Map (Expr 'EAddr) Contract)
-> Optic
     (IxKind (Map (Expr 'EAddr) Contract))
     '[]
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
     (IxValue (Map (Expr 'EAddr) Contract))
     (IxValue (Map (Expr 'EAddr) Contract))
forall m. Ixed m => Index m -> Optic' (IxKind m) '[] m (IxValue m)
ix Index (Map (Expr 'EAddr) Contract)
Expr 'EAddr
from Optic
  An_AffineTraversal
  '[]
  (VM t s)
  (VM t s)
  (IxValue (Map (Expr 'EAddr) Contract))
  (IxValue (Map (Expr 'EAddr) Contract))
-> Optic
     A_Lens
     '[]
     (IxValue (Map (Expr 'EAddr) Contract))
     (IxValue (Map (Expr 'EAddr) Contract))
     (Expr 'EWord)
     (Expr 'EWord)
-> Optic' An_AffineTraversal '[] (VM t s) (Expr 'EWord)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (IxValue (Map (Expr 'EAddr) Contract))
  (IxValue (Map (Expr 'EAddr) Contract))
  (Expr 'EWord)
  (Expr 'EWord)
#balance
      FeeSchedule Word64
-> Bool
-> Expr 'EWord
-> Gas t
-> Gas t
-> Expr 'EAddr
-> (Word64 -> Word64 -> EVM t s ())
-> EVM t s ()
forall s.
FeeSchedule Word64
-> Bool
-> Expr 'EWord
-> Gas t
-> Gas t
-> Expr 'EAddr
-> (Word64 -> Word64 -> EVM t s ())
-> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
FeeSchedule Word64
-> Bool
-> Expr 'EWord
-> Gas t
-> Gas t
-> Expr 'EAddr
-> (Word64 -> Word64 -> EVM t s ())
-> EVM t s ()
costOfCall FeeSchedule Word64
fees Bool
recipientExists Expr 'EWord
xValue Gas t
availableGas Gas t
xGas Expr 'EAddr
xTo ((Word64 -> Word64 -> EVM t s ()) -> EVM t s ())
-> (Word64 -> Word64 -> EVM t s ()) -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ \Word64
cost Word64
gas' -> do
        let checkCallDepth :: EVM t s ()
checkCallDepth =
              if [Frame t s] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length VM t s
vm.frames Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1024
              then do
                Optic A_Lens '[] (VM t s) (VM t s) [Expr 'EWord] [Expr 'EWord]
-> [Expr 'EWord] -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     [Expr 'EWord]
     [Expr 'EWord]
-> Optic A_Lens '[] (VM t s) (VM t s) [Expr 'EWord] [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  [Expr 'EWord]
  [Expr 'EWord]
#stack) (W256 -> Expr 'EWord
Lit W256
0 Expr 'EWord -> [Expr 'EWord] -> [Expr 'EWord]
forall a. a -> [a] -> [a]
: [Expr 'EWord]
xs)
                Optic A_Lens '[] (VM t s) (VM t s) (Expr 'Buf) (Expr 'Buf)
-> Expr 'Buf -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     (Expr 'Buf)
     (Expr 'Buf)
-> Optic A_Lens '[] (VM t s) (VM t s) (Expr 'Buf) (Expr 'Buf)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  (Expr 'Buf)
  (Expr 'Buf)
#returndata) Expr 'Buf
forall a. Monoid a => a
mempty
                TraceData -> EVM t s ()
forall (t :: VMType) s. TraceData -> EVM t s ()
pushTrace (TraceData -> EVM t s ()) -> TraceData -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ EvmError -> TraceData
ErrorTrace EvmError
CallDepthLimitReached
                EVM t s ()
forall (t :: VMType) s. (?op::Word8) => EVM t s ()
next
              else Gas t -> EVM t s ()
continue (Word64 -> Gas t
forall (t :: VMType). VMOps t => Word64 -> Gas t
toGas Word64
gas')
        case (Maybe (Expr 'EWord)
fromBal, Expr 'EWord
xValue) of
          -- we're not transferring any value, and can skip the balance check
          (Maybe (Expr 'EWord)
_, Lit W256
0) -> Word64 -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Word64 -> EVM t s () -> EVM t s ()
burn (Word64
cost Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
gas') EVM t s ()
checkCallDepth

          -- from is in the state, we check if they have enough balance
          (Just Expr 'EWord
fb, Expr 'EWord
_) -> do
            Word64 -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Word64 -> EVM t s () -> EVM t s ()
burn (Word64
cost Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
gas') (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$
              Expr 'EWord -> (Bool -> EVM t s ()) -> EVM t s ()
forall s. Expr 'EWord -> (Bool -> EVM t s ()) -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EWord -> (Bool -> EVM t s ()) -> EVM t s ()
branch (Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.gt Expr 'EWord
xValue Expr 'EWord
fb) ((Bool -> EVM t s ()) -> EVM t s ())
-> (Bool -> EVM t s ()) -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ \case
                Bool
True -> do
                  Optic A_Lens '[] (VM t s) (VM t s) [Expr 'EWord] [Expr 'EWord]
-> [Expr 'EWord] -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     [Expr 'EWord]
     [Expr 'EWord]
-> Optic A_Lens '[] (VM t s) (VM t s) [Expr 'EWord] [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  [Expr 'EWord]
  [Expr 'EWord]
#stack) (W256 -> Expr 'EWord
Lit W256
0 Expr 'EWord -> [Expr 'EWord] -> [Expr 'EWord]
forall a. a -> [a] -> [a]
: [Expr 'EWord]
xs)
                  Optic A_Lens '[] (VM t s) (VM t s) (Expr 'Buf) (Expr 'Buf)
-> Expr 'Buf -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     (Expr 'Buf)
     (Expr 'Buf)
-> Optic A_Lens '[] (VM t s) (VM t s) (Expr 'Buf) (Expr 'Buf)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  (Expr 'Buf)
  (Expr 'Buf)
#returndata) Expr 'Buf
forall a. Monoid a => a
mempty
                  TraceData -> EVM t s ()
forall (t :: VMType) s. TraceData -> EVM t s ()
pushTrace (TraceData -> EVM t s ()) -> TraceData -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ EvmError -> TraceData
ErrorTrace (Expr 'EWord -> Expr 'EWord -> EvmError
BalanceTooLow Expr 'EWord
xValue Contract
this.balance)
                  EVM t s ()
forall (t :: VMType) s. (?op::Word8) => EVM t s ()
next
                Bool
False -> EVM t s ()
checkCallDepth

          -- from is not in the state, we insert it if safe to do so and run the checks again
          (Maybe (Expr 'EWord)
Nothing, Expr 'EWord
_) -> case Expr 'EAddr
from of
            LitAddr Addr
_ -> do
              -- insert an entry in the state
              let contract :: Contract
contract = case VM t s
vm.config.baseState of
                    BaseState
AbstractBase -> Expr 'EAddr -> Contract
unknownContract Expr 'EAddr
from
                    BaseState
EmptyBase -> Contract
emptyContract
              (Optic A_Lens '[] (VM t s) (VM t s) Env Env
#env Optic A_Lens '[] (VM t s) (VM t s) Env Env
-> Optic
     A_Lens
     '[]
     Env
     Env
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
-> Optic
     A_Lens
     '[]
     (VM t s)
     (VM t s)
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  Env
  Env
  (Map (Expr 'EAddr) Contract)
  (Map (Expr 'EAddr) Contract)
#contracts) Optic
  A_Lens
  '[]
  (VM t s)
  (VM t s)
  (Map (Expr 'EAddr) Contract)
  (Map (Expr 'EAddr) Contract)
-> (Map (Expr 'EAddr) Contract -> Map (Expr 'EAddr) Contract)
-> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
%= (Expr 'EAddr
-> Contract
-> Map (Expr 'EAddr) Contract
-> Map (Expr 'EAddr) Contract
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Expr 'EAddr
from Contract
contract)
              -- run callChecks again
              Contract
-> Gas t
-> Expr 'EAddr
-> Expr 'EAddr
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> [Expr 'EWord]
-> (Gas t -> EVM t s ())
-> EVM t s ()
forall (t :: VMType) s.
(?op::Word8, VMOps t) =>
Contract
-> Gas t
-> Expr 'EAddr
-> Expr 'EAddr
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> [Expr 'EWord]
-> (Gas t -> EVM t s ())
-> EVM t s ()
callChecks Contract
this Gas t
xGas Expr 'EAddr
xContext Expr 'EAddr
xTo Expr 'EWord
xValue Expr 'EWord
xInOffset Expr 'EWord
xInSize Expr 'EWord
xOutOffset Expr 'EWord
xOutSize [Expr 'EWord]
xs Gas t -> EVM t s ()
continue

            -- adding a symbolic address into the state here would be unsound (due to potential aliasing)
            SymAddr Text
_ -> do
              Int
pc <- Optic' A_Lens '[] (VM t s) Int -> StateT (VM t s) (ST s) Int
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic A_Lens '[] (FrameState t s) (FrameState t s) Int Int
-> Optic' A_Lens '[] (VM t s) Int
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens '[] (FrameState t s) (FrameState t s) Int Int
#pc)
              PartialExec -> EVM t s ()
forall s. PartialExec -> EVM t s ()
forall (t :: VMType) s. VMOps t => PartialExec -> EVM t s ()
partial (PartialExec -> EVM t s ()) -> PartialExec -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ Int -> [Char] -> [SomeExpr] -> PartialExec
UnexpectedSymbolicArg Int
pc [Char]
"Attempting to transfer eth from a symbolic address that is not present in the state" ([Expr 'EAddr] -> [SomeExpr]
forall (a :: EType). Typeable a => [Expr a] -> [SomeExpr]
wrap [Expr 'EAddr
from])
            GVar GVar 'EAddr
_ -> [Char] -> EVM t s ()
forall a. HasCallStack => [Char] -> a
internalError [Char]
"Unexpected GVar"




precompiledContract
  :: (?op :: Word8, VMOps t)
  => Contract
  -> Gas t
  -> Addr
  -> Addr
  -> Expr EWord
  -> Expr EWord -> Expr EWord -> Expr EWord -> Expr EWord
  -> [Expr EWord]
  -> EVM t s ()
precompiledContract :: forall (t :: VMType) s.
(?op::Word8, VMOps t) =>
Contract
-> Gas t
-> Addr
-> Addr
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> [Expr 'EWord]
-> EVM t s ()
precompiledContract Contract
this Gas t
xGas Addr
precompileAddr Addr
recipient Expr 'EWord
xValue Expr 'EWord
inOffset Expr 'EWord
inSize Expr 'EWord
outOffset Expr 'EWord
outSize [Expr 'EWord]
xs
  = Contract
-> Gas t
-> Expr 'EAddr
-> Expr 'EAddr
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> [Expr 'EWord]
-> (Gas t -> StateT (VM t s) (ST s) ())
-> StateT (VM t s) (ST s) ()
forall (t :: VMType) s.
(?op::Word8, VMOps t) =>
Contract
-> Gas t
-> Expr 'EAddr
-> Expr 'EAddr
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> [Expr 'EWord]
-> (Gas t -> EVM t s ())
-> EVM t s ()
callChecks Contract
this Gas t
xGas (Addr -> Expr 'EAddr
LitAddr Addr
recipient) (Addr -> Expr 'EAddr
LitAddr Addr
precompileAddr) Expr 'EWord
xValue Expr 'EWord
inOffset Expr 'EWord
inSize Expr 'EWord
outOffset Expr 'EWord
outSize [Expr 'EWord]
xs ((Gas t -> StateT (VM t s) (ST s) ()) -> StateT (VM t s) (ST s) ())
-> (Gas t -> StateT (VM t s) (ST s) ())
-> StateT (VM t s) (ST s) ()
forall a b. (a -> b) -> a -> b
$ \Gas t
gas' ->
    do
      Addr
-> Gas t
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> [Expr 'EWord]
-> StateT (VM t s) (ST s) ()
forall (t :: VMType) s.
(?op::Word8, VMOps t) =>
Addr
-> Gas t
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> [Expr 'EWord]
-> EVM t s ()
executePrecompile Addr
precompileAddr Gas t
gas' Expr 'EWord
inOffset Expr 'EWord
inSize Expr 'EWord
outOffset Expr 'EWord
outSize [Expr 'EWord]
xs
      Expr 'EAddr
self <- Optic' A_Lens '[] (VM t s) (Expr 'EAddr)
-> StateT (VM t s) (ST s) (Expr 'EAddr)
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     (Expr 'EAddr)
     (Expr 'EAddr)
-> Optic' A_Lens '[] (VM t s) (Expr 'EAddr)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  (Expr 'EAddr)
  (Expr 'EAddr)
#contract)
      [Expr 'EWord]
stk <- Optic' A_Lens '[] (VM t s) [Expr 'EWord]
-> StateT (VM t s) (ST s) [Expr 'EWord]
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     [Expr 'EWord]
     [Expr 'EWord]
-> Optic' A_Lens '[] (VM t s) [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  [Expr 'EWord]
  [Expr 'EWord]
#stack)
      Int
pc' <- Optic' A_Lens '[] (VM t s) Int -> StateT (VM t s) (ST s) Int
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic A_Lens '[] (FrameState t s) (FrameState t s) Int Int
-> Optic' A_Lens '[] (VM t s) Int
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens '[] (FrameState t s) (FrameState t s) Int Int
#pc)
      Maybe (VMResult t s)
result' <- Optic' A_Lens '[] (VM t s) (Maybe (VMResult t s))
-> StateT (VM t s) (ST s) (Maybe (VMResult t s))
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use Optic' A_Lens '[] (VM t s) (Maybe (VMResult t s))
#result
      case Maybe (VMResult t s)
result' of
        Maybe (VMResult t s)
Nothing -> case [Expr 'EWord]
stk of
          Expr 'EWord
x:[Expr 'EWord]
_ -> case Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
x of
            Just W256
0 ->
              () -> StateT (VM t s) (ST s) ()
forall a. a -> StateT (VM t s) (ST s) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
            Just W256
1 ->
              Expr 'EAddr
-> (Contract -> StateT (VM t s) (ST s) ())
-> StateT (VM t s) (ST s) ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EAddr -> (Contract -> EVM t s ()) -> EVM t s ()
fetchAccount (Addr -> Expr 'EAddr
LitAddr Addr
recipient) ((Contract -> StateT (VM t s) (ST s) ())
 -> StateT (VM t s) (ST s) ())
-> (Contract -> StateT (VM t s) (ST s) ())
-> StateT (VM t s) (ST s) ()
forall a b. (a -> b) -> a -> b
$ \Contract
_ -> do
                Expr 'EAddr -> StateT (VM t s) (ST s) ()
forall (t :: VMType) s. Expr 'EAddr -> EVM t s ()
touchAccount Expr 'EAddr
self
                Expr 'EAddr -> StateT (VM t s) (ST s) ()
forall (t :: VMType) s. Expr 'EAddr -> EVM t s ()
touchAccount (Addr -> Expr 'EAddr
LitAddr Addr
recipient)
                Expr 'EAddr
-> Expr 'EAddr -> Expr 'EWord -> StateT (VM t s) (ST s) ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EAddr -> Expr 'EAddr -> Expr 'EWord -> EVM t s ()
transfer Expr 'EAddr
self (Addr -> Expr 'EAddr
LitAddr Addr
recipient) Expr 'EWord
xValue
            Maybe W256
_ -> PartialExec -> StateT (VM t s) (ST s) ()
forall s. PartialExec -> EVM t s ()
forall (t :: VMType) s. VMOps t => PartialExec -> EVM t s ()
partial (PartialExec -> StateT (VM t s) (ST s) ())
-> PartialExec -> StateT (VM t s) (ST s) ()
forall a b. (a -> b) -> a -> b
$
                   Int -> [Char] -> [SomeExpr] -> PartialExec
UnexpectedSymbolicArg Int
pc' [Char]
"unexpected return value from precompile" ([Expr 'EWord] -> [SomeExpr]
forall (a :: EType). Typeable a => [Expr a] -> [SomeExpr]
wrap [Expr 'EWord
x])
          [Expr 'EWord]
_ -> StateT (VM t s) (ST s) ()
forall (t :: VMType) s. VMOps t => EVM t s ()
underrun
        Maybe (VMResult t s)
_ -> () -> StateT (VM t s) (ST s) ()
forall a. a -> StateT (VM t s) (ST s) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

executePrecompile
  :: (?op :: Word8, VMOps t)
  => Addr
  -> Gas t -> Expr EWord -> Expr EWord -> Expr EWord -> Expr EWord -> [Expr EWord]
  -> EVM t s ()
executePrecompile :: forall (t :: VMType) s.
(?op::Word8, VMOps t) =>
Addr
-> Gas t
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> [Expr 'EWord]
-> EVM t s ()
executePrecompile Addr
preCompileAddr Gas t
gasCap Expr 'EWord
inOffset Expr 'EWord
inSize Expr 'EWord
outOffset Expr 'EWord
outSize [Expr 'EWord]
xs  = do
  VM t s
vm <- StateT (VM t s) (ST s) (VM t s)
forall s (m :: * -> *). MonadState s m => m s
get
  Expr 'Buf
input <- Expr 'EWord -> Expr 'EWord -> EVM t s (Expr 'Buf)
forall (t :: VMType) s.
Expr 'EWord -> Expr 'EWord -> EVM t s (Expr 'Buf)
readMemory Expr 'EWord
inOffset Expr 'EWord
inSize
  let fees :: FeeSchedule Word64
fees = VM t s
vm.block.schedule
      cost :: Word64
cost = FeeSchedule Word64 -> Addr -> Expr 'Buf -> Word64
costOfPrecompile FeeSchedule Word64
fees Addr
preCompileAddr Expr 'Buf
input
      notImplemented :: EVM t s ()
notImplemented = [Char] -> EVM t s ()
forall a. HasCallStack => [Char] -> a
internalError ([Char] -> EVM t s ()) -> [Char] -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ [Char]
"precompile at address " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Addr -> [Char]
forall a. Show a => a -> [Char]
show Addr
preCompileAddr [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" not yet implemented"
      precompileFail :: EVM t s ()
precompileFail = Gas t -> EVM t s () -> EVM t s ()
forall s. Gas t -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Gas t -> EVM t s () -> EVM t s ()
burn' (Gas t -> Word64 -> Gas t
forall (t :: VMType). VMOps t => Gas t -> Word64 -> Gas t
subGas Gas t
gasCap Word64
cost) (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ do
                         Optic A_Lens '[] (VM t s) (VM t s) [Expr 'EWord] [Expr 'EWord]
-> [Expr 'EWord] -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     [Expr 'EWord]
     [Expr 'EWord]
-> Optic A_Lens '[] (VM t s) (VM t s) [Expr 'EWord] [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  [Expr 'EWord]
  [Expr 'EWord]
#stack) (W256 -> Expr 'EWord
Lit W256
0 Expr 'EWord -> [Expr 'EWord] -> [Expr 'EWord]
forall a. a -> [a] -> [a]
: [Expr 'EWord]
xs)
                         TraceData -> EVM t s ()
forall (t :: VMType) s. TraceData -> EVM t s ()
pushTrace (TraceData -> EVM t s ()) -> TraceData -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ EvmError -> TraceData
ErrorTrace EvmError
PrecompileFailure
                         EVM t s ()
forall (t :: VMType) s. (?op::Word8) => EVM t s ()
next
  if Bool -> Bool
not (Word64 -> Gas t -> Bool
forall (t :: VMType). VMOps t => Word64 -> Gas t -> Bool
enoughGas Word64
cost Gas t
gasCap) then
    Gas t -> EVM t s () -> EVM t s ()
forall s. Gas t -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Gas t -> EVM t s () -> EVM t s ()
burn' Gas t
gasCap (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ do
      Optic A_Lens '[] (VM t s) (VM t s) [Expr 'EWord] [Expr 'EWord]
-> [Expr 'EWord] -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     [Expr 'EWord]
     [Expr 'EWord]
-> Optic A_Lens '[] (VM t s) (VM t s) [Expr 'EWord] [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  [Expr 'EWord]
  [Expr 'EWord]
#stack) (W256 -> Expr 'EWord
Lit W256
0 Expr 'EWord -> [Expr 'EWord] -> [Expr 'EWord]
forall a. a -> [a] -> [a]
: [Expr 'EWord]
xs)
      EVM t s ()
forall (t :: VMType) s. (?op::Word8) => EVM t s ()
next
  else Word64 -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Word64 -> EVM t s () -> EVM t s ()
burn Word64
cost (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$
    case Addr
preCompileAddr of
      -- ECRECOVER
      Addr
0x1 ->
        -- TODO: support symbolic variant
        Expr 'Buf -> [Char] -> (ByteString -> EVM t s ()) -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'Buf -> [Char] -> (ByteString -> EVM t s ()) -> EVM t s ()
forceConcreteBuf Expr 'Buf
input [Char]
"ECRECOVER" ((ByteString -> EVM t s ()) -> EVM t s ())
-> (ByteString -> EVM t s ()) -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ \ByteString
input' -> do
          case Int -> ByteString -> Int -> Maybe ByteString
EVM.Precompiled.execute Int
0x1 (Int -> ByteString -> ByteString
truncpadlit Int
128 ByteString
input') Int
32 of
            Maybe ByteString
Nothing -> do
              -- return no output for invalid signature
              Optic A_Lens '[] (VM t s) (VM t s) [Expr 'EWord] [Expr 'EWord]
-> [Expr 'EWord] -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     [Expr 'EWord]
     [Expr 'EWord]
-> Optic A_Lens '[] (VM t s) (VM t s) [Expr 'EWord] [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  [Expr 'EWord]
  [Expr 'EWord]
#stack) (W256 -> Expr 'EWord
Lit W256
1 Expr 'EWord -> [Expr 'EWord] -> [Expr 'EWord]
forall a. a -> [a] -> [a]
: [Expr 'EWord]
xs)
              Optic A_Lens '[] (VM t s) (VM t s) (Expr 'Buf) (Expr 'Buf)
-> Expr 'Buf -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     (Expr 'Buf)
     (Expr 'Buf)
-> Optic A_Lens '[] (VM t s) (VM t s) (Expr 'Buf) (Expr 'Buf)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  (Expr 'Buf)
  (Expr 'Buf)
#returndata) Expr 'Buf
forall a. Monoid a => a
mempty
              EVM t s ()
forall (t :: VMType) s. (?op::Word8) => EVM t s ()
next
            Just ByteString
output -> do
              Optic A_Lens '[] (VM t s) (VM t s) [Expr 'EWord] [Expr 'EWord]
-> [Expr 'EWord] -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     [Expr 'EWord]
     [Expr 'EWord]
-> Optic A_Lens '[] (VM t s) (VM t s) [Expr 'EWord] [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  [Expr 'EWord]
  [Expr 'EWord]
#stack) (W256 -> Expr 'EWord
Lit W256
1 Expr 'EWord -> [Expr 'EWord] -> [Expr 'EWord]
forall a. a -> [a] -> [a]
: [Expr 'EWord]
xs)
              Optic A_Lens '[] (VM t s) (VM t s) (Expr 'Buf) (Expr 'Buf)
-> Expr 'Buf -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     (Expr 'Buf)
     (Expr 'Buf)
-> Optic A_Lens '[] (VM t s) (VM t s) (Expr 'Buf) (Expr 'Buf)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  (Expr 'Buf)
  (Expr 'Buf)
#returndata) (ByteString -> Expr 'Buf
ConcreteBuf ByteString
output)
              Expr 'Buf
-> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM t s ()
forall (t :: VMType) s.
Expr 'Buf
-> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM t s ()
copyBytesToMemory (ByteString -> Expr 'Buf
ConcreteBuf ByteString
output) Expr 'EWord
outSize (W256 -> Expr 'EWord
Lit W256
0) Expr 'EWord
outOffset
              EVM t s ()
forall (t :: VMType) s. (?op::Word8) => EVM t s ()
next

      -- SHA2-256
      Addr
0x2 ->
        Expr 'Buf -> [Char] -> (ByteString -> EVM t s ()) -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'Buf -> [Char] -> (ByteString -> EVM t s ()) -> EVM t s ()
forceConcreteBuf Expr 'Buf
input [Char]
"SHA2-256" ((ByteString -> EVM t s ()) -> EVM t s ())
-> (ByteString -> EVM t s ()) -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ \ByteString
input' -> do
          let
            hash :: Expr 'Buf
hash = ByteString -> Expr 'Buf
forall {ba}. ByteArrayAccess ba => ba -> Expr 'Buf
sha256Buf ByteString
input'
            sha256Buf :: ba -> Expr 'Buf
sha256Buf ba
x = ByteString -> Expr 'Buf
ConcreteBuf (ByteString -> Expr 'Buf) -> ByteString -> Expr 'Buf
forall a b. (a -> b) -> a -> b
$ Digest SHA256 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (ba -> Digest SHA256
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
Crypto.hash ba
x :: Digest SHA256)
          Optic A_Lens '[] (VM t s) (VM t s) [Expr 'EWord] [Expr 'EWord]
-> [Expr 'EWord] -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     [Expr 'EWord]
     [Expr 'EWord]
-> Optic A_Lens '[] (VM t s) (VM t s) [Expr 'EWord] [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  [Expr 'EWord]
  [Expr 'EWord]
#stack) (W256 -> Expr 'EWord
Lit W256
1 Expr 'EWord -> [Expr 'EWord] -> [Expr 'EWord]
forall a. a -> [a] -> [a]
: [Expr 'EWord]
xs)
          Optic A_Lens '[] (VM t s) (VM t s) (Expr 'Buf) (Expr 'Buf)
-> Expr 'Buf -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     (Expr 'Buf)
     (Expr 'Buf)
-> Optic A_Lens '[] (VM t s) (VM t s) (Expr 'Buf) (Expr 'Buf)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  (Expr 'Buf)
  (Expr 'Buf)
#returndata) Expr 'Buf
hash
          Expr 'Buf
-> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM t s ()
forall (t :: VMType) s.
Expr 'Buf
-> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM t s ()
copyBytesToMemory Expr 'Buf
hash Expr 'EWord
outSize (W256 -> Expr 'EWord
Lit W256
0) Expr 'EWord
outOffset
          EVM t s ()
forall (t :: VMType) s. (?op::Word8) => EVM t s ()
next

      -- RIPEMD-160
      Addr
0x3 ->
        -- TODO: support symbolic variant
        Expr 'Buf -> [Char] -> (ByteString -> EVM t s ()) -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'Buf -> [Char] -> (ByteString -> EVM t s ()) -> EVM t s ()
forceConcreteBuf Expr 'Buf
input [Char]
"RIPEMD160" ((ByteString -> EVM t s ()) -> EVM t s ())
-> (ByteString -> EVM t s ()) -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ \ByteString
input' -> do
          let
            padding :: ByteString
padding = [Word8] -> ByteString
BS.pack ([Word8] -> ByteString) -> [Word8] -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> Word8 -> [Word8]
forall a. Int -> a -> [a]
replicate Int
12 Word8
0
            hash' :: ByteString
hash' = Digest RIPEMD160 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (ByteString -> Digest RIPEMD160
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
Crypto.hash ByteString
input' :: Digest RIPEMD160)
            hash :: Expr 'Buf
hash  = ByteString -> Expr 'Buf
ConcreteBuf (ByteString -> Expr 'Buf) -> ByteString -> Expr 'Buf
forall a b. (a -> b) -> a -> b
$ ByteString
padding ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
hash'
          Optic A_Lens '[] (VM t s) (VM t s) [Expr 'EWord] [Expr 'EWord]
-> [Expr 'EWord] -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     [Expr 'EWord]
     [Expr 'EWord]
-> Optic A_Lens '[] (VM t s) (VM t s) [Expr 'EWord] [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  [Expr 'EWord]
  [Expr 'EWord]
#stack) (W256 -> Expr 'EWord
Lit W256
1 Expr 'EWord -> [Expr 'EWord] -> [Expr 'EWord]
forall a. a -> [a] -> [a]
: [Expr 'EWord]
xs)
          Optic A_Lens '[] (VM t s) (VM t s) (Expr 'Buf) (Expr 'Buf)
-> Expr 'Buf -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     (Expr 'Buf)
     (Expr 'Buf)
-> Optic A_Lens '[] (VM t s) (VM t s) (Expr 'Buf) (Expr 'Buf)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  (Expr 'Buf)
  (Expr 'Buf)
#returndata) Expr 'Buf
hash
          Expr 'Buf
-> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM t s ()
forall (t :: VMType) s.
Expr 'Buf
-> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM t s ()
copyBytesToMemory Expr 'Buf
hash Expr 'EWord
outSize (W256 -> Expr 'EWord
Lit W256
0) Expr 'EWord
outOffset
          EVM t s ()
forall (t :: VMType) s. (?op::Word8) => EVM t s ()
next

      -- IDENTITY
      Addr
0x4 -> do
          Optic A_Lens '[] (VM t s) (VM t s) [Expr 'EWord] [Expr 'EWord]
-> [Expr 'EWord] -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     [Expr 'EWord]
     [Expr 'EWord]
-> Optic A_Lens '[] (VM t s) (VM t s) [Expr 'EWord] [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  [Expr 'EWord]
  [Expr 'EWord]
#stack) (W256 -> Expr 'EWord
Lit W256
1 Expr 'EWord -> [Expr 'EWord] -> [Expr 'EWord]
forall a. a -> [a] -> [a]
: [Expr 'EWord]
xs)
          Optic A_Lens '[] (VM t s) (VM t s) (Expr 'Buf) (Expr 'Buf)
-> Expr 'Buf -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     (Expr 'Buf)
     (Expr 'Buf)
-> Optic A_Lens '[] (VM t s) (VM t s) (Expr 'Buf) (Expr 'Buf)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  (Expr 'Buf)
  (Expr 'Buf)
#returndata) Expr 'Buf
input
          Expr 'Buf -> Expr 'EWord -> Expr 'EWord -> EVM t s ()
forall (t :: VMType) s.
Expr 'Buf -> Expr 'EWord -> Expr 'EWord -> EVM t s ()
copyCallBytesToMemory Expr 'Buf
input Expr 'EWord
outSize Expr 'EWord
outOffset
          EVM t s ()
forall (t :: VMType) s. (?op::Word8) => EVM t s ()
next

      -- MODEXP
      Addr
0x5 ->
        -- TODO: support symbolic variant
        Expr 'Buf -> [Char] -> (ByteString -> EVM t s ()) -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'Buf -> [Char] -> (ByteString -> EVM t s ()) -> EVM t s ()
forceConcreteBuf Expr 'Buf
input [Char]
"MODEXP" ((ByteString -> EVM t s ()) -> EVM t s ())
-> (ByteString -> EVM t s ()) -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ \ByteString
input' -> do
          let
            (W256
lenb, W256
lene, W256
lenm) = ByteString -> (W256, W256, W256)
parseModexpLength ByteString
input'

            output :: Expr 'Buf
output = ByteString -> Expr 'Buf
ConcreteBuf (ByteString -> Expr 'Buf) -> ByteString -> Expr 'Buf
forall a b. (a -> b) -> a -> b
$
              if W256 -> W256 -> ByteString -> Bool
isZero (W256
96 W256 -> W256 -> W256
forall a. Num a => a -> a -> a
+ W256
lenb W256 -> W256 -> W256
forall a. Num a => a -> a -> a
+ W256
lene) W256
lenm ByteString
input'
              then Int -> ByteString -> ByteString
truncpadlit (W256 -> Int
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto W256
lenm) (Int -> ByteString
forall a. Integral a => a -> ByteString
asBE (Int
0 :: Int))
              else
                let
                  b :: Integer
b = ByteString -> Integer
asInteger (ByteString -> Integer) -> ByteString -> Integer
forall a b. (a -> b) -> a -> b
$ W256 -> W256 -> ByteString -> ByteString
lazySlice W256
96 W256
lenb ByteString
input'
                  e :: Integer
e = ByteString -> Integer
asInteger (ByteString -> Integer) -> ByteString -> Integer
forall a b. (a -> b) -> a -> b
$ W256 -> W256 -> ByteString -> ByteString
lazySlice (W256
96 W256 -> W256 -> W256
forall a. Num a => a -> a -> a
+ W256
lenb) W256
lene ByteString
input'
                  m :: Integer
m = ByteString -> Integer
asInteger (ByteString -> Integer) -> ByteString -> Integer
forall a b. (a -> b) -> a -> b
$ W256 -> W256 -> ByteString -> ByteString
lazySlice (W256
96 W256 -> W256 -> W256
forall a. Num a => a -> a -> a
+ W256
lenb W256 -> W256 -> W256
forall a. Num a => a -> a -> a
+ W256
lene) W256
lenm ByteString
input'
                in
                  Int -> ByteString -> ByteString
padLeft (W256 -> Int
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto W256
lenm) (Integer -> ByteString
forall a. Integral a => a -> ByteString
asBE (Integer -> Integer -> Integer -> Integer
expFast Integer
b Integer
e Integer
m))
          Optic A_Lens '[] (VM t s) (VM t s) [Expr 'EWord] [Expr 'EWord]
-> [Expr 'EWord] -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     [Expr 'EWord]
     [Expr 'EWord]
-> Optic A_Lens '[] (VM t s) (VM t s) [Expr 'EWord] [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  [Expr 'EWord]
  [Expr 'EWord]
#stack) (W256 -> Expr 'EWord
Lit W256
1 Expr 'EWord -> [Expr 'EWord] -> [Expr 'EWord]
forall a. a -> [a] -> [a]
: [Expr 'EWord]
xs)
          Optic A_Lens '[] (VM t s) (VM t s) (Expr 'Buf) (Expr 'Buf)
-> Expr 'Buf -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     (Expr 'Buf)
     (Expr 'Buf)
-> Optic A_Lens '[] (VM t s) (VM t s) (Expr 'Buf) (Expr 'Buf)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  (Expr 'Buf)
  (Expr 'Buf)
#returndata) Expr 'Buf
output
          Expr 'Buf
-> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM t s ()
forall (t :: VMType) s.
Expr 'Buf
-> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM t s ()
copyBytesToMemory Expr 'Buf
output Expr 'EWord
outSize (W256 -> Expr 'EWord
Lit W256
0) Expr 'EWord
outOffset
          EVM t s ()
forall (t :: VMType) s. (?op::Word8) => EVM t s ()
next

      -- ECADD
      Addr
0x6 ->
        -- TODO: support symbolic variant
        Expr 'Buf -> [Char] -> (ByteString -> EVM t s ()) -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'Buf -> [Char] -> (ByteString -> EVM t s ()) -> EVM t s ()
forceConcreteBuf Expr 'Buf
input [Char]
"ECADD" ((ByteString -> EVM t s ()) -> EVM t s ())
-> (ByteString -> EVM t s ()) -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ \ByteString
input' ->
          case Int -> ByteString -> Int -> Maybe ByteString
EVM.Precompiled.execute Int
0x6 (Int -> ByteString -> ByteString
truncpadlit Int
128 ByteString
input') Int
64 of
            Maybe ByteString
Nothing -> EVM t s ()
precompileFail
            Just ByteString
output -> do
              let truncpaddedOutput :: Expr 'Buf
truncpaddedOutput = ByteString -> Expr 'Buf
ConcreteBuf (ByteString -> Expr 'Buf) -> ByteString -> Expr 'Buf
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
truncpadlit Int
64 ByteString
output
              Optic A_Lens '[] (VM t s) (VM t s) [Expr 'EWord] [Expr 'EWord]
-> [Expr 'EWord] -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     [Expr 'EWord]
     [Expr 'EWord]
-> Optic A_Lens '[] (VM t s) (VM t s) [Expr 'EWord] [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  [Expr 'EWord]
  [Expr 'EWord]
#stack) (W256 -> Expr 'EWord
Lit W256
1 Expr 'EWord -> [Expr 'EWord] -> [Expr 'EWord]
forall a. a -> [a] -> [a]
: [Expr 'EWord]
xs)
              Optic A_Lens '[] (VM t s) (VM t s) (Expr 'Buf) (Expr 'Buf)
-> Expr 'Buf -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     (Expr 'Buf)
     (Expr 'Buf)
-> Optic A_Lens '[] (VM t s) (VM t s) (Expr 'Buf) (Expr 'Buf)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  (Expr 'Buf)
  (Expr 'Buf)
#returndata) Expr 'Buf
truncpaddedOutput
              Expr 'Buf
-> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM t s ()
forall (t :: VMType) s.
Expr 'Buf
-> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM t s ()
copyBytesToMemory Expr 'Buf
truncpaddedOutput Expr 'EWord
outSize (W256 -> Expr 'EWord
Lit W256
0) Expr 'EWord
outOffset
              EVM t s ()
forall (t :: VMType) s. (?op::Word8) => EVM t s ()
next

      -- ECMUL
      Addr
0x7 ->
        -- TODO: support symbolic variant
        Expr 'Buf -> [Char] -> (ByteString -> EVM t s ()) -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'Buf -> [Char] -> (ByteString -> EVM t s ()) -> EVM t s ()
forceConcreteBuf Expr 'Buf
input [Char]
"ECMUL" ((ByteString -> EVM t s ()) -> EVM t s ())
-> (ByteString -> EVM t s ()) -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ \ByteString
input' ->
          case Int -> ByteString -> Int -> Maybe ByteString
EVM.Precompiled.execute Int
0x7 (Int -> ByteString -> ByteString
truncpadlit Int
96 ByteString
input') Int
64 of
          Maybe ByteString
Nothing -> EVM t s ()
precompileFail
          Just ByteString
output -> do
            let truncpaddedOutput :: Expr 'Buf
truncpaddedOutput = ByteString -> Expr 'Buf
ConcreteBuf (ByteString -> Expr 'Buf) -> ByteString -> Expr 'Buf
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
truncpadlit Int
64 ByteString
output
            Optic A_Lens '[] (VM t s) (VM t s) [Expr 'EWord] [Expr 'EWord]
-> [Expr 'EWord] -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     [Expr 'EWord]
     [Expr 'EWord]
-> Optic A_Lens '[] (VM t s) (VM t s) [Expr 'EWord] [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  [Expr 'EWord]
  [Expr 'EWord]
#stack) (W256 -> Expr 'EWord
Lit W256
1 Expr 'EWord -> [Expr 'EWord] -> [Expr 'EWord]
forall a. a -> [a] -> [a]
: [Expr 'EWord]
xs)
            Optic A_Lens '[] (VM t s) (VM t s) (Expr 'Buf) (Expr 'Buf)
-> Expr 'Buf -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     (Expr 'Buf)
     (Expr 'Buf)
-> Optic A_Lens '[] (VM t s) (VM t s) (Expr 'Buf) (Expr 'Buf)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  (Expr 'Buf)
  (Expr 'Buf)
#returndata) Expr 'Buf
truncpaddedOutput
            Expr 'Buf
-> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM t s ()
forall (t :: VMType) s.
Expr 'Buf
-> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM t s ()
copyBytesToMemory Expr 'Buf
truncpaddedOutput Expr 'EWord
outSize (W256 -> Expr 'EWord
Lit W256
0) Expr 'EWord
outOffset
            EVM t s ()
forall (t :: VMType) s. (?op::Word8) => EVM t s ()
next

      -- ECPAIRING
      Addr
0x8 ->
        -- TODO: support symbolic variant
        Expr 'Buf -> [Char] -> (ByteString -> EVM t s ()) -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'Buf -> [Char] -> (ByteString -> EVM t s ()) -> EVM t s ()
forceConcreteBuf Expr 'Buf
input [Char]
"ECPAIR" ((ByteString -> EVM t s ()) -> EVM t s ())
-> (ByteString -> EVM t s ()) -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ \ByteString
input' ->
          case Int -> ByteString -> Int -> Maybe ByteString
EVM.Precompiled.execute Int
0x8 ByteString
input' Int
32 of
          Maybe ByteString
Nothing -> EVM t s ()
precompileFail
          Just ByteString
output -> do
            let truncpaddedOutput :: Expr 'Buf
truncpaddedOutput = ByteString -> Expr 'Buf
ConcreteBuf (ByteString -> Expr 'Buf) -> ByteString -> Expr 'Buf
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
truncpadlit Int
32 ByteString
output
            Optic A_Lens '[] (VM t s) (VM t s) [Expr 'EWord] [Expr 'EWord]
-> [Expr 'EWord] -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     [Expr 'EWord]
     [Expr 'EWord]
-> Optic A_Lens '[] (VM t s) (VM t s) [Expr 'EWord] [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  [Expr 'EWord]
  [Expr 'EWord]
#stack) (W256 -> Expr 'EWord
Lit W256
1 Expr 'EWord -> [Expr 'EWord] -> [Expr 'EWord]
forall a. a -> [a] -> [a]
: [Expr 'EWord]
xs)
            Optic A_Lens '[] (VM t s) (VM t s) (Expr 'Buf) (Expr 'Buf)
-> Expr 'Buf -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     (Expr 'Buf)
     (Expr 'Buf)
-> Optic A_Lens '[] (VM t s) (VM t s) (Expr 'Buf) (Expr 'Buf)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  (Expr 'Buf)
  (Expr 'Buf)
#returndata) Expr 'Buf
truncpaddedOutput
            Expr 'Buf
-> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM t s ()
forall (t :: VMType) s.
Expr 'Buf
-> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM t s ()
copyBytesToMemory Expr 'Buf
truncpaddedOutput Expr 'EWord
outSize (W256 -> Expr 'EWord
Lit W256
0) Expr 'EWord
outOffset
            EVM t s ()
forall (t :: VMType) s. (?op::Word8) => EVM t s ()
next

      -- BLAKE2
      Addr
0x9 ->
        -- TODO: support symbolic variant
        Expr 'Buf -> [Char] -> (ByteString -> EVM t s ()) -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'Buf -> [Char] -> (ByteString -> EVM t s ()) -> EVM t s ()
forceConcreteBuf Expr 'Buf
input [Char]
"BLAKE2" ((ByteString -> EVM t s ()) -> EVM t s ())
-> (ByteString -> EVM t s ()) -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ \ByteString
input' -> do
          case (ByteString -> Int
BS.length ByteString
input', Word8
1 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= HasCallStack => ByteString -> Word8
ByteString -> Word8
BS.last ByteString
input') of
            (Int
213, Bool
True) -> case Int -> ByteString -> Int -> Maybe ByteString
EVM.Precompiled.execute Int
0x9 ByteString
input' Int
64 of
              Just ByteString
output -> do
                let truncpaddedOutput :: Expr 'Buf
truncpaddedOutput = ByteString -> Expr 'Buf
ConcreteBuf (ByteString -> Expr 'Buf) -> ByteString -> Expr 'Buf
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
truncpadlit Int
64 ByteString
output
                Optic A_Lens '[] (VM t s) (VM t s) [Expr 'EWord] [Expr 'EWord]
-> [Expr 'EWord] -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     [Expr 'EWord]
     [Expr 'EWord]
-> Optic A_Lens '[] (VM t s) (VM t s) [Expr 'EWord] [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  [Expr 'EWord]
  [Expr 'EWord]
#stack) (W256 -> Expr 'EWord
Lit W256
1 Expr 'EWord -> [Expr 'EWord] -> [Expr 'EWord]
forall a. a -> [a] -> [a]
: [Expr 'EWord]
xs)
                Optic A_Lens '[] (VM t s) (VM t s) (Expr 'Buf) (Expr 'Buf)
-> Expr 'Buf -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     (Expr 'Buf)
     (Expr 'Buf)
-> Optic A_Lens '[] (VM t s) (VM t s) (Expr 'Buf) (Expr 'Buf)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  (Expr 'Buf)
  (Expr 'Buf)
#returndata) Expr 'Buf
truncpaddedOutput
                Expr 'Buf
-> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM t s ()
forall (t :: VMType) s.
Expr 'Buf
-> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM t s ()
copyBytesToMemory Expr 'Buf
truncpaddedOutput Expr 'EWord
outSize (W256 -> Expr 'EWord
Lit W256
0) Expr 'EWord
outOffset
                EVM t s ()
forall (t :: VMType) s. (?op::Word8) => EVM t s ()
next
              Maybe ByteString
Nothing -> EVM t s ()
precompileFail
            (Int, Bool)
_ -> EVM t s ()
precompileFail

      Addr
_ -> EVM t s ()
notImplemented

truncpadlit :: Int -> ByteString -> ByteString
truncpadlit :: Int -> ByteString -> ByteString
truncpadlit Int
n ByteString
xs = if Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
n then Int -> ByteString -> ByteString
BS.take Int
n ByteString
xs
                   else ByteString -> ByteString -> ByteString
BS.append ByteString
xs (Int -> Word8 -> ByteString
BS.replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
m) Word8
0)
  where m :: Int
m = ByteString -> Int
BS.length ByteString
xs

lazySlice :: W256 -> W256 -> ByteString -> LS.ByteString
lazySlice :: W256 -> W256 -> ByteString -> ByteString
lazySlice W256
offset W256
size ByteString
bs =
  let bs' :: ByteString
bs' = Int64 -> ByteString -> ByteString
LS.take (W256 -> Int64
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto W256
size) (Int64 -> ByteString -> ByteString
LS.drop (W256 -> Int64
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto W256
offset) (ByteString -> ByteString
fromStrict ByteString
bs))
  in ByteString
bs' ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Int64 -> Word8 -> ByteString
LS.replicate (W256 -> Int64
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto W256
size Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- ByteString -> Int64
LS.length ByteString
bs') Word8
0

parseModexpLength :: ByteString -> (W256, W256, W256)
parseModexpLength :: ByteString -> (W256, W256, W256)
parseModexpLength ByteString
input =
  let lenb :: W256
lenb = ByteString -> W256
word (ByteString -> W256) -> ByteString -> W256
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
LS.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ W256 -> W256 -> ByteString -> ByteString
lazySlice  W256
0 W256
32 ByteString
input
      lene :: W256
lene = ByteString -> W256
word (ByteString -> W256) -> ByteString -> W256
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
LS.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ W256 -> W256 -> ByteString -> ByteString
lazySlice W256
32 W256
64 ByteString
input
      lenm :: W256
lenm = ByteString -> W256
word (ByteString -> W256) -> ByteString -> W256
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
LS.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ W256 -> W256 -> ByteString -> ByteString
lazySlice W256
64 W256
96 ByteString
input
  in (W256
lenb, W256
lene, W256
lenm)

--- checks if a range of ByteString bs starting at offset and length size is all zeros.
isZero :: W256 -> W256 -> ByteString -> Bool
isZero :: W256 -> W256 -> ByteString -> Bool
isZero W256
offset W256
size ByteString
bs =
  (Word8 -> Bool) -> ByteString -> Bool
LS.all (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0) (ByteString -> Bool) -> ByteString -> Bool
forall a b. (a -> b) -> a -> b
$
    Int64 -> ByteString -> ByteString
LS.take (W256 -> Int64
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto W256
size) (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$
      Int64 -> ByteString -> ByteString
LS.drop (W256 -> Int64
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto W256
offset) (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$
        ByteString -> ByteString
fromStrict ByteString
bs

asInteger :: LS.ByteString -> Integer
asInteger :: ByteString -> Integer
asInteger ByteString
xs = if ByteString
xs ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
forall a. Monoid a => a
mempty then Integer
0
  else Integer
256 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* ByteString -> Integer
asInteger (HasCallStack => ByteString -> ByteString
ByteString -> ByteString
LS.init ByteString
xs)
      Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Word8 -> Integer
forall target source. From source target => source -> target
into (HasCallStack => ByteString -> Word8
ByteString -> Word8
LS.last ByteString
xs)

-- * Opcode helper actions

noop :: Monad m => m ()
noop :: forall (m :: * -> *). Monad m => m ()
noop = () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

pushTo :: MonadState s m => Lens s s [a] [a] -> a -> m ()
pushTo :: forall s (m :: * -> *) a.
MonadState s m =>
Lens s s [a] [a] -> a -> m ()
pushTo Lens s s [a] [a]
f a
x = Lens s s [a] [a]
f Lens s s [a] [a] -> ([a] -> [a]) -> m ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
%= (a
x :)

pushToSequence :: MonadState s m => Setter s s (Seq a) (Seq a) -> a -> m ()
pushToSequence :: forall s (m :: * -> *) a.
MonadState s m =>
Setter s s (Seq a) (Seq a) -> a -> m ()
pushToSequence Setter s s (Seq a) (Seq a)
f a
x = Setter s s (Seq a) (Seq a)
f Setter s s (Seq a) (Seq a) -> (Seq a -> Seq a) -> m ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
%= (Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
Seq.|> a
x)

getCodeLocation :: VM t s -> CodeLocation
getCodeLocation :: forall (t :: VMType) s. VM t s -> CodeLocation
getCodeLocation VM t s
vm = (VM t s
vm.state.contract, VM t s
vm.state.pc)

query :: Query t s -> EVM t s ()
query :: forall (t :: VMType) s. Query t s -> EVM t s ()
query = Optic
  A_Lens
  '[]
  (VM t s)
  (VM t s)
  (Maybe (VMResult t s))
  (Maybe (VMResult t s))
-> Maybe (VMResult t s) -> StateT (VM t s) (ST s) ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign Optic
  A_Lens
  '[]
  (VM t s)
  (VM t s)
  (Maybe (VMResult t s))
  (Maybe (VMResult t s))
#result (Maybe (VMResult t s) -> StateT (VM t s) (ST s) ())
-> (Query t s -> Maybe (VMResult t s))
-> Query t s
-> StateT (VM t s) (ST s) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VMResult t s -> Maybe (VMResult t s)
forall a. a -> Maybe a
Just (VMResult t s -> Maybe (VMResult t s))
-> (Query t s -> VMResult t s) -> Query t s -> Maybe (VMResult t s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Effect t s -> VMResult t s
forall (t :: VMType) s. Effect t s -> VMResult t s
HandleEffect (Effect t s -> VMResult t s)
-> (Query t s -> Effect t s) -> Query t s -> VMResult t s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Query t s -> Effect t s
forall (t :: VMType) s. Query t s -> Effect t s
Query

choose :: Choose s -> EVM Symbolic s ()
choose :: forall s. Choose s -> EVM 'Symbolic s ()
choose = Optic
  A_Lens
  '[]
  (VM 'Symbolic s)
  (VM 'Symbolic s)
  (Maybe (VMResult 'Symbolic s))
  (Maybe (VMResult 'Symbolic s))
-> Maybe (VMResult 'Symbolic s)
-> StateT (VM 'Symbolic s) (ST s) ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign Optic
  A_Lens
  '[]
  (VM 'Symbolic s)
  (VM 'Symbolic s)
  (Maybe (VMResult 'Symbolic s))
  (Maybe (VMResult 'Symbolic s))
#result (Maybe (VMResult 'Symbolic s) -> StateT (VM 'Symbolic s) (ST s) ())
-> (Choose s -> Maybe (VMResult 'Symbolic s))
-> Choose s
-> StateT (VM 'Symbolic s) (ST s) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VMResult 'Symbolic s -> Maybe (VMResult 'Symbolic s)
forall a. a -> Maybe a
Just (VMResult 'Symbolic s -> Maybe (VMResult 'Symbolic s))
-> (Choose s -> VMResult 'Symbolic s)
-> Choose s
-> Maybe (VMResult 'Symbolic s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Effect 'Symbolic s -> VMResult 'Symbolic s
forall (t :: VMType) s. Effect t s -> VMResult t s
HandleEffect (Effect 'Symbolic s -> VMResult 'Symbolic s)
-> (Choose s -> Effect 'Symbolic s)
-> Choose s
-> VMResult 'Symbolic s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Choose s -> Effect 'Symbolic s
forall s. Choose s -> Effect 'Symbolic s
Choose

-- | Construct RPC Query and halt execution until resolved
fetchAccount :: VMOps t => Expr EAddr -> (Contract -> EVM t s ()) -> EVM t s ()
fetchAccount :: forall (t :: VMType) s.
VMOps t =>
Expr 'EAddr -> (Contract -> EVM t s ()) -> EVM t s ()
fetchAccount Expr 'EAddr
addr Contract -> EVM t s ()
continue =
  Optic' A_Lens '[] (VM t s) (Maybe Contract)
-> StateT (VM t s) (ST s) (Maybe Contract)
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic A_Lens '[] (VM t s) (VM t s) Env Env
#env Optic A_Lens '[] (VM t s) (VM t s) Env Env
-> Optic
     A_Lens
     '[]
     Env
     Env
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
-> Optic
     A_Lens
     '[]
     (VM t s)
     (VM t s)
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  Env
  Env
  (Map (Expr 'EAddr) Contract)
  (Map (Expr 'EAddr) Contract)
#contracts Optic
  A_Lens
  '[]
  (VM t s)
  (VM t s)
  (Map (Expr 'EAddr) Contract)
  (Map (Expr 'EAddr) Contract)
-> Optic
     A_Lens
     '[]
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
     (Maybe Contract)
     (Maybe Contract)
-> Optic' A_Lens '[] (VM t s) (Maybe Contract)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Index (Map (Expr 'EAddr) Contract)
-> Lens'
     (Map (Expr 'EAddr) Contract)
     (Maybe (IxValue (Map (Expr 'EAddr) Contract)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map (Expr 'EAddr) Contract)
Expr 'EAddr
addr) StateT (VM t s) (ST s) (Maybe Contract)
-> (Maybe Contract -> EVM t s ()) -> EVM t s ()
forall a b.
StateT (VM t s) (ST s) a
-> (a -> StateT (VM t s) (ST s) b) -> StateT (VM t s) (ST s) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just Contract
c -> Contract -> EVM t s ()
continue Contract
c
    Maybe Contract
Nothing -> case Expr 'EAddr
addr of
      SymAddr Text
_ -> do
        Int
pc <- Optic' A_Lens '[] (VM t s) Int -> StateT (VM t s) (ST s) Int
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic A_Lens '[] (FrameState t s) (FrameState t s) Int Int
-> Optic' A_Lens '[] (VM t s) Int
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens '[] (FrameState t s) (FrameState t s) Int Int
#pc)
        PartialExec -> EVM t s ()
forall s. PartialExec -> EVM t s ()
forall (t :: VMType) s. VMOps t => PartialExec -> EVM t s ()
partial (PartialExec -> EVM t s ()) -> PartialExec -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ Int -> [Char] -> [SomeExpr] -> PartialExec
UnexpectedSymbolicArg Int
pc [Char]
"trying to access a symbolic address that isn't already present in storage" ([Expr 'EAddr] -> [SomeExpr]
forall (a :: EType). Typeable a => [Expr a] -> [SomeExpr]
wrap [Expr 'EAddr
addr])
      LitAddr Addr
a -> do
        Optic' A_Lens '[] (VM t s) (Maybe Contract)
-> StateT (VM t s) (ST s) (Maybe Contract)
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic A_Lens '[] (VM t s) (VM t s) Cache Cache
#cache Optic A_Lens '[] (VM t s) (VM t s) Cache Cache
-> Optic
     A_Lens '[] Cache Cache (Map Addr Contract) (Map Addr Contract)
-> Optic
     A_Lens
     '[]
     (VM t s)
     (VM t s)
     (Map Addr Contract)
     (Map Addr Contract)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens '[] Cache Cache (Map Addr Contract) (Map Addr Contract)
#fetched Optic
  A_Lens
  '[]
  (VM t s)
  (VM t s)
  (Map Addr Contract)
  (Map Addr Contract)
-> Optic
     A_Lens
     '[]
     (Map Addr Contract)
     (Map Addr Contract)
     (Maybe Contract)
     (Maybe Contract)
-> Optic' A_Lens '[] (VM t s) (Maybe Contract)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Index (Map Addr Contract)
-> Lens' (Map Addr Contract) (Maybe (IxValue (Map Addr Contract)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map Addr Contract)
Addr
a) StateT (VM t s) (ST s) (Maybe Contract)
-> (Maybe Contract -> EVM t s ()) -> EVM t s ()
forall a b.
StateT (VM t s) (ST s) a
-> (a -> StateT (VM t s) (ST s) b) -> StateT (VM t s) (ST s) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Just Contract
c -> do
            Optic
  A_Lens
  '[]
  (VM t s)
  (VM t s)
  (Maybe (IxValue (Map (Expr 'EAddr) Contract)))
  (Maybe Contract)
-> Maybe Contract -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens '[] (VM t s) (VM t s) Env Env
#env Optic A_Lens '[] (VM t s) (VM t s) Env Env
-> Optic
     A_Lens
     '[]
     Env
     Env
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
-> Optic
     A_Lens
     '[]
     (VM t s)
     (VM t s)
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  Env
  Env
  (Map (Expr 'EAddr) Contract)
  (Map (Expr 'EAddr) Contract)
#contracts Optic
  A_Lens
  '[]
  (VM t s)
  (VM t s)
  (Map (Expr 'EAddr) Contract)
  (Map (Expr 'EAddr) Contract)
-> Optic
     A_Lens
     '[]
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
     (Maybe (IxValue (Map (Expr 'EAddr) Contract)))
     (Maybe Contract)
-> Optic
     A_Lens
     '[]
     (VM t s)
     (VM t s)
     (Maybe (IxValue (Map (Expr 'EAddr) Contract)))
     (Maybe Contract)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Index (Map (Expr 'EAddr) Contract)
-> Lens'
     (Map (Expr 'EAddr) Contract)
     (Maybe (IxValue (Map (Expr 'EAddr) Contract)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map (Expr 'EAddr) Contract)
Expr 'EAddr
addr) (Contract -> Maybe Contract
forall a. a -> Maybe a
Just Contract
c)
            Contract -> EVM t s ()
continue Contract
c
          Maybe Contract
Nothing -> do
            BaseState
base <- Optic' A_Lens '[] (VM t s) BaseState
-> StateT (VM t s) (ST s) BaseState
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic A_Lens '[] (VM t s) (VM t s) RuntimeConfig RuntimeConfig
#config Optic A_Lens '[] (VM t s) (VM t s) RuntimeConfig RuntimeConfig
-> Optic A_Lens '[] RuntimeConfig RuntimeConfig BaseState BaseState
-> Optic' A_Lens '[] (VM t s) BaseState
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens '[] RuntimeConfig RuntimeConfig BaseState BaseState
#baseState)
            Optic
  A_Lens
  '[]
  (VM t s)
  (VM t s)
  (Maybe (VMResult t s))
  (Maybe (VMResult t s))
-> Maybe (VMResult t s) -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens
  '[]
  (VM t s)
  (VM t s)
  (Maybe (VMResult t s))
  (Maybe (VMResult t s))
#result) (Maybe (VMResult t s) -> EVM t s ())
-> (Query t s -> Maybe (VMResult t s)) -> Query t s -> EVM t s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VMResult t s -> Maybe (VMResult t s)
forall a. a -> Maybe a
Just (VMResult t s -> Maybe (VMResult t s))
-> (Query t s -> VMResult t s) -> Query t s -> Maybe (VMResult t s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Effect t s -> VMResult t s
forall (t :: VMType) s. Effect t s -> VMResult t s
HandleEffect (Effect t s -> VMResult t s)
-> (Query t s -> Effect t s) -> Query t s -> VMResult t s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Query t s -> Effect t s
forall (t :: VMType) s. Query t s -> Effect t s
Query (Query t s -> EVM t s ()) -> Query t s -> EVM t s ()
forall a b. (a -> b) -> a -> b
$
              Addr -> BaseState -> (Contract -> EVM t s ()) -> Query t s
forall (t :: VMType) s.
Addr -> BaseState -> (Contract -> EVM t s ()) -> Query t s
PleaseFetchContract Addr
a BaseState
base
                (\Contract
c -> do Optic
  A_Lens
  '[]
  (VM t s)
  (VM t s)
  (Maybe (IxValue (Map Addr Contract)))
  (Maybe Contract)
-> Maybe Contract -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens '[] (VM t s) (VM t s) Cache Cache
#cache Optic A_Lens '[] (VM t s) (VM t s) Cache Cache
-> Optic
     A_Lens '[] Cache Cache (Map Addr Contract) (Map Addr Contract)
-> Optic
     A_Lens
     '[]
     (VM t s)
     (VM t s)
     (Map Addr Contract)
     (Map Addr Contract)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens '[] Cache Cache (Map Addr Contract) (Map Addr Contract)
#fetched Optic
  A_Lens
  '[]
  (VM t s)
  (VM t s)
  (Map Addr Contract)
  (Map Addr Contract)
-> Optic
     A_Lens
     '[]
     (Map Addr Contract)
     (Map Addr Contract)
     (Maybe (IxValue (Map Addr Contract)))
     (Maybe Contract)
-> Optic
     A_Lens
     '[]
     (VM t s)
     (VM t s)
     (Maybe (IxValue (Map Addr Contract)))
     (Maybe Contract)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Index (Map Addr Contract)
-> Lens' (Map Addr Contract) (Maybe (IxValue (Map Addr Contract)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map Addr Contract)
Addr
a) (Contract -> Maybe Contract
forall a. a -> Maybe a
Just Contract
c)
                          Optic
  A_Lens
  '[]
  (VM t s)
  (VM t s)
  (Maybe (IxValue (Map (Expr 'EAddr) Contract)))
  (Maybe Contract)
-> Maybe Contract -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens '[] (VM t s) (VM t s) Env Env
#env Optic A_Lens '[] (VM t s) (VM t s) Env Env
-> Optic
     A_Lens
     '[]
     Env
     Env
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
-> Optic
     A_Lens
     '[]
     (VM t s)
     (VM t s)
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  Env
  Env
  (Map (Expr 'EAddr) Contract)
  (Map (Expr 'EAddr) Contract)
#contracts Optic
  A_Lens
  '[]
  (VM t s)
  (VM t s)
  (Map (Expr 'EAddr) Contract)
  (Map (Expr 'EAddr) Contract)
-> Optic
     A_Lens
     '[]
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
     (Maybe (IxValue (Map (Expr 'EAddr) Contract)))
     (Maybe Contract)
-> Optic
     A_Lens
     '[]
     (VM t s)
     (VM t s)
     (Maybe (IxValue (Map (Expr 'EAddr) Contract)))
     (Maybe Contract)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Index (Map (Expr 'EAddr) Contract)
-> Lens'
     (Map (Expr 'EAddr) Contract)
     (Maybe (IxValue (Map (Expr 'EAddr) Contract)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map (Expr 'EAddr) Contract)
Expr 'EAddr
addr) (Contract -> Maybe Contract
forall a. a -> Maybe a
Just Contract
c)
                          Optic
  A_Lens
  '[]
  (VM t s)
  (VM t s)
  (Maybe (VMResult t s))
  (Maybe (VMResult t s))
-> Maybe (VMResult t s) -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign Optic
  A_Lens
  '[]
  (VM t s)
  (VM t s)
  (Maybe (VMResult t s))
  (Maybe (VMResult t s))
#result Maybe (VMResult t s)
forall a. Maybe a
Nothing
                          Contract -> EVM t s ()
continue Contract
c)
      GVar GVar 'EAddr
_ -> [Char] -> EVM t s ()
forall a. HasCallStack => [Char] -> a
internalError [Char]
"Unexpected GVar"

accessStorage
  :: VMOps t => Expr EAddr
  -> Expr EWord
  -> (Expr EWord -> EVM t s ())
  -> EVM t s ()
accessStorage :: forall (t :: VMType) s.
VMOps t =>
Expr 'EAddr
-> Expr 'EWord -> (Expr 'EWord -> EVM t s ()) -> EVM t s ()
accessStorage Expr 'EAddr
addr Expr 'EWord
slot Expr 'EWord -> EVM t s ()
continue = do
  let slotConc :: Expr 'EWord
slotConc = Expr 'EWord -> Expr 'EWord
forall (a :: EType). Expr a -> Expr a
Expr.concKeccakSimpExpr Expr 'EWord
slot
  Optic'
  A_Lens '[] (VM t s) (Maybe (IxValue (Map (Expr 'EAddr) Contract)))
-> StateT
     (VM t s) (ST s) (Maybe (IxValue (Map (Expr 'EAddr) Contract)))
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic A_Lens '[] (VM t s) (VM t s) Env Env
#env Optic A_Lens '[] (VM t s) (VM t s) Env Env
-> Optic
     A_Lens
     '[]
     Env
     Env
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
-> Optic
     A_Lens
     '[]
     (VM t s)
     (VM t s)
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  Env
  Env
  (Map (Expr 'EAddr) Contract)
  (Map (Expr 'EAddr) Contract)
#contracts Optic
  A_Lens
  '[]
  (VM t s)
  (VM t s)
  (Map (Expr 'EAddr) Contract)
  (Map (Expr 'EAddr) Contract)
-> Lens'
     (Map (Expr 'EAddr) Contract)
     (Maybe (IxValue (Map (Expr 'EAddr) Contract)))
-> Optic'
     A_Lens '[] (VM t s) (Maybe (IxValue (Map (Expr 'EAddr) Contract)))
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Index (Map (Expr 'EAddr) Contract)
-> Lens'
     (Map (Expr 'EAddr) Contract)
     (Maybe (IxValue (Map (Expr 'EAddr) Contract)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map (Expr 'EAddr) Contract)
Expr 'EAddr
addr) StateT
  (VM t s) (ST s) (Maybe (IxValue (Map (Expr 'EAddr) Contract)))
-> (Maybe (IxValue (Map (Expr 'EAddr) Contract)) -> EVM t s ())
-> EVM t s ()
forall a b.
StateT (VM t s) (ST s) a
-> (a -> StateT (VM t s) (ST s) b) -> StateT (VM t s) (ST s) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just IxValue (Map (Expr 'EAddr) Contract)
c ->
      -- Try first without concretization. Then if we get a Just, with concretization
      -- if both give a Just, should we `continue`.
      -- --> This is because readStorage can do smart rewrites, but only in case
      --     the expression is of a particular format, which can be destroyed by simplification.
      --     However, without concretization, it may not find things that are actually in the storage
      case Expr 'EWord -> Expr 'Storage -> Maybe (Expr 'EWord)
readStorage Expr 'EWord
slot IxValue (Map (Expr 'EAddr) Contract)
c.storage of
        Just Expr 'EWord
x -> case Expr 'EWord -> Expr 'Storage -> Maybe (Expr 'EWord)
readStorage Expr 'EWord
slotConc IxValue (Map (Expr 'EAddr) Contract)
c.storage of
          Just Expr 'EWord
_ -> Expr 'EWord -> EVM t s ()
continue Expr 'EWord
x
          Maybe (Expr 'EWord)
Nothing -> IxValue (Map (Expr 'EAddr) Contract) -> Expr 'EWord -> EVM t s ()
rpcCall IxValue (Map (Expr 'EAddr) Contract)
c Expr 'EWord
slotConc
        Maybe (Expr 'EWord)
Nothing -> IxValue (Map (Expr 'EAddr) Contract) -> Expr 'EWord -> EVM t s ()
rpcCall IxValue (Map (Expr 'EAddr) Contract)
c Expr 'EWord
slotConc
    Maybe (IxValue (Map (Expr 'EAddr) Contract))
Nothing ->
      Expr 'EAddr -> (Contract -> EVM t s ()) -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EAddr -> (Contract -> EVM t s ()) -> EVM t s ()
fetchAccount Expr 'EAddr
addr ((Contract -> EVM t s ()) -> EVM t s ())
-> (Contract -> EVM t s ()) -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ \Contract
_ ->
        Expr 'EAddr
-> Expr 'EWord -> (Expr 'EWord -> EVM t s ()) -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EAddr
-> Expr 'EWord -> (Expr 'EWord -> EVM t s ()) -> EVM t s ()
accessStorage Expr 'EAddr
addr Expr 'EWord
slot Expr 'EWord -> EVM t s ()
continue
  where
      rpcCall :: IxValue (Map (Expr 'EAddr) Contract) -> Expr 'EWord -> EVM t s ()
rpcCall IxValue (Map (Expr 'EAddr) Contract)
c Expr 'EWord
slotConc = if IxValue (Map (Expr 'EAddr) Contract)
c.external
        then Expr 'EAddr -> [Char] -> (Addr -> EVM t s ()) -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EAddr -> [Char] -> (Addr -> EVM t s ()) -> EVM t s ()
forceConcreteAddr Expr 'EAddr
addr [Char]
"cannot read storage from symbolic addresses via rpc" ((Addr -> EVM t s ()) -> EVM t s ())
-> (Addr -> EVM t s ()) -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ \Addr
addr' ->
          Expr 'EWord -> [Char] -> (W256 -> EVM t s ()) -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EWord -> [Char] -> (W256 -> EVM t s ()) -> EVM t s ()
forceConcrete Expr 'EWord
slotConc [Char]
"cannot read symbolic slots via RPC" ((W256 -> EVM t s ()) -> EVM t s ())
-> (W256 -> EVM t s ()) -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ \W256
slot' -> do
            -- check if the slot is cached
            Maybe (IxValue (Map Addr Contract))
contract <- Optic'
  An_AffineTraversal '[] (VM t s) (IxValue (Map Addr Contract))
-> StateT (VM t s) (ST s) (Maybe (IxValue (Map Addr Contract)))
forall k s (m :: * -> *) (is :: IxList) a.
(Is k An_AffineFold, MonadState s m) =>
Optic' k is s a -> m (Maybe a)
preuse (Optic A_Lens '[] (VM t s) (VM t s) Cache Cache
#cache Optic A_Lens '[] (VM t s) (VM t s) Cache Cache
-> Optic
     A_Lens '[] Cache Cache (Map Addr Contract) (Map Addr Contract)
-> Optic
     A_Lens
     '[]
     (VM t s)
     (VM t s)
     (Map Addr Contract)
     (Map Addr Contract)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens '[] Cache Cache (Map Addr Contract) (Map Addr Contract)
#fetched Optic
  A_Lens
  '[]
  (VM t s)
  (VM t s)
  (Map Addr Contract)
  (Map Addr Contract)
-> Optic
     (IxKind (Map Addr Contract))
     '[]
     (Map Addr Contract)
     (Map Addr Contract)
     (IxValue (Map Addr Contract))
     (IxValue (Map Addr Contract))
-> Optic'
     An_AffineTraversal '[] (VM t s) (IxValue (Map Addr Contract))
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Index (Map Addr Contract)
-> Optic
     (IxKind (Map Addr Contract))
     '[]
     (Map Addr Contract)
     (Map Addr Contract)
     (IxValue (Map Addr Contract))
     (IxValue (Map Addr Contract))
forall m. Ixed m => Index m -> Optic' (IxKind m) '[] m (IxValue m)
ix Index (Map Addr Contract)
Addr
addr')
            case Maybe (IxValue (Map Addr Contract))
contract of
              Maybe (IxValue (Map Addr Contract))
Nothing -> [Char] -> EVM t s ()
forall a. HasCallStack => [Char] -> a
internalError [Char]
"contract marked external not found in cache"
              Just IxValue (Map Addr Contract)
fetched -> case Expr 'EWord -> Expr 'Storage -> Maybe (Expr 'EWord)
readStorage (W256 -> Expr 'EWord
Lit W256
slot') IxValue (Map Addr Contract)
fetched.storage of
                          Maybe (Expr 'EWord)
Nothing -> Addr -> W256 -> EVM t s ()
mkQuery Addr
addr' W256
slot'
                          Just Expr 'EWord
val -> Expr 'EWord -> EVM t s ()
continue Expr 'EWord
val
        else do
          Optic
  An_AffineTraversal
  '[]
  (VM t s)
  (VM t s)
  (Expr 'Storage)
  (Expr 'Storage)
-> (Expr 'Storage -> Expr 'Storage) -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying (Optic A_Lens '[] (VM t s) (VM t s) Env Env
#env Optic A_Lens '[] (VM t s) (VM t s) Env Env
-> Optic
     A_Lens
     '[]
     Env
     Env
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
-> Optic
     A_Lens
     '[]
     (VM t s)
     (VM t s)
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  Env
  Env
  (Map (Expr 'EAddr) Contract)
  (Map (Expr 'EAddr) Contract)
#contracts Optic
  A_Lens
  '[]
  (VM t s)
  (VM t s)
  (Map (Expr 'EAddr) Contract)
  (Map (Expr 'EAddr) Contract)
-> Optic
     (IxKind (Map (Expr 'EAddr) Contract))
     '[]
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
     (IxValue (Map (Expr 'EAddr) Contract))
     (IxValue (Map (Expr 'EAddr) Contract))
-> Optic
     An_AffineTraversal
     '[]
     (VM t s)
     (VM t s)
     (IxValue (Map (Expr 'EAddr) Contract))
     (IxValue (Map (Expr 'EAddr) Contract))
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Index (Map (Expr 'EAddr) Contract)
-> Optic
     (IxKind (Map (Expr 'EAddr) Contract))
     '[]
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
     (IxValue (Map (Expr 'EAddr) Contract))
     (IxValue (Map (Expr 'EAddr) Contract))
forall m. Ixed m => Index m -> Optic' (IxKind m) '[] m (IxValue m)
ix Index (Map (Expr 'EAddr) Contract)
Expr 'EAddr
addr Optic
  An_AffineTraversal
  '[]
  (VM t s)
  (VM t s)
  (IxValue (Map (Expr 'EAddr) Contract))
  (IxValue (Map (Expr 'EAddr) Contract))
-> Optic
     A_Lens
     '[]
     (IxValue (Map (Expr 'EAddr) Contract))
     (IxValue (Map (Expr 'EAddr) Contract))
     (Expr 'Storage)
     (Expr 'Storage)
-> Optic
     An_AffineTraversal
     '[]
     (VM t s)
     (VM t s)
     (Expr 'Storage)
     (Expr 'Storage)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (IxValue (Map (Expr 'EAddr) Contract))
  (IxValue (Map (Expr 'EAddr) Contract))
  (Expr 'Storage)
  (Expr 'Storage)
#storage) (Expr 'EWord -> Expr 'EWord -> Expr 'Storage -> Expr 'Storage
writeStorage Expr 'EWord
slot (W256 -> Expr 'EWord
Lit W256
0))
          Expr 'EWord -> EVM t s ()
continue (Expr 'EWord -> EVM t s ()) -> Expr 'EWord -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ W256 -> Expr 'EWord
Lit W256
0
      mkQuery :: Addr -> W256 -> EVM t s ()
mkQuery Addr
a W256
s = Query t s -> EVM t s ()
forall (t :: VMType) s. Query t s -> EVM t s ()
query (Query t s -> EVM t s ()) -> Query t s -> EVM t s ()
forall a b. (a -> b) -> a -> b
$
        Addr -> W256 -> (W256 -> EVM t s ()) -> Query t s
forall (t :: VMType) s.
Addr -> W256 -> (W256 -> EVM t s ()) -> Query t s
PleaseFetchSlot Addr
a W256
s
          (\W256
x -> do
              Optic
  An_AffineTraversal
  '[]
  (VM t s)
  (VM t s)
  (Expr 'Storage)
  (Expr 'Storage)
-> (Expr 'Storage -> Expr 'Storage) -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying (Optic A_Lens '[] (VM t s) (VM t s) Cache Cache
#cache Optic A_Lens '[] (VM t s) (VM t s) Cache Cache
-> Optic
     A_Lens '[] Cache Cache (Map Addr Contract) (Map Addr Contract)
-> Optic
     A_Lens
     '[]
     (VM t s)
     (VM t s)
     (Map Addr Contract)
     (Map Addr Contract)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens '[] Cache Cache (Map Addr Contract) (Map Addr Contract)
#fetched Optic
  A_Lens
  '[]
  (VM t s)
  (VM t s)
  (Map Addr Contract)
  (Map Addr Contract)
-> Optic
     (IxKind (Map Addr Contract))
     '[]
     (Map Addr Contract)
     (Map Addr Contract)
     (IxValue (Map Addr Contract))
     (IxValue (Map Addr Contract))
-> Optic'
     An_AffineTraversal '[] (VM t s) (IxValue (Map Addr Contract))
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Index (Map Addr Contract)
-> Optic
     (IxKind (Map Addr Contract))
     '[]
     (Map Addr Contract)
     (Map Addr Contract)
     (IxValue (Map Addr Contract))
     (IxValue (Map Addr Contract))
forall m. Ixed m => Index m -> Optic' (IxKind m) '[] m (IxValue m)
ix Index (Map Addr Contract)
Addr
a Optic'
  An_AffineTraversal '[] (VM t s) (IxValue (Map Addr Contract))
-> Optic
     A_Lens
     '[]
     (IxValue (Map Addr Contract))
     (IxValue (Map Addr Contract))
     (Expr 'Storage)
     (Expr 'Storage)
-> Optic
     An_AffineTraversal
     '[]
     (VM t s)
     (VM t s)
     (Expr 'Storage)
     (Expr 'Storage)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (IxValue (Map Addr Contract))
  (IxValue (Map Addr Contract))
  (Expr 'Storage)
  (Expr 'Storage)
#storage) (Expr 'EWord -> Expr 'EWord -> Expr 'Storage -> Expr 'Storage
writeStorage (W256 -> Expr 'EWord
Lit W256
s) (W256 -> Expr 'EWord
Lit W256
x))
              Optic
  An_AffineTraversal
  '[]
  (VM t s)
  (VM t s)
  (Expr 'Storage)
  (Expr 'Storage)
-> (Expr 'Storage -> Expr 'Storage) -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying (Optic A_Lens '[] (VM t s) (VM t s) Env Env
#env Optic A_Lens '[] (VM t s) (VM t s) Env Env
-> Optic
     A_Lens
     '[]
     Env
     Env
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
-> Optic
     A_Lens
     '[]
     (VM t s)
     (VM t s)
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  Env
  Env
  (Map (Expr 'EAddr) Contract)
  (Map (Expr 'EAddr) Contract)
#contracts Optic
  A_Lens
  '[]
  (VM t s)
  (VM t s)
  (Map (Expr 'EAddr) Contract)
  (Map (Expr 'EAddr) Contract)
-> Optic
     (IxKind (Map (Expr 'EAddr) Contract))
     '[]
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
     (IxValue (Map (Expr 'EAddr) Contract))
     (IxValue (Map (Expr 'EAddr) Contract))
-> Optic
     An_AffineTraversal
     '[]
     (VM t s)
     (VM t s)
     (IxValue (Map (Expr 'EAddr) Contract))
     (IxValue (Map (Expr 'EAddr) Contract))
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Index (Map (Expr 'EAddr) Contract)
-> Optic
     (IxKind (Map (Expr 'EAddr) Contract))
     '[]
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
     (IxValue (Map (Expr 'EAddr) Contract))
     (IxValue (Map (Expr 'EAddr) Contract))
forall m. Ixed m => Index m -> Optic' (IxKind m) '[] m (IxValue m)
ix (Addr -> Expr 'EAddr
LitAddr Addr
a) Optic
  An_AffineTraversal
  '[]
  (VM t s)
  (VM t s)
  (IxValue (Map (Expr 'EAddr) Contract))
  (IxValue (Map (Expr 'EAddr) Contract))
-> Optic
     A_Lens
     '[]
     (IxValue (Map (Expr 'EAddr) Contract))
     (IxValue (Map (Expr 'EAddr) Contract))
     (Expr 'Storage)
     (Expr 'Storage)
-> Optic
     An_AffineTraversal
     '[]
     (VM t s)
     (VM t s)
     (Expr 'Storage)
     (Expr 'Storage)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (IxValue (Map (Expr 'EAddr) Contract))
  (IxValue (Map (Expr 'EAddr) Contract))
  (Expr 'Storage)
  (Expr 'Storage)
#storage) (Expr 'EWord -> Expr 'EWord -> Expr 'Storage -> Expr 'Storage
writeStorage (W256 -> Expr 'EWord
Lit W256
s) (W256 -> Expr 'EWord
Lit W256
x))
              Optic
  A_Lens
  '[]
  (VM t s)
  (VM t s)
  (Maybe (VMResult t s))
  (Maybe (VMResult t s))
-> Maybe (VMResult t s) -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign Optic
  A_Lens
  '[]
  (VM t s)
  (VM t s)
  (Maybe (VMResult t s))
  (Maybe (VMResult t s))
#result Maybe (VMResult t s)
forall a. Maybe a
Nothing
              Expr 'EWord -> EVM t s ()
continue (W256 -> Expr 'EWord
Lit W256
x))

accountExists :: Expr EAddr -> VM t s -> Bool
accountExists :: forall (t :: VMType) s. Expr 'EAddr -> VM t s -> Bool
accountExists Expr 'EAddr
addr VM t s
vm =
  case Expr 'EAddr -> Map (Expr 'EAddr) Contract -> Maybe Contract
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Expr 'EAddr
addr VM t s
vm.env.contracts of
    Just Contract
c -> Bool -> Bool
not (Contract -> Bool
accountEmpty Contract
c)
    Maybe Contract
Nothing -> Bool
False

-- EIP 161
accountEmpty :: Contract -> Bool
accountEmpty :: Contract -> Bool
accountEmpty Contract
c =
  case Contract
c.code of
    RuntimeCode (ConcreteRuntimeCode ByteString
"") -> Bool
True
    RuntimeCode (SymbolicRuntimeCode Vector (Expr 'Byte)
b) -> Vector (Expr 'Byte) -> Bool
forall a. Vector a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Vector (Expr 'Byte)
b
    ContractCode
_ -> Bool
False
  Bool -> Bool -> Bool
&& Contract
c.nonce Maybe W64 -> Maybe W64 -> Bool
forall a. Eq a => a -> a -> Bool
== (W64 -> Maybe W64
forall a. a -> Maybe a
Just W64
0)
  -- TODO: handle symbolic balance...
  Bool -> Bool -> Bool
&& Contract
c.balance Expr 'EWord -> Expr 'EWord -> Bool
forall a. Eq a => a -> a -> Bool
== W256 -> Expr 'EWord
Lit W256
0

-- * How to finalize a transaction
finalize :: VMOps t => EVM t s ()
finalize :: forall (t :: VMType) s. VMOps t => EVM t s ()
finalize = do
  let
    revertContracts :: EVM t s ()
revertContracts  = Optic' A_Lens '[] (VM t s) (Map (Expr 'EAddr) Contract)
-> StateT (VM t s) (ST s) (Map (Expr 'EAddr) Contract)
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic A_Lens '[] (VM t s) (VM t s) TxState TxState
#tx Optic A_Lens '[] (VM t s) (VM t s) TxState TxState
-> Optic
     A_Lens
     '[]
     TxState
     TxState
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
-> Optic' A_Lens '[] (VM t s) (Map (Expr 'EAddr) Contract)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  TxState
  TxState
  (Map (Expr 'EAddr) Contract)
  (Map (Expr 'EAddr) Contract)
#txReversion) StateT (VM t s) (ST s) (Map (Expr 'EAddr) Contract)
-> (Map (Expr 'EAddr) Contract -> EVM t s ()) -> EVM t s ()
forall a b.
StateT (VM t s) (ST s) a
-> (a -> StateT (VM t s) (ST s) b) -> StateT (VM t s) (ST s) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Optic' A_Lens '[] (VM t s) (Map (Expr 'EAddr) Contract)
-> Map (Expr 'EAddr) Contract -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens '[] (VM t s) (VM t s) Env Env
#env Optic A_Lens '[] (VM t s) (VM t s) Env Env
-> Optic
     A_Lens
     '[]
     Env
     Env
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
-> Optic' A_Lens '[] (VM t s) (Map (Expr 'EAddr) Contract)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  Env
  Env
  (Map (Expr 'EAddr) Contract)
  (Map (Expr 'EAddr) Contract)
#contracts)
    revertSubstate :: EVM t s ()
revertSubstate   = Optic A_Lens '[] (VM t s) (VM t s) SubState SubState
-> SubState -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens '[] (VM t s) (VM t s) TxState TxState
#tx Optic A_Lens '[] (VM t s) (VM t s) TxState TxState
-> Optic A_Lens '[] TxState TxState SubState SubState
-> Optic A_Lens '[] (VM t s) (VM t s) SubState SubState
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens '[] TxState TxState SubState SubState
#substate) ([Expr 'EAddr]
-> [Expr 'EAddr]
-> Set (Expr 'EAddr)
-> Set (Expr 'EAddr, W256)
-> [(Expr 'EAddr, Word64)]
-> SubState
SubState [Expr 'EAddr]
forall a. Monoid a => a
mempty [Expr 'EAddr]
forall a. Monoid a => a
mempty Set (Expr 'EAddr)
forall a. Monoid a => a
mempty Set (Expr 'EAddr, W256)
forall a. Monoid a => a
mempty [(Expr 'EAddr, Word64)]
forall a. Monoid a => a
mempty)

  Optic' A_Lens '[] (VM t s) (Maybe (VMResult t s))
-> StateT (VM t s) (ST s) (Maybe (VMResult t s))
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use Optic' A_Lens '[] (VM t s) (Maybe (VMResult t s))
#result StateT (VM t s) (ST s) (Maybe (VMResult t s))
-> (Maybe (VMResult t s) -> EVM t s ()) -> EVM t s ()
forall a b.
StateT (VM t s) (ST s) a
-> (a -> StateT (VM t s) (ST s) b) -> StateT (VM t s) (ST s) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just (VMFailure (Revert Expr 'Buf
_)) -> do
      EVM t s ()
revertContracts
      EVM t s ()
revertSubstate
    Just (VMFailure EvmError
_) -> do
      -- burn remaining gas
      Optic A_Lens '[] (VM t s) (VM t s) (Gas t) (Gas t)
-> Gas t -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens '[] (FrameState t s) (FrameState t s) (Gas t) (Gas t)
-> Optic A_Lens '[] (VM t s) (VM t s) (Gas t) (Gas t)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens '[] (FrameState t s) (FrameState t s) (Gas t) (Gas t)
#gas) Gas t
forall (t :: VMType). VMOps t => Gas t
initialGas
      EVM t s ()
revertContracts
      EVM t s ()
revertSubstate
    Just (VMSuccess Expr 'Buf
output) -> do
      -- deposit the code from a creation tx
      Int
pc' <- Optic' A_Lens '[] (VM t s) Int -> StateT (VM t s) (ST s) Int
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic A_Lens '[] (FrameState t s) (FrameState t s) Int Int
-> Optic' A_Lens '[] (VM t s) Int
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens '[] (FrameState t s) (FrameState t s) Int Int
#pc)
      Bool
creation <- Optic' A_Lens '[] (VM t s) Bool -> StateT (VM t s) (ST s) Bool
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic A_Lens '[] (VM t s) (VM t s) TxState TxState
#tx Optic A_Lens '[] (VM t s) (VM t s) TxState TxState
-> Optic A_Lens '[] TxState TxState Bool Bool
-> Optic' A_Lens '[] (VM t s) Bool
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens '[] TxState TxState Bool Bool
#isCreate)
      Expr 'EAddr
createe  <- Optic' A_Lens '[] (VM t s) (Expr 'EAddr)
-> StateT (VM t s) (ST s) (Expr 'EAddr)
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     (Expr 'EAddr)
     (Expr 'EAddr)
-> Optic' A_Lens '[] (VM t s) (Expr 'EAddr)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  (Expr 'EAddr)
  (Expr 'EAddr)
#contract)
      Bool
createeExists <- (Expr 'EAddr -> Map (Expr 'EAddr) Contract -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member Expr 'EAddr
createe) (Map (Expr 'EAddr) Contract -> Bool)
-> StateT (VM t s) (ST s) (Map (Expr 'EAddr) Contract)
-> StateT (VM t s) (ST s) Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Optic' A_Lens '[] (VM t s) (Map (Expr 'EAddr) Contract)
-> StateT (VM t s) (ST s) (Map (Expr 'EAddr) Contract)
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic A_Lens '[] (VM t s) (VM t s) Env Env
#env Optic A_Lens '[] (VM t s) (VM t s) Env Env
-> Optic
     A_Lens
     '[]
     Env
     Env
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
-> Optic' A_Lens '[] (VM t s) (Map (Expr 'EAddr) Contract)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  Env
  Env
  (Map (Expr 'EAddr) Contract)
  (Map (Expr 'EAddr) Contract)
#contracts)
      let onContractCode :: ContractCode -> EVM t s ()
onContractCode ContractCode
contractCode =
            Bool -> EVM t s () -> EVM t s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
creation Bool -> Bool -> Bool
&& Bool
createeExists) (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ Expr 'EAddr -> ContractCode -> EVM t s ()
forall (t :: VMType) s. Expr 'EAddr -> ContractCode -> EVM t s ()
replaceCode Expr 'EAddr
createe ContractCode
contractCode
      case Expr 'Buf
output of
        ConcreteBuf ByteString
bs ->
          ContractCode -> EVM t s ()
onContractCode (ContractCode -> EVM t s ()) -> ContractCode -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ RuntimeCode -> ContractCode
RuntimeCode (ByteString -> RuntimeCode
ConcreteRuntimeCode ByteString
bs)
        Expr 'Buf
_ ->
          case Expr 'Buf -> Maybe (Vector (Expr 'Byte))
Expr.toList Expr 'Buf
output of
            Maybe (Vector (Expr 'Byte))
Nothing ->
              PartialExec -> EVM t s ()
forall s. PartialExec -> EVM t s ()
forall (t :: VMType) s. VMOps t => PartialExec -> EVM t s ()
partial (PartialExec -> EVM t s ()) -> PartialExec -> EVM t s ()
forall a b. (a -> b) -> a -> b
$
                Int -> [Char] -> [SomeExpr] -> PartialExec
UnexpectedSymbolicArg Int
pc' [Char]
"runtime code cannot have an abstract length" ([Expr 'Buf] -> [SomeExpr]
forall (a :: EType). Typeable a => [Expr a] -> [SomeExpr]
wrap [Expr 'Buf
output])
            Just Vector (Expr 'Byte)
ops ->
              ContractCode -> EVM t s ()
onContractCode (ContractCode -> EVM t s ()) -> ContractCode -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ RuntimeCode -> ContractCode
RuntimeCode (Vector (Expr 'Byte) -> RuntimeCode
SymbolicRuntimeCode Vector (Expr 'Byte)
ops)
    Maybe (VMResult t s)
_ ->
      [Char] -> EVM t s ()
forall a. HasCallStack => [Char] -> a
internalError [Char]
"Finalising an unfinished tx."

  -- compute and pay the refund to the caller and the
  -- corresponding payment to the miner
  Block
block <- Optic' A_Lens '[] (VM t s) Block -> StateT (VM t s) (ST s) Block
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use Optic' A_Lens '[] (VM t s) Block
#block

  EVM t s ()
forall s. EVM t s ()
forall (t :: VMType) s. VMOps t => EVM t s ()
payRefunds

  Expr 'EAddr -> EVM t s ()
forall (t :: VMType) s. Expr 'EAddr -> EVM t s ()
touchAccount Block
block.coinbase

  -- perform state trie clearing (EIP 161), of selfdestructs
  -- and touched accounts. addresses are cleared if they have
  --    a) selfdestructed, or
  --    b) been touched and
  --    c) are empty.
  -- (see Yellow Paper "Accrued Substate")
  --
  -- remove any destructed addresses
  [Expr 'EAddr]
destroyedAddresses <- Optic' A_Lens '[] (VM t s) [Expr 'EAddr]
-> StateT (VM t s) (ST s) [Expr 'EAddr]
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic A_Lens '[] (VM t s) (VM t s) TxState TxState
#tx Optic A_Lens '[] (VM t s) (VM t s) TxState TxState
-> Optic A_Lens '[] TxState TxState SubState SubState
-> Optic A_Lens '[] (VM t s) (VM t s) SubState SubState
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens '[] TxState TxState SubState SubState
#substate Optic A_Lens '[] (VM t s) (VM t s) SubState SubState
-> Optic A_Lens '[] SubState SubState [Expr 'EAddr] [Expr 'EAddr]
-> Optic' A_Lens '[] (VM t s) [Expr 'EAddr]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens '[] SubState SubState [Expr 'EAddr] [Expr 'EAddr]
#selfdestructs)
  Optic' A_Lens '[] (VM t s) (Map (Expr 'EAddr) Contract)
-> (Map (Expr 'EAddr) Contract -> Map (Expr 'EAddr) Contract)
-> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying (Optic A_Lens '[] (VM t s) (VM t s) Env Env
#env Optic A_Lens '[] (VM t s) (VM t s) Env Env
-> Optic
     A_Lens
     '[]
     Env
     Env
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
-> Optic' A_Lens '[] (VM t s) (Map (Expr 'EAddr) Contract)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  Env
  Env
  (Map (Expr 'EAddr) Contract)
  (Map (Expr 'EAddr) Contract)
#contracts)
    ((Expr 'EAddr -> Contract -> Bool)
-> Map (Expr 'EAddr) Contract -> Map (Expr 'EAddr) Contract
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (\Expr 'EAddr
k Contract
_ -> (Expr 'EAddr
k Expr 'EAddr -> [Expr 'EAddr] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Expr 'EAddr]
destroyedAddresses)))
  -- then, clear any remaining empty and touched addresses
  [Expr 'EAddr]
touchedAddresses <- Optic' A_Lens '[] (VM t s) [Expr 'EAddr]
-> StateT (VM t s) (ST s) [Expr 'EAddr]
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic A_Lens '[] (VM t s) (VM t s) TxState TxState
#tx Optic A_Lens '[] (VM t s) (VM t s) TxState TxState
-> Optic A_Lens '[] TxState TxState SubState SubState
-> Optic A_Lens '[] (VM t s) (VM t s) SubState SubState
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens '[] TxState TxState SubState SubState
#substate Optic A_Lens '[] (VM t s) (VM t s) SubState SubState
-> Optic A_Lens '[] SubState SubState [Expr 'EAddr] [Expr 'EAddr]
-> Optic' A_Lens '[] (VM t s) [Expr 'EAddr]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens '[] SubState SubState [Expr 'EAddr] [Expr 'EAddr]
#touchedAccounts)
  Optic' A_Lens '[] (VM t s) (Map (Expr 'EAddr) Contract)
-> (Map (Expr 'EAddr) Contract -> Map (Expr 'EAddr) Contract)
-> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying (Optic A_Lens '[] (VM t s) (VM t s) Env Env
#env Optic A_Lens '[] (VM t s) (VM t s) Env Env
-> Optic
     A_Lens
     '[]
     Env
     Env
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
-> Optic' A_Lens '[] (VM t s) (Map (Expr 'EAddr) Contract)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  Env
  Env
  (Map (Expr 'EAddr) Contract)
  (Map (Expr 'EAddr) Contract)
#contracts)
    ((Expr 'EAddr -> Contract -> Bool)
-> Map (Expr 'EAddr) Contract -> Map (Expr 'EAddr) Contract
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey
      (\Expr 'EAddr
k Contract
a -> Bool -> Bool
not ((Expr 'EAddr
k Expr 'EAddr -> [Expr 'EAddr] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Expr 'EAddr]
touchedAddresses) Bool -> Bool -> Bool
&& Contract -> Bool
accountEmpty Contract
a)))

-- | Loads the selected contract as the current contract to execute
loadContract :: Expr EAddr -> State (VM t s) ()
loadContract :: forall (t :: VMType) s. Expr 'EAddr -> State (VM t s) ()
loadContract Expr 'EAddr
target =
  Optic' An_AffineTraversal '[] (VM t s) ContractCode
-> StateT (VM t s) Identity (Maybe ContractCode)
forall k s (m :: * -> *) (is :: IxList) a.
(Is k An_AffineFold, MonadState s m) =>
Optic' k is s a -> m (Maybe a)
preuse (Optic A_Lens '[] (VM t s) (VM t s) Env Env
#env Optic A_Lens '[] (VM t s) (VM t s) Env Env
-> Optic
     A_Lens
     '[]
     Env
     Env
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
-> Optic
     A_Lens
     '[]
     (VM t s)
     (VM t s)
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  Env
  Env
  (Map (Expr 'EAddr) Contract)
  (Map (Expr 'EAddr) Contract)
#contracts Optic
  A_Lens
  '[]
  (VM t s)
  (VM t s)
  (Map (Expr 'EAddr) Contract)
  (Map (Expr 'EAddr) Contract)
-> Optic
     (IxKind (Map (Expr 'EAddr) Contract))
     '[]
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
     (IxValue (Map (Expr 'EAddr) Contract))
     (IxValue (Map (Expr 'EAddr) Contract))
-> Optic
     An_AffineTraversal
     '[]
     (VM t s)
     (VM t s)
     (IxValue (Map (Expr 'EAddr) Contract))
     (IxValue (Map (Expr 'EAddr) Contract))
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Index (Map (Expr 'EAddr) Contract)
-> Optic
     (IxKind (Map (Expr 'EAddr) Contract))
     '[]
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
     (IxValue (Map (Expr 'EAddr) Contract))
     (IxValue (Map (Expr 'EAddr) Contract))
forall m. Ixed m => Index m -> Optic' (IxKind m) '[] m (IxValue m)
ix Index (Map (Expr 'EAddr) Contract)
Expr 'EAddr
target Optic
  An_AffineTraversal
  '[]
  (VM t s)
  (VM t s)
  (IxValue (Map (Expr 'EAddr) Contract))
  (IxValue (Map (Expr 'EAddr) Contract))
-> Optic
     A_Lens
     '[]
     (IxValue (Map (Expr 'EAddr) Contract))
     (IxValue (Map (Expr 'EAddr) Contract))
     ContractCode
     ContractCode
-> Optic' An_AffineTraversal '[] (VM t s) ContractCode
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (IxValue (Map (Expr 'EAddr) Contract))
  (IxValue (Map (Expr 'EAddr) Contract))
  ContractCode
  ContractCode
#code) StateT (VM t s) Identity (Maybe ContractCode)
-> (Maybe ContractCode -> StateT (VM t s) Identity ())
-> StateT (VM t s) Identity ()
forall a b.
StateT (VM t s) Identity a
-> (a -> StateT (VM t s) Identity b) -> StateT (VM t s) Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
    \case
      Maybe ContractCode
Nothing ->
        [Char] -> StateT (VM t s) Identity ()
forall a. HasCallStack => [Char] -> a
internalError [Char]
"Call target doesn't exist"
      Just ContractCode
targetCode -> do
        Optic A_Lens '[] (VM t s) (VM t s) (Expr 'EAddr) (Expr 'EAddr)
-> Expr 'EAddr -> StateT (VM t s) Identity ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     (Expr 'EAddr)
     (Expr 'EAddr)
-> Optic A_Lens '[] (VM t s) (VM t s) (Expr 'EAddr) (Expr 'EAddr)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  (Expr 'EAddr)
  (Expr 'EAddr)
#contract) Expr 'EAddr
target
        Optic A_Lens '[] (VM t s) (VM t s) ContractCode ContractCode
-> ContractCode -> StateT (VM t s) Identity ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     ContractCode
     ContractCode
-> Optic A_Lens '[] (VM t s) (VM t s) ContractCode ContractCode
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  ContractCode
  ContractCode
#code)     ContractCode
targetCode
        Optic A_Lens '[] (VM t s) (VM t s) (Expr 'EAddr) (Expr 'EAddr)
-> Expr 'EAddr -> StateT (VM t s) Identity ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     (Expr 'EAddr)
     (Expr 'EAddr)
-> Optic A_Lens '[] (VM t s) (VM t s) (Expr 'EAddr) (Expr 'EAddr)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  (Expr 'EAddr)
  (Expr 'EAddr)
#codeContract) Expr 'EAddr
target

limitStack :: VMOps t => Int -> EVM (t :: VMType) s () -> EVM t s ()
limitStack :: forall (t :: VMType) s. VMOps t => Int -> EVM t s () -> EVM t s ()
limitStack Int
n EVM t s ()
continue = do
  [Expr 'EWord]
stk <- Optic' A_Lens '[] (VM t s) [Expr 'EWord]
-> StateT (VM t s) (ST s) [Expr 'EWord]
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     [Expr 'EWord]
     [Expr 'EWord]
-> Optic' A_Lens '[] (VM t s) [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  [Expr 'EWord]
  [Expr 'EWord]
#stack)
  if [Expr 'EWord] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Expr 'EWord]
stk Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1024
    then EvmError -> EVM t s ()
forall (t :: VMType) s. VMOps t => EvmError -> EVM t s ()
vmError EvmError
StackLimitExceeded
    else EVM t s ()
continue

notStatic :: VMOps t => EVM t s () -> EVM t s ()
notStatic :: forall (t :: VMType) s. VMOps t => EVM t s () -> EVM t s ()
notStatic EVM t s ()
continue = do
  Bool
bad <- Optic' A_Lens '[] (VM t s) Bool -> StateT (VM t s) (ST s) Bool
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic A_Lens '[] (FrameState t s) (FrameState t s) Bool Bool
-> Optic' A_Lens '[] (VM t s) Bool
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens '[] (FrameState t s) (FrameState t s) Bool Bool
#static)
  if Bool
bad
    then EvmError -> EVM t s ()
forall (t :: VMType) s. VMOps t => EvmError -> EVM t s ()
vmError EvmError
StateChangeWhileStatic
    else EVM t s ()
continue

forceAddr :: VMOps t => Expr EWord -> String -> (Expr EAddr -> EVM t s ()) -> EVM t s ()
forceAddr :: forall (t :: VMType) s.
VMOps t =>
Expr 'EWord -> [Char] -> (Expr 'EAddr -> EVM t s ()) -> EVM t s ()
forceAddr Expr 'EWord
n [Char]
msg Expr 'EAddr -> EVM t s ()
continue = case Expr 'EWord -> Maybe (Expr 'EAddr)
wordToAddr Expr 'EWord
n of
  Maybe (Expr 'EAddr)
Nothing -> do
    VM t s
vm <- StateT (VM t s) (ST s) (VM t s)
forall s (m :: * -> *). MonadState s m => m s
get
    PartialExec -> EVM t s ()
forall s. PartialExec -> EVM t s ()
forall (t :: VMType) s. VMOps t => PartialExec -> EVM t s ()
partial (PartialExec -> EVM t s ()) -> PartialExec -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ Int -> [Char] -> [SomeExpr] -> PartialExec
UnexpectedSymbolicArg VM t s
vm.state.pc [Char]
msg ([Expr 'EWord] -> [SomeExpr]
forall (a :: EType). Typeable a => [Expr a] -> [SomeExpr]
wrap [Expr 'EWord
n])
  Just Expr 'EAddr
c -> Expr 'EAddr -> EVM t s ()
continue Expr 'EAddr
c

forceConcrete :: VMOps t => Expr EWord -> String -> (W256 -> EVM t s ()) -> EVM t s ()
forceConcrete :: forall (t :: VMType) s.
VMOps t =>
Expr 'EWord -> [Char] -> (W256 -> EVM t s ()) -> EVM t s ()
forceConcrete Expr 'EWord
n [Char]
msg W256 -> EVM t s ()
continue = case Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
n of
  Maybe W256
Nothing -> do
    VM t s
vm <- StateT (VM t s) (ST s) (VM t s)
forall s (m :: * -> *). MonadState s m => m s
get
    PartialExec -> EVM t s ()
forall s. PartialExec -> EVM t s ()
forall (t :: VMType) s. VMOps t => PartialExec -> EVM t s ()
partial (PartialExec -> EVM t s ()) -> PartialExec -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ Int -> [Char] -> [SomeExpr] -> PartialExec
UnexpectedSymbolicArg VM t s
vm.state.pc [Char]
msg ([Expr 'EWord] -> [SomeExpr]
forall (a :: EType). Typeable a => [Expr a] -> [SomeExpr]
wrap [Expr 'EWord
n])
  Just W256
c -> W256 -> EVM t s ()
continue W256
c

forceConcreteAddr :: VMOps t => Expr EAddr -> String -> (Addr -> EVM t s ()) -> EVM t s ()
forceConcreteAddr :: forall (t :: VMType) s.
VMOps t =>
Expr 'EAddr -> [Char] -> (Addr -> EVM t s ()) -> EVM t s ()
forceConcreteAddr Expr 'EAddr
n [Char]
msg Addr -> EVM t s ()
continue = case Expr 'EAddr -> Maybe Addr
maybeLitAddr Expr 'EAddr
n of
  Maybe Addr
Nothing -> do
    VM t s
vm <- StateT (VM t s) (ST s) (VM t s)
forall s (m :: * -> *). MonadState s m => m s
get
    PartialExec -> EVM t s ()
forall s. PartialExec -> EVM t s ()
forall (t :: VMType) s. VMOps t => PartialExec -> EVM t s ()
partial (PartialExec -> EVM t s ()) -> PartialExec -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ Int -> [Char] -> [SomeExpr] -> PartialExec
UnexpectedSymbolicArg VM t s
vm.state.pc [Char]
msg ([Expr 'EAddr] -> [SomeExpr]
forall (a :: EType). Typeable a => [Expr a] -> [SomeExpr]
wrap [Expr 'EAddr
n])
  Just Addr
c -> Addr -> EVM t s ()
continue Addr
c

forceConcreteAddr2 :: VMOps t => (Expr EAddr, Expr EAddr) -> String -> ((Addr, Addr) -> EVM t s ()) -> EVM t s ()
forceConcreteAddr2 :: forall (t :: VMType) s.
VMOps t =>
(Expr 'EAddr, Expr 'EAddr)
-> [Char] -> ((Addr, Addr) -> EVM t s ()) -> EVM t s ()
forceConcreteAddr2 (Expr 'EAddr
n,Expr 'EAddr
m) [Char]
msg (Addr, Addr) -> EVM t s ()
continue = case (Expr 'EAddr -> Maybe Addr
maybeLitAddr Expr 'EAddr
n, Expr 'EAddr -> Maybe Addr
maybeLitAddr Expr 'EAddr
m) of
  (Just Addr
c, Just Addr
d) -> (Addr, Addr) -> EVM t s ()
continue (Addr
c,Addr
d)
  (Maybe Addr, Maybe Addr)
_ -> do
    VM t s
vm <- StateT (VM t s) (ST s) (VM t s)
forall s (m :: * -> *). MonadState s m => m s
get
    PartialExec -> EVM t s ()
forall s. PartialExec -> EVM t s ()
forall (t :: VMType) s. VMOps t => PartialExec -> EVM t s ()
partial (PartialExec -> EVM t s ()) -> PartialExec -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ Int -> [Char] -> [SomeExpr] -> PartialExec
UnexpectedSymbolicArg VM t s
vm.state.pc [Char]
msg ([Expr 'EAddr] -> [SomeExpr]
forall (a :: EType). Typeable a => [Expr a] -> [SomeExpr]
wrap [Expr 'EAddr
n, Expr 'EAddr
m])

forceConcrete2 :: VMOps t => (Expr EWord, Expr EWord) -> String -> ((W256, W256) -> EVM t s ()) -> EVM t s ()
forceConcrete2 :: forall (t :: VMType) s.
VMOps t =>
(Expr 'EWord, Expr 'EWord)
-> [Char] -> ((W256, W256) -> EVM t s ()) -> EVM t s ()
forceConcrete2 (Expr 'EWord
n,Expr 'EWord
m) [Char]
msg (W256, W256) -> EVM t s ()
continue = case (Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
n, Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
m) of
  (Just W256
c, Just W256
d) -> (W256, W256) -> EVM t s ()
continue (W256
c, W256
d)
  (Maybe W256, Maybe W256)
_ -> do
    VM t s
vm <- StateT (VM t s) (ST s) (VM t s)
forall s (m :: * -> *). MonadState s m => m s
get
    PartialExec -> EVM t s ()
forall s. PartialExec -> EVM t s ()
forall (t :: VMType) s. VMOps t => PartialExec -> EVM t s ()
partial (PartialExec -> EVM t s ()) -> PartialExec -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ Int -> [Char] -> [SomeExpr] -> PartialExec
UnexpectedSymbolicArg VM t s
vm.state.pc [Char]
msg ([Expr 'EWord] -> [SomeExpr]
forall (a :: EType). Typeable a => [Expr a] -> [SomeExpr]
wrap [Expr 'EWord
n, Expr 'EWord
m])

forceConcreteBuf :: VMOps t => Expr Buf -> String -> (ByteString -> EVM t s ()) -> EVM t s ()
forceConcreteBuf :: forall (t :: VMType) s.
VMOps t =>
Expr 'Buf -> [Char] -> (ByteString -> EVM t s ()) -> EVM t s ()
forceConcreteBuf (ConcreteBuf ByteString
b) [Char]
_ ByteString -> EVM t s ()
continue = ByteString -> EVM t s ()
continue ByteString
b
forceConcreteBuf Expr 'Buf
b [Char]
msg ByteString -> EVM t s ()
_ = do
    VM t s
vm <- StateT (VM t s) (ST s) (VM t s)
forall s (m :: * -> *). MonadState s m => m s
get
    PartialExec -> EVM t s ()
forall s. PartialExec -> EVM t s ()
forall (t :: VMType) s. VMOps t => PartialExec -> EVM t s ()
partial (PartialExec -> EVM t s ()) -> PartialExec -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ Int -> [Char] -> [SomeExpr] -> PartialExec
UnexpectedSymbolicArg VM t s
vm.state.pc [Char]
msg ([Expr 'Buf] -> [SomeExpr]
forall (a :: EType). Typeable a => [Expr a] -> [SomeExpr]
wrap [Expr 'Buf
b])

-- * Substate manipulation
refund :: Word64 -> EVM t s ()
refund :: forall (t :: VMType) s. Word64 -> EVM t s ()
refund Word64
n = do
  Expr 'EAddr
self <- Optic' A_Lens '[] (VM t s) (Expr 'EAddr)
-> StateT (VM t s) (ST s) (Expr 'EAddr)
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     (Expr 'EAddr)
     (Expr 'EAddr)
-> Optic' A_Lens '[] (VM t s) (Expr 'EAddr)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  (Expr 'EAddr)
  (Expr 'EAddr)
#contract)
  Lens
  (VM t s) (VM t s) [(Expr 'EAddr, Word64)] [(Expr 'EAddr, Word64)]
-> (Expr 'EAddr, Word64) -> EVM t s ()
forall s (m :: * -> *) a.
MonadState s m =>
Lens s s [a] [a] -> a -> m ()
pushTo (Optic A_Lens '[] (VM t s) (VM t s) TxState TxState
#tx Optic A_Lens '[] (VM t s) (VM t s) TxState TxState
-> Optic A_Lens '[] TxState TxState SubState SubState
-> Optic A_Lens '[] (VM t s) (VM t s) SubState SubState
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens '[] TxState TxState SubState SubState
#substate Optic A_Lens '[] (VM t s) (VM t s) SubState SubState
-> Optic
     A_Lens
     '[]
     SubState
     SubState
     [(Expr 'EAddr, Word64)]
     [(Expr 'EAddr, Word64)]
-> Lens
     (VM t s) (VM t s) [(Expr 'EAddr, Word64)] [(Expr 'EAddr, Word64)]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  SubState
  SubState
  [(Expr 'EAddr, Word64)]
  [(Expr 'EAddr, Word64)]
#refunds) (Expr 'EAddr
self, Word64
n)

unRefund :: Word64 -> EVM t s ()
unRefund :: forall (t :: VMType) s. Word64 -> EVM t s ()
unRefund Word64
n = do
  Expr 'EAddr
self <- Optic' A_Lens '[] (VM t s) (Expr 'EAddr)
-> StateT (VM t s) (ST s) (Expr 'EAddr)
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     (Expr 'EAddr)
     (Expr 'EAddr)
-> Optic' A_Lens '[] (VM t s) (Expr 'EAddr)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  (Expr 'EAddr)
  (Expr 'EAddr)
#contract)
  [(Expr 'EAddr, Word64)]
refs <- Optic' A_Lens '[] (VM t s) [(Expr 'EAddr, Word64)]
-> StateT (VM t s) (ST s) [(Expr 'EAddr, Word64)]
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic A_Lens '[] (VM t s) (VM t s) TxState TxState
#tx Optic A_Lens '[] (VM t s) (VM t s) TxState TxState
-> Optic A_Lens '[] TxState TxState SubState SubState
-> Optic A_Lens '[] (VM t s) (VM t s) SubState SubState
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens '[] TxState TxState SubState SubState
#substate Optic A_Lens '[] (VM t s) (VM t s) SubState SubState
-> Optic
     A_Lens
     '[]
     SubState
     SubState
     [(Expr 'EAddr, Word64)]
     [(Expr 'EAddr, Word64)]
-> Optic' A_Lens '[] (VM t s) [(Expr 'EAddr, Word64)]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  SubState
  SubState
  [(Expr 'EAddr, Word64)]
  [(Expr 'EAddr, Word64)]
#refunds)
  Optic' A_Lens '[] (VM t s) [(Expr 'EAddr, Word64)]
-> [(Expr 'EAddr, Word64)] -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens '[] (VM t s) (VM t s) TxState TxState
#tx Optic A_Lens '[] (VM t s) (VM t s) TxState TxState
-> Optic A_Lens '[] TxState TxState SubState SubState
-> Optic A_Lens '[] (VM t s) (VM t s) SubState SubState
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens '[] TxState TxState SubState SubState
#substate Optic A_Lens '[] (VM t s) (VM t s) SubState SubState
-> Optic
     A_Lens
     '[]
     SubState
     SubState
     [(Expr 'EAddr, Word64)]
     [(Expr 'EAddr, Word64)]
-> Optic' A_Lens '[] (VM t s) [(Expr 'EAddr, Word64)]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  SubState
  SubState
  [(Expr 'EAddr, Word64)]
  [(Expr 'EAddr, Word64)]
#refunds)
    (((Expr 'EAddr, Word64) -> Bool)
-> [(Expr 'EAddr, Word64)] -> [(Expr 'EAddr, Word64)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Expr 'EAddr
a,Word64
b) -> Bool -> Bool
not (Expr 'EAddr
a Expr 'EAddr -> Expr 'EAddr -> Bool
forall a. Eq a => a -> a -> Bool
== Expr 'EAddr
self Bool -> Bool -> Bool
&& Word64
b Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
n)) [(Expr 'EAddr, Word64)]
refs)

touchAccount :: Expr EAddr -> EVM t s ()
touchAccount :: forall (t :: VMType) s. Expr 'EAddr -> EVM t s ()
touchAccount = Lens (VM t s) (VM t s) [Expr 'EAddr] [Expr 'EAddr]
-> Expr 'EAddr -> StateT (VM t s) (ST s) ()
forall s (m :: * -> *) a.
MonadState s m =>
Lens s s [a] [a] -> a -> m ()
pushTo ((Optic A_Lens '[] (VM t s) (VM t s) TxState TxState
#tx Optic A_Lens '[] (VM t s) (VM t s) TxState TxState
-> Optic A_Lens '[] TxState TxState SubState SubState
-> Optic A_Lens '[] (VM t s) (VM t s) SubState SubState
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens '[] TxState TxState SubState SubState
#substate) Optic A_Lens '[] (VM t s) (VM t s) SubState SubState
-> Optic A_Lens '[] SubState SubState [Expr 'EAddr] [Expr 'EAddr]
-> Lens (VM t s) (VM t s) [Expr 'EAddr] [Expr 'EAddr]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens '[] SubState SubState [Expr 'EAddr] [Expr 'EAddr]
#touchedAccounts)

selfdestruct :: Expr EAddr -> EVM t s ()
selfdestruct :: forall (t :: VMType) s. Expr 'EAddr -> EVM t s ()
selfdestruct = Lens (VM t s) (VM t s) [Expr 'EAddr] [Expr 'EAddr]
-> Expr 'EAddr -> StateT (VM t s) (ST s) ()
forall s (m :: * -> *) a.
MonadState s m =>
Lens s s [a] [a] -> a -> m ()
pushTo ((Optic A_Lens '[] (VM t s) (VM t s) TxState TxState
#tx Optic A_Lens '[] (VM t s) (VM t s) TxState TxState
-> Optic A_Lens '[] TxState TxState SubState SubState
-> Optic A_Lens '[] (VM t s) (VM t s) SubState SubState
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens '[] TxState TxState SubState SubState
#substate) Optic A_Lens '[] (VM t s) (VM t s) SubState SubState
-> Optic A_Lens '[] SubState SubState [Expr 'EAddr] [Expr 'EAddr]
-> Lens (VM t s) (VM t s) [Expr 'EAddr] [Expr 'EAddr]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens '[] SubState SubState [Expr 'EAddr] [Expr 'EAddr]
#selfdestructs)

accessAndBurn :: VMOps t => Expr EAddr -> EVM t s () -> EVM t s ()
accessAndBurn :: forall (t :: VMType) s.
VMOps t =>
Expr 'EAddr -> EVM t s () -> EVM t s ()
accessAndBurn Expr 'EAddr
x EVM t s ()
cont = do
  FeeSchedule {Word64
$sel:g_zero:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_base:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_verylow:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_low:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_mid:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_high:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_extcode:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_balance:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sload:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_jumpdest:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sset:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sreset:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:r_sclear:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_selfdestruct:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_selfdestruct_newaccount:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:r_selfdestruct:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_create:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_codedeposit:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_call:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_callvalue:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_callstipend:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_newaccount:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_exp:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_expbyte:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_memory:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_txcreate:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_txdatazero:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_txdatanonzero:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_transaction:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_log:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_logdata:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_logtopic:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sha3:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sha3word:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_initcodeword:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_copy:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_blockhash:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_extcodehash:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_quaddivisor:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_ecadd:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_ecmul:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_pairing_point:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_pairing_base:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_fround:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:r_block:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_cold_sload:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_cold_account_access:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_warm_storage_read:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_access_list_address:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_access_list_storage_key:FeeSchedule :: forall n. FeeSchedule n -> n
g_zero :: Word64
g_base :: Word64
g_verylow :: Word64
g_low :: Word64
g_mid :: Word64
g_high :: Word64
g_extcode :: Word64
g_balance :: Word64
g_sload :: Word64
g_jumpdest :: Word64
g_sset :: Word64
g_sreset :: Word64
r_sclear :: Word64
g_selfdestruct :: Word64
g_selfdestruct_newaccount :: Word64
r_selfdestruct :: Word64
g_create :: Word64
g_codedeposit :: Word64
g_call :: Word64
g_callvalue :: Word64
g_callstipend :: Word64
g_newaccount :: Word64
g_exp :: Word64
g_expbyte :: Word64
g_memory :: Word64
g_txcreate :: Word64
g_txdatazero :: Word64
g_txdatanonzero :: Word64
g_transaction :: Word64
g_log :: Word64
g_logdata :: Word64
g_logtopic :: Word64
g_sha3 :: Word64
g_sha3word :: Word64
g_initcodeword :: Word64
g_copy :: Word64
g_blockhash :: Word64
g_extcodehash :: Word64
g_quaddivisor :: Word64
g_ecadd :: Word64
g_ecmul :: Word64
g_pairing_point :: Word64
g_pairing_base :: Word64
g_fround :: Word64
r_block :: Word64
g_cold_sload :: Word64
g_cold_account_access :: Word64
g_warm_storage_read :: Word64
g_access_list_address :: Word64
g_access_list_storage_key :: Word64
..} <- Optic' A_Lens '[] (VM t s) (FeeSchedule Word64)
-> StateT (VM t s) (ST s) (FeeSchedule Word64)
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic A_Lens '[] (VM t s) (VM t s) Block Block
#block Optic A_Lens '[] (VM t s) (VM t s) Block Block
-> Optic
     A_Lens '[] Block Block (FeeSchedule Word64) (FeeSchedule Word64)
-> Optic' A_Lens '[] (VM t s) (FeeSchedule Word64)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens '[] Block Block (FeeSchedule Word64) (FeeSchedule Word64)
#schedule)
  Bool
acc <- Expr 'EAddr -> EVM t s Bool
forall (t :: VMType) s. Expr 'EAddr -> EVM t s Bool
accessAccountForGas Expr 'EAddr
x
  let cost :: Word64
cost = if Bool
acc then Word64
g_warm_storage_read else Word64
g_cold_account_access
  Word64 -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Word64 -> EVM t s () -> EVM t s ()
burn Word64
cost EVM t s ()
cont

-- | returns a wrapped boolean- if true, this address has been touched before in the txn (warm gas cost as in EIP 2929)
-- otherwise cold
accessAccountForGas :: Expr EAddr -> EVM t s Bool
accessAccountForGas :: forall (t :: VMType) s. Expr 'EAddr -> EVM t s Bool
accessAccountForGas Expr 'EAddr
addr = do
  Set (Expr 'EAddr)
accessedAddrs <- Optic' A_Lens '[] (VM t s) (Set (Expr 'EAddr))
-> StateT (VM t s) (ST s) (Set (Expr 'EAddr))
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic A_Lens '[] (VM t s) (VM t s) TxState TxState
#tx Optic A_Lens '[] (VM t s) (VM t s) TxState TxState
-> Optic A_Lens '[] TxState TxState SubState SubState
-> Optic A_Lens '[] (VM t s) (VM t s) SubState SubState
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens '[] TxState TxState SubState SubState
#substate Optic A_Lens '[] (VM t s) (VM t s) SubState SubState
-> Optic
     A_Lens
     '[]
     SubState
     SubState
     (Set (Expr 'EAddr))
     (Set (Expr 'EAddr))
-> Optic' A_Lens '[] (VM t s) (Set (Expr 'EAddr))
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  SubState
  SubState
  (Set (Expr 'EAddr))
  (Set (Expr 'EAddr))
#accessedAddresses)
  let accessed :: Bool
accessed = Expr 'EAddr -> Set (Expr 'EAddr) -> Bool
forall a. Ord a => a -> Set a -> Bool
member Expr 'EAddr
addr Set (Expr 'EAddr)
accessedAddrs
  Optic' A_Lens '[] (VM t s) (Set (Expr 'EAddr))
-> Set (Expr 'EAddr) -> StateT (VM t s) (ST s) ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens '[] (VM t s) (VM t s) TxState TxState
#tx Optic A_Lens '[] (VM t s) (VM t s) TxState TxState
-> Optic A_Lens '[] TxState TxState SubState SubState
-> Optic A_Lens '[] (VM t s) (VM t s) SubState SubState
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens '[] TxState TxState SubState SubState
#substate Optic A_Lens '[] (VM t s) (VM t s) SubState SubState
-> Optic
     A_Lens
     '[]
     SubState
     SubState
     (Set (Expr 'EAddr))
     (Set (Expr 'EAddr))
-> Optic' A_Lens '[] (VM t s) (Set (Expr 'EAddr))
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  SubState
  SubState
  (Set (Expr 'EAddr))
  (Set (Expr 'EAddr))
#accessedAddresses) (Expr 'EAddr -> Set (Expr 'EAddr) -> Set (Expr 'EAddr)
forall a. Ord a => a -> Set a -> Set a
insert Expr 'EAddr
addr Set (Expr 'EAddr)
accessedAddrs)
  Bool -> EVM t s Bool
forall a. a -> StateT (VM t s) (ST s) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
accessed

-- | returns a wrapped boolean- if true, this slot has been touched before in the txn (warm gas cost as in EIP 2929)
-- otherwise cold
accessStorageForGas :: Expr EAddr -> Expr EWord -> EVM t s Bool
accessStorageForGas :: forall (t :: VMType) s. Expr 'EAddr -> Expr 'EWord -> EVM t s Bool
accessStorageForGas Expr 'EAddr
addr Expr 'EWord
key = do
  Set (Expr 'EAddr, W256)
accessedStrkeys <- Optic' A_Lens '[] (VM t s) (Set (Expr 'EAddr, W256))
-> StateT (VM t s) (ST s) (Set (Expr 'EAddr, W256))
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic A_Lens '[] (VM t s) (VM t s) TxState TxState
#tx Optic A_Lens '[] (VM t s) (VM t s) TxState TxState
-> Optic A_Lens '[] TxState TxState SubState SubState
-> Optic A_Lens '[] (VM t s) (VM t s) SubState SubState
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens '[] TxState TxState SubState SubState
#substate Optic A_Lens '[] (VM t s) (VM t s) SubState SubState
-> Optic
     A_Lens
     '[]
     SubState
     SubState
     (Set (Expr 'EAddr, W256))
     (Set (Expr 'EAddr, W256))
-> Optic' A_Lens '[] (VM t s) (Set (Expr 'EAddr, W256))
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  SubState
  SubState
  (Set (Expr 'EAddr, W256))
  (Set (Expr 'EAddr, W256))
#accessedStorageKeys)
  case Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
key of
    Just W256
litword -> do
      let accessed :: Bool
accessed = (Expr 'EAddr, W256) -> Set (Expr 'EAddr, W256) -> Bool
forall a. Ord a => a -> Set a -> Bool
member (Expr 'EAddr
addr, W256
litword) Set (Expr 'EAddr, W256)
accessedStrkeys
      Optic' A_Lens '[] (VM t s) (Set (Expr 'EAddr, W256))
-> Set (Expr 'EAddr, W256) -> StateT (VM t s) (ST s) ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens '[] (VM t s) (VM t s) TxState TxState
#tx Optic A_Lens '[] (VM t s) (VM t s) TxState TxState
-> Optic A_Lens '[] TxState TxState SubState SubState
-> Optic A_Lens '[] (VM t s) (VM t s) SubState SubState
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens '[] TxState TxState SubState SubState
#substate Optic A_Lens '[] (VM t s) (VM t s) SubState SubState
-> Optic
     A_Lens
     '[]
     SubState
     SubState
     (Set (Expr 'EAddr, W256))
     (Set (Expr 'EAddr, W256))
-> Optic' A_Lens '[] (VM t s) (Set (Expr 'EAddr, W256))
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  SubState
  SubState
  (Set (Expr 'EAddr, W256))
  (Set (Expr 'EAddr, W256))
#accessedStorageKeys) ((Expr 'EAddr, W256)
-> Set (Expr 'EAddr, W256) -> Set (Expr 'EAddr, W256)
forall a. Ord a => a -> Set a -> Set a
insert (Expr 'EAddr
addr, W256
litword) Set (Expr 'EAddr, W256)
accessedStrkeys)
      Bool -> EVM t s Bool
forall a. a -> StateT (VM t s) (ST s) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
accessed
    Maybe W256
_ -> Bool -> EVM t s Bool
forall a. a -> StateT (VM t s) (ST s) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False

-- * Cheat codes

-- The cheat code is 7109709ecfa91a80626ff3989d68f67f5b1dd12d.
-- Call this address using one of the cheatActions below to do
-- special things, e.g. changing the block timestamp. Beware that
-- these are necessarily hevm specific.
cheatCode :: Expr EAddr
cheatCode :: Expr 'EAddr
cheatCode = Addr -> Expr 'EAddr
LitAddr (Addr -> Expr 'EAddr) -> Addr -> Expr 'EAddr
forall a b. (a -> b) -> a -> b
$ W256 -> Addr
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto (ByteString -> W256
keccak' ByteString
"hevm cheat code")

cheat
  :: (?op :: Word8, VMOps t)
  => (Expr EWord, Expr EWord) -> (Expr EWord, Expr EWord)
  -> EVM t s ()
cheat :: forall (t :: VMType) s.
(?op::Word8, VMOps t) =>
(Expr 'EWord, Expr 'EWord)
-> (Expr 'EWord, Expr 'EWord) -> EVM t s ()
cheat (Expr 'EWord
inOffset, Expr 'EWord
inSize) (Expr 'EWord
outOffset, Expr 'EWord
outSize) = do
  VM t s
vm <- StateT (VM t s) (ST s) (VM t s)
forall s (m :: * -> *). MonadState s m => m s
get
  Expr 'Buf
input <- Expr 'EWord -> Expr 'EWord -> EVM t s (Expr 'Buf)
forall (t :: VMType) s.
Expr 'EWord -> Expr 'EWord -> EVM t s (Expr 'Buf)
readMemory (Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.add Expr 'EWord
inOffset (W256 -> Expr 'EWord
Lit W256
4)) (Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.sub Expr 'EWord
inSize (W256 -> Expr 'EWord
Lit W256
4))
  Expr 'EWord
abi <- Int -> Expr 'EWord -> Expr 'Buf -> Expr 'EWord
readBytes Int
4 (W256 -> Expr 'EWord
Lit W256
0) (Expr 'Buf -> Expr 'EWord)
-> EVM t s (Expr 'Buf) -> StateT (VM t s) (ST s) (Expr 'EWord)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr 'EWord -> Expr 'EWord -> EVM t s (Expr 'Buf)
forall (t :: VMType) s.
Expr 'EWord -> Expr 'EWord -> EVM t s (Expr 'Buf)
readMemory Expr 'EWord
inOffset (W256 -> Expr 'EWord
Lit W256
4)
  TraceData -> EVM t s ()
forall (t :: VMType) s. TraceData -> EVM t s ()
pushTrace (TraceData -> EVM t s ()) -> TraceData -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ FrameContext -> TraceData
FrameTrace (Expr 'EAddr
-> Expr 'EAddr
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> Maybe W256
-> Expr 'Buf
-> Map (Expr 'EAddr) Contract
-> SubState
-> FrameContext
CallContext Expr 'EAddr
cheatCode Expr 'EAddr
cheatCode Expr 'EWord
inOffset Expr 'EWord
inSize (W256 -> Expr 'EWord
Lit W256
0) (Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
abi) Expr 'Buf
input VM t s
vm.env.contracts VM t s
vm.tx.substate)
  case Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
abi of
    Maybe W256
Nothing -> PartialExec -> EVM t s ()
forall s. PartialExec -> EVM t s ()
forall (t :: VMType) s. VMOps t => PartialExec -> EVM t s ()
partial (PartialExec -> EVM t s ()) -> PartialExec -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ Int -> [Char] -> [SomeExpr] -> PartialExec
UnexpectedSymbolicArg VM t s
vm.state.pc [Char]
"symbolic cheatcode selector" ([Expr 'EWord] -> [SomeExpr]
forall (a :: EType). Typeable a => [Expr a] -> [SomeExpr]
wrap [Expr 'EWord
abi])
    Just (W256 -> FunctionSelector
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto -> FunctionSelector
abi') ->
      case FunctionSelector
-> Map FunctionSelector (CheatAction t s)
-> Maybe (CheatAction t s)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup FunctionSelector
abi' Map FunctionSelector (CheatAction t s)
forall (t :: VMType) s.
VMOps t =>
Map FunctionSelector (CheatAction t s)
cheatActions of
        Maybe (CheatAction t s)
Nothing ->
          EvmError -> EVM t s ()
forall (t :: VMType) s. VMOps t => EvmError -> EVM t s ()
vmError (FunctionSelector -> EvmError
BadCheatCode FunctionSelector
abi')
        Just CheatAction t s
action -> do
            CheatAction t s
action Expr 'EWord
outOffset Expr 'EWord
outSize Expr 'Buf
input
            EVM t s ()
forall (t :: VMType) s. EVM t s ()
popTrace
            EVM t s ()
forall (t :: VMType) s. (?op::Word8) => EVM t s ()
next
            W256 -> EVM t s ()
forall (t :: VMType) s. W256 -> EVM t s ()
push W256
1

type CheatAction t s = Expr EWord -> Expr EWord -> Expr Buf -> EVM t s ()

cheatActions :: VMOps t => Map FunctionSelector (CheatAction t s)
cheatActions :: forall (t :: VMType) s.
VMOps t =>
Map FunctionSelector (CheatAction t s)
cheatActions =
  [(FunctionSelector, CheatAction t s)]
-> Map FunctionSelector (CheatAction t s)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
    [ ByteString
-> (FunctionSelector -> CheatAction t s)
-> (FunctionSelector, CheatAction t s)
forall {b}.
ByteString -> (FunctionSelector -> b) -> (FunctionSelector, b)
action ByteString
"ffi(string[])" ((FunctionSelector -> CheatAction t s)
 -> (FunctionSelector, CheatAction t s))
-> (FunctionSelector -> CheatAction t s)
-> (FunctionSelector, CheatAction t s)
forall a b. (a -> b) -> a -> b
$
        \FunctionSelector
sig Expr 'EWord
outOffset Expr 'EWord
outSize Expr 'Buf
input -> do
          VM t s
vm <- StateT (VM t s) (ST s) (VM t s)
forall s (m :: * -> *). MonadState s m => m s
get
          if VM t s
vm.config.allowFFI then
            case [AbiType] -> Expr 'Buf -> AbiVals
decodeBuf [AbiType -> AbiType
AbiArrayDynamicType AbiType
AbiStringType] Expr 'Buf
input of
              CAbi [AbiValue]
valsArr -> case [AbiValue]
valsArr of
                [AbiArrayDynamic AbiType
AbiStringType Vector AbiValue
strsV] ->
                  let
                    cmd :: [[Char]]
cmd = (AbiValue -> [Char]) -> [AbiValue] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
                            (\case
                              (AbiString ByteString
a) -> Text -> [Char]
unpack (Text -> [Char]) -> Text -> [Char]
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
decodeUtf8 ByteString
a
                              AbiValue
_ -> [Char]
"")
                            (Vector AbiValue -> [AbiValue]
forall a. Vector a -> [a]
V.toList Vector AbiValue
strsV)
                    cont :: ByteString -> EVM t s ()
cont ByteString
bs = do
                      let encoded :: Expr 'Buf
encoded = ByteString -> Expr 'Buf
ConcreteBuf ByteString
bs
                      Optic A_Lens '[] (VM t s) (VM t s) (Expr 'Buf) (Expr 'Buf)
-> Expr 'Buf -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     (Expr 'Buf)
     (Expr 'Buf)
-> Optic A_Lens '[] (VM t s) (VM t s) (Expr 'Buf) (Expr 'Buf)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  (Expr 'Buf)
  (Expr 'Buf)
#returndata) Expr 'Buf
encoded
                      Expr 'Buf
-> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM t s ()
forall (t :: VMType) s.
Expr 'Buf
-> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM t s ()
copyBytesToMemory Expr 'Buf
encoded Expr 'EWord
outSize (W256 -> Expr 'EWord
Lit W256
0) Expr 'EWord
outOffset
                      Optic
  A_Lens
  '[]
  (VM t s)
  (VM t s)
  (Maybe (VMResult t s))
  (Maybe (VMResult t s))
-> Maybe (VMResult t s) -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign Optic
  A_Lens
  '[]
  (VM t s)
  (VM t s)
  (Maybe (VMResult t s))
  (Maybe (VMResult t s))
#result Maybe (VMResult t s)
forall a. Maybe a
Nothing
                  in Query t s -> EVM t s ()
forall (t :: VMType) s. Query t s -> EVM t s ()
query ([[Char]] -> (ByteString -> EVM t s ()) -> Query t s
forall (t :: VMType) s.
[[Char]] -> (ByteString -> EVM t s ()) -> Query t s
PleaseDoFFI [[Char]]
cmd ByteString -> EVM t s ()
cont)
                [AbiValue]
_ -> EvmError -> EVM t s ()
forall (t :: VMType) s. VMOps t => EvmError -> EVM t s ()
vmError (FunctionSelector -> EvmError
BadCheatCode FunctionSelector
sig)
              AbiVals
_ -> EvmError -> EVM t s ()
forall (t :: VMType) s. VMOps t => EvmError -> EVM t s ()
vmError (FunctionSelector -> EvmError
BadCheatCode FunctionSelector
sig)
          else
            let msg :: [Char]
msg = [Char]
"ffi disabled: run again with --ffi if you want to allow tests to call external scripts"
            in PartialExec -> EVM t s ()
forall s. PartialExec -> EVM t s ()
forall (t :: VMType) s. VMOps t => PartialExec -> EVM t s ()
partial (PartialExec -> EVM t s ()) -> PartialExec -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ Int -> [Char] -> [SomeExpr] -> PartialExec
UnexpectedSymbolicArg VM t s
vm.state.pc [Char]
msg [],

      ByteString
-> (FunctionSelector -> CheatAction t s)
-> (FunctionSelector, CheatAction t s)
forall {b}.
ByteString -> (FunctionSelector -> b) -> (FunctionSelector, b)
action ByteString
"warp(uint256)" ((FunctionSelector -> CheatAction t s)
 -> (FunctionSelector, CheatAction t s))
-> (FunctionSelector -> CheatAction t s)
-> (FunctionSelector, CheatAction t s)
forall a b. (a -> b) -> a -> b
$
        \FunctionSelector
sig Expr 'EWord
_ Expr 'EWord
_ Expr 'Buf
input -> case Int -> Int -> Expr 'Buf -> [Expr 'EWord]
decodeStaticArgs Int
0 Int
1 Expr 'Buf
input of
          [Expr 'EWord
x]  -> Optic A_Lens '[] (VM t s) (VM t s) (Expr 'EWord) (Expr 'EWord)
-> Expr 'EWord -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens '[] (VM t s) (VM t s) Block Block
#block Optic A_Lens '[] (VM t s) (VM t s) Block Block
-> Optic A_Lens '[] Block Block (Expr 'EWord) (Expr 'EWord)
-> Optic A_Lens '[] (VM t s) (VM t s) (Expr 'EWord) (Expr 'EWord)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens '[] Block Block (Expr 'EWord) (Expr 'EWord)
#timestamp) Expr 'EWord
x
          [Expr 'EWord]
_ -> EvmError -> EVM t s ()
forall (t :: VMType) s. VMOps t => EvmError -> EVM t s ()
vmError (FunctionSelector -> EvmError
BadCheatCode FunctionSelector
sig),

      ByteString
-> (FunctionSelector -> CheatAction t s)
-> (FunctionSelector, CheatAction t s)
forall {b}.
ByteString -> (FunctionSelector -> b) -> (FunctionSelector, b)
action ByteString
"deal(address,uint256)" ((FunctionSelector -> CheatAction t s)
 -> (FunctionSelector, CheatAction t s))
-> (FunctionSelector -> CheatAction t s)
-> (FunctionSelector, CheatAction t s)
forall a b. (a -> b) -> a -> b
$
        \FunctionSelector
sig Expr 'EWord
_ Expr 'EWord
_ Expr 'Buf
input -> case Int -> Int -> Expr 'Buf -> [Expr 'EWord]
decodeStaticArgs Int
0 Int
2 Expr 'Buf
input of
          [Expr 'EWord
a, Expr 'EWord
amt] ->
            Expr 'EWord -> [Char] -> (Expr 'EAddr -> EVM t s ()) -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EWord -> [Char] -> (Expr 'EAddr -> EVM t s ()) -> EVM t s ()
forceAddr Expr 'EWord
a [Char]
"vm.deal: cannot decode target into an address" ((Expr 'EAddr -> EVM t s ()) -> EVM t s ())
-> (Expr 'EAddr -> EVM t s ()) -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ \Expr 'EAddr
usr ->
              Expr 'EAddr -> (Contract -> EVM t s ()) -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EAddr -> (Contract -> EVM t s ()) -> EVM t s ()
fetchAccount Expr 'EAddr
usr ((Contract -> EVM t s ()) -> EVM t s ())
-> (Contract -> EVM t s ()) -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ \Contract
_ -> do
                Optic
  An_AffineTraversal
  '[]
  (VM t s)
  (VM t s)
  (Expr 'EWord)
  (Expr 'EWord)
-> Expr 'EWord -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens '[] (VM t s) (VM t s) Env Env
#env Optic A_Lens '[] (VM t s) (VM t s) Env Env
-> Optic
     A_Lens
     '[]
     Env
     Env
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
-> Optic
     A_Lens
     '[]
     (VM t s)
     (VM t s)
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  Env
  Env
  (Map (Expr 'EAddr) Contract)
  (Map (Expr 'EAddr) Contract)
#contracts Optic
  A_Lens
  '[]
  (VM t s)
  (VM t s)
  (Map (Expr 'EAddr) Contract)
  (Map (Expr 'EAddr) Contract)
-> Optic
     (IxKind (Map (Expr 'EAddr) Contract))
     '[]
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
     (IxValue (Map (Expr 'EAddr) Contract))
     (IxValue (Map (Expr 'EAddr) Contract))
-> Optic
     An_AffineTraversal
     '[]
     (VM t s)
     (VM t s)
     (IxValue (Map (Expr 'EAddr) Contract))
     (IxValue (Map (Expr 'EAddr) Contract))
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Index (Map (Expr 'EAddr) Contract)
-> Optic
     (IxKind (Map (Expr 'EAddr) Contract))
     '[]
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
     (IxValue (Map (Expr 'EAddr) Contract))
     (IxValue (Map (Expr 'EAddr) Contract))
forall m. Ixed m => Index m -> Optic' (IxKind m) '[] m (IxValue m)
ix Index (Map (Expr 'EAddr) Contract)
Expr 'EAddr
usr Optic
  An_AffineTraversal
  '[]
  (VM t s)
  (VM t s)
  (IxValue (Map (Expr 'EAddr) Contract))
  (IxValue (Map (Expr 'EAddr) Contract))
-> Optic
     A_Lens
     '[]
     (IxValue (Map (Expr 'EAddr) Contract))
     (IxValue (Map (Expr 'EAddr) Contract))
     (Expr 'EWord)
     (Expr 'EWord)
-> Optic
     An_AffineTraversal
     '[]
     (VM t s)
     (VM t s)
     (Expr 'EWord)
     (Expr 'EWord)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (IxValue (Map (Expr 'EAddr) Contract))
  (IxValue (Map (Expr 'EAddr) Contract))
  (Expr 'EWord)
  (Expr 'EWord)
#balance) Expr 'EWord
amt
          [Expr 'EWord]
_ -> EvmError -> EVM t s ()
forall (t :: VMType) s. VMOps t => EvmError -> EVM t s ()
vmError (FunctionSelector -> EvmError
BadCheatCode FunctionSelector
sig),

      ByteString
-> (FunctionSelector -> CheatAction t s)
-> (FunctionSelector, CheatAction t s)
forall {b}.
ByteString -> (FunctionSelector -> b) -> (FunctionSelector, b)
action ByteString
"assume(bool)" ((FunctionSelector -> CheatAction t s)
 -> (FunctionSelector, CheatAction t s))
-> (FunctionSelector -> CheatAction t s)
-> (FunctionSelector, CheatAction t s)
forall a b. (a -> b) -> a -> b
$
        \FunctionSelector
sig Expr 'EWord
_ Expr 'EWord
_ Expr 'Buf
input -> case Int -> Int -> Expr 'Buf -> [Expr 'EWord]
decodeStaticArgs Int
0 Int
1 Expr 'Buf
input of
          [Expr 'EWord
c] -> Optic A_Lens '[] (VM t s) (VM t s) [Prop] [Prop]
-> ([Prop] -> [Prop]) -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying Optic A_Lens '[] (VM t s) (VM t s) [Prop] [Prop]
#constraints ((:) (Expr 'EWord -> Expr 'EWord -> Prop
forall (a :: EType). Typeable a => Expr a -> Expr a -> Prop
PEq Expr 'EWord
c (W256 -> Expr 'EWord
Lit W256
1)))
          [Expr 'EWord]
_ -> EvmError -> EVM t s ()
forall (t :: VMType) s. VMOps t => EvmError -> EVM t s ()
vmError (FunctionSelector -> EvmError
BadCheatCode FunctionSelector
sig),

      ByteString
-> (FunctionSelector -> CheatAction t s)
-> (FunctionSelector, CheatAction t s)
forall {b}.
ByteString -> (FunctionSelector -> b) -> (FunctionSelector, b)
action ByteString
"roll(uint256)" ((FunctionSelector -> CheatAction t s)
 -> (FunctionSelector, CheatAction t s))
-> (FunctionSelector -> CheatAction t s)
-> (FunctionSelector, CheatAction t s)
forall a b. (a -> b) -> a -> b
$
        \FunctionSelector
sig Expr 'EWord
_ Expr 'EWord
_ Expr 'Buf
input -> case Int -> Int -> Expr 'Buf -> [Expr 'EWord]
decodeStaticArgs Int
0 Int
1 Expr 'Buf
input of
          [Expr 'EWord
x] -> Expr 'EWord -> [Char] -> (W256 -> EVM t s ()) -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EWord -> [Char] -> (W256 -> EVM t s ()) -> EVM t s ()
forceConcrete Expr 'EWord
x [Char]
"cannot roll to a symbolic block number" (Optic A_Lens '[] (VM t s) (VM t s) W256 W256 -> W256 -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens '[] (VM t s) (VM t s) Block Block
#block Optic A_Lens '[] (VM t s) (VM t s) Block Block
-> Optic A_Lens '[] Block Block W256 W256
-> Optic A_Lens '[] (VM t s) (VM t s) W256 W256
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens '[] Block Block W256 W256
#number))
          [Expr 'EWord]
_ -> EvmError -> EVM t s ()
forall (t :: VMType) s. VMOps t => EvmError -> EVM t s ()
vmError (FunctionSelector -> EvmError
BadCheatCode FunctionSelector
sig),

      ByteString
-> (FunctionSelector -> CheatAction t s)
-> (FunctionSelector, CheatAction t s)
forall {b}.
ByteString -> (FunctionSelector -> b) -> (FunctionSelector, b)
action ByteString
"store(address,bytes32,bytes32)" ((FunctionSelector -> CheatAction t s)
 -> (FunctionSelector, CheatAction t s))
-> (FunctionSelector -> CheatAction t s)
-> (FunctionSelector, CheatAction t s)
forall a b. (a -> b) -> a -> b
$
        \FunctionSelector
sig Expr 'EWord
_ Expr 'EWord
_ Expr 'Buf
input -> case Int -> Int -> Expr 'Buf -> [Expr 'EWord]
decodeStaticArgs Int
0 Int
3 Expr 'Buf
input of
          [Expr 'EWord
a, Expr 'EWord
slot, Expr 'EWord
new] -> case Expr 'EWord -> Maybe (Expr 'EAddr)
wordToAddr Expr 'EWord
a of
            Just a' :: Expr 'EAddr
a'@(LitAddr Addr
_) -> Expr 'EAddr -> (Contract -> EVM t s ()) -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EAddr -> (Contract -> EVM t s ()) -> EVM t s ()
fetchAccount Expr 'EAddr
a' ((Contract -> EVM t s ()) -> EVM t s ())
-> (Contract -> EVM t s ()) -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ \Contract
_ ->
              Optic
  An_AffineTraversal
  '[]
  (VM t s)
  (VM t s)
  (Expr 'Storage)
  (Expr 'Storage)
-> (Expr 'Storage -> Expr 'Storage) -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying (Optic A_Lens '[] (VM t s) (VM t s) Env Env
#env Optic A_Lens '[] (VM t s) (VM t s) Env Env
-> Optic
     A_Lens
     '[]
     Env
     Env
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
-> Optic
     A_Lens
     '[]
     (VM t s)
     (VM t s)
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  Env
  Env
  (Map (Expr 'EAddr) Contract)
  (Map (Expr 'EAddr) Contract)
#contracts Optic
  A_Lens
  '[]
  (VM t s)
  (VM t s)
  (Map (Expr 'EAddr) Contract)
  (Map (Expr 'EAddr) Contract)
-> Optic
     (IxKind (Map (Expr 'EAddr) Contract))
     '[]
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
     (IxValue (Map (Expr 'EAddr) Contract))
     (IxValue (Map (Expr 'EAddr) Contract))
-> Optic
     An_AffineTraversal
     '[]
     (VM t s)
     (VM t s)
     (IxValue (Map (Expr 'EAddr) Contract))
     (IxValue (Map (Expr 'EAddr) Contract))
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Index (Map (Expr 'EAddr) Contract)
-> Optic
     (IxKind (Map (Expr 'EAddr) Contract))
     '[]
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
     (IxValue (Map (Expr 'EAddr) Contract))
     (IxValue (Map (Expr 'EAddr) Contract))
forall m. Ixed m => Index m -> Optic' (IxKind m) '[] m (IxValue m)
ix Index (Map (Expr 'EAddr) Contract)
Expr 'EAddr
a' Optic
  An_AffineTraversal
  '[]
  (VM t s)
  (VM t s)
  (IxValue (Map (Expr 'EAddr) Contract))
  (IxValue (Map (Expr 'EAddr) Contract))
-> Optic
     A_Lens
     '[]
     (IxValue (Map (Expr 'EAddr) Contract))
     (IxValue (Map (Expr 'EAddr) Contract))
     (Expr 'Storage)
     (Expr 'Storage)
-> Optic
     An_AffineTraversal
     '[]
     (VM t s)
     (VM t s)
     (Expr 'Storage)
     (Expr 'Storage)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (IxValue (Map (Expr 'EAddr) Contract))
  (IxValue (Map (Expr 'EAddr) Contract))
  (Expr 'Storage)
  (Expr 'Storage)
#storage) (Expr 'EWord -> Expr 'EWord -> Expr 'Storage -> Expr 'Storage
writeStorage Expr 'EWord
slot Expr 'EWord
new)
            Maybe (Expr 'EAddr)
_ -> EvmError -> EVM t s ()
forall (t :: VMType) s. VMOps t => EvmError -> EVM t s ()
vmError (FunctionSelector -> EvmError
BadCheatCode FunctionSelector
sig)
          [Expr 'EWord]
_ -> EvmError -> EVM t s ()
forall (t :: VMType) s. VMOps t => EvmError -> EVM t s ()
vmError (FunctionSelector -> EvmError
BadCheatCode FunctionSelector
sig),

      ByteString
-> (FunctionSelector -> CheatAction t s)
-> (FunctionSelector, CheatAction t s)
forall {b}.
ByteString -> (FunctionSelector -> b) -> (FunctionSelector, b)
action ByteString
"load(address,bytes32)" ((FunctionSelector -> CheatAction t s)
 -> (FunctionSelector, CheatAction t s))
-> (FunctionSelector -> CheatAction t s)
-> (FunctionSelector, CheatAction t s)
forall a b. (a -> b) -> a -> b
$
        \FunctionSelector
sig Expr 'EWord
outOffset Expr 'EWord
_ Expr 'Buf
input -> case Int -> Int -> Expr 'Buf -> [Expr 'EWord]
decodeStaticArgs Int
0 Int
2 Expr 'Buf
input of
          [Expr 'EWord
a, Expr 'EWord
slot] -> case Expr 'EWord -> Maybe (Expr 'EAddr)
wordToAddr Expr 'EWord
a of
            Just a' :: Expr 'EAddr
a'@(LitAddr Addr
_) -> Expr 'EAddr -> (Contract -> EVM t s ()) -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EAddr -> (Contract -> EVM t s ()) -> EVM t s ()
fetchAccount Expr 'EAddr
a' ((Contract -> EVM t s ()) -> EVM t s ())
-> (Contract -> EVM t s ()) -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ \Contract
_ ->
              Expr 'EAddr
-> Expr 'EWord -> (Expr 'EWord -> EVM t s ()) -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EAddr
-> Expr 'EWord -> (Expr 'EWord -> EVM t s ()) -> EVM t s ()
accessStorage Expr 'EAddr
a' Expr 'EWord
slot ((Expr 'EWord -> EVM t s ()) -> EVM t s ())
-> (Expr 'EWord -> EVM t s ()) -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ \Expr 'EWord
res -> do
                Optic A_Lens '[] (VM t s) (VM t s) (Expr 'EWord) (Expr 'EWord)
-> Expr 'EWord -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     (Expr 'Buf)
     (Expr 'Buf)
-> Optic A_Lens '[] (VM t s) (VM t s) (Expr 'Buf) (Expr 'Buf)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  (Expr 'Buf)
  (Expr 'Buf)
#returndata Optic A_Lens '[] (VM t s) (VM t s) (Expr 'Buf) (Expr 'Buf)
-> Optic
     A_Lens '[] (Expr 'Buf) (Expr 'Buf) (Expr 'EWord) (Expr 'EWord)
-> Optic A_Lens '[] (VM t s) (VM t s) (Expr 'EWord) (Expr 'EWord)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Expr 'EWord
-> Optic
     A_Lens '[] (Expr 'Buf) (Expr 'Buf) (Expr 'EWord) (Expr 'EWord)
word256At (W256 -> Expr 'EWord
Lit W256
0)) Expr 'EWord
res
                let buf :: Expr 'Buf
buf = Expr 'EWord -> Expr 'EWord -> Expr 'Buf -> Expr 'Buf
writeWord (W256 -> Expr 'EWord
Lit W256
0) Expr 'EWord
res (ByteString -> Expr 'Buf
ConcreteBuf ByteString
"")
                Expr 'Buf
-> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM t s ()
forall (t :: VMType) s.
Expr 'Buf
-> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM t s ()
copyBytesToMemory Expr 'Buf
buf (W256 -> Expr 'EWord
Lit W256
32) (W256 -> Expr 'EWord
Lit W256
0) Expr 'EWord
outOffset
            Maybe (Expr 'EAddr)
_ -> EvmError -> EVM t s ()
forall (t :: VMType) s. VMOps t => EvmError -> EVM t s ()
vmError (FunctionSelector -> EvmError
BadCheatCode FunctionSelector
sig)
          [Expr 'EWord]
_ -> EvmError -> EVM t s ()
forall (t :: VMType) s. VMOps t => EvmError -> EVM t s ()
vmError (FunctionSelector -> EvmError
BadCheatCode FunctionSelector
sig),

      ByteString
-> (FunctionSelector -> CheatAction t s)
-> (FunctionSelector, CheatAction t s)
forall {b}.
ByteString -> (FunctionSelector -> b) -> (FunctionSelector, b)
action ByteString
"sign(uint256,bytes32)" ((FunctionSelector -> CheatAction t s)
 -> (FunctionSelector, CheatAction t s))
-> (FunctionSelector -> CheatAction t s)
-> (FunctionSelector, CheatAction t s)
forall a b. (a -> b) -> a -> b
$
        \FunctionSelector
sig Expr 'EWord
outOffset Expr 'EWord
_ Expr 'Buf
input -> case Int -> Int -> Expr 'Buf -> [Expr 'EWord]
decodeStaticArgs Int
0 Int
2 Expr 'Buf
input of
          [Expr 'EWord
sk, Expr 'EWord
hash] ->
            (Expr 'EWord, Expr 'EWord)
-> [Char] -> ((W256, W256) -> EVM t s ()) -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
(Expr 'EWord, Expr 'EWord)
-> [Char] -> ((W256, W256) -> EVM t s ()) -> EVM t s ()
forceConcrete2 (Expr 'EWord
sk, Expr 'EWord
hash) [Char]
"cannot sign symbolic data" (((W256, W256) -> EVM t s ()) -> EVM t s ())
-> ((W256, W256) -> EVM t s ()) -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ \(W256
sk', W256
hash') -> do
              let (Word8
v,W256
r,W256
s) = W256 -> Integer -> (Word8, W256, W256)
EVM.Sign.sign W256
hash' (W256 -> Integer
forall target source. From source target => source -> target
into W256
sk')
                  encoded :: ByteString
encoded = AbiValue -> ByteString
encodeAbiValue (AbiValue -> ByteString) -> AbiValue -> ByteString
forall a b. (a -> b) -> a -> b
$
                    Vector AbiValue -> AbiValue
AbiTuple ([AbiValue] -> Vector AbiValue
forall a. [a] -> Vector a
V.fromList
                      [ Int -> Word256 -> AbiValue
AbiUInt Int
8 (Word256 -> AbiValue) -> Word256 -> AbiValue
forall a b. (a -> b) -> a -> b
$ Word8 -> Word256
forall target source. From source target => source -> target
into Word8
v
                      , Int -> ByteString -> AbiValue
AbiBytes Int
32 (W256 -> ByteString
word256Bytes W256
r)
                      , Int -> ByteString -> AbiValue
AbiBytes Int
32 (W256 -> ByteString
word256Bytes W256
s)
                      ])
              Optic A_Lens '[] (VM t s) (VM t s) (Expr 'Buf) (Expr 'Buf)
-> Expr 'Buf -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     (Expr 'Buf)
     (Expr 'Buf)
-> Optic A_Lens '[] (VM t s) (VM t s) (Expr 'Buf) (Expr 'Buf)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  (Expr 'Buf)
  (Expr 'Buf)
#returndata) (ByteString -> Expr 'Buf
ConcreteBuf ByteString
encoded)
              Expr 'Buf
-> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM t s ()
forall (t :: VMType) s.
Expr 'Buf
-> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM t s ()
copyBytesToMemory (ByteString -> Expr 'Buf
ConcreteBuf ByteString
encoded) (W256 -> Expr 'EWord
Lit (W256 -> Expr 'EWord)
-> (ByteString -> W256) -> ByteString -> Expr 'EWord
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> W256
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto (Int -> W256) -> (ByteString -> Int) -> ByteString -> W256
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
BS.length (ByteString -> Expr 'EWord) -> ByteString -> Expr 'EWord
forall a b. (a -> b) -> a -> b
$ ByteString
encoded) (W256 -> Expr 'EWord
Lit W256
0) Expr 'EWord
outOffset
          [Expr 'EWord]
_ -> EvmError -> EVM t s ()
forall (t :: VMType) s. VMOps t => EvmError -> EVM t s ()
vmError (FunctionSelector -> EvmError
BadCheatCode FunctionSelector
sig),

      ByteString
-> (FunctionSelector -> CheatAction t s)
-> (FunctionSelector, CheatAction t s)
forall {b}.
ByteString -> (FunctionSelector -> b) -> (FunctionSelector, b)
action ByteString
"addr(uint256)" ((FunctionSelector -> CheatAction t s)
 -> (FunctionSelector, CheatAction t s))
-> (FunctionSelector -> CheatAction t s)
-> (FunctionSelector, CheatAction t s)
forall a b. (a -> b) -> a -> b
$
        \FunctionSelector
sig Expr 'EWord
outOffset Expr 'EWord
_ Expr 'Buf
input -> case Int -> Int -> Expr 'Buf -> [Expr 'EWord]
decodeStaticArgs Int
0 Int
1 Expr 'Buf
input of
          [Expr 'EWord
sk] -> Expr 'EWord -> [Char] -> (W256 -> EVM t s ()) -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EWord -> [Char] -> (W256 -> EVM t s ()) -> EVM t s ()
forceConcrete Expr 'EWord
sk [Char]
"cannot derive address for a symbolic key" ((W256 -> EVM t s ()) -> EVM t s ())
-> (W256 -> EVM t s ()) -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ \W256
sk' -> do
            let a :: Maybe Addr
a = Integer -> Maybe Addr
EVM.Sign.deriveAddr (Integer -> Maybe Addr) -> Integer -> Maybe Addr
forall a b. (a -> b) -> a -> b
$ W256 -> Integer
forall target source. From source target => source -> target
into W256
sk'
            case Maybe Addr
a of
              Maybe Addr
Nothing -> EvmError -> EVM t s ()
forall (t :: VMType) s. VMOps t => EvmError -> EVM t s ()
vmError (FunctionSelector -> EvmError
BadCheatCode FunctionSelector
sig)
              Just Addr
address -> do
                let expAddr :: Expr 'EWord
expAddr = Addr -> Expr 'EWord
litAddr Addr
address
                Optic A_Lens '[] (VM t s) (VM t s) (Expr 'EWord) (Expr 'EWord)
-> Expr 'EWord -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     (Expr 'Buf)
     (Expr 'Buf)
-> Optic A_Lens '[] (VM t s) (VM t s) (Expr 'Buf) (Expr 'Buf)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  (Expr 'Buf)
  (Expr 'Buf)
#returndata Optic A_Lens '[] (VM t s) (VM t s) (Expr 'Buf) (Expr 'Buf)
-> Optic
     A_Lens '[] (Expr 'Buf) (Expr 'Buf) (Expr 'EWord) (Expr 'EWord)
-> Optic A_Lens '[] (VM t s) (VM t s) (Expr 'EWord) (Expr 'EWord)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Expr 'EWord
-> Optic
     A_Lens '[] (Expr 'Buf) (Expr 'Buf) (Expr 'EWord) (Expr 'EWord)
word256At (W256 -> Expr 'EWord
Lit W256
0)) Expr 'EWord
expAddr
                let buf :: Expr 'Buf
buf = ByteString -> Expr 'Buf
ConcreteBuf (ByteString -> Expr 'Buf) -> ByteString -> Expr 'Buf
forall a b. (a -> b) -> a -> b
$ W256 -> ByteString
word256Bytes (Addr -> W256
forall target source. From source target => source -> target
into Addr
address)
                Expr 'Buf
-> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM t s ()
forall (t :: VMType) s.
Expr 'Buf
-> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM t s ()
copyBytesToMemory Expr 'Buf
buf (W256 -> Expr 'EWord
Lit W256
32) (W256 -> Expr 'EWord
Lit W256
0) Expr 'EWord
outOffset
          [Expr 'EWord]
_ -> EvmError -> EVM t s ()
forall (t :: VMType) s. VMOps t => EvmError -> EVM t s ()
vmError (FunctionSelector -> EvmError
BadCheatCode FunctionSelector
sig),

      ByteString
-> (FunctionSelector -> CheatAction t s)
-> (FunctionSelector, CheatAction t s)
forall {b}.
ByteString -> (FunctionSelector -> b) -> (FunctionSelector, b)
action ByteString
"prank(address)" ((FunctionSelector -> CheatAction t s)
 -> (FunctionSelector, CheatAction t s))
-> (FunctionSelector -> CheatAction t s)
-> (FunctionSelector, CheatAction t s)
forall a b. (a -> b) -> a -> b
$
        \FunctionSelector
sig Expr 'EWord
_ Expr 'EWord
_ Expr 'Buf
input -> case Int -> Int -> Expr 'Buf -> [Expr 'EWord]
decodeStaticArgs Int
0 Int
1 Expr 'Buf
input of
          [Expr 'EWord
addr]  -> case Expr 'EWord -> Maybe (Expr 'EAddr)
wordToAddr Expr 'EWord
addr of
            Just Expr 'EAddr
a -> Optic
  A_Lens
  '[]
  (VM t s)
  (VM t s)
  (Maybe (Expr 'EAddr))
  (Maybe (Expr 'EAddr))
-> Maybe (Expr 'EAddr) -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens '[] (VM t s) (VM t s) RuntimeConfig RuntimeConfig
#config Optic A_Lens '[] (VM t s) (VM t s) RuntimeConfig RuntimeConfig
-> Optic
     A_Lens
     '[]
     RuntimeConfig
     RuntimeConfig
     (Maybe (Expr 'EAddr))
     (Maybe (Expr 'EAddr))
-> Optic
     A_Lens
     '[]
     (VM t s)
     (VM t s)
     (Maybe (Expr 'EAddr))
     (Maybe (Expr 'EAddr))
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  RuntimeConfig
  RuntimeConfig
  (Maybe (Expr 'EAddr))
  (Maybe (Expr 'EAddr))
#overrideCaller) (Expr 'EAddr -> Maybe (Expr 'EAddr)
forall a. a -> Maybe a
Just Expr 'EAddr
a)
            Maybe (Expr 'EAddr)
Nothing -> EvmError -> EVM t s ()
forall (t :: VMType) s. VMOps t => EvmError -> EVM t s ()
vmError (FunctionSelector -> EvmError
BadCheatCode FunctionSelector
sig)
          [Expr 'EWord]
_ -> EvmError -> EVM t s ()
forall (t :: VMType) s. VMOps t => EvmError -> EVM t s ()
vmError (FunctionSelector -> EvmError
BadCheatCode FunctionSelector
sig),

      ByteString
-> (FunctionSelector -> CheatAction t s)
-> (FunctionSelector, CheatAction t s)
forall {b}.
ByteString -> (FunctionSelector -> b) -> (FunctionSelector, b)
action ByteString
"createFork(string)" ((FunctionSelector -> CheatAction t s)
 -> (FunctionSelector, CheatAction t s))
-> (FunctionSelector -> CheatAction t s)
-> (FunctionSelector, CheatAction t s)
forall a b. (a -> b) -> a -> b
$
        \FunctionSelector
sig Expr 'EWord
outOffset Expr 'EWord
_ Expr 'Buf
input -> case [AbiType] -> Expr 'Buf -> AbiVals
decodeBuf [AbiType
AbiStringType] Expr 'Buf
input of
          CAbi [AbiValue]
valsArr -> case [AbiValue]
valsArr of
            [AbiString ByteString
bytes] -> do
              Int
forkId <- Seq ForkState -> Int
forall a. Seq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Seq ForkState -> Int)
-> StateT (VM t s) (ST s) (Seq ForkState)
-> StateT (VM t s) (ST s) Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (VM t s -> Seq ForkState) -> StateT (VM t s) (ST s) (Seq ForkState)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (.forks)
              let urlOrAlias :: [Char]
urlOrAlias = ByteString -> [Char]
Char8.unpack ByteString
bytes
              (VM t s -> VM t s) -> EVM t s ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((VM t s -> VM t s) -> EVM t s ())
-> (VM t s -> VM t s) -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ \VM t s
vm -> VM t s
vm { $sel:forks:VM :: Seq ForkState
forks = VM t s
vm.forks Seq ForkState -> ForkState -> Seq ForkState
forall a. Seq a -> a -> Seq a
Seq.|> Env -> Block -> Cache -> [Char] -> ForkState
ForkState VM t s
vm.env VM t s
vm.block VM t s
vm.cache [Char]
urlOrAlias }
              let encoded :: ByteString
encoded = AbiValue -> ByteString
encodeAbiValue (AbiValue -> ByteString) -> AbiValue -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> Word256 -> AbiValue
AbiUInt Int
256 (Int -> Word256
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
forkId)
              Optic A_Lens '[] (VM t s) (VM t s) (Expr 'Buf) (Expr 'Buf)
-> Expr 'Buf -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     (Expr 'Buf)
     (Expr 'Buf)
-> Optic A_Lens '[] (VM t s) (VM t s) (Expr 'Buf) (Expr 'Buf)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  (Expr 'Buf)
  (Expr 'Buf)
#returndata) (ByteString -> Expr 'Buf
ConcreteBuf ByteString
encoded)
              Expr 'Buf
-> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM t s ()
forall (t :: VMType) s.
Expr 'Buf
-> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM t s ()
copyBytesToMemory (ByteString -> Expr 'Buf
ConcreteBuf ByteString
encoded) (W256 -> Expr 'EWord
Lit (W256 -> Expr 'EWord)
-> (ByteString -> W256) -> ByteString -> Expr 'EWord
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> W256
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto (Int -> W256) -> (ByteString -> Int) -> ByteString -> W256
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
BS.length (ByteString -> Expr 'EWord) -> ByteString -> Expr 'EWord
forall a b. (a -> b) -> a -> b
$ ByteString
encoded) (W256 -> Expr 'EWord
Lit W256
0) Expr 'EWord
outOffset
            [AbiValue]
_ -> EvmError -> EVM t s ()
forall (t :: VMType) s. VMOps t => EvmError -> EVM t s ()
vmError (FunctionSelector -> EvmError
BadCheatCode FunctionSelector
sig)
          AbiVals
_ -> EvmError -> EVM t s ()
forall (t :: VMType) s. VMOps t => EvmError -> EVM t s ()
vmError (FunctionSelector -> EvmError
BadCheatCode FunctionSelector
sig),

      ByteString
-> (FunctionSelector -> CheatAction t s)
-> (FunctionSelector, CheatAction t s)
forall {b}.
ByteString -> (FunctionSelector -> b) -> (FunctionSelector, b)
action ByteString
"selectFork(uint256)" ((FunctionSelector -> CheatAction t s)
 -> (FunctionSelector, CheatAction t s))
-> (FunctionSelector -> CheatAction t s)
-> (FunctionSelector, CheatAction t s)
forall a b. (a -> b) -> a -> b
$
        \FunctionSelector
sig Expr 'EWord
_ Expr 'EWord
_ Expr 'Buf
input -> case Int -> Int -> Expr 'Buf -> [Expr 'EWord]
decodeStaticArgs Int
0 Int
1 Expr 'Buf
input of
          [Expr 'EWord
forkId] ->
            Expr 'EWord -> [Char] -> (W256 -> EVM t s ()) -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EWord -> [Char] -> (W256 -> EVM t s ()) -> EVM t s ()
forceConcrete Expr 'EWord
forkId [Char]
"forkId must be concrete" ((W256 -> EVM t s ()) -> EVM t s ())
-> (W256 -> EVM t s ()) -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ \(W256 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
forkId') -> do
              Maybe ForkState
saved <- Int -> Seq ForkState -> Maybe ForkState
forall a. Int -> Seq a -> Maybe a
Seq.lookup Int
forkId' (Seq ForkState -> Maybe ForkState)
-> StateT (VM t s) (ST s) (Seq ForkState)
-> StateT (VM t s) (ST s) (Maybe ForkState)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (VM t s -> Seq ForkState) -> StateT (VM t s) (ST s) (Seq ForkState)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (.forks)
              case Maybe ForkState
saved of
                Just ForkState
forkState -> do
                  VM t s
vm <- StateT (VM t s) (ST s) (VM t s)
forall s (m :: * -> *). MonadState s m => m s
get
                  let contractAddr :: Expr 'EAddr
contractAddr = VM t s
vm.state.contract
                  let callerAddr :: Expr 'EAddr
callerAddr = VM t s
vm.state.caller
                  Expr 'EAddr -> (Contract -> EVM t s ()) -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EAddr -> (Contract -> EVM t s ()) -> EVM t s ()
fetchAccount Expr 'EAddr
contractAddr ((Contract -> EVM t s ()) -> EVM t s ())
-> (Contract -> EVM t s ()) -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ \Contract
contractAcct -> Expr 'EAddr -> (Contract -> EVM t s ()) -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EAddr -> (Contract -> EVM t s ()) -> EVM t s ()
fetchAccount Expr 'EAddr
callerAddr ((Contract -> EVM t s ()) -> EVM t s ())
-> (Contract -> EVM t s ()) -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ \Contract
callerAcct -> do
                    let
                      -- the current contract is persisted across forks
                      newContracts :: Map (Expr 'EAddr) Contract
newContracts = Expr 'EAddr
-> Contract
-> Map (Expr 'EAddr) Contract
-> Map (Expr 'EAddr) Contract
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Expr 'EAddr
callerAddr Contract
callerAcct (Map (Expr 'EAddr) Contract -> Map (Expr 'EAddr) Contract)
-> Map (Expr 'EAddr) Contract -> Map (Expr 'EAddr) Contract
forall a b. (a -> b) -> a -> b
$
                                     Expr 'EAddr
-> Contract
-> Map (Expr 'EAddr) Contract
-> Map (Expr 'EAddr) Contract
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Expr 'EAddr
contractAddr Contract
contractAcct ForkState
forkState.env.contracts
                      newEnv :: Env
newEnv = (ForkState
forkState.env :: Env) { $sel:contracts:Env :: Map (Expr 'EAddr) Contract
contracts = Map (Expr 'EAddr) Contract
newContracts }

                    Bool -> EVM t s () -> EVM t s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (VM t s
vm.currentFork Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
forkId') (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ do
                      (VM t s -> VM t s) -> EVM t s ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((VM t s -> VM t s) -> EVM t s ())
-> (VM t s -> VM t s) -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ \VM t s
vm' -> VM t s
vm'
                        { $sel:env:VM :: Env
env = Env
newEnv
                        , $sel:block:VM :: Block
block = ForkState
forkState.block
                        , $sel:forks:VM :: Seq ForkState
forks = (ForkState -> ForkState) -> Int -> Seq ForkState -> Seq ForkState
forall a. (a -> a) -> Int -> Seq a -> Seq a
Seq.adjust' (\ForkState
state -> (ForkState
state :: ForkState)
                            { $sel:env:ForkState :: Env
env = VM t s
vm.env, $sel:block:ForkState :: Block
block = VM t s
vm.block, $sel:cache:ForkState :: Cache
cache = VM t s
vm.cache }
                          ) VM t s
vm.currentFork  VM t s
vm.forks
                        , $sel:currentFork:VM :: Int
currentFork = Int
forkId'
                        }
                Maybe ForkState
Nothing ->
                  EvmError -> EVM t s ()
forall (t :: VMType) s. VMOps t => EvmError -> EVM t s ()
vmError (Int -> EvmError
NonexistentFork Int
forkId')
          [Expr 'EWord]
_ -> EvmError -> EVM t s ()
forall (t :: VMType) s. VMOps t => EvmError -> EVM t s ()
vmError (FunctionSelector -> EvmError
BadCheatCode FunctionSelector
sig),

      ByteString
-> (FunctionSelector -> CheatAction t s)
-> (FunctionSelector, CheatAction t s)
forall {b}.
ByteString -> (FunctionSelector -> b) -> (FunctionSelector, b)
action ByteString
"activeFork()" ((FunctionSelector -> CheatAction t s)
 -> (FunctionSelector, CheatAction t s))
-> (FunctionSelector -> CheatAction t s)
-> (FunctionSelector, CheatAction t s)
forall a b. (a -> b) -> a -> b
$
        \FunctionSelector
_ Expr 'EWord
outOffset Expr 'EWord
_ Expr 'Buf
_ -> do
          VM t s
vm <- StateT (VM t s) (ST s) (VM t s)
forall s (m :: * -> *). MonadState s m => m s
get
          let encoded :: ByteString
encoded = AbiValue -> ByteString
encodeAbiValue (AbiValue -> ByteString) -> AbiValue -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> Word256 -> AbiValue
AbiUInt Int
256 (Int -> Word256
forall a b. (Integral a, Num b) => a -> b
fromIntegral VM t s
vm.currentFork)
          Optic A_Lens '[] (VM t s) (VM t s) (Expr 'Buf) (Expr 'Buf)
-> Expr 'Buf -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     (Expr 'Buf)
     (Expr 'Buf)
-> Optic A_Lens '[] (VM t s) (VM t s) (Expr 'Buf) (Expr 'Buf)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  (Expr 'Buf)
  (Expr 'Buf)
#returndata) (ByteString -> Expr 'Buf
ConcreteBuf ByteString
encoded)
          Expr 'Buf
-> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM t s ()
forall (t :: VMType) s.
Expr 'Buf
-> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM t s ()
copyBytesToMemory (ByteString -> Expr 'Buf
ConcreteBuf ByteString
encoded) (W256 -> Expr 'EWord
Lit (W256 -> Expr 'EWord)
-> (ByteString -> W256) -> ByteString -> Expr 'EWord
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> W256
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto (Int -> W256) -> (ByteString -> Int) -> ByteString -> W256
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
BS.length (ByteString -> Expr 'EWord) -> ByteString -> Expr 'EWord
forall a b. (a -> b) -> a -> b
$ ByteString
encoded) (W256 -> Expr 'EWord
Lit W256
0) Expr 'EWord
outOffset
    ]
  where
    action :: ByteString -> (FunctionSelector -> b) -> (FunctionSelector, b)
action ByteString
s FunctionSelector -> b
f = (ByteString -> FunctionSelector
abiKeccak ByteString
s, FunctionSelector -> b
f (ByteString -> FunctionSelector
abiKeccak ByteString
s))

-- * General call implementation ("delegateCall")
-- note that the continuation is ignored in the precompile case
delegateCall
  :: (VMOps t, ?op :: Word8)
  => Contract
  -> Gas t
  -> Expr EAddr
  -> Expr EAddr
  -> Expr EWord
  -> Expr EWord
  -> Expr EWord
  -> Expr EWord
  -> Expr EWord
  -> [Expr EWord]
  -> (Expr EAddr -> EVM t s ())
  -> EVM t s ()
delegateCall :: forall (t :: VMType) s.
(VMOps t, ?op::Word8) =>
Contract
-> Gas t
-> Expr 'EAddr
-> Expr 'EAddr
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> [Expr 'EWord]
-> (Expr 'EAddr -> EVM t s ())
-> EVM t s ()
delegateCall Contract
this Gas t
gasGiven Expr 'EAddr
xTo Expr 'EAddr
xContext Expr 'EWord
xValue Expr 'EWord
xInOffset Expr 'EWord
xInSize Expr 'EWord
xOutOffset Expr 'EWord
xOutSize [Expr 'EWord]
xs Expr 'EAddr -> EVM t s ()
continue
  | Expr 'EAddr -> Bool
isPrecompileAddr Expr 'EAddr
xTo
      = (Expr 'EAddr, Expr 'EAddr)
-> [Char] -> ((Addr, Addr) -> EVM t s ()) -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
(Expr 'EAddr, Expr 'EAddr)
-> [Char] -> ((Addr, Addr) -> EVM t s ()) -> EVM t s ()
forceConcreteAddr2 (Expr 'EAddr
xTo, Expr 'EAddr
xContext) [Char]
"Cannot call precompile with symbolic addresses" (((Addr, Addr) -> EVM t s ()) -> EVM t s ())
-> ((Addr, Addr) -> EVM t s ()) -> EVM t s ()
forall a b. (a -> b) -> a -> b
$
          \(Addr
xTo', Addr
xContext') ->
            Contract
-> Gas t
-> Addr
-> Addr
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> [Expr 'EWord]
-> EVM t s ()
forall (t :: VMType) s.
(?op::Word8, VMOps t) =>
Contract
-> Gas t
-> Addr
-> Addr
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> [Expr 'EWord]
-> EVM t s ()
precompiledContract Contract
this Gas t
gasGiven Addr
xTo' Addr
xContext' Expr 'EWord
xValue Expr 'EWord
xInOffset Expr 'EWord
xInSize Expr 'EWord
xOutOffset Expr 'EWord
xOutSize [Expr 'EWord]
xs
  | Expr 'EAddr
xTo Expr 'EAddr -> Expr 'EAddr -> Bool
forall a. Eq a => a -> a -> Bool
== Expr 'EAddr
cheatCode = do
      Optic A_Lens '[] (VM t s) (VM t s) [Expr 'EWord] [Expr 'EWord]
-> [Expr 'EWord] -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     [Expr 'EWord]
     [Expr 'EWord]
-> Optic A_Lens '[] (VM t s) (VM t s) [Expr 'EWord] [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  [Expr 'EWord]
  [Expr 'EWord]
#stack) [Expr 'EWord]
xs
      (Expr 'EWord, Expr 'EWord)
-> (Expr 'EWord, Expr 'EWord) -> EVM t s ()
forall (t :: VMType) s.
(?op::Word8, VMOps t) =>
(Expr 'EWord, Expr 'EWord)
-> (Expr 'EWord, Expr 'EWord) -> EVM t s ()
cheat (Expr 'EWord
xInOffset, Expr 'EWord
xInSize) (Expr 'EWord
xOutOffset, Expr 'EWord
xOutSize)
  | Bool
otherwise =
      Contract
-> Gas t
-> Expr 'EAddr
-> Expr 'EAddr
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> [Expr 'EWord]
-> (Gas t -> EVM t s ())
-> EVM t s ()
forall (t :: VMType) s.
(?op::Word8, VMOps t) =>
Contract
-> Gas t
-> Expr 'EAddr
-> Expr 'EAddr
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> [Expr 'EWord]
-> (Gas t -> EVM t s ())
-> EVM t s ()
callChecks Contract
this Gas t
gasGiven Expr 'EAddr
xContext Expr 'EAddr
xTo Expr 'EWord
xValue Expr 'EWord
xInOffset Expr 'EWord
xInSize Expr 'EWord
xOutOffset Expr 'EWord
xOutSize [Expr 'EWord]
xs ((Gas t -> EVM t s ()) -> EVM t s ())
-> (Gas t -> EVM t s ()) -> EVM t s ()
forall a b. (a -> b) -> a -> b
$
        \Gas t
xGas -> do
          VM t s
vm0 <- StateT (VM t s) (ST s) (VM t s)
forall s (m :: * -> *). MonadState s m => m s
get
          Expr 'EAddr -> (Contract -> EVM t s ()) -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EAddr -> (Contract -> EVM t s ()) -> EVM t s ()
fetchAccount Expr 'EAddr
xTo ((Contract -> EVM t s ()) -> EVM t s ())
-> (Contract -> EVM t s ()) -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ \Contract
target -> case Contract
target.code of
              UnknownCode Expr 'EAddr
_ -> do
                Int
pc <- Optic' A_Lens '[] (VM t s) Int -> StateT (VM t s) (ST s) Int
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic A_Lens '[] (FrameState t s) (FrameState t s) Int Int
-> Optic' A_Lens '[] (VM t s) Int
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens '[] (FrameState t s) (FrameState t s) Int Int
#pc)
                PartialExec -> EVM t s ()
forall s. PartialExec -> EVM t s ()
forall (t :: VMType) s. VMOps t => PartialExec -> EVM t s ()
partial (PartialExec -> EVM t s ()) -> PartialExec -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ Int -> [Char] -> [SomeExpr] -> PartialExec
UnexpectedSymbolicArg Int
pc [Char]
"call target has unknown code" ([Expr 'EAddr] -> [SomeExpr]
forall (a :: EType). Typeable a => [Expr a] -> [SomeExpr]
wrap [Expr 'EAddr
xTo])
              ContractCode
_ -> do
                Gas t -> EVM t s () -> EVM t s ()
forall s. Gas t -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Gas t -> EVM t s () -> EVM t s ()
burn' Gas t
xGas (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ do
                  Expr 'Buf
calldata <- Expr 'EWord -> Expr 'EWord -> EVM t s (Expr 'Buf)
forall (t :: VMType) s.
Expr 'EWord -> Expr 'EWord -> EVM t s (Expr 'Buf)
readMemory Expr 'EWord
xInOffset Expr 'EWord
xInSize
                  Maybe W256
abi <- Expr 'EWord -> Maybe W256
maybeLitWord (Expr 'EWord -> Maybe W256)
-> (Expr 'Buf -> Expr 'EWord) -> Expr 'Buf -> Maybe W256
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Expr 'EWord -> Expr 'Buf -> Expr 'EWord
readBytes Int
4 (W256 -> Expr 'EWord
Lit W256
0) (Expr 'Buf -> Maybe W256)
-> EVM t s (Expr 'Buf) -> StateT (VM t s) (ST s) (Maybe W256)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr 'EWord -> Expr 'EWord -> EVM t s (Expr 'Buf)
forall (t :: VMType) s.
Expr 'EWord -> Expr 'EWord -> EVM t s (Expr 'Buf)
readMemory Expr 'EWord
xInOffset (W256 -> Expr 'EWord
Lit W256
4)
                  let newContext :: FrameContext
newContext = CallContext
                                    { $sel:target:CreationContext :: Expr 'EAddr
target    = Expr 'EAddr
xTo
                                    , $sel:context:CreationContext :: Expr 'EAddr
context   = Expr 'EAddr
xContext
                                    , $sel:offset:CreationContext :: Expr 'EWord
offset    = Expr 'EWord
xOutOffset
                                    , $sel:size:CreationContext :: Expr 'EWord
size      = Expr 'EWord
xOutSize
                                    , $sel:codehash:CreationContext :: Expr 'EWord
codehash  = Contract
target.codehash
                                    , $sel:callreversion:CreationContext :: Map (Expr 'EAddr) Contract
callreversion = VM t s
vm0.env.contracts
                                    , $sel:subState:CreationContext :: SubState
subState  = VM t s
vm0.tx.substate
                                    , Maybe W256
abi :: Maybe W256
$sel:abi:CreationContext :: Maybe W256
abi
                                    , Expr 'Buf
calldata :: Expr 'Buf
$sel:calldata:CreationContext :: Expr 'Buf
calldata
                                    }
                  TraceData -> EVM t s ()
forall (t :: VMType) s. TraceData -> EVM t s ()
pushTrace (FrameContext -> TraceData
FrameTrace FrameContext
newContext)
                  EVM t s ()
forall (t :: VMType) s. (?op::Word8) => EVM t s ()
next
                  VM t s
vm1 <- StateT (VM t s) (ST s) (VM t s)
forall s (m :: * -> *). MonadState s m => m s
get

                  Lens (VM t s) (VM t s) [Frame t s] [Frame t s]
-> Frame t s -> EVM t s ()
forall s (m :: * -> *) a.
MonadState s m =>
Lens s s [a] [a] -> a -> m ()
pushTo Lens (VM t s) (VM t s) [Frame t s] [Frame t s]
#frames (Frame t s -> EVM t s ()) -> Frame t s -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ Frame
                    { $sel:state:Frame :: FrameState t s
state = VM t s
vm1.state { $sel:stack:FrameState :: [Expr 'EWord]
stack = [Expr 'EWord]
xs }
                    , $sel:context:Frame :: FrameContext
context = FrameContext
newContext
                    }

                  let clearInitCode :: ContractCode -> ContractCode
clearInitCode = \case
                        (InitCode ByteString
_ Expr 'Buf
_) -> ByteString -> Expr 'Buf -> ContractCode
InitCode ByteString
forall a. Monoid a => a
mempty Expr 'Buf
forall a. Monoid a => a
mempty
                        ContractCode
a -> ContractCode
a

                  Memory s
newMemory <- MutableMemory s -> Memory s
forall s. MutableMemory s -> Memory s
ConcreteMemory (MutableMemory s -> Memory s)
-> StateT (VM t s) (ST s) (MutableMemory s)
-> StateT (VM t s) (ST s) (Memory s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> StateT
     (VM t s)
     (ST s)
     (MVector (PrimState (StateT (VM t s) (ST s))) Word8)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> m (MVector (PrimState m) a)
VUnboxed.Mutable.new Int
0
                  Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> StateT (FrameState t s) (ST s) () -> EVM t s ()
forall k (is :: IxList) c.
Is k A_Lens =>
Optic' k is (VM t s) (FrameState t s)
-> StateT (FrameState t s) (ST s) c -> StateT (VM t s) (ST s) c
forall (m :: * -> *) (n :: * -> *) s t k (is :: IxList) c.
(Zoom m n s t, Is k A_Lens) =>
Optic' k is t s -> m c -> n c
zoom Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state (StateT (FrameState t s) (ST s) () -> EVM t s ())
-> StateT (FrameState t s) (ST s) () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ do
                    Optic A_Lens '[] (FrameState t s) (FrameState t s) (Gas t) (Gas t)
-> Gas t -> StateT (FrameState t s) (ST s) ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign Optic A_Lens '[] (FrameState t s) (FrameState t s) (Gas t) (Gas t)
#gas Gas t
xGas
                    Optic A_Lens '[] (FrameState t s) (FrameState t s) Int Int
-> Int -> StateT (FrameState t s) (ST s) ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign Optic A_Lens '[] (FrameState t s) (FrameState t s) Int Int
#pc Int
0
                    Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  ContractCode
  ContractCode
-> ContractCode -> StateT (FrameState t s) (ST s) ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  ContractCode
  ContractCode
#code (ContractCode -> ContractCode
clearInitCode Contract
target.code)
                    Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  (Expr 'EAddr)
  (Expr 'EAddr)
-> Expr 'EAddr -> StateT (FrameState t s) (ST s) ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  (Expr 'EAddr)
  (Expr 'EAddr)
#codeContract Expr 'EAddr
xTo
                    Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  [Expr 'EWord]
  [Expr 'EWord]
-> [Expr 'EWord] -> StateT (FrameState t s) (ST s) ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  [Expr 'EWord]
  [Expr 'EWord]
#stack [Expr 'EWord]
forall a. Monoid a => a
mempty
                    Optic
  A_Lens '[] (FrameState t s) (FrameState t s) (Memory s) (Memory s)
-> Memory s -> StateT (FrameState t s) (ST s) ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign Optic
  A_Lens '[] (FrameState t s) (FrameState t s) (Memory s) (Memory s)
#memory Memory s
newMemory
                    Optic A_Lens '[] (FrameState t s) (FrameState t s) Word64 Word64
-> Word64 -> StateT (FrameState t s) (ST s) ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign Optic A_Lens '[] (FrameState t s) (FrameState t s) Word64 Word64
#memorySize Word64
0
                    Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  (Expr 'Buf)
  (Expr 'Buf)
-> Expr 'Buf -> StateT (FrameState t s) (ST s) ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  (Expr 'Buf)
  (Expr 'Buf)
#returndata Expr 'Buf
forall a. Monoid a => a
mempty
                    Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  (Expr 'Buf)
  (Expr 'Buf)
-> Expr 'Buf -> StateT (FrameState t s) (ST s) ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  (Expr 'Buf)
  (Expr 'Buf)
#calldata Expr 'Buf
calldata
                  Expr 'EAddr -> EVM t s ()
continue Expr 'EAddr
xTo

-- -- * Contract creation

-- EIP 684
collision :: Maybe Contract -> Bool
collision :: Maybe Contract -> Bool
collision Maybe Contract
c' = case Maybe Contract
c' of
  Just Contract
c -> Contract
c.nonce Maybe W64 -> Maybe W64 -> Bool
forall a. Eq a => a -> a -> Bool
/= W64 -> Maybe W64
forall a. a -> Maybe a
Just W64
0 Bool -> Bool -> Bool
|| case Contract
c.code of
    RuntimeCode (ConcreteRuntimeCode ByteString
"") -> Bool
False
    RuntimeCode (SymbolicRuntimeCode Vector (Expr 'Byte)
b) -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Vector (Expr 'Byte) -> Bool
forall a. Vector a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Vector (Expr 'Byte)
b
    ContractCode
_ -> Bool
True
  Maybe Contract
Nothing -> Bool
False

create :: forall t s. (?op :: Word8, VMOps t)
  => Expr EAddr -> Contract
  -> Expr EWord -> Gas t -> Expr EWord -> [Expr EWord] -> Expr EAddr -> Expr Buf -> EVM t s ()
create :: forall (t :: VMType) s.
(?op::Word8, VMOps t) =>
Expr 'EAddr
-> Contract
-> Expr 'EWord
-> Gas t
-> Expr 'EWord
-> [Expr 'EWord]
-> Expr 'EAddr
-> Expr 'Buf
-> EVM t s ()
create Expr 'EAddr
self Contract
this Expr 'EWord
xSize Gas t
xGas Expr 'EWord
xValue [Expr 'EWord]
xs Expr 'EAddr
newAddr Expr 'Buf
initCode = do
  VM t s
vm0 <- StateT (VM t s) (ST s) (VM t s)
forall s (m :: * -> *). MonadState s m => m s
get
  if Expr 'EWord
xSize Expr 'EWord -> Expr 'EWord -> Bool
forall a. Ord a => a -> a -> Bool
> W256 -> Expr 'EWord
Lit (VM t s
vm0.block.maxCodeSize W256 -> W256 -> W256
forall a. Num a => a -> a -> a
* W256
2)
  then do
    Optic A_Lens '[] (VM t s) (VM t s) [Expr 'EWord] [Expr 'EWord]
-> [Expr 'EWord] -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     [Expr 'EWord]
     [Expr 'EWord]
-> Optic A_Lens '[] (VM t s) (VM t s) [Expr 'EWord] [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  [Expr 'EWord]
  [Expr 'EWord]
#stack) (W256 -> Expr 'EWord
Lit W256
0 Expr 'EWord -> [Expr 'EWord] -> [Expr 'EWord]
forall a. a -> [a] -> [a]
: [Expr 'EWord]
xs)
    Optic A_Lens '[] (VM t s) (VM t s) (Expr 'Buf) (Expr 'Buf)
-> Expr 'Buf -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     (Expr 'Buf)
     (Expr 'Buf)
-> Optic A_Lens '[] (VM t s) (VM t s) (Expr 'Buf) (Expr 'Buf)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  (Expr 'Buf)
  (Expr 'Buf)
#returndata) Expr 'Buf
forall a. Monoid a => a
mempty
    EvmError -> EVM t s ()
forall (t :: VMType) s. VMOps t => EvmError -> EVM t s ()
vmError (EvmError -> EVM t s ()) -> EvmError -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ W256 -> Expr 'EWord -> EvmError
MaxInitCodeSizeExceeded (VM t s
vm0.block.maxCodeSize W256 -> W256 -> W256
forall a. Num a => a -> a -> a
* W256
2) Expr 'EWord
xSize
  else if Contract
this.nonce Maybe W64 -> Maybe W64 -> Bool
forall a. Eq a => a -> a -> Bool
== W64 -> Maybe W64
forall a. a -> Maybe a
Just W64
forall a. Bounded a => a
maxBound
  then do
    Optic A_Lens '[] (VM t s) (VM t s) [Expr 'EWord] [Expr 'EWord]
-> [Expr 'EWord] -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     [Expr 'EWord]
     [Expr 'EWord]
-> Optic A_Lens '[] (VM t s) (VM t s) [Expr 'EWord] [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  [Expr 'EWord]
  [Expr 'EWord]
#stack) (W256 -> Expr 'EWord
Lit W256
0 Expr 'EWord -> [Expr 'EWord] -> [Expr 'EWord]
forall a. a -> [a] -> [a]
: [Expr 'EWord]
xs)
    Optic A_Lens '[] (VM t s) (VM t s) (Expr 'Buf) (Expr 'Buf)
-> Expr 'Buf -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     (Expr 'Buf)
     (Expr 'Buf)
-> Optic A_Lens '[] (VM t s) (VM t s) (Expr 'Buf) (Expr 'Buf)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  (Expr 'Buf)
  (Expr 'Buf)
#returndata) Expr 'Buf
forall a. Monoid a => a
mempty
    TraceData -> EVM t s ()
forall (t :: VMType) s. TraceData -> EVM t s ()
pushTrace (TraceData -> EVM t s ()) -> TraceData -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ EvmError -> TraceData
ErrorTrace EvmError
NonceOverflow
    EVM t s ()
forall (t :: VMType) s. (?op::Word8) => EVM t s ()
next
  else if [Frame t s] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length VM t s
vm0.frames Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1024
  then do
    Optic A_Lens '[] (VM t s) (VM t s) [Expr 'EWord] [Expr 'EWord]
-> [Expr 'EWord] -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     [Expr 'EWord]
     [Expr 'EWord]
-> Optic A_Lens '[] (VM t s) (VM t s) [Expr 'EWord] [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  [Expr 'EWord]
  [Expr 'EWord]
#stack) (W256 -> Expr 'EWord
Lit W256
0 Expr 'EWord -> [Expr 'EWord] -> [Expr 'EWord]
forall a. a -> [a] -> [a]
: [Expr 'EWord]
xs)
    Optic A_Lens '[] (VM t s) (VM t s) (Expr 'Buf) (Expr 'Buf)
-> Expr 'Buf -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     (Expr 'Buf)
     (Expr 'Buf)
-> Optic A_Lens '[] (VM t s) (VM t s) (Expr 'Buf) (Expr 'Buf)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  (Expr 'Buf)
  (Expr 'Buf)
#returndata) Expr 'Buf
forall a. Monoid a => a
mempty
    TraceData -> EVM t s ()
forall (t :: VMType) s. TraceData -> EVM t s ()
pushTrace (TraceData -> EVM t s ()) -> TraceData -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ EvmError -> TraceData
ErrorTrace EvmError
CallDepthLimitReached
    EVM t s ()
forall (t :: VMType) s. (?op::Word8) => EVM t s ()
next
  else if Maybe Contract -> Bool
collision (Maybe Contract -> Bool) -> Maybe Contract -> Bool
forall a b. (a -> b) -> a -> b
$ Expr 'EAddr -> Map (Expr 'EAddr) Contract -> Maybe Contract
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Expr 'EAddr
newAddr VM t s
vm0.env.contracts
  then Gas t -> EVM t s () -> EVM t s ()
forall s. Gas t -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Gas t -> EVM t s () -> EVM t s ()
burn' Gas t
xGas (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ do
    Optic A_Lens '[] (VM t s) (VM t s) [Expr 'EWord] [Expr 'EWord]
-> [Expr 'EWord] -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     [Expr 'EWord]
     [Expr 'EWord]
-> Optic A_Lens '[] (VM t s) (VM t s) [Expr 'EWord] [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  [Expr 'EWord]
  [Expr 'EWord]
#stack) (W256 -> Expr 'EWord
Lit W256
0 Expr 'EWord -> [Expr 'EWord] -> [Expr 'EWord]
forall a. a -> [a] -> [a]
: [Expr 'EWord]
xs)
    Optic A_Lens '[] (VM t s) (VM t s) (Expr 'Buf) (Expr 'Buf)
-> Expr 'Buf -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     (Expr 'Buf)
     (Expr 'Buf)
-> Optic A_Lens '[] (VM t s) (VM t s) (Expr 'Buf) (Expr 'Buf)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  (Expr 'Buf)
  (Expr 'Buf)
#returndata) Expr 'Buf
forall a. Monoid a => a
mempty
    Optic
  An_AffineTraversal '[] (VM t s) (VM t s) (Maybe W64) (Maybe W64)
-> (Maybe W64 -> Maybe W64) -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying (Optic A_Lens '[] (VM t s) (VM t s) Env Env
#env Optic A_Lens '[] (VM t s) (VM t s) Env Env
-> Optic
     A_Lens
     '[]
     Env
     Env
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
-> Optic
     A_Lens
     '[]
     (VM t s)
     (VM t s)
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  Env
  Env
  (Map (Expr 'EAddr) Contract)
  (Map (Expr 'EAddr) Contract)
#contracts Optic
  A_Lens
  '[]
  (VM t s)
  (VM t s)
  (Map (Expr 'EAddr) Contract)
  (Map (Expr 'EAddr) Contract)
-> Optic
     (IxKind (Map (Expr 'EAddr) Contract))
     '[]
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
     (IxValue (Map (Expr 'EAddr) Contract))
     (IxValue (Map (Expr 'EAddr) Contract))
-> Optic
     An_AffineTraversal
     '[]
     (VM t s)
     (VM t s)
     (IxValue (Map (Expr 'EAddr) Contract))
     (IxValue (Map (Expr 'EAddr) Contract))
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Index (Map (Expr 'EAddr) Contract)
-> Optic
     (IxKind (Map (Expr 'EAddr) Contract))
     '[]
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
     (IxValue (Map (Expr 'EAddr) Contract))
     (IxValue (Map (Expr 'EAddr) Contract))
forall m. Ixed m => Index m -> Optic' (IxKind m) '[] m (IxValue m)
ix Index (Map (Expr 'EAddr) Contract)
Expr 'EAddr
self Optic
  An_AffineTraversal
  '[]
  (VM t s)
  (VM t s)
  (IxValue (Map (Expr 'EAddr) Contract))
  (IxValue (Map (Expr 'EAddr) Contract))
-> Optic
     A_Lens
     '[]
     (IxValue (Map (Expr 'EAddr) Contract))
     (IxValue (Map (Expr 'EAddr) Contract))
     (Maybe W64)
     (Maybe W64)
-> Optic
     An_AffineTraversal '[] (VM t s) (VM t s) (Maybe W64) (Maybe W64)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (IxValue (Map (Expr 'EAddr) Contract))
  (IxValue (Map (Expr 'EAddr) Contract))
  (Maybe W64)
  (Maybe W64)
#nonce) ((W64 -> W64) -> Maybe W64 -> Maybe W64
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (W64 -> W64 -> W64
forall a. Num a => a -> a -> a
(+) W64
1))
    EVM t s ()
forall (t :: VMType) s. (?op::Word8) => EVM t s ()
next
  -- do we have enough balance
  else Expr 'EWord -> (Bool -> EVM t s ()) -> EVM t s ()
forall s. Expr 'EWord -> (Bool -> EVM t s ()) -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EWord -> (Bool -> EVM t s ()) -> EVM t s ()
branch (Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.gt Expr 'EWord
xValue Contract
this.balance) ((Bool -> EVM t s ()) -> EVM t s ())
-> (Bool -> EVM t s ()) -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ \case
      Bool
True -> do
        Optic A_Lens '[] (VM t s) (VM t s) [Expr 'EWord] [Expr 'EWord]
-> [Expr 'EWord] -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     [Expr 'EWord]
     [Expr 'EWord]
-> Optic A_Lens '[] (VM t s) (VM t s) [Expr 'EWord] [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  [Expr 'EWord]
  [Expr 'EWord]
#stack) (W256 -> Expr 'EWord
Lit W256
0 Expr 'EWord -> [Expr 'EWord] -> [Expr 'EWord]
forall a. a -> [a] -> [a]
: [Expr 'EWord]
xs)
        Optic A_Lens '[] (VM t s) (VM t s) (Expr 'Buf) (Expr 'Buf)
-> Expr 'Buf -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     (Expr 'Buf)
     (Expr 'Buf)
-> Optic A_Lens '[] (VM t s) (VM t s) (Expr 'Buf) (Expr 'Buf)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  (Expr 'Buf)
  (Expr 'Buf)
#returndata) Expr 'Buf
forall a. Monoid a => a
mempty
        TraceData -> EVM t s ()
forall (t :: VMType) s. TraceData -> EVM t s ()
pushTrace (TraceData -> EVM t s ()) -> TraceData -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ EvmError -> TraceData
ErrorTrace (EvmError -> TraceData) -> EvmError -> TraceData
forall a b. (a -> b) -> a -> b
$ Expr 'EWord -> Expr 'EWord -> EvmError
BalanceTooLow Expr 'EWord
xValue Contract
this.balance
        EVM t s ()
forall (t :: VMType) s. (?op::Word8) => EVM t s ()
next
        Expr 'EAddr -> EVM t s ()
forall (t :: VMType) s. Expr 'EAddr -> EVM t s ()
touchAccount Expr 'EAddr
self
        Expr 'EAddr -> EVM t s ()
forall (t :: VMType) s. Expr 'EAddr -> EVM t s ()
touchAccount Expr 'EAddr
newAddr
      -- are we overflowing the nonce
      Bool
False -> Gas t -> EVM t s () -> EVM t s ()
forall s. Gas t -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Gas t -> EVM t s () -> EVM t s ()
burn' Gas t
xGas (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ do
        case Expr 'Buf -> Maybe ContractCode
parseInitCode Expr 'Buf
initCode of
          Maybe ContractCode
Nothing ->
            PartialExec -> EVM t s ()
forall s. PartialExec -> EVM t s ()
forall (t :: VMType) s. VMOps t => PartialExec -> EVM t s ()
partial (PartialExec -> EVM t s ()) -> PartialExec -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ Int -> [Char] -> [SomeExpr] -> PartialExec
UnexpectedSymbolicArg VM t s
vm0.state.pc [Char]
"initcode must have a concrete prefix" []
          Just ContractCode
c -> do
            let
              newContract :: Contract
newContract = ContractCode -> Contract
initialContract ContractCode
c
              newContext :: FrameContext
newContext  =
                CreationContext { $sel:address:CreationContext :: Expr 'EAddr
address   = Expr 'EAddr
newAddr
                                , $sel:codehash:CreationContext :: Expr 'EWord
codehash  = Contract
newContract.codehash
                                , $sel:createreversion:CreationContext :: Map (Expr 'EAddr) Contract
createreversion = VM t s
vm0.env.contracts
                                , $sel:substate:CreationContext :: SubState
substate  = VM t s
vm0.tx.substate
                                }

            Optic
  A_Lens
  '[]
  (VM t s)
  (VM t s)
  (Map (Expr 'EAddr) Contract)
  (Map (Expr 'EAddr) Contract)
-> StateT (Map (Expr 'EAddr) Contract) (ST s) () -> EVM t s ()
forall k (is :: IxList) c.
Is k A_Lens =>
Optic' k is (VM t s) (Map (Expr 'EAddr) Contract)
-> StateT (Map (Expr 'EAddr) Contract) (ST s) c
-> StateT (VM t s) (ST s) c
forall (m :: * -> *) (n :: * -> *) s t k (is :: IxList) c.
(Zoom m n s t, Is k A_Lens) =>
Optic' k is t s -> m c -> n c
zoom (Optic A_Lens '[] (VM t s) (VM t s) Env Env
#env Optic A_Lens '[] (VM t s) (VM t s) Env Env
-> Optic
     A_Lens
     '[]
     Env
     Env
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
-> Optic
     A_Lens
     '[]
     (VM t s)
     (VM t s)
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  Env
  Env
  (Map (Expr 'EAddr) Contract)
  (Map (Expr 'EAddr) Contract)
#contracts) (StateT (Map (Expr 'EAddr) Contract) (ST s) () -> EVM t s ())
-> StateT (Map (Expr 'EAddr) Contract) (ST s) () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ do
              Maybe (IxValue (Map (Expr 'EAddr) Contract))
oldAcc <- Lens'
  (Map (Expr 'EAddr) Contract)
  (Maybe (IxValue (Map (Expr 'EAddr) Contract)))
-> StateT
     (Map (Expr 'EAddr) Contract)
     (ST s)
     (Maybe (IxValue (Map (Expr 'EAddr) Contract)))
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Index (Map (Expr 'EAddr) Contract)
-> Lens'
     (Map (Expr 'EAddr) Contract)
     (Maybe (IxValue (Map (Expr 'EAddr) Contract)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map (Expr 'EAddr) Contract)
Expr 'EAddr
newAddr)
              let oldBal :: Expr 'EWord
oldBal = Expr 'EWord
-> (IxValue (Map (Expr 'EAddr) Contract) -> Expr 'EWord)
-> Maybe (IxValue (Map (Expr 'EAddr) Contract))
-> Expr 'EWord
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (W256 -> Expr 'EWord
Lit W256
0) (.balance) Maybe (IxValue (Map (Expr 'EAddr) Contract))
oldAcc

              Lens'
  (Map (Expr 'EAddr) Contract)
  (Maybe (IxValue (Map (Expr 'EAddr) Contract)))
-> Maybe (IxValue (Map (Expr 'EAddr) Contract))
-> StateT (Map (Expr 'EAddr) Contract) (ST s) ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Index (Map (Expr 'EAddr) Contract)
-> Lens'
     (Map (Expr 'EAddr) Contract)
     (Maybe (IxValue (Map (Expr 'EAddr) Contract)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map (Expr 'EAddr) Contract)
Expr 'EAddr
newAddr) (IxValue (Map (Expr 'EAddr) Contract)
-> Maybe (IxValue (Map (Expr 'EAddr) Contract))
forall a. a -> Maybe a
Just (Contract
newContract Contract
-> (Contract -> IxValue (Map (Expr 'EAddr) Contract))
-> IxValue (Map (Expr 'EAddr) Contract)
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens
  '[]
  Contract
  (IxValue (Map (Expr 'EAddr) Contract))
  (Expr 'EWord)
  (Expr 'EWord)
#balance Optic
  A_Lens
  '[]
  Contract
  (IxValue (Map (Expr 'EAddr) Contract))
  (Expr 'EWord)
  (Expr 'EWord)
-> Expr 'EWord -> Contract -> IxValue (Map (Expr 'EAddr) Contract)
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Expr 'EWord
oldBal))
              Optic
  An_AffineTraversal
  '[]
  (Map (Expr 'EAddr) Contract)
  (Map (Expr 'EAddr) Contract)
  (Maybe W64)
  (Maybe W64)
-> (Maybe W64 -> Maybe W64)
-> StateT (Map (Expr 'EAddr) Contract) (ST s) ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying (Index (Map (Expr 'EAddr) Contract)
-> Optic
     (IxKind (Map (Expr 'EAddr) Contract))
     '[]
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
     (IxValue (Map (Expr 'EAddr) Contract))
     (IxValue (Map (Expr 'EAddr) Contract))
forall m. Ixed m => Index m -> Optic' (IxKind m) '[] m (IxValue m)
ix Index (Map (Expr 'EAddr) Contract)
Expr 'EAddr
self Optic
  (IxKind (Map (Expr 'EAddr) Contract))
  '[]
  (Map (Expr 'EAddr) Contract)
  (Map (Expr 'EAddr) Contract)
  (IxValue (Map (Expr 'EAddr) Contract))
  (IxValue (Map (Expr 'EAddr) Contract))
-> Optic
     A_Lens
     '[]
     (IxValue (Map (Expr 'EAddr) Contract))
     (IxValue (Map (Expr 'EAddr) Contract))
     (Maybe W64)
     (Maybe W64)
-> Optic
     An_AffineTraversal
     '[]
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
     (Maybe W64)
     (Maybe W64)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (IxValue (Map (Expr 'EAddr) Contract))
  (IxValue (Map (Expr 'EAddr) Contract))
  (Maybe W64)
  (Maybe W64)
#nonce) ((W64 -> W64) -> Maybe W64 -> Maybe W64
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (W64 -> W64 -> W64
forall a. Num a => a -> a -> a
(+) W64
1))

            let
              resetStorage :: Expr Storage -> Expr Storage
              resetStorage :: Expr 'Storage -> Expr 'Storage
resetStorage = \case
                  ConcreteStore Map W256 W256
_ -> Map W256 W256 -> Expr 'Storage
ConcreteStore Map W256 W256
forall a. Monoid a => a
mempty
                  AbstractStore Expr 'EAddr
a Maybe W256
Nothing -> Expr 'EAddr -> Maybe W256 -> Expr 'Storage
AbstractStore Expr 'EAddr
a Maybe W256
forall a. Maybe a
Nothing
                  SStore Expr 'EWord
_ Expr 'EWord
_ Expr 'Storage
p -> Expr 'Storage -> Expr 'Storage
resetStorage Expr 'Storage
p
                  AbstractStore Expr 'EAddr
_ (Just W256
_) -> [Char] -> Expr 'Storage
forall a. HasCallStack => [Char] -> a
internalError [Char]
"unexpected logical store in EVM.hs"
                  GVar GVar 'Storage
_  -> [Char] -> Expr 'Storage
forall a. HasCallStack => [Char] -> a
internalError [Char]
"unexpected global variable"

            Optic
  An_AffineTraversal
  '[]
  (VM t s)
  (VM t s)
  (Expr 'Storage)
  (Expr 'Storage)
-> (Expr 'Storage -> Expr 'Storage) -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying (Optic A_Lens '[] (VM t s) (VM t s) Env Env
#env Optic A_Lens '[] (VM t s) (VM t s) Env Env
-> Optic
     A_Lens
     '[]
     Env
     Env
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
-> Optic
     A_Lens
     '[]
     (VM t s)
     (VM t s)
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  Env
  Env
  (Map (Expr 'EAddr) Contract)
  (Map (Expr 'EAddr) Contract)
#contracts Optic
  A_Lens
  '[]
  (VM t s)
  (VM t s)
  (Map (Expr 'EAddr) Contract)
  (Map (Expr 'EAddr) Contract)
-> Optic
     (IxKind (Map (Expr 'EAddr) Contract))
     '[]
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
     (IxValue (Map (Expr 'EAddr) Contract))
     (IxValue (Map (Expr 'EAddr) Contract))
-> Optic
     An_AffineTraversal
     '[]
     (VM t s)
     (VM t s)
     (IxValue (Map (Expr 'EAddr) Contract))
     (IxValue (Map (Expr 'EAddr) Contract))
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Index (Map (Expr 'EAddr) Contract)
-> Optic
     (IxKind (Map (Expr 'EAddr) Contract))
     '[]
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
     (IxValue (Map (Expr 'EAddr) Contract))
     (IxValue (Map (Expr 'EAddr) Contract))
forall m. Ixed m => Index m -> Optic' (IxKind m) '[] m (IxValue m)
ix Index (Map (Expr 'EAddr) Contract)
Expr 'EAddr
newAddr Optic
  An_AffineTraversal
  '[]
  (VM t s)
  (VM t s)
  (IxValue (Map (Expr 'EAddr) Contract))
  (IxValue (Map (Expr 'EAddr) Contract))
-> Optic
     A_Lens
     '[]
     (IxValue (Map (Expr 'EAddr) Contract))
     (IxValue (Map (Expr 'EAddr) Contract))
     (Expr 'Storage)
     (Expr 'Storage)
-> Optic
     An_AffineTraversal
     '[]
     (VM t s)
     (VM t s)
     (Expr 'Storage)
     (Expr 'Storage)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (IxValue (Map (Expr 'EAddr) Contract))
  (IxValue (Map (Expr 'EAddr) Contract))
  (Expr 'Storage)
  (Expr 'Storage)
#storage) Expr 'Storage -> Expr 'Storage
resetStorage
            Optic
  An_AffineTraversal
  '[]
  (VM t s)
  (VM t s)
  (Expr 'Storage)
  (Expr 'Storage)
-> (Expr 'Storage -> Expr 'Storage) -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying (Optic A_Lens '[] (VM t s) (VM t s) Env Env
#env Optic A_Lens '[] (VM t s) (VM t s) Env Env
-> Optic
     A_Lens
     '[]
     Env
     Env
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
-> Optic
     A_Lens
     '[]
     (VM t s)
     (VM t s)
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  Env
  Env
  (Map (Expr 'EAddr) Contract)
  (Map (Expr 'EAddr) Contract)
#contracts Optic
  A_Lens
  '[]
  (VM t s)
  (VM t s)
  (Map (Expr 'EAddr) Contract)
  (Map (Expr 'EAddr) Contract)
-> Optic
     (IxKind (Map (Expr 'EAddr) Contract))
     '[]
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
     (IxValue (Map (Expr 'EAddr) Contract))
     (IxValue (Map (Expr 'EAddr) Contract))
-> Optic
     An_AffineTraversal
     '[]
     (VM t s)
     (VM t s)
     (IxValue (Map (Expr 'EAddr) Contract))
     (IxValue (Map (Expr 'EAddr) Contract))
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Index (Map (Expr 'EAddr) Contract)
-> Optic
     (IxKind (Map (Expr 'EAddr) Contract))
     '[]
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
     (IxValue (Map (Expr 'EAddr) Contract))
     (IxValue (Map (Expr 'EAddr) Contract))
forall m. Ixed m => Index m -> Optic' (IxKind m) '[] m (IxValue m)
ix Index (Map (Expr 'EAddr) Contract)
Expr 'EAddr
newAddr Optic
  An_AffineTraversal
  '[]
  (VM t s)
  (VM t s)
  (IxValue (Map (Expr 'EAddr) Contract))
  (IxValue (Map (Expr 'EAddr) Contract))
-> Optic
     A_Lens
     '[]
     (IxValue (Map (Expr 'EAddr) Contract))
     (IxValue (Map (Expr 'EAddr) Contract))
     (Expr 'Storage)
     (Expr 'Storage)
-> Optic
     An_AffineTraversal
     '[]
     (VM t s)
     (VM t s)
     (Expr 'Storage)
     (Expr 'Storage)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (IxValue (Map (Expr 'EAddr) Contract))
  (IxValue (Map (Expr 'EAddr) Contract))
  (Expr 'Storage)
  (Expr 'Storage)
#origStorage) Expr 'Storage -> Expr 'Storage
resetStorage

            Expr 'EAddr -> Expr 'EAddr -> Expr 'EWord -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EAddr -> Expr 'EAddr -> Expr 'EWord -> EVM t s ()
transfer Expr 'EAddr
self Expr 'EAddr
newAddr Expr 'EWord
xValue

            TraceData -> EVM t s ()
forall (t :: VMType) s. TraceData -> EVM t s ()
pushTrace (FrameContext -> TraceData
FrameTrace FrameContext
newContext)
            EVM t s ()
forall (t :: VMType) s. (?op::Word8) => EVM t s ()
next
            VM t s
vm1 <- StateT (VM t s) (ST s) (VM t s)
forall s (m :: * -> *). MonadState s m => m s
get
            Lens (VM t s) (VM t s) [Frame t s] [Frame t s]
-> Frame t s -> EVM t s ()
forall s (m :: * -> *) a.
MonadState s m =>
Lens s s [a] [a] -> a -> m ()
pushTo Lens (VM t s) (VM t s) [Frame t s] [Frame t s]
#frames (Frame t s -> EVM t s ()) -> Frame t s -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ Frame
              { $sel:context:Frame :: FrameContext
context = FrameContext
newContext
              , $sel:state:Frame :: FrameState t s
state   = VM t s
vm1.state { $sel:stack:FrameState :: [Expr 'EWord]
stack = [Expr 'EWord]
xs }
              }

            FrameState t s
state :: FrameState t s <- ST s (FrameState t s) -> StateT (VM t s) (ST s) (FrameState t s)
forall (m :: * -> *) a. Monad m => m a -> StateT (VM t s) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ST s (FrameState t s)
forall (t :: VMType) s. VMOps t => ST s (FrameState t s)
blankState
            Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> FrameState t s -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state (FrameState t s -> EVM t s ()) -> FrameState t s -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ FrameState t s
state
              { $sel:contract:FrameState :: Expr 'EAddr
contract     = Expr 'EAddr
newAddr
              , $sel:codeContract:FrameState :: Expr 'EAddr
codeContract = Expr 'EAddr
newAddr
              , $sel:code:FrameState :: ContractCode
code         = ContractCode
c
              , $sel:callvalue:FrameState :: Expr 'EWord
callvalue    = Expr 'EWord
xValue
              , $sel:caller:FrameState :: Expr 'EAddr
caller       = Expr 'EAddr
self
              , $sel:gas:FrameState :: Gas t
gas          = Gas t
xGas
              }

-- | Parses a raw Buf into an InitCode
--
-- solidity implements constructor args by appending them to the end of
-- the initcode. we support this internally by treating initCode as a
-- concrete region (initCode) followed by a potentially symbolic region
-- (arguments).
--
-- when constructing a contract that has symbolic constructor args, we
-- need to apply some heuristics to convert the (unstructured) initcode
-- in memory into this structured representation. The (unsound, bad,
-- hacky) way that we do this, is by: looking for the first potentially
-- symbolic byte in the input buffer and then splitting it there into code / data.
parseInitCode :: Expr Buf -> Maybe ContractCode
parseInitCode :: Expr 'Buf -> Maybe ContractCode
parseInitCode (ConcreteBuf ByteString
b) = ContractCode -> Maybe ContractCode
forall a. a -> Maybe a
Just (ByteString -> Expr 'Buf -> ContractCode
InitCode ByteString
b Expr 'Buf
forall a. Monoid a => a
mempty)
parseInitCode Expr 'Buf
buf = if Vector Word8 -> Bool
forall a. Vector a -> Bool
V.null Vector Word8
conc
                    then Maybe ContractCode
forall a. Maybe a
Nothing
                    else ContractCode -> Maybe ContractCode
forall a. a -> Maybe a
Just (ContractCode -> Maybe ContractCode)
-> ContractCode -> Maybe ContractCode
forall a b. (a -> b) -> a -> b
$ ByteString -> Expr 'Buf -> ContractCode
InitCode ([Word8] -> ByteString
BS.pack ([Word8] -> ByteString) -> [Word8] -> ByteString
forall a b. (a -> b) -> a -> b
$ Vector Word8 -> [Word8]
forall a. Vector a -> [a]
V.toList Vector Word8
conc) Expr 'Buf
sym
  where
    conc :: Vector Word8
conc = Expr 'Buf -> Vector Word8
Expr.concretePrefix Expr 'Buf
buf
    -- unsafeInto: findIndex will always be positive
    sym :: Expr 'Buf
sym = W256 -> Expr 'Buf -> Expr 'Buf
Expr.drop (Int -> W256
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto (Vector Word8 -> Int
forall a. Vector a -> Int
V.length Vector Word8
conc)) Expr 'Buf
buf

-- | Replace a contract's code, like when CREATE returns
-- from the constructor code.
replaceCode :: Expr EAddr -> ContractCode -> EVM t s ()
replaceCode :: forall (t :: VMType) s. Expr 'EAddr -> ContractCode -> EVM t s ()
replaceCode Expr 'EAddr
target ContractCode
newCode =
  Optic'
  A_Lens '[] (VM t s) (Maybe (IxValue (Map (Expr 'EAddr) Contract)))
-> StateT (Maybe (IxValue (Map (Expr 'EAddr) Contract))) (ST s) ()
-> StateT (VM t s) (ST s) ()
forall k (is :: IxList) c.
Is k A_Lens =>
Optic' k is (VM t s) (Maybe (IxValue (Map (Expr 'EAddr) Contract)))
-> StateT (Maybe (IxValue (Map (Expr 'EAddr) Contract))) (ST s) c
-> StateT (VM t s) (ST s) c
forall (m :: * -> *) (n :: * -> *) s t k (is :: IxList) c.
(Zoom m n s t, Is k A_Lens) =>
Optic' k is t s -> m c -> n c
zoom (Optic A_Lens '[] (VM t s) (VM t s) Env Env
#env Optic A_Lens '[] (VM t s) (VM t s) Env Env
-> Optic
     A_Lens
     '[]
     Env
     Env
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
-> Optic
     A_Lens
     '[]
     (VM t s)
     (VM t s)
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  Env
  Env
  (Map (Expr 'EAddr) Contract)
  (Map (Expr 'EAddr) Contract)
#contracts Optic
  A_Lens
  '[]
  (VM t s)
  (VM t s)
  (Map (Expr 'EAddr) Contract)
  (Map (Expr 'EAddr) Contract)
-> Lens'
     (Map (Expr 'EAddr) Contract)
     (Maybe (IxValue (Map (Expr 'EAddr) Contract)))
-> Optic'
     A_Lens '[] (VM t s) (Maybe (IxValue (Map (Expr 'EAddr) Contract)))
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Index (Map (Expr 'EAddr) Contract)
-> Lens'
     (Map (Expr 'EAddr) Contract)
     (Maybe (IxValue (Map (Expr 'EAddr) Contract)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map (Expr 'EAddr) Contract)
Expr 'EAddr
target) (StateT (Maybe (IxValue (Map (Expr 'EAddr) Contract))) (ST s) ()
 -> StateT (VM t s) (ST s) ())
-> StateT (Maybe (IxValue (Map (Expr 'EAddr) Contract))) (ST s) ()
-> StateT (VM t s) (ST s) ()
forall a b. (a -> b) -> a -> b
$
    StateT
  (Maybe (IxValue (Map (Expr 'EAddr) Contract)))
  (ST s)
  (Maybe Contract)
forall s (m :: * -> *). MonadState s m => m s
get StateT
  (Maybe (IxValue (Map (Expr 'EAddr) Contract)))
  (ST s)
  (Maybe Contract)
-> (Maybe Contract
    -> StateT (Maybe (IxValue (Map (Expr 'EAddr) Contract))) (ST s) ())
-> StateT (Maybe (IxValue (Map (Expr 'EAddr) Contract))) (ST s) ()
forall a b.
StateT (Maybe (IxValue (Map (Expr 'EAddr) Contract))) (ST s) a
-> (a
    -> StateT (Maybe (IxValue (Map (Expr 'EAddr) Contract))) (ST s) b)
-> StateT (Maybe (IxValue (Map (Expr 'EAddr) Contract))) (ST s) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Just Contract
now -> case Contract
now.code of
        InitCode ByteString
_ Expr 'Buf
_ ->
          Maybe Contract
-> StateT (Maybe (IxValue (Map (Expr 'EAddr) Contract))) (ST s) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Maybe Contract
 -> StateT (Maybe (IxValue (Map (Expr 'EAddr) Contract))) (ST s) ())
-> (Contract -> Maybe Contract)
-> Contract
-> StateT (Maybe (IxValue (Map (Expr 'EAddr) Contract))) (ST s) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Contract -> Maybe Contract
forall a. a -> Maybe a
Just (Contract
 -> StateT (Maybe (IxValue (Map (Expr 'EAddr) Contract))) (ST s) ())
-> Contract
-> StateT (Maybe (IxValue (Map (Expr 'EAddr) Contract))) (ST s) ()
forall a b. (a -> b) -> a -> b
$
            ((ContractCode -> Contract
initialContract ContractCode
newCode) :: Contract)
              { $sel:balance:Contract :: Expr 'EWord
balance = Contract
now.balance
              , $sel:nonce:Contract :: Maybe W64
nonce = Contract
now.nonce
              , $sel:storage:Contract :: Expr 'Storage
storage = Contract
now.storage
              }
        RuntimeCode RuntimeCode
_ ->
          [Char]
-> StateT (Maybe (IxValue (Map (Expr 'EAddr) Contract))) (ST s) ()
forall a. HasCallStack => [Char] -> a
internalError ([Char]
 -> StateT (Maybe (IxValue (Map (Expr 'EAddr) Contract))) (ST s) ())
-> [Char]
-> StateT (Maybe (IxValue (Map (Expr 'EAddr) Contract))) (ST s) ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Can't replace code of deployed contract " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Expr 'EAddr -> [Char]
forall a. Show a => a -> [Char]
show Expr 'EAddr
target
        UnknownCode Expr 'EAddr
_ ->
          [Char]
-> StateT (Maybe (IxValue (Map (Expr 'EAddr) Contract))) (ST s) ()
forall a. HasCallStack => [Char] -> a
internalError [Char]
"Can't replace unknown code"
      Maybe Contract
Nothing ->
        [Char]
-> StateT (Maybe (IxValue (Map (Expr 'EAddr) Contract))) (ST s) ()
forall a. HasCallStack => [Char] -> a
internalError [Char]
"Can't replace code of nonexistent contract"

replaceCodeOfSelf :: ContractCode -> EVM t s ()
replaceCodeOfSelf :: forall (t :: VMType) s. ContractCode -> EVM t s ()
replaceCodeOfSelf ContractCode
newCode = do
  VM t s
vm <- StateT (VM t s) (ST s) (VM t s)
forall s (m :: * -> *). MonadState s m => m s
get
  Expr 'EAddr -> ContractCode -> EVM t s ()
forall (t :: VMType) s. Expr 'EAddr -> ContractCode -> EVM t s ()
replaceCode VM t s
vm.state.contract ContractCode
newCode

resetState :: VMOps t => EVM t s ()
resetState :: forall (t :: VMType) s. VMOps t => EVM t s ()
resetState = do
  FrameState t s
state <- ST s (FrameState t s) -> StateT (VM t s) (ST s) (FrameState t s)
forall (m :: * -> *) a. Monad m => m a -> StateT (VM t s) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ST s (FrameState t s)
forall (t :: VMType) s. VMOps t => ST s (FrameState t s)
blankState
  (VM t s -> VM t s) -> EVM t s ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((VM t s -> VM t s) -> EVM t s ())
-> (VM t s -> VM t s) -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ \VM t s
vm -> VM t s
vm { $sel:result:VM :: Maybe (VMResult t s)
result = Maybe (VMResult t s)
forall a. Maybe a
Nothing, $sel:frames:VM :: [Frame t s]
frames = [], FrameState t s
$sel:state:VM :: FrameState t s
state :: FrameState t s
state }

-- * VM error implementation

vmError :: VMOps t => EvmError -> EVM t s ()
vmError :: forall (t :: VMType) s. VMOps t => EvmError -> EVM t s ()
vmError EvmError
e = FrameResult -> EVM t s ()
forall (t :: VMType) s. VMOps t => FrameResult -> EVM t s ()
finishFrame (EvmError -> FrameResult
FrameErrored EvmError
e)

wrap :: Typeable a => [Expr a] -> [SomeExpr]
wrap :: forall (a :: EType). Typeable a => [Expr a] -> [SomeExpr]
wrap = (Expr a -> SomeExpr) -> [Expr a] -> [SomeExpr]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Expr a -> SomeExpr
forall (a :: EType). Typeable a => Expr a -> SomeExpr
SomeExpr

underrun :: VMOps t => EVM t s ()
underrun :: forall (t :: VMType) s. VMOps t => EVM t s ()
underrun = EvmError -> EVM t s ()
forall (t :: VMType) s. VMOps t => EvmError -> EVM t s ()
vmError EvmError
StackUnderrun

-- | A stack frame can be popped in three ways.
data FrameResult
  = FrameReturned (Expr Buf) -- ^ STOP, RETURN, or no more code
  | FrameReverted (Expr Buf) -- ^ REVERT
  | FrameErrored EvmError -- ^ Any other error
  deriving Int -> FrameResult -> [Char] -> [Char]
[FrameResult] -> [Char] -> [Char]
FrameResult -> [Char]
(Int -> FrameResult -> [Char] -> [Char])
-> (FrameResult -> [Char])
-> ([FrameResult] -> [Char] -> [Char])
-> Show FrameResult
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> FrameResult -> [Char] -> [Char]
showsPrec :: Int -> FrameResult -> [Char] -> [Char]
$cshow :: FrameResult -> [Char]
show :: FrameResult -> [Char]
$cshowList :: [FrameResult] -> [Char] -> [Char]
showList :: [FrameResult] -> [Char] -> [Char]
Show

-- | This function defines how to pop the current stack frame in either of
-- the ways specified by 'FrameResult'.
--
-- It also handles the case when the current stack frame is the only one;
-- in this case, we set the final '_result' of the VM execution.
finishFrame :: VMOps t => FrameResult -> EVM t s ()
finishFrame :: forall (t :: VMType) s. VMOps t => FrameResult -> EVM t s ()
finishFrame FrameResult
how = do
  VM t s
oldVm <- StateT (VM t s) (ST s) (VM t s)
forall s (m :: * -> *). MonadState s m => m s
get

  case VM t s
oldVm.frames of
    -- Is the current frame the only one?
    [] -> do
      case FrameResult
how of
          FrameReturned Expr 'Buf
output -> Optic
  A_Lens
  '[]
  (VM t s)
  (VM t s)
  (Maybe (VMResult t s))
  (Maybe (VMResult t s))
-> Maybe (VMResult t s) -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign Optic
  A_Lens
  '[]
  (VM t s)
  (VM t s)
  (Maybe (VMResult t s))
  (Maybe (VMResult t s))
#result (Maybe (VMResult t s) -> EVM t s ())
-> (VMResult t s -> Maybe (VMResult t s))
-> VMResult t s
-> EVM t s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VMResult t s -> Maybe (VMResult t s)
forall a. a -> Maybe a
Just (VMResult t s -> EVM t s ()) -> VMResult t s -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ Expr 'Buf -> VMResult t s
forall (t :: VMType) s. Expr 'Buf -> VMResult t s
VMSuccess Expr 'Buf
output
          FrameReverted Expr 'Buf
buffer -> Optic
  A_Lens
  '[]
  (VM t s)
  (VM t s)
  (Maybe (VMResult t s))
  (Maybe (VMResult t s))
-> Maybe (VMResult t s) -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign Optic
  A_Lens
  '[]
  (VM t s)
  (VM t s)
  (Maybe (VMResult t s))
  (Maybe (VMResult t s))
#result (Maybe (VMResult t s) -> EVM t s ())
-> (VMResult t s -> Maybe (VMResult t s))
-> VMResult t s
-> EVM t s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VMResult t s -> Maybe (VMResult t s)
forall a. a -> Maybe a
Just (VMResult t s -> EVM t s ()) -> VMResult t s -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ EvmError -> VMResult t s
forall (t :: VMType) s. EvmError -> VMResult t s
VMFailure (Expr 'Buf -> EvmError
Revert Expr 'Buf
buffer)
          FrameErrored EvmError
e       -> Optic
  A_Lens
  '[]
  (VM t s)
  (VM t s)
  (Maybe (VMResult t s))
  (Maybe (VMResult t s))
-> Maybe (VMResult t s) -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign Optic
  A_Lens
  '[]
  (VM t s)
  (VM t s)
  (Maybe (VMResult t s))
  (Maybe (VMResult t s))
#result (Maybe (VMResult t s) -> EVM t s ())
-> (VMResult t s -> Maybe (VMResult t s))
-> VMResult t s
-> EVM t s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VMResult t s -> Maybe (VMResult t s)
forall a. a -> Maybe a
Just (VMResult t s -> EVM t s ()) -> VMResult t s -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ EvmError -> VMResult t s
forall (t :: VMType) s. EvmError -> VMResult t s
VMFailure EvmError
e
      EVM t s ()
forall (t :: VMType) s. VMOps t => EVM t s ()
finalize

    -- Are there some remaining frames?
    Frame t s
nextFrame : [Frame t s]
remainingFrames -> do

      -- Insert a debug trace.
      TraceData -> EVM t s ()
forall (t :: VMType) s. TraceData -> EVM t s ()
insertTrace (TraceData -> EVM t s ()) -> TraceData -> EVM t s ()
forall a b. (a -> b) -> a -> b
$
        case FrameResult
how of
          FrameErrored EvmError
e ->
            EvmError -> TraceData
ErrorTrace EvmError
e
          FrameReverted Expr 'Buf
e ->
            EvmError -> TraceData
ErrorTrace (Expr 'Buf -> EvmError
Revert Expr 'Buf
e)
          FrameReturned Expr 'Buf
output ->
            Expr 'Buf -> FrameContext -> TraceData
ReturnTrace Expr 'Buf
output Frame t s
nextFrame.context
      -- Pop to the previous level of the debug trace stack.
      EVM t s ()
forall (t :: VMType) s. EVM t s ()
popTrace

      -- Pop the top frame.
      Optic A_Lens '[] (VM t s) (VM t s) [Frame t s] [Frame t s]
-> [Frame t s] -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign Optic A_Lens '[] (VM t s) (VM t s) [Frame t s] [Frame t s]
#frames [Frame t s]
remainingFrames
      -- Install the state of the frame to which we shall return.
      Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> FrameState t s -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Frame t s
nextFrame.state

      -- Now dispatch on whether we were creating or calling,
      -- and whether we shall return, revert, or internalError(six cases).
      case Frame t s
nextFrame.context of

        -- Were we calling?
        CallContext Expr 'EAddr
_ Expr 'EAddr
_ Expr 'EWord
outOffset Expr 'EWord
outSize Expr 'EWord
_ Maybe W256
_ Expr 'Buf
_ Map (Expr 'EAddr) Contract
reversion SubState
substate' -> do

          -- Excerpt K.1. from the yellow paper:
          -- K.1. Deletion of an Account Despite Out-of-gas.
          -- At block 2675119, in the transaction 0xcf416c536ec1a19ed1fb89e4ec7ffb3cf73aa413b3aa9b77d60e4fd81a4296ba,
          -- an account at address 0x03 was called and an out-of-gas occurred during the call.
          -- Against the equation (197), this added 0x03 in the set of touched addresses, and this transaction turned σ[0x03] into ∅.

          -- In other words, we special case address 0x03 and keep it in the set of touched accounts during revert
          [Expr 'EAddr]
touched <- Optic' A_Lens '[] (VM t s) [Expr 'EAddr]
-> StateT (VM t s) (ST s) [Expr 'EAddr]
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic A_Lens '[] (VM t s) (VM t s) TxState TxState
#tx Optic A_Lens '[] (VM t s) (VM t s) TxState TxState
-> Optic A_Lens '[] TxState TxState SubState SubState
-> Optic A_Lens '[] (VM t s) (VM t s) SubState SubState
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens '[] TxState TxState SubState SubState
#substate Optic A_Lens '[] (VM t s) (VM t s) SubState SubState
-> Optic A_Lens '[] SubState SubState [Expr 'EAddr] [Expr 'EAddr]
-> Optic' A_Lens '[] (VM t s) [Expr 'EAddr]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens '[] SubState SubState [Expr 'EAddr] [Expr 'EAddr]
#touchedAccounts)

          let
            substate'' :: SubState
substate'' = Optic A_Lens '[] SubState SubState [Expr 'EAddr] [Expr 'EAddr]
-> ([Expr 'EAddr] -> [Expr 'EAddr]) -> SubState -> SubState
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic A_Lens '[] SubState SubState [Expr 'EAddr] [Expr 'EAddr]
#touchedAccounts (([Expr 'EAddr] -> [Expr 'EAddr])
-> (Expr 'EAddr -> [Expr 'EAddr] -> [Expr 'EAddr])
-> Maybe (Expr 'EAddr)
-> [Expr 'EAddr]
-> [Expr 'EAddr]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Expr 'EAddr] -> [Expr 'EAddr]
forall a. a -> a
id Expr 'EAddr -> [Expr 'EAddr] -> [Expr 'EAddr]
forall s a. Cons s s a a => a -> s -> s
cons ((Expr 'EAddr -> Bool) -> [Expr 'EAddr] -> Maybe (Expr 'EAddr)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Addr -> Expr 'EAddr
LitAddr Addr
3 ==) [Expr 'EAddr]
touched)) SubState
substate'
            revertContracts :: EVM t s ()
revertContracts = Optic
  A_Lens
  '[]
  (VM t s)
  (VM t s)
  (Map (Expr 'EAddr) Contract)
  (Map (Expr 'EAddr) Contract)
-> Map (Expr 'EAddr) Contract -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens '[] (VM t s) (VM t s) Env Env
#env Optic A_Lens '[] (VM t s) (VM t s) Env Env
-> Optic
     A_Lens
     '[]
     Env
     Env
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
-> Optic
     A_Lens
     '[]
     (VM t s)
     (VM t s)
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  Env
  Env
  (Map (Expr 'EAddr) Contract)
  (Map (Expr 'EAddr) Contract)
#contracts) Map (Expr 'EAddr) Contract
reversion
            revertSubstate :: EVM t s ()
revertSubstate  = Optic A_Lens '[] (VM t s) (VM t s) SubState SubState
-> SubState -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens '[] (VM t s) (VM t s) TxState TxState
#tx Optic A_Lens '[] (VM t s) (VM t s) TxState TxState
-> Optic A_Lens '[] TxState TxState SubState SubState
-> Optic A_Lens '[] (VM t s) (VM t s) SubState SubState
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens '[] TxState TxState SubState SubState
#substate) SubState
substate''

          case FrameResult
how of
            -- Case 1: Returning from a call?
            FrameReturned Expr 'Buf
output -> do
              Optic A_Lens '[] (VM t s) (VM t s) (Expr 'Buf) (Expr 'Buf)
-> Expr 'Buf -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     (Expr 'Buf)
     (Expr 'Buf)
-> Optic A_Lens '[] (VM t s) (VM t s) (Expr 'Buf) (Expr 'Buf)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  (Expr 'Buf)
  (Expr 'Buf)
#returndata) Expr 'Buf
output
              Expr 'Buf -> Expr 'EWord -> Expr 'EWord -> EVM t s ()
forall (t :: VMType) s.
Expr 'Buf -> Expr 'EWord -> Expr 'EWord -> EVM t s ()
copyCallBytesToMemory Expr 'Buf
output Expr 'EWord
outSize Expr 'EWord
outOffset
              VM t s -> EVM t s ()
forall s. VM t s -> EVM t s ()
forall (t :: VMType) s. VMOps t => VM t s -> EVM t s ()
reclaimRemainingGasAllowance VM t s
oldVm
              W256 -> EVM t s ()
forall (t :: VMType) s. W256 -> EVM t s ()
push W256
1

            -- Case 2: Reverting during a call?
            FrameReverted Expr 'Buf
output -> do
              EVM t s ()
revertContracts
              EVM t s ()
revertSubstate
              Optic A_Lens '[] (VM t s) (VM t s) (Expr 'Buf) (Expr 'Buf)
-> Expr 'Buf -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     (Expr 'Buf)
     (Expr 'Buf)
-> Optic A_Lens '[] (VM t s) (VM t s) (Expr 'Buf) (Expr 'Buf)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  (Expr 'Buf)
  (Expr 'Buf)
#returndata) Expr 'Buf
output
              Expr 'Buf -> Expr 'EWord -> Expr 'EWord -> EVM t s ()
forall (t :: VMType) s.
Expr 'Buf -> Expr 'EWord -> Expr 'EWord -> EVM t s ()
copyCallBytesToMemory Expr 'Buf
output Expr 'EWord
outSize Expr 'EWord
outOffset
              VM t s -> EVM t s ()
forall s. VM t s -> EVM t s ()
forall (t :: VMType) s. VMOps t => VM t s -> EVM t s ()
reclaimRemainingGasAllowance VM t s
oldVm
              W256 -> EVM t s ()
forall (t :: VMType) s. W256 -> EVM t s ()
push W256
0

            -- Case 3: Error during a call?
            FrameErrored EvmError
_ -> do
              EVM t s ()
revertContracts
              EVM t s ()
revertSubstate
              Optic A_Lens '[] (VM t s) (VM t s) (Expr 'Buf) (Expr 'Buf)
-> Expr 'Buf -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     (Expr 'Buf)
     (Expr 'Buf)
-> Optic A_Lens '[] (VM t s) (VM t s) (Expr 'Buf) (Expr 'Buf)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  (Expr 'Buf)
  (Expr 'Buf)
#returndata) Expr 'Buf
forall a. Monoid a => a
mempty
              W256 -> EVM t s ()
forall (t :: VMType) s. W256 -> EVM t s ()
push W256
0
        -- Or were we creating?
        CreationContext Expr 'EAddr
_ Expr 'EWord
_ Map (Expr 'EAddr) Contract
reversion SubState
substate' -> do
          Expr 'EAddr
creator <- Optic' A_Lens '[] (VM t s) (Expr 'EAddr)
-> StateT (VM t s) (ST s) (Expr 'EAddr)
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     (Expr 'EAddr)
     (Expr 'EAddr)
-> Optic' A_Lens '[] (VM t s) (Expr 'EAddr)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  (Expr 'EAddr)
  (Expr 'EAddr)
#contract)
          let
            createe :: Expr 'EAddr
createe = VM t s
oldVm.state.contract
            revertContracts :: EVM t s ()
revertContracts = Optic
  A_Lens
  '[]
  (VM t s)
  (VM t s)
  (Map (Expr 'EAddr) Contract)
  (Map (Expr 'EAddr) Contract)
-> Map (Expr 'EAddr) Contract -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens '[] (VM t s) (VM t s) Env Env
#env Optic A_Lens '[] (VM t s) (VM t s) Env Env
-> Optic
     A_Lens
     '[]
     Env
     Env
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
-> Optic
     A_Lens
     '[]
     (VM t s)
     (VM t s)
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  Env
  Env
  (Map (Expr 'EAddr) Contract)
  (Map (Expr 'EAddr) Contract)
#contracts) Map (Expr 'EAddr) Contract
reversion'
            revertSubstate :: EVM t s ()
revertSubstate  = Optic A_Lens '[] (VM t s) (VM t s) SubState SubState
-> SubState -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens '[] (VM t s) (VM t s) TxState TxState
#tx Optic A_Lens '[] (VM t s) (VM t s) TxState TxState
-> Optic A_Lens '[] TxState TxState SubState SubState
-> Optic A_Lens '[] (VM t s) (VM t s) SubState SubState
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens '[] TxState TxState SubState SubState
#substate) SubState
substate'

            -- persist the nonce through the reversion
            reversion' :: Map (Expr 'EAddr) Contract
reversion' = ((Contract -> Contract)
-> Expr 'EAddr
-> Map (Expr 'EAddr) Contract
-> Map (Expr 'EAddr) Contract
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (Optic A_Lens '[] Contract Contract (Maybe W64) (Maybe W64)
-> (Maybe W64 -> Maybe W64) -> Contract -> Contract
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic A_Lens '[] Contract Contract (Maybe W64) (Maybe W64)
#nonce ((W64 -> W64) -> Maybe W64 -> Maybe W64
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (W64 -> W64 -> W64
forall a. Num a => a -> a -> a
(+) W64
1))) Expr 'EAddr
creator) Map (Expr 'EAddr) Contract
reversion

          case FrameResult
how of
            -- Case 4: Returning during a creation?
            FrameReturned Expr 'Buf
output -> do
              let onContractCode :: ContractCode -> EVM t s ()
onContractCode ContractCode
contractCode = do
                    Expr 'EAddr -> ContractCode -> EVM t s ()
forall (t :: VMType) s. Expr 'EAddr -> ContractCode -> EVM t s ()
replaceCode Expr 'EAddr
createe ContractCode
contractCode
                    Optic A_Lens '[] (VM t s) (VM t s) (Expr 'Buf) (Expr 'Buf)
-> Expr 'Buf -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     (Expr 'Buf)
     (Expr 'Buf)
-> Optic A_Lens '[] (VM t s) (VM t s) (Expr 'Buf) (Expr 'Buf)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  (Expr 'Buf)
  (Expr 'Buf)
#returndata) Expr 'Buf
forall a. Monoid a => a
mempty
                    VM t s -> EVM t s ()
forall s. VM t s -> EVM t s ()
forall (t :: VMType) s. VMOps t => VM t s -> EVM t s ()
reclaimRemainingGasAllowance VM t s
oldVm
                    Expr 'EAddr -> EVM t s ()
forall (t :: VMType) s. Expr 'EAddr -> EVM t s ()
pushAddr Expr 'EAddr
createe
              case Expr 'Buf
output of
                ConcreteBuf ByteString
bs ->
                  ContractCode -> EVM t s ()
onContractCode (ContractCode -> EVM t s ()) -> ContractCode -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ RuntimeCode -> ContractCode
RuntimeCode (ByteString -> RuntimeCode
ConcreteRuntimeCode ByteString
bs)
                Expr 'Buf
_ ->
                  case Expr 'Buf -> Maybe (Vector (Expr 'Byte))
Expr.toList Expr 'Buf
output of
                    Maybe (Vector (Expr 'Byte))
Nothing -> PartialExec -> EVM t s ()
forall s. PartialExec -> EVM t s ()
forall (t :: VMType) s. VMOps t => PartialExec -> EVM t s ()
partial (PartialExec -> EVM t s ()) -> PartialExec -> EVM t s ()
forall a b. (a -> b) -> a -> b
$
                      Int -> [Char] -> [SomeExpr] -> PartialExec
UnexpectedSymbolicArg
                        VM t s
oldVm.state.pc
                        [Char]
"runtime code cannot have an abstract length"
                        ([Expr 'Buf] -> [SomeExpr]
forall (a :: EType). Typeable a => [Expr a] -> [SomeExpr]
wrap [Expr 'Buf
output])
                    Just Vector (Expr 'Byte)
newCode -> do
                      ContractCode -> EVM t s ()
onContractCode (ContractCode -> EVM t s ()) -> ContractCode -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ RuntimeCode -> ContractCode
RuntimeCode (Vector (Expr 'Byte) -> RuntimeCode
SymbolicRuntimeCode Vector (Expr 'Byte)
newCode)

            -- Case 5: Reverting during a creation?
            FrameReverted Expr 'Buf
output -> do
              EVM t s ()
revertContracts
              EVM t s ()
revertSubstate
              Optic A_Lens '[] (VM t s) (VM t s) (Expr 'Buf) (Expr 'Buf)
-> Expr 'Buf -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     (Expr 'Buf)
     (Expr 'Buf)
-> Optic A_Lens '[] (VM t s) (VM t s) (Expr 'Buf) (Expr 'Buf)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  (Expr 'Buf)
  (Expr 'Buf)
#returndata) Expr 'Buf
output
              VM t s -> EVM t s ()
forall s. VM t s -> EVM t s ()
forall (t :: VMType) s. VMOps t => VM t s -> EVM t s ()
reclaimRemainingGasAllowance VM t s
oldVm
              W256 -> EVM t s ()
forall (t :: VMType) s. W256 -> EVM t s ()
push W256
0

            -- Case 6: Error during a creation?
            FrameErrored EvmError
_ -> do
              EVM t s ()
revertContracts
              EVM t s ()
revertSubstate
              Optic A_Lens '[] (VM t s) (VM t s) (Expr 'Buf) (Expr 'Buf)
-> Expr 'Buf -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     (Expr 'Buf)
     (Expr 'Buf)
-> Optic A_Lens '[] (VM t s) (VM t s) (Expr 'Buf) (Expr 'Buf)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  (Expr 'Buf)
  (Expr 'Buf)
#returndata) Expr 'Buf
forall a. Monoid a => a
mempty
              W256 -> EVM t s ()
forall (t :: VMType) s. W256 -> EVM t s ()
push W256
0


-- * Memory helpers

accessUnboundedMemoryRange
  :: VMOps t => Word64
  -> Word64
  -> EVM t s ()
  -> EVM t s ()
accessUnboundedMemoryRange :: forall (t :: VMType) s.
VMOps t =>
Word64 -> Word64 -> EVM t s () -> EVM t s ()
accessUnboundedMemoryRange Word64
_ Word64
0 EVM t s ()
continue = EVM t s ()
continue
accessUnboundedMemoryRange Word64
f Word64
l EVM t s ()
continue = do
  Word64
m0 <- Optic' A_Lens '[] (VM t s) Word64 -> StateT (VM t s) (ST s) Word64
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic A_Lens '[] (FrameState t s) (FrameState t s) Word64 Word64
-> Optic' A_Lens '[] (VM t s) Word64
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens '[] (FrameState t s) (FrameState t s) Word64 Word64
#memorySize)
  FeeSchedule Word64
fees <- (VM t s -> FeeSchedule Word64)
-> StateT (VM t s) (ST s) (FeeSchedule Word64)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (.block.schedule)
  let m1 :: Word64
m1 = Word64
32 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64 -> Word64 -> Word64
forall a. (Num a, Integral a) => a -> a -> a
ceilDiv (Word64 -> Word64 -> Word64
forall a. Ord a => a -> a -> a
max Word64
m0 (Word64
f Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
l)) Word64
32
  Word64 -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Word64 -> EVM t s () -> EVM t s ()
burn (FeeSchedule Word64 -> Word64 -> Word64
memoryCost FeeSchedule Word64
fees Word64
m1 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- FeeSchedule Word64 -> Word64 -> Word64
memoryCost FeeSchedule Word64
fees Word64
m0) (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ do
    Optic' A_Lens '[] (VM t s) Word64 -> Word64 -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic A_Lens '[] (FrameState t s) (FrameState t s) Word64 Word64
-> Optic' A_Lens '[] (VM t s) Word64
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens '[] (FrameState t s) (FrameState t s) Word64 Word64
#memorySize) Word64
m1
    EVM t s ()
continue

accessMemoryRange
  :: VMOps t
  => Expr EWord
  -> Expr EWord
  -> EVM t s ()
  -> EVM t s ()
accessMemoryRange :: forall (t :: VMType) s.
VMOps t =>
Expr 'EWord -> Expr 'EWord -> EVM t s () -> EVM t s ()
accessMemoryRange Expr 'EWord
_ (Lit W256
0) EVM t s ()
continue = EVM t s ()
continue
accessMemoryRange (Lit W256
offs) (Lit W256
sz) EVM t s ()
continue =
  case (,) (Word64 -> Word64 -> (Word64, Word64))
-> Maybe Word64 -> Maybe (Word64 -> (Word64, Word64))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> W256 -> Maybe Word64
toWord64 W256
offs Maybe (Word64 -> (Word64, Word64))
-> Maybe Word64 -> Maybe (Word64, Word64)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> W256 -> Maybe Word64
toWord64 W256
sz of
    Maybe (Word64, Word64)
Nothing -> EvmError -> EVM t s ()
forall (t :: VMType) s. VMOps t => EvmError -> EVM t s ()
vmError EvmError
IllegalOverflow
    Just (Word64
offs64, Word64
sz64) ->
      if Word64
offs64 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
sz64 Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< Word64
sz64
        then EvmError -> EVM t s ()
forall (t :: VMType) s. VMOps t => EvmError -> EVM t s ()
vmError EvmError
IllegalOverflow
        -- we need to limit these to <256MB because otherwise we could run out of memory
        -- in e.g. OpCalldatacopy and subsequent memory allocation when running with abstract gas.
        -- In these cases, the system would try to allocate a large (but <2**64 bytes) memory
        -- that leads to out-of-heap. Real-world scenarios cannot allocate 256MB of memory due to gas
        else if Word64
offs64 Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word64
0x0fffffff Bool -> Bool -> Bool
|| Word64
sz64 Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word64
0x0fffffff
             then EvmError -> EVM t s ()
forall (t :: VMType) s. VMOps t => EvmError -> EVM t s ()
vmError EvmError
IllegalOverflow
             else Word64 -> Word64 -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Word64 -> Word64 -> EVM t s () -> EVM t s ()
accessUnboundedMemoryRange Word64
offs64 Word64
sz64 EVM t s ()
continue
-- we just ignore gas if we get symbolic inputs
accessMemoryRange Expr 'EWord
_ Expr 'EWord
_ EVM t s ()
continue = EVM t s ()
continue

accessMemoryWord
  :: VMOps t => Expr EWord -> EVM t s () -> EVM t s ()
accessMemoryWord :: forall (t :: VMType) s.
VMOps t =>
Expr 'EWord -> EVM t s () -> EVM t s ()
accessMemoryWord Expr 'EWord
x = Expr 'EWord -> Expr 'EWord -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Expr 'EWord -> Expr 'EWord -> EVM t s () -> EVM t s ()
accessMemoryRange Expr 'EWord
x (W256 -> Expr 'EWord
Lit W256
32)

copyBytesToMemory
  :: Expr Buf -> Expr EWord -> Expr EWord -> Expr EWord -> EVM t s ()
copyBytesToMemory :: forall (t :: VMType) s.
Expr 'Buf
-> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM t s ()
copyBytesToMemory Expr 'Buf
bs Expr 'EWord
size Expr 'EWord
srcOffset Expr 'EWord
memOffset =
  if Expr 'EWord
size Expr 'EWord -> Expr 'EWord -> Bool
forall a. Eq a => a -> a -> Bool
== W256 -> Expr 'EWord
Lit W256
0 then StateT (VM t s) (ST s) ()
forall (m :: * -> *). Monad m => m ()
noop
  else do
    (VM t s -> Memory s) -> StateT (VM t s) (ST s) (Memory s)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (.state.memory) StateT (VM t s) (ST s) (Memory s)
-> (Memory s -> StateT (VM t s) (ST s) ())
-> StateT (VM t s) (ST s) ()
forall a b.
StateT (VM t s) (ST s) a
-> (a -> StateT (VM t s) (ST s) b) -> StateT (VM t s) (ST s) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      ConcreteMemory MutableMemory s
mem ->
        case (Expr 'Buf
bs, Expr 'EWord
size, Expr 'EWord
srcOffset, Expr 'EWord
memOffset) of
          (ConcreteBuf ByteString
b, Lit W256
size', Lit W256
srcOffset', Lit W256
memOffset') -> do
            let src :: ByteString
src =
                  if W256
srcOffset' W256 -> W256 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int -> W256
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto (ByteString -> Int
BS.length ByteString
b) then
                    Int -> Word8 -> ByteString
BS.replicate (W256 -> Int
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto W256
size') Word8
0
                  else
                    Int -> ByteString -> ByteString
BS.take (W256 -> Int
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto W256
size') (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$
                    Int -> ByteString -> ByteString
padRight (W256 -> Int
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto W256
size') (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$
                    Int -> ByteString -> ByteString
BS.drop (W256 -> Int
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto W256
srcOffset') ByteString
b

            MutableMemory s -> Int -> ByteString -> StateT (VM t s) (ST s) ()
forall s (t :: VMType).
MutableMemory s -> Int -> ByteString -> EVM t s ()
writeMemory MutableMemory s
mem (W256 -> Int
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto W256
memOffset') ByteString
src
          (Expr 'Buf, Expr 'EWord, Expr 'EWord, Expr 'EWord)
_ -> do
            -- copy out and move to symbolic memory
            Expr 'Buf
buf <- MutableMemory s -> EVM t s (Expr 'Buf)
forall s (t :: VMType). MutableMemory s -> EVM t s (Expr 'Buf)
freezeMemory MutableMemory s
mem
            Optic A_Lens '[] (VM t s) (VM t s) (Memory s) (Memory s)
-> Memory s -> StateT (VM t s) (ST s) ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens '[] (FrameState t s) (FrameState t s) (Memory s) (Memory s)
-> Optic A_Lens '[] (VM t s) (VM t s) (Memory s) (Memory s)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens '[] (FrameState t s) (FrameState t s) (Memory s) (Memory s)
#memory) (Memory s -> StateT (VM t s) (ST s) ())
-> Memory s -> StateT (VM t s) (ST s) ()
forall a b. (a -> b) -> a -> b
$
              Expr 'Buf -> Memory s
forall s. Expr 'Buf -> Memory s
SymbolicMemory (Expr 'Buf -> Memory s) -> Expr 'Buf -> Memory s
forall a b. (a -> b) -> a -> b
$ Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'Buf
-> Expr 'Buf
-> Expr 'Buf
copySlice Expr 'EWord
srcOffset Expr 'EWord
memOffset Expr 'EWord
size Expr 'Buf
bs Expr 'Buf
buf
      SymbolicMemory Expr 'Buf
mem ->
        Optic A_Lens '[] (VM t s) (VM t s) (Memory s) (Memory s)
-> Memory s -> StateT (VM t s) (ST s) ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens '[] (FrameState t s) (FrameState t s) (Memory s) (Memory s)
-> Optic A_Lens '[] (VM t s) (VM t s) (Memory s) (Memory s)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens '[] (FrameState t s) (FrameState t s) (Memory s) (Memory s)
#memory) (Memory s -> StateT (VM t s) (ST s) ())
-> Memory s -> StateT (VM t s) (ST s) ()
forall a b. (a -> b) -> a -> b
$
          Expr 'Buf -> Memory s
forall s. Expr 'Buf -> Memory s
SymbolicMemory (Expr 'Buf -> Memory s) -> Expr 'Buf -> Memory s
forall a b. (a -> b) -> a -> b
$ Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'Buf
-> Expr 'Buf
-> Expr 'Buf
copySlice Expr 'EWord
srcOffset Expr 'EWord
memOffset Expr 'EWord
size Expr 'Buf
bs Expr 'Buf
mem

copyCallBytesToMemory
  :: Expr Buf -> Expr EWord -> Expr EWord -> EVM t s ()
copyCallBytesToMemory :: forall (t :: VMType) s.
Expr 'Buf -> Expr 'EWord -> Expr 'EWord -> EVM t s ()
copyCallBytesToMemory Expr 'Buf
bs Expr 'EWord
size Expr 'EWord
yOffset =
  Expr 'Buf
-> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM t s ()
forall (t :: VMType) s.
Expr 'Buf
-> Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> EVM t s ()
copyBytesToMemory Expr 'Buf
bs (Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.min Expr 'EWord
size (Expr 'Buf -> Expr 'EWord
bufLength Expr 'Buf
bs)) (W256 -> Expr 'EWord
Lit W256
0) Expr 'EWord
yOffset

readMemory :: Expr EWord -> Expr EWord -> EVM t s (Expr Buf)
readMemory :: forall (t :: VMType) s.
Expr 'EWord -> Expr 'EWord -> EVM t s (Expr 'Buf)
readMemory Expr 'EWord
offset' Expr 'EWord
size' = do
  VM t s
vm <- StateT (VM t s) (ST s) (VM t s)
forall s (m :: * -> *). MonadState s m => m s
get
  case VM t s
vm.state.memory of
    ConcreteMemory MutableMemory s
mem -> do
      case (Expr 'EWord
offset', Expr 'EWord
size') of
        (Lit W256
offset, Lit W256
size) -> do
          let Word64
memSize :: Word64 = Int -> Word64
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto (MutableMemory s -> Int
forall a s. Unbox a => MVector s a -> Int
VUnboxed.Mutable.length MutableMemory s
mem)
          if W256
size W256 -> W256 -> Bool
forall a. Ord a => a -> a -> Bool
> W256
Expr.maxBytes Bool -> Bool -> Bool
||
             W256
offset W256 -> W256 -> W256
forall a. Num a => a -> a -> a
+ W256
size W256 -> W256 -> Bool
forall a. Ord a => a -> a -> Bool
> W256
Expr.maxBytes Bool -> Bool -> Bool
||
             W256
offset W256 -> W256 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word64 -> W256
forall target source. From source target => source -> target
into Word64
memSize then
            -- reads past memory are all zeros
            Expr 'Buf -> EVM t s (Expr 'Buf)
forall a. a -> StateT (VM t s) (ST s) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expr 'Buf -> EVM t s (Expr 'Buf))
-> Expr 'Buf -> EVM t s (Expr 'Buf)
forall a b. (a -> b) -> a -> b
$ ByteString -> Expr 'Buf
ConcreteBuf (ByteString -> Expr 'Buf) -> ByteString -> Expr 'Buf
forall a b. (a -> b) -> a -> b
$ Int -> Word8 -> ByteString
BS.replicate (W256 -> Int
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto W256
size) Word8
0
          else do
            let pastEnd :: Int
pastEnd = (W256 -> Int
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto W256
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ W256 -> Int
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto W256
size) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Word64 -> Int
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto Word64
memSize
            let fromMemSize :: Int
fromMemSize = if Int
pastEnd Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then W256 -> Int
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto W256
size Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
pastEnd else W256 -> Int
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto W256
size

            Vector Word8
buf <- MVector (PrimState (StateT (VM t s) (ST s))) Word8
-> StateT (VM t s) (ST s) (Vector Word8)
forall a (m :: * -> *).
(Unbox a, PrimMonad m) =>
MVector (PrimState m) a -> m (Vector a)
VUnboxed.freeze (MVector (PrimState (StateT (VM t s) (ST s))) Word8
 -> StateT (VM t s) (ST s) (Vector Word8))
-> MVector (PrimState (StateT (VM t s) (ST s))) Word8
-> StateT (VM t s) (ST s) (Vector Word8)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> MutableMemory s -> MutableMemory s
forall a s. Unbox a => Int -> Int -> MVector s a -> MVector s a
VUnboxed.Mutable.slice (W256 -> Int
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto W256
offset) Int
fromMemSize MutableMemory s
mem
            let dataFromMem :: ByteString
dataFromMem = [Word8] -> ByteString
BS.pack ([Word8] -> ByteString) -> [Word8] -> ByteString
forall a b. (a -> b) -> a -> b
$ Vector Word8 -> [Word8]
forall a. Unbox a => Vector a -> [a]
VUnboxed.toList Vector Word8
buf
            Expr 'Buf -> EVM t s (Expr 'Buf)
forall a. a -> StateT (VM t s) (ST s) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expr 'Buf -> EVM t s (Expr 'Buf))
-> Expr 'Buf -> EVM t s (Expr 'Buf)
forall a b. (a -> b) -> a -> b
$ ByteString -> Expr 'Buf
ConcreteBuf (ByteString -> Expr 'Buf) -> ByteString -> Expr 'Buf
forall a b. (a -> b) -> a -> b
$ ByteString
dataFromMem ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Int -> Word8 -> ByteString
BS.replicate Int
pastEnd Word8
0
        (Expr 'EWord, Expr 'EWord)
_ -> do
          Expr 'Buf
buf <- MutableMemory s -> EVM t s (Expr 'Buf)
forall s (t :: VMType). MutableMemory s -> EVM t s (Expr 'Buf)
freezeMemory MutableMemory s
mem
          Expr 'Buf -> EVM t s (Expr 'Buf)
forall a. a -> StateT (VM t s) (ST s) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expr 'Buf -> EVM t s (Expr 'Buf))
-> Expr 'Buf -> EVM t s (Expr 'Buf)
forall a b. (a -> b) -> a -> b
$ Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'Buf
-> Expr 'Buf
-> Expr 'Buf
copySlice Expr 'EWord
offset' (W256 -> Expr 'EWord
Lit W256
0) Expr 'EWord
size' Expr 'Buf
buf Expr 'Buf
forall a. Monoid a => a
mempty
    SymbolicMemory Expr 'Buf
mem ->
      Expr 'Buf -> EVM t s (Expr 'Buf)
forall a. a -> StateT (VM t s) (ST s) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expr 'Buf -> EVM t s (Expr 'Buf))
-> Expr 'Buf -> EVM t s (Expr 'Buf)
forall a b. (a -> b) -> a -> b
$ Expr 'EWord
-> Expr 'EWord
-> Expr 'EWord
-> Expr 'Buf
-> Expr 'Buf
-> Expr 'Buf
copySlice Expr 'EWord
offset' (W256 -> Expr 'EWord
Lit W256
0) Expr 'EWord
size' Expr 'Buf
mem Expr 'Buf
forall a. Monoid a => a
mempty

-- * Tracing

withTraceLocation :: TraceData -> EVM t s Trace
withTraceLocation :: forall (t :: VMType) s. TraceData -> EVM t s Trace
withTraceLocation TraceData
x = do
  VM t s
vm <- StateT (VM t s) (ST s) (VM t s)
forall s (m :: * -> *). MonadState s m => m s
get
  let this :: Contract
this = Maybe Contract -> Contract
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Contract -> Contract) -> Maybe Contract -> Contract
forall a b. (a -> b) -> a -> b
$ VM t s -> Maybe Contract
forall (t :: VMType) s. VM t s -> Maybe Contract
currentContract VM t s
vm
  Trace -> EVM t s Trace
forall a. a -> StateT (VM t s) (ST s) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Trace
    { $sel:tracedata:Trace :: TraceData
tracedata = TraceData
x
    , $sel:contract:Trace :: Contract
contract = Contract
this
    , $sel:opIx:Trace :: Int
opIx = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ Contract
this.opIxMap Vector Int -> Int -> Maybe Int
forall a. Storable a => Vector a -> Int -> Maybe a
SV.!? VM t s
vm.state.pc
    }

pushTrace :: TraceData -> EVM t s ()
pushTrace :: forall (t :: VMType) s. TraceData -> EVM t s ()
pushTrace TraceData
x = do
  Trace
trace <- TraceData -> EVM t s Trace
forall (t :: VMType) s. TraceData -> EVM t s Trace
withTraceLocation TraceData
x
  Optic
  A_Lens
  '[]
  (VM t s)
  (VM t s)
  (TreePos Empty Trace)
  (TreePos Empty Trace)
-> (TreePos Empty Trace -> TreePos Empty Trace) -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying Optic
  A_Lens
  '[]
  (VM t s)
  (VM t s)
  (TreePos Empty Trace)
  (TreePos Empty Trace)
#traces ((TreePos Empty Trace -> TreePos Empty Trace) -> EVM t s ())
-> (TreePos Empty Trace -> TreePos Empty Trace) -> EVM t s ()
forall a b. (a -> b) -> a -> b
$
    \TreePos Empty Trace
t -> TreePos Full Trace -> TreePos Empty Trace
forall a. TreePos Full a -> TreePos Empty a
Zipper.children (TreePos Full Trace -> TreePos Empty Trace)
-> TreePos Full Trace -> TreePos Empty Trace
forall a b. (a -> b) -> a -> b
$ Tree Trace -> TreePos Empty Trace -> TreePos Full Trace
forall a. Tree a -> TreePos Empty a -> TreePos Full a
Zipper.insert (Trace -> Forest Trace -> Tree Trace
forall a. a -> [Tree a] -> Tree a
Node Trace
trace []) TreePos Empty Trace
t

insertTrace :: TraceData -> EVM t s ()
insertTrace :: forall (t :: VMType) s. TraceData -> EVM t s ()
insertTrace TraceData
x = do
  Trace
trace <- TraceData -> EVM t s Trace
forall (t :: VMType) s. TraceData -> EVM t s Trace
withTraceLocation TraceData
x
  Optic
  A_Lens
  '[]
  (VM t s)
  (VM t s)
  (TreePos Empty Trace)
  (TreePos Empty Trace)
-> (TreePos Empty Trace -> TreePos Empty Trace) -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying Optic
  A_Lens
  '[]
  (VM t s)
  (VM t s)
  (TreePos Empty Trace)
  (TreePos Empty Trace)
#traces ((TreePos Empty Trace -> TreePos Empty Trace) -> EVM t s ())
-> (TreePos Empty Trace -> TreePos Empty Trace) -> EVM t s ()
forall a b. (a -> b) -> a -> b
$
    \TreePos Empty Trace
t -> TreePos Full Trace -> TreePos Empty Trace
forall a. TreePos Full a -> TreePos Empty a
Zipper.nextSpace (TreePos Full Trace -> TreePos Empty Trace)
-> TreePos Full Trace -> TreePos Empty Trace
forall a b. (a -> b) -> a -> b
$ Tree Trace -> TreePos Empty Trace -> TreePos Full Trace
forall a. Tree a -> TreePos Empty a -> TreePos Full a
Zipper.insert (Trace -> Forest Trace -> Tree Trace
forall a. a -> [Tree a] -> Tree a
Node Trace
trace []) TreePos Empty Trace
t

popTrace :: EVM t s ()
popTrace :: forall (t :: VMType) s. EVM t s ()
popTrace =
  Optic
  A_Lens
  '[]
  (VM t s)
  (VM t s)
  (TreePos Empty Trace)
  (TreePos Empty Trace)
-> (TreePos Empty Trace -> TreePos Empty Trace)
-> StateT (VM t s) (ST s) ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying Optic
  A_Lens
  '[]
  (VM t s)
  (VM t s)
  (TreePos Empty Trace)
  (TreePos Empty Trace)
#traces ((TreePos Empty Trace -> TreePos Empty Trace)
 -> StateT (VM t s) (ST s) ())
-> (TreePos Empty Trace -> TreePos Empty Trace)
-> StateT (VM t s) (ST s) ()
forall a b. (a -> b) -> a -> b
$
    \TreePos Empty Trace
t -> case TreePos Empty Trace -> Maybe (TreePos Full Trace)
forall (t :: * -> *) a.
PosType t =>
TreePos t a -> Maybe (TreePos Full a)
Zipper.parent TreePos Empty Trace
t of
            Maybe (TreePos Full Trace)
Nothing -> [Char] -> TreePos Empty Trace
forall a. HasCallStack => [Char] -> a
internalError [Char]
"internal internalError(trace root)"
            Just TreePos Full Trace
t' -> TreePos Full Trace -> TreePos Empty Trace
forall a. TreePos Full a -> TreePos Empty a
Zipper.nextSpace TreePos Full Trace
t'

zipperRootForest :: Zipper.TreePos Zipper.Empty a -> Forest a
zipperRootForest :: forall a. TreePos Empty a -> Forest a
zipperRootForest TreePos Empty a
z =
  case TreePos Empty a -> Maybe (TreePos Full a)
forall (t :: * -> *) a.
PosType t =>
TreePos t a -> Maybe (TreePos Full a)
Zipper.parent TreePos Empty a
z of
    Maybe (TreePos Full a)
Nothing -> TreePos Empty a -> Forest a
forall (t :: * -> *) a. PosType t => TreePos t a -> Forest a
Zipper.toForest TreePos Empty a
z
    Just TreePos Full a
z' -> TreePos Empty a -> Forest a
forall a. TreePos Empty a -> Forest a
zipperRootForest (TreePos Full a -> TreePos Empty a
forall a. TreePos Full a -> TreePos Empty a
Zipper.nextSpace TreePos Full a
z')

traceForest :: VM t s -> Forest Trace
traceForest :: forall (t :: VMType) s. VM t s -> Forest Trace
traceForest VM t s
vm = TreePos Empty Trace -> Forest Trace
forall a. TreePos Empty a -> Forest a
zipperRootForest VM t s
vm.traces

traceForest' :: Expr End -> Forest Trace
traceForest' :: Expr 'End -> Forest Trace
traceForest' (Success [Prop]
_ (Traces Forest Trace
f Map (Expr 'EAddr) Contract
_) Expr 'Buf
_ Map (Expr 'EAddr) (Expr 'EContract)
_) = Forest Trace
f
traceForest' (Partial [Prop]
_ (Traces Forest Trace
f Map (Expr 'EAddr) Contract
_) PartialExec
_) = Forest Trace
f
traceForest' (Failure [Prop]
_ (Traces Forest Trace
f Map (Expr 'EAddr) Contract
_) EvmError
_) = Forest Trace
f
traceForest' (ITE {}) = [Char] -> Forest Trace
forall a. HasCallStack => [Char] -> a
internalError[Char]
"Internal Error: ITE does not contain a trace"
traceForest' (GVar {}) = [Char] -> Forest Trace
forall a. HasCallStack => [Char] -> a
internalError[Char]
"Internal Error: Unexpected GVar"

traceContext :: Expr End -> Map (Expr EAddr) Contract
traceContext :: Expr 'End -> Map (Expr 'EAddr) Contract
traceContext (Success [Prop]
_ (Traces Forest Trace
_ Map (Expr 'EAddr) Contract
c) Expr 'Buf
_ Map (Expr 'EAddr) (Expr 'EContract)
_) = Map (Expr 'EAddr) Contract
c
traceContext (Partial [Prop]
_ (Traces Forest Trace
_ Map (Expr 'EAddr) Contract
c) PartialExec
_) = Map (Expr 'EAddr) Contract
c
traceContext (Failure [Prop]
_ (Traces Forest Trace
_ Map (Expr 'EAddr) Contract
c) EvmError
_) = Map (Expr 'EAddr) Contract
c
traceContext (ITE {}) = [Char] -> Map (Expr 'EAddr) Contract
forall a. HasCallStack => [Char] -> a
internalError[Char]
"Internal Error: ITE does not contain a trace"
traceContext (GVar {}) = [Char] -> Map (Expr 'EAddr) Contract
forall a. HasCallStack => [Char] -> a
internalError[Char]
"Internal Error: Unexpected GVar"

traceTopLog :: [Expr Log] -> EVM t s ()
traceTopLog :: forall (t :: VMType) s. [Expr 'Log] -> EVM t s ()
traceTopLog [] = StateT (VM t s) (ST s) ()
forall (m :: * -> *). Monad m => m ()
noop
traceTopLog ((LogEntry Expr 'EWord
addr Expr 'Buf
bytes [Expr 'EWord]
topics) : [Expr 'Log]
_) = do
  Trace
trace <- TraceData -> EVM t s Trace
forall (t :: VMType) s. TraceData -> EVM t s Trace
withTraceLocation (Expr 'EWord -> Expr 'Buf -> [Expr 'EWord] -> TraceData
EventTrace Expr 'EWord
addr Expr 'Buf
bytes [Expr 'EWord]
topics)
  Optic
  A_Lens
  '[]
  (VM t s)
  (VM t s)
  (TreePos Empty Trace)
  (TreePos Empty Trace)
-> (TreePos Empty Trace -> TreePos Empty Trace)
-> StateT (VM t s) (ST s) ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying Optic
  A_Lens
  '[]
  (VM t s)
  (VM t s)
  (TreePos Empty Trace)
  (TreePos Empty Trace)
#traces ((TreePos Empty Trace -> TreePos Empty Trace)
 -> StateT (VM t s) (ST s) ())
-> (TreePos Empty Trace -> TreePos Empty Trace)
-> StateT (VM t s) (ST s) ()
forall a b. (a -> b) -> a -> b
$
    \TreePos Empty Trace
t -> TreePos Full Trace -> TreePos Empty Trace
forall a. TreePos Full a -> TreePos Empty a
Zipper.nextSpace (Tree Trace -> TreePos Empty Trace -> TreePos Full Trace
forall a. Tree a -> TreePos Empty a -> TreePos Full a
Zipper.insert (Trace -> Forest Trace -> Tree Trace
forall a. a -> [Tree a] -> Tree a
Node Trace
trace []) TreePos Empty Trace
t)
traceTopLog ((GVar GVar 'Log
_) : [Expr 'Log]
_) = [Char] -> StateT (VM t s) (ST s) ()
forall a. HasCallStack => [Char] -> a
internalError [Char]
"unexpected global variable"

-- * Stack manipulation

push :: W256 -> EVM t s ()
push :: forall (t :: VMType) s. W256 -> EVM t s ()
push = Expr 'EWord -> EVM t s ()
forall (t :: VMType) s. Expr 'EWord -> EVM t s ()
pushSym (Expr 'EWord -> EVM t s ())
-> (W256 -> Expr 'EWord) -> W256 -> EVM t s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. W256 -> Expr 'EWord
Lit

pushSym :: Expr EWord -> EVM t s ()
pushSym :: forall (t :: VMType) s. Expr 'EWord -> EVM t s ()
pushSym Expr 'EWord
x = Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     [Expr 'EWord]
     [Expr 'EWord]
-> Optic A_Lens '[] (VM t s) (VM t s) [Expr 'EWord] [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  [Expr 'EWord]
  [Expr 'EWord]
#stack Optic A_Lens '[] (VM t s) (VM t s) [Expr 'EWord] [Expr 'EWord]
-> ([Expr 'EWord] -> [Expr 'EWord]) -> StateT (VM t s) (ST s) ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
%= (Expr 'EWord
x :)

pushAddr :: Expr EAddr -> EVM t s ()
pushAddr :: forall (t :: VMType) s. Expr 'EAddr -> EVM t s ()
pushAddr (LitAddr Addr
x) = Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     [Expr 'EWord]
     [Expr 'EWord]
-> Optic A_Lens '[] (VM t s) (VM t s) [Expr 'EWord] [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  [Expr 'EWord]
  [Expr 'EWord]
#stack Optic A_Lens '[] (VM t s) (VM t s) [Expr 'EWord] [Expr 'EWord]
-> ([Expr 'EWord] -> [Expr 'EWord]) -> StateT (VM t s) (ST s) ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
%= (W256 -> Expr 'EWord
Lit (Addr -> W256
forall target source. From source target => source -> target
into Addr
x) :)
pushAddr x :: Expr 'EAddr
x@(SymAddr Text
_) = Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     [Expr 'EWord]
     [Expr 'EWord]
-> Optic A_Lens '[] (VM t s) (VM t s) [Expr 'EWord] [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  [Expr 'EWord]
  [Expr 'EWord]
#stack Optic A_Lens '[] (VM t s) (VM t s) [Expr 'EWord] [Expr 'EWord]
-> ([Expr 'EWord] -> [Expr 'EWord]) -> StateT (VM t s) (ST s) ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
%= (Expr 'EAddr -> Expr 'EWord
WAddr Expr 'EAddr
x :)
pushAddr (GVar GVar 'EAddr
_) = [Char] -> StateT (VM t s) (ST s) ()
forall a. HasCallStack => [Char] -> a
internalError [Char]
"Unexpected GVar"

stackOp1
  :: (?op :: Word8, VMOps t)
  => Word64
  -> (Expr EWord -> Expr EWord)
  -> EVM t s ()
stackOp1 :: forall (t :: VMType) s.
(?op::Word8, VMOps t) =>
Word64 -> (Expr 'EWord -> Expr 'EWord) -> EVM t s ()
stackOp1 Word64
cost Expr 'EWord -> Expr 'EWord
f =
  Optic' A_Lens '[] (VM t s) [Expr 'EWord]
-> StateT (VM t s) (ST s) [Expr 'EWord]
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     [Expr 'EWord]
     [Expr 'EWord]
-> Optic' A_Lens '[] (VM t s) [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  [Expr 'EWord]
  [Expr 'EWord]
#stack) StateT (VM t s) (ST s) [Expr 'EWord]
-> ([Expr 'EWord] -> StateT (VM t s) (ST s) ())
-> StateT (VM t s) (ST s) ()
forall a b.
StateT (VM t s) (ST s) a
-> (a -> StateT (VM t s) (ST s) b) -> StateT (VM t s) (ST s) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Expr 'EWord
x:[Expr 'EWord]
xs ->
      Word64 -> StateT (VM t s) (ST s) () -> StateT (VM t s) (ST s) ()
forall (t :: VMType) s.
VMOps t =>
Word64 -> EVM t s () -> EVM t s ()
burn Word64
cost (StateT (VM t s) (ST s) () -> StateT (VM t s) (ST s) ())
-> StateT (VM t s) (ST s) () -> StateT (VM t s) (ST s) ()
forall a b. (a -> b) -> a -> b
$ do
        StateT (VM t s) (ST s) ()
forall (t :: VMType) s. (?op::Word8) => EVM t s ()
next
        let !y :: Expr 'EWord
y = Expr 'EWord -> Expr 'EWord
f Expr 'EWord
x
        #state % #stack .= y : xs
    [Expr 'EWord]
_ ->
      StateT (VM t s) (ST s) ()
forall (t :: VMType) s. VMOps t => EVM t s ()
underrun

stackOp2
  :: (?op :: Word8, VMOps t)
  => Word64
  -> (Expr EWord -> Expr EWord -> Expr EWord)
  -> EVM t s ()
stackOp2 :: forall (t :: VMType) s.
(?op::Word8, VMOps t) =>
Word64 -> (Expr 'EWord -> Expr 'EWord -> Expr 'EWord) -> EVM t s ()
stackOp2 Word64
cost Expr 'EWord -> Expr 'EWord -> Expr 'EWord
f =
  Optic' A_Lens '[] (VM t s) [Expr 'EWord]
-> StateT (VM t s) (ST s) [Expr 'EWord]
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     [Expr 'EWord]
     [Expr 'EWord]
-> Optic' A_Lens '[] (VM t s) [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  [Expr 'EWord]
  [Expr 'EWord]
#stack) StateT (VM t s) (ST s) [Expr 'EWord]
-> ([Expr 'EWord] -> StateT (VM t s) (ST s) ())
-> StateT (VM t s) (ST s) ()
forall a b.
StateT (VM t s) (ST s) a
-> (a -> StateT (VM t s) (ST s) b) -> StateT (VM t s) (ST s) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Expr 'EWord
x:Expr 'EWord
y:[Expr 'EWord]
xs ->
      Word64 -> StateT (VM t s) (ST s) () -> StateT (VM t s) (ST s) ()
forall (t :: VMType) s.
VMOps t =>
Word64 -> EVM t s () -> EVM t s ()
burn Word64
cost (StateT (VM t s) (ST s) () -> StateT (VM t s) (ST s) ())
-> StateT (VM t s) (ST s) () -> StateT (VM t s) (ST s) ()
forall a b. (a -> b) -> a -> b
$ do
        StateT (VM t s) (ST s) ()
forall (t :: VMType) s. (?op::Word8) => EVM t s ()
next
        #state % #stack .= f x y : xs
    [Expr 'EWord]
_ ->
      StateT (VM t s) (ST s) ()
forall (t :: VMType) s. VMOps t => EVM t s ()
underrun

stackOp3
  :: (?op :: Word8, VMOps t)
  => Word64
  -> (Expr EWord -> Expr EWord -> Expr EWord -> Expr EWord)
  -> EVM t s ()
stackOp3 :: forall (t :: VMType) s.
(?op::Word8, VMOps t) =>
Word64
-> (Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> Expr 'EWord)
-> EVM t s ()
stackOp3 Word64
cost Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> Expr 'EWord
f =
  Optic' A_Lens '[] (VM t s) [Expr 'EWord]
-> StateT (VM t s) (ST s) [Expr 'EWord]
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     [Expr 'EWord]
     [Expr 'EWord]
-> Optic' A_Lens '[] (VM t s) [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  [Expr 'EWord]
  [Expr 'EWord]
#stack) StateT (VM t s) (ST s) [Expr 'EWord]
-> ([Expr 'EWord] -> StateT (VM t s) (ST s) ())
-> StateT (VM t s) (ST s) ()
forall a b.
StateT (VM t s) (ST s) a
-> (a -> StateT (VM t s) (ST s) b) -> StateT (VM t s) (ST s) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Expr 'EWord
x:Expr 'EWord
y:Expr 'EWord
z:[Expr 'EWord]
xs ->
      Word64 -> StateT (VM t s) (ST s) () -> StateT (VM t s) (ST s) ()
forall (t :: VMType) s.
VMOps t =>
Word64 -> EVM t s () -> EVM t s ()
burn Word64
cost (StateT (VM t s) (ST s) () -> StateT (VM t s) (ST s) ())
-> StateT (VM t s) (ST s) () -> StateT (VM t s) (ST s) ()
forall a b. (a -> b) -> a -> b
$ do
      StateT (VM t s) (ST s) ()
forall (t :: VMType) s. (?op::Word8) => EVM t s ()
next
      (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     [Expr 'EWord]
     [Expr 'EWord]
-> Optic' A_Lens '[] (VM t s) [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  [Expr 'EWord]
  [Expr 'EWord]
#stack) Optic' A_Lens '[] (VM t s) [Expr 'EWord]
-> [Expr 'EWord] -> StateT (VM t s) (ST s) ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
.= Expr 'EWord -> Expr 'EWord -> Expr 'EWord -> Expr 'EWord
f Expr 'EWord
x Expr 'EWord
y Expr 'EWord
z Expr 'EWord -> [Expr 'EWord] -> [Expr 'EWord]
forall a. a -> [a] -> [a]
: [Expr 'EWord]
xs
    [Expr 'EWord]
_ ->
      StateT (VM t s) (ST s) ()
forall (t :: VMType) s. VMOps t => EVM t s ()
underrun

-- * Bytecode data functions

checkJump :: VMOps t => Int -> [Expr EWord] -> EVM t s ()
checkJump :: forall (t :: VMType) s.
VMOps t =>
Int -> [Expr 'EWord] -> EVM t s ()
checkJump Int
x [Expr 'EWord]
xs = Int -> EVM t s () -> EVM t s ()
forall (t :: VMType) s. VMOps t => Int -> EVM t s () -> EVM t s ()
noJumpIntoInitData Int
x (EVM t s () -> EVM t s ()) -> EVM t s () -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ do
  VM t s
vm <- StateT (VM t s) (ST s) (VM t s)
forall s (m :: * -> *). MonadState s m => m s
get
  case VM t s -> Int -> Bool
forall (t :: VMType) s. VM t s -> Int -> Bool
isValidJumpDest VM t s
vm Int
x of
    Bool
True -> do
      #state % #stack .= xs
      #state % #pc .= x
    Bool
False -> EvmError -> EVM t s ()
forall (t :: VMType) s. VMOps t => EvmError -> EVM t s ()
vmError EvmError
BadJumpDestination

-- fails with partial if we're trying to jump into the symbolic region of an `InitCode`
noJumpIntoInitData :: VMOps t => Int -> EVM t s () -> EVM t s ()
noJumpIntoInitData :: forall (t :: VMType) s. VMOps t => Int -> EVM t s () -> EVM t s ()
noJumpIntoInitData Int
idx EVM t s ()
cont = do
  VM t s
vm <- StateT (VM t s) (ST s) (VM t s)
forall s (m :: * -> *). MonadState s m => m s
get
  case VM t s
vm.state.code of
    -- init code is totally concrete, so we don't return partial if we're
    -- jumping beyond the range of `ops`
    InitCode ByteString
_ (ConcreteBuf ByteString
"") -> EVM t s ()
cont
    -- init code has a symbolic region, so check if we're trying to jump into
    -- the symbolic region and return partial if we are
    InitCode ByteString
ops Expr 'Buf
_ -> if Int
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> ByteString -> Int
BS.length ByteString
ops
                      then PartialExec -> EVM t s ()
forall s. PartialExec -> EVM t s ()
forall (t :: VMType) s. VMOps t => PartialExec -> EVM t s ()
partial (PartialExec -> EVM t s ()) -> PartialExec -> EVM t s ()
forall a b. (a -> b) -> a -> b
$ Int -> Int -> PartialExec
JumpIntoSymbolicCode VM t s
vm.state.pc Int
idx
                      else EVM t s ()
cont
    -- we're not executing init code, so nothing to check here
    ContractCode
_ -> EVM t s ()
cont

isValidJumpDest :: VM t s -> Int -> Bool
isValidJumpDest :: forall (t :: VMType) s. VM t s -> Int -> Bool
isValidJumpDest VM t s
vm Int
x = let
    code :: ContractCode
code = VM t s
vm.state.code
    self :: Expr 'EAddr
self = VM t s
vm.state.codeContract
    contract :: Contract
contract = Contract -> Maybe Contract -> Contract
forall a. a -> Maybe a -> a
fromMaybe
      ([Char] -> Contract
forall a. HasCallStack => [Char] -> a
internalError [Char]
"self not found in current contracts")
      (Expr 'EAddr -> Map (Expr 'EAddr) Contract -> Maybe Contract
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Expr 'EAddr
self VM t s
vm.env.contracts)
    op :: Maybe Word8
op = case ContractCode
code of
      UnknownCode Expr 'EAddr
_ -> [Char] -> Maybe Word8
forall a. HasCallStack => [Char] -> a
internalError [Char]
"Cannot analyze jumpdests for unknown code"
      InitCode ByteString
ops Expr 'Buf
_ -> ByteString -> Int -> Maybe Word8
BS.indexMaybe ByteString
ops Int
x
      RuntimeCode (ConcreteRuntimeCode ByteString
ops) -> ByteString -> Int -> Maybe Word8
BS.indexMaybe ByteString
ops Int
x
      RuntimeCode (SymbolicRuntimeCode Vector (Expr 'Byte)
ops) -> Vector (Expr 'Byte)
ops Vector (Expr 'Byte) -> Int -> Maybe (Expr 'Byte)
forall a. Vector a -> Int -> Maybe a
V.!? Int
x Maybe (Expr 'Byte) -> (Expr 'Byte -> Maybe Word8) -> Maybe Word8
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Expr 'Byte -> Maybe Word8
maybeLitByte
  in case Maybe Word8
op of
       Maybe Word8
Nothing -> Bool
False
       Just Word8
b -> Word8
0x5b Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
b Bool -> Bool -> Bool
&& Op
forall a. GenericOp a
OpJumpdest Op -> Op -> Bool
forall a. Eq a => a -> a -> Bool
== (Int, Op) -> Op
forall a b. (a, b) -> b
snd (Contract
contract.codeOps Vector (Int, Op) -> Int -> (Int, Op)
forall a. Vector a -> Int -> a
V.! (Contract
contract.opIxMap Vector Int -> Int -> Int
forall a. Storable a => Vector a -> Int -> a
SV.! Int
x))

opSize :: Word8 -> Int
opSize :: Word8 -> Int
opSize Word8
x | Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
0x60 Bool -> Bool -> Bool
&& Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
0x7f = Word8 -> Int
forall target source. From source target => source -> target
into Word8
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
0x60 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2
opSize Word8
_                          = Int
1

--  i of the resulting vector contains the operation index for
-- the program counter value i.  This is needed because source map
-- entries are per operation, not per byte.
mkOpIxMap :: ContractCode -> SV.Vector Int
mkOpIxMap :: ContractCode -> Vector Int
mkOpIxMap (UnknownCode Expr 'EAddr
_) = [Char] -> Vector Int
forall a. HasCallStack => [Char] -> a
internalError [Char]
"Cannot build opIxMap for unknown code"
mkOpIxMap (InitCode ByteString
conc Expr 'Buf
_)
  = (forall s. ST s (MVector s Int)) -> Vector Int
forall a. Storable a => (forall s. ST s (MVector s a)) -> Vector a
SV.create ((forall s. ST s (MVector s Int)) -> Vector Int)
-> (forall s. ST s (MVector s Int)) -> Vector Int
forall a b. (a -> b) -> a -> b
$ Int -> ST s (MVector (PrimState (ST s)) Int)
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
Int -> m (MVector (PrimState m) a)
SV.new (ByteString -> Int
BS.length ByteString
conc) ST s (MVector s Int)
-> (MVector s Int -> ST s (MVector s Int)) -> ST s (MVector s Int)
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \MVector s Int
v ->
      -- Loop over the byte string accumulating a vector-mutating action.
      -- This is somewhat obfuscated, but should be fast.
      let (Word8
_, Int
_, Int
_, ST s ()
m) = ((Word8, Int, Int, ST s ()) -> Word8 -> (Word8, Int, Int, ST s ()))
-> (Word8, Int, Int, ST s ())
-> ByteString
-> (Word8, Int, Int, ST s ())
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
BS.foldl' (MVector (PrimState (ST s)) Int
-> (Word8, Int, Int, ST s ())
-> Word8
-> (Word8, Int, Int, ST s ())
forall {a} {m :: * -> *} {a} {a}.
(Ord a, PrimMonad m, Storable a, Num a, Num a) =>
MVector (PrimState m) a
-> (a, Int, a, m a) -> a -> (a, Int, a, m ())
go MVector s Int
MVector (PrimState (ST s)) Int
v) (Word8
0 :: Word8, Int
0, Int
0, () -> ST s ()
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) ByteString
conc
      in ST s ()
m ST s () -> ST s (MVector s Int) -> ST s (MVector s Int)
forall a b. ST s a -> ST s b -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MVector s Int -> ST s (MVector s Int)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MVector s Int
v
      where
        -- concrete case
        go :: MVector (PrimState m) a
-> (a, Int, a, m a) -> a -> (a, Int, a, m ())
go MVector (PrimState m) a
v (a
0, !Int
i, !a
j, !m a
m) a
x | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
0x60 Bool -> Bool -> Bool
&& a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
0x7f =
          {- Start of PUSH op. -} (a
x a -> a -> a
forall a. Num a => a -> a -> a
- a
0x60 a -> a -> a
forall a. Num a => a -> a -> a
+ a
1, Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, a
j,     m a
m m a -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MVector (PrimState m) a -> Int -> a -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
SV.write MVector (PrimState m) a
v Int
i a
j)
        go MVector (PrimState m) a
v (a
1, !Int
i, !a
j, !m a
m) a
_ =
          {- End of PUSH op. -}   (a
0,            Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, a
j a -> a -> a
forall a. Num a => a -> a -> a
+ a
1, m a
m m a -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MVector (PrimState m) a -> Int -> a -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
SV.write MVector (PrimState m) a
v Int
i a
j)
        go MVector (PrimState m) a
v (a
0, !Int
i, !a
j, !m a
m) a
_ =
          {- Other op. -}         (a
0,            Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, a
j a -> a -> a
forall a. Num a => a -> a -> a
+ a
1, m a
m m a -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MVector (PrimState m) a -> Int -> a -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
SV.write MVector (PrimState m) a
v Int
i a
j)
        go MVector (PrimState m) a
v (a
n, !Int
i, !a
j, !m a
m) a
_ =
          {- PUSH data. -}        (a
n a -> a -> a
forall a. Num a => a -> a -> a
- a
1,        Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, a
j,     m a
m m a -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MVector (PrimState m) a -> Int -> a -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
SV.write MVector (PrimState m) a
v Int
i a
j)

mkOpIxMap (RuntimeCode (ConcreteRuntimeCode ByteString
ops)) =
  ContractCode -> Vector Int
mkOpIxMap (ByteString -> Expr 'Buf -> ContractCode
InitCode ByteString
ops Expr 'Buf
forall a. Monoid a => a
mempty) -- a bit hacky

mkOpIxMap (RuntimeCode (SymbolicRuntimeCode Vector (Expr 'Byte)
ops))
  = (forall s. ST s (MVector s Int)) -> Vector Int
forall a. Storable a => (forall s. ST s (MVector s a)) -> Vector a
SV.create ((forall s. ST s (MVector s Int)) -> Vector Int)
-> (forall s. ST s (MVector s Int)) -> Vector Int
forall a b. (a -> b) -> a -> b
$ Int -> ST s (MVector (PrimState (ST s)) Int)
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
Int -> m (MVector (PrimState m) a)
SV.new (Vector (Expr 'Byte) -> Int
forall a. Vector a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Vector (Expr 'Byte)
ops) ST s (MVector s Int)
-> (MVector s Int -> ST s (MVector s Int)) -> ST s (MVector s Int)
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \MVector s Int
v ->
      let (Word8
_, Int
_, Int
_, ST s ()
m) = ((Word8, Int, Int, ST s ())
 -> Expr 'Byte -> (Word8, Int, Int, ST s ()))
-> (Word8, Int, Int, ST s ())
-> [Expr 'Byte]
-> (Word8, Int, Int, ST s ())
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (MVector (PrimState (ST s)) Int
-> (Word8, Int, Int, ST s ())
-> Expr 'Byte
-> (Word8, Int, Int, ST s ())
forall {m :: * -> *} {a} {a}.
(PrimMonad m, Storable a, Num a, Show a) =>
MVector (PrimState m) a
-> (Word8, Int, a, m a) -> Expr 'Byte -> (Word8, Int, a, m ())
go MVector s Int
MVector (PrimState (ST s)) Int
v) (Word8
0, Int
0, Int
0, () -> ST s ()
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) ([Expr 'Byte] -> [Expr 'Byte]
stripBytecodeMetadataSym ([Expr 'Byte] -> [Expr 'Byte]) -> [Expr 'Byte] -> [Expr 'Byte]
forall a b. (a -> b) -> a -> b
$ Vector (Expr 'Byte) -> [Expr 'Byte]
forall a. Vector a -> [a]
V.toList Vector (Expr 'Byte)
ops)
      in ST s ()
m ST s () -> ST s (MVector s Int) -> ST s (MVector s Int)
forall a b. ST s a -> ST s b -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MVector s Int -> ST s (MVector s Int)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MVector s Int
v
      where
        go :: MVector (PrimState m) a
-> (Word8, Int, a, m a) -> Expr 'Byte -> (Word8, Int, a, m ())
go MVector (PrimState m) a
v (Word8
0, !Int
i, !a
j, !m a
m) Expr 'Byte
x = case Expr 'Byte -> Maybe Word8
maybeLitByte Expr 'Byte
x of
          Just Word8
x' -> if Word8
x' Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
0x60 Bool -> Bool -> Bool
&& Word8
x' Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
0x7f
            -- start of PUSH op --
                     then (Word8
x' Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
0x60 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
1, Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, a
j,     m a
m m a -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MVector (PrimState m) a -> Int -> a -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
SV.write MVector (PrimState m) a
v Int
i a
j)
            -- other data --
                     else (Word8
0,             Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, a
j a -> a -> a
forall a. Num a => a -> a -> a
+ a
1, m a
m m a -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MVector (PrimState m) a -> Int -> a -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
SV.write MVector (PrimState m) a
v Int
i a
j)
          Maybe Word8
_ -> [Char] -> (Word8, Int, a, m ())
forall a. HasCallStack => [Char] -> a
internalError ([Char] -> (Word8, Int, a, m ()))
-> [Char] -> (Word8, Int, a, m ())
forall a b. (a -> b) -> a -> b
$ [Char]
"cannot analyze symbolic code:\nx: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Expr 'Byte -> [Char]
forall a. Show a => a -> [Char]
show Expr 'Byte
x [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" i: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Int -> [Char]
forall a. Show a => a -> [Char]
show Int
i [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" j: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> a -> [Char]
forall a. Show a => a -> [Char]
show a
j

        go MVector (PrimState m) a
v (Word8
1, !Int
i, !a
j, !m a
m) Expr 'Byte
_ =
          {- End of PUSH op. -}   (Word8
0,            Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, a
j a -> a -> a
forall a. Num a => a -> a -> a
+ a
1, m a
m m a -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MVector (PrimState m) a -> Int -> a -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
SV.write MVector (PrimState m) a
v Int
i a
j)
        go MVector (PrimState m) a
v (Word8
n, !Int
i, !a
j, !m a
m) Expr 'Byte
_ =
          {- PUSH data. -}        (Word8
n Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
1,        Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, a
j,     m a
m m a -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MVector (PrimState m) a -> Int -> a -> m ()
forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
MVector (PrimState m) a -> Int -> a -> m ()
SV.write MVector (PrimState m) a
v Int
i a
j)


vmOp :: VM t s -> Maybe Op
vmOp :: forall (t :: VMType) s. VM t s -> Maybe Op
vmOp VM t s
vm =
  let i :: Int
i  = VM t s
vm VM t s -> Optic' A_Lens '[] (VM t s) Int -> Int
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic A_Lens '[] (FrameState t s) (FrameState t s) Int Int
-> Optic' A_Lens '[] (VM t s) Int
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens '[] (FrameState t s) (FrameState t s) Int Int
#pc
      code' :: ContractCode
code' = VM t s
vm VM t s -> Optic' A_Lens '[] (VM t s) ContractCode -> ContractCode
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens
     '[]
     (FrameState t s)
     (FrameState t s)
     ContractCode
     ContractCode
-> Optic' A_Lens '[] (VM t s) ContractCode
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState t s)
  (FrameState t s)
  ContractCode
  ContractCode
#code
      (Word8
op, [Expr 'Byte]
pushdata) = case ContractCode
code' of
        UnknownCode Expr 'EAddr
_ -> [Char] -> (Word8, [Expr 'Byte])
forall a. HasCallStack => [Char] -> a
internalError [Char]
"cannot get op from unknown code"
        InitCode ByteString
xs' Expr 'Buf
_ ->
          (HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
xs' Int
i, (Word8 -> Expr 'Byte) -> [Word8] -> [Expr 'Byte]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word8 -> Expr 'Byte
LitByte ([Word8] -> [Expr 'Byte]) -> [Word8] -> [Expr 'Byte]
forall a b. (a -> b) -> a -> b
$ ByteString -> [Word8]
BS.unpack (ByteString -> [Word8]) -> ByteString -> [Word8]
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.drop Int
i ByteString
xs')
        RuntimeCode (ConcreteRuntimeCode ByteString
xs') ->
          (HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
xs' Int
i, (Word8 -> Expr 'Byte) -> [Word8] -> [Expr 'Byte]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word8 -> Expr 'Byte
LitByte ([Word8] -> [Expr 'Byte]) -> [Word8] -> [Expr 'Byte]
forall a b. (a -> b) -> a -> b
$ ByteString -> [Word8]
BS.unpack (ByteString -> [Word8]) -> ByteString -> [Word8]
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.drop Int
i ByteString
xs')
        RuntimeCode (SymbolicRuntimeCode Vector (Expr 'Byte)
xs') ->
          ( Word8 -> Maybe Word8 -> Word8
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> Word8
forall a. HasCallStack => [Char] -> a
internalError [Char]
"unexpected symbolic code") (Maybe Word8 -> Word8)
-> (Expr 'Byte -> Maybe Word8) -> Expr 'Byte -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr 'Byte -> Maybe Word8
maybeLitByte (Expr 'Byte -> Word8) -> Expr 'Byte -> Word8
forall a b. (a -> b) -> a -> b
$ Vector (Expr 'Byte)
xs' Vector (Expr 'Byte) -> Int -> Expr 'Byte
forall a. Vector a -> Int -> a
V.! Int
i , Vector (Expr 'Byte) -> [Expr 'Byte]
forall a. Vector a -> [a]
V.toList (Vector (Expr 'Byte) -> [Expr 'Byte])
-> Vector (Expr 'Byte) -> [Expr 'Byte]
forall a b. (a -> b) -> a -> b
$ Int -> Vector (Expr 'Byte) -> Vector (Expr 'Byte)
forall a. Int -> Vector a -> Vector a
V.drop Int
i Vector (Expr 'Byte)
xs')
  in if (ContractCode -> Int
opslen ContractCode
code' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
i)
     then Maybe Op
forall a. Maybe a
Nothing
     else Op -> Maybe Op
forall a. a -> Maybe a
Just (Word8 -> [Expr 'Byte] -> Op
readOp Word8
op [Expr 'Byte]
pushdata)

vmOpIx :: VM t s -> Maybe Int
vmOpIx :: forall (t :: VMType) s. VM t s -> Maybe Int
vmOpIx VM t s
vm =
  do Contract
self <- VM t s -> Maybe Contract
forall (t :: VMType) s. VM t s -> Maybe Contract
currentContract VM t s
vm
     Contract
self.opIxMap Vector Int -> Int -> Maybe Int
forall a. Storable a => Vector a -> Int -> Maybe a
SV.!? VM t s
vm.state.pc

-- Maps operation indices into a pair of (bytecode index, operation)
mkCodeOps :: ContractCode -> V.Vector (Int, Op)
mkCodeOps :: ContractCode -> Vector (Int, Op)
mkCodeOps ContractCode
contractCode =
  let l :: [Expr 'Byte]
l = case ContractCode
contractCode of
            UnknownCode Expr 'EAddr
_ -> [Char] -> [Expr 'Byte]
forall a. HasCallStack => [Char] -> a
internalError [Char]
"Cannot make codeOps for unknown code"
            InitCode ByteString
bytes Expr 'Buf
_ ->
              Word8 -> Expr 'Byte
LitByte (Word8 -> Expr 'Byte) -> [Word8] -> [Expr 'Byte]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ByteString -> [Word8]
BS.unpack ByteString
bytes)
            RuntimeCode (ConcreteRuntimeCode ByteString
ops) ->
              Word8 -> Expr 'Byte
LitByte (Word8 -> Expr 'Byte) -> [Word8] -> [Expr 'Byte]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ByteString -> [Word8]
BS.unpack (ByteString -> [Word8]) -> ByteString -> [Word8]
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
stripBytecodeMetadata ByteString
ops)
            RuntimeCode (SymbolicRuntimeCode Vector (Expr 'Byte)
ops) ->
              [Expr 'Byte] -> [Expr 'Byte]
stripBytecodeMetadataSym ([Expr 'Byte] -> [Expr 'Byte]) -> [Expr 'Byte] -> [Expr 'Byte]
forall a b. (a -> b) -> a -> b
$ Vector (Expr 'Byte) -> [Expr 'Byte]
forall a. Vector a -> [a]
V.toList Vector (Expr 'Byte)
ops
  in [(Int, Op)] -> Vector (Int, Op)
forall a. [a] -> Vector a
V.fromList ([(Int, Op)] -> Vector (Int, Op))
-> (Seq (Int, Op) -> [(Int, Op)])
-> Seq (Int, Op)
-> Vector (Int, Op)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq (Int, Op) -> [(Int, Op)]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq (Int, Op) -> Vector (Int, Op))
-> Seq (Int, Op) -> Vector (Int, Op)
forall a b. (a -> b) -> a -> b
$ Int -> [Expr 'Byte] -> Seq (Int, Op)
go Int
0 [Expr 'Byte]
l
  where
    go :: Int -> [Expr 'Byte] -> Seq (Int, Op)
go !Int
i ![Expr 'Byte]
xs =
      case [Expr 'Byte] -> Maybe (Expr 'Byte, [Expr 'Byte])
forall s a. Cons s s a a => s -> Maybe (a, s)
uncons [Expr 'Byte]
xs of
        Maybe (Expr 'Byte, [Expr 'Byte])
Nothing ->
          Seq (Int, Op)
forall a. Monoid a => a
mempty
        Just (Expr 'Byte
x, [Expr 'Byte]
xs') ->
          let x' :: Word8
x' = Word8 -> Maybe Word8 -> Word8
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> Word8
forall a. HasCallStack => [Char] -> a
internalError [Char]
"unexpected symbolic code argument") (Maybe Word8 -> Word8) -> Maybe Word8 -> Word8
forall a b. (a -> b) -> a -> b
$ Expr 'Byte -> Maybe Word8
maybeLitByte Expr 'Byte
x
              j :: Int
j = Word8 -> Int
opSize Word8
x'
          in (Int
i, Word8 -> [Expr 'Byte] -> Op
readOp Word8
x' [Expr 'Byte]
xs') (Int, Op) -> Seq (Int, Op) -> Seq (Int, Op)
forall a. a -> Seq a -> Seq a
Seq.<| Int -> [Expr 'Byte] -> Seq (Int, Op)
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
j) (Int -> [Expr 'Byte] -> [Expr 'Byte]
forall a. Int -> [a] -> [a]
drop Int
j [Expr 'Byte]
xs)

-- * Gas cost calculation helpers

concreteModexpGasFee :: ByteString -> Word64
concreteModexpGasFee :: ByteString -> Word64
concreteModexpGasFee ByteString
input =
  if W256
lenb W256 -> W256 -> Bool
forall a. Ord a => a -> a -> Bool
< Word32 -> W256
forall target source. From source target => source -> target
into (Word32
forall a. Bounded a => a
maxBound :: Word32) Bool -> Bool -> Bool
&&
     (W256
lene W256 -> W256 -> Bool
forall a. Ord a => a -> a -> Bool
< Word32 -> W256
forall target source. From source target => source -> target
into (Word32
forall a. Bounded a => a
maxBound :: Word32) Bool -> Bool -> Bool
|| (W256
lenb W256 -> W256 -> Bool
forall a. Eq a => a -> a -> Bool
== W256
0 Bool -> Bool -> Bool
&& W256
lenm W256 -> W256 -> Bool
forall a. Eq a => a -> a -> Bool
== W256
0)) Bool -> Bool -> Bool
&&
     W256
lenm W256 -> W256 -> Bool
forall a. Ord a => a -> a -> Bool
< Word64 -> W256
forall target source. From source target => source -> target
into (Word64
forall a. Bounded a => a
maxBound :: Word64)
  then
    Word64 -> Word64 -> Word64
forall a. Ord a => a -> a -> a
max Word64
200 ((Word64
multiplicationComplexity Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
iterCount) Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`div` Word64
3)
  else
    Word64
forall a. Bounded a => a
maxBound -- TODO: this is not 100% correct, return Nothing on overflow
  where
    (W256
lenb, W256
lene, W256
lenm) = ByteString -> (W256, W256, W256)
parseModexpLength ByteString
input
    ez :: Bool
ez = W256 -> W256 -> ByteString -> Bool
isZero (W256
96 W256 -> W256 -> W256
forall a. Num a => a -> a -> a
+ W256
lenb) W256
lene ByteString
input
    e' :: W256
e' = ByteString -> W256
word (ByteString -> W256) -> ByteString -> W256
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
LS.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$
      W256 -> W256 -> ByteString -> ByteString
lazySlice (W256
96 W256 -> W256 -> W256
forall a. Num a => a -> a -> a
+ W256
lenb) (W256 -> W256 -> W256
forall a. Ord a => a -> a -> a
min W256
32 W256
lene) ByteString
input
    nwords :: Word64
    nwords :: Word64
nwords = Word64 -> Word64 -> Word64
forall a. (Num a, Integral a) => a -> a -> a
ceilDiv (W256 -> Word64
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto (W256 -> Word64) -> W256 -> Word64
forall a b. (a -> b) -> a -> b
$ W256 -> W256 -> W256
forall a. Ord a => a -> a -> a
max W256
lenb W256
lenm) Word64
8
    multiplicationComplexity :: Word64
multiplicationComplexity = Word64
nwords Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
nwords
    iterCount' :: Word64
    iterCount' :: Word64
iterCount' | W256
lene W256 -> W256 -> Bool
forall a. Ord a => a -> a -> Bool
<= W256
32 Bool -> Bool -> Bool
&& Bool
ez = Word64
0
               | W256
lene W256 -> W256 -> Bool
forall a. Ord a => a -> a -> Bool
<= W256
32 = Int -> Word64
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto (W256 -> Int
forall b. FiniteBits b => b -> Int
log2 W256
e')
               | W256
e' W256 -> W256 -> Bool
forall a. Eq a => a -> a -> Bool
== W256
0 = Word64
8 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* (W256 -> Word64
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto W256
lene Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
32)
               | Bool
otherwise = Int -> Word64
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto (W256 -> Int
forall b. FiniteBits b => b -> Int
log2 W256
e') Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
8 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* (W256 -> Word64
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto W256
lene Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
32)
    iterCount :: Word64
iterCount = Word64 -> Word64 -> Word64
forall a. Ord a => a -> a -> a
max Word64
iterCount' Word64
1

-- Gas cost of precompiles
costOfPrecompile :: FeeSchedule Word64 -> Addr -> Expr Buf -> Word64
costOfPrecompile :: FeeSchedule Word64 -> Addr -> Expr 'Buf -> Word64
costOfPrecompile (FeeSchedule {Word64
$sel:g_zero:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_base:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_verylow:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_low:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_mid:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_high:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_extcode:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_balance:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sload:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_jumpdest:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sset:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sreset:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:r_sclear:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_selfdestruct:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_selfdestruct_newaccount:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:r_selfdestruct:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_create:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_codedeposit:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_call:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_callvalue:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_callstipend:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_newaccount:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_exp:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_expbyte:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_memory:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_txcreate:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_txdatazero:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_txdatanonzero:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_transaction:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_log:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_logdata:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_logtopic:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sha3:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sha3word:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_initcodeword:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_copy:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_blockhash:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_extcodehash:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_quaddivisor:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_ecadd:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_ecmul:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_pairing_point:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_pairing_base:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_fround:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:r_block:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_cold_sload:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_cold_account_access:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_warm_storage_read:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_access_list_address:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_access_list_storage_key:FeeSchedule :: forall n. FeeSchedule n -> n
g_zero :: Word64
g_base :: Word64
g_verylow :: Word64
g_low :: Word64
g_mid :: Word64
g_high :: Word64
g_extcode :: Word64
g_balance :: Word64
g_sload :: Word64
g_jumpdest :: Word64
g_sset :: Word64
g_sreset :: Word64
r_sclear :: Word64
g_selfdestruct :: Word64
g_selfdestruct_newaccount :: Word64
r_selfdestruct :: Word64
g_create :: Word64
g_codedeposit :: Word64
g_call :: Word64
g_callvalue :: Word64
g_callstipend :: Word64
g_newaccount :: Word64
g_exp :: Word64
g_expbyte :: Word64
g_memory :: Word64
g_txcreate :: Word64
g_txdatazero :: Word64
g_txdatanonzero :: Word64
g_transaction :: Word64
g_log :: Word64
g_logdata :: Word64
g_logtopic :: Word64
g_sha3 :: Word64
g_sha3word :: Word64
g_initcodeword :: Word64
g_copy :: Word64
g_blockhash :: Word64
g_extcodehash :: Word64
g_quaddivisor :: Word64
g_ecadd :: Word64
g_ecmul :: Word64
g_pairing_point :: Word64
g_pairing_base :: Word64
g_fround :: Word64
r_block :: Word64
g_cold_sload :: Word64
g_cold_account_access :: Word64
g_warm_storage_read :: Word64
g_access_list_address :: Word64
g_access_list_storage_key :: Word64
..}) Addr
precompileAddr Expr 'Buf
input =
  let errorDynamicSize :: a
errorDynamicSize = [Char] -> a
forall a. HasCallStack => [Char] -> a
internalError [Char]
"precompile input cannot have a dynamic size"
      inputLen :: Word64
inputLen = case Expr 'Buf
input of
                   ConcreteBuf ByteString
bs -> Int -> Word64
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BS.length ByteString
bs
                   AbstractBuf Text
_ -> Word64
forall {a}. a
errorDynamicSize
                   Expr 'Buf
buf -> case Expr 'Buf -> Expr 'EWord
bufLength Expr 'Buf
buf of
                            Lit W256
l -> W256 -> Word64
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto W256
l -- TODO: overflow
                            Expr 'EWord
_ -> Word64
forall {a}. a
errorDynamicSize
  in case Addr
precompileAddr of
    -- ECRECOVER
    Addr
0x1 -> Word64
3000
    -- SHA2-256
    Addr
0x2 -> (((Word64
inputLen Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
31) Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`div` Word64
32) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
12) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
60
    -- RIPEMD-160
    Addr
0x3 -> (((Word64
inputLen Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
31) Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`div` Word64
32) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
120) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
600
    -- IDENTITY
    Addr
0x4 -> (((Word64
inputLen Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
31) Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`div` Word64
32) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
3) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
15
    -- MODEXP
    Addr
0x5 -> case Expr 'Buf
input of
             ConcreteBuf ByteString
i -> ByteString -> Word64
concreteModexpGasFee ByteString
i
             Expr 'Buf
_ -> [Char] -> Word64
forall a. HasCallStack => [Char] -> a
internalError [Char]
"Unsupported symbolic modexp gas calc "
    -- ECADD
    Addr
0x6 -> Word64
g_ecadd
    -- ECMUL
    Addr
0x7 -> Word64
g_ecmul
    -- ECPAIRING
    Addr
0x8 -> (Word64
inputLen Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`div` Word64
192) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
g_pairing_point Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
g_pairing_base
    -- BLAKE2
    Addr
0x9 -> case Expr 'Buf
input of
             ConcreteBuf ByteString
i -> Word64
g_fround Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* (Integer -> Word64
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto (Integer -> Word64) -> Integer -> Word64
forall a b. (a -> b) -> a -> b
$ ByteString -> Integer
asInteger (ByteString -> Integer) -> ByteString -> Integer
forall a b. (a -> b) -> a -> b
$ W256 -> W256 -> ByteString -> ByteString
lazySlice W256
0 W256
4 ByteString
i)
             Expr 'Buf
_ -> [Char] -> Word64
forall a. HasCallStack => [Char] -> a
internalError [Char]
"Unsupported symbolic blake2 gas calc"
    Addr
_ -> [Char] -> Word64
forall a. HasCallStack => [Char] -> a
internalError ([Char] -> Word64) -> [Char] -> Word64
forall a b. (a -> b) -> a -> b
$ [Char]
"unimplemented precompiled contract " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Addr -> [Char]
forall a. Show a => a -> [Char]
show Addr
precompileAddr

-- Gas cost of memory expansion
memoryCost :: FeeSchedule Word64 -> Word64 -> Word64
memoryCost :: FeeSchedule Word64 -> Word64 -> Word64
memoryCost FeeSchedule{Word64
$sel:g_zero:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_base:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_verylow:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_low:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_mid:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_high:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_extcode:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_balance:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sload:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_jumpdest:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sset:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sreset:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:r_sclear:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_selfdestruct:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_selfdestruct_newaccount:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:r_selfdestruct:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_create:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_codedeposit:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_call:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_callvalue:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_callstipend:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_newaccount:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_exp:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_expbyte:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_memory:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_txcreate:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_txdatazero:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_txdatanonzero:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_transaction:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_log:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_logdata:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_logtopic:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sha3:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sha3word:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_initcodeword:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_copy:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_blockhash:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_extcodehash:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_quaddivisor:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_ecadd:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_ecmul:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_pairing_point:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_pairing_base:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_fround:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:r_block:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_cold_sload:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_cold_account_access:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_warm_storage_read:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_access_list_address:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_access_list_storage_key:FeeSchedule :: forall n. FeeSchedule n -> n
g_zero :: Word64
g_base :: Word64
g_verylow :: Word64
g_low :: Word64
g_mid :: Word64
g_high :: Word64
g_extcode :: Word64
g_balance :: Word64
g_sload :: Word64
g_jumpdest :: Word64
g_sset :: Word64
g_sreset :: Word64
r_sclear :: Word64
g_selfdestruct :: Word64
g_selfdestruct_newaccount :: Word64
r_selfdestruct :: Word64
g_create :: Word64
g_codedeposit :: Word64
g_call :: Word64
g_callvalue :: Word64
g_callstipend :: Word64
g_newaccount :: Word64
g_exp :: Word64
g_expbyte :: Word64
g_memory :: Word64
g_txcreate :: Word64
g_txdatazero :: Word64
g_txdatanonzero :: Word64
g_transaction :: Word64
g_log :: Word64
g_logdata :: Word64
g_logtopic :: Word64
g_sha3 :: Word64
g_sha3word :: Word64
g_initcodeword :: Word64
g_copy :: Word64
g_blockhash :: Word64
g_extcodehash :: Word64
g_quaddivisor :: Word64
g_ecadd :: Word64
g_ecmul :: Word64
g_pairing_point :: Word64
g_pairing_base :: Word64
g_fround :: Word64
r_block :: Word64
g_cold_sload :: Word64
g_cold_account_access :: Word64
g_warm_storage_read :: Word64
g_access_list_address :: Word64
g_access_list_storage_key :: Word64
..} Word64
byteCount =
  let
    wordCount :: Word64
wordCount = Word64 -> Word64 -> Word64
forall a. (Num a, Integral a) => a -> a -> a
ceilDiv Word64
byteCount Word64
32
    linearCost :: Word64
linearCost = Word64
g_memory Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
wordCount
    quadraticCost :: Word64
quadraticCost = Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
div (Word64
wordCount Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
wordCount) Word64
512
  in
    Word64
linearCost Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
quadraticCost

hashcode :: ContractCode -> Expr EWord
hashcode :: ContractCode -> Expr 'EWord
hashcode (UnknownCode Expr 'EAddr
a) = Expr 'EAddr -> Expr 'EWord
CodeHash Expr 'EAddr
a
hashcode (InitCode ByteString
ops Expr 'Buf
args) = Expr 'Buf -> Expr 'EWord
keccak (Expr 'Buf -> Expr 'EWord) -> Expr 'Buf -> Expr 'EWord
forall a b. (a -> b) -> a -> b
$ (ByteString -> Expr 'Buf
ConcreteBuf ByteString
ops) Expr 'Buf -> Expr 'Buf -> Expr 'Buf
forall a. Semigroup a => a -> a -> a
<> Expr 'Buf
args
hashcode (RuntimeCode (ConcreteRuntimeCode ByteString
ops)) = Expr 'Buf -> Expr 'EWord
keccak (ByteString -> Expr 'Buf
ConcreteBuf ByteString
ops)
hashcode (RuntimeCode (SymbolicRuntimeCode Vector (Expr 'Byte)
ops)) = Expr 'Buf -> Expr 'EWord
keccak (Expr 'Buf -> Expr 'EWord)
-> (Vector (Expr 'Byte) -> Expr 'Buf)
-> Vector (Expr 'Byte)
-> Expr 'EWord
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (Expr 'Byte) -> Expr 'Buf
Expr.fromList (Vector (Expr 'Byte) -> Expr 'EWord)
-> Vector (Expr 'Byte) -> Expr 'EWord
forall a b. (a -> b) -> a -> b
$ Vector (Expr 'Byte)
ops

-- | The length of the code ignoring any constructor args.
-- This represents the region that can contain executable opcodes
opslen :: ContractCode -> Int
opslen :: ContractCode -> Int
opslen (UnknownCode Expr 'EAddr
_) = [Char] -> Int
forall a. HasCallStack => [Char] -> a
internalError [Char]
"Cannot produce concrete opslen for unknown code"
opslen (InitCode ByteString
ops Expr 'Buf
_) = ByteString -> Int
BS.length ByteString
ops
opslen (RuntimeCode (ConcreteRuntimeCode ByteString
ops)) = ByteString -> Int
BS.length ByteString
ops
opslen (RuntimeCode (SymbolicRuntimeCode Vector (Expr 'Byte)
ops)) = Vector (Expr 'Byte) -> Int
forall a. Vector a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Vector (Expr 'Byte)
ops

-- | The length of the code including any constructor args.
-- This can return an abstract value
codelen :: ContractCode -> Expr EWord
codelen :: ContractCode -> Expr 'EWord
codelen (UnknownCode Expr 'EAddr
a) = Expr 'EAddr -> Expr 'EWord
CodeSize Expr 'EAddr
a
codelen c :: ContractCode
c@(InitCode {}) = case ContractCode -> Maybe (Expr 'Buf)
toBuf ContractCode
c of
  Just Expr 'Buf
b -> Expr 'Buf -> Expr 'EWord
bufLength Expr 'Buf
b
  Maybe (Expr 'Buf)
Nothing -> [Char] -> Expr 'EWord
forall a. HasCallStack => [Char] -> a
internalError [Char]
"impossible"
-- these are never going to be negative so unsafeInto is fine here
codelen (RuntimeCode (ConcreteRuntimeCode ByteString
ops)) = W256 -> Expr 'EWord
Lit (W256 -> Expr 'EWord) -> (Int -> W256) -> Int -> Expr 'EWord
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> W256
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto (Int -> Expr 'EWord) -> Int -> Expr 'EWord
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BS.length ByteString
ops
codelen (RuntimeCode (SymbolicRuntimeCode Vector (Expr 'Byte)
ops)) = W256 -> Expr 'EWord
Lit (W256 -> Expr 'EWord) -> (Int -> W256) -> Int -> Expr 'EWord
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> W256
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto (Int -> Expr 'EWord) -> Int -> Expr 'EWord
forall a b. (a -> b) -> a -> b
$ Vector (Expr 'Byte) -> Int
forall a. Vector a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Vector (Expr 'Byte)
ops

toBuf :: ContractCode -> Maybe (Expr Buf)
toBuf :: ContractCode -> Maybe (Expr 'Buf)
toBuf (UnknownCode Expr 'EAddr
_) = Maybe (Expr 'Buf)
forall a. Maybe a
Nothing
toBuf (InitCode ByteString
ops Expr 'Buf
args) = Expr 'Buf -> Maybe (Expr 'Buf)
forall a. a -> Maybe a
Just (Expr 'Buf -> Maybe (Expr 'Buf)) -> Expr 'Buf -> Maybe (Expr 'Buf)
forall a b. (a -> b) -> a -> b
$ ByteString -> Expr 'Buf
ConcreteBuf ByteString
ops Expr 'Buf -> Expr 'Buf -> Expr 'Buf
forall a. Semigroup a => a -> a -> a
<> Expr 'Buf
args
toBuf (RuntimeCode (ConcreteRuntimeCode ByteString
ops)) = Expr 'Buf -> Maybe (Expr 'Buf)
forall a. a -> Maybe a
Just (Expr 'Buf -> Maybe (Expr 'Buf)) -> Expr 'Buf -> Maybe (Expr 'Buf)
forall a b. (a -> b) -> a -> b
$ ByteString -> Expr 'Buf
ConcreteBuf ByteString
ops
toBuf (RuntimeCode (SymbolicRuntimeCode Vector (Expr 'Byte)
ops)) = Expr 'Buf -> Maybe (Expr 'Buf)
forall a. a -> Maybe a
Just (Expr 'Buf -> Maybe (Expr 'Buf)) -> Expr 'Buf -> Maybe (Expr 'Buf)
forall a b. (a -> b) -> a -> b
$ Vector (Expr 'Byte) -> Expr 'Buf
Expr.fromList Vector (Expr 'Byte)
ops

codeloc :: EVM t s CodeLocation
codeloc :: forall (t :: VMType) s. EVM t s CodeLocation
codeloc = do
  VM t s
vm <- StateT (VM t s) (ST s) (VM t s)
forall s (m :: * -> *). MonadState s m => m s
get
  CodeLocation -> EVM t s CodeLocation
forall a. a -> StateT (VM t s) (ST s) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VM t s
vm.state.contract, VM t s
vm.state.pc)

createAddress :: Expr EAddr -> Maybe W64 -> EVM t s (Expr EAddr)
createAddress :: forall (t :: VMType) s.
Expr 'EAddr -> Maybe W64 -> EVM t s (Expr 'EAddr)
createAddress (LitAddr Addr
a) (Just W64
n) = Expr 'EAddr -> StateT (VM t s) (ST s) (Expr 'EAddr)
forall a. a -> StateT (VM t s) (ST s) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expr 'EAddr -> StateT (VM t s) (ST s) (Expr 'EAddr))
-> Expr 'EAddr -> StateT (VM t s) (ST s) (Expr 'EAddr)
forall a b. (a -> b) -> a -> b
$ Addr -> W64 -> Expr 'EAddr
Concrete.createAddress Addr
a W64
n
createAddress (GVar GVar 'EAddr
_) Maybe W64
_ = [Char] -> StateT (VM t s) (ST s) (Expr 'EAddr)
forall a. HasCallStack => [Char] -> a
internalError [Char]
"Unexpected GVar"
createAddress Expr 'EAddr
_ Maybe W64
_ = StateT (VM t s) (ST s) (Expr 'EAddr)
forall (t :: VMType) s. EVM t s (Expr 'EAddr)
freshSymAddr

create2Address :: Expr EAddr -> W256 -> ByteString -> EVM t s (Expr EAddr)
create2Address :: forall (t :: VMType) s.
Expr 'EAddr -> W256 -> ByteString -> EVM t s (Expr 'EAddr)
create2Address (LitAddr Addr
a) W256
s ByteString
b = Expr 'EAddr -> StateT (VM t s) (ST s) (Expr 'EAddr)
forall a. a -> StateT (VM t s) (ST s) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expr 'EAddr -> StateT (VM t s) (ST s) (Expr 'EAddr))
-> Expr 'EAddr -> StateT (VM t s) (ST s) (Expr 'EAddr)
forall a b. (a -> b) -> a -> b
$ Addr -> W256 -> ByteString -> Expr 'EAddr
Concrete.create2Address Addr
a W256
s ByteString
b
create2Address (SymAddr Text
_) W256
_ ByteString
_ = StateT (VM t s) (ST s) (Expr 'EAddr)
forall (t :: VMType) s. EVM t s (Expr 'EAddr)
freshSymAddr
create2Address (GVar GVar 'EAddr
_) W256
_ ByteString
_ = [Char] -> StateT (VM t s) (ST s) (Expr 'EAddr)
forall a. HasCallStack => [Char] -> a
internalError [Char]
"Unexpected GVar"

freshSymAddr :: EVM t s (Expr EAddr)
freshSymAddr :: forall (t :: VMType) s. EVM t s (Expr 'EAddr)
freshSymAddr = do
  Optic A_Lens '[] (VM t s) (VM t s) Int Int
-> (Int -> Int) -> StateT (VM t s) (ST s) ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying (Optic A_Lens '[] (VM t s) (VM t s) Env Env
#env Optic A_Lens '[] (VM t s) (VM t s) Env Env
-> Optic A_Lens '[] Env Env Int Int
-> Optic A_Lens '[] (VM t s) (VM t s) Int Int
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens '[] Env Env Int Int
#freshAddresses) (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
  Int
n <- Optic A_Lens '[] (VM t s) (VM t s) Int Int
-> StateT (VM t s) (ST s) Int
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic A_Lens '[] (VM t s) (VM t s) Env Env
#env Optic A_Lens '[] (VM t s) (VM t s) Env Env
-> Optic A_Lens '[] Env Env Int Int
-> Optic A_Lens '[] (VM t s) (VM t s) Int Int
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens '[] Env Env Int Int
#freshAddresses)
  Expr 'EAddr -> EVM t s (Expr 'EAddr)
forall a. a -> StateT (VM t s) (ST s) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expr 'EAddr -> EVM t s (Expr 'EAddr))
-> Expr 'EAddr -> EVM t s (Expr 'EAddr)
forall a b. (a -> b) -> a -> b
$ Text -> Expr 'EAddr
SymAddr (Text
"freshSymAddr" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ([Char] -> Text
pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n))

isPrecompileAddr :: Expr EAddr -> Bool
isPrecompileAddr :: Expr 'EAddr -> Bool
isPrecompileAddr = \case
  LitAddr Addr
a -> Addr
0x0 Addr -> Addr -> Bool
forall a. Ord a => a -> a -> Bool
< Addr
a Bool -> Bool -> Bool
&& Addr
a Addr -> Addr -> Bool
forall a. Ord a => a -> a -> Bool
<= Addr
0x09
  SymAddr Text
_ -> Bool
False
  GVar GVar 'EAddr
_ -> [Char] -> Bool
forall a. HasCallStack => [Char] -> a
internalError [Char]
"Unexpected GVar"

-- * Arithmetic

ceilDiv :: (Num a, Integral a) => a -> a -> a
ceilDiv :: forall a. (Num a, Integral a) => a -> a -> a
ceilDiv a
m a
n = a -> a -> a
forall a. Integral a => a -> a -> a
div (a
m a -> a -> a
forall a. Num a => a -> a -> a
+ a
n a -> a -> a
forall a. Num a => a -> a -> a
- a
1) a
n

allButOne64th :: (Num a, Integral a) => a -> a
allButOne64th :: forall a. (Num a, Integral a) => a -> a
allButOne64th a
n = a
n a -> a -> a
forall a. Num a => a -> a -> a
- a -> a -> a
forall a. Integral a => a -> a -> a
div a
n a
64

log2 :: FiniteBits b => b -> Int
log2 :: forall b. FiniteBits b => b -> Int
log2 b
x = b -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize b
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- b -> Int
forall b. FiniteBits b => b -> Int
countLeadingZeros b
x

writeMemory :: MutableMemory s -> Int -> ByteString -> EVM t s ()
writeMemory :: forall s (t :: VMType).
MutableMemory s -> Int -> ByteString -> EVM t s ()
writeMemory MutableMemory s
memory Int
offset ByteString
buf = do
  MutableMemory s
memory' <- Int -> StateT (VM t s) (ST s) (MutableMemory s)
expandMemory (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ByteString -> Int
BS.length ByteString
buf)
  ((Int, Word8) -> EVM t s ()) -> [(Int, Word8)] -> EVM t s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((Int -> Word8 -> EVM t s ()) -> (Int, Word8) -> EVM t s ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (MVector (PrimState (StateT (VM t s) (ST s))) Word8
-> Int -> Word8 -> EVM t s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
VUnboxed.Mutable.write MutableMemory s
MVector (PrimState (StateT (VM t s) (ST s))) Word8
memory'))
        ([Int] -> [Word8] -> [(Int, Word8)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
offset..] (ByteString -> [Word8]
BS.unpack ByteString
buf))
  where
  expandMemory :: Int -> StateT (VM t s) (ST s) (MutableMemory s)
expandMemory Int
targetSize = do
    let toAlloc :: Int
toAlloc = Int
targetSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- MutableMemory s -> Int
forall a s. Unbox a => MVector s a -> Int
VUnboxed.Mutable.length MutableMemory s
memory
    if Int
toAlloc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then do
      MutableMemory s
memory' <- MVector (PrimState (StateT (VM t s) (ST s))) Word8
-> Int
-> StateT
     (VM t s)
     (ST s)
     (MVector (PrimState (StateT (VM t s) (ST s))) Word8)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a)
VUnboxed.Mutable.grow MutableMemory s
MVector (PrimState (StateT (VM t s) (ST s))) Word8
memory Int
toAlloc
      Optic A_Lens '[] (VM t s) (VM t s) (Memory s) (Memory s)
-> Memory s -> EVM t s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
#state Optic
  A_Lens '[] (VM t s) (VM t s) (FrameState t s) (FrameState t s)
-> Optic
     A_Lens '[] (FrameState t s) (FrameState t s) (Memory s) (Memory s)
-> Optic A_Lens '[] (VM t s) (VM t s) (Memory s) (Memory s)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens '[] (FrameState t s) (FrameState t s) (Memory s) (Memory s)
#memory) (MutableMemory s -> Memory s
forall s. MutableMemory s -> Memory s
ConcreteMemory MutableMemory s
memory')
      MutableMemory s -> StateT (VM t s) (ST s) (MutableMemory s)
forall a. a -> StateT (VM t s) (ST s) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MutableMemory s
memory'
    else
      MutableMemory s -> StateT (VM t s) (ST s) (MutableMemory s)
forall a. a -> StateT (VM t s) (ST s) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MutableMemory s
memory

freezeMemory :: MutableMemory s -> EVM t s (Expr Buf)
freezeMemory :: forall s (t :: VMType). MutableMemory s -> EVM t s (Expr 'Buf)
freezeMemory MutableMemory s
memory =
  ByteString -> Expr 'Buf
ConcreteBuf (ByteString -> Expr 'Buf)
-> (Vector Word8 -> ByteString) -> Vector Word8 -> Expr 'Buf
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
BS.pack ([Word8] -> ByteString)
-> (Vector Word8 -> [Word8]) -> Vector Word8 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Word8 -> [Word8]
forall a. Unbox a => Vector a -> [a]
VUnboxed.toList (Vector Word8 -> Expr 'Buf)
-> StateT (VM t s) (ST s) (Vector Word8)
-> StateT (VM t s) (ST s) (Expr 'Buf)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVector (PrimState (StateT (VM t s) (ST s))) Word8
-> StateT (VM t s) (ST s) (Vector Word8)
forall a (m :: * -> *).
(Unbox a, PrimMonad m) =>
MVector (PrimState m) a -> m (Vector a)
VUnboxed.freeze MutableMemory s
MVector (PrimState (StateT (VM t s) (ST s))) Word8
memory


instance VMOps Symbolic where
  burn' :: forall s. Gas 'Symbolic -> EVM 'Symbolic s () -> EVM 'Symbolic s ()
burn' Gas 'Symbolic
_ EVM 'Symbolic s ()
continue = EVM 'Symbolic s ()
continue
  burnExp :: forall s. Expr 'EWord -> EVM 'Symbolic s () -> EVM 'Symbolic s ()
burnExp Expr 'EWord
_ EVM 'Symbolic s ()
continue = EVM 'Symbolic s ()
continue
  burnSha3 :: forall s. Expr 'EWord -> EVM 'Symbolic s () -> EVM 'Symbolic s ()
burnSha3 Expr 'EWord
_ EVM 'Symbolic s ()
continue = EVM 'Symbolic s ()
continue
  burnCalldatacopy :: forall s. Expr 'EWord -> EVM 'Symbolic s () -> EVM 'Symbolic s ()
burnCalldatacopy Expr 'EWord
_ EVM 'Symbolic s ()
continue = EVM 'Symbolic s ()
continue
  burnCodecopy :: forall s. Expr 'EWord -> EVM 'Symbolic s () -> EVM 'Symbolic s ()
burnCodecopy Expr 'EWord
_ EVM 'Symbolic s ()
continue = EVM 'Symbolic s ()
continue
  burnExtcodecopy :: forall s.
Expr 'EAddr
-> Expr 'EWord -> EVM 'Symbolic s () -> EVM 'Symbolic s ()
burnExtcodecopy Expr 'EAddr
_ Expr 'EWord
_ EVM 'Symbolic s ()
continue = EVM 'Symbolic s ()
continue
  burnReturndatacopy :: forall s. Expr 'EWord -> EVM 'Symbolic s () -> EVM 'Symbolic s ()
burnReturndatacopy Expr 'EWord
_ EVM 'Symbolic s ()
continue = EVM 'Symbolic s ()
continue
  burnLog :: forall s.
Expr 'EWord -> Word8 -> EVM 'Symbolic s () -> EVM 'Symbolic s ()
burnLog Expr 'EWord
_ Word8
_ EVM 'Symbolic s ()
continue = EVM 'Symbolic s ()
continue

  initialGas :: Gas 'Symbolic
initialGas = ()
  ensureGas :: forall s. Word64 -> EVM 'Symbolic s () -> EVM 'Symbolic s ()
ensureGas Word64
_ EVM 'Symbolic s ()
continue = EVM 'Symbolic s ()
continue
  gasTryFrom :: Expr 'EWord -> Either () (Gas 'Symbolic)
gasTryFrom Expr 'EWord
_ = () -> Either () ()
forall a b. b -> Either a b
Right ()
  costOfCreate :: FeeSchedule Word64
-> Gas 'Symbolic
-> Expr 'EWord
-> Bool
-> (Gas 'Symbolic, Gas 'Symbolic)
costOfCreate FeeSchedule Word64
_ Gas 'Symbolic
_ Expr 'EWord
_ Bool
_ = ((), ())
  costOfCall :: forall s.
FeeSchedule Word64
-> Bool
-> Expr 'EWord
-> Gas 'Symbolic
-> Gas 'Symbolic
-> Expr 'EAddr
-> (Word64 -> Word64 -> EVM 'Symbolic s ())
-> EVM 'Symbolic s ()
costOfCall FeeSchedule Word64
_ Bool
_ Expr 'EWord
_ Gas 'Symbolic
_ Gas 'Symbolic
_ Expr 'EAddr
_ Word64 -> Word64 -> EVM 'Symbolic s ()
continue = Word64 -> Word64 -> EVM 'Symbolic s ()
continue Word64
0 Word64
0
  reclaimRemainingGasAllowance :: forall s. VM 'Symbolic s -> EVM 'Symbolic s ()
reclaimRemainingGasAllowance VM 'Symbolic s
_ = () -> StateT (VM 'Symbolic s) (ST s) ()
forall a. a -> StateT (VM 'Symbolic s) (ST s) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  payRefunds :: forall s. EVM 'Symbolic s ()
payRefunds = () -> StateT (VM 'Symbolic s) (ST s) ()
forall a. a -> StateT (VM 'Symbolic s) (ST s) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  pushGas :: forall s. EVM 'Symbolic s ()
pushGas = do
    Optic A_Lens '[] (VM 'Symbolic s) (VM 'Symbolic s) Int Int
-> (Int -> Int) -> EVM 'Symbolic s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying (Optic A_Lens '[] (VM 'Symbolic s) (VM 'Symbolic s) Env Env
#env Optic A_Lens '[] (VM 'Symbolic s) (VM 'Symbolic s) Env Env
-> Optic A_Lens '[] Env Env Int Int
-> Optic A_Lens '[] (VM 'Symbolic s) (VM 'Symbolic s) Int Int
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens '[] Env Env Int Int
#freshGasVals) (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    Int
n <- Optic A_Lens '[] (VM 'Symbolic s) (VM 'Symbolic s) Int Int
-> StateT (VM 'Symbolic s) (ST s) Int
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic A_Lens '[] (VM 'Symbolic s) (VM 'Symbolic s) Env Env
#env Optic A_Lens '[] (VM 'Symbolic s) (VM 'Symbolic s) Env Env
-> Optic A_Lens '[] Env Env Int Int
-> Optic A_Lens '[] (VM 'Symbolic s) (VM 'Symbolic s) Int Int
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens '[] Env Env Int Int
#freshGasVals)
    Expr 'EWord -> EVM 'Symbolic s ()
forall (t :: VMType) s. Expr 'EWord -> EVM t s ()
pushSym (Expr 'EWord -> EVM 'Symbolic s ())
-> Expr 'EWord -> EVM 'Symbolic s ()
forall a b. (a -> b) -> a -> b
$ Int -> Expr 'EWord
Expr.Gas Int
n
  enoughGas :: Word64 -> Gas 'Symbolic -> Bool
enoughGas Word64
_ Gas 'Symbolic
_ = Bool
True
  subGas :: Gas 'Symbolic -> Word64 -> Gas 'Symbolic
subGas Gas 'Symbolic
_ Word64
_ = ()
  toGas :: Word64 -> Gas 'Symbolic
toGas Word64
_ = ()
  whenSymbolicElse :: forall s a.
EVM 'Symbolic s a -> EVM 'Symbolic s a -> EVM 'Symbolic s a
whenSymbolicElse EVM 'Symbolic s a
a EVM 'Symbolic s a
_ = EVM 'Symbolic s a
a

  partial :: forall s. PartialExec -> EVM 'Symbolic s ()
partial PartialExec
e = Optic
  A_Lens
  '[]
  (VM 'Symbolic s)
  (VM 'Symbolic s)
  (Maybe (VMResult 'Symbolic s))
  (Maybe (VMResult 'Symbolic s))
-> Maybe (VMResult 'Symbolic s)
-> StateT (VM 'Symbolic s) (ST s) ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign Optic
  A_Lens
  '[]
  (VM 'Symbolic s)
  (VM 'Symbolic s)
  (Maybe (VMResult 'Symbolic s))
  (Maybe (VMResult 'Symbolic s))
#result (VMResult 'Symbolic s -> Maybe (VMResult 'Symbolic s)
forall a. a -> Maybe a
Just (PartialExec -> VMResult 'Symbolic s
forall s. PartialExec -> VMResult 'Symbolic s
Unfinished PartialExec
e))
  branch :: forall s.
Expr 'EWord -> (Bool -> EVM 'Symbolic s ()) -> EVM 'Symbolic s ()
branch Expr 'EWord
cond Bool -> EVM 'Symbolic s ()
continue = do
    CodeLocation
loc <- EVM 'Symbolic s CodeLocation
forall (t :: VMType) s. EVM t s CodeLocation
codeloc
    [Prop]
pathconds <- Lens (VM 'Symbolic s) (VM 'Symbolic s) [Prop] [Prop]
-> StateT (VM 'Symbolic s) (ST s) [Prop]
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use Lens (VM 'Symbolic s) (VM 'Symbolic s) [Prop] [Prop]
#constraints
    Query 'Symbolic s -> EVM 'Symbolic s ()
forall (t :: VMType) s. Query t s -> EVM t s ()
query (Query 'Symbolic s -> EVM 'Symbolic s ())
-> Query 'Symbolic s -> EVM 'Symbolic s ()
forall a b. (a -> b) -> a -> b
$ Expr 'EWord
-> [Prop]
-> (BranchCondition -> EVM 'Symbolic s ())
-> Query 'Symbolic s
forall s.
Expr 'EWord
-> [Prop]
-> (BranchCondition -> EVM 'Symbolic s ())
-> Query 'Symbolic s
PleaseAskSMT Expr 'EWord
cond [Prop]
pathconds (CodeLocation -> BranchCondition -> EVM 'Symbolic s ()
choosePath CodeLocation
loc)
    where
      condSimp :: Expr 'EWord
condSimp = Expr 'EWord -> Expr 'EWord
forall (a :: EType). Expr a -> Expr a
Expr.simplify Expr 'EWord
cond
      condSimpConc :: Expr 'EWord
condSimpConc = Expr 'EWord -> Expr 'EWord
forall (a :: EType). Expr a -> Expr a
Expr.concKeccakSimpExpr Expr 'EWord
condSimp
      choosePath :: CodeLocation -> BranchCondition -> EVM 'Symbolic s ()
choosePath CodeLocation
loc (Case Bool
v) = do
        Optic
  A_Lens
  '[]
  (VM 'Symbolic s)
  (VM 'Symbolic s)
  (Maybe (VMResult 'Symbolic s))
  (Maybe (VMResult 'Symbolic s))
-> Maybe (VMResult 'Symbolic s) -> EVM 'Symbolic s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign Optic
  A_Lens
  '[]
  (VM 'Symbolic s)
  (VM 'Symbolic s)
  (Maybe (VMResult 'Symbolic s))
  (Maybe (VMResult 'Symbolic s))
#result Maybe (VMResult 'Symbolic s)
forall a. Maybe a
Nothing
        Lens (VM 'Symbolic s) (VM 'Symbolic s) [Prop] [Prop]
-> Prop -> EVM 'Symbolic s ()
forall s (m :: * -> *) a.
MonadState s m =>
Lens s s [a] [a] -> a -> m ()
pushTo Lens (VM 'Symbolic s) (VM 'Symbolic s) [Prop] [Prop]
#constraints (Prop -> EVM 'Symbolic s ()) -> Prop -> EVM 'Symbolic s ()
forall a b. (a -> b) -> a -> b
$ if Bool
v then Prop -> Prop
Expr.simplifyProp (Expr 'EWord
condSimpConc Expr 'EWord -> Expr 'EWord -> Prop
forall (a :: EType). Typeable a => Expr a -> Expr a -> Prop
./= W256 -> Expr 'EWord
Lit W256
0)
                                   else Prop -> Prop
Expr.simplifyProp (Expr 'EWord
condSimpConc Expr 'EWord -> Expr 'EWord -> Prop
forall (a :: EType). Typeable a => Expr a -> Expr a -> Prop
.== W256 -> Expr 'EWord
Lit W256
0)
        (Int
iteration, [Expr 'EWord]
_) <- Optic' A_Lens '[] (VM 'Symbolic s) (Int, [Expr 'EWord])
-> StateT (VM 'Symbolic s) (ST s) (Int, [Expr 'EWord])
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic
  A_Lens
  '[]
  (VM 'Symbolic s)
  (VM 'Symbolic s)
  (Map CodeLocation (Int, [Expr 'EWord]))
  (Map CodeLocation (Int, [Expr 'EWord]))
#iterations Optic
  A_Lens
  '[]
  (VM 'Symbolic s)
  (VM 'Symbolic s)
  (Map CodeLocation (Int, [Expr 'EWord]))
  (Map CodeLocation (Int, [Expr 'EWord]))
-> Optic
     A_Lens
     '[]
     (Map CodeLocation (Int, [Expr 'EWord]))
     (Map CodeLocation (Int, [Expr 'EWord]))
     (Maybe (Int, [Expr 'EWord]))
     (Maybe (Int, [Expr 'EWord]))
-> Optic
     A_Lens
     '[]
     (VM 'Symbolic s)
     (VM 'Symbolic s)
     (Maybe (Int, [Expr 'EWord]))
     (Maybe (Int, [Expr 'EWord]))
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Index (Map CodeLocation (Int, [Expr 'EWord]))
-> Lens'
     (Map CodeLocation (Int, [Expr 'EWord]))
     (Maybe (IxValue (Map CodeLocation (Int, [Expr 'EWord]))))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at CodeLocation
Index (Map CodeLocation (Int, [Expr 'EWord]))
loc Optic
  A_Lens
  '[]
  (VM 'Symbolic s)
  (VM 'Symbolic s)
  (Maybe (Int, [Expr 'EWord]))
  (Maybe (Int, [Expr 'EWord]))
-> Optic
     An_Iso
     '[]
     (Maybe (Int, [Expr 'EWord]))
     (Maybe (Int, [Expr 'EWord]))
     (Int, [Expr 'EWord])
     (Int, [Expr 'EWord])
-> Optic' A_Lens '[] (VM 'Symbolic s) (Int, [Expr 'EWord])
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% (Int, [Expr 'EWord])
-> Optic
     An_Iso
     '[]
     (Maybe (Int, [Expr 'EWord]))
     (Maybe (Int, [Expr 'EWord]))
     (Int, [Expr 'EWord])
     (Int, [Expr 'EWord])
forall a. Eq a => a -> Iso' (Maybe a) a
non (Int
0,[]))
        [Expr 'EWord]
stack <- Optic' A_Lens '[] (VM 'Symbolic s) [Expr 'EWord]
-> StateT (VM 'Symbolic s) (ST s) [Expr 'EWord]
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic
  A_Lens
  '[]
  (VM 'Symbolic s)
  (VM 'Symbolic s)
  (FrameState 'Symbolic s)
  (FrameState 'Symbolic s)
#state Optic
  A_Lens
  '[]
  (VM 'Symbolic s)
  (VM 'Symbolic s)
  (FrameState 'Symbolic s)
  (FrameState 'Symbolic s)
-> Optic
     A_Lens
     '[]
     (FrameState 'Symbolic s)
     (FrameState 'Symbolic s)
     [Expr 'EWord]
     [Expr 'EWord]
-> Optic' A_Lens '[] (VM 'Symbolic s) [Expr 'EWord]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState 'Symbolic s)
  (FrameState 'Symbolic s)
  [Expr 'EWord]
  [Expr 'EWord]
#stack)
        Optic
  A_Lens
  '[]
  (VM 'Symbolic s)
  (VM 'Symbolic s)
  (Maybe (IxValue (Map (CodeLocation, Int) Bool)))
  (Maybe Bool)
-> Maybe Bool -> EVM 'Symbolic s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic A_Lens '[] (VM 'Symbolic s) (VM 'Symbolic s) Cache Cache
#cache Optic A_Lens '[] (VM 'Symbolic s) (VM 'Symbolic s) Cache Cache
-> Optic
     A_Lens
     '[]
     Cache
     Cache
     (Map (CodeLocation, Int) Bool)
     (Map (CodeLocation, Int) Bool)
-> Optic
     A_Lens
     '[]
     (VM 'Symbolic s)
     (VM 'Symbolic s)
     (Map (CodeLocation, Int) Bool)
     (Map (CodeLocation, Int) Bool)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  Cache
  Cache
  (Map (CodeLocation, Int) Bool)
  (Map (CodeLocation, Int) Bool)
#path Optic
  A_Lens
  '[]
  (VM 'Symbolic s)
  (VM 'Symbolic s)
  (Map (CodeLocation, Int) Bool)
  (Map (CodeLocation, Int) Bool)
-> Optic
     A_Lens
     '[]
     (Map (CodeLocation, Int) Bool)
     (Map (CodeLocation, Int) Bool)
     (Maybe (IxValue (Map (CodeLocation, Int) Bool)))
     (Maybe Bool)
-> Optic
     A_Lens
     '[]
     (VM 'Symbolic s)
     (VM 'Symbolic s)
     (Maybe (IxValue (Map (CodeLocation, Int) Bool)))
     (Maybe Bool)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Index (Map (CodeLocation, Int) Bool)
-> Lens'
     (Map (CodeLocation, Int) Bool)
     (Maybe (IxValue (Map (CodeLocation, Int) Bool)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at (CodeLocation
loc, Int
iteration)) (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
v)
        Optic
  A_Lens
  '[]
  (VM 'Symbolic s)
  (VM 'Symbolic s)
  (Maybe (IxValue (Map CodeLocation (Int, [Expr 'EWord]))))
  (Maybe (Int, [Expr 'EWord]))
-> Maybe (Int, [Expr 'EWord]) -> EVM 'Symbolic s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> b -> m ()
assign (Optic
  A_Lens
  '[]
  (VM 'Symbolic s)
  (VM 'Symbolic s)
  (Map CodeLocation (Int, [Expr 'EWord]))
  (Map CodeLocation (Int, [Expr 'EWord]))
#iterations Optic
  A_Lens
  '[]
  (VM 'Symbolic s)
  (VM 'Symbolic s)
  (Map CodeLocation (Int, [Expr 'EWord]))
  (Map CodeLocation (Int, [Expr 'EWord]))
-> Optic
     A_Lens
     '[]
     (Map CodeLocation (Int, [Expr 'EWord]))
     (Map CodeLocation (Int, [Expr 'EWord]))
     (Maybe (IxValue (Map CodeLocation (Int, [Expr 'EWord]))))
     (Maybe (Int, [Expr 'EWord]))
-> Optic
     A_Lens
     '[]
     (VM 'Symbolic s)
     (VM 'Symbolic s)
     (Maybe (IxValue (Map CodeLocation (Int, [Expr 'EWord]))))
     (Maybe (Int, [Expr 'EWord]))
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Index (Map CodeLocation (Int, [Expr 'EWord]))
-> Lens'
     (Map CodeLocation (Int, [Expr 'EWord]))
     (Maybe (IxValue (Map CodeLocation (Int, [Expr 'EWord]))))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at CodeLocation
Index (Map CodeLocation (Int, [Expr 'EWord]))
loc) ((Int, [Expr 'EWord]) -> Maybe (Int, [Expr 'EWord])
forall a. a -> Maybe a
Just (Int
iteration Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, [Expr 'EWord]
stack))
        Bool -> EVM 'Symbolic s ()
continue Bool
v
      -- Both paths are possible; we ask for more input
      choosePath CodeLocation
loc BranchCondition
Unknown =
        Choose s -> EVM 'Symbolic s ()
forall s. Choose s -> EVM 'Symbolic s ()
choose (Choose s -> EVM 'Symbolic s ())
-> ((Bool -> EVM 'Symbolic s ()) -> Choose s)
-> (Bool -> EVM 'Symbolic s ())
-> EVM 'Symbolic s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr 'EWord -> (Bool -> EVM 'Symbolic s ()) -> Choose s
forall s. Expr 'EWord -> (Bool -> EVM 'Symbolic s ()) -> Choose s
PleaseChoosePath Expr 'EWord
condSimp ((Bool -> EVM 'Symbolic s ()) -> EVM 'Symbolic s ())
-> (Bool -> EVM 'Symbolic s ()) -> EVM 'Symbolic s ()
forall a b. (a -> b) -> a -> b
$ CodeLocation -> BranchCondition -> EVM 'Symbolic s ()
choosePath CodeLocation
loc (BranchCondition -> EVM 'Symbolic s ())
-> (Bool -> BranchCondition) -> Bool -> EVM 'Symbolic s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> BranchCondition
Case

instance VMOps Concrete where
  burn' :: forall s. Gas 'Concrete -> EVM 'Concrete s () -> EVM 'Concrete s ()
burn' Gas 'Concrete
n EVM 'Concrete s ()
continue = do
    Word64
available <- Optic A_Lens '[] (VM 'Concrete s) (VM 'Concrete s) Word64 Word64
-> StateT (VM 'Concrete s) (ST s) Word64
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic
  A_Lens
  '[]
  (VM 'Concrete s)
  (VM 'Concrete s)
  (FrameState 'Concrete s)
  (FrameState 'Concrete s)
#state Optic
  A_Lens
  '[]
  (VM 'Concrete s)
  (VM 'Concrete s)
  (FrameState 'Concrete s)
  (FrameState 'Concrete s)
-> Optic
     A_Lens
     '[]
     (FrameState 'Concrete s)
     (FrameState 'Concrete s)
     Word64
     Word64
-> Optic A_Lens '[] (VM 'Concrete s) (VM 'Concrete s) Word64 Word64
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState 'Concrete s)
  (FrameState 'Concrete s)
  Word64
  Word64
#gas)
    if Word64
Gas 'Concrete
n Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64
available
      then do
        #state % #gas %= (subtract n)
        #burned %= (+ n)
        continue
      else
        EvmError -> EVM 'Concrete s ()
forall (t :: VMType) s. VMOps t => EvmError -> EVM t s ()
vmError (Word64 -> Word64 -> EvmError
OutOfGas Word64
available Word64
Gas 'Concrete
n)

  burnExp :: forall s. Expr 'EWord -> EVM 'Concrete s () -> EVM 'Concrete s ()
burnExp (Expr 'EWord -> W256
forceLit -> W256
exponent) EVM 'Concrete s ()
continue = do
    FeeSchedule {Word64
$sel:g_zero:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_base:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_verylow:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_low:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_mid:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_high:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_extcode:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_balance:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sload:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_jumpdest:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sset:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sreset:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:r_sclear:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_selfdestruct:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_selfdestruct_newaccount:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:r_selfdestruct:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_create:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_codedeposit:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_call:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_callvalue:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_callstipend:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_newaccount:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_exp:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_expbyte:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_memory:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_txcreate:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_txdatazero:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_txdatanonzero:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_transaction:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_log:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_logdata:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_logtopic:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sha3:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sha3word:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_initcodeword:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_copy:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_blockhash:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_extcodehash:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_quaddivisor:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_ecadd:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_ecmul:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_pairing_point:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_pairing_base:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_fround:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:r_block:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_cold_sload:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_cold_account_access:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_warm_storage_read:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_access_list_address:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_access_list_storage_key:FeeSchedule :: forall n. FeeSchedule n -> n
g_zero :: Word64
g_base :: Word64
g_verylow :: Word64
g_low :: Word64
g_mid :: Word64
g_high :: Word64
g_extcode :: Word64
g_balance :: Word64
g_sload :: Word64
g_jumpdest :: Word64
g_sset :: Word64
g_sreset :: Word64
r_sclear :: Word64
g_selfdestruct :: Word64
g_selfdestruct_newaccount :: Word64
r_selfdestruct :: Word64
g_create :: Word64
g_codedeposit :: Word64
g_call :: Word64
g_callvalue :: Word64
g_callstipend :: Word64
g_newaccount :: Word64
g_exp :: Word64
g_expbyte :: Word64
g_memory :: Word64
g_txcreate :: Word64
g_txdatazero :: Word64
g_txdatanonzero :: Word64
g_transaction :: Word64
g_log :: Word64
g_logdata :: Word64
g_logtopic :: Word64
g_sha3 :: Word64
g_sha3word :: Word64
g_initcodeword :: Word64
g_copy :: Word64
g_blockhash :: Word64
g_extcodehash :: Word64
g_quaddivisor :: Word64
g_ecadd :: Word64
g_ecmul :: Word64
g_pairing_point :: Word64
g_pairing_base :: Word64
g_fround :: Word64
r_block :: Word64
g_cold_sload :: Word64
g_cold_account_access :: Word64
g_warm_storage_read :: Word64
g_access_list_address :: Word64
g_access_list_storage_key :: Word64
..} <- (VM 'Concrete s -> FeeSchedule Word64)
-> StateT (VM 'Concrete s) (ST s) (FeeSchedule Word64)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (.block.schedule)
    let cost :: Word64
cost = if W256
exponent W256 -> W256 -> Bool
forall a. Eq a => a -> a -> Bool
== W256
0
          then Word64
g_exp
          else Word64
g_exp Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
g_expbyte Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Int -> Word64
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto (Int -> Int -> Int
forall a. (Num a, Integral a) => a -> a -> a
ceilDiv (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ W256 -> Int
forall b. FiniteBits b => b -> Int
log2 W256
exponent) Int
8)
    Word64 -> EVM 'Concrete s () -> EVM 'Concrete s ()
forall (t :: VMType) s.
VMOps t =>
Word64 -> EVM t s () -> EVM t s ()
burn Word64
cost EVM 'Concrete s ()
continue

  burnSha3 :: forall s. Expr 'EWord -> EVM 'Concrete s () -> EVM 'Concrete s ()
burnSha3 (Expr 'EWord -> W256
forceLit -> W256
xSize) EVM 'Concrete s ()
continue = do
    FeeSchedule {Word64
$sel:g_zero:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_base:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_verylow:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_low:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_mid:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_high:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_extcode:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_balance:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sload:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_jumpdest:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sset:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sreset:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:r_sclear:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_selfdestruct:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_selfdestruct_newaccount:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:r_selfdestruct:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_create:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_codedeposit:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_call:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_callvalue:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_callstipend:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_newaccount:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_exp:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_expbyte:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_memory:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_txcreate:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_txdatazero:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_txdatanonzero:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_transaction:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_log:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_logdata:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_logtopic:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sha3:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sha3word:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_initcodeword:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_copy:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_blockhash:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_extcodehash:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_quaddivisor:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_ecadd:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_ecmul:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_pairing_point:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_pairing_base:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_fround:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:r_block:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_cold_sload:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_cold_account_access:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_warm_storage_read:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_access_list_address:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_access_list_storage_key:FeeSchedule :: forall n. FeeSchedule n -> n
g_zero :: Word64
g_base :: Word64
g_verylow :: Word64
g_low :: Word64
g_mid :: Word64
g_high :: Word64
g_extcode :: Word64
g_balance :: Word64
g_sload :: Word64
g_jumpdest :: Word64
g_sset :: Word64
g_sreset :: Word64
r_sclear :: Word64
g_selfdestruct :: Word64
g_selfdestruct_newaccount :: Word64
r_selfdestruct :: Word64
g_create :: Word64
g_codedeposit :: Word64
g_call :: Word64
g_callvalue :: Word64
g_callstipend :: Word64
g_newaccount :: Word64
g_exp :: Word64
g_expbyte :: Word64
g_memory :: Word64
g_txcreate :: Word64
g_txdatazero :: Word64
g_txdatanonzero :: Word64
g_transaction :: Word64
g_log :: Word64
g_logdata :: Word64
g_logtopic :: Word64
g_sha3 :: Word64
g_sha3word :: Word64
g_initcodeword :: Word64
g_copy :: Word64
g_blockhash :: Word64
g_extcodehash :: Word64
g_quaddivisor :: Word64
g_ecadd :: Word64
g_ecmul :: Word64
g_pairing_point :: Word64
g_pairing_base :: Word64
g_fround :: Word64
r_block :: Word64
g_cold_sload :: Word64
g_cold_account_access :: Word64
g_warm_storage_read :: Word64
g_access_list_address :: Word64
g_access_list_storage_key :: Word64
..} <- (VM 'Concrete s -> FeeSchedule Word64)
-> StateT (VM 'Concrete s) (ST s) (FeeSchedule Word64)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (.block.schedule)
    Word64 -> EVM 'Concrete s () -> EVM 'Concrete s ()
forall (t :: VMType) s.
VMOps t =>
Word64 -> EVM t s () -> EVM t s ()
burn (Word64
g_sha3 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
g_sha3word Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64 -> Word64 -> Word64
forall a. (Num a, Integral a) => a -> a -> a
ceilDiv (W256 -> Word64
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto W256
xSize) Word64
32) EVM 'Concrete s ()
continue

  burnCalldatacopy :: forall s. Expr 'EWord -> EVM 'Concrete s () -> EVM 'Concrete s ()
burnCalldatacopy (Expr 'EWord -> W256
forceLit -> W256
xSize) EVM 'Concrete s ()
continue = do
    FeeSchedule {Word64
$sel:g_zero:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_base:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_verylow:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_low:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_mid:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_high:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_extcode:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_balance:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sload:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_jumpdest:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sset:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sreset:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:r_sclear:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_selfdestruct:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_selfdestruct_newaccount:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:r_selfdestruct:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_create:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_codedeposit:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_call:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_callvalue:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_callstipend:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_newaccount:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_exp:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_expbyte:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_memory:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_txcreate:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_txdatazero:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_txdatanonzero:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_transaction:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_log:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_logdata:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_logtopic:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sha3:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sha3word:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_initcodeword:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_copy:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_blockhash:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_extcodehash:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_quaddivisor:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_ecadd:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_ecmul:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_pairing_point:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_pairing_base:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_fround:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:r_block:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_cold_sload:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_cold_account_access:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_warm_storage_read:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_access_list_address:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_access_list_storage_key:FeeSchedule :: forall n. FeeSchedule n -> n
g_zero :: Word64
g_base :: Word64
g_verylow :: Word64
g_low :: Word64
g_mid :: Word64
g_high :: Word64
g_extcode :: Word64
g_balance :: Word64
g_sload :: Word64
g_jumpdest :: Word64
g_sset :: Word64
g_sreset :: Word64
r_sclear :: Word64
g_selfdestruct :: Word64
g_selfdestruct_newaccount :: Word64
r_selfdestruct :: Word64
g_create :: Word64
g_codedeposit :: Word64
g_call :: Word64
g_callvalue :: Word64
g_callstipend :: Word64
g_newaccount :: Word64
g_exp :: Word64
g_expbyte :: Word64
g_memory :: Word64
g_txcreate :: Word64
g_txdatazero :: Word64
g_txdatanonzero :: Word64
g_transaction :: Word64
g_log :: Word64
g_logdata :: Word64
g_logtopic :: Word64
g_sha3 :: Word64
g_sha3word :: Word64
g_initcodeword :: Word64
g_copy :: Word64
g_blockhash :: Word64
g_extcodehash :: Word64
g_quaddivisor :: Word64
g_ecadd :: Word64
g_ecmul :: Word64
g_pairing_point :: Word64
g_pairing_base :: Word64
g_fround :: Word64
r_block :: Word64
g_cold_sload :: Word64
g_cold_account_access :: Word64
g_warm_storage_read :: Word64
g_access_list_address :: Word64
g_access_list_storage_key :: Word64
..} <- (VM 'Concrete s -> FeeSchedule Word64)
-> StateT (VM 'Concrete s) (ST s) (FeeSchedule Word64)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (.block.schedule)
    Word64 -> EVM 'Concrete s () -> EVM 'Concrete s ()
forall (t :: VMType) s.
VMOps t =>
Word64 -> EVM t s () -> EVM t s ()
burn (Word64
g_verylow Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
g_copy Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64 -> Word64 -> Word64
forall a. (Num a, Integral a) => a -> a -> a
ceilDiv (W256 -> Word64
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto W256
xSize) Word64
32) EVM 'Concrete s ()
continue

  burnCodecopy :: forall s. Expr 'EWord -> EVM 'Concrete s () -> EVM 'Concrete s ()
burnCodecopy (Expr 'EWord -> W256
forceLit -> W256
n) EVM 'Concrete s ()
continue =
    case W256 -> Either (TryFromException W256 Word64) Word64
forall source target.
TryFrom source target =>
source -> Either (TryFromException source target) target
tryFrom W256
n of
      Left TryFromException W256 Word64
_ -> EvmError -> EVM 'Concrete s ()
forall (t :: VMType) s. VMOps t => EvmError -> EVM t s ()
vmError EvmError
IllegalOverflow
      Right Word64
n' -> do
        FeeSchedule {Word64
$sel:g_zero:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_base:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_verylow:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_low:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_mid:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_high:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_extcode:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_balance:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sload:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_jumpdest:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sset:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sreset:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:r_sclear:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_selfdestruct:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_selfdestruct_newaccount:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:r_selfdestruct:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_create:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_codedeposit:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_call:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_callvalue:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_callstipend:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_newaccount:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_exp:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_expbyte:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_memory:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_txcreate:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_txdatazero:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_txdatanonzero:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_transaction:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_log:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_logdata:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_logtopic:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sha3:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sha3word:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_initcodeword:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_copy:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_blockhash:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_extcodehash:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_quaddivisor:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_ecadd:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_ecmul:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_pairing_point:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_pairing_base:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_fround:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:r_block:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_cold_sload:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_cold_account_access:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_warm_storage_read:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_access_list_address:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_access_list_storage_key:FeeSchedule :: forall n. FeeSchedule n -> n
g_zero :: Word64
g_base :: Word64
g_verylow :: Word64
g_low :: Word64
g_mid :: Word64
g_high :: Word64
g_extcode :: Word64
g_balance :: Word64
g_sload :: Word64
g_jumpdest :: Word64
g_sset :: Word64
g_sreset :: Word64
r_sclear :: Word64
g_selfdestruct :: Word64
g_selfdestruct_newaccount :: Word64
r_selfdestruct :: Word64
g_create :: Word64
g_codedeposit :: Word64
g_call :: Word64
g_callvalue :: Word64
g_callstipend :: Word64
g_newaccount :: Word64
g_exp :: Word64
g_expbyte :: Word64
g_memory :: Word64
g_txcreate :: Word64
g_txdatazero :: Word64
g_txdatanonzero :: Word64
g_transaction :: Word64
g_log :: Word64
g_logdata :: Word64
g_logtopic :: Word64
g_sha3 :: Word64
g_sha3word :: Word64
g_initcodeword :: Word64
g_copy :: Word64
g_blockhash :: Word64
g_extcodehash :: Word64
g_quaddivisor :: Word64
g_ecadd :: Word64
g_ecmul :: Word64
g_pairing_point :: Word64
g_pairing_base :: Word64
g_fround :: Word64
r_block :: Word64
g_cold_sload :: Word64
g_cold_account_access :: Word64
g_warm_storage_read :: Word64
g_access_list_address :: Word64
g_access_list_storage_key :: Word64
..} <- (VM 'Concrete s -> FeeSchedule Word64)
-> StateT (VM 'Concrete s) (ST s) (FeeSchedule Word64)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (.block.schedule)
        if Word64
n' Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= ( (Word64
forall a. Bounded a => a
maxBound :: Word64) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
g_verylow ) Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`div` Word64
g_copy Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
32 then
          Word64 -> EVM 'Concrete s () -> EVM 'Concrete s ()
forall (t :: VMType) s.
VMOps t =>
Word64 -> EVM t s () -> EVM t s ()
burn (Word64
g_verylow Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
g_copy Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64 -> Word64 -> Word64
forall a. (Num a, Integral a) => a -> a -> a
ceilDiv (W256 -> Word64
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto W256
n) Word64
32) EVM 'Concrete s ()
continue
        else EvmError -> EVM 'Concrete s ()
forall (t :: VMType) s. VMOps t => EvmError -> EVM t s ()
vmError EvmError
IllegalOverflow

  burnExtcodecopy :: forall s.
Expr 'EAddr
-> Expr 'EWord -> EVM 'Concrete s () -> EVM 'Concrete s ()
burnExtcodecopy Expr 'EAddr
extAccount (Expr 'EWord -> W256
forceLit -> W256
codeSize) EVM 'Concrete s ()
continue = do
    FeeSchedule {Word64
$sel:g_zero:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_base:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_verylow:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_low:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_mid:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_high:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_extcode:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_balance:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sload:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_jumpdest:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sset:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sreset:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:r_sclear:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_selfdestruct:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_selfdestruct_newaccount:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:r_selfdestruct:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_create:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_codedeposit:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_call:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_callvalue:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_callstipend:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_newaccount:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_exp:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_expbyte:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_memory:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_txcreate:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_txdatazero:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_txdatanonzero:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_transaction:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_log:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_logdata:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_logtopic:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sha3:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sha3word:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_initcodeword:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_copy:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_blockhash:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_extcodehash:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_quaddivisor:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_ecadd:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_ecmul:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_pairing_point:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_pairing_base:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_fround:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:r_block:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_cold_sload:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_cold_account_access:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_warm_storage_read:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_access_list_address:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_access_list_storage_key:FeeSchedule :: forall n. FeeSchedule n -> n
g_zero :: Word64
g_base :: Word64
g_verylow :: Word64
g_low :: Word64
g_mid :: Word64
g_high :: Word64
g_extcode :: Word64
g_balance :: Word64
g_sload :: Word64
g_jumpdest :: Word64
g_sset :: Word64
g_sreset :: Word64
r_sclear :: Word64
g_selfdestruct :: Word64
g_selfdestruct_newaccount :: Word64
r_selfdestruct :: Word64
g_create :: Word64
g_codedeposit :: Word64
g_call :: Word64
g_callvalue :: Word64
g_callstipend :: Word64
g_newaccount :: Word64
g_exp :: Word64
g_expbyte :: Word64
g_memory :: Word64
g_txcreate :: Word64
g_txdatazero :: Word64
g_txdatanonzero :: Word64
g_transaction :: Word64
g_log :: Word64
g_logdata :: Word64
g_logtopic :: Word64
g_sha3 :: Word64
g_sha3word :: Word64
g_initcodeword :: Word64
g_copy :: Word64
g_blockhash :: Word64
g_extcodehash :: Word64
g_quaddivisor :: Word64
g_ecadd :: Word64
g_ecmul :: Word64
g_pairing_point :: Word64
g_pairing_base :: Word64
g_fround :: Word64
r_block :: Word64
g_cold_sload :: Word64
g_cold_account_access :: Word64
g_warm_storage_read :: Word64
g_access_list_address :: Word64
g_access_list_storage_key :: Word64
..} <- (VM 'Concrete s -> FeeSchedule Word64)
-> StateT (VM 'Concrete s) (ST s) (FeeSchedule Word64)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (.block.schedule)
    Bool
acc <- Expr 'EAddr -> EVM 'Concrete s Bool
forall (t :: VMType) s. Expr 'EAddr -> EVM t s Bool
accessAccountForGas Expr 'EAddr
extAccount
    let cost :: Word64
cost = if Bool
acc then Word64
g_warm_storage_read else Word64
g_cold_account_access
    Word64 -> EVM 'Concrete s () -> EVM 'Concrete s ()
forall (t :: VMType) s.
VMOps t =>
Word64 -> EVM t s () -> EVM t s ()
burn (Word64
cost Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
g_copy Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64 -> Word64 -> Word64
forall a. (Num a, Integral a) => a -> a -> a
ceilDiv (W256 -> Word64
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto W256
codeSize) Word64
32) EVM 'Concrete s ()
continue

  burnReturndatacopy :: forall s. Expr 'EWord -> EVM 'Concrete s () -> EVM 'Concrete s ()
burnReturndatacopy (Expr 'EWord -> W256
forceLit -> W256
xSize) EVM 'Concrete s ()
continue = do
    FeeSchedule {Word64
$sel:g_zero:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_base:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_verylow:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_low:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_mid:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_high:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_extcode:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_balance:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sload:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_jumpdest:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sset:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sreset:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:r_sclear:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_selfdestruct:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_selfdestruct_newaccount:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:r_selfdestruct:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_create:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_codedeposit:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_call:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_callvalue:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_callstipend:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_newaccount:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_exp:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_expbyte:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_memory:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_txcreate:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_txdatazero:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_txdatanonzero:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_transaction:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_log:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_logdata:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_logtopic:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sha3:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sha3word:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_initcodeword:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_copy:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_blockhash:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_extcodehash:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_quaddivisor:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_ecadd:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_ecmul:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_pairing_point:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_pairing_base:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_fround:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:r_block:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_cold_sload:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_cold_account_access:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_warm_storage_read:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_access_list_address:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_access_list_storage_key:FeeSchedule :: forall n. FeeSchedule n -> n
g_zero :: Word64
g_base :: Word64
g_verylow :: Word64
g_low :: Word64
g_mid :: Word64
g_high :: Word64
g_extcode :: Word64
g_balance :: Word64
g_sload :: Word64
g_jumpdest :: Word64
g_sset :: Word64
g_sreset :: Word64
r_sclear :: Word64
g_selfdestruct :: Word64
g_selfdestruct_newaccount :: Word64
r_selfdestruct :: Word64
g_create :: Word64
g_codedeposit :: Word64
g_call :: Word64
g_callvalue :: Word64
g_callstipend :: Word64
g_newaccount :: Word64
g_exp :: Word64
g_expbyte :: Word64
g_memory :: Word64
g_txcreate :: Word64
g_txdatazero :: Word64
g_txdatanonzero :: Word64
g_transaction :: Word64
g_log :: Word64
g_logdata :: Word64
g_logtopic :: Word64
g_sha3 :: Word64
g_sha3word :: Word64
g_initcodeword :: Word64
g_copy :: Word64
g_blockhash :: Word64
g_extcodehash :: Word64
g_quaddivisor :: Word64
g_ecadd :: Word64
g_ecmul :: Word64
g_pairing_point :: Word64
g_pairing_base :: Word64
g_fround :: Word64
r_block :: Word64
g_cold_sload :: Word64
g_cold_account_access :: Word64
g_warm_storage_read :: Word64
g_access_list_address :: Word64
g_access_list_storage_key :: Word64
..} <- (VM 'Concrete s -> FeeSchedule Word64)
-> StateT (VM 'Concrete s) (ST s) (FeeSchedule Word64)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (.block.schedule)
    Word64 -> EVM 'Concrete s () -> EVM 'Concrete s ()
forall (t :: VMType) s.
VMOps t =>
Word64 -> EVM t s () -> EVM t s ()
burn (Word64
g_verylow Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
g_copy Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64 -> Word64 -> Word64
forall a. (Num a, Integral a) => a -> a -> a
ceilDiv (W256 -> Word64
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto W256
xSize) Word64
32) EVM 'Concrete s ()
continue

  burnLog :: forall s.
Expr 'EWord -> Word8 -> EVM 'Concrete s () -> EVM 'Concrete s ()
burnLog (Expr 'EWord -> W256
forceLit -> W256
xSize) Word8
n EVM 'Concrete s ()
continue = do
    case W256 -> Either (TryFromException W256 Word64) Word64
forall source target.
TryFrom source target =>
source -> Either (TryFromException source target) target
tryFrom W256
xSize of
      Right Word64
sz -> do
        FeeSchedule {Word64
$sel:g_zero:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_base:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_verylow:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_low:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_mid:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_high:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_extcode:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_balance:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sload:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_jumpdest:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sset:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sreset:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:r_sclear:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_selfdestruct:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_selfdestruct_newaccount:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:r_selfdestruct:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_create:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_codedeposit:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_call:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_callvalue:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_callstipend:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_newaccount:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_exp:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_expbyte:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_memory:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_txcreate:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_txdatazero:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_txdatanonzero:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_transaction:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_log:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_logdata:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_logtopic:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sha3:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sha3word:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_initcodeword:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_copy:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_blockhash:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_extcodehash:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_quaddivisor:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_ecadd:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_ecmul:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_pairing_point:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_pairing_base:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_fround:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:r_block:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_cold_sload:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_cold_account_access:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_warm_storage_read:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_access_list_address:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_access_list_storage_key:FeeSchedule :: forall n. FeeSchedule n -> n
g_zero :: Word64
g_base :: Word64
g_verylow :: Word64
g_low :: Word64
g_mid :: Word64
g_high :: Word64
g_extcode :: Word64
g_balance :: Word64
g_sload :: Word64
g_jumpdest :: Word64
g_sset :: Word64
g_sreset :: Word64
r_sclear :: Word64
g_selfdestruct :: Word64
g_selfdestruct_newaccount :: Word64
r_selfdestruct :: Word64
g_create :: Word64
g_codedeposit :: Word64
g_call :: Word64
g_callvalue :: Word64
g_callstipend :: Word64
g_newaccount :: Word64
g_exp :: Word64
g_expbyte :: Word64
g_memory :: Word64
g_txcreate :: Word64
g_txdatazero :: Word64
g_txdatanonzero :: Word64
g_transaction :: Word64
g_log :: Word64
g_logdata :: Word64
g_logtopic :: Word64
g_sha3 :: Word64
g_sha3word :: Word64
g_initcodeword :: Word64
g_copy :: Word64
g_blockhash :: Word64
g_extcodehash :: Word64
g_quaddivisor :: Word64
g_ecadd :: Word64
g_ecmul :: Word64
g_pairing_point :: Word64
g_pairing_base :: Word64
g_fround :: Word64
r_block :: Word64
g_cold_sload :: Word64
g_cold_account_access :: Word64
g_warm_storage_read :: Word64
g_access_list_address :: Word64
g_access_list_storage_key :: Word64
..} <- (VM 'Concrete s -> FeeSchedule Word64)
-> StateT (VM 'Concrete s) (ST s) (FeeSchedule Word64)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (.block.schedule)
        Word64 -> EVM 'Concrete s () -> EVM 'Concrete s ()
forall (t :: VMType) s.
VMOps t =>
Word64 -> EVM t s () -> EVM t s ()
burn (Word64
g_log Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
g_logdata Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
sz Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ (Word8 -> Word64
forall target source. From source target => source -> target
into Word8
n) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
g_logtopic) EVM 'Concrete s ()
continue
      Either (TryFromException W256 Word64) Word64
_ -> EvmError -> EVM 'Concrete s ()
forall (t :: VMType) s. VMOps t => EvmError -> EVM t s ()
vmError EvmError
IllegalOverflow

  initialGas :: Gas 'Concrete
initialGas = Word64
Gas 'Concrete
0

  ensureGas :: forall s. Word64 -> EVM 'Concrete s () -> EVM 'Concrete s ()
ensureGas Word64
amount EVM 'Concrete s ()
continue = do
    Word64
availableGas <- Optic' A_Lens '[] (VM 'Concrete s) Word64
-> StateT (VM 'Concrete s) (ST s) Word64
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic
  A_Lens
  '[]
  (VM 'Concrete s)
  (VM 'Concrete s)
  (FrameState 'Concrete s)
  (FrameState 'Concrete s)
#state Optic
  A_Lens
  '[]
  (VM 'Concrete s)
  (VM 'Concrete s)
  (FrameState 'Concrete s)
  (FrameState 'Concrete s)
-> Optic
     A_Lens
     '[]
     (FrameState 'Concrete s)
     (FrameState 'Concrete s)
     Word64
     Word64
-> Optic' A_Lens '[] (VM 'Concrete s) Word64
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState 'Concrete s)
  (FrameState 'Concrete s)
  Word64
  Word64
#gas)

    if Word64
availableGas Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64
amount then
      EvmError -> EVM 'Concrete s ()
forall (t :: VMType) s. VMOps t => EvmError -> EVM t s ()
vmError (Word64 -> Word64 -> EvmError
OutOfGas Word64
availableGas Word64
amount)
    else EVM 'Concrete s ()
continue

  gasTryFrom :: Expr 'EWord -> Either () (Gas 'Concrete)
gasTryFrom (Expr 'EWord -> W256
forceLit -> W256
w256) =
    case W256 -> Either (TryFromException W256 Word64) Word64
forall source target.
TryFrom source target =>
source -> Either (TryFromException source target) target
tryFrom W256
w256 of
      Left TryFromException W256 Word64
_ -> () -> Either () Word64
forall a b. a -> Either a b
Left ()
      Right Word64
a -> Word64 -> Either () Word64
forall a b. b -> Either a b
Right Word64
a

  -- Gas cost of create, including hash cost if needed
  costOfCreate :: FeeSchedule Word64
-> Gas 'Concrete
-> Expr 'EWord
-> Bool
-> (Gas 'Concrete, Gas 'Concrete)
costOfCreate (FeeSchedule {Word64
$sel:g_zero:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_base:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_verylow:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_low:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_mid:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_high:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_extcode:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_balance:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sload:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_jumpdest:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sset:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sreset:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:r_sclear:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_selfdestruct:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_selfdestruct_newaccount:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:r_selfdestruct:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_create:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_codedeposit:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_call:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_callvalue:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_callstipend:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_newaccount:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_exp:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_expbyte:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_memory:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_txcreate:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_txdatazero:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_txdatanonzero:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_transaction:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_log:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_logdata:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_logtopic:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sha3:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sha3word:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_initcodeword:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_copy:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_blockhash:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_extcodehash:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_quaddivisor:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_ecadd:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_ecmul:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_pairing_point:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_pairing_base:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_fround:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:r_block:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_cold_sload:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_cold_account_access:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_warm_storage_read:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_access_list_address:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_access_list_storage_key:FeeSchedule :: forall n. FeeSchedule n -> n
g_zero :: Word64
g_base :: Word64
g_verylow :: Word64
g_low :: Word64
g_mid :: Word64
g_high :: Word64
g_extcode :: Word64
g_balance :: Word64
g_sload :: Word64
g_jumpdest :: Word64
g_sset :: Word64
g_sreset :: Word64
r_sclear :: Word64
g_selfdestruct :: Word64
g_selfdestruct_newaccount :: Word64
r_selfdestruct :: Word64
g_create :: Word64
g_codedeposit :: Word64
g_call :: Word64
g_callvalue :: Word64
g_callstipend :: Word64
g_newaccount :: Word64
g_exp :: Word64
g_expbyte :: Word64
g_memory :: Word64
g_txcreate :: Word64
g_txdatazero :: Word64
g_txdatanonzero :: Word64
g_transaction :: Word64
g_log :: Word64
g_logdata :: Word64
g_logtopic :: Word64
g_sha3 :: Word64
g_sha3word :: Word64
g_initcodeword :: Word64
g_copy :: Word64
g_blockhash :: Word64
g_extcodehash :: Word64
g_quaddivisor :: Word64
g_ecadd :: Word64
g_ecmul :: Word64
g_pairing_point :: Word64
g_pairing_base :: Word64
g_fround :: Word64
r_block :: Word64
g_cold_sload :: Word64
g_cold_account_access :: Word64
g_warm_storage_read :: Word64
g_access_list_address :: Word64
g_access_list_storage_key :: Word64
..}) Gas 'Concrete
availableGas Expr 'EWord
size Bool
hashNeeded = (Word64
Gas 'Concrete
createCost, Word64
Gas 'Concrete
initGas)
    where
      byteCost :: Word64
byteCost   = if Bool
hashNeeded then Word64
g_sha3word Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
g_initcodeword else Word64
g_initcodeword
      createCost :: Word64
createCost = Word64
g_create Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
codeCost
      codeCost :: Word64
codeCost   = Word64
byteCost Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* (Word64 -> Word64 -> Word64
forall a. (Num a, Integral a) => a -> a -> a
ceilDiv (W256 -> Word64
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto (Expr 'EWord -> W256
forceLit Expr 'EWord
size)) Word64
32)
      initGas :: Word64
initGas    = Word64 -> Word64
forall a. (Num a, Integral a) => a -> a
allButOne64th (Word64
Gas 'Concrete
availableGas Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
createCost)

  -- Gas cost function for CALL, transliterated from the Yellow Paper.
  costOfCall :: forall s.
FeeSchedule Word64
-> Bool
-> Expr 'EWord
-> Gas 'Concrete
-> Gas 'Concrete
-> Expr 'EAddr
-> (Word64 -> Word64 -> EVM 'Concrete s ())
-> EVM 'Concrete s ()
costOfCall (FeeSchedule {Word64
$sel:g_zero:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_base:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_verylow:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_low:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_mid:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_high:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_extcode:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_balance:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sload:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_jumpdest:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sset:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sreset:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:r_sclear:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_selfdestruct:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_selfdestruct_newaccount:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:r_selfdestruct:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_create:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_codedeposit:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_call:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_callvalue:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_callstipend:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_newaccount:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_exp:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_expbyte:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_memory:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_txcreate:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_txdatazero:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_txdatanonzero:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_transaction:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_log:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_logdata:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_logtopic:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sha3:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_sha3word:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_initcodeword:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_copy:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_blockhash:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_extcodehash:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_quaddivisor:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_ecadd:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_ecmul:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_pairing_point:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_pairing_base:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_fround:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:r_block:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_cold_sload:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_cold_account_access:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_warm_storage_read:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_access_list_address:FeeSchedule :: forall n. FeeSchedule n -> n
$sel:g_access_list_storage_key:FeeSchedule :: forall n. FeeSchedule n -> n
g_zero :: Word64
g_base :: Word64
g_verylow :: Word64
g_low :: Word64
g_mid :: Word64
g_high :: Word64
g_extcode :: Word64
g_balance :: Word64
g_sload :: Word64
g_jumpdest :: Word64
g_sset :: Word64
g_sreset :: Word64
r_sclear :: Word64
g_selfdestruct :: Word64
g_selfdestruct_newaccount :: Word64
r_selfdestruct :: Word64
g_create :: Word64
g_codedeposit :: Word64
g_call :: Word64
g_callvalue :: Word64
g_callstipend :: Word64
g_newaccount :: Word64
g_exp :: Word64
g_expbyte :: Word64
g_memory :: Word64
g_txcreate :: Word64
g_txdatazero :: Word64
g_txdatanonzero :: Word64
g_transaction :: Word64
g_log :: Word64
g_logdata :: Word64
g_logtopic :: Word64
g_sha3 :: Word64
g_sha3word :: Word64
g_initcodeword :: Word64
g_copy :: Word64
g_blockhash :: Word64
g_extcodehash :: Word64
g_quaddivisor :: Word64
g_ecadd :: Word64
g_ecmul :: Word64
g_pairing_point :: Word64
g_pairing_base :: Word64
g_fround :: Word64
r_block :: Word64
g_cold_sload :: Word64
g_cold_account_access :: Word64
g_warm_storage_read :: Word64
g_access_list_address :: Word64
g_access_list_storage_key :: Word64
..}) Bool
recipientExists (Expr 'EWord -> W256
forceLit -> W256
xValue) Gas 'Concrete
availableGas Gas 'Concrete
xGas Expr 'EAddr
target Word64 -> Word64 -> EVM 'Concrete s ()
continue = do
    Bool
acc <- Expr 'EAddr -> EVM 'Concrete s Bool
forall (t :: VMType) s. Expr 'EAddr -> EVM t s Bool
accessAccountForGas Expr 'EAddr
target
    let call_base_gas :: Word64
call_base_gas = if Bool
acc then Word64
g_warm_storage_read else Word64
g_cold_account_access
        c_new :: Word64
c_new = if Bool -> Bool
not Bool
recipientExists Bool -> Bool -> Bool
&& W256
xValue W256 -> W256 -> Bool
forall a. Eq a => a -> a -> Bool
/= W256
0
              then Word64
g_newaccount
              else Word64
0
        c_xfer :: Word64
c_xfer = if W256
xValue W256 -> W256 -> Bool
forall a. Eq a => a -> a -> Bool
/= W256
0  then Word64
g_callvalue else Word64
0
        c_extra :: Word64
c_extra = Word64
call_base_gas Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
c_xfer Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
c_new
        c_gascap :: Word64
c_gascap =  if Word64
Gas 'Concrete
availableGas Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word64
c_extra
                    then Word64 -> Word64 -> Word64
forall a. Ord a => a -> a -> a
min Word64
Gas 'Concrete
xGas (Word64 -> Word64
forall a. (Num a, Integral a) => a -> a
allButOne64th (Word64
Gas 'Concrete
availableGas Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
c_extra))
                    else Word64
Gas 'Concrete
xGas
        c_callgas :: Word64
c_callgas = if W256
xValue W256 -> W256 -> Bool
forall a. Eq a => a -> a -> Bool
/= W256
0 then Word64
c_gascap Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
g_callstipend else Word64
c_gascap
    let (Word64
cost, Word64
gas') = (Word64
c_gascap Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
c_extra, Word64
c_callgas)
    Word64 -> Word64 -> EVM 'Concrete s ()
continue Word64
cost Word64
gas'

  -- When entering a call, the gas allowance is counted as burned
  -- in advance; this unburns the remainder and adds it to the
  -- parent frame.
  reclaimRemainingGasAllowance :: forall s. VM 'Concrete s -> EVM 'Concrete s ()
reclaimRemainingGasAllowance VM 'Concrete s
oldVm = do
    let remainingGas :: Gas 'Concrete
remainingGas = VM 'Concrete s
oldVm.state.gas
    Optic
  A_Lens
  '[]
  (VM 'Concrete s)
  (VM 'Concrete s)
  (Gas 'Concrete)
  (Gas 'Concrete)
-> (Gas 'Concrete -> Gas 'Concrete) -> EVM 'Concrete s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying Optic
  A_Lens
  '[]
  (VM 'Concrete s)
  (VM 'Concrete s)
  (Gas 'Concrete)
  (Gas 'Concrete)
#burned (Gas 'Concrete -> Gas 'Concrete -> Gas 'Concrete
forall a. Num a => a -> a -> a
subtract Gas 'Concrete
remainingGas)
    Optic
  A_Lens
  '[]
  (VM 'Concrete s)
  (VM 'Concrete s)
  (Gas 'Concrete)
  (Gas 'Concrete)
-> (Gas 'Concrete -> Gas 'Concrete) -> EVM 'Concrete s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying (Optic
  A_Lens
  '[]
  (VM 'Concrete s)
  (VM 'Concrete s)
  (FrameState 'Concrete s)
  (FrameState 'Concrete s)
#state Optic
  A_Lens
  '[]
  (VM 'Concrete s)
  (VM 'Concrete s)
  (FrameState 'Concrete s)
  (FrameState 'Concrete s)
-> Optic
     A_Lens
     '[]
     (FrameState 'Concrete s)
     (FrameState 'Concrete s)
     (Gas 'Concrete)
     (Gas 'Concrete)
-> Optic
     A_Lens
     '[]
     (VM 'Concrete s)
     (VM 'Concrete s)
     (Gas 'Concrete)
     (Gas 'Concrete)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState 'Concrete s)
  (FrameState 'Concrete s)
  (Gas 'Concrete)
  (Gas 'Concrete)
#gas) (Gas 'Concrete -> Gas 'Concrete -> Gas 'Concrete
forall a. Num a => a -> a -> a
+ Gas 'Concrete
remainingGas)

  payRefunds :: forall s. EVM 'Concrete s ()
payRefunds = do
    -- compute and pay the refund to the caller and the
    -- corresponding payment to the miner
    Block
block        <- Optic' A_Lens '[] (VM 'Concrete s) Block
-> StateT (VM 'Concrete s) (ST s) Block
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use Optic' A_Lens '[] (VM 'Concrete s) Block
#block
    TxState
tx           <- Optic' A_Lens '[] (VM 'Concrete s) TxState
-> StateT (VM 'Concrete s) (ST s) TxState
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use Optic' A_Lens '[] (VM 'Concrete s) TxState
#tx
    Word64
gasRemaining <- Optic' A_Lens '[] (VM 'Concrete s) Word64
-> StateT (VM 'Concrete s) (ST s) Word64
forall k s (m :: * -> *) (is :: IxList) a.
(Is k A_Getter, MonadState s m) =>
Optic' k is s a -> m a
use (Optic
  A_Lens
  '[]
  (VM 'Concrete s)
  (VM 'Concrete s)
  (FrameState 'Concrete s)
  (FrameState 'Concrete s)
#state Optic
  A_Lens
  '[]
  (VM 'Concrete s)
  (VM 'Concrete s)
  (FrameState 'Concrete s)
  (FrameState 'Concrete s)
-> Optic
     A_Lens
     '[]
     (FrameState 'Concrete s)
     (FrameState 'Concrete s)
     Word64
     Word64
-> Optic' A_Lens '[] (VM 'Concrete s) Word64
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  (FrameState 'Concrete s)
  (FrameState 'Concrete s)
  Word64
  Word64
#gas)

    let
      sumRefunds :: Word64
sumRefunds   = [Word64] -> Word64
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((Expr 'EAddr, Word64) -> Word64
forall a b. (a, b) -> b
snd ((Expr 'EAddr, Word64) -> Word64)
-> [(Expr 'EAddr, Word64)] -> [Word64]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxState
tx.substate.refunds)
      gasUsed :: Word64
gasUsed      = TxState
tx.gaslimit Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
gasRemaining
      cappedRefund :: Word64
cappedRefund = Word64 -> Word64 -> Word64
forall a. Ord a => a -> a -> a
min (Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
quot Word64
gasUsed Word64
5) Word64
sumRefunds
      originPay :: W256
originPay    = (Word64 -> W256
forall target source. From source target => source -> target
into (Word64 -> W256) -> Word64 -> W256
forall a b. (a -> b) -> a -> b
$ Word64
gasRemaining Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
cappedRefund) W256 -> W256 -> W256
forall a. Num a => a -> a -> a
* TxState
tx.gasprice
      minerPay :: W256
minerPay     = TxState
tx.priorityFee W256 -> W256 -> W256
forall a. Num a => a -> a -> a
* (Word64 -> W256
forall target source. From source target => source -> target
into Word64
gasUsed)

    Optic
  A_Lens
  '[]
  (VM 'Concrete s)
  (VM 'Concrete s)
  (Map (Expr 'EAddr) Contract)
  (Map (Expr 'EAddr) Contract)
-> (Map (Expr 'EAddr) Contract -> Map (Expr 'EAddr) Contract)
-> EVM 'Concrete s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying (Optic A_Lens '[] (VM 'Concrete s) (VM 'Concrete s) Env Env
#env Optic A_Lens '[] (VM 'Concrete s) (VM 'Concrete s) Env Env
-> Optic
     A_Lens
     '[]
     Env
     Env
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
-> Optic
     A_Lens
     '[]
     (VM 'Concrete s)
     (VM 'Concrete s)
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  Env
  Env
  (Map (Expr 'EAddr) Contract)
  (Map (Expr 'EAddr) Contract)
#contracts)
       ((Contract -> Contract)
-> Expr 'EAddr
-> Map (Expr 'EAddr) Contract
-> Map (Expr 'EAddr) Contract
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (Optic A_Lens '[] Contract Contract (Expr 'EWord) (Expr 'EWord)
-> (Expr 'EWord -> Expr 'EWord) -> Contract -> Contract
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic A_Lens '[] Contract Contract (Expr 'EWord) (Expr 'EWord)
#balance (Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.add (W256 -> Expr 'EWord
Lit W256
originPay))) TxState
tx.origin)
    Optic
  A_Lens
  '[]
  (VM 'Concrete s)
  (VM 'Concrete s)
  (Map (Expr 'EAddr) Contract)
  (Map (Expr 'EAddr) Contract)
-> (Map (Expr 'EAddr) Contract -> Map (Expr 'EAddr) Contract)
-> EVM 'Concrete s ()
forall k s (m :: * -> *) (is :: IxList) a b.
(Is k A_Setter, MonadState s m) =>
Optic k is s s a b -> (a -> b) -> m ()
modifying (Optic A_Lens '[] (VM 'Concrete s) (VM 'Concrete s) Env Env
#env Optic A_Lens '[] (VM 'Concrete s) (VM 'Concrete s) Env Env
-> Optic
     A_Lens
     '[]
     Env
     Env
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
-> Optic
     A_Lens
     '[]
     (VM 'Concrete s)
     (VM 'Concrete s)
     (Map (Expr 'EAddr) Contract)
     (Map (Expr 'EAddr) Contract)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  '[]
  Env
  Env
  (Map (Expr 'EAddr) Contract)
  (Map (Expr 'EAddr) Contract)
#contracts)
       ((Contract -> Contract)
-> Expr 'EAddr
-> Map (Expr 'EAddr) Contract
-> Map (Expr 'EAddr) Contract
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (Optic A_Lens '[] Contract Contract (Expr 'EWord) (Expr 'EWord)
-> (Expr 'EWord -> Expr 'EWord) -> Contract -> Contract
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Optic A_Lens '[] Contract Contract (Expr 'EWord) (Expr 'EWord)
#balance (Expr 'EWord -> Expr 'EWord -> Expr 'EWord
Expr.add (W256 -> Expr 'EWord
Lit W256
minerPay))) Block
block.coinbase)

  pushGas :: forall s. EVM 'Concrete s ()
pushGas = do
    VM 'Concrete s
vm <- StateT (VM 'Concrete s) (ST s) (VM 'Concrete s)
forall s (m :: * -> *). MonadState s m => m s
get
    W256 -> EVM 'Concrete s ()
forall (t :: VMType) s. W256 -> EVM t s ()
push (Gas 'Concrete -> W256
forall target source. From source target => source -> target
into VM 'Concrete s
vm.state.gas)

  enoughGas :: Word64 -> Gas 'Concrete -> Bool
enoughGas Word64
cost Gas 'Concrete
gasCap = Word64
cost Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64
Gas 'Concrete
gasCap

  subGas :: Gas 'Concrete -> Word64 -> Gas 'Concrete
subGas Gas 'Concrete
gasCap Word64
cost = Word64
Gas 'Concrete
gasCap Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
cost

  toGas :: Word64 -> Gas 'Concrete
toGas = Word64 -> Word64
Word64 -> Gas 'Concrete
forall a. a -> a
id

  whenSymbolicElse :: forall s a.
EVM 'Concrete s a -> EVM 'Concrete s a -> EVM 'Concrete s a
whenSymbolicElse EVM 'Concrete s a
_ EVM 'Concrete s a
a = EVM 'Concrete s a
a

  partial :: forall s. PartialExec -> EVM 'Concrete s ()
partial PartialExec
_ = [Char] -> EVM 'Concrete s ()
forall a. HasCallStack => [Char] -> a
internalError [Char]
"won't happen during concrete exec"

  branch :: forall s.
Expr 'EWord -> (Bool -> EVM 'Concrete s ()) -> EVM 'Concrete s ()
branch (Expr 'EWord -> W256
forceLit -> W256
cond) Bool -> EVM 'Concrete s ()
continue = Bool -> EVM 'Concrete s ()
continue (W256
cond W256 -> W256 -> Bool
forall a. Ord a => a -> a -> Bool
> W256
0)

-- Create symbolic VM from concrete VM
symbolify :: VM Concrete s -> VM Symbolic s
symbolify :: forall s. VM 'Concrete s -> VM 'Symbolic s
symbolify VM 'Concrete s
vm =
  VM 'Concrete s
vm { $sel:result:VM :: Maybe (VMResult 'Symbolic s)
result = VMResult 'Concrete s -> VMResult 'Symbolic s
forall s. VMResult 'Concrete s -> VMResult 'Symbolic s
symbolifyResult (VMResult 'Concrete s -> VMResult 'Symbolic s)
-> Maybe (VMResult 'Concrete s) -> Maybe (VMResult 'Symbolic s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VM 'Concrete s
vm.result
     , $sel:state:VM :: FrameState 'Symbolic s
state  = FrameState 'Concrete s -> FrameState 'Symbolic s
forall s. FrameState 'Concrete s -> FrameState 'Symbolic s
symbolifyFrameState VM 'Concrete s
vm.state
     , $sel:frames:VM :: [Frame 'Symbolic s]
frames = Frame 'Concrete s -> Frame 'Symbolic s
forall s. Frame 'Concrete s -> Frame 'Symbolic s
symbolifyFrame (Frame 'Concrete s -> Frame 'Symbolic s)
-> [Frame 'Concrete s] -> [Frame 'Symbolic s]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VM 'Concrete s
vm.frames
     , $sel:burned:VM :: Gas 'Symbolic
burned = ()
     }

symbolifyFrameState :: FrameState Concrete s -> FrameState Symbolic s
symbolifyFrameState :: forall s. FrameState 'Concrete s -> FrameState 'Symbolic s
symbolifyFrameState FrameState 'Concrete s
state = FrameState 'Concrete s
state { $sel:gas:FrameState :: Gas 'Symbolic
gas = () }

symbolifyFrame :: Frame Concrete s -> Frame Symbolic s
symbolifyFrame :: forall s. Frame 'Concrete s -> Frame 'Symbolic s
symbolifyFrame Frame 'Concrete s
frame = Frame 'Concrete s
frame { $sel:state:Frame :: FrameState 'Symbolic s
state = FrameState 'Concrete s -> FrameState 'Symbolic s
forall s. FrameState 'Concrete s -> FrameState 'Symbolic s
symbolifyFrameState Frame 'Concrete s
frame.state }

symbolifyResult :: VMResult Concrete s -> VMResult Symbolic s
symbolifyResult :: forall s. VMResult 'Concrete s -> VMResult 'Symbolic s
symbolifyResult VMResult 'Concrete s
result =
  case VMResult 'Concrete s
result of
    HandleEffect Effect 'Concrete s
_ -> [Char] -> VMResult 'Symbolic s
forall a. HasCallStack => [Char] -> a
internalError [Char]
"shouldn't happen"
    VMFailure EvmError
e -> EvmError -> VMResult 'Symbolic s
forall (t :: VMType) s. EvmError -> VMResult t s
VMFailure EvmError
e
    VMSuccess Expr 'Buf
b -> Expr 'Buf -> VMResult 'Symbolic s
forall (t :: VMType) s. Expr 'Buf -> VMResult t s
VMSuccess Expr 'Buf
b

forceLit :: Expr EWord -> W256
forceLit :: Expr 'EWord -> W256
forceLit (Lit W256
w) = W256
w
forceLit Expr 'EWord
_ = [Char] -> W256
forall a. HasCallStack => [Char] -> a
internalError [Char]
"concrete vm, shouldn't ever happen"

burn :: VMOps t => Word64 -> EVM t s () -> EVM t s ()
burn :: forall (t :: VMType) s.
VMOps t =>
Word64 -> EVM t s () -> EVM t s ()
burn = Gas t -> EVM t s () -> EVM t s ()
forall s. Gas t -> EVM t s () -> EVM t s ()
forall (t :: VMType) s.
VMOps t =>
Gas t -> EVM t s () -> EVM t s ()
burn' (Gas t -> EVM t s () -> EVM t s ())
-> (Word64 -> Gas t) -> Word64 -> EVM t s () -> EVM t s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Gas t
forall (t :: VMType). VMOps t => Word64 -> Gas t
toGas