{-# 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
  { forall (m :: * -> *) a b. OpcodeMapper m a b -> a -> m (Opcode' b)
mapOnJump     :: a -> m (Opcode' b)
  , forall (m :: * -> *) a b. OpcodeMapper m a b -> a -> m (Opcode' b)
mapOnJumpi    :: a -> m (Opcode' b)
  , forall (m :: * -> *) a b. OpcodeMapper m a b -> a -> m (Opcode' b)
mapOnJumpdest :: a -> m (Opcode' b)
  , forall (m :: * -> *) a 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 :: forall (m :: * -> *) a b.
Monad m =>
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     -> forall (m :: * -> *) a b. OpcodeMapper m a b -> a -> m (Opcode' b)
mapOnJump OpcodeMapper m a b
mapper a
a
  JUMPI a
a    -> forall (m :: * -> *) a b. OpcodeMapper m a b -> a -> m (Opcode' b)
mapOnJumpi OpcodeMapper m a b
mapper a
a
  JUMPDEST a
a -> 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' forall j. Opcode' j
STOP forall j. Opcode' j
STOP
  Opcode' a
ADD        -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' forall j. Opcode' j
ADD forall j. Opcode' j
ADD
  Opcode' a
MUL        -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' forall j. Opcode' j
MUL forall j. Opcode' j
MUL
  Opcode' a
SUB        -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' forall j. Opcode' j
SUB forall j. Opcode' j
SUB
  Opcode' a
DIV        -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' forall j. Opcode' j
DIV forall j. Opcode' j
DIV
  Opcode' a
SDIV       -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' forall j. Opcode' j
SDIV forall j. Opcode' j
SDIV
  Opcode' a
MOD        -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' forall j. Opcode' j
MOD forall j. Opcode' j
MOD
  Opcode' a
SMOD       -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' forall j. Opcode' j
SMOD forall j. Opcode' j
SMOD
  Opcode' a
ADDMOD     -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' forall j. Opcode' j
ADDMOD forall j. Opcode' j
ADDMOD
  Opcode' a
MULMOD     -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' forall j. Opcode' j
MULMOD forall j. Opcode' j
MULMOD
  Opcode' a
EXP        -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' forall j. Opcode' j
EXP forall j. Opcode' j
EXP
  Opcode' a
SIGNEXTEND -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' forall j. Opcode' j
SIGNEXTEND forall j. Opcode' j
SIGNEXTEND

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

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

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

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

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

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

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

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

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

  -- f0s: System Operations
  Opcode' a
CREATE       -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' forall j. Opcode' j
CREATE forall j. Opcode' j
CREATE
  Opcode' a
CALL         -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' forall j. Opcode' j
CALL forall j. Opcode' j
CALL
  Opcode' a
CALLCODE     -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' forall j. Opcode' j
CALLCODE forall j. Opcode' j
CALLCODE
  Opcode' a
RETURN       -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' forall j. Opcode' j
RETURN forall j. Opcode' j
RETURN
  Opcode' a
DELEGATECALL -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' forall j. Opcode' j
DELEGATECALL forall j. Opcode' j
DELEGATECALL
  Opcode' a
CREATE2      -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' forall j. Opcode' j
CREATE2 forall j. Opcode' j
CREATE2
  Opcode' a
STATICCALL   -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' forall j. Opcode' j
STATICCALL forall j. Opcode' j
STATICCALL
  Opcode' a
REVERT       -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' forall j. Opcode' j
REVERT forall j. Opcode' j
REVERT
  Opcode' a
INVALID      -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' forall j. Opcode' j
INVALID forall j. Opcode' j
INVALID
  Opcode' a
SELFDESTRUCT -> Opcode' a -> Opcode' b -> m (Opcode' b)
mapOnOther' forall j. Opcode' j
SELFDESTRUCT 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 <- 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return Opcode' b
opb
        Maybe (Opcode' b)
Nothing  -> forall (m :: * -> *) a. Monad m => a -> m a
return Opcode' b
opbDefault