{-|
Module      : Assembler
Description : Assembler for EVM opcodes used in the HEVM symbolic checker
-}

{-# LANGUAGE DataKinds #-}

module EVM.Assembler where

import EVM.Op
import EVM.Types
import qualified EVM.Expr as Expr

import qualified Data.Vector as V
import Data.Vector (Vector)

assemble :: [Op] -> Vector (Expr Byte)
assemble :: [Op] -> Vector (Expr 'Byte)
assemble [Op]
os = forall a. [a] -> Vector a
V.fromList forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Op -> [Expr 'Byte]
go [Op]
os
  where
    go :: Op -> [Expr Byte]
    go :: Op -> [Expr 'Byte]
go = \case
      Op
OpStop -> [Word8 -> Expr 'Byte
LitByte Word8
0x00]
      Op
OpAdd -> [Word8 -> Expr 'Byte
LitByte Word8
0x01]
      Op
OpMul -> [Word8 -> Expr 'Byte
LitByte Word8
0x02]
      Op
OpSub -> [Word8 -> Expr 'Byte
LitByte Word8
0x03]
      Op
OpDiv -> [Word8 -> Expr 'Byte
LitByte Word8
0x04]
      Op
OpSdiv -> [Word8 -> Expr 'Byte
LitByte Word8
0x05]
      Op
OpMod -> [Word8 -> Expr 'Byte
LitByte Word8
0x06]
      Op
OpSmod -> [Word8 -> Expr 'Byte
LitByte Word8
0x07]
      Op
OpAddmod -> [Word8 -> Expr 'Byte
LitByte Word8
0x08]
      Op
OpMulmod -> [Word8 -> Expr 'Byte
LitByte Word8
0x09]
      Op
OpExp -> [Word8 -> Expr 'Byte
LitByte Word8
0x0A]
      Op
OpSignextend -> [Word8 -> Expr 'Byte
LitByte Word8
0x0B]
      Op
OpLt -> [Word8 -> Expr 'Byte
LitByte Word8
0x10]
      Op
OpGt -> [Word8 -> Expr 'Byte
LitByte Word8
0x11]
      Op
OpSlt -> [Word8 -> Expr 'Byte
LitByte Word8
0x12]
      Op
OpSgt -> [Word8 -> Expr 'Byte
LitByte Word8
0x13]
      Op
OpEq -> [Word8 -> Expr 'Byte
LitByte Word8
0x14]
      Op
OpIszero -> [Word8 -> Expr 'Byte
LitByte Word8
0x15]
      Op
OpAnd -> [Word8 -> Expr 'Byte
LitByte Word8
0x16]
      Op
OpOr -> [Word8 -> Expr 'Byte
LitByte Word8
0x17]
      Op
OpXor -> [Word8 -> Expr 'Byte
LitByte Word8
0x18]
      Op
OpNot -> [Word8 -> Expr 'Byte
LitByte Word8
0x19]
      Op
OpByte -> [Word8 -> Expr 'Byte
LitByte Word8
0x1A]
      Op
OpShl -> [Word8 -> Expr 'Byte
LitByte Word8
0x1B]
      Op
OpShr -> [Word8 -> Expr 'Byte
LitByte Word8
0x1C]
      Op
OpSar -> [Word8 -> Expr 'Byte
LitByte Word8
0x1D]
      Op
OpSha3 -> [Word8 -> Expr 'Byte
LitByte Word8
0x20]
      Op
OpAddress -> [Word8 -> Expr 'Byte
LitByte Word8
0x30]
      Op
OpBalance -> [Word8 -> Expr 'Byte
LitByte Word8
0x31]
      Op
OpOrigin -> [Word8 -> Expr 'Byte
LitByte Word8
0x32]
      Op
OpCaller -> [Word8 -> Expr 'Byte
LitByte Word8
0x33]
      Op
OpCallvalue -> [Word8 -> Expr 'Byte
LitByte Word8
0x34]
      Op
OpCalldataload -> [Word8 -> Expr 'Byte
LitByte Word8
0x35]
      Op
OpCalldatasize -> [Word8 -> Expr 'Byte
LitByte Word8
0x36]
      Op
OpCalldatacopy -> [Word8 -> Expr 'Byte
LitByte Word8
0x37]
      Op
OpCodesize -> [Word8 -> Expr 'Byte
LitByte Word8
0x38]
      Op
OpCodecopy -> [Word8 -> Expr 'Byte
LitByte Word8
0x39]
      Op
OpGasprice -> [Word8 -> Expr 'Byte
LitByte Word8
0x3A]
      Op
OpExtcodesize -> [Word8 -> Expr 'Byte
LitByte Word8
0x3B]
      Op
OpExtcodecopy -> [Word8 -> Expr 'Byte
LitByte Word8
0x3C]
      Op
OpReturndatasize -> [Word8 -> Expr 'Byte
LitByte Word8
0x3D]
      Op
OpReturndatacopy -> [Word8 -> Expr 'Byte
LitByte Word8
0x3E]
      Op
OpExtcodehash -> [Word8 -> Expr 'Byte
LitByte Word8
0x3F]
      Op
OpBlockhash -> [Word8 -> Expr 'Byte
LitByte Word8
0x40]
      Op
OpCoinbase -> [Word8 -> Expr 'Byte
LitByte Word8
0x41]
      Op
OpTimestamp -> [Word8 -> Expr 'Byte
LitByte Word8
0x42]
      Op
OpNumber -> [Word8 -> Expr 'Byte
LitByte Word8
0x43]
      Op
OpPrevRandao -> [Word8 -> Expr 'Byte
LitByte Word8
0x44]
      Op
OpGaslimit -> [Word8 -> Expr 'Byte
LitByte Word8
0x45]
      Op
OpChainid -> [Word8 -> Expr 'Byte
LitByte Word8
0x46]
      Op
OpSelfbalance -> [Word8 -> Expr 'Byte
LitByte Word8
0x47]
      Op
OpBaseFee -> [Word8 -> Expr 'Byte
LitByte Word8
0x48]
      Op
OpPop -> [Word8 -> Expr 'Byte
LitByte Word8
0x50]
      Op
OpMload -> [Word8 -> Expr 'Byte
LitByte Word8
0x51]
      Op
OpMstore -> [Word8 -> Expr 'Byte
LitByte Word8
0x52]
      Op
OpMstore8 -> [Word8 -> Expr 'Byte
LitByte Word8
0x53]
      Op
OpSload -> [Word8 -> Expr 'Byte
LitByte Word8
0x54]
      Op
OpSstore -> [Word8 -> Expr 'Byte
LitByte Word8
0x55]
      Op
OpJump -> [Word8 -> Expr 'Byte
LitByte Word8
0x56]
      Op
OpJumpi -> [Word8 -> Expr 'Byte
LitByte Word8
0x57]
      Op
OpPc -> [Word8 -> Expr 'Byte
LitByte Word8
0x58]
      Op
OpMsize -> [Word8 -> Expr 'Byte
LitByte Word8
0x59]
      Op
OpGas -> [Word8 -> Expr 'Byte
LitByte Word8
0x5A]
      Op
OpJumpdest -> [Word8 -> Expr 'Byte
LitByte Word8
0x5B]
      Op
OpCreate -> [Word8 -> Expr 'Byte
LitByte Word8
0xF0]
      Op
OpCall -> [Word8 -> Expr 'Byte
LitByte Word8
0xF1]
      Op
OpStaticcall -> [Word8 -> Expr 'Byte
LitByte Word8
0xFA]
      Op
OpCallcode -> [Word8 -> Expr 'Byte
LitByte Word8
0xF2]
      Op
OpReturn -> [Word8 -> Expr 'Byte
LitByte Word8
0xF3]
      Op
OpDelegatecall -> [Word8 -> Expr 'Byte
LitByte Word8
0xF4]
      Op
OpCreate2 -> [Word8 -> Expr 'Byte
LitByte Word8
0xF5]
      Op
OpRevert -> [Word8 -> Expr 'Byte
LitByte Word8
0xFD]
      Op
OpSelfdestruct -> [Word8 -> Expr 'Byte
LitByte Word8
0xFF]
      OpDup Word8
n ->
        if Word8
1 forall a. Ord a => a -> a -> Bool
<= Word8
n Bool -> Bool -> Bool
&& Word8
n forall a. Ord a => a -> a -> Bool
<= Word8
16
        then [Word8 -> Expr 'Byte
LitByte (Word8
0x80 forall a. Num a => a -> a -> a
+ (Word8
n forall a. Num a => a -> a -> a
- Word8
1))]
        else forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Internal Error: invalid argument to OpDup: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Word8
n
      OpSwap Word8
n ->
        if Word8
1 forall a. Ord a => a -> a -> Bool
<= Word8
n Bool -> Bool -> Bool
&& Word8
n forall a. Ord a => a -> a -> Bool
<= Word8
16
        then [Word8 -> Expr 'Byte
LitByte (Word8
0x90 forall a. Num a => a -> a -> a
+ (Word8
n forall a. Num a => a -> a -> a
- Word8
1))]
        else forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Internal Error: invalid argument to OpSwap: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Word8
n
      OpLog Word8
n ->
        if Word8
0 forall a. Ord a => a -> a -> Bool
<= Word8
n Bool -> Bool -> Bool
&& Word8
n forall a. Ord a => a -> a -> Bool
<= Word8
4
        then [Word8 -> Expr 'Byte
LitByte (Word8
0xA0 forall a. Num a => a -> a -> a
+ Word8
n)]
        else forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Internal Error: invalid argument to OpLog: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Word8
n
      -- we just always assemble OpPush into PUSH32
      OpPush Expr 'EWord
wrd -> (Word8 -> Expr 'Byte
LitByte Word8
0x7f) forall a. a -> [a] -> [a]
: [Expr 'EWord -> Expr 'EWord -> Expr 'Byte
Expr.indexWord (W256 -> Expr 'EWord
Lit W256
i) Expr 'EWord
wrd | W256
i <- [W256
0..W256
31]]
      Op
OpPush0 -> [Word8 -> Expr 'Byte
LitByte Word8
0x5f]
      OpUnknown Word8
o -> [Word8 -> Expr 'Byte
LitByte Word8
o]