{-# LANGUAGE DataKinds #-}

module EVM.Op
  ( Op
  , GenericOp (..)
  , opString
  , intToOpName
  , getOp
  , readOp
  ) where

import EVM.Expr qualified as Expr
import EVM.Types

import Data.Vector qualified as V
import Data.Word (Word8)
import Numeric (showHex)
import Witch (into)

intToOpName:: Int -> String
intToOpName :: Int -> String
intToOpName Int
a =
  case Int
a of
    Int
0x00 -> String
"STOP"
    Int
0x01 -> String
"ADD"
    Int
0x02 -> String
"MUL"
    Int
0x03 -> String
"SUB"
    Int
0x04 -> String
"DIV"
    Int
0x05 -> String
"SDIV"
    Int
0x06 -> String
"MOD"
    Int
0x07 -> String
"SMOD"
    Int
0x08 -> String
"ADDMOD"
    Int
0x09 -> String
"MULMOD"
    Int
0x0a -> String
"EXP"
    Int
0x0b -> String
"SIGNEXTEND"
    --
    Int
0x10 -> String
"LT"
    Int
0x11 -> String
"GT"
    Int
0x12 -> String
"SLT"
    Int
0x13 -> String
"SGT"
    Int
0x14 -> String
"EQ"
    Int
0x15 -> String
"ISZERO"
    Int
0x16 -> String
"AND"
    Int
0x17 -> String
"OR"
    Int
0x18 -> String
"XOR"
    Int
0x19 -> String
"NOT"
    Int
0x1a -> String
"BYTE"
    Int
0x1b -> String
"SHL"
    Int
0x1c -> String
"SHR"
    Int
0x1d -> String
"SAR"
    Int
0x20 -> String
"SHA3"
    Int
0x30 -> String
"ADDRESS"
    --
    Int
0x31 -> String
"BALANCE"
    Int
0x32 -> String
"ORIGIN"
    Int
0x33 -> String
"CALLER"
    Int
0x34 -> String
"CALLVALUE"
    Int
0x35 -> String
"CALLDATALOAD"
    Int
0x36 -> String
"CALLDATASIZE"
    Int
0x37 -> String
"CALLDATACOPY"
    Int
0x38 -> String
"CODESIZE"
    Int
0x39 -> String
"CODECOPY"
    Int
0x3a -> String
"GASPRICE"
    Int
0x3b -> String
"EXTCODESIZE"
    Int
0x3c -> String
"EXTCODECOPY"
    Int
0x3d -> String
"RETURNDATASIZE"
    Int
0x3e -> String
"RETURNDATACOPY"
    Int
0x3f -> String
"EXTCODEHASH"
    Int
0x40 -> String
"BLOCKHASH"
    Int
0x41 -> String
"COINBASE"
    Int
0x42 -> String
"TIMESTAMP"
    Int
0x43 -> String
"NUMBER"
    Int
0x44 -> String
"PREVRANDAO"
    Int
0x45 -> String
"GASLIMIT"
    Int
0x46 -> String
"CHAINID"
    Int
0x47 -> String
"SELFBALANCE"
    Int
0x48 -> String
"BASEFEE"
    Int
0x50 -> String
"POP"
    Int
0x51 -> String
"MLOAD"
    Int
0x52 -> String
"MSTORE"
    Int
0x53 -> String
"MSTORE8"
    Int
0x54 -> String
"SLOAD"
    Int
0x55 -> String
"SSTORE"
    Int
0x56 -> String
"JUMP"
    Int
0x57 -> String
"JUMPI"
    Int
0x58 -> String
"PC"
    Int
0x59 -> String
"MSIZE"
    Int
0x5a -> String
"GAS"
    Int
0x5b -> String
"JUMPDEST"
    --
    Int
0x5f -> String
"PUSH0"
    Int
0x60 -> String
"PUSH1"
    Int
0x61 -> String
"PUSH2"
    Int
0x62 -> String
"PUSH3"
    Int
0x63 -> String
"PUSH4"
    Int
0x64 -> String
"PUSH5"
    Int
0x65 -> String
"PUSH6"
    Int
0x66 -> String
"PUSH7"
    Int
0x67 -> String
"PUSH8"
    Int
0x68 -> String
"PUSH9"
    Int
0x69 -> String
"PUSH10"
    Int
0x6a -> String
"PUSH11"
    Int
0x6b -> String
"PUSH12"
    Int
0x6c -> String
"PUSH13"
    Int
0x6d -> String
"PUSH14"
    Int
0x6e -> String
"PUSH15"
    Int
0x6f -> String
"PUSH16"
    Int
0x70 -> String
"PUSH17"
    Int
0x71 -> String
"PUSH18"
    Int
0x72 -> String
"PUSH19"
    Int
0x73 -> String
"PUSH20"
    Int
0x74 -> String
"PUSH21"
    Int
0x75 -> String
"PUSH22"
    Int
0x76 -> String
"PUSH23"
    Int
0x77 -> String
"PUSH24"
    Int
0x78 -> String
"PUSH25"
    Int
0x79 -> String
"PUSH26"
    Int
0x7a -> String
"PUSH27"
    Int
0x7b -> String
"PUSH28"
    Int
0x7c -> String
"PUSH29"
    Int
0x7d -> String
"PUSH30"
    Int
0x7e -> String
"PUSH31"
    Int
0x7f -> String
"PUSH32"
    --
    Int
0x80 -> String
"DUP1"
    Int
0x81 -> String
"DUP2"
    Int
0x82 -> String
"DUP3"
    Int
0x83 -> String
"DUP4"
    Int
0x84 -> String
"DUP5"
    Int
0x85 -> String
"DUP6"
    Int
0x86 -> String
"DUP7"
    Int
0x87 -> String
"DUP8"
    Int
0x88 -> String
"DUP9"
    Int
0x89 -> String
"DUP10"
    Int
0x8a -> String
"DUP11"
    Int
0x8b -> String
"DUP12"
    Int
0x8c -> String
"DUP13"
    Int
0x8d -> String
"DUP14"
    Int
0x8e -> String
"DUP15"
    Int
0x8f -> String
"DUP16"
    --
    Int
0x90 -> String
"SWAP1"
    Int
0x91 -> String
"SWAP2"
    Int
0x92 -> String
"SWAP3"
    Int
0x93 -> String
"SWAP4"
    Int
0x94 -> String
"SWAP5"
    Int
0x95 -> String
"SWAP6"
    Int
0x96 -> String
"SWAP7"
    Int
0x97 -> String
"SWAP8"
    Int
0x98 -> String
"SWAP9"
    Int
0x99 -> String
"SWAP10"
    Int
0x9a -> String
"SWAP11"
    Int
0x9b -> String
"SWAP12"
    Int
0x9c -> String
"SWAP13"
    Int
0x9d -> String
"SWAP14"
    Int
0x9e -> String
"SWAP15"
    Int
0x9f -> String
"SWAP16"
    --
    Int
0xa0 -> String
"LOG0"
    Int
0xa1 -> String
"LOG1"
    Int
0xa2 -> String
"LOG2"
    Int
0xa3 -> String
"LOG3"
    Int
0xa4 -> String
"LOG4"
    --
    Int
0xf0 -> String
"CREATE"
    Int
0xf1 -> String
"CALL"
    Int
0xf2 -> String
"CALLCODE"
    Int
0xf3 -> String
"RETURN"
    Int
0xf4 -> String
"DELEGATECALL"
    Int
0xf5 -> String
"CREATE2"
    Int
0xfa -> String
"STATICCALL"
    Int
0xfd -> String
"REVERT"
    Int
0xfe -> String
"INVALID"
    Int
0xff -> String
"SELFDESTRUCT"
    Int
_ -> String
"UNKNOWN "

opString :: (Integral a, Show a) => (a, Op) -> String
opString :: forall a. (Integral a, Show a) => (a, Op) -> String
opString (a
i, Op
o) = let showPc :: a -> String
showPc a
x | a
x forall a. Ord a => a -> a -> Bool
< a
0x10 = Char
'0' forall a. a -> [a] -> [a]
: forall a. (Integral a, Show a) => a -> ShowS
showHex a
x String
""
                               | Bool
otherwise = forall a. (Integral a, Show a) => a -> ShowS
showHex a
x String
""
                  in forall {a}. (Integral a, Show a) => a -> String
showPc a
i forall a. Semigroup a => a -> a -> a
<> String
" " forall a. [a] -> [a] -> [a]
++ case Op
o of
  Op
OpStop -> String
"STOP"
  Op
OpAdd -> String
"ADD"
  Op
OpMul -> String
"MUL"
  Op
OpSub -> String
"SUB"
  Op
OpDiv -> String
"DIV"
  Op
OpSdiv -> String
"SDIV"
  Op
OpMod -> String
"MOD"
  Op
OpSmod -> String
"SMOD"
  Op
OpAddmod -> String
"ADDMOD"
  Op
OpMulmod -> String
"MULMOD"
  Op
OpExp -> String
"EXP"
  Op
OpSignextend -> String
"SIGNEXTEND"
  Op
OpLt -> String
"LT"
  Op
OpGt -> String
"GT"
  Op
OpSlt -> String
"SLT"
  Op
OpSgt -> String
"SGT"
  Op
OpEq -> String
"EQ"
  Op
OpIszero -> String
"ISZERO"
  Op
OpAnd -> String
"AND"
  Op
OpOr -> String
"OR"
  Op
OpXor -> String
"XOR"
  Op
OpNot -> String
"NOT"
  Op
OpByte -> String
"BYTE"
  Op
OpShl -> String
"SHL"
  Op
OpShr -> String
"SHR"
  Op
OpSar -> String
"SAR"
  Op
OpSha3 -> String
"SHA3"
  Op
OpAddress -> String
"ADDRESS"
  Op
OpBalance -> String
"BALANCE"
  Op
OpOrigin -> String
"ORIGIN"
  Op
OpCaller -> String
"CALLER"
  Op
OpCallvalue -> String
"CALLVALUE"
  Op
OpCalldataload -> String
"CALLDATALOAD"
  Op
OpCalldatasize -> String
"CALLDATASIZE"
  Op
OpCalldatacopy -> String
"CALLDATACOPY"
  Op
OpCodesize -> String
"CODESIZE"
  Op
OpCodecopy -> String
"CODECOPY"
  Op
OpGasprice -> String
"GASPRICE"
  Op
OpExtcodesize -> String
"EXTCODESIZE"
  Op
OpExtcodecopy -> String
"EXTCODECOPY"
  Op
OpReturndatasize -> String
"RETURNDATASIZE"
  Op
OpReturndatacopy -> String
"RETURNDATACOPY"
  Op
OpExtcodehash -> String
"EXTCODEHASH"
  Op
OpBlockhash -> String
"BLOCKHASH"
  Op
OpCoinbase -> String
"COINBASE"
  Op
OpTimestamp -> String
"TIMESTAMP"
  Op
OpNumber -> String
"NUMBER"
  Op
OpPrevRandao -> String
"PREVRANDAO"
  Op
OpGaslimit -> String
"GASLIMIT"
  Op
OpChainid -> String
"CHAINID"
  Op
OpSelfbalance -> String
"SELFBALANCE"
  Op
OpBaseFee -> String
"BASEFEE"
  Op
OpPop -> String
"POP"
  Op
OpMload -> String
"MLOAD"
  Op
OpMstore -> String
"MSTORE"
  Op
OpMstore8 -> String
"MSTORE8"
  Op
OpSload -> String
"SLOAD"
  Op
OpSstore -> String
"SSTORE"
  Op
OpJump -> String
"JUMP"
  Op
OpJumpi -> String
"JUMPI"
  Op
OpPc -> String
"PC"
  Op
OpMsize -> String
"MSIZE"
  Op
OpGas -> String
"GAS"
  Op
OpJumpdest -> String
"JUMPDEST"
  Op
OpCreate -> String
"CREATE"
  Op
OpCall -> String
"CALL"
  Op
OpStaticcall -> String
"STATICCALL"
  Op
OpCallcode -> String
"CALLCODE"
  Op
OpReturn -> String
"RETURN"
  Op
OpDelegatecall -> String
"DELEGATECALL"
  Op
OpCreate2 -> String
"CREATE2"
  Op
OpSelfdestruct -> String
"SELFDESTRUCT"
  OpDup Word8
x -> String
"DUP" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word8
x
  OpSwap Word8
x -> String
"SWAP" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word8
x
  OpLog Word8
x -> String
"LOG" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word8
x
  Op
OpPush0  -> String
"PUSH0"
  OpPush Expr 'EWord
x -> case Expr 'EWord
x of
    Lit W256
x' -> String
"PUSH 0x" forall a. [a] -> [a] -> [a]
++ (forall a. (Integral a, Show a) => a -> ShowS
showHex W256
x' String
"")
    Expr 'EWord
_ -> String
"PUSH " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Expr 'EWord
x
  Op
OpRevert -> String
"REVERT"
  OpUnknown Word8
x -> case Word8
x of
    Word8
254 -> String
"INVALID"
    Word8
_ -> String
"UNKNOWN " forall a. [a] -> [a] -> [a]
++ (forall a. (Integral a, Show a) => a -> ShowS
showHex Word8
x String
"")

readOp :: Word8 -> [Expr Byte] -> Op
readOp :: Word8 -> [Expr 'Byte] -> Op
readOp Word8
x [Expr 'Byte]
xs =
  (\Word8
n -> Int -> Expr 'EWord -> Expr 'Buf -> Expr 'EWord
Expr.readBytes (forall target source. From source target => source -> target
into Word8
n) (W256 -> Expr 'EWord
Lit W256
0) (Vector (Expr 'Byte) -> Expr 'Buf
Expr.fromList forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Vector a
V.fromList [Expr 'Byte]
xs)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word8 -> GenericOp Word8
getOp Word8
x

getOp :: Word8 -> GenericOp Word8
getOp :: Word8 -> GenericOp Word8
getOp Word8
x | Word8
x forall a. Ord a => a -> a -> Bool
>= Word8
0x80 Bool -> Bool -> Bool
&& Word8
x forall a. Ord a => a -> a -> Bool
<= Word8
0x8f = forall a. Word8 -> GenericOp a
OpDup (Word8
x forall a. Num a => a -> a -> a
- Word8
0x80 forall a. Num a => a -> a -> a
+ Word8
1)
getOp Word8
x | Word8
x forall a. Ord a => a -> a -> Bool
>= Word8
0x90 Bool -> Bool -> Bool
&& Word8
x forall a. Ord a => a -> a -> Bool
<= Word8
0x9f = forall a. Word8 -> GenericOp a
OpSwap (Word8
x forall a. Num a => a -> a -> a
- Word8
0x90 forall a. Num a => a -> a -> a
+ Word8
1)
getOp Word8
x | Word8
x forall a. Ord a => a -> a -> Bool
>= Word8
0xa0 Bool -> Bool -> Bool
&& Word8
x forall a. Ord a => a -> a -> Bool
<= Word8
0xa4 = forall a. Word8 -> GenericOp a
OpLog (Word8
x forall a. Num a => a -> a -> a
- Word8
0xa0)
getOp Word8
x | Word8
x forall a. Ord a => a -> a -> Bool
>= Word8
0x60 Bool -> Bool -> Bool
&& Word8
x forall a. Ord a => a -> a -> Bool
<= Word8
0x7f = forall a. a -> GenericOp a
OpPush (Word8
x forall a. Num a => a -> a -> a
- Word8
0x60 forall a. Num a => a -> a -> a
+ Word8
1)
getOp Word8
x = case Word8
x of
  Word8
0x00 -> forall a. GenericOp a
OpStop
  Word8
0x01 -> forall a. GenericOp a
OpAdd
  Word8
0x02 -> forall a. GenericOp a
OpMul
  Word8
0x03 -> forall a. GenericOp a
OpSub
  Word8
0x04 -> forall a. GenericOp a
OpDiv
  Word8
0x05 -> forall a. GenericOp a
OpSdiv
  Word8
0x06 -> forall a. GenericOp a
OpMod
  Word8
0x07 -> forall a. GenericOp a
OpSmod
  Word8
0x08 -> forall a. GenericOp a
OpAddmod
  Word8
0x09 -> forall a. GenericOp a
OpMulmod
  Word8
0x0a -> forall a. GenericOp a
OpExp
  Word8
0x0b -> forall a. GenericOp a
OpSignextend
  Word8
0x10 -> forall a. GenericOp a
OpLt
  Word8
0x11 -> forall a. GenericOp a
OpGt
  Word8
0x12 -> forall a. GenericOp a
OpSlt
  Word8
0x13 -> forall a. GenericOp a
OpSgt
  Word8
0x14 -> forall a. GenericOp a
OpEq
  Word8
0x15 -> forall a. GenericOp a
OpIszero
  Word8
0x16 -> forall a. GenericOp a
OpAnd
  Word8
0x17 -> forall a. GenericOp a
OpOr
  Word8
0x18 -> forall a. GenericOp a
OpXor
  Word8
0x19 -> forall a. GenericOp a
OpNot
  Word8
0x1a -> forall a. GenericOp a
OpByte
  Word8
0x1b -> forall a. GenericOp a
OpShl
  Word8
0x1c -> forall a. GenericOp a
OpShr
  Word8
0x1d -> forall a. GenericOp a
OpSar
  Word8
0x20 -> forall a. GenericOp a
OpSha3
  Word8
0x30 -> forall a. GenericOp a
OpAddress
  Word8
0x31 -> forall a. GenericOp a
OpBalance
  Word8
0x32 -> forall a. GenericOp a
OpOrigin
  Word8
0x33 -> forall a. GenericOp a
OpCaller
  Word8
0x34 -> forall a. GenericOp a
OpCallvalue
  Word8
0x35 -> forall a. GenericOp a
OpCalldataload
  Word8
0x36 -> forall a. GenericOp a
OpCalldatasize
  Word8
0x37 -> forall a. GenericOp a
OpCalldatacopy
  Word8
0x38 -> forall a. GenericOp a
OpCodesize
  Word8
0x39 -> forall a. GenericOp a
OpCodecopy
  Word8
0x3a -> forall a. GenericOp a
OpGasprice
  Word8
0x3b -> forall a. GenericOp a
OpExtcodesize
  Word8
0x3c -> forall a. GenericOp a
OpExtcodecopy
  Word8
0x3d -> forall a. GenericOp a
OpReturndatasize
  Word8
0x3e -> forall a. GenericOp a
OpReturndatacopy
  Word8
0x3f -> forall a. GenericOp a
OpExtcodehash
  Word8
0x40 -> forall a. GenericOp a
OpBlockhash
  Word8
0x41 -> forall a. GenericOp a
OpCoinbase
  Word8
0x42 -> forall a. GenericOp a
OpTimestamp
  Word8
0x43 -> forall a. GenericOp a
OpNumber
  Word8
0x44 -> forall a. GenericOp a
OpPrevRandao
  Word8
0x45 -> forall a. GenericOp a
OpGaslimit
  Word8
0x46 -> forall a. GenericOp a
OpChainid
  Word8
0x47 -> forall a. GenericOp a
OpSelfbalance
  Word8
0x48 -> forall a. GenericOp a
OpBaseFee
  Word8
0x50 -> forall a. GenericOp a
OpPop
  Word8
0x51 -> forall a. GenericOp a
OpMload
  Word8
0x52 -> forall a. GenericOp a
OpMstore
  Word8
0x53 -> forall a. GenericOp a
OpMstore8
  Word8
0x54 -> forall a. GenericOp a
OpSload
  Word8
0x55 -> forall a. GenericOp a
OpSstore
  Word8
0x56 -> forall a. GenericOp a
OpJump
  Word8
0x57 -> forall a. GenericOp a
OpJumpi
  Word8
0x58 -> forall a. GenericOp a
OpPc
  Word8
0x59 -> forall a. GenericOp a
OpMsize
  Word8
0x5a -> forall a. GenericOp a
OpGas
  Word8
0x5b -> forall a. GenericOp a
OpJumpdest
  Word8
0x5f -> forall a. GenericOp a
OpPush0
  Word8
0xf0 -> forall a. GenericOp a
OpCreate
  Word8
0xf1 -> forall a. GenericOp a
OpCall
  Word8
0xf2 -> forall a. GenericOp a
OpCallcode
  Word8
0xf3 -> forall a. GenericOp a
OpReturn
  Word8
0xf4 -> forall a. GenericOp a
OpDelegatecall
  Word8
0xf5 -> forall a. GenericOp a
OpCreate2
  Word8
0xfd -> forall a. GenericOp a
OpRevert
  Word8
0xfa -> forall a. GenericOp a
OpStaticcall
  Word8
0xff -> forall a. GenericOp a
OpSelfdestruct
  Word8
_    -> forall a. Word8 -> GenericOp a
OpUnknown Word8
x