{-# LANGUAGE ScopedTypeVariables #-}

-- |
-- Module: EVM.Opcode.Traversal
-- Copyright: 2018 Simon Shine
-- Maintainer: Simon Shine <shreddedglory@gmail.com>
-- License: MIT
--
-- This module exposes a generic method of traversing 'Opcode''s.

module EVM.Opcode.Traversal
  ( OpcodeMapper(..)
  , mapOpcodeM
  ) where

import Prelude hiding (LT, EQ, GT)
import EVM.Opcode

-- | An 'OpcodeMapper' is a collection of four mapping functions that can
-- map any @'Opcode'' a@ to an @'Opcode'' b@. For each of the three opcodes
-- that are annotated, 'JUMP', 'JUMPI' and 'JUMPDEST', a separate mapping
-- function is specified, and for any other opcode, a general mapping function
-- is specified that falls back to the same opcode of type @'Opcode'' b@.
--
-- See 'EVM.Opcode.Labelled.translate' for an example of usage.
data OpcodeMapper m a b = OpcodeMapper
  { OpcodeMapper m a b -> a -> m (Opcode' b)
mapOnJump     :: a -> m (Opcode' b)
  , OpcodeMapper m a b -> a -> m (Opcode' b)
mapOnJumpi    :: a -> m (Opcode' b)
  , OpcodeMapper m a b -> a -> m (Opcode' b)
mapOnJumpdest :: a -> m (Opcode' b)
  , OpcodeMapper m a b -> Opcode' a -> m (Maybe (Opcode' b))
mapOnOther    :: Opcode' a -> m (Maybe (Opcode' b))
  }

-- | Given an 'OpcodeMapper' and an @'Opcode'' a@, produce @m ('Opcode'' b)@.
mapOpcodeM :: forall m a b. Monad m => OpcodeMapper m a b -> Opcode' a -> m (Opcode' b)
mapOpcodeM :: OpcodeMapper m a b -> Opcode' a -> m (Opcode' b)
mapOpcodeM OpcodeMapper m a b
mapper Opcode' a
opcode = case Opcode' a
opcode of
  JUMP a
a     -> OpcodeMapper m a b -> a -> m (Opcode' b)
forall (m :: * -> *) a b. OpcodeMapper m a b -> a -> m (Opcode' b)
mapOnJump OpcodeMapper m a b
mapper a
a
  JUMPI a
a    -> OpcodeMapper m a b -> a -> m (Opcode' b)
forall (m :: * -> *) a b. OpcodeMapper m a b -> a -> m (Opcode' b)
mapOnJumpi OpcodeMapper m a b
mapper a
a
  JUMPDEST a
a -> OpcodeMapper m a b -> a -> m (Opcode' b)
forall (m :: * -> *) a b. OpcodeMapper m a b -> a -> m (Opcode' b)
mapOnJumpdest OpcodeMapper m a b
mapper a
a

  -- 0s: Stop and Arithmetic Operations
  Opcode' a
STOP       -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' Opcode' a
forall j. Opcode' j
STOP Opcode' b
forall j. Opcode' j
STOP
  Opcode' a
ADD        -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' Opcode' a
forall j. Opcode' j
ADD Opcode' b
forall j. Opcode' j
ADD
  Opcode' a
MUL        -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' Opcode' a
forall j. Opcode' j
MUL Opcode' b
forall j. Opcode' j
MUL
  Opcode' a
SUB        -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' Opcode' a
forall j. Opcode' j
SUB Opcode' b
forall j. Opcode' j
SUB
  Opcode' a
DIV        -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' Opcode' a
forall j. Opcode' j
DIV Opcode' b
forall j. Opcode' j
DIV
  Opcode' a
SDIV       -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' Opcode' a
forall j. Opcode' j
SDIV Opcode' b
forall j. Opcode' j
SDIV
  Opcode' a
MOD        -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' Opcode' a
forall j. Opcode' j
MOD Opcode' b
forall j. Opcode' j
MOD
  Opcode' a
SMOD       -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' Opcode' a
forall j. Opcode' j
SMOD Opcode' b
forall j. Opcode' j
SMOD
  Opcode' a
ADDMOD     -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' Opcode' a
forall j. Opcode' j
ADDMOD Opcode' b
forall j. Opcode' j
ADDMOD
  Opcode' a
MULMOD     -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' Opcode' a
forall j. Opcode' j
MULMOD Opcode' b
forall j. Opcode' j
MULMOD
  Opcode' a
EXP        -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' Opcode' a
forall j. Opcode' j
EXP Opcode' b
forall j. Opcode' j
EXP
  Opcode' a
SIGNEXTEND -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' Opcode' a
forall j. Opcode' j
SIGNEXTEND Opcode' b
forall j. Opcode' j
SIGNEXTEND

  -- 10s: Comparison & Bitwise Logic Operations
  Opcode' a
LT      -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' Opcode' a
forall j. Opcode' j
LT Opcode' b
forall j. Opcode' j
LT
  Opcode' a
GT      -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' Opcode' a
forall j. Opcode' j
GT Opcode' b
forall j. Opcode' j
GT
  Opcode' a
SLT     -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' Opcode' a
forall j. Opcode' j
SLT Opcode' b
forall j. Opcode' j
SLT
  Opcode' a
SGT     -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' Opcode' a
forall j. Opcode' j
SGT Opcode' b
forall j. Opcode' j
SGT
  Opcode' a
EQ      -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' Opcode' a
forall j. Opcode' j
EQ Opcode' b
forall j. Opcode' j
EQ
  Opcode' a
ISZERO  -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' Opcode' a
forall j. Opcode' j
ISZERO Opcode' b
forall j. Opcode' j
ISZERO
  Opcode' a
AND     -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' Opcode' a
forall j. Opcode' j
AND Opcode' b
forall j. Opcode' j
AND
  Opcode' a
OR      -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' Opcode' a
forall j. Opcode' j
OR Opcode' b
forall j. Opcode' j
OR
  Opcode' a
XOR     -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' Opcode' a
forall j. Opcode' j
XOR Opcode' b
forall j. Opcode' j
XOR
  Opcode' a
NOT     -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' Opcode' a
forall j. Opcode' j
NOT Opcode' b
forall j. Opcode' j
NOT
  Opcode' a
BYTE    -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' Opcode' a
forall j. Opcode' j
BYTE Opcode' b
forall j. Opcode' j
BYTE
  Opcode' a
SHL     -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' Opcode' a
forall j. Opcode' j
SHL Opcode' b
forall j. Opcode' j
SHL
  Opcode' a
SHR     -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' Opcode' a
forall j. Opcode' j
SHR Opcode' b
forall j. Opcode' j
SHR
  Opcode' a
SAR     -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' Opcode' a
forall j. Opcode' j
SAR Opcode' b
forall j. Opcode' j
SAR

  -- 20s: SHA3
  Opcode' a
SHA3 -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' Opcode' a
forall j. Opcode' j
SHA3 Opcode' b
forall j. Opcode' j
SHA3

  -- 30s: Environmental Information
  Opcode' a
ADDRESS        -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' Opcode' a
forall j. Opcode' j
ADDRESS Opcode' b
forall j. Opcode' j
ADDRESS
  Opcode' a
BALANCE        -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' Opcode' a
forall j. Opcode' j
BALANCE Opcode' b
forall j. Opcode' j
BALANCE
  Opcode' a
ORIGIN         -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' Opcode' a
forall j. Opcode' j
ORIGIN Opcode' b
forall j. Opcode' j
ORIGIN
  Opcode' a
CALLER         -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' Opcode' a
forall j. Opcode' j
CALLER Opcode' b
forall j. Opcode' j
CALLER
  Opcode' a
CALLVALUE      -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' Opcode' a
forall j. Opcode' j
CALLVALUE Opcode' b
forall j. Opcode' j
CALLVALUE
  Opcode' a
CALLDATALOAD   -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' Opcode' a
forall j. Opcode' j
CALLDATALOAD Opcode' b
forall j. Opcode' j
CALLDATALOAD
  Opcode' a
CALLDATASIZE   -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' Opcode' a
forall j. Opcode' j
CALLDATASIZE Opcode' b
forall j. Opcode' j
CALLDATASIZE
  Opcode' a
CALLDATACOPY   -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' Opcode' a
forall j. Opcode' j
CALLDATACOPY Opcode' b
forall j. Opcode' j
CALLDATACOPY
  Opcode' a
CODESIZE       -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' Opcode' a
forall j. Opcode' j
CODESIZE Opcode' b
forall j. Opcode' j
CODESIZE
  Opcode' a
CODECOPY       -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' Opcode' a
forall j. Opcode' j
CODECOPY Opcode' b
forall j. Opcode' j
CODECOPY
  Opcode' a
GASPRICE       -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' Opcode' a
forall j. Opcode' j
GASPRICE Opcode' b
forall j. Opcode' j
GASPRICE
  Opcode' a
EXTCODESIZE    -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' Opcode' a
forall j. Opcode' j
EXTCODESIZE Opcode' b
forall j. Opcode' j
EXTCODESIZE
  Opcode' a
EXTCODECOPY    -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' Opcode' a
forall j. Opcode' j
EXTCODECOPY Opcode' b
forall j. Opcode' j
EXTCODECOPY
  Opcode' a
RETURNDATASIZE -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' Opcode' a
forall j. Opcode' j
RETURNDATASIZE Opcode' b
forall j. Opcode' j
RETURNDATASIZE
  Opcode' a
RETURNDATACOPY -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' Opcode' a
forall j. Opcode' j
RETURNDATACOPY Opcode' b
forall j. Opcode' j
RETURNDATACOPY
  Opcode' a
EXTCODEHASH    -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' Opcode' a
forall j. Opcode' j
EXTCODEHASH Opcode' b
forall j. Opcode' j
EXTCODEHASH

  -- 40s: Block Information
  Opcode' a
BLOCKHASH   -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' Opcode' a
forall j. Opcode' j
BLOCKHASH Opcode' b
forall j. Opcode' j
BLOCKHASH
  Opcode' a
COINBASE    -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' Opcode' a
forall j. Opcode' j
COINBASE Opcode' b
forall j. Opcode' j
COINBASE
  Opcode' a
TIMESTAMP   -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' Opcode' a
forall j. Opcode' j
TIMESTAMP Opcode' b
forall j. Opcode' j
TIMESTAMP
  Opcode' a
NUMBER      -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' Opcode' a
forall j. Opcode' j
NUMBER Opcode' b
forall j. Opcode' j
NUMBER
  Opcode' a
DIFFICULTY  -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' Opcode' a
forall j. Opcode' j
DIFFICULTY Opcode' b
forall j. Opcode' j
DIFFICULTY
  Opcode' a
GASLIMIT    -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' Opcode' a
forall j. Opcode' j
GASLIMIT Opcode' b
forall j. Opcode' j
GASLIMIT
  Opcode' a
CHAINID     -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' Opcode' a
forall j. Opcode' j
CHAINID Opcode' b
forall j. Opcode' j
CHAINID
  Opcode' a
SELFBALANCE -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' Opcode' a
forall j. Opcode' j
SELFBALANCE Opcode' b
forall j. Opcode' j
SELFBALANCE

  -- 50s: Stack, Memory, Storage and Flow Operations
  Opcode' a
POP       -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' Opcode' a
forall j. Opcode' j
POP Opcode' b
forall j. Opcode' j
POP
  Opcode' a
MLOAD     -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' Opcode' a
forall j. Opcode' j
MLOAD Opcode' b
forall j. Opcode' j
MLOAD
  Opcode' a
MSTORE    -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' Opcode' a
forall j. Opcode' j
MSTORE Opcode' b
forall j. Opcode' j
MSTORE
  Opcode' a
MSTORE8   -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' Opcode' a
forall j. Opcode' j
MSTORE8 Opcode' b
forall j. Opcode' j
MSTORE8
  Opcode' a
SLOAD     -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' Opcode' a
forall j. Opcode' j
SLOAD Opcode' b
forall j. Opcode' j
SLOAD
  Opcode' a
SSTORE    -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' Opcode' a
forall j. Opcode' j
SSTORE Opcode' b
forall j. Opcode' j
SSTORE
  Opcode' a
PC        -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' Opcode' a
forall j. Opcode' j
PC Opcode' b
forall j. Opcode' j
PC
  Opcode' a
MSIZE     -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' Opcode' a
forall j. Opcode' j
MSIZE Opcode' b
forall j. Opcode' j
MSIZE
  Opcode' a
GAS       -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' Opcode' a
forall j. Opcode' j
GAS Opcode' b
forall j. Opcode' j
GAS

  -- 60s & 70s: Push Operations
  PUSH Word256
n    -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' (Word256 -> Opcode' a
forall j. Word256 -> Opcode' j
PUSH Word256
n) (Word256 -> Opcode' b
forall j. Word256 -> Opcode' j
PUSH Word256
n)

  -- 80s: Duplication Operations (DUP)
  DUP Ord16
i     -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' (Ord16 -> Opcode' a
forall j. Ord16 -> Opcode' j
DUP Ord16
i) (Ord16 -> Opcode' b
forall j. Ord16 -> Opcode' j
DUP Ord16
i)

  -- 90s: Exchange operations (SWAP)
  SWAP Ord16
i    -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' (Ord16 -> Opcode' a
forall j. Ord16 -> Opcode' j
SWAP Ord16
i) (Ord16 -> Opcode' b
forall j. Ord16 -> Opcode' j
SWAP Ord16
i)

  -- a0s: Logging Operations (LOG)
  LOG Ord5
i     -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' (Ord5 -> Opcode' a
forall j. Ord5 -> Opcode' j
LOG Ord5
i) (Ord5 -> Opcode' b
forall j. Ord5 -> Opcode' j
LOG Ord5
i)

  -- f0s: System Operations
  Opcode' a
CREATE       -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' Opcode' a
forall j. Opcode' j
CREATE Opcode' b
forall j. Opcode' j
CREATE
  Opcode' a
CALL         -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' Opcode' a
forall j. Opcode' j
CALL Opcode' b
forall j. Opcode' j
CALL
  Opcode' a
CALLCODE     -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' Opcode' a
forall j. Opcode' j
CALLCODE Opcode' b
forall j. Opcode' j
CALLCODE
  Opcode' a
RETURN       -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' Opcode' a
forall j. Opcode' j
RETURN Opcode' b
forall j. Opcode' j
RETURN
  Opcode' a
DELEGATECALL -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' Opcode' a
forall j. Opcode' j
DELEGATECALL Opcode' b
forall j. Opcode' j
DELEGATECALL
  Opcode' a
CREATE2      -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' Opcode' a
forall j. Opcode' j
CREATE2 Opcode' b
forall j. Opcode' j
CREATE2
  Opcode' a
STATICCALL   -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' Opcode' a
forall j. Opcode' j
STATICCALL Opcode' b
forall j. Opcode' j
STATICCALL
  Opcode' a
REVERT       -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' Opcode' a
forall j. Opcode' j
REVERT Opcode' b
forall j. Opcode' j
REVERT
  Opcode' a
INVALID      -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' Opcode' a
forall j. Opcode' j
INVALID Opcode' b
forall j. Opcode' j
INVALID
  Opcode' a
SELFDESTRUCT -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' Opcode' a
forall j. Opcode' j
SELFDESTRUCT Opcode' b
forall j. Opcode' j
SELFDESTRUCT
  where
    mapOnOther' :: Opcode' a -> Opcode' b -> m (Opcode' b)
    mapOnOther' :: Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' Opcode' a
opa Opcode' b
opbDefault = do
      Maybe (Opcode' b)
res <- OpcodeMapper m a b -> Opcode' a -> m (Maybe (Opcode' b))
forall (m :: * -> *) a b.
OpcodeMapper m a b -> Opcode' a -> m (Maybe (Opcode' b))
mapOnOther OpcodeMapper m a b
mapper Opcode' a
opa
      case Maybe (Opcode' b)
res of
        Just Opcode' b
opb -> Opcode' b -> m (Opcode' b)
forall (m :: * -> *) a. Monad m => a -> m a
return Opcode' b
opb
        Maybe (Opcode' b)
Nothing  -> Opcode' b -> m (Opcode' b)
forall (m :: * -> *) a. Monad m => a -> m a
return Opcode' b
opbDefault