{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
-- {-# OPTIONS_GHC -funbox-strict-fields #-}
{-# LANGUAGE DeriveAnyClass     #-}
{-# LANGUAGE StrictData     #-}
{-# LANGUAGE LambdaCase         #-}
{-# LANGUAGE BangPatterns       #-}
{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE FlexibleContexts   #-}
{-# LANGUAGE FlexibleInstances  #-}
{-# LANGUAGE RecordWildCards    #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell    #-}
{-# LANGUAGE TupleSections      #-}
{-|
Module      : Language.JVM.ByteCode
Copyright   : (c) Christian Gram Kalhauge, 2018
License     : MIT
Maintainer  : kalhuage@cs.ucla.edu
-}
module Language.JVM.ByteCode
  ( ByteCode (..)
  , unByteCode

  -- * evolve and devolve
  , evolveByteCode
  , devolveByteCode
  , evolveOffset
  , devolveOffset

  , ByteCodeStaged (..)

  -- * Managing offsets
  , ByteCodeInst (..)
  , ByteCodeRef
  , ByteCodeOffset
  , ByteCodeIndex
  , OffsetMap
  , indexOffset
  , offsetIndex
  , offsetMap

  , generateOffsets

  -- * ByteCode Operations
  , ByteCodeOpr (..)

  , BConstant
  , CConstant (..)
  , OneOrTwo (..)

  , SwitchTable (..)
  , switchHigh

  , FieldAccess (..)
  , Invocation (..)

  , ShortRelativeRef
  , LongRelativeRef
  , NewArrayType (..)
  , newArrayTypeType
  , LowNewArrayType (..)

  -- * Operations
  , BinOpr (..)
  , BitOpr (..)
  , CmpOpr (..)
  , CastOpr (..)

  -- * Type sets
  , ArithmeticType (..)
  , SmallArithmeticType (..)
  , LocalType (..)
  , ArrayType (..)

  -- * Renames
  , WordSize
  , ByteOffset
  , LocalAddress
  , IncrementAmount
  ) where

import           GHC.Generics          (Generic)

import           Numeric               (showHex)
import           Prelude               hiding (fail)

import           Control.DeepSeq       (NFData)
import           Control.Monad         hiding (fail)
import           Control.Monad.Fail    (fail)
import           Unsafe.Coerce

import           Data.Binary
import           Data.Binary.Get       hiding (Get, label)
import           Data.Binary.Put       hiding (Put)
import qualified Data.ByteString.Lazy  as BL
import           Data.Int
import qualified Data.IntMap.Strict           as IM
import qualified Data.Vector           as V

import           Language.JVM.Constant
import           Language.JVM.Staged
import           Language.JVM.Type

-- | ByteCode constains a list of ByteCode instructions and the size of the bytecode.
-- if the ByteCode is in the Low stage then the byte code instructions are
-- annotated with the byte code offsets.
data ByteCode i = ByteCode
  { ByteCode i -> Word32
byteCodeSize :: !Word32
  , ByteCode i -> Vector (ByteCodeInst i)
byteCodeInstructions :: V.Vector (ByteCodeInst i)
  }

unByteCode :: ByteCode i -> V.Vector (ByteCodeInst i)
unByteCode :: ByteCode i -> Vector (ByteCodeInst i)
unByteCode = ByteCode i -> Vector (ByteCodeInst i)
forall i. ByteCode i -> Vector (ByteCodeInst i)
byteCodeInstructions

-- | The offset in the byte code
type ByteCodeOffset = Word16

-- | The index of the byte code.
type ByteCodeIndex = Int

-- | A ByteCode reference is either byte code offset in the
-- low stage, and a byte code index in the high state
type ByteCodeRef i  = Choice ByteCodeOffset ByteCodeIndex i

-- | The offset map, maps offset to instruction ids.
type OffsetMap = IM.IntMap ByteCodeIndex

-- | Given an `OffsetMap` turn a offset into a bytecode index
offsetIndex :: OffsetMap -> ByteCodeOffset -> Maybe (ByteCodeIndex)
offsetIndex :: OffsetMap -> ByteCodeOffset -> Maybe Int
offsetIndex OffsetMap
o ByteCodeOffset
i = Int -> OffsetMap -> Maybe Int
forall a. Int -> IntMap a -> Maybe a
IM.lookup (ByteCodeOffset -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ByteCodeOffset
i) OffsetMap
o

-- | Given an `OffsetMap` turn a offset into a bytecode index
evolveOffset ::
  EvolveM m
  => OffsetMap
  -> ByteCodeOffset
  -> m (ByteCodeIndex)
evolveOffset :: OffsetMap -> ByteCodeOffset -> m Int
evolveOffset OffsetMap
o ByteCodeOffset
i =
  case OffsetMap -> ByteCodeOffset -> Maybe Int
offsetIndex OffsetMap
o ByteCodeOffset
i of
    Just Int
a -> Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> m Int) -> Int -> m Int
forall a b. (a -> b) -> a -> b
$ Int
a
    Maybe Int
Nothing ->
      String -> m Int
forall (m :: * -> *) r. EvolveM m => String -> m r
evolveError (String -> m Int) -> String -> m Int
forall a b. (a -> b) -> a -> b
$ String
"Not valid offset " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteCodeOffset -> String
forall a. Show a => a -> String
show ByteCodeOffset
i

-- | Given low byte code we can create an `OffsetMap`
offsetMap :: ByteCode Low -> OffsetMap
offsetMap :: ByteCode Low -> OffsetMap
offsetMap (ByteCode Word32
l Vector (ByteCodeInst Low)
v) =
  [(Int, Int)] -> OffsetMap
forall a. [(Int, a)] -> IntMap a
IM.fromList
    ([(Int, Int)] -> OffsetMap)
-> (Vector (ByteCodeInst Low) -> [(Int, Int)])
-> Vector (ByteCodeInst Low)
-> OffsetMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
l, Vector (ByteCodeInst Low) -> Int
forall a. Vector a -> Int
V.length Vector (ByteCodeInst Low)
v)(Int, Int) -> [(Int, Int)] -> [(Int, Int)]
forall a. a -> [a] -> [a]
:)
    ([(Int, Int)] -> [(Int, Int)])
-> (Vector (ByteCodeInst Low) -> [(Int, Int)])
-> Vector (ByteCodeInst Low)
-> [(Int, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(Int, Int)] -> Int -> ByteCodeInst Low -> [(Int, Int)])
-> [(Int, Int)] -> Vector (ByteCodeInst Low) -> [(Int, Int)]
forall a b. (a -> Int -> b -> a) -> a -> Vector b -> a
V.ifoldl' (\[(Int, Int)]
ls Int
idx ByteCodeInst Low
i -> (ByteCodeOffset -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteCodeOffset -> Int) -> ByteCodeOffset -> Int
forall a b. (a -> b) -> a -> b
$ ByteCodeInst Low -> ByteCodeOffset
forall r. ByteCodeInst r -> ByteCodeOffset
offset ByteCodeInst Low
i, Int
idx) (Int, Int) -> [(Int, Int)] -> [(Int, Int)]
forall a. a -> [a] -> [a]
: [(Int, Int)]
ls) []
    (Vector (ByteCodeInst Low) -> OffsetMap)
-> Vector (ByteCodeInst Low) -> OffsetMap
forall a b. (a -> b) -> a -> b
$ Vector (ByteCodeInst Low)
v

-- | Given an `OffsetMap` turn a offset into a bytecode index
devolveOffset ::
  DevolveM m
  => ByteCode Low
  -> ByteCodeIndex
  -> m (ByteCodeOffset)
devolveOffset :: ByteCode Low -> Int -> m ByteCodeOffset
devolveOffset ByteCode Low
v Int
i = do
  case ByteCode Low -> Int -> Maybe ByteCodeOffset
indexOffset ByteCode Low
v Int
i of
    Just ByteCodeOffset
x ->
      ByteCodeOffset -> m ByteCodeOffset
forall (m :: * -> *) a. Monad m => a -> m a
return ByteCodeOffset
x
    Maybe ByteCodeOffset
Nothing ->
      String -> m ByteCodeOffset
forall a. HasCallStack => String -> a
error (String -> m ByteCodeOffset) -> String -> m ByteCodeOffset
forall a b. (a -> b) -> a -> b
$ String
"Bad index " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i

-- | Return the bytecode offset from the bytecode.
indexOffset :: ByteCode Low -> ByteCodeIndex -> Maybe (ByteCodeOffset)
indexOffset :: ByteCode Low -> Int -> Maybe ByteCodeOffset
indexOffset (ByteCode Word32
x Vector (ByteCodeInst Low)
bc) Int
i =
  if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Vector (ByteCodeInst Low) -> Int
forall a. Vector a -> Int
V.length Vector (ByteCodeInst Low)
bc
    then ByteCodeOffset -> Maybe ByteCodeOffset
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32 -> ByteCodeOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
x)
    else ByteCodeInst Low -> ByteCodeOffset
forall r. ByteCodeInst r -> ByteCodeOffset
offset (ByteCodeInst Low -> ByteCodeOffset)
-> Maybe (ByteCodeInst Low) -> Maybe ByteCodeOffset
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector (ByteCodeInst Low)
bc Vector (ByteCodeInst Low) -> Int -> Maybe (ByteCodeInst Low)
forall a. Vector a -> Int -> Maybe a
V.!? Int
i

devolveOffset' ::
  DevolveM m
  => V.Vector ByteCodeOffset
  -> ByteCodeIndex
  -> m (ByteCodeOffset)
devolveOffset' :: Vector ByteCodeOffset -> Int -> m ByteCodeOffset
devolveOffset' Vector ByteCodeOffset
v Int
i = do
  case Vector ByteCodeOffset -> Int -> Maybe ByteCodeOffset
indexOffset' Vector ByteCodeOffset
v Int
i of
    Just ByteCodeOffset
x ->
      ByteCodeOffset -> m ByteCodeOffset
forall (m :: * -> *) a. Monad m => a -> m a
return ByteCodeOffset
x
    Maybe ByteCodeOffset
Nothing ->
      String -> m ByteCodeOffset
forall a. HasCallStack => String -> a
error (String -> m ByteCodeOffset) -> String -> m ByteCodeOffset
forall a b. (a -> b) -> a -> b
$ String
"Bad index " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i

indexOffset' :: V.Vector ByteCodeOffset -> ByteCodeIndex -> Maybe (ByteCodeOffset)
indexOffset' :: Vector ByteCodeOffset -> Int -> Maybe ByteCodeOffset
indexOffset' Vector ByteCodeOffset
c Int
i = Vector ByteCodeOffset
c Vector ByteCodeOffset -> Int -> Maybe ByteCodeOffset
forall a. Vector a -> Int -> Maybe a
V.!? Int
i

-- | The byte code instruction is mostly used to succinctly read and
-- write an bytecode instruction from a bytestring.
data ByteCodeInst r = ByteCodeInst
  { ByteCodeInst r -> ByteCodeOffset
offset :: !(ByteCodeOffset)
  , ByteCodeInst r -> ByteCodeOpr r
opcode :: !(ByteCodeOpr r)
  }

evolveByteCode :: EvolveM m => ByteCode Low -> m (OffsetMap, ByteCode High)
evolveByteCode :: ByteCode Low -> m (OffsetMap, ByteCode High)
evolveByteCode bc :: ByteCode Low
bc@(ByteCode Word32
ln Vector (ByteCodeInst Low)
v) = do
  let !om :: OffsetMap
om = ByteCode Low -> OffsetMap
offsetMap ByteCode Low
bc
  Vector (ByteCodeInst High)
x <- (ByteCodeInst Low -> m (ByteCodeInst High))
-> Vector (ByteCodeInst Low) -> m (Vector (ByteCodeInst High))
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Vector a -> m (Vector b)
V.mapM ((ByteCodeOffset -> m Int)
-> ByteCodeInst Low -> m (ByteCodeInst High)
forall (m :: * -> *).
EvolveM m =>
(ByteCodeOffset -> m Int)
-> ByteCodeInst Low -> m (ByteCodeInst High)
evolveByteCodeInst (OffsetMap -> ByteCodeOffset -> m Int
forall (m :: * -> *).
EvolveM m =>
OffsetMap -> ByteCodeOffset -> m Int
evolveOffset OffsetMap
om)) Vector (ByteCodeInst Low)
v
  (OffsetMap, ByteCode High) -> m (OffsetMap, ByteCode High)
forall (m :: * -> *) a. Monad m => a -> m a
return ((OffsetMap, ByteCode High) -> m (OffsetMap, ByteCode High))
-> (ByteCode High -> (OffsetMap, ByteCode High))
-> ByteCode High
-> m (OffsetMap, ByteCode High)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OffsetMap
om,) (ByteCode High -> m (OffsetMap, ByteCode High))
-> ByteCode High -> m (OffsetMap, ByteCode High)
forall a b. (a -> b) -> a -> b
$ Word32 -> Vector (ByteCodeInst High) -> ByteCode High
forall i. Word32 -> Vector (ByteCodeInst i) -> ByteCode i
ByteCode Word32
ln Vector (ByteCodeInst High)
x

devolveByteCode :: DevolveM m => ByteCode High -> m (ByteCode Low)
devolveByteCode :: ByteCode High -> m (ByteCode Low)
devolveByteCode (ByteCode Word32
_ Vector (ByteCodeInst High)
bc) = do
  -- Devolving byte code is not straight forward.
  (ByteCodeOffset
len, Vector ByteCodeOffset
offsets) <- Vector (ByteCodeOpr High)
-> m (ByteCodeOffset, Vector ByteCodeOffset)
forall (m :: * -> *).
DevolveM m =>
Vector (ByteCodeOpr High)
-> m (ByteCodeOffset, Vector ByteCodeOffset)
generateOffsets ((ByteCodeInst High -> ByteCodeOpr High)
-> Vector (ByteCodeInst High) -> Vector (ByteCodeOpr High)
forall a b. (a -> b) -> Vector a -> Vector b
V.map ByteCodeInst High -> ByteCodeOpr High
forall r. ByteCodeInst r -> ByteCodeOpr r
opcode Vector (ByteCodeInst High)
bc)
  Word32 -> Vector (ByteCodeInst Low) -> ByteCode Low
forall i. Word32 -> Vector (ByteCodeInst i) -> ByteCode i
ByteCode (ByteCodeOffset -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral ByteCodeOffset
len)
    (Vector (ByteCodeInst Low) -> ByteCode Low)
-> m (Vector (ByteCodeInst Low)) -> m (ByteCode Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ByteCodeInst High -> m (ByteCodeInst Low))
-> Vector (ByteCodeInst High) -> m (Vector (ByteCodeInst Low))
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Vector a -> m (Vector b)
V.mapM
      ((Int -> m ByteCodeOffset)
-> ByteCodeInst High -> m (ByteCodeInst Low)
forall (m :: * -> *).
DevolveM m =>
(Int -> m ByteCodeOffset)
-> ByteCodeInst High -> m (ByteCodeInst Low)
devolveByteCodeInst (Vector ByteCodeOffset -> Int -> m ByteCodeOffset
forall (m :: * -> *).
DevolveM m =>
Vector ByteCodeOffset -> Int -> m ByteCodeOffset
devolveOffset' Vector ByteCodeOffset
offsets))
      ((ByteCodeInst High -> ByteCodeOffset -> ByteCodeInst High)
-> Vector (ByteCodeInst High)
-> Vector ByteCodeOffset
-> Vector (ByteCodeInst High)
forall a b c. (a -> b -> c) -> Vector a -> Vector b -> Vector c
V.zipWith ((ByteCodeOffset -> ByteCodeOpr High -> ByteCodeInst High)
-> ByteCodeOpr High -> ByteCodeOffset -> ByteCodeInst High
forall a b c. (a -> b -> c) -> b -> a -> c
flip ByteCodeOffset -> ByteCodeOpr High -> ByteCodeInst High
forall r. ByteCodeOffset -> ByteCodeOpr r -> ByteCodeInst r
ByteCodeInst (ByteCodeOpr High -> ByteCodeOffset -> ByteCodeInst High)
-> (ByteCodeInst High -> ByteCodeOpr High)
-> ByteCodeInst High
-> ByteCodeOffset
-> ByteCodeInst High
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteCodeInst High -> ByteCodeOpr High
forall r. ByteCodeInst r -> ByteCodeOpr r
opcode) Vector (ByteCodeInst High)
bc Vector ByteCodeOffset
offsets)

generateOffsets :: DevolveM m => V.Vector (ByteCodeOpr High) -> m (Word16, V.Vector ByteCodeOffset)
generateOffsets :: Vector (ByteCodeOpr High)
-> m (ByteCodeOffset, Vector ByteCodeOffset)
generateOffsets Vector (ByteCodeOpr High)
bc = do
  (ByteCodeOffset
len, [ByteCodeOffset]
vect) <- ((ByteCodeOffset, [ByteCodeOffset])
 -> ByteCodeOpr High -> m (ByteCodeOffset, [ByteCodeOffset]))
-> (ByteCodeOffset, [ByteCodeOffset])
-> Vector (ByteCodeOpr High)
-> m (ByteCodeOffset, [ByteCodeOffset])
forall (m :: * -> *) a b.
Monad m =>
(a -> b -> m a) -> a -> Vector b -> m a
V.foldM' (ByteCodeOffset, [ByteCodeOffset])
-> ByteCodeOpr High -> m (ByteCodeOffset, [ByteCodeOffset])
forall (m :: * -> *).
DevolveM m =>
(ByteCodeOffset, [ByteCodeOffset])
-> ByteCodeOpr High -> m (ByteCodeOffset, [ByteCodeOffset])
acc (ByteCodeOffset
0,[]) Vector (ByteCodeOpr High)
bc
  (ByteCodeOffset, Vector ByteCodeOffset)
-> m (ByteCodeOffset, Vector ByteCodeOffset)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOffset
len, [ByteCodeOffset] -> Vector ByteCodeOffset
forall a. [a] -> Vector a
V.fromList ([ByteCodeOffset] -> Vector ByteCodeOffset)
-> ([ByteCodeOffset] -> [ByteCodeOffset])
-> [ByteCodeOffset]
-> Vector ByteCodeOffset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteCodeOffset] -> [ByteCodeOffset]
forall a. [a] -> [a]
reverse ([ByteCodeOffset] -> Vector ByteCodeOffset)
-> [ByteCodeOffset] -> Vector ByteCodeOffset
forall a b. (a -> b) -> a -> b
$ [ByteCodeOffset]
vect)
  where
    acc :: (ByteCodeOffset, [ByteCodeOffset])
-> ByteCodeOpr High -> m (ByteCodeOffset, [ByteCodeOffset])
acc (ByteCodeOffset
off, [ByteCodeOffset]
lst) ByteCodeOpr High
opr = do
      ByteCodeInst Low
inst <- (Int -> m ByteCodeOffset)
-> ByteCodeInst High -> m (ByteCodeInst Low)
forall (m :: * -> *).
DevolveM m =>
(Int -> m ByteCodeOffset)
-> ByteCodeInst High -> m (ByteCodeInst Low)
devolveByteCodeInst (m ByteCodeOffset -> Int -> m ByteCodeOffset
forall a b. a -> b -> a
const (m ByteCodeOffset -> Int -> m ByteCodeOffset)
-> m ByteCodeOffset -> Int -> m ByteCodeOffset
forall a b. (a -> b) -> a -> b
$ ByteCodeOffset -> m ByteCodeOffset
forall (m :: * -> *) a. Monad m => a -> m a
return ByteCodeOffset
0) (ByteCodeOffset -> ByteCodeOpr High -> ByteCodeInst High
forall r. ByteCodeOffset -> ByteCodeOpr r -> ByteCodeInst r
ByteCodeInst ByteCodeOffset
off ByteCodeOpr High
opr)
      let o :: ByteCodeOffset
o = ByteCodeOffset
off ByteCodeOffset -> ByteCodeOffset -> ByteCodeOffset
forall a. Num a => a -> a -> a
+ ByteCodeInst Low -> ByteCodeOffset
byteSize ByteCodeInst Low
inst
      (ByteCodeOffset, [ByteCodeOffset])
-> m (ByteCodeOffset, [ByteCodeOffset])
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOffset
o, ByteCodeOffset
offByteCodeOffset -> [ByteCodeOffset] -> [ByteCodeOffset]
forall a. a -> [a] -> [a]
:[ByteCodeOffset]
lst)

class ByteCodeStaged s where
  evolveBC ::
    EvolveM m
    => (ByteCodeOffset -> m ByteCodeIndex)
    -> s Low
    -> m (s High)

  devolveBC ::
    DevolveM m
    => (ByteCodeIndex -> m ByteCodeOffset)
    -> s High
    -> m (s Low)

byteSize :: ByteCodeInst Low -> Word16
byteSize :: ByteCodeInst Low -> ByteCodeOffset
byteSize ByteCodeInst Low
inst =
  Int64 -> ByteCodeOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> ByteCodeOffset)
-> (Put -> Int64) -> Put -> ByteCodeOffset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int64
BL.length (ByteString -> Int64) -> (Put -> ByteString) -> Put -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPut (Put -> ByteCodeOffset) -> Put -> ByteCodeOffset
forall a b. (a -> b) -> a -> b
$ ByteCodeOffset -> ByteCodeOpr Low -> Put
putByteCode (ByteCodeInst Low -> ByteCodeOffset
forall r. ByteCodeInst r -> ByteCodeOffset
offset ByteCodeInst Low
inst) (ByteCodeInst Low -> ByteCodeOpr Low
forall r. ByteCodeInst r -> ByteCodeOpr r
opcode ByteCodeInst Low
inst)

instance ByteCodeStaged ByteCodeInst where
  evolveBC :: (ByteCodeOffset -> m Int)
-> ByteCodeInst Low -> m (ByteCodeInst High)
evolveBC = (ByteCodeOffset -> m Int)
-> ByteCodeInst Low -> m (ByteCodeInst High)
forall (m :: * -> *).
EvolveM m =>
(ByteCodeOffset -> m Int)
-> ByteCodeInst Low -> m (ByteCodeInst High)
evolveByteCodeInst
  devolveBC :: (Int -> m ByteCodeOffset)
-> ByteCodeInst High -> m (ByteCodeInst Low)
devolveBC = (Int -> m ByteCodeOffset)
-> ByteCodeInst High -> m (ByteCodeInst Low)
forall (m :: * -> *).
DevolveM m =>
(Int -> m ByteCodeOffset)
-> ByteCodeInst High -> m (ByteCodeInst Low)
devolveByteCodeInst


newArrayTypeType :: NewArrayType -> JRefType
newArrayTypeType :: NewArrayType -> JRefType
newArrayTypeType (NewArrayType Word8
n JType
m) = Word8 -> JType -> JRefType
extendArrays Word8
n JType
m
  where
    extendArrays :: Word8 -> JType -> JRefType
    extendArrays :: Word8 -> JType -> JRefType
extendArrays Word8
1 = JType -> JRefType
JTArray
    extendArrays Word8
n = Word8 -> JType -> JRefType
extendArrays (Word8
nWord8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
-Word8
1) (JType -> JRefType) -> (JType -> JType) -> JType -> JRefType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JRefType -> JType
JTRef (JRefType -> JType) -> (JType -> JRefType) -> JType -> JType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JType -> JRefType
JTArray

evolveNewArrayType :: EvolveM m => LowNewArrayType -> m NewArrayType
evolveNewArrayType :: LowNewArrayType -> m NewArrayType
evolveNewArrayType = \case
  ArrayBaseType JBaseType
b -> NewArrayType -> m NewArrayType
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NewArrayType -> m NewArrayType) -> NewArrayType -> m NewArrayType
forall a b. (a -> b) -> a -> b
$ Word8 -> JType -> NewArrayType
NewArrayType Word8
1 (JBaseType -> JType
JTBase JBaseType
b)
  ArrayReference Ref JRefType Low
_ Word8
0 -> String -> m NewArrayType
forall (m :: * -> *) r. EvolveM m => String -> m r
evolveError String
"Invalid bytecode instruction"
  ArrayReference Ref JRefType Low
m Word8
1 -> do
    JRefType
m' <- ByteCodeOffset -> m JRefType
forall (m :: * -> *) r.
(EvolveM m, Referenceable r) =>
ByteCodeOffset -> m r
link ByteCodeOffset
Ref JRefType Low
m
    NewArrayType -> m NewArrayType
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NewArrayType -> m NewArrayType) -> NewArrayType -> m NewArrayType
forall a b. (a -> b) -> a -> b
$ Word8 -> JType -> NewArrayType
NewArrayType Word8
1 (JRefType -> JType
JTRef JRefType
m')
  ArrayReference Ref JRefType Low
m Word8
n -> do
    JRefType
m' <- ByteCodeOffset -> m JRefType
forall (m :: * -> *) r.
(EvolveM m, Referenceable r) =>
ByteCodeOffset -> m r
link ByteCodeOffset
Ref JRefType Low
m
    JType
m'' <- Word8 -> JType -> m JType
forall t (f :: * -> *).
(Eq t, Num t, EvolveM f) =>
t -> JType -> f JType
dropArrays Word8
n (JRefType -> JType
JTRef JRefType
m')
    NewArrayType -> m NewArrayType
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NewArrayType -> m NewArrayType) -> NewArrayType -> m NewArrayType
forall a b. (a -> b) -> a -> b
$ Word8 -> JType -> NewArrayType
NewArrayType Word8
n JType
m''

  where
    dropArrays :: t -> JType -> f JType
dropArrays t
0 = JType -> f JType
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    dropArrays t
n = \case
      JTRef (JTArray JType
a) ->
        t -> JType -> f JType
dropArrays (t
n t -> t -> t
forall a. Num a => a -> a -> a
- t
1) JType
a
      JType
a ->
        String -> f JType
forall (m :: * -> *) r. EvolveM m => String -> m r
evolveError (String
"expected array got" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> JType -> String
forall a. Show a => a -> String
show JType
a)

devolveNewArrayType :: DevolveM m => NewArrayType -> m LowNewArrayType
devolveNewArrayType :: NewArrayType -> m LowNewArrayType
devolveNewArrayType = \case
  NewArrayType Word8
0 JType
_ -> String -> m LowNewArrayType
forall a. HasCallStack => String -> a
error String
"NewArrayType cannot have 0 dimentions"
  NewArrayType Word8
1 (JTBase JBaseType
m) ->
    LowNewArrayType -> m LowNewArrayType
forall (m :: * -> *) a. Monad m => a -> m a
return (LowNewArrayType -> m LowNewArrayType)
-> LowNewArrayType -> m LowNewArrayType
forall a b. (a -> b) -> a -> b
$ JBaseType -> LowNewArrayType
ArrayBaseType JBaseType
m
  NewArrayType Word8
1 (JTRef JRefType
m) -> do
    ByteCodeOffset
m' <- JRefType -> m ByteCodeOffset
forall (m :: * -> *) r.
(DevolveM m, Referenceable r) =>
r -> m ByteCodeOffset
unlink JRefType
m
    LowNewArrayType -> m LowNewArrayType
forall (m :: * -> *) a. Monad m => a -> m a
return (LowNewArrayType -> m LowNewArrayType)
-> LowNewArrayType -> m LowNewArrayType
forall a b. (a -> b) -> a -> b
$ Ref JRefType Low -> Word8 -> LowNewArrayType
ArrayReference ByteCodeOffset
Ref JRefType Low
m' Word8
1
  a :: NewArrayType
a@(NewArrayType Word8
n JType
_) -> do
    ByteCodeOffset
m' <- JRefType -> m ByteCodeOffset
forall (m :: * -> *) r.
(DevolveM m, Referenceable r) =>
r -> m ByteCodeOffset
unlink (NewArrayType -> JRefType
newArrayTypeType NewArrayType
a)
    LowNewArrayType -> m LowNewArrayType
forall (m :: * -> *) a. Monad m => a -> m a
return (LowNewArrayType -> m LowNewArrayType)
-> LowNewArrayType -> m LowNewArrayType
forall a b. (a -> b) -> a -> b
$ Ref JRefType Low -> Word8 -> LowNewArrayType
ArrayReference ByteCodeOffset
Ref JRefType Low
m' Word8
n



evolveByteCodeInst ::
  EvolveM m
  => (ByteCodeOffset -> m ByteCodeIndex)
  -> ByteCodeInst Low
  -> m (ByteCodeInst High)
evolveByteCodeInst :: (ByteCodeOffset -> m Int)
-> ByteCodeInst Low -> m (ByteCodeInst High)
evolveByteCodeInst ByteCodeOffset -> m Int
g (ByteCodeInst ByteCodeOffset
ofs ByteCodeOpr Low
opr) = do
  ByteCodeOpr High
x <- case ByteCodeOpr Low
opr of
    Push BConstant Low
c            -> String -> m (ByteCodeOpr High) -> m (ByteCodeOpr High)
forall (m :: * -> *) a. LabelM m => String -> m a -> m a
label String
"Push" (m (ByteCodeOpr High) -> m (ByteCodeOpr High))
-> m (ByteCodeOpr High) -> m (ByteCodeOpr High)
forall a b. (a -> b) -> a -> b
$ Maybe JValue -> ByteCodeOpr High
forall r. BConstant r -> ByteCodeOpr r
Push (Maybe JValue -> ByteCodeOpr High)
-> m (Maybe JValue) -> m (ByteCodeOpr High)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BConstant Low -> m (BConstant High)
forall (m :: * -> *).
EvolveM m =>
BConstant Low -> m (BConstant High)
evolveBConstant BConstant Low
c
    Get FieldAccess
fa Ref AbsFieldId Low
r          -> String -> m (ByteCodeOpr High) -> m (ByteCodeOpr High)
forall (m :: * -> *) a. LabelM m => String -> m a -> m a
label String
"Get" (m (ByteCodeOpr High) -> m (ByteCodeOpr High))
-> m (ByteCodeOpr High) -> m (ByteCodeOpr High)
forall a b. (a -> b) -> a -> b
$ FieldAccess -> Ref AbsFieldId High -> ByteCodeOpr High
forall r. FieldAccess -> Ref AbsFieldId r -> ByteCodeOpr r
Get FieldAccess
fa (AbsFieldId -> ByteCodeOpr High)
-> m AbsFieldId -> m (ByteCodeOpr High)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteCodeOffset -> m AbsFieldId
forall (m :: * -> *) r.
(EvolveM m, Referenceable r) =>
ByteCodeOffset -> m r
link ByteCodeOffset
Ref AbsFieldId Low
r
    Put FieldAccess
fa Ref AbsFieldId Low
r          -> String -> m (ByteCodeOpr High) -> m (ByteCodeOpr High)
forall (m :: * -> *) a. LabelM m => String -> m a -> m a
label String
"Put" (m (ByteCodeOpr High) -> m (ByteCodeOpr High))
-> m (ByteCodeOpr High) -> m (ByteCodeOpr High)
forall a b. (a -> b) -> a -> b
$ FieldAccess -> Ref AbsFieldId High -> ByteCodeOpr High
forall r. FieldAccess -> Ref AbsFieldId r -> ByteCodeOpr r
Put FieldAccess
fa (AbsFieldId -> ByteCodeOpr High)
-> m AbsFieldId -> m (ByteCodeOpr High)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteCodeOffset -> m AbsFieldId
forall (m :: * -> *) r.
(EvolveM m, Referenceable r) =>
ByteCodeOffset -> m r
link ByteCodeOffset
Ref AbsFieldId Low
r
    Invoke Invocation Low
r          -> String -> m (ByteCodeOpr High) -> m (ByteCodeOpr High)
forall (m :: * -> *) a. LabelM m => String -> m a -> m a
label String
"Invoke" (m (ByteCodeOpr High) -> m (ByteCodeOpr High))
-> m (ByteCodeOpr High) -> m (ByteCodeOpr High)
forall a b. (a -> b) -> a -> b
$ Invocation High -> ByteCodeOpr High
forall r. Invocation r -> ByteCodeOpr r
Invoke (Invocation High -> ByteCodeOpr High)
-> m (Invocation High) -> m (ByteCodeOpr High)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Invocation Low -> m (Invocation High)
forall (s :: * -> *) (m :: * -> *).
(Staged s, EvolveM m) =>
s Low -> m (s High)
evolve Invocation Low
r
    New Ref ClassName Low
r             -> String -> m (ByteCodeOpr High) -> m (ByteCodeOpr High)
forall (m :: * -> *) a. LabelM m => String -> m a -> m a
label String
"New" (m (ByteCodeOpr High) -> m (ByteCodeOpr High))
-> m (ByteCodeOpr High) -> m (ByteCodeOpr High)
forall a b. (a -> b) -> a -> b
$ ClassName -> ByteCodeOpr High
forall r. Ref ClassName r -> ByteCodeOpr r
New (ClassName -> ByteCodeOpr High)
-> m ClassName -> m (ByteCodeOpr High)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteCodeOffset -> m ClassName
forall (m :: * -> *) r.
(EvolveM m, Referenceable r) =>
ByteCodeOffset -> m r
link ByteCodeOffset
Ref ClassName Low
r
    NewArray Choice LowNewArrayType NewArrayType Low
r        -> String -> m (ByteCodeOpr High) -> m (ByteCodeOpr High)
forall (m :: * -> *) a. LabelM m => String -> m a -> m a
label String
"NewArray" (m (ByteCodeOpr High) -> m (ByteCodeOpr High))
-> m (ByteCodeOpr High) -> m (ByteCodeOpr High)
forall a b. (a -> b) -> a -> b
$ NewArrayType -> ByteCodeOpr High
forall r. Choice LowNewArrayType NewArrayType r -> ByteCodeOpr r
NewArray (NewArrayType -> ByteCodeOpr High)
-> m NewArrayType -> m (ByteCodeOpr High)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LowNewArrayType -> m NewArrayType
forall (m :: * -> *).
EvolveM m =>
LowNewArrayType -> m NewArrayType
evolveNewArrayType Choice LowNewArrayType NewArrayType Low
LowNewArrayType
r
    CheckCast Ref JRefType Low
r       -> String -> m (ByteCodeOpr High) -> m (ByteCodeOpr High)
forall (m :: * -> *) a. LabelM m => String -> m a -> m a
label String
"CheckCast" (m (ByteCodeOpr High) -> m (ByteCodeOpr High))
-> m (ByteCodeOpr High) -> m (ByteCodeOpr High)
forall a b. (a -> b) -> a -> b
$ JRefType -> ByteCodeOpr High
forall r. Ref JRefType r -> ByteCodeOpr r
CheckCast (JRefType -> ByteCodeOpr High)
-> m JRefType -> m (ByteCodeOpr High)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteCodeOffset -> m JRefType
forall (m :: * -> *) r.
(EvolveM m, Referenceable r) =>
ByteCodeOffset -> m r
link ByteCodeOffset
Ref JRefType Low
r
    InstanceOf Ref JRefType Low
r      -> String -> m (ByteCodeOpr High) -> m (ByteCodeOpr High)
forall (m :: * -> *) a. LabelM m => String -> m a -> m a
label String
"InstanceOf" (m (ByteCodeOpr High) -> m (ByteCodeOpr High))
-> m (ByteCodeOpr High) -> m (ByteCodeOpr High)
forall a b. (a -> b) -> a -> b
$ JRefType -> ByteCodeOpr High
forall r. Ref JRefType r -> ByteCodeOpr r
InstanceOf (JRefType -> ByteCodeOpr High)
-> m JRefType -> m (ByteCodeOpr High)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteCodeOffset -> m JRefType
forall (m :: * -> *) r.
(EvolveM m, Referenceable r) =>
ByteCodeOffset -> m r
link ByteCodeOffset
Ref JRefType Low
r
    If CmpOpr
cp OneOrTwo
on ShortRelativeRef Low
r        -> String -> m (ByteCodeOpr High) -> m (ByteCodeOpr High)
forall (m :: * -> *) a. LabelM m => String -> m a -> m a
label String
"If" (m (ByteCodeOpr High) -> m (ByteCodeOpr High))
-> m (ByteCodeOpr High) -> m (ByteCodeOpr High)
forall a b. (a -> b) -> a -> b
$ CmpOpr -> OneOrTwo -> ShortRelativeRef High -> ByteCodeOpr High
forall r. CmpOpr -> OneOrTwo -> ShortRelativeRef r -> ByteCodeOpr r
If CmpOpr
cp OneOrTwo
on (Int -> ByteCodeOpr High) -> m Int -> m (ByteCodeOpr High)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int16 -> m Int
forall a. Integral a => a -> m Int
calcOffset Int16
ShortRelativeRef Low
r
    IfRef Bool
b OneOrTwo
on ShortRelativeRef Low
r      -> String -> m (ByteCodeOpr High) -> m (ByteCodeOpr High)
forall (m :: * -> *) a. LabelM m => String -> m a -> m a
label String
"IfRef" (m (ByteCodeOpr High) -> m (ByteCodeOpr High))
-> m (ByteCodeOpr High) -> m (ByteCodeOpr High)
forall a b. (a -> b) -> a -> b
$ Bool -> OneOrTwo -> ShortRelativeRef High -> ByteCodeOpr High
forall r. Bool -> OneOrTwo -> ShortRelativeRef r -> ByteCodeOpr r
IfRef Bool
b OneOrTwo
on (Int -> ByteCodeOpr High) -> m Int -> m (ByteCodeOpr High)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int16 -> m Int
forall a. Integral a => a -> m Int
calcOffset Int16
ShortRelativeRef Low
r
    Goto LongRelativeRef Low
r            -> String -> m (ByteCodeOpr High) -> m (ByteCodeOpr High)
forall (m :: * -> *) a. LabelM m => String -> m a -> m a
label String
"Goto" (m (ByteCodeOpr High) -> m (ByteCodeOpr High))
-> m (ByteCodeOpr High) -> m (ByteCodeOpr High)
forall a b. (a -> b) -> a -> b
$ Int -> ByteCodeOpr High
forall r. LongRelativeRef r -> ByteCodeOpr r
Goto (Int -> ByteCodeOpr High) -> m Int -> m (ByteCodeOpr High)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int32 -> m Int
forall a. Integral a => a -> m Int
calcOffset Int32
LongRelativeRef Low
r
    Jsr LongRelativeRef Low
r             -> String -> m (ByteCodeOpr High) -> m (ByteCodeOpr High)
forall (m :: * -> *) a. LabelM m => String -> m a -> m a
label String
"Jsr" (m (ByteCodeOpr High) -> m (ByteCodeOpr High))
-> m (ByteCodeOpr High) -> m (ByteCodeOpr High)
forall a b. (a -> b) -> a -> b
$ Int -> ByteCodeOpr High
forall r. LongRelativeRef r -> ByteCodeOpr r
Jsr (Int -> ByteCodeOpr High) -> m Int -> m (ByteCodeOpr High)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int32 -> m Int
forall a. Integral a => a -> m Int
calcOffset Int32
LongRelativeRef Low
r
    TableSwitch LongRelativeRef Low
i (SwitchTable Int32
l Vector (LongRelativeRef Low)
ofss) -> String -> m (ByteCodeOpr High) -> m (ByteCodeOpr High)
forall (m :: * -> *) a. LabelM m => String -> m a -> m a
label String
"TableSwitch" (m (ByteCodeOpr High) -> m (ByteCodeOpr High))
-> m (ByteCodeOpr High) -> m (ByteCodeOpr High)
forall a b. (a -> b) -> a -> b
$
        Int -> SwitchTable High -> ByteCodeOpr High
forall r. LongRelativeRef r -> SwitchTable r -> ByteCodeOpr r
TableSwitch (Int -> SwitchTable High -> ByteCodeOpr High)
-> m Int -> m (SwitchTable High -> ByteCodeOpr High)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int32 -> m Int
forall a. Integral a => a -> m Int
calcOffset Int32
LongRelativeRef Low
i m (SwitchTable High -> ByteCodeOpr High)
-> m (SwitchTable High) -> m (ByteCodeOpr High)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int32 -> Vector (LongRelativeRef High) -> SwitchTable High
forall r. Int32 -> Vector (LongRelativeRef r) -> SwitchTable r
SwitchTable Int32
l (Vector Int -> SwitchTable High)
-> m (Vector Int) -> m (SwitchTable High)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int32 -> m Int) -> Vector Int32 -> m (Vector Int)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Vector a -> m (Vector b)
V.mapM Int32 -> m Int
forall a. Integral a => a -> m Int
calcOffset Vector Int32
Vector (LongRelativeRef Low)
ofss)
    LookupSwitch LongRelativeRef Low
i Vector (Int32, LongRelativeRef Low)
ofss -> String -> m (ByteCodeOpr High) -> m (ByteCodeOpr High)
forall (m :: * -> *) a. LabelM m => String -> m a -> m a
label String
"LookupSwitch" (m (ByteCodeOpr High) -> m (ByteCodeOpr High))
-> m (ByteCodeOpr High) -> m (ByteCodeOpr High)
forall a b. (a -> b) -> a -> b
$
        Int -> Vector (Int32, Int) -> ByteCodeOpr High
forall r.
LongRelativeRef r
-> Vector (Int32, LongRelativeRef r) -> ByteCodeOpr r
LookupSwitch (Int -> Vector (Int32, Int) -> ByteCodeOpr High)
-> m Int -> m (Vector (Int32, Int) -> ByteCodeOpr High)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int32 -> m Int
forall a. Integral a => a -> m Int
calcOffset Int32
LongRelativeRef Low
i m (Vector (Int32, Int) -> ByteCodeOpr High)
-> m (Vector (Int32, Int)) -> m (ByteCodeOpr High)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Int32, Int32) -> m (Int32, Int))
-> Vector (Int32, Int32) -> m (Vector (Int32, Int))
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Vector a -> m (Vector b)
V.mapM (\(Int32
a, Int32
b) -> (Int32
a,) (Int -> (Int32, Int)) -> m Int -> m (Int32, Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int32 -> m Int
forall a. Integral a => a -> m Int
calcOffset Int32
b) Vector (Int32, Int32)
Vector (Int32, LongRelativeRef Low)
ofss
    ByteCodeOpr Low
a                 -> ByteCodeOpr High -> m (ByteCodeOpr High)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr High -> m (ByteCodeOpr High))
-> ByteCodeOpr High -> m (ByteCodeOpr High)
forall a b. (a -> b) -> a -> b
$ ByteCodeOpr Low -> ByteCodeOpr High
forall a b. a -> b
unsafeCoerce ByteCodeOpr Low
a
  ByteCodeInst High -> m (ByteCodeInst High)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeInst High -> m (ByteCodeInst High))
-> ByteCodeInst High -> m (ByteCodeInst High)
forall a b. (a -> b) -> a -> b
$ ByteCodeOpr High -> ByteCodeInst High -> ByteCodeInst High
seq ByteCodeOpr High
x (ByteCodeOffset -> ByteCodeOpr High -> ByteCodeInst High
forall r. ByteCodeOffset -> ByteCodeOpr r -> ByteCodeInst r
ByteCodeInst ByteCodeOffset
ofs ByteCodeOpr High
x)
  where
    calcOffset :: a -> m Int
calcOffset a
r =
      ByteCodeOffset -> m Int
g (a -> ByteCodeOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> ByteCodeOffset) -> a -> ByteCodeOffset
forall a b. (a -> b) -> a -> b
$ ByteCodeOffset -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral ByteCodeOffset
ofs a -> a -> a
forall a. Num a => a -> a -> a
+ a
r)


devolveByteCodeInst ::
  DevolveM m
  => (ByteCodeIndex -> m ByteCodeOffset)
  -> ByteCodeInst High
  -> m (ByteCodeInst Low)
devolveByteCodeInst :: (Int -> m ByteCodeOffset)
-> ByteCodeInst High -> m (ByteCodeInst Low)
devolveByteCodeInst Int -> m ByteCodeOffset
g (ByteCodeInst ByteCodeOffset
ofs ByteCodeOpr High
opr) =
  ByteCodeOffset -> ByteCodeOpr Low -> ByteCodeInst Low
forall r. ByteCodeOffset -> ByteCodeOpr r -> ByteCodeInst r
ByteCodeInst ByteCodeOffset
ofs (ByteCodeOpr Low -> ByteCodeInst Low)
-> m (ByteCodeOpr Low) -> m (ByteCodeInst Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case ByteCodeOpr High
opr of
    Push BConstant High
c            -> String -> m (ByteCodeOpr Low) -> m (ByteCodeOpr Low)
forall (m :: * -> *) a. LabelM m => String -> m a -> m a
label String
"Push" (m (ByteCodeOpr Low) -> m (ByteCodeOpr Low))
-> m (ByteCodeOpr Low) -> m (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ CConstant Low -> ByteCodeOpr Low
forall r. BConstant r -> ByteCodeOpr r
Push (CConstant Low -> ByteCodeOpr Low)
-> m (CConstant Low) -> m (ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BConstant High -> m (BConstant Low)
forall (m :: * -> *).
DevolveM m =>
BConstant High -> m (BConstant Low)
devolveBConstant BConstant High
c
    Get FieldAccess
fa Ref AbsFieldId High
r          -> String -> m (ByteCodeOpr Low) -> m (ByteCodeOpr Low)
forall (m :: * -> *) a. LabelM m => String -> m a -> m a
label String
"Get" (m (ByteCodeOpr Low) -> m (ByteCodeOpr Low))
-> m (ByteCodeOpr Low) -> m (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ FieldAccess -> Ref AbsFieldId Low -> ByteCodeOpr Low
forall r. FieldAccess -> Ref AbsFieldId r -> ByteCodeOpr r
Get FieldAccess
fa (ByteCodeOffset -> ByteCodeOpr Low)
-> m ByteCodeOffset -> m (ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AbsFieldId -> m ByteCodeOffset
forall (m :: * -> *) r.
(DevolveM m, Referenceable r) =>
r -> m ByteCodeOffset
unlink Ref AbsFieldId High
AbsFieldId
r
    Put FieldAccess
fa Ref AbsFieldId High
r          -> String -> m (ByteCodeOpr Low) -> m (ByteCodeOpr Low)
forall (m :: * -> *) a. LabelM m => String -> m a -> m a
label String
"Put" (m (ByteCodeOpr Low) -> m (ByteCodeOpr Low))
-> m (ByteCodeOpr Low) -> m (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ FieldAccess -> Ref AbsFieldId Low -> ByteCodeOpr Low
forall r. FieldAccess -> Ref AbsFieldId r -> ByteCodeOpr r
Put FieldAccess
fa (ByteCodeOffset -> ByteCodeOpr Low)
-> m ByteCodeOffset -> m (ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AbsFieldId -> m ByteCodeOffset
forall (m :: * -> *) r.
(DevolveM m, Referenceable r) =>
r -> m ByteCodeOffset
unlink Ref AbsFieldId High
AbsFieldId
r
    Invoke Invocation High
r          -> String -> m (ByteCodeOpr Low) -> m (ByteCodeOpr Low)
forall (m :: * -> *) a. LabelM m => String -> m a -> m a
label String
"Invoke" (m (ByteCodeOpr Low) -> m (ByteCodeOpr Low))
-> m (ByteCodeOpr Low) -> m (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ Invocation Low -> ByteCodeOpr Low
forall r. Invocation r -> ByteCodeOpr r
Invoke (Invocation Low -> ByteCodeOpr Low)
-> m (Invocation Low) -> m (ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Invocation High -> m (Invocation Low)
forall (s :: * -> *) (m :: * -> *).
(Staged s, DevolveM m) =>
s High -> m (s Low)
devolve Invocation High
r
    New Ref ClassName High
r             -> String -> m (ByteCodeOpr Low) -> m (ByteCodeOpr Low)
forall (m :: * -> *) a. LabelM m => String -> m a -> m a
label String
"New" (m (ByteCodeOpr Low) -> m (ByteCodeOpr Low))
-> m (ByteCodeOpr Low) -> m (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ ByteCodeOffset -> ByteCodeOpr Low
forall r. Ref ClassName r -> ByteCodeOpr r
New (ByteCodeOffset -> ByteCodeOpr Low)
-> m ByteCodeOffset -> m (ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ClassName -> m ByteCodeOffset
forall (m :: * -> *) r.
(DevolveM m, Referenceable r) =>
r -> m ByteCodeOffset
unlink Ref ClassName High
ClassName
r
    NewArray Choice LowNewArrayType NewArrayType High
r        -> String -> m (ByteCodeOpr Low) -> m (ByteCodeOpr Low)
forall (m :: * -> *) a. LabelM m => String -> m a -> m a
label String
"NewArray" (m (ByteCodeOpr Low) -> m (ByteCodeOpr Low))
-> m (ByteCodeOpr Low) -> m (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ LowNewArrayType -> ByteCodeOpr Low
forall r. Choice LowNewArrayType NewArrayType r -> ByteCodeOpr r
NewArray (LowNewArrayType -> ByteCodeOpr Low)
-> m LowNewArrayType -> m (ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NewArrayType -> m LowNewArrayType
forall (m :: * -> *).
DevolveM m =>
NewArrayType -> m LowNewArrayType
devolveNewArrayType Choice LowNewArrayType NewArrayType High
NewArrayType
r
    CheckCast Ref JRefType High
r       -> String -> m (ByteCodeOpr Low) -> m (ByteCodeOpr Low)
forall (m :: * -> *) a. LabelM m => String -> m a -> m a
label String
"CheckCast" (m (ByteCodeOpr Low) -> m (ByteCodeOpr Low))
-> m (ByteCodeOpr Low) -> m (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ ByteCodeOffset -> ByteCodeOpr Low
forall r. Ref JRefType r -> ByteCodeOpr r
CheckCast (ByteCodeOffset -> ByteCodeOpr Low)
-> m ByteCodeOffset -> m (ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JRefType -> m ByteCodeOffset
forall (m :: * -> *) r.
(DevolveM m, Referenceable r) =>
r -> m ByteCodeOffset
unlink Ref JRefType High
JRefType
r
    InstanceOf Ref JRefType High
r      -> String -> m (ByteCodeOpr Low) -> m (ByteCodeOpr Low)
forall (m :: * -> *) a. LabelM m => String -> m a -> m a
label String
"InstanceOf" (m (ByteCodeOpr Low) -> m (ByteCodeOpr Low))
-> m (ByteCodeOpr Low) -> m (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ ByteCodeOffset -> ByteCodeOpr Low
forall r. Ref JRefType r -> ByteCodeOpr r
InstanceOf (ByteCodeOffset -> ByteCodeOpr Low)
-> m ByteCodeOffset -> m (ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JRefType -> m ByteCodeOffset
forall (m :: * -> *) r.
(DevolveM m, Referenceable r) =>
r -> m ByteCodeOffset
unlink Ref JRefType High
JRefType
r
    If CmpOpr
cp OneOrTwo
on ShortRelativeRef High
r        -> String -> m (ByteCodeOpr Low) -> m (ByteCodeOpr Low)
forall (m :: * -> *) a. LabelM m => String -> m a -> m a
label String
"If" (m (ByteCodeOpr Low) -> m (ByteCodeOpr Low))
-> m (ByteCodeOpr Low) -> m (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ CmpOpr -> OneOrTwo -> ShortRelativeRef Low -> ByteCodeOpr Low
forall r. CmpOpr -> OneOrTwo -> ShortRelativeRef r -> ByteCodeOpr r
If CmpOpr
cp OneOrTwo
on (Int16 -> ByteCodeOpr Low) -> m Int16 -> m (ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> m Int16
forall b. Num b => Int -> m b
calcOffset Int
ShortRelativeRef High
r
    IfRef Bool
b OneOrTwo
on ShortRelativeRef High
r      -> String -> m (ByteCodeOpr Low) -> m (ByteCodeOpr Low)
forall (m :: * -> *) a. LabelM m => String -> m a -> m a
label String
"IfRef" (m (ByteCodeOpr Low) -> m (ByteCodeOpr Low))
-> m (ByteCodeOpr Low) -> m (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ Bool -> OneOrTwo -> ShortRelativeRef Low -> ByteCodeOpr Low
forall r. Bool -> OneOrTwo -> ShortRelativeRef r -> ByteCodeOpr r
IfRef Bool
b OneOrTwo
on (Int16 -> ByteCodeOpr Low) -> m Int16 -> m (ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> m Int16
forall b. Num b => Int -> m b
calcOffset Int
ShortRelativeRef High
r
    Goto LongRelativeRef High
r            -> String -> m (ByteCodeOpr Low) -> m (ByteCodeOpr Low)
forall (m :: * -> *) a. LabelM m => String -> m a -> m a
label String
"Goto" (m (ByteCodeOpr Low) -> m (ByteCodeOpr Low))
-> m (ByteCodeOpr Low) -> m (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ Int32 -> ByteCodeOpr Low
forall r. LongRelativeRef r -> ByteCodeOpr r
Goto (Int32 -> ByteCodeOpr Low) -> m Int32 -> m (ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> m Int32
forall b. Num b => Int -> m b
calcOffset Int
LongRelativeRef High
r
    Jsr LongRelativeRef High
r             -> String -> m (ByteCodeOpr Low) -> m (ByteCodeOpr Low)
forall (m :: * -> *) a. LabelM m => String -> m a -> m a
label String
"Jsr" (m (ByteCodeOpr Low) -> m (ByteCodeOpr Low))
-> m (ByteCodeOpr Low) -> m (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ Int32 -> ByteCodeOpr Low
forall r. LongRelativeRef r -> ByteCodeOpr r
Jsr (Int32 -> ByteCodeOpr Low) -> m Int32 -> m (ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> m Int32
forall b. Num b => Int -> m b
calcOffset Int
LongRelativeRef High
r
    TableSwitch LongRelativeRef High
i (SwitchTable Int32
l Vector (LongRelativeRef High)
ofss) -> String -> m (ByteCodeOpr Low) -> m (ByteCodeOpr Low)
forall (m :: * -> *) a. LabelM m => String -> m a -> m a
label String
"TableSwitch" (m (ByteCodeOpr Low) -> m (ByteCodeOpr Low))
-> m (ByteCodeOpr Low) -> m (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$
        Int32 -> SwitchTable Low -> ByteCodeOpr Low
forall r. LongRelativeRef r -> SwitchTable r -> ByteCodeOpr r
TableSwitch (Int32 -> SwitchTable Low -> ByteCodeOpr Low)
-> m Int32 -> m (SwitchTable Low -> ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> m Int32
forall b. Num b => Int -> m b
calcOffset Int
LongRelativeRef High
i m (SwitchTable Low -> ByteCodeOpr Low)
-> m (SwitchTable Low) -> m (ByteCodeOpr Low)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int32 -> Vector (LongRelativeRef Low) -> SwitchTable Low
forall r. Int32 -> Vector (LongRelativeRef r) -> SwitchTable r
SwitchTable Int32
l (Vector Int32 -> SwitchTable Low)
-> m (Vector Int32) -> m (SwitchTable Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> m Int32) -> Vector Int -> m (Vector Int32)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Vector a -> m (Vector b)
V.mapM Int -> m Int32
forall b. Num b => Int -> m b
calcOffset Vector Int
Vector (LongRelativeRef High)
ofss)
    LookupSwitch LongRelativeRef High
i Vector (Int32, LongRelativeRef High)
ofss -> String -> m (ByteCodeOpr Low) -> m (ByteCodeOpr Low)
forall (m :: * -> *) a. LabelM m => String -> m a -> m a
label String
"LookupSwitch" (m (ByteCodeOpr Low) -> m (ByteCodeOpr Low))
-> m (ByteCodeOpr Low) -> m (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$
        Int32 -> Vector (Int32, Int32) -> ByteCodeOpr Low
forall r.
LongRelativeRef r
-> Vector (Int32, LongRelativeRef r) -> ByteCodeOpr r
LookupSwitch (Int32 -> Vector (Int32, Int32) -> ByteCodeOpr Low)
-> m Int32 -> m (Vector (Int32, Int32) -> ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> m Int32
forall b. Num b => Int -> m b
calcOffset Int
LongRelativeRef High
i m (Vector (Int32, Int32) -> ByteCodeOpr Low)
-> m (Vector (Int32, Int32)) -> m (ByteCodeOpr Low)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Int32, Int) -> m (Int32, Int32))
-> Vector (Int32, Int) -> m (Vector (Int32, Int32))
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Vector a -> m (Vector b)
V.mapM (\(Int32
a, Int
b) -> (Int32
a,) (Int32 -> (Int32, Int32)) -> m Int32 -> m (Int32, Int32)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> m Int32
forall b. Num b => Int -> m b
calcOffset Int
b) Vector (Int32, Int)
Vector (Int32, LongRelativeRef High)
ofss
    ByteCodeOpr High
a -> ByteCodeOpr Low -> m (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> m (ByteCodeOpr Low))
-> ByteCodeOpr Low -> m (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ ByteCodeOpr High -> ByteCodeOpr Low
forall a b. a -> b
unsafeCoerce ByteCodeOpr High
a
  where
    calcOffset :: Int -> m b
calcOffset Int
r = do
      ByteCodeOffset
x <- Int -> m ByteCodeOffset
g Int
r
      b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOffset -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral ByteCodeOffset
x b -> b -> b
forall a. Num a => a -> a -> a
- ByteCodeOffset -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral ByteCodeOffset
ofs)

instance Staged Invocation where
  evolve :: Invocation Low -> m (Invocation High)
evolve Invocation Low
i =
    case Invocation Low
i of
      InvkSpecial Ref AbsVariableMethodId Low
r     -> String -> m (Invocation High) -> m (Invocation High)
forall (m :: * -> *) a. LabelM m => String -> m a -> m a
label String
"InvkSpecial" (m (Invocation High) -> m (Invocation High))
-> m (Invocation High) -> m (Invocation High)
forall a b. (a -> b) -> a -> b
$ AbsVariableMethodId -> Invocation High
forall r. Ref AbsVariableMethodId r -> Invocation r
InvkSpecial (AbsVariableMethodId -> Invocation High)
-> m AbsVariableMethodId -> m (Invocation High)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteCodeOffset -> m AbsVariableMethodId
forall (m :: * -> *) r.
(EvolveM m, Referenceable r) =>
ByteCodeOffset -> m r
link ByteCodeOffset
Ref AbsVariableMethodId Low
r
      InvkVirtual Ref (InRefType MethodId) Low
r     -> String -> m (Invocation High) -> m (Invocation High)
forall (m :: * -> *) a. LabelM m => String -> m a -> m a
label String
"InvkVirtual" (m (Invocation High) -> m (Invocation High))
-> m (Invocation High) -> m (Invocation High)
forall a b. (a -> b) -> a -> b
$ InRefType MethodId -> Invocation High
forall r. Ref (InRefType MethodId) r -> Invocation r
InvkVirtual (InRefType MethodId -> Invocation High)
-> m (InRefType MethodId) -> m (Invocation High)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteCodeOffset -> m (InRefType MethodId)
forall (m :: * -> *) r.
(EvolveM m, Referenceable r) =>
ByteCodeOffset -> m r
link ByteCodeOffset
Ref (InRefType MethodId) Low
r
      InvkStatic Ref AbsVariableMethodId Low
r      -> String -> m (Invocation High) -> m (Invocation High)
forall (m :: * -> *) a. LabelM m => String -> m a -> m a
label String
"InvkStatic" (m (Invocation High) -> m (Invocation High))
-> m (Invocation High) -> m (Invocation High)
forall a b. (a -> b) -> a -> b
$ AbsVariableMethodId -> Invocation High
forall r. Ref AbsVariableMethodId r -> Invocation r
InvkStatic (AbsVariableMethodId -> Invocation High)
-> m AbsVariableMethodId -> m (Invocation High)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteCodeOffset -> m AbsVariableMethodId
forall (m :: * -> *) r.
(EvolveM m, Referenceable r) =>
ByteCodeOffset -> m r
link ByteCodeOffset
Ref AbsVariableMethodId Low
r
      InvkInterface Word8
w Ref AbsInterfaceMethodId Low
r -> String -> m (Invocation High) -> m (Invocation High)
forall (m :: * -> *) a. LabelM m => String -> m a -> m a
label String
"InvkInterface" (m (Invocation High) -> m (Invocation High))
-> m (Invocation High) -> m (Invocation High)
forall a b. (a -> b) -> a -> b
$ Word8 -> Ref AbsInterfaceMethodId High -> Invocation High
forall r. Word8 -> Ref AbsInterfaceMethodId r -> Invocation r
InvkInterface Word8
w (AbsInterfaceMethodId -> Invocation High)
-> m AbsInterfaceMethodId -> m (Invocation High)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteCodeOffset -> m AbsInterfaceMethodId
forall (m :: * -> *) r.
(EvolveM m, Referenceable r) =>
ByteCodeOffset -> m r
link ByteCodeOffset
Ref AbsInterfaceMethodId Low
r
      InvkDynamic DeepRef InvokeDynamic Low
r     -> String -> m (Invocation High) -> m (Invocation High)
forall (m :: * -> *) a. LabelM m => String -> m a -> m a
label String
"InvkDynamic" (m (Invocation High) -> m (Invocation High))
-> m (Invocation High) -> m (Invocation High)
forall a b. (a -> b) -> a -> b
$ InvokeDynamic High -> Invocation High
forall r. DeepRef InvokeDynamic r -> Invocation r
InvkDynamic (InvokeDynamic High -> Invocation High)
-> m (InvokeDynamic High) -> m (Invocation High)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteCodeOffset -> m (InvokeDynamic High)
forall (m :: * -> *) r.
(EvolveM m, Referenceable r) =>
ByteCodeOffset -> m r
link ByteCodeOffset
DeepRef InvokeDynamic Low
r

  devolve :: Invocation High -> m (Invocation Low)
devolve Invocation High
i =
    case Invocation High
i of
      InvkSpecial Ref AbsVariableMethodId High
r     -> String -> m (Invocation Low) -> m (Invocation Low)
forall (m :: * -> *) a. LabelM m => String -> m a -> m a
label String
"InvkSpecial" (m (Invocation Low) -> m (Invocation Low))
-> m (Invocation Low) -> m (Invocation Low)
forall a b. (a -> b) -> a -> b
$ ByteCodeOffset -> Invocation Low
forall r. Ref AbsVariableMethodId r -> Invocation r
InvkSpecial (ByteCodeOffset -> Invocation Low)
-> m ByteCodeOffset -> m (Invocation Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AbsVariableMethodId -> m ByteCodeOffset
forall (m :: * -> *) r.
(DevolveM m, Referenceable r) =>
r -> m ByteCodeOffset
unlink Ref AbsVariableMethodId High
AbsVariableMethodId
r
      InvkVirtual Ref (InRefType MethodId) High
r     -> String -> m (Invocation Low) -> m (Invocation Low)
forall (m :: * -> *) a. LabelM m => String -> m a -> m a
label String
"InvkVirtual" (m (Invocation Low) -> m (Invocation Low))
-> m (Invocation Low) -> m (Invocation Low)
forall a b. (a -> b) -> a -> b
$ ByteCodeOffset -> Invocation Low
forall r. Ref (InRefType MethodId) r -> Invocation r
InvkVirtual (ByteCodeOffset -> Invocation Low)
-> m ByteCodeOffset -> m (Invocation Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InRefType MethodId -> m ByteCodeOffset
forall (m :: * -> *) r.
(DevolveM m, Referenceable r) =>
r -> m ByteCodeOffset
unlink Ref (InRefType MethodId) High
InRefType MethodId
r
      InvkStatic Ref AbsVariableMethodId High
r      -> String -> m (Invocation Low) -> m (Invocation Low)
forall (m :: * -> *) a. LabelM m => String -> m a -> m a
label String
"InvkStatic" (m (Invocation Low) -> m (Invocation Low))
-> m (Invocation Low) -> m (Invocation Low)
forall a b. (a -> b) -> a -> b
$ ByteCodeOffset -> Invocation Low
forall r. Ref AbsVariableMethodId r -> Invocation r
InvkStatic (ByteCodeOffset -> Invocation Low)
-> m ByteCodeOffset -> m (Invocation Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AbsVariableMethodId -> m ByteCodeOffset
forall (m :: * -> *) r.
(DevolveM m, Referenceable r) =>
r -> m ByteCodeOffset
unlink Ref AbsVariableMethodId High
AbsVariableMethodId
r
      InvkInterface Word8
w Ref AbsInterfaceMethodId High
r -> String -> m (Invocation Low) -> m (Invocation Low)
forall (m :: * -> *) a. LabelM m => String -> m a -> m a
label String
"InvkInterface" (m (Invocation Low) -> m (Invocation Low))
-> m (Invocation Low) -> m (Invocation Low)
forall a b. (a -> b) -> a -> b
$ Word8 -> Ref AbsInterfaceMethodId Low -> Invocation Low
forall r. Word8 -> Ref AbsInterfaceMethodId r -> Invocation r
InvkInterface Word8
w (ByteCodeOffset -> Invocation Low)
-> m ByteCodeOffset -> m (Invocation Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AbsInterfaceMethodId -> m ByteCodeOffset
forall (m :: * -> *) r.
(DevolveM m, Referenceable r) =>
r -> m ByteCodeOffset
unlink Ref AbsInterfaceMethodId High
AbsInterfaceMethodId
r
      InvkDynamic DeepRef InvokeDynamic High
r     -> String -> m (Invocation Low) -> m (Invocation Low)
forall (m :: * -> *) a. LabelM m => String -> m a -> m a
label String
"InvkDynamic" (m (Invocation Low) -> m (Invocation Low))
-> m (Invocation Low) -> m (Invocation Low)
forall a b. (a -> b) -> a -> b
$ ByteCodeOffset -> Invocation Low
forall r. DeepRef InvokeDynamic r -> Invocation r
InvkDynamic (ByteCodeOffset -> Invocation Low)
-> m ByteCodeOffset -> m (Invocation Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InvokeDynamic High -> m ByteCodeOffset
forall (m :: * -> *) r.
(DevolveM m, Referenceable r) =>
r -> m ByteCodeOffset
unlink DeepRef InvokeDynamic High
InvokeDynamic High
r


instance Binary (ByteCode Low) where
  get :: Get (ByteCode Low)
get = do
    Word32
x <- Get Word32
getWord32be
    ByteString
bs <- Int64 -> Get ByteString
getLazyByteString (Word32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
x)
    case Get [ByteCodeInst Low]
-> ByteString
-> Either
     (ByteString, Int64, String) (ByteString, Int64, [ByteCodeInst Low])
forall a.
Get a
-> ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, a)
runGetOrFail Get [ByteCodeInst Low]
go ByteString
bs of
      Right (ByteString
_,Int64
_,[ByteCodeInst Low]
bcs) -> ByteCode Low -> Get (ByteCode Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCode Low -> Get (ByteCode Low))
-> ([ByteCodeInst Low] -> ByteCode Low)
-> [ByteCodeInst Low]
-> Get (ByteCode Low)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Vector (ByteCodeInst Low) -> ByteCode Low
forall i. Word32 -> Vector (ByteCodeInst i) -> ByteCode i
ByteCode Word32
x (Vector (ByteCodeInst Low) -> ByteCode Low)
-> ([ByteCodeInst Low] -> Vector (ByteCodeInst Low))
-> [ByteCodeInst Low]
-> ByteCode Low
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteCodeInst Low] -> Vector (ByteCodeInst Low)
forall a. [a] -> Vector a
V.fromList ([ByteCodeInst Low] -> Get (ByteCode Low))
-> [ByteCodeInst Low] -> Get (ByteCode Low)
forall a b. (a -> b) -> a -> b
$ [ByteCodeInst Low]
bcs
      Left (ByteString
_,Int64
_,String
msg)  -> String -> Get (ByteCode Low)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
msg
    where
      go :: Get [ByteCodeInst Low]
go = Get Bool
isEmpty Get Bool
-> (Bool -> Get [ByteCodeInst Low]) -> Get [ByteCodeInst Low]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
t ->
        if Bool
t
          then [ByteCodeInst Low] -> Get [ByteCodeInst Low]
forall (m :: * -> *) a. Monad m => a -> m a
return []
          else do
            ByteCodeInst Low
x <- Get (ByteCodeInst Low)
forall t. Binary t => Get t
get
            (ByteCodeInst Low
xByteCodeInst Low -> [ByteCodeInst Low] -> [ByteCodeInst Low]
forall a. a -> [a] -> [a]
:) ([ByteCodeInst Low] -> [ByteCodeInst Low])
-> Get [ByteCodeInst Low] -> Get [ByteCodeInst Low]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [ByteCodeInst Low]
go

  put :: ByteCode Low -> Put
put (ByteCode Word32
_ Vector (ByteCodeInst Low)
lst)= do
    let bs :: ByteString
bs = Put -> ByteString
runPut ((ByteCodeInst Low -> Put) -> Vector (ByteCodeInst Low) -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ByteCodeInst Low -> Put
forall t. Binary t => t -> Put
put Vector (ByteCodeInst Low)
lst)
    Word32 -> Put
putWord32be (Int64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Word32) -> Int64 -> Word32
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
BL.length ByteString
bs)
    ByteString -> Put
putLazyByteString ByteString
bs

instance Binary (ByteCodeInst Low) where
  get :: Get (ByteCodeInst Low)
get = do
    ByteCodeOffset
i <- (Int64 -> ByteCodeOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> ByteCodeOffset) -> Get Int64 -> Get ByteCodeOffset
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int64
bytesRead)
    ByteCodeOpr Low
x <- Get (ByteCodeOpr Low)
forall t. Binary t => Get t
get
    ByteCodeInst Low -> Get (ByteCodeInst Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOffset -> ByteCodeOpr Low -> ByteCodeInst Low
forall r. ByteCodeOffset -> ByteCodeOpr r -> ByteCodeInst r
ByteCodeInst ByteCodeOffset
i ByteCodeOpr Low
x)

  put :: ByteCodeInst Low -> Put
put ByteCodeInst Low
x =
    ByteCodeOffset -> ByteCodeOpr Low -> Put
putByteCode (ByteCodeInst Low -> ByteCodeOffset
forall r. ByteCodeInst r -> ByteCodeOffset
offset ByteCodeInst Low
x) (ByteCodeOpr Low -> Put) -> ByteCodeOpr Low -> Put
forall a b. (a -> b) -> a -> b
$ ByteCodeInst Low -> ByteCodeOpr Low
forall r. ByteCodeInst r -> ByteCodeOpr r
opcode ByteCodeInst Low
x

-- | A short relative bytecode ref is defined in correspondence with the
type ShortRelativeRef i = Choice Int16 ByteCodeIndex i

-- | A Long relative reference. The only reason this exist because
-- the signed nature of int, looses a bit.
type LongRelativeRef i = Choice Int32 ByteCodeIndex i

data ArithmeticType = MInt | MLong | MFloat | MDouble
  deriving (Int -> ArithmeticType -> String -> String
[ArithmeticType] -> String -> String
ArithmeticType -> String
(Int -> ArithmeticType -> String -> String)
-> (ArithmeticType -> String)
-> ([ArithmeticType] -> String -> String)
-> Show ArithmeticType
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [ArithmeticType] -> String -> String
$cshowList :: [ArithmeticType] -> String -> String
show :: ArithmeticType -> String
$cshow :: ArithmeticType -> String
showsPrec :: Int -> ArithmeticType -> String -> String
$cshowsPrec :: Int -> ArithmeticType -> String -> String
Show, Eq ArithmeticType
Eq ArithmeticType
-> (ArithmeticType -> ArithmeticType -> Ordering)
-> (ArithmeticType -> ArithmeticType -> Bool)
-> (ArithmeticType -> ArithmeticType -> Bool)
-> (ArithmeticType -> ArithmeticType -> Bool)
-> (ArithmeticType -> ArithmeticType -> Bool)
-> (ArithmeticType -> ArithmeticType -> ArithmeticType)
-> (ArithmeticType -> ArithmeticType -> ArithmeticType)
-> Ord ArithmeticType
ArithmeticType -> ArithmeticType -> Bool
ArithmeticType -> ArithmeticType -> Ordering
ArithmeticType -> ArithmeticType -> ArithmeticType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ArithmeticType -> ArithmeticType -> ArithmeticType
$cmin :: ArithmeticType -> ArithmeticType -> ArithmeticType
max :: ArithmeticType -> ArithmeticType -> ArithmeticType
$cmax :: ArithmeticType -> ArithmeticType -> ArithmeticType
>= :: ArithmeticType -> ArithmeticType -> Bool
$c>= :: ArithmeticType -> ArithmeticType -> Bool
> :: ArithmeticType -> ArithmeticType -> Bool
$c> :: ArithmeticType -> ArithmeticType -> Bool
<= :: ArithmeticType -> ArithmeticType -> Bool
$c<= :: ArithmeticType -> ArithmeticType -> Bool
< :: ArithmeticType -> ArithmeticType -> Bool
$c< :: ArithmeticType -> ArithmeticType -> Bool
compare :: ArithmeticType -> ArithmeticType -> Ordering
$ccompare :: ArithmeticType -> ArithmeticType -> Ordering
$cp1Ord :: Eq ArithmeticType
Ord, ArithmeticType -> ArithmeticType -> Bool
(ArithmeticType -> ArithmeticType -> Bool)
-> (ArithmeticType -> ArithmeticType -> Bool) -> Eq ArithmeticType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ArithmeticType -> ArithmeticType -> Bool
$c/= :: ArithmeticType -> ArithmeticType -> Bool
== :: ArithmeticType -> ArithmeticType -> Bool
$c== :: ArithmeticType -> ArithmeticType -> Bool
Eq, Int -> ArithmeticType
ArithmeticType -> Int
ArithmeticType -> [ArithmeticType]
ArithmeticType -> ArithmeticType
ArithmeticType -> ArithmeticType -> [ArithmeticType]
ArithmeticType
-> ArithmeticType -> ArithmeticType -> [ArithmeticType]
(ArithmeticType -> ArithmeticType)
-> (ArithmeticType -> ArithmeticType)
-> (Int -> ArithmeticType)
-> (ArithmeticType -> Int)
-> (ArithmeticType -> [ArithmeticType])
-> (ArithmeticType -> ArithmeticType -> [ArithmeticType])
-> (ArithmeticType -> ArithmeticType -> [ArithmeticType])
-> (ArithmeticType
    -> ArithmeticType -> ArithmeticType -> [ArithmeticType])
-> Enum ArithmeticType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ArithmeticType
-> ArithmeticType -> ArithmeticType -> [ArithmeticType]
$cenumFromThenTo :: ArithmeticType
-> ArithmeticType -> ArithmeticType -> [ArithmeticType]
enumFromTo :: ArithmeticType -> ArithmeticType -> [ArithmeticType]
$cenumFromTo :: ArithmeticType -> ArithmeticType -> [ArithmeticType]
enumFromThen :: ArithmeticType -> ArithmeticType -> [ArithmeticType]
$cenumFromThen :: ArithmeticType -> ArithmeticType -> [ArithmeticType]
enumFrom :: ArithmeticType -> [ArithmeticType]
$cenumFrom :: ArithmeticType -> [ArithmeticType]
fromEnum :: ArithmeticType -> Int
$cfromEnum :: ArithmeticType -> Int
toEnum :: Int -> ArithmeticType
$ctoEnum :: Int -> ArithmeticType
pred :: ArithmeticType -> ArithmeticType
$cpred :: ArithmeticType -> ArithmeticType
succ :: ArithmeticType -> ArithmeticType
$csucc :: ArithmeticType -> ArithmeticType
Enum, ArithmeticType
ArithmeticType -> ArithmeticType -> Bounded ArithmeticType
forall a. a -> a -> Bounded a
maxBound :: ArithmeticType
$cmaxBound :: ArithmeticType
minBound :: ArithmeticType
$cminBound :: ArithmeticType
Bounded, (forall x. ArithmeticType -> Rep ArithmeticType x)
-> (forall x. Rep ArithmeticType x -> ArithmeticType)
-> Generic ArithmeticType
forall x. Rep ArithmeticType x -> ArithmeticType
forall x. ArithmeticType -> Rep ArithmeticType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ArithmeticType x -> ArithmeticType
$cfrom :: forall x. ArithmeticType -> Rep ArithmeticType x
Generic, ArithmeticType -> ()
(ArithmeticType -> ()) -> NFData ArithmeticType
forall a. (a -> ()) -> NFData a
rnf :: ArithmeticType -> ()
$crnf :: ArithmeticType -> ()
NFData)

data SmallArithmeticType = MByte | MChar | MShort
  deriving (Int -> SmallArithmeticType -> String -> String
[SmallArithmeticType] -> String -> String
SmallArithmeticType -> String
(Int -> SmallArithmeticType -> String -> String)
-> (SmallArithmeticType -> String)
-> ([SmallArithmeticType] -> String -> String)
-> Show SmallArithmeticType
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [SmallArithmeticType] -> String -> String
$cshowList :: [SmallArithmeticType] -> String -> String
show :: SmallArithmeticType -> String
$cshow :: SmallArithmeticType -> String
showsPrec :: Int -> SmallArithmeticType -> String -> String
$cshowsPrec :: Int -> SmallArithmeticType -> String -> String
Show, Eq SmallArithmeticType
Eq SmallArithmeticType
-> (SmallArithmeticType -> SmallArithmeticType -> Ordering)
-> (SmallArithmeticType -> SmallArithmeticType -> Bool)
-> (SmallArithmeticType -> SmallArithmeticType -> Bool)
-> (SmallArithmeticType -> SmallArithmeticType -> Bool)
-> (SmallArithmeticType -> SmallArithmeticType -> Bool)
-> (SmallArithmeticType
    -> SmallArithmeticType -> SmallArithmeticType)
-> (SmallArithmeticType
    -> SmallArithmeticType -> SmallArithmeticType)
-> Ord SmallArithmeticType
SmallArithmeticType -> SmallArithmeticType -> Bool
SmallArithmeticType -> SmallArithmeticType -> Ordering
SmallArithmeticType -> SmallArithmeticType -> SmallArithmeticType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SmallArithmeticType -> SmallArithmeticType -> SmallArithmeticType
$cmin :: SmallArithmeticType -> SmallArithmeticType -> SmallArithmeticType
max :: SmallArithmeticType -> SmallArithmeticType -> SmallArithmeticType
$cmax :: SmallArithmeticType -> SmallArithmeticType -> SmallArithmeticType
>= :: SmallArithmeticType -> SmallArithmeticType -> Bool
$c>= :: SmallArithmeticType -> SmallArithmeticType -> Bool
> :: SmallArithmeticType -> SmallArithmeticType -> Bool
$c> :: SmallArithmeticType -> SmallArithmeticType -> Bool
<= :: SmallArithmeticType -> SmallArithmeticType -> Bool
$c<= :: SmallArithmeticType -> SmallArithmeticType -> Bool
< :: SmallArithmeticType -> SmallArithmeticType -> Bool
$c< :: SmallArithmeticType -> SmallArithmeticType -> Bool
compare :: SmallArithmeticType -> SmallArithmeticType -> Ordering
$ccompare :: SmallArithmeticType -> SmallArithmeticType -> Ordering
$cp1Ord :: Eq SmallArithmeticType
Ord, SmallArithmeticType -> SmallArithmeticType -> Bool
(SmallArithmeticType -> SmallArithmeticType -> Bool)
-> (SmallArithmeticType -> SmallArithmeticType -> Bool)
-> Eq SmallArithmeticType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SmallArithmeticType -> SmallArithmeticType -> Bool
$c/= :: SmallArithmeticType -> SmallArithmeticType -> Bool
== :: SmallArithmeticType -> SmallArithmeticType -> Bool
$c== :: SmallArithmeticType -> SmallArithmeticType -> Bool
Eq, Int -> SmallArithmeticType
SmallArithmeticType -> Int
SmallArithmeticType -> [SmallArithmeticType]
SmallArithmeticType -> SmallArithmeticType
SmallArithmeticType -> SmallArithmeticType -> [SmallArithmeticType]
SmallArithmeticType
-> SmallArithmeticType
-> SmallArithmeticType
-> [SmallArithmeticType]
(SmallArithmeticType -> SmallArithmeticType)
-> (SmallArithmeticType -> SmallArithmeticType)
-> (Int -> SmallArithmeticType)
-> (SmallArithmeticType -> Int)
-> (SmallArithmeticType -> [SmallArithmeticType])
-> (SmallArithmeticType
    -> SmallArithmeticType -> [SmallArithmeticType])
-> (SmallArithmeticType
    -> SmallArithmeticType -> [SmallArithmeticType])
-> (SmallArithmeticType
    -> SmallArithmeticType
    -> SmallArithmeticType
    -> [SmallArithmeticType])
-> Enum SmallArithmeticType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: SmallArithmeticType
-> SmallArithmeticType
-> SmallArithmeticType
-> [SmallArithmeticType]
$cenumFromThenTo :: SmallArithmeticType
-> SmallArithmeticType
-> SmallArithmeticType
-> [SmallArithmeticType]
enumFromTo :: SmallArithmeticType -> SmallArithmeticType -> [SmallArithmeticType]
$cenumFromTo :: SmallArithmeticType -> SmallArithmeticType -> [SmallArithmeticType]
enumFromThen :: SmallArithmeticType -> SmallArithmeticType -> [SmallArithmeticType]
$cenumFromThen :: SmallArithmeticType -> SmallArithmeticType -> [SmallArithmeticType]
enumFrom :: SmallArithmeticType -> [SmallArithmeticType]
$cenumFrom :: SmallArithmeticType -> [SmallArithmeticType]
fromEnum :: SmallArithmeticType -> Int
$cfromEnum :: SmallArithmeticType -> Int
toEnum :: Int -> SmallArithmeticType
$ctoEnum :: Int -> SmallArithmeticType
pred :: SmallArithmeticType -> SmallArithmeticType
$cpred :: SmallArithmeticType -> SmallArithmeticType
succ :: SmallArithmeticType -> SmallArithmeticType
$csucc :: SmallArithmeticType -> SmallArithmeticType
Enum, SmallArithmeticType
SmallArithmeticType
-> SmallArithmeticType -> Bounded SmallArithmeticType
forall a. a -> a -> Bounded a
maxBound :: SmallArithmeticType
$cmaxBound :: SmallArithmeticType
minBound :: SmallArithmeticType
$cminBound :: SmallArithmeticType
Bounded, (forall x. SmallArithmeticType -> Rep SmallArithmeticType x)
-> (forall x. Rep SmallArithmeticType x -> SmallArithmeticType)
-> Generic SmallArithmeticType
forall x. Rep SmallArithmeticType x -> SmallArithmeticType
forall x. SmallArithmeticType -> Rep SmallArithmeticType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SmallArithmeticType x -> SmallArithmeticType
$cfrom :: forall x. SmallArithmeticType -> Rep SmallArithmeticType x
Generic, SmallArithmeticType -> ()
(SmallArithmeticType -> ()) -> NFData SmallArithmeticType
forall a. (a -> ()) -> NFData a
rnf :: SmallArithmeticType -> ()
$crnf :: SmallArithmeticType -> ()
NFData)

data LowNewArrayType
  = ArrayBaseType JBaseType
  | ArrayReference (Ref JRefType Low) Word8
  deriving (Int -> LowNewArrayType -> String -> String
[LowNewArrayType] -> String -> String
LowNewArrayType -> String
(Int -> LowNewArrayType -> String -> String)
-> (LowNewArrayType -> String)
-> ([LowNewArrayType] -> String -> String)
-> Show LowNewArrayType
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [LowNewArrayType] -> String -> String
$cshowList :: [LowNewArrayType] -> String -> String
show :: LowNewArrayType -> String
$cshow :: LowNewArrayType -> String
showsPrec :: Int -> LowNewArrayType -> String -> String
$cshowsPrec :: Int -> LowNewArrayType -> String -> String
Show, Eq LowNewArrayType
Eq LowNewArrayType
-> (LowNewArrayType -> LowNewArrayType -> Ordering)
-> (LowNewArrayType -> LowNewArrayType -> Bool)
-> (LowNewArrayType -> LowNewArrayType -> Bool)
-> (LowNewArrayType -> LowNewArrayType -> Bool)
-> (LowNewArrayType -> LowNewArrayType -> Bool)
-> (LowNewArrayType -> LowNewArrayType -> LowNewArrayType)
-> (LowNewArrayType -> LowNewArrayType -> LowNewArrayType)
-> Ord LowNewArrayType
LowNewArrayType -> LowNewArrayType -> Bool
LowNewArrayType -> LowNewArrayType -> Ordering
LowNewArrayType -> LowNewArrayType -> LowNewArrayType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LowNewArrayType -> LowNewArrayType -> LowNewArrayType
$cmin :: LowNewArrayType -> LowNewArrayType -> LowNewArrayType
max :: LowNewArrayType -> LowNewArrayType -> LowNewArrayType
$cmax :: LowNewArrayType -> LowNewArrayType -> LowNewArrayType
>= :: LowNewArrayType -> LowNewArrayType -> Bool
$c>= :: LowNewArrayType -> LowNewArrayType -> Bool
> :: LowNewArrayType -> LowNewArrayType -> Bool
$c> :: LowNewArrayType -> LowNewArrayType -> Bool
<= :: LowNewArrayType -> LowNewArrayType -> Bool
$c<= :: LowNewArrayType -> LowNewArrayType -> Bool
< :: LowNewArrayType -> LowNewArrayType -> Bool
$c< :: LowNewArrayType -> LowNewArrayType -> Bool
compare :: LowNewArrayType -> LowNewArrayType -> Ordering
$ccompare :: LowNewArrayType -> LowNewArrayType -> Ordering
$cp1Ord :: Eq LowNewArrayType
Ord, LowNewArrayType -> LowNewArrayType -> Bool
(LowNewArrayType -> LowNewArrayType -> Bool)
-> (LowNewArrayType -> LowNewArrayType -> Bool)
-> Eq LowNewArrayType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LowNewArrayType -> LowNewArrayType -> Bool
$c/= :: LowNewArrayType -> LowNewArrayType -> Bool
== :: LowNewArrayType -> LowNewArrayType -> Bool
$c== :: LowNewArrayType -> LowNewArrayType -> Bool
Eq, (forall x. LowNewArrayType -> Rep LowNewArrayType x)
-> (forall x. Rep LowNewArrayType x -> LowNewArrayType)
-> Generic LowNewArrayType
forall x. Rep LowNewArrayType x -> LowNewArrayType
forall x. LowNewArrayType -> Rep LowNewArrayType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LowNewArrayType x -> LowNewArrayType
$cfrom :: forall x. LowNewArrayType -> Rep LowNewArrayType x
Generic, LowNewArrayType -> ()
(LowNewArrayType -> ()) -> NFData LowNewArrayType
forall a. (a -> ()) -> NFData a
rnf :: LowNewArrayType -> ()
$crnf :: LowNewArrayType -> ()
NFData)

data NewArrayType
  = NewArrayType Word8 JType
  deriving (Int -> NewArrayType -> String -> String
[NewArrayType] -> String -> String
NewArrayType -> String
(Int -> NewArrayType -> String -> String)
-> (NewArrayType -> String)
-> ([NewArrayType] -> String -> String)
-> Show NewArrayType
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [NewArrayType] -> String -> String
$cshowList :: [NewArrayType] -> String -> String
show :: NewArrayType -> String
$cshow :: NewArrayType -> String
showsPrec :: Int -> NewArrayType -> String -> String
$cshowsPrec :: Int -> NewArrayType -> String -> String
Show, Eq NewArrayType
Eq NewArrayType
-> (NewArrayType -> NewArrayType -> Ordering)
-> (NewArrayType -> NewArrayType -> Bool)
-> (NewArrayType -> NewArrayType -> Bool)
-> (NewArrayType -> NewArrayType -> Bool)
-> (NewArrayType -> NewArrayType -> Bool)
-> (NewArrayType -> NewArrayType -> NewArrayType)
-> (NewArrayType -> NewArrayType -> NewArrayType)
-> Ord NewArrayType
NewArrayType -> NewArrayType -> Bool
NewArrayType -> NewArrayType -> Ordering
NewArrayType -> NewArrayType -> NewArrayType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: NewArrayType -> NewArrayType -> NewArrayType
$cmin :: NewArrayType -> NewArrayType -> NewArrayType
max :: NewArrayType -> NewArrayType -> NewArrayType
$cmax :: NewArrayType -> NewArrayType -> NewArrayType
>= :: NewArrayType -> NewArrayType -> Bool
$c>= :: NewArrayType -> NewArrayType -> Bool
> :: NewArrayType -> NewArrayType -> Bool
$c> :: NewArrayType -> NewArrayType -> Bool
<= :: NewArrayType -> NewArrayType -> Bool
$c<= :: NewArrayType -> NewArrayType -> Bool
< :: NewArrayType -> NewArrayType -> Bool
$c< :: NewArrayType -> NewArrayType -> Bool
compare :: NewArrayType -> NewArrayType -> Ordering
$ccompare :: NewArrayType -> NewArrayType -> Ordering
$cp1Ord :: Eq NewArrayType
Ord, NewArrayType -> NewArrayType -> Bool
(NewArrayType -> NewArrayType -> Bool)
-> (NewArrayType -> NewArrayType -> Bool) -> Eq NewArrayType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NewArrayType -> NewArrayType -> Bool
$c/= :: NewArrayType -> NewArrayType -> Bool
== :: NewArrayType -> NewArrayType -> Bool
$c== :: NewArrayType -> NewArrayType -> Bool
Eq, (forall x. NewArrayType -> Rep NewArrayType x)
-> (forall x. Rep NewArrayType x -> NewArrayType)
-> Generic NewArrayType
forall x. Rep NewArrayType x -> NewArrayType
forall x. NewArrayType -> Rep NewArrayType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NewArrayType x -> NewArrayType
$cfrom :: forall x. NewArrayType -> Rep NewArrayType x
Generic, NewArrayType -> ()
(NewArrayType -> ()) -> NFData NewArrayType
forall a. (a -> ()) -> NFData a
rnf :: NewArrayType -> ()
$crnf :: NewArrayType -> ()
NFData)

data LocalType = LInt | LLong | LFloat | LDouble | LRef
  deriving (Int -> LocalType -> String -> String
[LocalType] -> String -> String
LocalType -> String
(Int -> LocalType -> String -> String)
-> (LocalType -> String)
-> ([LocalType] -> String -> String)
-> Show LocalType
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [LocalType] -> String -> String
$cshowList :: [LocalType] -> String -> String
show :: LocalType -> String
$cshow :: LocalType -> String
showsPrec :: Int -> LocalType -> String -> String
$cshowsPrec :: Int -> LocalType -> String -> String
Show, Eq LocalType
Eq LocalType
-> (LocalType -> LocalType -> Ordering)
-> (LocalType -> LocalType -> Bool)
-> (LocalType -> LocalType -> Bool)
-> (LocalType -> LocalType -> Bool)
-> (LocalType -> LocalType -> Bool)
-> (LocalType -> LocalType -> LocalType)
-> (LocalType -> LocalType -> LocalType)
-> Ord LocalType
LocalType -> LocalType -> Bool
LocalType -> LocalType -> Ordering
LocalType -> LocalType -> LocalType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LocalType -> LocalType -> LocalType
$cmin :: LocalType -> LocalType -> LocalType
max :: LocalType -> LocalType -> LocalType
$cmax :: LocalType -> LocalType -> LocalType
>= :: LocalType -> LocalType -> Bool
$c>= :: LocalType -> LocalType -> Bool
> :: LocalType -> LocalType -> Bool
$c> :: LocalType -> LocalType -> Bool
<= :: LocalType -> LocalType -> Bool
$c<= :: LocalType -> LocalType -> Bool
< :: LocalType -> LocalType -> Bool
$c< :: LocalType -> LocalType -> Bool
compare :: LocalType -> LocalType -> Ordering
$ccompare :: LocalType -> LocalType -> Ordering
$cp1Ord :: Eq LocalType
Ord, LocalType -> LocalType -> Bool
(LocalType -> LocalType -> Bool)
-> (LocalType -> LocalType -> Bool) -> Eq LocalType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LocalType -> LocalType -> Bool
$c/= :: LocalType -> LocalType -> Bool
== :: LocalType -> LocalType -> Bool
$c== :: LocalType -> LocalType -> Bool
Eq, Int -> LocalType
LocalType -> Int
LocalType -> [LocalType]
LocalType -> LocalType
LocalType -> LocalType -> [LocalType]
LocalType -> LocalType -> LocalType -> [LocalType]
(LocalType -> LocalType)
-> (LocalType -> LocalType)
-> (Int -> LocalType)
-> (LocalType -> Int)
-> (LocalType -> [LocalType])
-> (LocalType -> LocalType -> [LocalType])
-> (LocalType -> LocalType -> [LocalType])
-> (LocalType -> LocalType -> LocalType -> [LocalType])
-> Enum LocalType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: LocalType -> LocalType -> LocalType -> [LocalType]
$cenumFromThenTo :: LocalType -> LocalType -> LocalType -> [LocalType]
enumFromTo :: LocalType -> LocalType -> [LocalType]
$cenumFromTo :: LocalType -> LocalType -> [LocalType]
enumFromThen :: LocalType -> LocalType -> [LocalType]
$cenumFromThen :: LocalType -> LocalType -> [LocalType]
enumFrom :: LocalType -> [LocalType]
$cenumFrom :: LocalType -> [LocalType]
fromEnum :: LocalType -> Int
$cfromEnum :: LocalType -> Int
toEnum :: Int -> LocalType
$ctoEnum :: Int -> LocalType
pred :: LocalType -> LocalType
$cpred :: LocalType -> LocalType
succ :: LocalType -> LocalType
$csucc :: LocalType -> LocalType
Enum, LocalType
LocalType -> LocalType -> Bounded LocalType
forall a. a -> a -> Bounded a
maxBound :: LocalType
$cmaxBound :: LocalType
minBound :: LocalType
$cminBound :: LocalType
Bounded, (forall x. LocalType -> Rep LocalType x)
-> (forall x. Rep LocalType x -> LocalType) -> Generic LocalType
forall x. Rep LocalType x -> LocalType
forall x. LocalType -> Rep LocalType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LocalType x -> LocalType
$cfrom :: forall x. LocalType -> Rep LocalType x
Generic, LocalType -> ()
(LocalType -> ()) -> NFData LocalType
forall a. (a -> ()) -> NFData a
rnf :: LocalType -> ()
$crnf :: LocalType -> ()
NFData)

data ArrayType
  = AByte | AChar | AShort | AInt | ALong
  | AFloat | ADouble | ARef
  deriving (Int -> ArrayType -> String -> String
[ArrayType] -> String -> String
ArrayType -> String
(Int -> ArrayType -> String -> String)
-> (ArrayType -> String)
-> ([ArrayType] -> String -> String)
-> Show ArrayType
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [ArrayType] -> String -> String
$cshowList :: [ArrayType] -> String -> String
show :: ArrayType -> String
$cshow :: ArrayType -> String
showsPrec :: Int -> ArrayType -> String -> String
$cshowsPrec :: Int -> ArrayType -> String -> String
Show, ArrayType -> ArrayType -> Bool
(ArrayType -> ArrayType -> Bool)
-> (ArrayType -> ArrayType -> Bool) -> Eq ArrayType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ArrayType -> ArrayType -> Bool
$c/= :: ArrayType -> ArrayType -> Bool
== :: ArrayType -> ArrayType -> Bool
$c== :: ArrayType -> ArrayType -> Bool
Eq, Eq ArrayType
Eq ArrayType
-> (ArrayType -> ArrayType -> Ordering)
-> (ArrayType -> ArrayType -> Bool)
-> (ArrayType -> ArrayType -> Bool)
-> (ArrayType -> ArrayType -> Bool)
-> (ArrayType -> ArrayType -> Bool)
-> (ArrayType -> ArrayType -> ArrayType)
-> (ArrayType -> ArrayType -> ArrayType)
-> Ord ArrayType
ArrayType -> ArrayType -> Bool
ArrayType -> ArrayType -> Ordering
ArrayType -> ArrayType -> ArrayType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ArrayType -> ArrayType -> ArrayType
$cmin :: ArrayType -> ArrayType -> ArrayType
max :: ArrayType -> ArrayType -> ArrayType
$cmax :: ArrayType -> ArrayType -> ArrayType
>= :: ArrayType -> ArrayType -> Bool
$c>= :: ArrayType -> ArrayType -> Bool
> :: ArrayType -> ArrayType -> Bool
$c> :: ArrayType -> ArrayType -> Bool
<= :: ArrayType -> ArrayType -> Bool
$c<= :: ArrayType -> ArrayType -> Bool
< :: ArrayType -> ArrayType -> Bool
$c< :: ArrayType -> ArrayType -> Bool
compare :: ArrayType -> ArrayType -> Ordering
$ccompare :: ArrayType -> ArrayType -> Ordering
$cp1Ord :: Eq ArrayType
Ord, (forall x. ArrayType -> Rep ArrayType x)
-> (forall x. Rep ArrayType x -> ArrayType) -> Generic ArrayType
forall x. Rep ArrayType x -> ArrayType
forall x. ArrayType -> Rep ArrayType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ArrayType x -> ArrayType
$cfrom :: forall x. ArrayType -> Rep ArrayType x
Generic, ArrayType -> ()
(ArrayType -> ()) -> NFData ArrayType
forall a. (a -> ()) -> NFData a
rnf :: ArrayType -> ()
$crnf :: ArrayType -> ()
NFData)

data Invocation r
  = InvkSpecial !(Ref AbsVariableMethodId r)
  -- ^ Variable since 52.0
  | InvkVirtual !(Ref (InRefType MethodId) r)
  | InvkStatic !(Ref AbsVariableMethodId r)
  -- ^ Variable since 52.0
  | InvkInterface !Word8 !(Ref AbsInterfaceMethodId r)
  -- ^ Should be a positive number
  | InvkDynamic !(DeepRef InvokeDynamic r)

data FieldAccess
  = FldStatic
  | FldField
  deriving (Int -> FieldAccess -> String -> String
[FieldAccess] -> String -> String
FieldAccess -> String
(Int -> FieldAccess -> String -> String)
-> (FieldAccess -> String)
-> ([FieldAccess] -> String -> String)
-> Show FieldAccess
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [FieldAccess] -> String -> String
$cshowList :: [FieldAccess] -> String -> String
show :: FieldAccess -> String
$cshow :: FieldAccess -> String
showsPrec :: Int -> FieldAccess -> String -> String
$cshowsPrec :: Int -> FieldAccess -> String -> String
Show, Eq FieldAccess
Eq FieldAccess
-> (FieldAccess -> FieldAccess -> Ordering)
-> (FieldAccess -> FieldAccess -> Bool)
-> (FieldAccess -> FieldAccess -> Bool)
-> (FieldAccess -> FieldAccess -> Bool)
-> (FieldAccess -> FieldAccess -> Bool)
-> (FieldAccess -> FieldAccess -> FieldAccess)
-> (FieldAccess -> FieldAccess -> FieldAccess)
-> Ord FieldAccess
FieldAccess -> FieldAccess -> Bool
FieldAccess -> FieldAccess -> Ordering
FieldAccess -> FieldAccess -> FieldAccess
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FieldAccess -> FieldAccess -> FieldAccess
$cmin :: FieldAccess -> FieldAccess -> FieldAccess
max :: FieldAccess -> FieldAccess -> FieldAccess
$cmax :: FieldAccess -> FieldAccess -> FieldAccess
>= :: FieldAccess -> FieldAccess -> Bool
$c>= :: FieldAccess -> FieldAccess -> Bool
> :: FieldAccess -> FieldAccess -> Bool
$c> :: FieldAccess -> FieldAccess -> Bool
<= :: FieldAccess -> FieldAccess -> Bool
$c<= :: FieldAccess -> FieldAccess -> Bool
< :: FieldAccess -> FieldAccess -> Bool
$c< :: FieldAccess -> FieldAccess -> Bool
compare :: FieldAccess -> FieldAccess -> Ordering
$ccompare :: FieldAccess -> FieldAccess -> Ordering
$cp1Ord :: Eq FieldAccess
Ord, FieldAccess -> FieldAccess -> Bool
(FieldAccess -> FieldAccess -> Bool)
-> (FieldAccess -> FieldAccess -> Bool) -> Eq FieldAccess
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FieldAccess -> FieldAccess -> Bool
$c/= :: FieldAccess -> FieldAccess -> Bool
== :: FieldAccess -> FieldAccess -> Bool
$c== :: FieldAccess -> FieldAccess -> Bool
Eq, (forall x. FieldAccess -> Rep FieldAccess x)
-> (forall x. Rep FieldAccess x -> FieldAccess)
-> Generic FieldAccess
forall x. Rep FieldAccess x -> FieldAccess
forall x. FieldAccess -> Rep FieldAccess x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FieldAccess x -> FieldAccess
$cfrom :: forall x. FieldAccess -> Rep FieldAccess x
Generic, FieldAccess -> ()
(FieldAccess -> ()) -> NFData FieldAccess
forall a. (a -> ()) -> NFData a
rnf :: FieldAccess -> ()
$crnf :: FieldAccess -> ()
NFData)

data OneOrTwo = One | Two
  deriving (Int -> OneOrTwo -> String -> String
[OneOrTwo] -> String -> String
OneOrTwo -> String
(Int -> OneOrTwo -> String -> String)
-> (OneOrTwo -> String)
-> ([OneOrTwo] -> String -> String)
-> Show OneOrTwo
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [OneOrTwo] -> String -> String
$cshowList :: [OneOrTwo] -> String -> String
show :: OneOrTwo -> String
$cshow :: OneOrTwo -> String
showsPrec :: Int -> OneOrTwo -> String -> String
$cshowsPrec :: Int -> OneOrTwo -> String -> String
Show, Eq OneOrTwo
Eq OneOrTwo
-> (OneOrTwo -> OneOrTwo -> Ordering)
-> (OneOrTwo -> OneOrTwo -> Bool)
-> (OneOrTwo -> OneOrTwo -> Bool)
-> (OneOrTwo -> OneOrTwo -> Bool)
-> (OneOrTwo -> OneOrTwo -> Bool)
-> (OneOrTwo -> OneOrTwo -> OneOrTwo)
-> (OneOrTwo -> OneOrTwo -> OneOrTwo)
-> Ord OneOrTwo
OneOrTwo -> OneOrTwo -> Bool
OneOrTwo -> OneOrTwo -> Ordering
OneOrTwo -> OneOrTwo -> OneOrTwo
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: OneOrTwo -> OneOrTwo -> OneOrTwo
$cmin :: OneOrTwo -> OneOrTwo -> OneOrTwo
max :: OneOrTwo -> OneOrTwo -> OneOrTwo
$cmax :: OneOrTwo -> OneOrTwo -> OneOrTwo
>= :: OneOrTwo -> OneOrTwo -> Bool
$c>= :: OneOrTwo -> OneOrTwo -> Bool
> :: OneOrTwo -> OneOrTwo -> Bool
$c> :: OneOrTwo -> OneOrTwo -> Bool
<= :: OneOrTwo -> OneOrTwo -> Bool
$c<= :: OneOrTwo -> OneOrTwo -> Bool
< :: OneOrTwo -> OneOrTwo -> Bool
$c< :: OneOrTwo -> OneOrTwo -> Bool
compare :: OneOrTwo -> OneOrTwo -> Ordering
$ccompare :: OneOrTwo -> OneOrTwo -> Ordering
$cp1Ord :: Eq OneOrTwo
Ord, OneOrTwo
OneOrTwo -> OneOrTwo -> Bounded OneOrTwo
forall a. a -> a -> Bounded a
maxBound :: OneOrTwo
$cmaxBound :: OneOrTwo
minBound :: OneOrTwo
$cminBound :: OneOrTwo
Bounded, OneOrTwo -> OneOrTwo -> Bool
(OneOrTwo -> OneOrTwo -> Bool)
-> (OneOrTwo -> OneOrTwo -> Bool) -> Eq OneOrTwo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OneOrTwo -> OneOrTwo -> Bool
$c/= :: OneOrTwo -> OneOrTwo -> Bool
== :: OneOrTwo -> OneOrTwo -> Bool
$c== :: OneOrTwo -> OneOrTwo -> Bool
Eq, Int -> OneOrTwo
OneOrTwo -> Int
OneOrTwo -> [OneOrTwo]
OneOrTwo -> OneOrTwo
OneOrTwo -> OneOrTwo -> [OneOrTwo]
OneOrTwo -> OneOrTwo -> OneOrTwo -> [OneOrTwo]
(OneOrTwo -> OneOrTwo)
-> (OneOrTwo -> OneOrTwo)
-> (Int -> OneOrTwo)
-> (OneOrTwo -> Int)
-> (OneOrTwo -> [OneOrTwo])
-> (OneOrTwo -> OneOrTwo -> [OneOrTwo])
-> (OneOrTwo -> OneOrTwo -> [OneOrTwo])
-> (OneOrTwo -> OneOrTwo -> OneOrTwo -> [OneOrTwo])
-> Enum OneOrTwo
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: OneOrTwo -> OneOrTwo -> OneOrTwo -> [OneOrTwo]
$cenumFromThenTo :: OneOrTwo -> OneOrTwo -> OneOrTwo -> [OneOrTwo]
enumFromTo :: OneOrTwo -> OneOrTwo -> [OneOrTwo]
$cenumFromTo :: OneOrTwo -> OneOrTwo -> [OneOrTwo]
enumFromThen :: OneOrTwo -> OneOrTwo -> [OneOrTwo]
$cenumFromThen :: OneOrTwo -> OneOrTwo -> [OneOrTwo]
enumFrom :: OneOrTwo -> [OneOrTwo]
$cenumFrom :: OneOrTwo -> [OneOrTwo]
fromEnum :: OneOrTwo -> Int
$cfromEnum :: OneOrTwo -> Int
toEnum :: Int -> OneOrTwo
$ctoEnum :: Int -> OneOrTwo
pred :: OneOrTwo -> OneOrTwo
$cpred :: OneOrTwo -> OneOrTwo
succ :: OneOrTwo -> OneOrTwo
$csucc :: OneOrTwo -> OneOrTwo
Enum, (forall x. OneOrTwo -> Rep OneOrTwo x)
-> (forall x. Rep OneOrTwo x -> OneOrTwo) -> Generic OneOrTwo
forall x. Rep OneOrTwo x -> OneOrTwo
forall x. OneOrTwo -> Rep OneOrTwo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OneOrTwo x -> OneOrTwo
$cfrom :: forall x. OneOrTwo -> Rep OneOrTwo x
Generic, OneOrTwo -> ()
(OneOrTwo -> ()) -> NFData OneOrTwo
forall a. (a -> ()) -> NFData a
rnf :: OneOrTwo -> ()
$crnf :: OneOrTwo -> ()
NFData)

type WordSize = OneOrTwo

evolveBConstant :: EvolveM m => BConstant Low -> m (BConstant High)
evolveBConstant :: BConstant Low -> m (BConstant High)
evolveBConstant BConstant Low
ccnst = do
  CConstant High
x <- CConstant Low -> m (CConstant High)
forall (s :: * -> *) (m :: * -> *).
(Staged s, EvolveM m) =>
s Low -> m (s High)
evolve BConstant Low
CConstant Low
ccnst
  Maybe JValue -> m (Maybe JValue)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe JValue -> m (Maybe JValue))
-> Maybe JValue -> m (Maybe JValue)
forall a b. (a -> b) -> a -> b
$ case CConstant High
x of
    CConstant High
CNull    -> Maybe JValue
forall a. Maybe a
Nothing
    CConstant High
CIntM1   -> JValue -> Maybe JValue
forall a. a -> Maybe a
Just (JValue -> Maybe JValue) -> JValue -> Maybe JValue
forall a b. (a -> b) -> a -> b
$ Int32 -> JValue
VInteger (-Int32
1)
    CConstant High
CInt0    -> JValue -> Maybe JValue
forall a. a -> Maybe a
Just (JValue -> Maybe JValue) -> JValue -> Maybe JValue
forall a b. (a -> b) -> a -> b
$ Int32 -> JValue
VInteger Int32
0
    CConstant High
CInt1    -> JValue -> Maybe JValue
forall a. a -> Maybe a
Just (JValue -> Maybe JValue) -> JValue -> Maybe JValue
forall a b. (a -> b) -> a -> b
$ Int32 -> JValue
VInteger Int32
1
    CConstant High
CInt2    -> JValue -> Maybe JValue
forall a. a -> Maybe a
Just (JValue -> Maybe JValue) -> JValue -> Maybe JValue
forall a b. (a -> b) -> a -> b
$ Int32 -> JValue
VInteger Int32
2
    CConstant High
CInt3    -> JValue -> Maybe JValue
forall a. a -> Maybe a
Just (JValue -> Maybe JValue) -> JValue -> Maybe JValue
forall a b. (a -> b) -> a -> b
$ Int32 -> JValue
VInteger Int32
3
    CConstant High
CInt4    -> JValue -> Maybe JValue
forall a. a -> Maybe a
Just (JValue -> Maybe JValue) -> JValue -> Maybe JValue
forall a b. (a -> b) -> a -> b
$ Int32 -> JValue
VInteger Int32
4
    CConstant High
CInt5    -> JValue -> Maybe JValue
forall a. a -> Maybe a
Just (JValue -> Maybe JValue) -> JValue -> Maybe JValue
forall a b. (a -> b) -> a -> b
$ Int32 -> JValue
VInteger Int32
5
    CConstant High
CLong0   -> JValue -> Maybe JValue
forall a. a -> Maybe a
Just (JValue -> Maybe JValue) -> JValue -> Maybe JValue
forall a b. (a -> b) -> a -> b
$ Int64 -> JValue
VLong Int64
0
    CConstant High
CLong1   -> JValue -> Maybe JValue
forall a. a -> Maybe a
Just (JValue -> Maybe JValue) -> JValue -> Maybe JValue
forall a b. (a -> b) -> a -> b
$ Int64 -> JValue
VLong Int64
1
    CConstant High
CFloat0  -> JValue -> Maybe JValue
forall a. a -> Maybe a
Just (JValue -> Maybe JValue) -> JValue -> Maybe JValue
forall a b. (a -> b) -> a -> b
$ VFloat -> JValue
VFloat VFloat
0
    CConstant High
CFloat1  -> JValue -> Maybe JValue
forall a. a -> Maybe a
Just (JValue -> Maybe JValue) -> JValue -> Maybe JValue
forall a b. (a -> b) -> a -> b
$ VFloat -> JValue
VFloat VFloat
1
    CConstant High
CFloat2  -> JValue -> Maybe JValue
forall a. a -> Maybe a
Just (JValue -> Maybe JValue) -> JValue -> Maybe JValue
forall a b. (a -> b) -> a -> b
$ VFloat -> JValue
VFloat VFloat
2
    CConstant High
CDouble0 -> JValue -> Maybe JValue
forall a. a -> Maybe a
Just (JValue -> Maybe JValue) -> JValue -> Maybe JValue
forall a b. (a -> b) -> a -> b
$ VDouble -> JValue
VDouble VDouble
0
    CConstant High
CDouble1 -> JValue -> Maybe JValue
forall a. a -> Maybe a
Just (JValue -> Maybe JValue) -> JValue -> Maybe JValue
forall a b. (a -> b) -> a -> b
$ VDouble -> JValue
VDouble VDouble
1
    CByte Int8
i  -> JValue -> Maybe JValue
forall a. a -> Maybe a
Just (JValue -> Maybe JValue) -> JValue -> Maybe JValue
forall a b. (a -> b) -> a -> b
$ Int32 -> JValue
VInteger (Int8 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int8
i)
    CShort Int16
i -> JValue -> Maybe JValue
forall a. a -> Maybe a
Just (JValue -> Maybe JValue) -> JValue -> Maybe JValue
forall a b. (a -> b) -> a -> b
$ Int32 -> JValue
VInteger (Int16 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int16
i)
    CRef Maybe OneOrTwo
_ Ref JValue High
r -> JValue -> Maybe JValue
forall a. a -> Maybe a
Just (JValue -> Maybe JValue) -> JValue -> Maybe JValue
forall a b. (a -> b) -> a -> b
$ Ref JValue High
JValue
r

devolveBConstant :: DevolveM m =>  BConstant High -> m (BConstant Low)
devolveBConstant :: BConstant High -> m (BConstant Low)
devolveBConstant BConstant High
x = do
  CConstant High -> m (CConstant Low)
forall (s :: * -> *) (m :: * -> *).
(Staged s, DevolveM m) =>
s High -> m (s Low)
devolve CConstant High
v
  where
    v :: CConstant High
    v :: CConstant High
v = case BConstant High
x of
      BConstant High
Nothing -> CConstant High
forall r. CConstant r
CNull
      Just x' -> case JValue
x' of
        VInteger Int32
i ->
          case Int32
i of
            (-1) -> CConstant High
forall r. CConstant r
CIntM1; Int32
0 -> CConstant High
forall r. CConstant r
CInt0; Int32
1 -> CConstant High
forall r. CConstant r
CInt1; Int32
2 -> CConstant High
forall r. CConstant r
CInt2; Int32
3 -> CConstant High
forall r. CConstant r
CInt3; Int32
4 -> CConstant High
forall r. CConstant r
CInt4; Int32
5 -> CConstant High
forall r. CConstant r
CInt5;
            Int32
i | -Int32
128 Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int32
i Bool -> Bool -> Bool
&& Int32
i Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int32
127      -> Int8 -> CConstant High
forall r. Int8 -> CConstant r
CByte (Int32 -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
i)
              | -Int32
32768 Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int32
i Bool -> Bool -> Bool
&& Int32
i Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int32
32767 -> Int16 -> CConstant High
forall r. Int16 -> CConstant r
CShort (Int32 -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
i)
              | Bool
otherwise -> Maybe OneOrTwo -> Ref JValue High -> CConstant High
forall r. Maybe OneOrTwo -> Ref JValue r -> CConstant r
CRef Maybe OneOrTwo
forall a. Maybe a
Nothing Ref JValue High
JValue
x'
        VLong Int64
0                           -> CConstant High
forall r. CConstant r
CLong0
        VLong Int64
1                           -> CConstant High
forall r. CConstant r
CLong1
        VFloat VFloat
0                          -> CConstant High
forall r. CConstant r
CFloat0
        VFloat VFloat
1                          -> CConstant High
forall r. CConstant r
CFloat1
        VFloat VFloat
2                          -> CConstant High
forall r. CConstant r
CFloat2
        VDouble VDouble
0                         -> CConstant High
forall r. CConstant r
CDouble0
        VDouble VDouble
1                         -> CConstant High
forall r. CConstant r
CDouble1
        VDouble VDouble
_                         -> Maybe OneOrTwo -> Ref JValue High -> CConstant High
forall r. Maybe OneOrTwo -> Ref JValue r -> CConstant r
CRef (OneOrTwo -> Maybe OneOrTwo
forall a. a -> Maybe a
Just OneOrTwo
Two) Ref JValue High
JValue
x'
        VLong Int64
_                           -> Maybe OneOrTwo -> Ref JValue High -> CConstant High
forall r. Maybe OneOrTwo -> Ref JValue r -> CConstant r
CRef (OneOrTwo -> Maybe OneOrTwo
forall a. a -> Maybe a
Just OneOrTwo
Two) Ref JValue High
JValue
x'
        JValue
_                                 -> Maybe OneOrTwo -> Ref JValue High -> CConstant High
forall r. Maybe OneOrTwo -> Ref JValue r -> CConstant r
CRef Maybe OneOrTwo
forall a. Maybe a
Nothing Ref JValue High
JValue
x'


-- | A Wrapper around CConstant.
type BConstant r = Choice (CConstant r) (Maybe JValue) r

instance Staged CConstant where
  evolve :: CConstant Low -> m (CConstant High)
evolve CConstant Low
x =
    case CConstant Low
x of
      CRef Maybe OneOrTwo
w Ref JValue Low
r -> String -> m (CConstant High) -> m (CConstant High)
forall (m :: * -> *) a. LabelM m => String -> m a -> m a
label String
"Ref" (m (CConstant High) -> m (CConstant High))
-> m (CConstant High) -> m (CConstant High)
forall a b. (a -> b) -> a -> b
$ Maybe OneOrTwo -> Ref JValue High -> CConstant High
forall r. Maybe OneOrTwo -> Ref JValue r -> CConstant r
CRef Maybe OneOrTwo
w (JValue -> CConstant High) -> m JValue -> m (CConstant High)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteCodeOffset -> m JValue
forall (m :: * -> *) r.
(EvolveM m, Referenceable r) =>
ByteCodeOffset -> m r
link ByteCodeOffset
Ref JValue Low
r
      CConstant Low
a        -> CConstant High -> m (CConstant High)
forall (m :: * -> *) a. Monad m => a -> m a
return (CConstant High -> m (CConstant High))
-> CConstant High -> m (CConstant High)
forall a b. (a -> b) -> a -> b
$ CConstant Low -> CConstant High
forall a b. a -> b
unsafeCoerce CConstant Low
a

  devolve :: CConstant High -> m (CConstant Low)
devolve CConstant High
x =
    case CConstant High
x of
      CRef Maybe OneOrTwo
w Ref JValue High
r -> String -> m (CConstant Low) -> m (CConstant Low)
forall (m :: * -> *) a. LabelM m => String -> m a -> m a
label String
"Ref" (m (CConstant Low) -> m (CConstant Low))
-> m (CConstant Low) -> m (CConstant Low)
forall a b. (a -> b) -> a -> b
$ Maybe OneOrTwo -> Ref JValue Low -> CConstant Low
forall r. Maybe OneOrTwo -> Ref JValue r -> CConstant r
CRef Maybe OneOrTwo
w (ByteCodeOffset -> CConstant Low)
-> m ByteCodeOffset -> m (CConstant Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JValue -> m ByteCodeOffset
forall (m :: * -> *) r.
(DevolveM m, Referenceable r) =>
r -> m ByteCodeOffset
unlink Ref JValue High
JValue
r
      CConstant High
a        -> CConstant Low -> m (CConstant Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (CConstant Low -> m (CConstant Low))
-> CConstant Low -> m (CConstant Low)
forall a b. (a -> b) -> a -> b
$ CConstant High -> CConstant Low
forall a b. a -> b
unsafeCoerce CConstant High
a


data CConstant r
  = CNull

  | CIntM1
   -- ^ -1
  | CInt0
  | CInt1
  | CInt2
  | CInt3
  | CInt4
  | CInt5

  | CLong0
  | CLong1

  | CFloat0
  | CFloat1
  | CFloat2

  | CDouble0
  | CDouble1

  | CByte Int8
  | CShort Int16

  | CRef (Maybe WordSize) (Ref JValue r)

data BinOpr
  = Add
  | Sub
  | Mul
  | Div
  | Rem
  deriving (Int -> BinOpr -> String -> String
[BinOpr] -> String -> String
BinOpr -> String
(Int -> BinOpr -> String -> String)
-> (BinOpr -> String)
-> ([BinOpr] -> String -> String)
-> Show BinOpr
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [BinOpr] -> String -> String
$cshowList :: [BinOpr] -> String -> String
show :: BinOpr -> String
$cshow :: BinOpr -> String
showsPrec :: Int -> BinOpr -> String -> String
$cshowsPrec :: Int -> BinOpr -> String -> String
Show, Eq BinOpr
Eq BinOpr
-> (BinOpr -> BinOpr -> Ordering)
-> (BinOpr -> BinOpr -> Bool)
-> (BinOpr -> BinOpr -> Bool)
-> (BinOpr -> BinOpr -> Bool)
-> (BinOpr -> BinOpr -> Bool)
-> (BinOpr -> BinOpr -> BinOpr)
-> (BinOpr -> BinOpr -> BinOpr)
-> Ord BinOpr
BinOpr -> BinOpr -> Bool
BinOpr -> BinOpr -> Ordering
BinOpr -> BinOpr -> BinOpr
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BinOpr -> BinOpr -> BinOpr
$cmin :: BinOpr -> BinOpr -> BinOpr
max :: BinOpr -> BinOpr -> BinOpr
$cmax :: BinOpr -> BinOpr -> BinOpr
>= :: BinOpr -> BinOpr -> Bool
$c>= :: BinOpr -> BinOpr -> Bool
> :: BinOpr -> BinOpr -> Bool
$c> :: BinOpr -> BinOpr -> Bool
<= :: BinOpr -> BinOpr -> Bool
$c<= :: BinOpr -> BinOpr -> Bool
< :: BinOpr -> BinOpr -> Bool
$c< :: BinOpr -> BinOpr -> Bool
compare :: BinOpr -> BinOpr -> Ordering
$ccompare :: BinOpr -> BinOpr -> Ordering
$cp1Ord :: Eq BinOpr
Ord, BinOpr -> BinOpr -> Bool
(BinOpr -> BinOpr -> Bool)
-> (BinOpr -> BinOpr -> Bool) -> Eq BinOpr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BinOpr -> BinOpr -> Bool
$c/= :: BinOpr -> BinOpr -> Bool
== :: BinOpr -> BinOpr -> Bool
$c== :: BinOpr -> BinOpr -> Bool
Eq, (forall x. BinOpr -> Rep BinOpr x)
-> (forall x. Rep BinOpr x -> BinOpr) -> Generic BinOpr
forall x. Rep BinOpr x -> BinOpr
forall x. BinOpr -> Rep BinOpr x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BinOpr x -> BinOpr
$cfrom :: forall x. BinOpr -> Rep BinOpr x
Generic, BinOpr -> ()
(BinOpr -> ()) -> NFData BinOpr
forall a. (a -> ()) -> NFData a
rnf :: BinOpr -> ()
$crnf :: BinOpr -> ()
NFData)

data BitOpr
  = ShL
  | ShR
  | UShR
  | And
  | Or
  | XOr
  deriving (Int -> BitOpr -> String -> String
[BitOpr] -> String -> String
BitOpr -> String
(Int -> BitOpr -> String -> String)
-> (BitOpr -> String)
-> ([BitOpr] -> String -> String)
-> Show BitOpr
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [BitOpr] -> String -> String
$cshowList :: [BitOpr] -> String -> String
show :: BitOpr -> String
$cshow :: BitOpr -> String
showsPrec :: Int -> BitOpr -> String -> String
$cshowsPrec :: Int -> BitOpr -> String -> String
Show, Eq BitOpr
Eq BitOpr
-> (BitOpr -> BitOpr -> Ordering)
-> (BitOpr -> BitOpr -> Bool)
-> (BitOpr -> BitOpr -> Bool)
-> (BitOpr -> BitOpr -> Bool)
-> (BitOpr -> BitOpr -> Bool)
-> (BitOpr -> BitOpr -> BitOpr)
-> (BitOpr -> BitOpr -> BitOpr)
-> Ord BitOpr
BitOpr -> BitOpr -> Bool
BitOpr -> BitOpr -> Ordering
BitOpr -> BitOpr -> BitOpr
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BitOpr -> BitOpr -> BitOpr
$cmin :: BitOpr -> BitOpr -> BitOpr
max :: BitOpr -> BitOpr -> BitOpr
$cmax :: BitOpr -> BitOpr -> BitOpr
>= :: BitOpr -> BitOpr -> Bool
$c>= :: BitOpr -> BitOpr -> Bool
> :: BitOpr -> BitOpr -> Bool
$c> :: BitOpr -> BitOpr -> Bool
<= :: BitOpr -> BitOpr -> Bool
$c<= :: BitOpr -> BitOpr -> Bool
< :: BitOpr -> BitOpr -> Bool
$c< :: BitOpr -> BitOpr -> Bool
compare :: BitOpr -> BitOpr -> Ordering
$ccompare :: BitOpr -> BitOpr -> Ordering
$cp1Ord :: Eq BitOpr
Ord, BitOpr -> BitOpr -> Bool
(BitOpr -> BitOpr -> Bool)
-> (BitOpr -> BitOpr -> Bool) -> Eq BitOpr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BitOpr -> BitOpr -> Bool
$c/= :: BitOpr -> BitOpr -> Bool
== :: BitOpr -> BitOpr -> Bool
$c== :: BitOpr -> BitOpr -> Bool
Eq, (forall x. BitOpr -> Rep BitOpr x)
-> (forall x. Rep BitOpr x -> BitOpr) -> Generic BitOpr
forall x. Rep BitOpr x -> BitOpr
forall x. BitOpr -> Rep BitOpr x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BitOpr x -> BitOpr
$cfrom :: forall x. BitOpr -> Rep BitOpr x
Generic, BitOpr -> ()
(BitOpr -> ()) -> NFData BitOpr
forall a. (a -> ()) -> NFData a
rnf :: BitOpr -> ()
$crnf :: BitOpr -> ()
NFData)

type LocalAddress = Word16
type IncrementAmount = Int16

maxWord8 :: Word16
maxWord8 :: ByteCodeOffset
maxWord8 = ByteCodeOffset
0xff

data CmpOpr
  = CEq | CNe | CLt | CGe | CGt | CLe
  deriving (Int -> CmpOpr -> String -> String
[CmpOpr] -> String -> String
CmpOpr -> String
(Int -> CmpOpr -> String -> String)
-> (CmpOpr -> String)
-> ([CmpOpr] -> String -> String)
-> Show CmpOpr
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [CmpOpr] -> String -> String
$cshowList :: [CmpOpr] -> String -> String
show :: CmpOpr -> String
$cshow :: CmpOpr -> String
showsPrec :: Int -> CmpOpr -> String -> String
$cshowsPrec :: Int -> CmpOpr -> String -> String
Show, Eq CmpOpr
Eq CmpOpr
-> (CmpOpr -> CmpOpr -> Ordering)
-> (CmpOpr -> CmpOpr -> Bool)
-> (CmpOpr -> CmpOpr -> Bool)
-> (CmpOpr -> CmpOpr -> Bool)
-> (CmpOpr -> CmpOpr -> Bool)
-> (CmpOpr -> CmpOpr -> CmpOpr)
-> (CmpOpr -> CmpOpr -> CmpOpr)
-> Ord CmpOpr
CmpOpr -> CmpOpr -> Bool
CmpOpr -> CmpOpr -> Ordering
CmpOpr -> CmpOpr -> CmpOpr
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CmpOpr -> CmpOpr -> CmpOpr
$cmin :: CmpOpr -> CmpOpr -> CmpOpr
max :: CmpOpr -> CmpOpr -> CmpOpr
$cmax :: CmpOpr -> CmpOpr -> CmpOpr
>= :: CmpOpr -> CmpOpr -> Bool
$c>= :: CmpOpr -> CmpOpr -> Bool
> :: CmpOpr -> CmpOpr -> Bool
$c> :: CmpOpr -> CmpOpr -> Bool
<= :: CmpOpr -> CmpOpr -> Bool
$c<= :: CmpOpr -> CmpOpr -> Bool
< :: CmpOpr -> CmpOpr -> Bool
$c< :: CmpOpr -> CmpOpr -> Bool
compare :: CmpOpr -> CmpOpr -> Ordering
$ccompare :: CmpOpr -> CmpOpr -> Ordering
$cp1Ord :: Eq CmpOpr
Ord, CmpOpr -> CmpOpr -> Bool
(CmpOpr -> CmpOpr -> Bool)
-> (CmpOpr -> CmpOpr -> Bool) -> Eq CmpOpr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CmpOpr -> CmpOpr -> Bool
$c/= :: CmpOpr -> CmpOpr -> Bool
== :: CmpOpr -> CmpOpr -> Bool
$c== :: CmpOpr -> CmpOpr -> Bool
Eq, (forall x. CmpOpr -> Rep CmpOpr x)
-> (forall x. Rep CmpOpr x -> CmpOpr) -> Generic CmpOpr
forall x. Rep CmpOpr x -> CmpOpr
forall x. CmpOpr -> Rep CmpOpr x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CmpOpr x -> CmpOpr
$cfrom :: forall x. CmpOpr -> Rep CmpOpr x
Generic, CmpOpr -> ()
(CmpOpr -> ()) -> NFData CmpOpr
forall a. (a -> ()) -> NFData a
rnf :: CmpOpr -> ()
$crnf :: CmpOpr -> ()
NFData)

data CastOpr
  = CastDown SmallArithmeticType
  -- ^ Cast from Int to a smaller type
  | CastTo ArithmeticType ArithmeticType
  -- ^ Cast from any to any arithmetic type. Cannot be the same type.
  deriving (Int -> CastOpr -> String -> String
[CastOpr] -> String -> String
CastOpr -> String
(Int -> CastOpr -> String -> String)
-> (CastOpr -> String)
-> ([CastOpr] -> String -> String)
-> Show CastOpr
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [CastOpr] -> String -> String
$cshowList :: [CastOpr] -> String -> String
show :: CastOpr -> String
$cshow :: CastOpr -> String
showsPrec :: Int -> CastOpr -> String -> String
$cshowsPrec :: Int -> CastOpr -> String -> String
Show, Eq CastOpr
Eq CastOpr
-> (CastOpr -> CastOpr -> Ordering)
-> (CastOpr -> CastOpr -> Bool)
-> (CastOpr -> CastOpr -> Bool)
-> (CastOpr -> CastOpr -> Bool)
-> (CastOpr -> CastOpr -> Bool)
-> (CastOpr -> CastOpr -> CastOpr)
-> (CastOpr -> CastOpr -> CastOpr)
-> Ord CastOpr
CastOpr -> CastOpr -> Bool
CastOpr -> CastOpr -> Ordering
CastOpr -> CastOpr -> CastOpr
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CastOpr -> CastOpr -> CastOpr
$cmin :: CastOpr -> CastOpr -> CastOpr
max :: CastOpr -> CastOpr -> CastOpr
$cmax :: CastOpr -> CastOpr -> CastOpr
>= :: CastOpr -> CastOpr -> Bool
$c>= :: CastOpr -> CastOpr -> Bool
> :: CastOpr -> CastOpr -> Bool
$c> :: CastOpr -> CastOpr -> Bool
<= :: CastOpr -> CastOpr -> Bool
$c<= :: CastOpr -> CastOpr -> Bool
< :: CastOpr -> CastOpr -> Bool
$c< :: CastOpr -> CastOpr -> Bool
compare :: CastOpr -> CastOpr -> Ordering
$ccompare :: CastOpr -> CastOpr -> Ordering
$cp1Ord :: Eq CastOpr
Ord, CastOpr -> CastOpr -> Bool
(CastOpr -> CastOpr -> Bool)
-> (CastOpr -> CastOpr -> Bool) -> Eq CastOpr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CastOpr -> CastOpr -> Bool
$c/= :: CastOpr -> CastOpr -> Bool
== :: CastOpr -> CastOpr -> Bool
$c== :: CastOpr -> CastOpr -> Bool
Eq, (forall x. CastOpr -> Rep CastOpr x)
-> (forall x. Rep CastOpr x -> CastOpr) -> Generic CastOpr
forall x. Rep CastOpr x -> CastOpr
forall x. CastOpr -> Rep CastOpr x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CastOpr x -> CastOpr
$cfrom :: forall x. CastOpr -> Rep CastOpr x
Generic, CastOpr -> ()
(CastOpr -> ()) -> NFData CastOpr
forall a. (a -> ()) -> NFData a
rnf :: CastOpr -> ()
$crnf :: CastOpr -> ()
NFData)


data SwitchTable r = SwitchTable
  { SwitchTable r -> Int32
switchLow     :: Int32
  , SwitchTable r -> Vector (LongRelativeRef r)
switchOffsets :: V.Vector (LongRelativeRef r)
  }

switchHigh :: SwitchTable Low -> Int32
switchHigh :: SwitchTable Low -> Int32
switchHigh SwitchTable Low
st =
  Int32
len Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
1 Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ SwitchTable Low -> Int32
forall r. SwitchTable r -> Int32
switchLow SwitchTable Low
st
  where
    len :: Int32
len = Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> (Vector Int32 -> Int) -> Vector Int32 -> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Int32 -> Int
forall a. Vector a -> Int
V.length (Vector Int32 -> Int32) -> Vector Int32 -> Int32
forall a b. (a -> b) -> a -> b
$ SwitchTable Low -> Vector (LongRelativeRef Low)
forall r. SwitchTable r -> Vector (LongRelativeRef r)
switchOffsets SwitchTable Low
st

data ByteCodeOpr r
  = ArrayLoad !ArrayType
  -- ^ aaload baload ...
  | ArrayStore !ArrayType
  -- ^ aastore bastore ...

  | Push !(BConstant r)

  | Load !LocalType !LocalAddress
  -- ^ aload_0, bload_2, iload 5 ...
  | Store !LocalType !LocalAddress
  -- ^ aload, bload ...

  | BinaryOpr !BinOpr !ArithmeticType
  -- ^ iadd ...
  | Neg !ArithmeticType
  -- ^ ineg ...

  | BitOpr !BitOpr !WordSize
  -- ^ Exclusively on int and long, identified by the word-size

  | IncrLocal !LocalAddress !IncrementAmount
  -- ^ Only works on ints, increment local #1, with #2

  | Cast !CastOpr
  -- ^ Only valid on different types

  | CompareLongs

  | CompareFloating !Bool !WordSize
  -- ^ Compare two floating values, #1 indicates if greater-than, #2
  -- is if float or double should be used.

  | If !CmpOpr !OneOrTwo !(ShortRelativeRef r)
  -- ^ compare with 0 if #2 is False, and two ints from the stack if
  -- True. the last value is the offset

  | IfRef !Bool !OneOrTwo !(ShortRelativeRef r)
  -- ^ check if two objects are equal, or not equal. If #2 is True, compare
  -- with null.

  | Goto !(LongRelativeRef r)
  | Jsr !(LongRelativeRef r)
  | Ret !LocalAddress

  | TableSwitch !(LongRelativeRef r) !(SwitchTable r)
  -- ^ a table switch has 2 values a `default` and a `SwitchTable`
  | LookupSwitch !(LongRelativeRef r) (V.Vector (Int32, (LongRelativeRef r)))
  -- ^ a lookup switch has a `default` value and a list of pairs.

  | Get !FieldAccess !(Ref AbsFieldId r)
  | Put !FieldAccess !(Ref AbsFieldId r)

  | Invoke !(Invocation r)

  | New !(Ref ClassName r)
  
  | NewArray !(Choice LowNewArrayType NewArrayType r)
  -- ^ the first argument is the number of dimentions
  -- of the array that have to be instantiatied.
  -- The JType indicates the type of the instantiated array

  | ArrayLength

  | Throw

  | CheckCast !(Ref JRefType r)
  | InstanceOf !(Ref JRefType r)

  | Monitor !Bool
  -- ^ True => Enter, False => Exit

  | Return !(Maybe LocalType)

  | Nop

  | Pop !WordSize

  | Dup !WordSize
  | DupX1 !WordSize
  | DupX2 !WordSize

  | Swap


instance Binary (ByteCodeOpr Low) where
  get :: Get (ByteCodeOpr Low)
get = do
    Word8
cmd <- Get Word8
getWord8
    case Word8
cmd of
      Word8
0x00 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return ByteCodeOpr Low
forall r. ByteCodeOpr r
Nop
      Word8
0x01 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ BConstant Low -> ByteCodeOpr Low
forall r. BConstant r -> ByteCodeOpr r
Push BConstant Low
forall r. CConstant r
CNull

      Word8
0x02 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ BConstant Low -> ByteCodeOpr Low
forall r. BConstant r -> ByteCodeOpr r
Push BConstant Low
forall r. CConstant r
CIntM1
      Word8
0x03 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ BConstant Low -> ByteCodeOpr Low
forall r. BConstant r -> ByteCodeOpr r
Push BConstant Low
forall r. CConstant r
CInt0
      Word8
0x04 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ BConstant Low -> ByteCodeOpr Low
forall r. BConstant r -> ByteCodeOpr r
Push BConstant Low
forall r. CConstant r
CInt1
      Word8
0x05 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ BConstant Low -> ByteCodeOpr Low
forall r. BConstant r -> ByteCodeOpr r
Push BConstant Low
forall r. CConstant r
CInt2
      Word8
0x06 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ BConstant Low -> ByteCodeOpr Low
forall r. BConstant r -> ByteCodeOpr r
Push BConstant Low
forall r. CConstant r
CInt3
      Word8
0x07 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ BConstant Low -> ByteCodeOpr Low
forall r. BConstant r -> ByteCodeOpr r
Push BConstant Low
forall r. CConstant r
CInt4
      Word8
0x08 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ BConstant Low -> ByteCodeOpr Low
forall r. BConstant r -> ByteCodeOpr r
Push BConstant Low
forall r. CConstant r
CInt5

      Word8
0x09 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ BConstant Low -> ByteCodeOpr Low
forall r. BConstant r -> ByteCodeOpr r
Push BConstant Low
forall r. CConstant r
CLong0
      Word8
0x0a -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ BConstant Low -> ByteCodeOpr Low
forall r. BConstant r -> ByteCodeOpr r
Push BConstant Low
forall r. CConstant r
CLong1

      Word8
0x0b -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ BConstant Low -> ByteCodeOpr Low
forall r. BConstant r -> ByteCodeOpr r
Push BConstant Low
forall r. CConstant r
CFloat0
      Word8
0x0c -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ BConstant Low -> ByteCodeOpr Low
forall r. BConstant r -> ByteCodeOpr r
Push BConstant Low
forall r. CConstant r
CFloat1
      Word8
0x0d -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ BConstant Low -> ByteCodeOpr Low
forall r. BConstant r -> ByteCodeOpr r
Push BConstant Low
forall r. CConstant r
CFloat2

      Word8
0x0e -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ BConstant Low -> ByteCodeOpr Low
forall r. BConstant r -> ByteCodeOpr r
Push BConstant Low
forall r. CConstant r
CDouble0
      Word8
0x0f -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ BConstant Low -> ByteCodeOpr Low
forall r. BConstant r -> ByteCodeOpr r
Push BConstant Low
forall r. CConstant r
CDouble1

      Word8
0x10 -> CConstant Low -> ByteCodeOpr Low
forall r. BConstant r -> ByteCodeOpr r
Push (CConstant Low -> ByteCodeOpr Low)
-> (Int8 -> CConstant Low) -> Int8 -> ByteCodeOpr Low
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> CConstant Low
forall r. Int8 -> CConstant r
CByte (Int8 -> ByteCodeOpr Low) -> Get Int8 -> Get (ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int8
forall t. Binary t => Get t
get
      Word8
0x11 -> CConstant Low -> ByteCodeOpr Low
forall r. BConstant r -> ByteCodeOpr r
Push (CConstant Low -> ByteCodeOpr Low)
-> (Int16 -> CConstant Low) -> Int16 -> ByteCodeOpr Low
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> CConstant Low
forall r. Int16 -> CConstant r
CShort (Int16 -> ByteCodeOpr Low) -> Get Int16 -> Get (ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int16
forall t. Binary t => Get t
get

      Word8
0x12 -> CConstant Low -> ByteCodeOpr Low
forall r. BConstant r -> ByteCodeOpr r
Push (CConstant Low -> ByteCodeOpr Low)
-> (Word8 -> CConstant Low) -> Word8 -> ByteCodeOpr Low
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe OneOrTwo -> Ref JValue Low -> CConstant Low
forall r. Maybe OneOrTwo -> Ref JValue r -> CConstant r
CRef Maybe OneOrTwo
forall a. Maybe a
Nothing (ByteCodeOffset -> CConstant Low)
-> (Word8 -> ByteCodeOffset) -> Word8 -> CConstant Low
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> ByteCodeOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> ByteCodeOpr Low) -> Get Word8 -> Get (ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
      Word8
0x13 -> CConstant Low -> ByteCodeOpr Low
forall r. BConstant r -> ByteCodeOpr r
Push (CConstant Low -> ByteCodeOpr Low)
-> (ByteCodeOffset -> CConstant Low)
-> ByteCodeOffset
-> ByteCodeOpr Low
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe OneOrTwo -> Ref JValue Low -> CConstant Low
forall r. Maybe OneOrTwo -> Ref JValue r -> CConstant r
CRef (OneOrTwo -> Maybe OneOrTwo
forall a. a -> Maybe a
Just OneOrTwo
One) (ByteCodeOffset -> ByteCodeOpr Low)
-> Get ByteCodeOffset -> Get (ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteCodeOffset
forall t. Binary t => Get t
get
      Word8
0x14 -> CConstant Low -> ByteCodeOpr Low
forall r. BConstant r -> ByteCodeOpr r
Push (CConstant Low -> ByteCodeOpr Low)
-> (ByteCodeOffset -> CConstant Low)
-> ByteCodeOffset
-> ByteCodeOpr Low
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe OneOrTwo -> Ref JValue Low -> CConstant Low
forall r. Maybe OneOrTwo -> Ref JValue r -> CConstant r
CRef (OneOrTwo -> Maybe OneOrTwo
forall a. a -> Maybe a
Just OneOrTwo
Two) (ByteCodeOffset -> ByteCodeOpr Low)
-> Get ByteCodeOffset -> Get (ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteCodeOffset
forall t. Binary t => Get t
get

      Word8
0x15 -> LocalType -> ByteCodeOffset -> ByteCodeOpr Low
forall r. LocalType -> ByteCodeOffset -> ByteCodeOpr r
Load LocalType
LInt (ByteCodeOffset -> ByteCodeOpr Low)
-> (Word8 -> ByteCodeOffset) -> Word8 -> ByteCodeOpr Low
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> ByteCodeOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> ByteCodeOpr Low) -> Get Word8 -> Get (ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
      Word8
0x16 -> LocalType -> ByteCodeOffset -> ByteCodeOpr Low
forall r. LocalType -> ByteCodeOffset -> ByteCodeOpr r
Load LocalType
LLong (ByteCodeOffset -> ByteCodeOpr Low)
-> (Word8 -> ByteCodeOffset) -> Word8 -> ByteCodeOpr Low
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> ByteCodeOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> ByteCodeOpr Low) -> Get Word8 -> Get (ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
      Word8
0x17 -> LocalType -> ByteCodeOffset -> ByteCodeOpr Low
forall r. LocalType -> ByteCodeOffset -> ByteCodeOpr r
Load LocalType
LFloat (ByteCodeOffset -> ByteCodeOpr Low)
-> (Word8 -> ByteCodeOffset) -> Word8 -> ByteCodeOpr Low
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> ByteCodeOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> ByteCodeOpr Low) -> Get Word8 -> Get (ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
      Word8
0x18 -> LocalType -> ByteCodeOffset -> ByteCodeOpr Low
forall r. LocalType -> ByteCodeOffset -> ByteCodeOpr r
Load LocalType
LDouble (ByteCodeOffset -> ByteCodeOpr Low)
-> (Word8 -> ByteCodeOffset) -> Word8 -> ByteCodeOpr Low
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> ByteCodeOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> ByteCodeOpr Low) -> Get Word8 -> Get (ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
      Word8
0x19 -> LocalType -> ByteCodeOffset -> ByteCodeOpr Low
forall r. LocalType -> ByteCodeOffset -> ByteCodeOpr r
Load LocalType
LRef (ByteCodeOffset -> ByteCodeOpr Low)
-> (Word8 -> ByteCodeOffset) -> Word8 -> ByteCodeOpr Low
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> ByteCodeOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> ByteCodeOpr Low) -> Get Word8 -> Get (ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8

      Word8
0x1a -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ LocalType -> ByteCodeOffset -> ByteCodeOpr Low
forall r. LocalType -> ByteCodeOffset -> ByteCodeOpr r
Load LocalType
LInt ByteCodeOffset
0
      Word8
0x1b -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ LocalType -> ByteCodeOffset -> ByteCodeOpr Low
forall r. LocalType -> ByteCodeOffset -> ByteCodeOpr r
Load LocalType
LInt ByteCodeOffset
1
      Word8
0x1c -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ LocalType -> ByteCodeOffset -> ByteCodeOpr Low
forall r. LocalType -> ByteCodeOffset -> ByteCodeOpr r
Load LocalType
LInt ByteCodeOffset
2
      Word8
0x1d -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ LocalType -> ByteCodeOffset -> ByteCodeOpr Low
forall r. LocalType -> ByteCodeOffset -> ByteCodeOpr r
Load LocalType
LInt ByteCodeOffset
3

      Word8
0x1e -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ LocalType -> ByteCodeOffset -> ByteCodeOpr Low
forall r. LocalType -> ByteCodeOffset -> ByteCodeOpr r
Load LocalType
LLong ByteCodeOffset
0
      Word8
0x1f -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ LocalType -> ByteCodeOffset -> ByteCodeOpr Low
forall r. LocalType -> ByteCodeOffset -> ByteCodeOpr r
Load LocalType
LLong ByteCodeOffset
1
      Word8
0x20 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ LocalType -> ByteCodeOffset -> ByteCodeOpr Low
forall r. LocalType -> ByteCodeOffset -> ByteCodeOpr r
Load LocalType
LLong ByteCodeOffset
2
      Word8
0x21 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ LocalType -> ByteCodeOffset -> ByteCodeOpr Low
forall r. LocalType -> ByteCodeOffset -> ByteCodeOpr r
Load LocalType
LLong ByteCodeOffset
3

      Word8
0x22 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ LocalType -> ByteCodeOffset -> ByteCodeOpr Low
forall r. LocalType -> ByteCodeOffset -> ByteCodeOpr r
Load LocalType
LFloat ByteCodeOffset
0
      Word8
0x23 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ LocalType -> ByteCodeOffset -> ByteCodeOpr Low
forall r. LocalType -> ByteCodeOffset -> ByteCodeOpr r
Load LocalType
LFloat ByteCodeOffset
1
      Word8
0x24 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ LocalType -> ByteCodeOffset -> ByteCodeOpr Low
forall r. LocalType -> ByteCodeOffset -> ByteCodeOpr r
Load LocalType
LFloat ByteCodeOffset
2
      Word8
0x25 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ LocalType -> ByteCodeOffset -> ByteCodeOpr Low
forall r. LocalType -> ByteCodeOffset -> ByteCodeOpr r
Load LocalType
LFloat ByteCodeOffset
3

      Word8
0x26 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ LocalType -> ByteCodeOffset -> ByteCodeOpr Low
forall r. LocalType -> ByteCodeOffset -> ByteCodeOpr r
Load LocalType
LDouble ByteCodeOffset
0
      Word8
0x27 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ LocalType -> ByteCodeOffset -> ByteCodeOpr Low
forall r. LocalType -> ByteCodeOffset -> ByteCodeOpr r
Load LocalType
LDouble ByteCodeOffset
1
      Word8
0x28 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ LocalType -> ByteCodeOffset -> ByteCodeOpr Low
forall r. LocalType -> ByteCodeOffset -> ByteCodeOpr r
Load LocalType
LDouble ByteCodeOffset
2
      Word8
0x29 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ LocalType -> ByteCodeOffset -> ByteCodeOpr Low
forall r. LocalType -> ByteCodeOffset -> ByteCodeOpr r
Load LocalType
LDouble ByteCodeOffset
3

      Word8
0x2a -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ LocalType -> ByteCodeOffset -> ByteCodeOpr Low
forall r. LocalType -> ByteCodeOffset -> ByteCodeOpr r
Load LocalType
LRef ByteCodeOffset
0
      Word8
0x2b -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ LocalType -> ByteCodeOffset -> ByteCodeOpr Low
forall r. LocalType -> ByteCodeOffset -> ByteCodeOpr r
Load LocalType
LRef ByteCodeOffset
1
      Word8
0x2c -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ LocalType -> ByteCodeOffset -> ByteCodeOpr Low
forall r. LocalType -> ByteCodeOffset -> ByteCodeOpr r
Load LocalType
LRef ByteCodeOffset
2
      Word8
0x2d -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ LocalType -> ByteCodeOffset -> ByteCodeOpr Low
forall r. LocalType -> ByteCodeOffset -> ByteCodeOpr r
Load LocalType
LRef ByteCodeOffset
3

      Word8
0x2e -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ ArrayType -> ByteCodeOpr Low
forall r. ArrayType -> ByteCodeOpr r
ArrayLoad ArrayType
AInt
      Word8
0x2f -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ ArrayType -> ByteCodeOpr Low
forall r. ArrayType -> ByteCodeOpr r
ArrayLoad ArrayType
ALong
      Word8
0x30 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ ArrayType -> ByteCodeOpr Low
forall r. ArrayType -> ByteCodeOpr r
ArrayLoad ArrayType
AFloat
      Word8
0x31 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ ArrayType -> ByteCodeOpr Low
forall r. ArrayType -> ByteCodeOpr r
ArrayLoad ArrayType
ADouble
      Word8
0x32 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ ArrayType -> ByteCodeOpr Low
forall r. ArrayType -> ByteCodeOpr r
ArrayLoad ArrayType
ARef
      Word8
0x33 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ ArrayType -> ByteCodeOpr Low
forall r. ArrayType -> ByteCodeOpr r
ArrayLoad ArrayType
AByte
      Word8
0x34 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ ArrayType -> ByteCodeOpr Low
forall r. ArrayType -> ByteCodeOpr r
ArrayLoad ArrayType
AChar
      Word8
0x35 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ ArrayType -> ByteCodeOpr Low
forall r. ArrayType -> ByteCodeOpr r
ArrayLoad ArrayType
AShort

      Word8
0x36 -> LocalType -> ByteCodeOffset -> ByteCodeOpr Low
forall r. LocalType -> ByteCodeOffset -> ByteCodeOpr r
Store LocalType
LInt (ByteCodeOffset -> ByteCodeOpr Low)
-> (Word8 -> ByteCodeOffset) -> Word8 -> ByteCodeOpr Low
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> ByteCodeOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> ByteCodeOpr Low) -> Get Word8 -> Get (ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
      Word8
0x37 -> LocalType -> ByteCodeOffset -> ByteCodeOpr Low
forall r. LocalType -> ByteCodeOffset -> ByteCodeOpr r
Store LocalType
LLong (ByteCodeOffset -> ByteCodeOpr Low)
-> (Word8 -> ByteCodeOffset) -> Word8 -> ByteCodeOpr Low
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> ByteCodeOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> ByteCodeOpr Low) -> Get Word8 -> Get (ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
      Word8
0x38 -> LocalType -> ByteCodeOffset -> ByteCodeOpr Low
forall r. LocalType -> ByteCodeOffset -> ByteCodeOpr r
Store LocalType
LFloat (ByteCodeOffset -> ByteCodeOpr Low)
-> (Word8 -> ByteCodeOffset) -> Word8 -> ByteCodeOpr Low
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> ByteCodeOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> ByteCodeOpr Low) -> Get Word8 -> Get (ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
      Word8
0x39 -> LocalType -> ByteCodeOffset -> ByteCodeOpr Low
forall r. LocalType -> ByteCodeOffset -> ByteCodeOpr r
Store LocalType
LDouble (ByteCodeOffset -> ByteCodeOpr Low)
-> (Word8 -> ByteCodeOffset) -> Word8 -> ByteCodeOpr Low
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> ByteCodeOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> ByteCodeOpr Low) -> Get Word8 -> Get (ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
      Word8
0x3a -> LocalType -> ByteCodeOffset -> ByteCodeOpr Low
forall r. LocalType -> ByteCodeOffset -> ByteCodeOpr r
Store LocalType
LRef (ByteCodeOffset -> ByteCodeOpr Low)
-> (Word8 -> ByteCodeOffset) -> Word8 -> ByteCodeOpr Low
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> ByteCodeOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> ByteCodeOpr Low) -> Get Word8 -> Get (ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8

      Word8
0x3b -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ LocalType -> ByteCodeOffset -> ByteCodeOpr Low
forall r. LocalType -> ByteCodeOffset -> ByteCodeOpr r
Store LocalType
LInt ByteCodeOffset
0
      Word8
0x3c -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ LocalType -> ByteCodeOffset -> ByteCodeOpr Low
forall r. LocalType -> ByteCodeOffset -> ByteCodeOpr r
Store LocalType
LInt ByteCodeOffset
1
      Word8
0x3d -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ LocalType -> ByteCodeOffset -> ByteCodeOpr Low
forall r. LocalType -> ByteCodeOffset -> ByteCodeOpr r
Store LocalType
LInt ByteCodeOffset
2
      Word8
0x3e -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ LocalType -> ByteCodeOffset -> ByteCodeOpr Low
forall r. LocalType -> ByteCodeOffset -> ByteCodeOpr r
Store LocalType
LInt ByteCodeOffset
3

      Word8
0x3f -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ LocalType -> ByteCodeOffset -> ByteCodeOpr Low
forall r. LocalType -> ByteCodeOffset -> ByteCodeOpr r
Store LocalType
LLong ByteCodeOffset
0
      Word8
0x40 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ LocalType -> ByteCodeOffset -> ByteCodeOpr Low
forall r. LocalType -> ByteCodeOffset -> ByteCodeOpr r
Store LocalType
LLong ByteCodeOffset
1
      Word8
0x41 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ LocalType -> ByteCodeOffset -> ByteCodeOpr Low
forall r. LocalType -> ByteCodeOffset -> ByteCodeOpr r
Store LocalType
LLong ByteCodeOffset
2
      Word8
0x42 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ LocalType -> ByteCodeOffset -> ByteCodeOpr Low
forall r. LocalType -> ByteCodeOffset -> ByteCodeOpr r
Store LocalType
LLong ByteCodeOffset
3

      Word8
0x43 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ LocalType -> ByteCodeOffset -> ByteCodeOpr Low
forall r. LocalType -> ByteCodeOffset -> ByteCodeOpr r
Store LocalType
LFloat ByteCodeOffset
0
      Word8
0x44 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ LocalType -> ByteCodeOffset -> ByteCodeOpr Low
forall r. LocalType -> ByteCodeOffset -> ByteCodeOpr r
Store LocalType
LFloat ByteCodeOffset
1
      Word8
0x45 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ LocalType -> ByteCodeOffset -> ByteCodeOpr Low
forall r. LocalType -> ByteCodeOffset -> ByteCodeOpr r
Store LocalType
LFloat ByteCodeOffset
2
      Word8
0x46 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ LocalType -> ByteCodeOffset -> ByteCodeOpr Low
forall r. LocalType -> ByteCodeOffset -> ByteCodeOpr r
Store LocalType
LFloat ByteCodeOffset
3

      Word8
0x47 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ LocalType -> ByteCodeOffset -> ByteCodeOpr Low
forall r. LocalType -> ByteCodeOffset -> ByteCodeOpr r
Store LocalType
LDouble ByteCodeOffset
0
      Word8
0x48 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ LocalType -> ByteCodeOffset -> ByteCodeOpr Low
forall r. LocalType -> ByteCodeOffset -> ByteCodeOpr r
Store LocalType
LDouble ByteCodeOffset
1
      Word8
0x49 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ LocalType -> ByteCodeOffset -> ByteCodeOpr Low
forall r. LocalType -> ByteCodeOffset -> ByteCodeOpr r
Store LocalType
LDouble ByteCodeOffset
2
      Word8
0x4a -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ LocalType -> ByteCodeOffset -> ByteCodeOpr Low
forall r. LocalType -> ByteCodeOffset -> ByteCodeOpr r
Store LocalType
LDouble ByteCodeOffset
3

      Word8
0x4b -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ LocalType -> ByteCodeOffset -> ByteCodeOpr Low
forall r. LocalType -> ByteCodeOffset -> ByteCodeOpr r
Store LocalType
LRef ByteCodeOffset
0
      Word8
0x4c -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ LocalType -> ByteCodeOffset -> ByteCodeOpr Low
forall r. LocalType -> ByteCodeOffset -> ByteCodeOpr r
Store LocalType
LRef ByteCodeOffset
1
      Word8
0x4d -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ LocalType -> ByteCodeOffset -> ByteCodeOpr Low
forall r. LocalType -> ByteCodeOffset -> ByteCodeOpr r
Store LocalType
LRef ByteCodeOffset
2
      Word8
0x4e -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ LocalType -> ByteCodeOffset -> ByteCodeOpr Low
forall r. LocalType -> ByteCodeOffset -> ByteCodeOpr r
Store LocalType
LRef ByteCodeOffset
3

      Word8
0x4f -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ ArrayType -> ByteCodeOpr Low
forall r. ArrayType -> ByteCodeOpr r
ArrayStore ArrayType
AInt
      Word8
0x50 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ ArrayType -> ByteCodeOpr Low
forall r. ArrayType -> ByteCodeOpr r
ArrayStore ArrayType
ALong
      Word8
0x51 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ ArrayType -> ByteCodeOpr Low
forall r. ArrayType -> ByteCodeOpr r
ArrayStore ArrayType
AFloat
      Word8
0x52 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ ArrayType -> ByteCodeOpr Low
forall r. ArrayType -> ByteCodeOpr r
ArrayStore ArrayType
ADouble
      Word8
0x53 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ ArrayType -> ByteCodeOpr Low
forall r. ArrayType -> ByteCodeOpr r
ArrayStore ArrayType
ARef
      Word8
0x54 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ ArrayType -> ByteCodeOpr Low
forall r. ArrayType -> ByteCodeOpr r
ArrayStore ArrayType
AByte
      Word8
0x55 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ ArrayType -> ByteCodeOpr Low
forall r. ArrayType -> ByteCodeOpr r
ArrayStore ArrayType
AChar
      Word8
0x56 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ ArrayType -> ByteCodeOpr Low
forall r. ArrayType -> ByteCodeOpr r
ArrayStore ArrayType
AShort

      Word8
0x57 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ OneOrTwo -> ByteCodeOpr Low
forall r. OneOrTwo -> ByteCodeOpr r
Pop OneOrTwo
One
      Word8
0x58 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ OneOrTwo -> ByteCodeOpr Low
forall r. OneOrTwo -> ByteCodeOpr r
Pop OneOrTwo
Two

      Word8
0x59 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ OneOrTwo -> ByteCodeOpr Low
forall r. OneOrTwo -> ByteCodeOpr r
Dup OneOrTwo
One
      Word8
0x5a -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ OneOrTwo -> ByteCodeOpr Low
forall r. OneOrTwo -> ByteCodeOpr r
DupX1 OneOrTwo
One
      Word8
0x5b -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ OneOrTwo -> ByteCodeOpr Low
forall r. OneOrTwo -> ByteCodeOpr r
DupX2 OneOrTwo
One

      Word8
0x5c -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ OneOrTwo -> ByteCodeOpr Low
forall r. OneOrTwo -> ByteCodeOpr r
Dup OneOrTwo
Two
      Word8
0x5d -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ OneOrTwo -> ByteCodeOpr Low
forall r. OneOrTwo -> ByteCodeOpr r
DupX1 OneOrTwo
Two
      Word8
0x5e -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ OneOrTwo -> ByteCodeOpr Low
forall r. OneOrTwo -> ByteCodeOpr r
DupX2 OneOrTwo
Two

      Word8
0x5f -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ ByteCodeOpr Low
forall r. ByteCodeOpr r
Swap

      Word8
0x60 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ BinOpr -> ArithmeticType -> ByteCodeOpr Low
forall r. BinOpr -> ArithmeticType -> ByteCodeOpr r
BinaryOpr BinOpr
Add ArithmeticType
MInt
      Word8
0x61 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ BinOpr -> ArithmeticType -> ByteCodeOpr Low
forall r. BinOpr -> ArithmeticType -> ByteCodeOpr r
BinaryOpr BinOpr
Add ArithmeticType
MLong
      Word8
0x62 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ BinOpr -> ArithmeticType -> ByteCodeOpr Low
forall r. BinOpr -> ArithmeticType -> ByteCodeOpr r
BinaryOpr BinOpr
Add ArithmeticType
MFloat
      Word8
0x63 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ BinOpr -> ArithmeticType -> ByteCodeOpr Low
forall r. BinOpr -> ArithmeticType -> ByteCodeOpr r
BinaryOpr BinOpr
Add ArithmeticType
MDouble

      Word8
0x64 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ BinOpr -> ArithmeticType -> ByteCodeOpr Low
forall r. BinOpr -> ArithmeticType -> ByteCodeOpr r
BinaryOpr BinOpr
Sub ArithmeticType
MInt
      Word8
0x65 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ BinOpr -> ArithmeticType -> ByteCodeOpr Low
forall r. BinOpr -> ArithmeticType -> ByteCodeOpr r
BinaryOpr BinOpr
Sub ArithmeticType
MLong
      Word8
0x66 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ BinOpr -> ArithmeticType -> ByteCodeOpr Low
forall r. BinOpr -> ArithmeticType -> ByteCodeOpr r
BinaryOpr BinOpr
Sub ArithmeticType
MFloat
      Word8
0x67 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ BinOpr -> ArithmeticType -> ByteCodeOpr Low
forall r. BinOpr -> ArithmeticType -> ByteCodeOpr r
BinaryOpr BinOpr
Sub ArithmeticType
MDouble

      Word8
0x68 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ BinOpr -> ArithmeticType -> ByteCodeOpr Low
forall r. BinOpr -> ArithmeticType -> ByteCodeOpr r
BinaryOpr BinOpr
Mul ArithmeticType
MInt
      Word8
0x69 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ BinOpr -> ArithmeticType -> ByteCodeOpr Low
forall r. BinOpr -> ArithmeticType -> ByteCodeOpr r
BinaryOpr BinOpr
Mul ArithmeticType
MLong
      Word8
0x6a -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ BinOpr -> ArithmeticType -> ByteCodeOpr Low
forall r. BinOpr -> ArithmeticType -> ByteCodeOpr r
BinaryOpr BinOpr
Mul ArithmeticType
MFloat
      Word8
0x6b -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ BinOpr -> ArithmeticType -> ByteCodeOpr Low
forall r. BinOpr -> ArithmeticType -> ByteCodeOpr r
BinaryOpr BinOpr
Mul ArithmeticType
MDouble

      Word8
0x6c -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ BinOpr -> ArithmeticType -> ByteCodeOpr Low
forall r. BinOpr -> ArithmeticType -> ByteCodeOpr r
BinaryOpr BinOpr
Div ArithmeticType
MInt
      Word8
0x6d -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ BinOpr -> ArithmeticType -> ByteCodeOpr Low
forall r. BinOpr -> ArithmeticType -> ByteCodeOpr r
BinaryOpr BinOpr
Div ArithmeticType
MLong
      Word8
0x6e -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ BinOpr -> ArithmeticType -> ByteCodeOpr Low
forall r. BinOpr -> ArithmeticType -> ByteCodeOpr r
BinaryOpr BinOpr
Div ArithmeticType
MFloat
      Word8
0x6f -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ BinOpr -> ArithmeticType -> ByteCodeOpr Low
forall r. BinOpr -> ArithmeticType -> ByteCodeOpr r
BinaryOpr BinOpr
Div ArithmeticType
MDouble

      Word8
0x70 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ BinOpr -> ArithmeticType -> ByteCodeOpr Low
forall r. BinOpr -> ArithmeticType -> ByteCodeOpr r
BinaryOpr BinOpr
Rem ArithmeticType
MInt
      Word8
0x71 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ BinOpr -> ArithmeticType -> ByteCodeOpr Low
forall r. BinOpr -> ArithmeticType -> ByteCodeOpr r
BinaryOpr BinOpr
Rem ArithmeticType
MLong
      Word8
0x72 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ BinOpr -> ArithmeticType -> ByteCodeOpr Low
forall r. BinOpr -> ArithmeticType -> ByteCodeOpr r
BinaryOpr BinOpr
Rem ArithmeticType
MFloat
      Word8
0x73 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ BinOpr -> ArithmeticType -> ByteCodeOpr Low
forall r. BinOpr -> ArithmeticType -> ByteCodeOpr r
BinaryOpr BinOpr
Rem ArithmeticType
MDouble

      Word8
0x74 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ ArithmeticType -> ByteCodeOpr Low
forall r. ArithmeticType -> ByteCodeOpr r
Neg ArithmeticType
MInt
      Word8
0x75 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ ArithmeticType -> ByteCodeOpr Low
forall r. ArithmeticType -> ByteCodeOpr r
Neg ArithmeticType
MLong
      Word8
0x76 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ ArithmeticType -> ByteCodeOpr Low
forall r. ArithmeticType -> ByteCodeOpr r
Neg ArithmeticType
MFloat
      Word8
0x77 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ ArithmeticType -> ByteCodeOpr Low
forall r. ArithmeticType -> ByteCodeOpr r
Neg ArithmeticType
MDouble

      Word8
0x78 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ BitOpr -> OneOrTwo -> ByteCodeOpr Low
forall r. BitOpr -> OneOrTwo -> ByteCodeOpr r
BitOpr BitOpr
ShL OneOrTwo
One
      Word8
0x79 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ BitOpr -> OneOrTwo -> ByteCodeOpr Low
forall r. BitOpr -> OneOrTwo -> ByteCodeOpr r
BitOpr BitOpr
ShL OneOrTwo
Two
      Word8
0x7a -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ BitOpr -> OneOrTwo -> ByteCodeOpr Low
forall r. BitOpr -> OneOrTwo -> ByteCodeOpr r
BitOpr BitOpr
ShR OneOrTwo
One
      Word8
0x7b -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ BitOpr -> OneOrTwo -> ByteCodeOpr Low
forall r. BitOpr -> OneOrTwo -> ByteCodeOpr r
BitOpr BitOpr
ShR OneOrTwo
Two

      Word8
0x7c -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ BitOpr -> OneOrTwo -> ByteCodeOpr Low
forall r. BitOpr -> OneOrTwo -> ByteCodeOpr r
BitOpr BitOpr
UShR OneOrTwo
One
      Word8
0x7d -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ BitOpr -> OneOrTwo -> ByteCodeOpr Low
forall r. BitOpr -> OneOrTwo -> ByteCodeOpr r
BitOpr BitOpr
UShR OneOrTwo
Two

      Word8
0x7e -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ BitOpr -> OneOrTwo -> ByteCodeOpr Low
forall r. BitOpr -> OneOrTwo -> ByteCodeOpr r
BitOpr BitOpr
And OneOrTwo
One
      Word8
0x7f -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ BitOpr -> OneOrTwo -> ByteCodeOpr Low
forall r. BitOpr -> OneOrTwo -> ByteCodeOpr r
BitOpr BitOpr
And OneOrTwo
Two
      Word8
0x80 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ BitOpr -> OneOrTwo -> ByteCodeOpr Low
forall r. BitOpr -> OneOrTwo -> ByteCodeOpr r
BitOpr BitOpr
Or OneOrTwo
One
      Word8
0x81 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ BitOpr -> OneOrTwo -> ByteCodeOpr Low
forall r. BitOpr -> OneOrTwo -> ByteCodeOpr r
BitOpr BitOpr
Or OneOrTwo
Two
      Word8
0x82 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ BitOpr -> OneOrTwo -> ByteCodeOpr Low
forall r. BitOpr -> OneOrTwo -> ByteCodeOpr r
BitOpr BitOpr
XOr OneOrTwo
One
      Word8
0x83 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ BitOpr -> OneOrTwo -> ByteCodeOpr Low
forall r. BitOpr -> OneOrTwo -> ByteCodeOpr r
BitOpr BitOpr
XOr OneOrTwo
Two

      Word8
0x84 -> ByteCodeOffset -> Int16 -> ByteCodeOpr Low
forall r. ByteCodeOffset -> Int16 -> ByteCodeOpr r
IncrLocal (ByteCodeOffset -> Int16 -> ByteCodeOpr Low)
-> Get ByteCodeOffset -> Get (Int16 -> ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word8 -> ByteCodeOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> ByteCodeOffset) -> Get Word8 -> Get ByteCodeOffset
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8) Get (Int16 -> ByteCodeOpr Low)
-> Get Int16 -> Get (ByteCodeOpr Low)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int8 -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int8 -> Int16) -> Get Int8 -> Get Int16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int8
getInt8)

      Word8
0x85 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ CastOpr -> ByteCodeOpr Low
forall r. CastOpr -> ByteCodeOpr r
Cast (ArithmeticType -> ArithmeticType -> CastOpr
CastTo ArithmeticType
MInt ArithmeticType
MLong)
      Word8
0x86 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ CastOpr -> ByteCodeOpr Low
forall r. CastOpr -> ByteCodeOpr r
Cast (ArithmeticType -> ArithmeticType -> CastOpr
CastTo ArithmeticType
MInt ArithmeticType
MFloat)
      Word8
0x87 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ CastOpr -> ByteCodeOpr Low
forall r. CastOpr -> ByteCodeOpr r
Cast (ArithmeticType -> ArithmeticType -> CastOpr
CastTo ArithmeticType
MInt ArithmeticType
MDouble)

      Word8
0x88 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ CastOpr -> ByteCodeOpr Low
forall r. CastOpr -> ByteCodeOpr r
Cast (ArithmeticType -> ArithmeticType -> CastOpr
CastTo ArithmeticType
MLong ArithmeticType
MInt)
      Word8
0x89 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ CastOpr -> ByteCodeOpr Low
forall r. CastOpr -> ByteCodeOpr r
Cast (ArithmeticType -> ArithmeticType -> CastOpr
CastTo ArithmeticType
MLong ArithmeticType
MFloat)
      Word8
0x8a -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ CastOpr -> ByteCodeOpr Low
forall r. CastOpr -> ByteCodeOpr r
Cast (ArithmeticType -> ArithmeticType -> CastOpr
CastTo ArithmeticType
MLong ArithmeticType
MDouble)

      Word8
0x8b -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ CastOpr -> ByteCodeOpr Low
forall r. CastOpr -> ByteCodeOpr r
Cast (ArithmeticType -> ArithmeticType -> CastOpr
CastTo ArithmeticType
MFloat ArithmeticType
MInt)
      Word8
0x8c -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ CastOpr -> ByteCodeOpr Low
forall r. CastOpr -> ByteCodeOpr r
Cast (ArithmeticType -> ArithmeticType -> CastOpr
CastTo ArithmeticType
MFloat ArithmeticType
MLong)
      Word8
0x8d -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ CastOpr -> ByteCodeOpr Low
forall r. CastOpr -> ByteCodeOpr r
Cast (ArithmeticType -> ArithmeticType -> CastOpr
CastTo ArithmeticType
MFloat ArithmeticType
MDouble)

      Word8
0x8e -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ CastOpr -> ByteCodeOpr Low
forall r. CastOpr -> ByteCodeOpr r
Cast (ArithmeticType -> ArithmeticType -> CastOpr
CastTo ArithmeticType
MDouble ArithmeticType
MInt)
      Word8
0x8f -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ CastOpr -> ByteCodeOpr Low
forall r. CastOpr -> ByteCodeOpr r
Cast (ArithmeticType -> ArithmeticType -> CastOpr
CastTo ArithmeticType
MDouble ArithmeticType
MLong)
      Word8
0x90 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ CastOpr -> ByteCodeOpr Low
forall r. CastOpr -> ByteCodeOpr r
Cast (ArithmeticType -> ArithmeticType -> CastOpr
CastTo ArithmeticType
MDouble ArithmeticType
MFloat)

      Word8
0x91 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ CastOpr -> ByteCodeOpr Low
forall r. CastOpr -> ByteCodeOpr r
Cast (SmallArithmeticType -> CastOpr
CastDown SmallArithmeticType
MByte)
      Word8
0x92 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ CastOpr -> ByteCodeOpr Low
forall r. CastOpr -> ByteCodeOpr r
Cast (SmallArithmeticType -> CastOpr
CastDown SmallArithmeticType
MChar)
      Word8
0x93 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ CastOpr -> ByteCodeOpr Low
forall r. CastOpr -> ByteCodeOpr r
Cast (SmallArithmeticType -> CastOpr
CastDown SmallArithmeticType
MShort)

      Word8
0x94 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ ByteCodeOpr Low
forall r. ByteCodeOpr r
CompareLongs

      Word8
0x95 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ Bool -> OneOrTwo -> ByteCodeOpr Low
forall r. Bool -> OneOrTwo -> ByteCodeOpr r
CompareFloating Bool
True OneOrTwo
One
      Word8
0x96 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ Bool -> OneOrTwo -> ByteCodeOpr Low
forall r. Bool -> OneOrTwo -> ByteCodeOpr r
CompareFloating Bool
False OneOrTwo
One

      Word8
0x97 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ Bool -> OneOrTwo -> ByteCodeOpr Low
forall r. Bool -> OneOrTwo -> ByteCodeOpr r
CompareFloating Bool
True OneOrTwo
Two
      Word8
0x98 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ Bool -> OneOrTwo -> ByteCodeOpr Low
forall r. Bool -> OneOrTwo -> ByteCodeOpr r
CompareFloating Bool
False OneOrTwo
Two

      Word8
0x99 -> CmpOpr -> OneOrTwo -> ShortRelativeRef Low -> ByteCodeOpr Low
forall r. CmpOpr -> OneOrTwo -> ShortRelativeRef r -> ByteCodeOpr r
If CmpOpr
CEq OneOrTwo
One (Int16 -> ByteCodeOpr Low) -> Get Int16 -> Get (ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int16
forall t. Binary t => Get t
get
      Word8
0x9a -> CmpOpr -> OneOrTwo -> ShortRelativeRef Low -> ByteCodeOpr Low
forall r. CmpOpr -> OneOrTwo -> ShortRelativeRef r -> ByteCodeOpr r
If CmpOpr
CNe OneOrTwo
One (Int16 -> ByteCodeOpr Low) -> Get Int16 -> Get (ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int16
forall t. Binary t => Get t
get
      Word8
0x9b -> CmpOpr -> OneOrTwo -> ShortRelativeRef Low -> ByteCodeOpr Low
forall r. CmpOpr -> OneOrTwo -> ShortRelativeRef r -> ByteCodeOpr r
If CmpOpr
CLt OneOrTwo
One (Int16 -> ByteCodeOpr Low) -> Get Int16 -> Get (ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int16
forall t. Binary t => Get t
get
      Word8
0x9c -> CmpOpr -> OneOrTwo -> ShortRelativeRef Low -> ByteCodeOpr Low
forall r. CmpOpr -> OneOrTwo -> ShortRelativeRef r -> ByteCodeOpr r
If CmpOpr
CGe OneOrTwo
One (Int16 -> ByteCodeOpr Low) -> Get Int16 -> Get (ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int16
forall t. Binary t => Get t
get
      Word8
0x9d -> CmpOpr -> OneOrTwo -> ShortRelativeRef Low -> ByteCodeOpr Low
forall r. CmpOpr -> OneOrTwo -> ShortRelativeRef r -> ByteCodeOpr r
If CmpOpr
CGt OneOrTwo
One (Int16 -> ByteCodeOpr Low) -> Get Int16 -> Get (ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int16
forall t. Binary t => Get t
get
      Word8
0x9e -> CmpOpr -> OneOrTwo -> ShortRelativeRef Low -> ByteCodeOpr Low
forall r. CmpOpr -> OneOrTwo -> ShortRelativeRef r -> ByteCodeOpr r
If CmpOpr
CLe OneOrTwo
One (Int16 -> ByteCodeOpr Low) -> Get Int16 -> Get (ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int16
forall t. Binary t => Get t
get

      Word8
0x9f -> CmpOpr -> OneOrTwo -> ShortRelativeRef Low -> ByteCodeOpr Low
forall r. CmpOpr -> OneOrTwo -> ShortRelativeRef r -> ByteCodeOpr r
If CmpOpr
CEq OneOrTwo
Two (Int16 -> ByteCodeOpr Low) -> Get Int16 -> Get (ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int16
forall t. Binary t => Get t
get
      Word8
0xa0 -> CmpOpr -> OneOrTwo -> ShortRelativeRef Low -> ByteCodeOpr Low
forall r. CmpOpr -> OneOrTwo -> ShortRelativeRef r -> ByteCodeOpr r
If CmpOpr
CNe OneOrTwo
Two (Int16 -> ByteCodeOpr Low) -> Get Int16 -> Get (ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int16
forall t. Binary t => Get t
get
      Word8
0xa1 -> CmpOpr -> OneOrTwo -> ShortRelativeRef Low -> ByteCodeOpr Low
forall r. CmpOpr -> OneOrTwo -> ShortRelativeRef r -> ByteCodeOpr r
If CmpOpr
CLt OneOrTwo
Two (Int16 -> ByteCodeOpr Low) -> Get Int16 -> Get (ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int16
forall t. Binary t => Get t
get
      Word8
0xa2 -> CmpOpr -> OneOrTwo -> ShortRelativeRef Low -> ByteCodeOpr Low
forall r. CmpOpr -> OneOrTwo -> ShortRelativeRef r -> ByteCodeOpr r
If CmpOpr
CGe OneOrTwo
Two (Int16 -> ByteCodeOpr Low) -> Get Int16 -> Get (ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int16
forall t. Binary t => Get t
get
      Word8
0xa3 -> CmpOpr -> OneOrTwo -> ShortRelativeRef Low -> ByteCodeOpr Low
forall r. CmpOpr -> OneOrTwo -> ShortRelativeRef r -> ByteCodeOpr r
If CmpOpr
CGt OneOrTwo
Two (Int16 -> ByteCodeOpr Low) -> Get Int16 -> Get (ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int16
forall t. Binary t => Get t
get
      Word8
0xa4 -> CmpOpr -> OneOrTwo -> ShortRelativeRef Low -> ByteCodeOpr Low
forall r. CmpOpr -> OneOrTwo -> ShortRelativeRef r -> ByteCodeOpr r
If CmpOpr
CLe OneOrTwo
Two (Int16 -> ByteCodeOpr Low) -> Get Int16 -> Get (ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int16
forall t. Binary t => Get t
get

      Word8
0xa5 -> Bool -> OneOrTwo -> ShortRelativeRef Low -> ByteCodeOpr Low
forall r. Bool -> OneOrTwo -> ShortRelativeRef r -> ByteCodeOpr r
IfRef Bool
True OneOrTwo
Two (Int16 -> ByteCodeOpr Low) -> Get Int16 -> Get (ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int16
forall t. Binary t => Get t
get
      Word8
0xa6 -> Bool -> OneOrTwo -> ShortRelativeRef Low -> ByteCodeOpr Low
forall r. Bool -> OneOrTwo -> ShortRelativeRef r -> ByteCodeOpr r
IfRef Bool
False OneOrTwo
Two (Int16 -> ByteCodeOpr Low) -> Get Int16 -> Get (ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int16
forall t. Binary t => Get t
get

      Word8
0xa7 -> Int32 -> ByteCodeOpr Low
forall r. LongRelativeRef r -> ByteCodeOpr r
Goto (Int32 -> ByteCodeOpr Low)
-> (Int16 -> Int32) -> Int16 -> ByteCodeOpr Low
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int16 -> ByteCodeOpr Low) -> Get Int16 -> Get (ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int16
getInt16be
      Word8
0xa8 -> Int32 -> ByteCodeOpr Low
forall r. LongRelativeRef r -> ByteCodeOpr r
Jsr (Int32 -> ByteCodeOpr Low)
-> (Int16 -> Int32) -> Int16 -> ByteCodeOpr Low
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int16 -> ByteCodeOpr Low) -> Get Int16 -> Get (ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int16
getInt16be

      Word8
0xa9 -> ByteCodeOffset -> ByteCodeOpr Low
forall r. ByteCodeOffset -> ByteCodeOpr r
Ret (ByteCodeOffset -> ByteCodeOpr Low)
-> (Word8 -> ByteCodeOffset) -> Word8 -> ByteCodeOpr Low
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> ByteCodeOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> ByteCodeOpr Low) -> Get Word8 -> Get (ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8

      Word8
0xaa -> do
        Int64
offset' <- Get Int64
bytesRead
        let skipAmount :: Int64
skipAmount = (Int64
4 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
offset' Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`mod` Int64
4) Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`mod` Int64
4
        Int -> Get ()
skip (Int -> Get ()) -> Int -> Get ()
forall a b. (a -> b) -> a -> b
$ Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
skipAmount
        Int32
dft <- Get Int32
getInt32be
        Int32
low <- Get Int32
getInt32be
        Int32
high <- Get Int32
getInt32be
        Vector Int32
table <- Int -> Get Int32 -> Get (Vector Int32)
forall (m :: * -> *) a. Monad m => Int -> m a -> m (Vector a)
V.replicateM (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Int) -> Int32 -> Int
forall a b. (a -> b) -> a -> b
$ Int32
high Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
low Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
1) Get Int32
getInt32be
        ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ LongRelativeRef Low -> SwitchTable Low -> ByteCodeOpr Low
forall r. LongRelativeRef r -> SwitchTable r -> ByteCodeOpr r
TableSwitch Int32
LongRelativeRef Low
dft (Int32 -> Vector (LongRelativeRef Low) -> SwitchTable Low
forall r. Int32 -> Vector (LongRelativeRef r) -> SwitchTable r
SwitchTable Int32
low Vector Int32
Vector (LongRelativeRef Low)
table)

      Word8
0xab -> do
        Int64
offset' <- Get Int64
bytesRead
        let skipAmount :: Int64
skipAmount = ((Int64
4 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
offset' Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`mod` Int64
4) Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`mod` Int64
4)
        Int -> Get ()
skip (Int -> Get ()) -> Int -> Get ()
forall a b. (a -> b) -> a -> b
$ Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
skipAmount
        Int32
dft <- Get Int32
getInt32be
        Int32
npairs <- Get Int32
getInt32be
        Vector (Int32, Int32)
pairs <- Int -> Get (Int32, Int32) -> Get (Vector (Int32, Int32))
forall (m :: * -> *) a. Monad m => Int -> m a -> m (Vector a)
V.replicateM (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
npairs) Get (Int32, Int32)
forall t. Binary t => Get t
get
        ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ LongRelativeRef Low
-> Vector (Int32, LongRelativeRef Low) -> ByteCodeOpr Low
forall r.
LongRelativeRef r
-> Vector (Int32, LongRelativeRef r) -> ByteCodeOpr r
LookupSwitch Int32
LongRelativeRef Low
dft Vector (Int32, Int32)
Vector (Int32, LongRelativeRef Low)
pairs

      Word8
0xac -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> (LocalType -> ByteCodeOpr Low)
-> LocalType
-> Get (ByteCodeOpr Low)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe LocalType -> ByteCodeOpr Low
forall r. Maybe LocalType -> ByteCodeOpr r
Return (Maybe LocalType -> ByteCodeOpr Low)
-> (LocalType -> Maybe LocalType) -> LocalType -> ByteCodeOpr Low
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalType -> Maybe LocalType
forall a. a -> Maybe a
Just (LocalType -> Get (ByteCodeOpr Low))
-> LocalType -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ LocalType
LInt
      Word8
0xad -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> (LocalType -> ByteCodeOpr Low)
-> LocalType
-> Get (ByteCodeOpr Low)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe LocalType -> ByteCodeOpr Low
forall r. Maybe LocalType -> ByteCodeOpr r
Return (Maybe LocalType -> ByteCodeOpr Low)
-> (LocalType -> Maybe LocalType) -> LocalType -> ByteCodeOpr Low
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalType -> Maybe LocalType
forall a. a -> Maybe a
Just (LocalType -> Get (ByteCodeOpr Low))
-> LocalType -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ LocalType
LLong
      Word8
0xae -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> (LocalType -> ByteCodeOpr Low)
-> LocalType
-> Get (ByteCodeOpr Low)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe LocalType -> ByteCodeOpr Low
forall r. Maybe LocalType -> ByteCodeOpr r
Return (Maybe LocalType -> ByteCodeOpr Low)
-> (LocalType -> Maybe LocalType) -> LocalType -> ByteCodeOpr Low
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalType -> Maybe LocalType
forall a. a -> Maybe a
Just (LocalType -> Get (ByteCodeOpr Low))
-> LocalType -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ LocalType
LFloat
      Word8
0xaf -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> (LocalType -> ByteCodeOpr Low)
-> LocalType
-> Get (ByteCodeOpr Low)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe LocalType -> ByteCodeOpr Low
forall r. Maybe LocalType -> ByteCodeOpr r
Return (Maybe LocalType -> ByteCodeOpr Low)
-> (LocalType -> Maybe LocalType) -> LocalType -> ByteCodeOpr Low
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalType -> Maybe LocalType
forall a. a -> Maybe a
Just (LocalType -> Get (ByteCodeOpr Low))
-> LocalType -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ LocalType
LDouble
      Word8
0xb0 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> (LocalType -> ByteCodeOpr Low)
-> LocalType
-> Get (ByteCodeOpr Low)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe LocalType -> ByteCodeOpr Low
forall r. Maybe LocalType -> ByteCodeOpr r
Return (Maybe LocalType -> ByteCodeOpr Low)
-> (LocalType -> Maybe LocalType) -> LocalType -> ByteCodeOpr Low
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalType -> Maybe LocalType
forall a. a -> Maybe a
Just (LocalType -> Get (ByteCodeOpr Low))
-> LocalType -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ LocalType
LRef
      Word8
0xb1 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> (Maybe LocalType -> ByteCodeOpr Low)
-> Maybe LocalType
-> Get (ByteCodeOpr Low)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe LocalType -> ByteCodeOpr Low
forall r. Maybe LocalType -> ByteCodeOpr r
Return (Maybe LocalType -> Get (ByteCodeOpr Low))
-> Maybe LocalType -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ Maybe LocalType
forall a. Maybe a
Nothing

      Word8
0xb2 -> FieldAccess -> Ref AbsFieldId Low -> ByteCodeOpr Low
forall r. FieldAccess -> Ref AbsFieldId r -> ByteCodeOpr r
Get FieldAccess
FldStatic (ByteCodeOffset -> ByteCodeOpr Low)
-> Get ByteCodeOffset -> Get (ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteCodeOffset
forall t. Binary t => Get t
get
      Word8
0xb3 -> FieldAccess -> Ref AbsFieldId Low -> ByteCodeOpr Low
forall r. FieldAccess -> Ref AbsFieldId r -> ByteCodeOpr r
Put FieldAccess
FldStatic (ByteCodeOffset -> ByteCodeOpr Low)
-> Get ByteCodeOffset -> Get (ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteCodeOffset
forall t. Binary t => Get t
get

      Word8
0xb4 -> FieldAccess -> Ref AbsFieldId Low -> ByteCodeOpr Low
forall r. FieldAccess -> Ref AbsFieldId r -> ByteCodeOpr r
Get FieldAccess
FldField (ByteCodeOffset -> ByteCodeOpr Low)
-> Get ByteCodeOffset -> Get (ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteCodeOffset
forall t. Binary t => Get t
get
      Word8
0xb5 -> FieldAccess -> Ref AbsFieldId Low -> ByteCodeOpr Low
forall r. FieldAccess -> Ref AbsFieldId r -> ByteCodeOpr r
Put FieldAccess
FldField (ByteCodeOffset -> ByteCodeOpr Low)
-> Get ByteCodeOffset -> Get (ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteCodeOffset
forall t. Binary t => Get t
get

      Word8
0xb6 -> Invocation Low -> ByteCodeOpr Low
forall r. Invocation r -> ByteCodeOpr r
Invoke (Invocation Low -> ByteCodeOpr Low)
-> (ByteCodeOffset -> Invocation Low)
-> ByteCodeOffset
-> ByteCodeOpr Low
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteCodeOffset -> Invocation Low
forall r. Ref (InRefType MethodId) r -> Invocation r
InvkVirtual (ByteCodeOffset -> ByteCodeOpr Low)
-> Get ByteCodeOffset -> Get (ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteCodeOffset
forall t. Binary t => Get t
get
      Word8
0xb7 -> Invocation Low -> ByteCodeOpr Low
forall r. Invocation r -> ByteCodeOpr r
Invoke (Invocation Low -> ByteCodeOpr Low)
-> (ByteCodeOffset -> Invocation Low)
-> ByteCodeOffset
-> ByteCodeOpr Low
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteCodeOffset -> Invocation Low
forall r. Ref AbsVariableMethodId r -> Invocation r
InvkSpecial (ByteCodeOffset -> ByteCodeOpr Low)
-> Get ByteCodeOffset -> Get (ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteCodeOffset
forall t. Binary t => Get t
get
      Word8
0xb8 -> Invocation Low -> ByteCodeOpr Low
forall r. Invocation r -> ByteCodeOpr r
Invoke (Invocation Low -> ByteCodeOpr Low)
-> (ByteCodeOffset -> Invocation Low)
-> ByteCodeOffset
-> ByteCodeOpr Low
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteCodeOffset -> Invocation Low
forall r. Ref AbsVariableMethodId r -> Invocation r
InvkStatic (ByteCodeOffset -> ByteCodeOpr Low)
-> Get ByteCodeOffset -> Get (ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteCodeOffset
forall t. Binary t => Get t
get
      Word8
0xb9 -> do
        ByteCodeOffset
ref <- Get ByteCodeOffset
forall t. Binary t => Get t
get
        Word8
count <- Get Word8
forall t. Binary t => Get t
get
        Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word8
count Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$ String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Should be not zero"
        Word8
zero <- Get Word8
getWord8
        Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word8
zero Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$ String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Should be zero"
        ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ Invocation Low -> ByteCodeOpr Low
forall r. Invocation r -> ByteCodeOpr r
Invoke (Word8 -> Ref AbsInterfaceMethodId Low -> Invocation Low
forall r. Word8 -> Ref AbsInterfaceMethodId r -> Invocation r
InvkInterface Word8
count ByteCodeOffset
Ref AbsInterfaceMethodId Low
ref)
      Word8
0xba -> do
        ByteCodeOffset
ref <- Get ByteCodeOffset
forall t. Binary t => Get t
get
        Word8
count <- Get Word8
getWord8
        Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word8
count Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$ String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Should be zero"
        Word8
zero <- Get Word8
getWord8
        Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word8
zero Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$ String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Should be zero"
        ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ Invocation Low -> ByteCodeOpr Low
forall r. Invocation r -> ByteCodeOpr r
Invoke (DeepRef InvokeDynamic Low -> Invocation Low
forall r. DeepRef InvokeDynamic r -> Invocation r
InvkDynamic ByteCodeOffset
DeepRef InvokeDynamic Low
ref)
      Word8
0xbb -> ByteCodeOffset -> ByteCodeOpr Low
forall r. Ref ClassName r -> ByteCodeOpr r
New (ByteCodeOffset -> ByteCodeOpr Low)
-> Get ByteCodeOffset -> Get (ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteCodeOffset
forall t. Binary t => Get t
get

      Word8
0xbc -> do
        Word8
x <- Get Word8
getWord8
        LowNewArrayType -> ByteCodeOpr Low
forall r. Choice LowNewArrayType NewArrayType r -> ByteCodeOpr r
NewArray (LowNewArrayType -> ByteCodeOpr Low)
-> (JBaseType -> LowNewArrayType) -> JBaseType -> ByteCodeOpr Low
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JBaseType -> LowNewArrayType
ArrayBaseType (JBaseType -> ByteCodeOpr Low)
-> Get JBaseType -> Get (ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Word8
x of
          Word8
4  -> JBaseType -> Get JBaseType
forall (m :: * -> *) a. Monad m => a -> m a
return JBaseType
JTBoolean
          Word8
5  -> JBaseType -> Get JBaseType
forall (m :: * -> *) a. Monad m => a -> m a
return JBaseType
JTChar
          Word8
6  -> JBaseType -> Get JBaseType
forall (m :: * -> *) a. Monad m => a -> m a
return JBaseType
JTFloat
          Word8
7  -> JBaseType -> Get JBaseType
forall (m :: * -> *) a. Monad m => a -> m a
return JBaseType
JTDouble
          Word8
8  -> JBaseType -> Get JBaseType
forall (m :: * -> *) a. Monad m => a -> m a
return JBaseType
JTByte
          Word8
9  -> JBaseType -> Get JBaseType
forall (m :: * -> *) a. Monad m => a -> m a
return JBaseType
JTShort
          Word8
10 -> JBaseType -> Get JBaseType
forall (m :: * -> *) a. Monad m => a -> m a
return JBaseType
JTInt
          Word8
11 -> JBaseType -> Get JBaseType
forall (m :: * -> *) a. Monad m => a -> m a
return JBaseType
JTLong
          Word8
_  -> String -> Get JBaseType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get JBaseType) -> String -> Get JBaseType
forall a b. (a -> b) -> a -> b
$ String
"Unknown type '0x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String -> String
forall a. (Integral a, Show a) => a -> String -> String
showHex Word8
x String
"'."

      Word8
0xbd -> LowNewArrayType -> ByteCodeOpr Low
forall r. Choice LowNewArrayType NewArrayType r -> ByteCodeOpr r
NewArray (LowNewArrayType -> ByteCodeOpr Low)
-> (ByteCodeOffset -> LowNewArrayType)
-> ByteCodeOffset
-> ByteCodeOpr Low
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ByteCodeOffset -> Word8 -> LowNewArrayType)
-> Word8 -> ByteCodeOffset -> LowNewArrayType
forall a b c. (a -> b -> c) -> b -> a -> c
flip ByteCodeOffset -> Word8 -> LowNewArrayType
Ref JRefType Low -> Word8 -> LowNewArrayType
ArrayReference Word8
1) (ByteCodeOffset -> ByteCodeOpr Low)
-> Get ByteCodeOffset -> Get (ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteCodeOffset
forall t. Binary t => Get t
get

      Word8
0xbe -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return ByteCodeOpr Low
forall r. ByteCodeOpr r
ArrayLength

      Word8
0xbf -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return ByteCodeOpr Low
forall r. ByteCodeOpr r
Throw

      Word8
0xc0 -> ByteCodeOffset -> ByteCodeOpr Low
forall r. Ref JRefType r -> ByteCodeOpr r
CheckCast (ByteCodeOffset -> ByteCodeOpr Low)
-> Get ByteCodeOffset -> Get (ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteCodeOffset
forall t. Binary t => Get t
get
      Word8
0xc1 -> ByteCodeOffset -> ByteCodeOpr Low
forall r. Ref JRefType r -> ByteCodeOpr r
InstanceOf (ByteCodeOffset -> ByteCodeOpr Low)
-> Get ByteCodeOffset -> Get (ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteCodeOffset
forall t. Binary t => Get t
get

      Word8
0xc2 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ Bool -> ByteCodeOpr Low
forall r. Bool -> ByteCodeOpr r
Monitor Bool
True
      Word8
0xc3 -> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteCodeOpr Low -> Get (ByteCodeOpr Low))
-> ByteCodeOpr Low -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ Bool -> ByteCodeOpr Low
forall r. Bool -> ByteCodeOpr r
Monitor Bool
False

      Word8
0xc4 -> do
        Word8
subopcode <- Get Word8
getWord8
        case Word8
subopcode of
          Word8
0x15 -> LocalType -> ByteCodeOffset -> ByteCodeOpr Low
forall r. LocalType -> ByteCodeOffset -> ByteCodeOpr r
Load LocalType
LInt (ByteCodeOffset -> ByteCodeOpr Low)
-> Get ByteCodeOffset -> Get (ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteCodeOffset
forall t. Binary t => Get t
get
          Word8
0x16 -> LocalType -> ByteCodeOffset -> ByteCodeOpr Low
forall r. LocalType -> ByteCodeOffset -> ByteCodeOpr r
Load LocalType
LLong (ByteCodeOffset -> ByteCodeOpr Low)
-> Get ByteCodeOffset -> Get (ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteCodeOffset
forall t. Binary t => Get t
get
          Word8
0x17 -> LocalType -> ByteCodeOffset -> ByteCodeOpr Low
forall r. LocalType -> ByteCodeOffset -> ByteCodeOpr r
Load LocalType
LFloat (ByteCodeOffset -> ByteCodeOpr Low)
-> Get ByteCodeOffset -> Get (ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteCodeOffset
forall t. Binary t => Get t
get
          Word8
0x18 -> LocalType -> ByteCodeOffset -> ByteCodeOpr Low
forall r. LocalType -> ByteCodeOffset -> ByteCodeOpr r
Load LocalType
LDouble (ByteCodeOffset -> ByteCodeOpr Low)
-> Get ByteCodeOffset -> Get (ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteCodeOffset
forall t. Binary t => Get t
get
          Word8
0x19 -> LocalType -> ByteCodeOffset -> ByteCodeOpr Low
forall r. LocalType -> ByteCodeOffset -> ByteCodeOpr r
Load LocalType
LRef (ByteCodeOffset -> ByteCodeOpr Low)
-> Get ByteCodeOffset -> Get (ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteCodeOffset
forall t. Binary t => Get t
get

          Word8
0x36 -> LocalType -> ByteCodeOffset -> ByteCodeOpr Low
forall r. LocalType -> ByteCodeOffset -> ByteCodeOpr r
Store LocalType
LInt (ByteCodeOffset -> ByteCodeOpr Low)
-> Get ByteCodeOffset -> Get (ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteCodeOffset
forall t. Binary t => Get t
get
          Word8
0x37 -> LocalType -> ByteCodeOffset -> ByteCodeOpr Low
forall r. LocalType -> ByteCodeOffset -> ByteCodeOpr r
Store LocalType
LLong (ByteCodeOffset -> ByteCodeOpr Low)
-> Get ByteCodeOffset -> Get (ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteCodeOffset
forall t. Binary t => Get t
get
          Word8
0x38 -> LocalType -> ByteCodeOffset -> ByteCodeOpr Low
forall r. LocalType -> ByteCodeOffset -> ByteCodeOpr r
Store LocalType
LFloat (ByteCodeOffset -> ByteCodeOpr Low)
-> Get ByteCodeOffset -> Get (ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteCodeOffset
forall t. Binary t => Get t
get
          Word8
0x39 -> LocalType -> ByteCodeOffset -> ByteCodeOpr Low
forall r. LocalType -> ByteCodeOffset -> ByteCodeOpr r
Store LocalType
LDouble (ByteCodeOffset -> ByteCodeOpr Low)
-> Get ByteCodeOffset -> Get (ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteCodeOffset
forall t. Binary t => Get t
get
          Word8
0x3a -> LocalType -> ByteCodeOffset -> ByteCodeOpr Low
forall r. LocalType -> ByteCodeOffset -> ByteCodeOpr r
Store LocalType
LRef (ByteCodeOffset -> ByteCodeOpr Low)
-> Get ByteCodeOffset -> Get (ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteCodeOffset
forall t. Binary t => Get t
get

          Word8
0x84 -> ByteCodeOffset -> Int16 -> ByteCodeOpr Low
forall r. ByteCodeOffset -> Int16 -> ByteCodeOpr r
IncrLocal (ByteCodeOffset -> Int16 -> ByteCodeOpr Low)
-> Get ByteCodeOffset -> Get (Int16 -> ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteCodeOffset
forall t. Binary t => Get t
get Get (Int16 -> ByteCodeOpr Low)
-> Get Int16 -> Get (ByteCodeOpr Low)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int16
forall t. Binary t => Get t
get

          Word8
0xa9 -> ByteCodeOffset -> ByteCodeOpr Low
forall r. ByteCodeOffset -> ByteCodeOpr r
Ret (ByteCodeOffset -> ByteCodeOpr Low)
-> Get ByteCodeOffset -> Get (ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteCodeOffset
forall t. Binary t => Get t
get

          Word8
_ -> String -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get (ByteCodeOpr Low))
-> String -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ String
"Wide does not work for opcode '0x"
                String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String -> String
forall a. (Integral a, Show a) => a -> String -> String
showHex Word8
subopcode String
"'"

      Word8
0xc5 -> LowNewArrayType -> ByteCodeOpr Low
forall r. Choice LowNewArrayType NewArrayType r -> ByteCodeOpr r
NewArray (LowNewArrayType -> ByteCodeOpr Low)
-> Get LowNewArrayType -> Get (ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ByteCodeOffset -> Word8 -> LowNewArrayType
Ref JRefType Low -> Word8 -> LowNewArrayType
ArrayReference (ByteCodeOffset -> Word8 -> LowNewArrayType)
-> Get ByteCodeOffset -> Get (Word8 -> LowNewArrayType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteCodeOffset
forall t. Binary t => Get t
get Get (Word8 -> LowNewArrayType) -> Get Word8 -> Get LowNewArrayType
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word8
forall t. Binary t => Get t
get)

      Word8
0xc6 -> Bool -> OneOrTwo -> ShortRelativeRef Low -> ByteCodeOpr Low
forall r. Bool -> OneOrTwo -> ShortRelativeRef r -> ByteCodeOpr r
IfRef Bool
False OneOrTwo
One (Int16 -> ByteCodeOpr Low) -> Get Int16 -> Get (ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int16
forall t. Binary t => Get t
get
      Word8
0xc7 -> Bool -> OneOrTwo -> ShortRelativeRef Low -> ByteCodeOpr Low
forall r. Bool -> OneOrTwo -> ShortRelativeRef r -> ByteCodeOpr r
IfRef Bool
True OneOrTwo
One (Int16 -> ByteCodeOpr Low) -> Get Int16 -> Get (ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int16
forall t. Binary t => Get t
get

      Word8
0xc8 -> Int32 -> ByteCodeOpr Low
forall r. LongRelativeRef r -> ByteCodeOpr r
Goto (Int32 -> ByteCodeOpr Low) -> Get Int32 -> Get (ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int32
getInt32be
      Word8
0xc9 -> Int32 -> ByteCodeOpr Low
forall r. LongRelativeRef r -> ByteCodeOpr r
Jsr (Int32 -> ByteCodeOpr Low) -> Get Int32 -> Get (ByteCodeOpr Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int32
getInt32be

      Word8
_ -> String -> Get (ByteCodeOpr Low)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get (ByteCodeOpr Low))
-> String -> Get (ByteCodeOpr Low)
forall a b. (a -> b) -> a -> b
$ String
"I do not know this bytecode '0x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String -> String
forall a. (Integral a, Show a) => a -> String -> String
showHex Word8
cmd String
"'."

  {-# INLINABLE get #-}

  put :: ByteCodeOpr Low -> Put
put = ByteCodeOffset -> ByteCodeOpr Low -> Put
putByteCode ByteCodeOffset
0

  {-# INLINE put #-}

putByteCode :: Word16 -> ByteCodeOpr Low -> Put
putByteCode :: ByteCodeOffset -> ByteCodeOpr Low -> Put
putByteCode ByteCodeOffset
n ByteCodeOpr Low
bc =
  case ByteCodeOpr Low
bc of
    ByteCodeOpr Low
Nop -> Word8 -> Put
putWord8 Word8
0x00
    Push BConstant Low
CNull -> Word8 -> Put
putWord8 Word8
0x01

    Push BConstant Low
CIntM1 -> Word8 -> Put
putWord8 Word8
0x02
    Push BConstant Low
CInt0 -> Word8 -> Put
putWord8 Word8
0x03
    Push BConstant Low
CInt1 -> Word8 -> Put
putWord8 Word8
0x04
    Push BConstant Low
CInt2 -> Word8 -> Put
putWord8 Word8
0x05
    Push BConstant Low
CInt3 -> Word8 -> Put
putWord8 Word8
0x06
    Push BConstant Low
CInt4 -> Word8 -> Put
putWord8 Word8
0x07
    Push BConstant Low
CInt5 -> Word8 -> Put
putWord8 Word8
0x08

    Push BConstant Low
CLong0 -> Word8 -> Put
putWord8 Word8
0x09
    Push BConstant Low
CLong1 -> Word8 -> Put
putWord8 Word8
0x0a

    Push BConstant Low
CFloat0 -> Word8 -> Put
putWord8 Word8
0x0b
    Push BConstant Low
CFloat1 -> Word8 -> Put
putWord8 Word8
0x0c
    Push BConstant Low
CFloat2 -> Word8 -> Put
putWord8 Word8
0x0d

    Push BConstant Low
CDouble0 -> Word8 -> Put
putWord8 Word8
0x0e
    Push BConstant Low
CDouble1 -> Word8 -> Put
putWord8 Word8
0x0f

    Push (CByte x) -> Word8 -> Put
putWord8 Word8
0x10 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int8 -> Put
forall t. Binary t => t -> Put
put Int8
x
    Push (CShort x) -> Word8 -> Put
putWord8 Word8
0x11 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int16 -> Put
forall t. Binary t => t -> Put
put Int16
x

    Push (CRef (Just One) x) ->
      Word8 -> Put
putWord8 Word8
0x13 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteCodeOffset -> Put
forall t. Binary t => t -> Put
put ByteCodeOffset
Ref JValue Low
x
    -- In this case force the wide
    Push (CRef Nothing x)
      | ByteCodeOffset
Ref JValue Low
x ByteCodeOffset -> ByteCodeOffset -> Bool
forall a. Ord a => a -> a -> Bool
<= ByteCodeOffset
0xff -> Word8 -> Put
putWord8 Word8
0x12 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Word8 -> Put
putWord8 (Word8 -> Put)
-> (ByteCodeOffset -> Word8) -> ByteCodeOffset -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteCodeOffset -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteCodeOffset -> Put) -> ByteCodeOffset -> Put
forall a b. (a -> b) -> a -> b
$ ByteCodeOffset
Ref JValue Low
x)
      | Bool
otherwise -> Word8 -> Put
putWord8 Word8
0x13 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteCodeOffset -> Put
forall t. Binary t => t -> Put
put ByteCodeOffset
Ref JValue Low
x
    -- Here there is no direct restrictions
    Push (CRef (Just Two) r) -> Word8 -> Put
putWord8 Word8
0x14 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteCodeOffset -> Put
forall t. Binary t => t -> Put
put ByteCodeOffset
Ref JValue Low
r

    Load LocalType
tp ByteCodeOffset
vl ->
      case LocalType
tp of
        LocalType
LInt ->
          case ByteCodeOffset
vl of
            ByteCodeOffset
0 -> Word8 -> Put
putWord8 Word8
0x1a
            ByteCodeOffset
1 -> Word8 -> Put
putWord8 Word8
0x1b
            ByteCodeOffset
2 -> Word8 -> Put
putWord8 Word8
0x1c
            ByteCodeOffset
3 -> Word8 -> Put
putWord8 Word8
0x1d
            ByteCodeOffset
a | ByteCodeOffset
a ByteCodeOffset -> ByteCodeOffset -> Bool
forall a. Ord a => a -> a -> Bool
<= ByteCodeOffset
maxWord8 -> do
                Word8 -> Put
putWord8 Word8
0x15
                Word8 -> Put
putWord8 (ByteCodeOffset -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ByteCodeOffset
a)
            ByteCodeOffset
a -> do
              Word8 -> Put
putWord8 Word8
0xc4 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
putWord8 Word8
0x15 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteCodeOffset -> Put
forall t. Binary t => t -> Put
put ByteCodeOffset
a
        LocalType
LLong ->
          case ByteCodeOffset
vl of
            ByteCodeOffset
0 -> Word8 -> Put
putWord8 Word8
0x1e
            ByteCodeOffset
1 -> Word8 -> Put
putWord8 Word8
0x1f
            ByteCodeOffset
2 -> Word8 -> Put
putWord8 Word8
0x20
            ByteCodeOffset
3 -> Word8 -> Put
putWord8 Word8
0x21
            ByteCodeOffset
a | ByteCodeOffset
a ByteCodeOffset -> ByteCodeOffset -> Bool
forall a. Ord a => a -> a -> Bool
<= ByteCodeOffset
maxWord8 -> do
                Word8 -> Put
putWord8 Word8
0x16
                Word8 -> Put
putWord8 (ByteCodeOffset -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ByteCodeOffset
a)
            ByteCodeOffset
a -> do
              Word8 -> Put
putWord8 Word8
0xc4 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
putWord8 Word8
0x16 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteCodeOffset -> Put
forall t. Binary t => t -> Put
put ByteCodeOffset
a
        LocalType
LFloat ->
          case ByteCodeOffset
vl of
            ByteCodeOffset
0 -> Word8 -> Put
putWord8 Word8
0x22
            ByteCodeOffset
1 -> Word8 -> Put
putWord8 Word8
0x23
            ByteCodeOffset
2 -> Word8 -> Put
putWord8 Word8
0x24
            ByteCodeOffset
3 -> Word8 -> Put
putWord8 Word8
0x25
            ByteCodeOffset
a | ByteCodeOffset
a ByteCodeOffset -> ByteCodeOffset -> Bool
forall a. Ord a => a -> a -> Bool
<= ByteCodeOffset
maxWord8 -> do
                Word8 -> Put
putWord8 Word8
0x17
                Word8 -> Put
putWord8 (ByteCodeOffset -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ByteCodeOffset
a)
            ByteCodeOffset
a -> do
              Word8 -> Put
putWord8 Word8
0xc4 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
putWord8 Word8
0x17 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteCodeOffset -> Put
forall t. Binary t => t -> Put
put ByteCodeOffset
a
        LocalType
LDouble ->
          case ByteCodeOffset
vl of
            ByteCodeOffset
0 -> Word8 -> Put
putWord8 Word8
0x26
            ByteCodeOffset
1 -> Word8 -> Put
putWord8 Word8
0x27
            ByteCodeOffset
2 -> Word8 -> Put
putWord8 Word8
0x28
            ByteCodeOffset
3 -> Word8 -> Put
putWord8 Word8
0x29
            ByteCodeOffset
a | ByteCodeOffset
a ByteCodeOffset -> ByteCodeOffset -> Bool
forall a. Ord a => a -> a -> Bool
<= ByteCodeOffset
maxWord8 -> do
                Word8 -> Put
putWord8 Word8
0x18
                Word8 -> Put
putWord8 (ByteCodeOffset -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ByteCodeOffset
a)
            ByteCodeOffset
a -> do
              Word8 -> Put
putWord8 Word8
0xc4 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
putWord8 Word8
0x18 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteCodeOffset -> Put
forall t. Binary t => t -> Put
put ByteCodeOffset
a
        LocalType
LRef ->
          case ByteCodeOffset
vl of
            ByteCodeOffset
0 -> Word8 -> Put
putWord8 Word8
0x2a
            ByteCodeOffset
1 -> Word8 -> Put
putWord8 Word8
0x2b
            ByteCodeOffset
2 -> Word8 -> Put
putWord8 Word8
0x2c
            ByteCodeOffset
3 -> Word8 -> Put
putWord8 Word8
0x2d
            ByteCodeOffset
a | ByteCodeOffset
a ByteCodeOffset -> ByteCodeOffset -> Bool
forall a. Ord a => a -> a -> Bool
<= ByteCodeOffset
maxWord8 -> do
                Word8 -> Put
putWord8 Word8
0x19
                Word8 -> Put
putWord8 (ByteCodeOffset -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ByteCodeOffset
a)
            ByteCodeOffset
a -> do
              Word8 -> Put
putWord8 Word8
0xc4 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
putWord8 Word8
0x19 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteCodeOffset -> Put
forall t. Binary t => t -> Put
put ByteCodeOffset
a


    ArrayLoad ArrayType
t ->
      case ArrayType
t of
        ArrayType
AInt    -> Word8 -> Put
putWord8 Word8
0x2e
        ArrayType
ALong   -> Word8 -> Put
putWord8 Word8
0x2f
        ArrayType
AFloat  -> Word8 -> Put
putWord8 Word8
0x30
        ArrayType
ADouble -> Word8 -> Put
putWord8 Word8
0x31
        ArrayType
ARef    -> Word8 -> Put
putWord8 Word8
0x32
        ArrayType
AByte   -> Word8 -> Put
putWord8 Word8
0x33
        ArrayType
AChar   -> Word8 -> Put
putWord8 Word8
0x34
        ArrayType
AShort  -> Word8 -> Put
putWord8 Word8
0x35

    Store LocalType
tp ByteCodeOffset
vl ->
      case LocalType
tp of
        LocalType
LInt ->
          case ByteCodeOffset
vl of
            ByteCodeOffset
0 -> Word8 -> Put
putWord8 Word8
0x3b
            ByteCodeOffset
1 -> Word8 -> Put
putWord8 Word8
0x3c
            ByteCodeOffset
2 -> Word8 -> Put
putWord8 Word8
0x3d
            ByteCodeOffset
3 -> Word8 -> Put
putWord8 Word8
0x3e
            ByteCodeOffset
a | ByteCodeOffset
a ByteCodeOffset -> ByteCodeOffset -> Bool
forall a. Ord a => a -> a -> Bool
<= ByteCodeOffset
maxWord8 -> do
                Word8 -> Put
putWord8 Word8
0x36
                Word8 -> Put
putWord8 (ByteCodeOffset -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ByteCodeOffset
a)
            ByteCodeOffset
a -> do
              Word8 -> Put
putWord8 Word8
0xc4 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
putWord8 Word8
0x36 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteCodeOffset -> Put
forall t. Binary t => t -> Put
put ByteCodeOffset
a

        LocalType
LLong ->
          case ByteCodeOffset
vl of
            ByteCodeOffset
0 -> Word8 -> Put
putWord8 Word8
0x3f
            ByteCodeOffset
1 -> Word8 -> Put
putWord8 Word8
0x40
            ByteCodeOffset
2 -> Word8 -> Put
putWord8 Word8
0x41
            ByteCodeOffset
3 -> Word8 -> Put
putWord8 Word8
0x42
            ByteCodeOffset
a | ByteCodeOffset
a ByteCodeOffset -> ByteCodeOffset -> Bool
forall a. Ord a => a -> a -> Bool
<= ByteCodeOffset
maxWord8 -> do
                Word8 -> Put
putWord8 Word8
0x37
                Word8 -> Put
putWord8 (ByteCodeOffset -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ByteCodeOffset
a)
            ByteCodeOffset
a -> do
              Word8 -> Put
putWord8 Word8
0xc4 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
putWord8 Word8
0x37 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteCodeOffset -> Put
forall t. Binary t => t -> Put
put ByteCodeOffset
a

        LocalType
LFloat ->
          case ByteCodeOffset
vl of
            ByteCodeOffset
0 -> Word8 -> Put
putWord8 Word8
0x43
            ByteCodeOffset
1 -> Word8 -> Put
putWord8 Word8
0x44
            ByteCodeOffset
2 -> Word8 -> Put
putWord8 Word8
0x45
            ByteCodeOffset
3 -> Word8 -> Put
putWord8 Word8
0x46
            ByteCodeOffset
a | ByteCodeOffset
a ByteCodeOffset -> ByteCodeOffset -> Bool
forall a. Ord a => a -> a -> Bool
<= ByteCodeOffset
maxWord8 -> do
                Word8 -> Put
putWord8 Word8
0x38
                Word8 -> Put
putWord8 (ByteCodeOffset -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ByteCodeOffset
a)
            ByteCodeOffset
a -> do
              Word8 -> Put
putWord8 Word8
0xc4 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
putWord8 Word8
0x38 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteCodeOffset -> Put
forall t. Binary t => t -> Put
put ByteCodeOffset
a

        LocalType
LDouble ->
          case ByteCodeOffset
vl of
            ByteCodeOffset
0 -> Word8 -> Put
putWord8 Word8
0x47
            ByteCodeOffset
1 -> Word8 -> Put
putWord8 Word8
0x48
            ByteCodeOffset
2 -> Word8 -> Put
putWord8 Word8
0x49
            ByteCodeOffset
3 -> Word8 -> Put
putWord8 Word8
0x4a
            ByteCodeOffset
a | ByteCodeOffset
a ByteCodeOffset -> ByteCodeOffset -> Bool
forall a. Ord a => a -> a -> Bool
<= ByteCodeOffset
maxWord8 -> do
                Word8 -> Put
putWord8 Word8
0x39
                Word8 -> Put
putWord8 (ByteCodeOffset -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ByteCodeOffset
a)
            ByteCodeOffset
a -> do
              Word8 -> Put
putWord8 Word8
0xc4 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
putWord8 Word8
0x39 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteCodeOffset -> Put
forall t. Binary t => t -> Put
put ByteCodeOffset
a

        LocalType
LRef ->
          case ByteCodeOffset
vl of
            ByteCodeOffset
0 -> Word8 -> Put
putWord8 Word8
0x4b
            ByteCodeOffset
1 -> Word8 -> Put
putWord8 Word8
0x4c
            ByteCodeOffset
2 -> Word8 -> Put
putWord8 Word8
0x4d
            ByteCodeOffset
3 -> Word8 -> Put
putWord8 Word8
0x4e
            ByteCodeOffset
a | ByteCodeOffset
a ByteCodeOffset -> ByteCodeOffset -> Bool
forall a. Ord a => a -> a -> Bool
<= ByteCodeOffset
maxWord8 -> do
                Word8 -> Put
putWord8 Word8
0x3a
                Word8 -> Put
putWord8 (ByteCodeOffset -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ByteCodeOffset
a)
            ByteCodeOffset
a -> do
              Word8 -> Put
putWord8 Word8
0xc4 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
putWord8 Word8
0x3a Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteCodeOffset -> Put
forall t. Binary t => t -> Put
put ByteCodeOffset
a

    ArrayStore ArrayType
AInt -> Word8 -> Put
putWord8 Word8
0x4f
    ArrayStore ArrayType
ALong -> Word8 -> Put
putWord8 Word8
0x50
    ArrayStore ArrayType
AFloat -> Word8 -> Put
putWord8 Word8
0x51
    ArrayStore ArrayType
ADouble -> Word8 -> Put
putWord8 Word8
0x52
    ArrayStore ArrayType
ARef -> Word8 -> Put
putWord8 Word8
0x53
    ArrayStore ArrayType
AByte -> Word8 -> Put
putWord8 Word8
0x54
    ArrayStore ArrayType
AChar -> Word8 -> Put
putWord8 Word8
0x55
    ArrayStore ArrayType
AShort -> Word8 -> Put
putWord8 Word8
0x56

    Pop OneOrTwo
One -> Word8 -> Put
putWord8 Word8
0x57
    Pop OneOrTwo
Two -> Word8 -> Put
putWord8 Word8
0x58

    Dup OneOrTwo
One -> Word8 -> Put
putWord8 Word8
0x59
    DupX1 OneOrTwo
One -> Word8 -> Put
putWord8 Word8
0x5a
    DupX2 OneOrTwo
One -> Word8 -> Put
putWord8 Word8
0x5b

    Dup OneOrTwo
Two -> Word8 -> Put
putWord8 Word8
0x5c
    DupX1 OneOrTwo
Two -> Word8 -> Put
putWord8 Word8
0x5d
    DupX2 OneOrTwo
Two -> Word8 -> Put
putWord8 Word8
0x5e

    ByteCodeOpr Low
Swap -> Word8 -> Put
putWord8 Word8
0x5f

    BinaryOpr BinOpr
Add ArithmeticType
MInt -> Word8 -> Put
putWord8 Word8
0x60
    BinaryOpr BinOpr
Add ArithmeticType
MLong -> Word8 -> Put
putWord8 Word8
0x61
    BinaryOpr BinOpr
Add ArithmeticType
MFloat -> Word8 -> Put
putWord8 Word8
0x62
    BinaryOpr BinOpr
Add ArithmeticType
MDouble -> Word8 -> Put
putWord8 Word8
0x63

    BinaryOpr BinOpr
Sub ArithmeticType
MInt -> Word8 -> Put
putWord8 Word8
0x64
    BinaryOpr BinOpr
Sub ArithmeticType
MLong -> Word8 -> Put
putWord8 Word8
0x65
    BinaryOpr BinOpr
Sub ArithmeticType
MFloat -> Word8 -> Put
putWord8 Word8
0x66
    BinaryOpr BinOpr
Sub ArithmeticType
MDouble -> Word8 -> Put
putWord8 Word8
0x67

    BinaryOpr BinOpr
Mul ArithmeticType
MInt -> Word8 -> Put
putWord8 Word8
0x68
    BinaryOpr BinOpr
Mul ArithmeticType
MLong -> Word8 -> Put
putWord8 Word8
0x69
    BinaryOpr BinOpr
Mul ArithmeticType
MFloat -> Word8 -> Put
putWord8 Word8
0x6a
    BinaryOpr BinOpr
Mul ArithmeticType
MDouble -> Word8 -> Put
putWord8 Word8
0x6b

    BinaryOpr BinOpr
Div ArithmeticType
MInt -> Word8 -> Put
putWord8 Word8
0x6c
    BinaryOpr BinOpr
Div ArithmeticType
MLong -> Word8 -> Put
putWord8 Word8
0x6d
    BinaryOpr BinOpr
Div ArithmeticType
MFloat -> Word8 -> Put
putWord8 Word8
0x6e
    BinaryOpr BinOpr
Div ArithmeticType
MDouble -> Word8 -> Put
putWord8 Word8
0x6f

    BinaryOpr BinOpr
Rem ArithmeticType
MInt -> Word8 -> Put
putWord8 Word8
0x70
    BinaryOpr BinOpr
Rem ArithmeticType
MLong -> Word8 -> Put
putWord8 Word8
0x71
    BinaryOpr BinOpr
Rem ArithmeticType
MFloat -> Word8 -> Put
putWord8 Word8
0x72
    BinaryOpr BinOpr
Rem ArithmeticType
MDouble -> Word8 -> Put
putWord8 Word8
0x73

    Neg ArithmeticType
MInt -> Word8 -> Put
putWord8 Word8
0x74
    Neg ArithmeticType
MLong -> Word8 -> Put
putWord8 Word8
0x75
    Neg ArithmeticType
MFloat -> Word8 -> Put
putWord8 Word8
0x76
    Neg ArithmeticType
MDouble -> Word8 -> Put
putWord8 Word8
0x77

    BitOpr BitOpr
ShL OneOrTwo
One -> Word8 -> Put
putWord8 Word8
0x78
    BitOpr BitOpr
ShL OneOrTwo
Two -> Word8 -> Put
putWord8 Word8
0x79
    BitOpr BitOpr
ShR OneOrTwo
One -> Word8 -> Put
putWord8 Word8
0x7a
    BitOpr BitOpr
ShR OneOrTwo
Two -> Word8 -> Put
putWord8 Word8
0x7b

    BitOpr BitOpr
UShR OneOrTwo
One -> Word8 -> Put
putWord8 Word8
0x7c
    BitOpr BitOpr
UShR OneOrTwo
Two -> Word8 -> Put
putWord8 Word8
0x7d

    BitOpr BitOpr
And OneOrTwo
One -> Word8 -> Put
putWord8 Word8
0x7e
    BitOpr BitOpr
And OneOrTwo
Two -> Word8 -> Put
putWord8 Word8
0x7f
    BitOpr BitOpr
Or OneOrTwo
One -> Word8 -> Put
putWord8 Word8
0x80
    BitOpr BitOpr
Or OneOrTwo
Two -> Word8 -> Put
putWord8 Word8
0x81
    BitOpr BitOpr
XOr OneOrTwo
One -> Word8 -> Put
putWord8 Word8
0x82
    BitOpr BitOpr
XOr OneOrTwo
Two -> Word8 -> Put
putWord8 Word8
0x83

    IncrLocal ByteCodeOffset
s1 Int16
s2 ->
      if ByteCodeOffset
s1 ByteCodeOffset -> ByteCodeOffset -> Bool
forall a. Ord a => a -> a -> Bool
> ByteCodeOffset
maxWord8 Bool -> Bool -> Bool
|| Int16
s2 Int16 -> Int16 -> Bool
forall a. Ord a => a -> a -> Bool
> Int8 -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int8
forall a. Bounded a => a
maxBound :: Int8) Bool -> Bool -> Bool
|| Int16
s2 Int16 -> Int16 -> Bool
forall a. Ord a => a -> a -> Bool
< Int8 -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int8
forall a. Bounded a => a
minBound :: Int8) then
        Word8 -> Put
putWord8 Word8
0xc4 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
putWord8 Word8
0x84 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteCodeOffset -> Put
forall t. Binary t => t -> Put
put ByteCodeOffset
s1 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int16 -> Put
forall t. Binary t => t -> Put
put Int16
s2
      else
        Word8 -> Put
putWord8 Word8
0x84 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
putWord8 (ByteCodeOffset -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ByteCodeOffset
s1) Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int8 -> Put
putInt8 (Int16 -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int16
s2)

    Cast CastOpr
a ->
      case CastOpr
a of
        CastTo ArithmeticType
MInt ArithmeticType
MLong -> Word8 -> Put
putWord8 Word8
0x85
        CastTo ArithmeticType
MInt ArithmeticType
MFloat -> Word8 -> Put
putWord8 Word8
0x86
        CastTo ArithmeticType
MInt ArithmeticType
MDouble -> Word8 -> Put
putWord8 Word8
0x87

        CastTo ArithmeticType
MLong ArithmeticType
MInt -> Word8 -> Put
putWord8 Word8
0x88
        CastTo ArithmeticType
MLong ArithmeticType
MFloat -> Word8 -> Put
putWord8 Word8
0x89
        CastTo ArithmeticType
MLong ArithmeticType
MDouble -> Word8 -> Put
putWord8 Word8
0x8a

        CastTo ArithmeticType
MFloat ArithmeticType
MInt -> Word8 -> Put
putWord8 Word8
0x8b
        CastTo ArithmeticType
MFloat ArithmeticType
MLong -> Word8 -> Put
putWord8 Word8
0x8c
        CastTo ArithmeticType
MFloat ArithmeticType
MDouble -> Word8 -> Put
putWord8 Word8
0x8d

        CastTo ArithmeticType
MDouble ArithmeticType
MInt -> Word8 -> Put
putWord8 Word8
0x8e
        CastTo ArithmeticType
MDouble ArithmeticType
MLong -> Word8 -> Put
putWord8 Word8
0x8f
        CastTo ArithmeticType
MDouble ArithmeticType
MFloat -> Word8 -> Put
putWord8 Word8
0x90

        CastDown SmallArithmeticType
MByte -> Word8 -> Put
putWord8 Word8
0x91
        CastDown SmallArithmeticType
MChar -> Word8 -> Put
putWord8 Word8
0x92
        CastDown SmallArithmeticType
MShort -> Word8 -> Put
putWord8 Word8
0x93

        CastOpr
_ -> String -> Put
forall a. HasCallStack => String -> a
error (String -> Put) -> String -> Put
forall a b. (a -> b) -> a -> b
$ String
"Cannot cast from " String -> String -> String
forall a. [a] -> [a] -> [a]
++ CastOpr -> String
forall a. Show a => a -> String
show CastOpr
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" to " String -> String -> String
forall a. [a] -> [a] -> [a]
++ CastOpr -> String
forall a. Show a => a -> String
show CastOpr
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."

    ByteCodeOpr Low
CompareLongs -> Word8 -> Put
putWord8 Word8
0x94

    CompareFloating Bool
True OneOrTwo
One -> Word8 -> Put
putWord8 Word8
0x95
    CompareFloating Bool
False OneOrTwo
One -> Word8 -> Put
putWord8 Word8
0x96

    CompareFloating Bool
True OneOrTwo
Two -> Word8 -> Put
putWord8 Word8
0x97
    CompareFloating Bool
False OneOrTwo
Two -> Word8 -> Put
putWord8 Word8
0x98

    If CmpOpr
CEq OneOrTwo
One ShortRelativeRef Low
a -> Word8 -> Put
putWord8 Word8
0x99 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int16 -> Put
forall t. Binary t => t -> Put
put Int16
ShortRelativeRef Low
a
    If CmpOpr
CNe OneOrTwo
One ShortRelativeRef Low
a -> Word8 -> Put
putWord8 Word8
0x9a Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int16 -> Put
forall t. Binary t => t -> Put
put Int16
ShortRelativeRef Low
a
    If CmpOpr
CLt OneOrTwo
One ShortRelativeRef Low
a -> Word8 -> Put
putWord8 Word8
0x9b Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int16 -> Put
forall t. Binary t => t -> Put
put Int16
ShortRelativeRef Low
a
    If CmpOpr
CGe OneOrTwo
One ShortRelativeRef Low
a -> Word8 -> Put
putWord8 Word8
0x9c Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int16 -> Put
forall t. Binary t => t -> Put
put Int16
ShortRelativeRef Low
a
    If CmpOpr
CGt OneOrTwo
One ShortRelativeRef Low
a -> Word8 -> Put
putWord8 Word8
0x9d Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int16 -> Put
forall t. Binary t => t -> Put
put Int16
ShortRelativeRef Low
a
    If CmpOpr
CLe OneOrTwo
One ShortRelativeRef Low
a -> Word8 -> Put
putWord8 Word8
0x9e Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int16 -> Put
forall t. Binary t => t -> Put
put Int16
ShortRelativeRef Low
a

    If CmpOpr
CEq OneOrTwo
Two ShortRelativeRef Low
a -> Word8 -> Put
putWord8 Word8
0x9f Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int16 -> Put
forall t. Binary t => t -> Put
put Int16
ShortRelativeRef Low
a
    If CmpOpr
CNe OneOrTwo
Two ShortRelativeRef Low
a -> Word8 -> Put
putWord8 Word8
0xa0 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int16 -> Put
forall t. Binary t => t -> Put
put Int16
ShortRelativeRef Low
a
    If CmpOpr
CLt OneOrTwo
Two ShortRelativeRef Low
a -> Word8 -> Put
putWord8 Word8
0xa1 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int16 -> Put
forall t. Binary t => t -> Put
put Int16
ShortRelativeRef Low
a
    If CmpOpr
CGe OneOrTwo
Two ShortRelativeRef Low
a -> Word8 -> Put
putWord8 Word8
0xa2 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int16 -> Put
forall t. Binary t => t -> Put
put Int16
ShortRelativeRef Low
a
    If CmpOpr
CGt OneOrTwo
Two ShortRelativeRef Low
a -> Word8 -> Put
putWord8 Word8
0xa3 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int16 -> Put
forall t. Binary t => t -> Put
put Int16
ShortRelativeRef Low
a
    If CmpOpr
CLe OneOrTwo
Two ShortRelativeRef Low
a -> Word8 -> Put
putWord8 Word8
0xa4 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int16 -> Put
forall t. Binary t => t -> Put
put Int16
ShortRelativeRef Low
a

    IfRef Bool
True OneOrTwo
Two ShortRelativeRef Low
a -> Word8 -> Put
putWord8 Word8
0xa5 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int16 -> Put
forall t. Binary t => t -> Put
put Int16
ShortRelativeRef Low
a
    IfRef Bool
False OneOrTwo
Two ShortRelativeRef Low
a -> Word8 -> Put
putWord8 Word8
0xa6 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int16 -> Put
forall t. Binary t => t -> Put
put Int16
ShortRelativeRef Low
a

    Goto LongRelativeRef Low
a -> do
      if (Int32 -> Int32
forall a. Num a => a -> a
abs Int32
LongRelativeRef Low
a) Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
< (Int32
2 :: Int32) Int32 -> Int32 -> Int32
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int32
15 :: Int32) then do
        Word8 -> Put
putWord8 Word8
0xa7
        Int16 -> Put
putInt16be (Int32 -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
LongRelativeRef Low
a)
      else do
        Word8 -> Put
putWord8 Word8
0xc8
        Int32 -> Put
putInt32be Int32
LongRelativeRef Low
a
    Jsr LongRelativeRef Low
a ->
      if (Int32 -> Int32
forall a. Num a => a -> a
abs Int32
LongRelativeRef Low
a) Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
< (Int32
2 :: Int32) Int32 -> Int32 -> Int32
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int32
15 :: Int32) then do
        Word8 -> Put
putWord8 Word8
0xa8
        Int16 -> Put
putInt16be (Int32 -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
LongRelativeRef Low
a)
      else do
        Word8 -> Put
putWord8 Word8
0xc9
        Int32 -> Put
putInt32be Int32
LongRelativeRef Low
a

    Ret ByteCodeOffset
a ->
      -- Check if correct size
      if ByteCodeOffset
a ByteCodeOffset -> ByteCodeOffset -> Bool
forall a. Ord a => a -> a -> Bool
<= ByteCodeOffset
maxWord8
      then do
        Word8 -> Put
putWord8 Word8
0xa9
        Word8 -> Put
putWord8 (ByteCodeOffset -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ByteCodeOffset
a)
      else do
        Word8 -> Put
putWord8 Word8
0xc4 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
putWord8 Word8
0xa9 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteCodeOffset -> Put
forall t. Binary t => t -> Put
put ByteCodeOffset
a

    TableSwitch LongRelativeRef Low
dft SwitchTable Low
table -> do
      Word8 -> Put
putWord8 Word8
0xaa
      -- missing pad
      Int -> Put -> Put
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ (ByteCodeOffset -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((ByteCodeOffset
4 ByteCodeOffset -> ByteCodeOffset -> ByteCodeOffset
forall a. Num a => a -> a -> a
- (ByteCodeOffset
n ByteCodeOffset -> ByteCodeOffset -> ByteCodeOffset
forall a. Num a => a -> a -> a
+ ByteCodeOffset
1) ByteCodeOffset -> ByteCodeOffset -> ByteCodeOffset
forall a. Integral a => a -> a -> a
`mod` ByteCodeOffset
4) ByteCodeOffset -> ByteCodeOffset -> ByteCodeOffset
forall a. Integral a => a -> a -> a
`mod` ByteCodeOffset
4)) (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$ Word8 -> Put
putWord8 Word8
0x00
      Int32 -> Put
putInt32be Int32
LongRelativeRef Low
dft
      Int32 -> Put
putInt32be (SwitchTable Low -> Int32
forall r. SwitchTable r -> Int32
switchLow SwitchTable Low
table)
      Int32 -> Put
putInt32be (SwitchTable Low -> Int32
switchHigh SwitchTable Low
table)
      (Int32 -> Put) -> Vector Int32 -> Put
forall (m :: * -> *) a b. Monad m => (a -> m b) -> Vector a -> m ()
V.mapM_ Int32 -> Put
putInt32be (SwitchTable Low -> Vector (LongRelativeRef Low)
forall r. SwitchTable r -> Vector (LongRelativeRef r)
switchOffsets SwitchTable Low
table)

    LookupSwitch LongRelativeRef Low
dft Vector (Int32, LongRelativeRef Low)
pairs -> do
      Word8 -> Put
putWord8 Word8
0xab
      Int -> Put -> Put
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ (ByteCodeOffset -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((ByteCodeOffset
4 ByteCodeOffset -> ByteCodeOffset -> ByteCodeOffset
forall a. Num a => a -> a -> a
- (ByteCodeOffset
n ByteCodeOffset -> ByteCodeOffset -> ByteCodeOffset
forall a. Num a => a -> a -> a
+ ByteCodeOffset
1) ByteCodeOffset -> ByteCodeOffset -> ByteCodeOffset
forall a. Integral a => a -> a -> a
`mod` ByteCodeOffset
4) ByteCodeOffset -> ByteCodeOffset -> ByteCodeOffset
forall a. Integral a => a -> a -> a
`mod` ByteCodeOffset
4)) (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$ Word8 -> Put
putWord8 Word8
0x00
      Int32 -> Put
putInt32be Int32
LongRelativeRef Low
dft
      Int32 -> Put
putInt32be (Int32 -> Put) -> (Int -> Int32) -> Int -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Put) -> Int -> Put
forall a b. (a -> b) -> a -> b
$ Vector (Int32, Int32) -> Int
forall a. Vector a -> Int
V.length Vector (Int32, Int32)
Vector (Int32, LongRelativeRef Low)
pairs
      ((Int32, Int32) -> Put) -> Vector (Int32, Int32) -> Put
forall (m :: * -> *) a b. Monad m => (a -> m b) -> Vector a -> m ()
V.mapM_ (Int32, Int32) -> Put
forall t. Binary t => t -> Put
put Vector (Int32, Int32)
Vector (Int32, LongRelativeRef Low)
pairs

    Return ( Just LocalType
LInt ) -> Word8 -> Put
putWord8 Word8
0xac
    Return ( Just LocalType
LLong ) -> Word8 -> Put
putWord8 Word8
0xad
    Return ( Just LocalType
LFloat ) -> Word8 -> Put
putWord8 Word8
0xae
    Return ( Just LocalType
LDouble ) -> Word8 -> Put
putWord8 Word8
0xaf
    Return ( Just LocalType
LRef ) -> Word8 -> Put
putWord8 Word8
0xb0
    Return Maybe LocalType
Nothing -> Word8 -> Put
putWord8 Word8
0xb1

    Get FieldAccess
FldStatic Ref AbsFieldId Low
a -> Word8 -> Put
putWord8 Word8
0xb2 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteCodeOffset -> Put
forall t. Binary t => t -> Put
put ByteCodeOffset
Ref AbsFieldId Low
a
    Put FieldAccess
FldStatic Ref AbsFieldId Low
a -> Word8 -> Put
putWord8 Word8
0xb3 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteCodeOffset -> Put
forall t. Binary t => t -> Put
put ByteCodeOffset
Ref AbsFieldId Low
a

    Get FieldAccess
FldField Ref AbsFieldId Low
a -> Word8 -> Put
putWord8 Word8
0xb4 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteCodeOffset -> Put
forall t. Binary t => t -> Put
put ByteCodeOffset
Ref AbsFieldId Low
a
    Put FieldAccess
FldField Ref AbsFieldId Low
a -> Word8 -> Put
putWord8 Word8
0xb5 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteCodeOffset -> Put
forall t. Binary t => t -> Put
put ByteCodeOffset
Ref AbsFieldId Low
a

    Invoke Invocation Low
i ->
      case Invocation Low
i of
        InvkVirtual Ref (InRefType MethodId) Low
a -> Word8 -> Put
putWord8 Word8
0xb6 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteCodeOffset -> Put
forall t. Binary t => t -> Put
put ByteCodeOffset
Ref (InRefType MethodId) Low
a
        InvkSpecial Ref AbsVariableMethodId Low
a -> Word8 -> Put
putWord8 Word8
0xb7 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteCodeOffset -> Put
forall t. Binary t => t -> Put
put ByteCodeOffset
Ref AbsVariableMethodId Low
a
        InvkStatic Ref AbsVariableMethodId Low
a -> Word8 -> Put
putWord8 Word8
0xb8 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteCodeOffset -> Put
forall t. Binary t => t -> Put
put ByteCodeOffset
Ref AbsVariableMethodId Low
a
        InvkInterface Word8
count Ref AbsInterfaceMethodId Low
a -> do
          Bool -> Put -> Put
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word8
count Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0) (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$ String -> Put
forall a. HasCallStack => String -> a
error String
"Should be not zero"
          Word8 -> Put
putWord8 Word8
0xb9
          ByteCodeOffset -> Put
forall t. Binary t => t -> Put
put ByteCodeOffset
Ref AbsInterfaceMethodId Low
a
          Word8 -> Put
forall t. Binary t => t -> Put
put Word8
count
          Word8 -> Put
putWord8 Word8
0
        InvkDynamic DeepRef InvokeDynamic Low
a ->
          Word8 -> Put
putWord8 Word8
0xba Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteCodeOffset -> Put
forall t. Binary t => t -> Put
put ByteCodeOffset
DeepRef InvokeDynamic Low
a Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
putWord8 Word8
0 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
putWord8 Word8
0

    New Ref ClassName Low
a -> Word8 -> Put
putWord8 Word8
0xbb Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteCodeOffset -> Put
forall t. Binary t => t -> Put
put ByteCodeOffset
Ref ClassName Low
a
    NewArray Choice LowNewArrayType NewArrayType Low
a ->
      case Choice LowNewArrayType NewArrayType Low
a of
        ArrayBaseType bt -> case JBaseType
bt of
          JBaseType
JTBoolean -> Word8 -> Put
putWord8 Word8
0xbc Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
putWord8 Word8
4
          JBaseType
JTChar    -> Word8 -> Put
putWord8 Word8
0xbc Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
putWord8 Word8
5
          JBaseType
JTFloat   -> Word8 -> Put
putWord8 Word8
0xbc Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
putWord8 Word8
6
          JBaseType
JTDouble  -> Word8 -> Put
putWord8 Word8
0xbc Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
putWord8 Word8
7
          JBaseType
JTByte    -> Word8 -> Put
putWord8 Word8
0xbc Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
putWord8 Word8
8
          JBaseType
JTShort   -> Word8 -> Put
putWord8 Word8
0xbc Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
putWord8 Word8
9
          JBaseType
JTInt     -> Word8 -> Put
putWord8 Word8
0xbc Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
putWord8 Word8
10
          JBaseType
JTLong    -> Word8 -> Put
putWord8 Word8
0xbc Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
putWord8 Word8
11
        ArrayReference p 1 -> Word8 -> Put
putWord8 Word8
0xbd Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteCodeOffset -> Put
forall t. Binary t => t -> Put
put ByteCodeOffset
Ref JRefType Low
p
        ArrayReference p n -> Word8 -> Put
putWord8 Word8
0xc5 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteCodeOffset -> Put
forall t. Binary t => t -> Put
put ByteCodeOffset
Ref JRefType Low
p Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
forall t. Binary t => t -> Put
put Word8
n

    ByteCodeOpr Low
ArrayLength -> Word8 -> Put
putWord8 Word8
0xbe
    ByteCodeOpr Low
Throw -> Word8 -> Put
putWord8 Word8
0xbf

    CheckCast Ref JRefType Low
a -> Word8 -> Put
putWord8 Word8
0xc0 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteCodeOffset -> Put
forall t. Binary t => t -> Put
put ByteCodeOffset
Ref JRefType Low
a
    InstanceOf Ref JRefType Low
a -> Word8 -> Put
putWord8 Word8
0xc1 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteCodeOffset -> Put
forall t. Binary t => t -> Put
put ByteCodeOffset
Ref JRefType Low
a

    Monitor Bool
True -> Word8 -> Put
putWord8 Word8
0xc2
    Monitor Bool
False -> Word8 -> Put
putWord8 Word8
0xc3


    IfRef Bool
False OneOrTwo
One ShortRelativeRef Low
a -> Word8 -> Put
putWord8 Word8
0xc6 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int16 -> Put
forall t. Binary t => t -> Put
put Int16
ShortRelativeRef Low
a
    IfRef Bool
True OneOrTwo
One ShortRelativeRef Low
a -> Word8 -> Put
putWord8 Word8
0xc7 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int16 -> Put
forall t. Binary t => t -> Put
put Int16
ShortRelativeRef Low
a

instance Eq (ByteCode High) where
  ByteCode Word32
_ Vector (ByteCodeInst High)
a == :: ByteCode High -> ByteCode High -> Bool
== ByteCode Word32
_ Vector (ByteCodeInst High)
b =
    Vector (ByteCodeInst High)
a Vector (ByteCodeInst High) -> Vector (ByteCodeInst High) -> Bool
forall a. Eq a => a -> a -> Bool
== Vector (ByteCodeInst High)
b

instance Eq (ByteCode Low) where
  ByteCode Word32
i Vector (ByteCodeInst Low)
a == :: ByteCode Low -> ByteCode Low -> Bool
== ByteCode Word32
j Vector (ByteCodeInst Low)
b =
    Word32
i Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
j Bool -> Bool -> Bool
&& Vector (ByteCodeInst Low)
a Vector (ByteCodeInst Low) -> Vector (ByteCodeInst Low) -> Bool
forall a. Eq a => a -> a -> Bool
== Vector (ByteCodeInst Low)
b

deriving instance Ord (ByteCode Low)

instance Eq (ByteCodeInst High) where
  ByteCodeInst ByteCodeOffset
_ ByteCodeOpr High
a == :: ByteCodeInst High -> ByteCodeInst High -> Bool
== ByteCodeInst ByteCodeOffset
_ ByteCodeOpr High
b =
    ByteCodeOpr High
a ByteCodeOpr High -> ByteCodeOpr High -> Bool
forall a. Eq a => a -> a -> Bool
== ByteCodeOpr High
b

instance Eq (ByteCodeInst Low) where
  ByteCodeInst ByteCodeOffset
i ByteCodeOpr Low
a == :: ByteCodeInst Low -> ByteCodeInst Low -> Bool
== ByteCodeInst ByteCodeOffset
j ByteCodeOpr Low
b =
    ByteCodeOffset
i ByteCodeOffset -> ByteCodeOffset -> Bool
forall a. Eq a => a -> a -> Bool
== ByteCodeOffset
j Bool -> Bool -> Bool
&& ByteCodeOpr Low
a ByteCodeOpr Low -> ByteCodeOpr Low -> Bool
forall a. Eq a => a -> a -> Bool
== ByteCodeOpr Low
b

deriving instance Ord (ByteCodeInst Low)

$(deriveThese ''ByteCode [''Show, ''Generic, ''NFData])
$(deriveThese ''ByteCodeInst [''Show, ''Generic, ''NFData])
$(deriveBase ''ByteCodeOpr)
$(deriveBase ''SwitchTable)
$(deriveBase ''Invocation)
$(deriveBase ''CConstant)