{-# LANGUAGE DeriveAnyClass      #-}
{-# LANGUAGE DeriveGeneric       #-}
{-# LANGUAGE FlexibleInstances   #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving  #-}
{-# LANGUAGE TemplateHaskell     #-}
{-# LANGUAGE LambdaCase          #-}
{-|
Module      : Language.JVM.Attribute.StackMapTable
Copyright   : (c) Christian Gram Kalhauge, 2018
License     : MIT
Maintainer  : kalhuage@cs.ucla.edu

Based on the StackMapTable Attribute,
as documented [here](http://docs.oracle.com/javase/specs/jvms/se8/html/jvms-4.html#jvms-4.7.4).

-}

module Language.JVM.Attribute.StackMapTable
  ( StackMapTable (..)
  , DeltaOffset
  , StackMapFrame (..)
  , StackMapFrameType (..)
  , emptyStackMapTable

  , VerificationTypeInfo (..)

  -- * Helper functions
  , offsetDelta
  , offsetDeltaInv
  ) where

import           Control.Monad               (replicateM)
import           Data.Binary
import           Data.Binary.Get             hiding (label)
import           Data.Binary.Put
import           Data.Foldable
import           Numeric
import           Unsafe.Coerce

import           Language.JVM.Attribute.Base
import           Language.JVM.ByteCode
import           Language.JVM.Constant
import           Language.JVM.Staged
import           Language.JVM.Type
import           Language.JVM.Utils

-- | 'StackMapTable' is an Attribute.
instance IsAttribute (StackMapTable Low) where
  attrName :: Const Text (StackMapTable Low)
attrName = Text -> Const Text (StackMapTable Low)
forall k a (b :: k). a -> Const a b
Const Text
"StackMapTable"

-- | An Exceptions attribute is a list of references into the
-- constant pool.
newtype StackMapTable r = StackMapTable
  { StackMapTable r
-> Choice (SizedList16 (StackMapFrame Low)) [StackMapFrame High] r
stackMapTable :: Choice (SizedList16 (StackMapFrame Low)) [StackMapFrame High] r
  }

emptyStackMapTable :: StackMapTable High
emptyStackMapTable :: StackMapTable High
emptyStackMapTable = Choice (SizedList16 (StackMapFrame Low)) [StackMapFrame High] High
-> StackMapTable High
forall r.
Choice (SizedList16 (StackMapFrame Low)) [StackMapFrame High] r
-> StackMapTable r
StackMapTable []

-- | A delta offset
type DeltaOffset i = Choice Word16 Int i

-- | An stack map frame
data StackMapFrame r = StackMapFrame
  { StackMapFrame r -> DeltaOffset r
deltaOffset :: DeltaOffset r
  , StackMapFrame r -> StackMapFrameType r
frameType   :: StackMapFrameType r
  }

-- | An stack map frame type
data StackMapFrameType r
  = SameFrame
  | SameLocals1StackItemFrame (VerificationTypeInfo r)
  | ChopFrame Word8
  | AppendFrame [VerificationTypeInfo r]
  | FullFrame
      (SizedList16 (VerificationTypeInfo r))
      (SizedList16 (VerificationTypeInfo r))

instance Binary (StackMapFrame Low) where
  get :: Get (StackMapFrame Low)
get = do
    Word8
ft <- Get Word8
getWord8
    let
      framegetter :: Get (StackMapFrame Low)
framegetter
        | Word8
0 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
ft Bool -> Bool -> Bool
&& Word8
ft Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
63
        = StackMapFrame Low -> Get (StackMapFrame Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (StackMapFrame Low -> Get (StackMapFrame Low))
-> StackMapFrame Low -> Get (StackMapFrame Low)
forall a b. (a -> b) -> a -> b
$ DeltaOffset Low -> StackMapFrameType Low -> StackMapFrame Low
forall r. DeltaOffset r -> StackMapFrameType r -> StackMapFrame r
StackMapFrame (Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
ft) StackMapFrameType Low
forall r. StackMapFrameType r
SameFrame

        | Word8
64 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
ft Bool -> Bool -> Bool
&& Word8
ft Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
127
        = DeltaOffset Low -> StackMapFrameType Low -> StackMapFrame Low
forall r. DeltaOffset r -> StackMapFrameType r -> StackMapFrame r
StackMapFrame (Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word16) -> Word8 -> Word16
forall a b. (a -> b) -> a -> b
$ Word8
ft Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
64) (StackMapFrameType Low -> StackMapFrame Low)
-> (VerificationTypeInfo Low -> StackMapFrameType Low)
-> VerificationTypeInfo Low
-> StackMapFrame Low
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerificationTypeInfo Low -> StackMapFrameType Low
forall r. VerificationTypeInfo r -> StackMapFrameType r
SameLocals1StackItemFrame (VerificationTypeInfo Low -> StackMapFrame Low)
-> Get (VerificationTypeInfo Low) -> Get (StackMapFrame Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (VerificationTypeInfo Low)
forall t. Binary t => Get t
get

        | Word8
128 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
ft Bool -> Bool -> Bool
&& Word8
ft Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
246
        = String -> Get (StackMapFrame Low)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get (StackMapFrame Low))
-> String -> Get (StackMapFrame Low)
forall a b. (a -> b) -> a -> b
$ String
"Reserved for further use: '0x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String -> String
forall a. (Integral a, Show a) => a -> String -> String
showHex Word8
ft String
"'"

        | Word8
ft Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
247
        = Word16 -> StackMapFrameType Low -> StackMapFrame Low
forall r. DeltaOffset r -> StackMapFrameType r -> StackMapFrame r
StackMapFrame (Word16 -> StackMapFrameType Low -> StackMapFrame Low)
-> Get Word16 -> Get (StackMapFrameType Low -> StackMapFrame Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16be Get (StackMapFrameType Low -> StackMapFrame Low)
-> Get (StackMapFrameType Low) -> Get (StackMapFrame Low)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (VerificationTypeInfo Low -> StackMapFrameType Low
forall r. VerificationTypeInfo r -> StackMapFrameType r
SameLocals1StackItemFrame (VerificationTypeInfo Low -> StackMapFrameType Low)
-> Get (VerificationTypeInfo Low) -> Get (StackMapFrameType Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (VerificationTypeInfo Low)
forall t. Binary t => Get t
get)

        | Word8
248 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
ft Bool -> Bool -> Bool
&& Word8
ft Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
250
        = Word16 -> StackMapFrameType Low -> StackMapFrame Low
forall r. DeltaOffset r -> StackMapFrameType r -> StackMapFrame r
StackMapFrame (Word16 -> StackMapFrameType Low -> StackMapFrame Low)
-> Get Word16 -> Get (StackMapFrameType Low -> StackMapFrame Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16be Get (StackMapFrameType Low -> StackMapFrame Low)
-> Get (StackMapFrameType Low) -> Get (StackMapFrame Low)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StackMapFrameType Low -> Get (StackMapFrameType Low)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word8 -> StackMapFrameType Low
forall r. Word8 -> StackMapFrameType r
ChopFrame (Word8
251 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
ft))

        | Word8
ft Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
251
        = Word16 -> StackMapFrameType Low -> StackMapFrame Low
forall r. DeltaOffset r -> StackMapFrameType r -> StackMapFrame r
StackMapFrame (Word16 -> StackMapFrameType Low -> StackMapFrame Low)
-> Get Word16 -> Get (StackMapFrameType Low -> StackMapFrame Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16be Get (StackMapFrameType Low -> StackMapFrame Low)
-> Get (StackMapFrameType Low) -> Get (StackMapFrame Low)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StackMapFrameType Low -> Get (StackMapFrameType Low)
forall (f :: * -> *) a. Applicative f => a -> f a
pure StackMapFrameType Low
forall r. StackMapFrameType r
SameFrame

        | Word8
252 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
ft Bool -> Bool -> Bool
&& Word8
ft Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
254
        = do
            Word16
offset' <- Get Word16
getWord16be
            [VerificationTypeInfo Low]
locals <- Int
-> Get (VerificationTypeInfo Low) -> Get [VerificationTypeInfo Low]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> Word8 -> Int
forall a b. (a -> b) -> a -> b
$ Word8
ft Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
251) Get (VerificationTypeInfo Low)
forall t. Binary t => Get t
get
            StackMapFrame Low -> Get (StackMapFrame Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (StackMapFrame Low -> Get (StackMapFrame Low))
-> StackMapFrame Low -> Get (StackMapFrame Low)
forall a b. (a -> b) -> a -> b
$ DeltaOffset Low -> StackMapFrameType Low -> StackMapFrame Low
forall r. DeltaOffset r -> StackMapFrameType r -> StackMapFrame r
StackMapFrame Word16
DeltaOffset Low
offset' ([VerificationTypeInfo Low] -> StackMapFrameType Low
forall r. [VerificationTypeInfo r] -> StackMapFrameType r
AppendFrame [VerificationTypeInfo Low]
locals)

        | Word8
ft Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
255
        = Word16 -> StackMapFrameType Low -> StackMapFrame Low
forall r. DeltaOffset r -> StackMapFrameType r -> StackMapFrame r
StackMapFrame (Word16 -> StackMapFrameType Low -> StackMapFrame Low)
-> Get Word16 -> Get (StackMapFrameType Low -> StackMapFrame Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16be Get (StackMapFrameType Low -> StackMapFrame Low)
-> Get (StackMapFrameType Low) -> Get (StackMapFrame Low)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (SizedList16 (VerificationTypeInfo Low)
-> SizedList16 (VerificationTypeInfo Low) -> StackMapFrameType Low
forall r.
SizedList16 (VerificationTypeInfo r)
-> SizedList16 (VerificationTypeInfo r) -> StackMapFrameType r
FullFrame (SizedList16 (VerificationTypeInfo Low)
 -> SizedList16 (VerificationTypeInfo Low) -> StackMapFrameType Low)
-> Get (SizedList16 (VerificationTypeInfo Low))
-> Get
     (SizedList16 (VerificationTypeInfo Low) -> StackMapFrameType Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (SizedList16 (VerificationTypeInfo Low))
forall t. Binary t => Get t
get Get
  (SizedList16 (VerificationTypeInfo Low) -> StackMapFrameType Low)
-> Get (SizedList16 (VerificationTypeInfo Low))
-> Get (StackMapFrameType Low)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get (SizedList16 (VerificationTypeInfo Low))
forall t. Binary t => Get t
get)

        | Bool
otherwise
        = String -> Get (StackMapFrame Low)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get (StackMapFrame Low))
-> String -> Get (StackMapFrame Low)
forall a b. (a -> b) -> a -> b
$ String
"Unknown frame type '0x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String -> String
forall a. (Integral a, Show a) => a -> String -> String
showHex Word8
ft String
"'"
    Get (StackMapFrame Low)
framegetter

  put :: StackMapFrame Low -> Put
put (StackMapFrame DeltaOffset Low
off StackMapFrameType Low
frame) =
    case StackMapFrameType Low
frame of
      StackMapFrameType Low
SameFrame
        | Word16
DeltaOffset Low
off Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word16
63 ->
            Word8 -> Put
putWord8 (Word16 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
DeltaOffset Low
off)
        | Bool
otherwise -> do
            Word8 -> Put
putWord8 Word8
251
            Word16 -> Put
putWord16be Word16
DeltaOffset Low
off

      SameLocals1StackItemFrame VerificationTypeInfo Low
vt
        | Word16
DeltaOffset Low
off Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word16
63 -> do
            Word8 -> Put
putWord8 (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$ Word16 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16
64 Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word16
DeltaOffset Low
off)
            VerificationTypeInfo Low -> Put
forall t. Binary t => t -> Put
put VerificationTypeInfo Low
vt
        | Bool
otherwise -> do
            Word8 -> Put
putWord8 Word8
247
            Word16 -> Put
putWord16be Word16
DeltaOffset Low
off
            VerificationTypeInfo Low -> Put
forall t. Binary t => t -> Put
put VerificationTypeInfo Low
vt

      ChopFrame Word8
w
        | Word8
0 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
w Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
3 -> do
          Word8 -> Put
putWord8 (Word8
251 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
w)
          Word16 -> Put
putWord16be Word16
DeltaOffset Low
off
        | Bool
otherwise ->
          String -> Put
forall a. HasCallStack => String -> a
error (String -> Put) -> String -> Put
forall a b. (a -> b) -> a -> b
$ String
"Can't write a cutoff value outside ]0,3], but was: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
w

      AppendFrame [VerificationTypeInfo Low]
vs
        | [VerificationTypeInfo Low] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [VerificationTypeInfo Low]
vs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
3 Bool -> Bool -> Bool
&& Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [VerificationTypeInfo Low] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [VerificationTypeInfo Low]
vs -> do
          Word8 -> Put
putWord8 (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Int
251 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [VerificationTypeInfo Low] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [VerificationTypeInfo Low]
vs)
          Word16 -> Put
putWord16be Word16
DeltaOffset Low
off
          (VerificationTypeInfo Low -> Put)
-> [VerificationTypeInfo Low] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ VerificationTypeInfo Low -> Put
forall t. Binary t => t -> Put
put [VerificationTypeInfo Low]
vs
        | Bool
otherwise ->
          String -> Put
forall a. HasCallStack => String -> a
error (String -> Put) -> String -> Put
forall a b. (a -> b) -> a -> b
$ String
"The AppendFrame has to contain at least 1 and at most 3 elements: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [VerificationTypeInfo Low] -> String
forall a. Show a => a -> String
show [VerificationTypeInfo Low]
vs

      FullFrame SizedList16 (VerificationTypeInfo Low)
ls1 SizedList16 (VerificationTypeInfo Low)
ls2 -> do
        Word8 -> Put
putWord8 Word8
255
        Word16 -> Put
putWord16be Word16
DeltaOffset Low
off
        SizedList16 (VerificationTypeInfo Low) -> Put
forall t. Binary t => t -> Put
put SizedList16 (VerificationTypeInfo Low)
ls1
        SizedList16 (VerificationTypeInfo Low) -> Put
forall t. Binary t => t -> Put
put SizedList16 (VerificationTypeInfo Low)
ls2

-- | The types info of the stack map frame.
data VerificationTypeInfo r
  = VTTop
  | VTInteger
  | VTFloat
  | VTLong
  | VTDouble
  | VTNull
  | VTUninitializedThis
  | VTObject !(Ref JRefType r)
  | VTUninitialized !(ByteCodeRef r)
    -- ^ This 'ByteCodeRef' refers to the "new" bytcode instruction
    -- which created the object.

instance Binary (VerificationTypeInfo Low) where
  get :: Get (VerificationTypeInfo Low)
get = Get Word8
getWord8 Get Word8
-> (Word8 -> Get (VerificationTypeInfo Low))
-> Get (VerificationTypeInfo Low)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Word8
0 -> VerificationTypeInfo Low -> Get (VerificationTypeInfo Low)
forall (f :: * -> *) a. Applicative f => a -> f a
pure VerificationTypeInfo Low
forall r. VerificationTypeInfo r
VTTop
    Word8
1 -> VerificationTypeInfo Low -> Get (VerificationTypeInfo Low)
forall (f :: * -> *) a. Applicative f => a -> f a
pure VerificationTypeInfo Low
forall r. VerificationTypeInfo r
VTInteger
    Word8
2 -> VerificationTypeInfo Low -> Get (VerificationTypeInfo Low)
forall (f :: * -> *) a. Applicative f => a -> f a
pure VerificationTypeInfo Low
forall r. VerificationTypeInfo r
VTFloat
    Word8
3 -> VerificationTypeInfo Low -> Get (VerificationTypeInfo Low)
forall (f :: * -> *) a. Applicative f => a -> f a
pure VerificationTypeInfo Low
forall r. VerificationTypeInfo r
VTLong
    Word8
4 -> VerificationTypeInfo Low -> Get (VerificationTypeInfo Low)
forall (f :: * -> *) a. Applicative f => a -> f a
pure VerificationTypeInfo Low
forall r. VerificationTypeInfo r
VTDouble
    Word8
5 -> VerificationTypeInfo Low -> Get (VerificationTypeInfo Low)
forall (f :: * -> *) a. Applicative f => a -> f a
pure VerificationTypeInfo Low
forall r. VerificationTypeInfo r
VTNull
    Word8
6 -> VerificationTypeInfo Low -> Get (VerificationTypeInfo Low)
forall (f :: * -> *) a. Applicative f => a -> f a
pure VerificationTypeInfo Low
forall r. VerificationTypeInfo r
VTUninitializedThis
    Word8
7 -> Word16 -> VerificationTypeInfo Low
forall r. Ref JRefType r -> VerificationTypeInfo r
VTObject (Word16 -> VerificationTypeInfo Low)
-> Get Word16 -> Get (VerificationTypeInfo Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
forall t. Binary t => Get t
get
    Word8
8 -> Word16 -> VerificationTypeInfo Low
forall r. ByteCodeRef r -> VerificationTypeInfo r
VTUninitialized (Word16 -> VerificationTypeInfo Low)
-> Get Word16 -> Get (VerificationTypeInfo Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
forall t. Binary t => Get t
get
    Word8
tag -> String -> Get (VerificationTypeInfo Low)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get (VerificationTypeInfo Low))
-> String -> Get (VerificationTypeInfo Low)
forall a b. (a -> b) -> a -> b
$ String
"Unexpected tag : '0x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String -> String
forall a. (Integral a, Show a) => a -> String -> String
showHex Word8
tag String
"'"

  put :: VerificationTypeInfo Low -> Put
put = \case
    VerificationTypeInfo Low
VTTop               -> Word8 -> Put
putWord8 Word8
0
    VerificationTypeInfo Low
VTInteger           -> Word8 -> Put
putWord8 Word8
1
    VerificationTypeInfo Low
VTFloat             -> Word8 -> Put
putWord8 Word8
2
    VerificationTypeInfo Low
VTLong              -> Word8 -> Put
putWord8 Word8
3
    VerificationTypeInfo Low
VTDouble            -> Word8 -> Put
putWord8 Word8
4
    VerificationTypeInfo Low
VTNull              -> Word8 -> Put
putWord8 Word8
5
    VerificationTypeInfo Low
VTUninitializedThis -> Word8 -> Put
putWord8 Word8
6
    VTObject Ref JRefType Low
s          -> do Word8 -> Put
putWord8 Word8
7; Word16 -> Put
forall t. Binary t => t -> Put
put Word16
Ref JRefType Low
s
    VTUninitialized DeltaOffset Low
s   -> do Word8 -> Put
putWord8 Word8
8; Word16 -> Put
forall t. Binary t => t -> Put
put Word16
DeltaOffset Low
s

instance ByteCodeStaged StackMapTable where
  evolveBC :: (Word16 -> m Int) -> StackMapTable Low -> m (StackMapTable High)
evolveBC Word16 -> m Int
f (StackMapTable Choice (SizedList16 (StackMapFrame Low)) [StackMapFrame High] Low
ls) =
    String -> m (StackMapTable High) -> m (StackMapTable High)
forall (m :: * -> *) a. LabelM m => String -> m a -> m a
label String
"StackMapTable" (m (StackMapTable High) -> m (StackMapTable High))
-> m (StackMapTable High) -> m (StackMapTable High)
forall a b. (a -> b) -> a -> b
$
    [StackMapFrame High] -> StackMapTable High
forall r.
Choice (SizedList16 (StackMapFrame Low)) [StackMapFrame High] r
-> StackMapTable r
StackMapTable ([StackMapFrame High] -> StackMapTable High)
-> ((Word16, [StackMapFrame High]) -> [StackMapFrame High])
-> (Word16, [StackMapFrame High])
-> StackMapTable High
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [StackMapFrame High] -> [StackMapFrame High]
forall a. [a] -> [a]
reverse ([StackMapFrame High] -> [StackMapFrame High])
-> ((Word16, [StackMapFrame High]) -> [StackMapFrame High])
-> (Word16, [StackMapFrame High])
-> [StackMapFrame High]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word16, [StackMapFrame High]) -> [StackMapFrame High]
forall a b. (a, b) -> b
snd ((Word16, [StackMapFrame High]) -> StackMapTable High)
-> m (Word16, [StackMapFrame High]) -> m (StackMapTable High)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (m (Word16, [StackMapFrame High])
 -> StackMapFrame Low -> m (Word16, [StackMapFrame High]))
-> m (Word16, [StackMapFrame High])
-> SizedList16 (StackMapFrame Low)
-> m (Word16, [StackMapFrame High])
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' m (Word16, [StackMapFrame High])
-> StackMapFrame Low -> m (Word16, [StackMapFrame High])
acc ((Word16, [StackMapFrame High]) -> m (Word16, [StackMapFrame High])
forall (m :: * -> *) a. Monad m => a -> m a
return (Word16
0, [])) Choice (SizedList16 (StackMapFrame Low)) [StackMapFrame High] Low
SizedList16 (StackMapFrame Low)
ls
    where
      acc :: m (Word16, [StackMapFrame High])
-> StackMapFrame Low -> m (Word16, [StackMapFrame High])
acc m (Word16, [StackMapFrame High])
a (StackMapFrame DeltaOffset Low
delta StackMapFrameType Low
frm) = do
        (Word16
lidx, [StackMapFrame High]
lst) <- m (Word16, [StackMapFrame High])
a
        StackMapFrameType High
frm' <- (Word16 -> m Int)
-> StackMapFrameType Low -> m (StackMapFrameType High)
forall (s :: * -> *) (m :: * -> *).
(ByteCodeStaged s, EvolveM m) =>
(Word16 -> m Int) -> s Low -> m (s High)
evolveBC Word16 -> m Int
f StackMapFrameType Low
frm
        let bco :: Word16
bco = if [StackMapFrame High]
lst [StackMapFrame High] -> [StackMapFrame High] -> Bool
forall a. Eq a => a -> a -> Bool
/= [] then Word16 -> Word16 -> Word16
offsetDelta Word16
lidx Word16
DeltaOffset Low
delta else Word16
DeltaOffset Low
delta
        Int
x <- Word16 -> m Int
f Word16
bco
        (Word16, [StackMapFrame High]) -> m (Word16, [StackMapFrame High])
forall (m :: * -> *) a. Monad m => a -> m a
return (Word16
bco, DeltaOffset High -> StackMapFrameType High -> StackMapFrame High
forall r. DeltaOffset r -> StackMapFrameType r -> StackMapFrame r
StackMapFrame Int
DeltaOffset High
x StackMapFrameType High
frm' StackMapFrame High -> [StackMapFrame High] -> [StackMapFrame High]
forall a. a -> [a] -> [a]
: [StackMapFrame High]
lst)

  devolveBC :: (Int -> m Word16) -> StackMapTable High -> m (StackMapTable Low)
devolveBC Int -> m Word16
f (StackMapTable Choice (SizedList16 (StackMapFrame Low)) [StackMapFrame High] High
ls) =
    String -> m (StackMapTable Low) -> m (StackMapTable Low)
forall (m :: * -> *) a. LabelM m => String -> m a -> m a
label String
"StackMapTable" (m (StackMapTable Low) -> m (StackMapTable Low))
-> m (StackMapTable Low) -> m (StackMapTable Low)
forall a b. (a -> b) -> a -> b
$
    SizedList16 (StackMapFrame Low) -> StackMapTable Low
forall r.
Choice (SizedList16 (StackMapFrame Low)) [StackMapFrame High] r
-> StackMapTable r
StackMapTable (SizedList16 (StackMapFrame Low) -> StackMapTable Low)
-> ((Word16, [StackMapFrame Low])
    -> SizedList16 (StackMapFrame Low))
-> (Word16, [StackMapFrame Low])
-> StackMapTable Low
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [StackMapFrame Low] -> SizedList16 (StackMapFrame Low)
forall w a. [a] -> SizedList w a
SizedList ([StackMapFrame Low] -> SizedList16 (StackMapFrame Low))
-> ((Word16, [StackMapFrame Low]) -> [StackMapFrame Low])
-> (Word16, [StackMapFrame Low])
-> SizedList16 (StackMapFrame Low)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [StackMapFrame Low] -> [StackMapFrame Low]
forall a. [a] -> [a]
reverse ([StackMapFrame Low] -> [StackMapFrame Low])
-> ((Word16, [StackMapFrame Low]) -> [StackMapFrame Low])
-> (Word16, [StackMapFrame Low])
-> [StackMapFrame Low]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word16, [StackMapFrame Low]) -> [StackMapFrame Low]
forall a b. (a, b) -> b
snd ((Word16, [StackMapFrame Low]) -> StackMapTable Low)
-> m (Word16, [StackMapFrame Low]) -> m (StackMapTable Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (m (Word16, [StackMapFrame Low])
 -> StackMapFrame High -> m (Word16, [StackMapFrame Low]))
-> m (Word16, [StackMapFrame Low])
-> [StackMapFrame High]
-> m (Word16, [StackMapFrame Low])
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' m (Word16, [StackMapFrame Low])
-> StackMapFrame High -> m (Word16, [StackMapFrame Low])
acc ((Word16, [StackMapFrame Low]) -> m (Word16, [StackMapFrame Low])
forall (m :: * -> *) a. Monad m => a -> m a
return (Word16
0 :: Word16, [])) [StackMapFrame High]
Choice (SizedList16 (StackMapFrame Low)) [StackMapFrame High] High
ls
    where
      acc :: m (Word16, [StackMapFrame Low])
-> StackMapFrame High -> m (Word16, [StackMapFrame Low])
acc m (Word16, [StackMapFrame Low])
a (StackMapFrame DeltaOffset High
x StackMapFrameType High
frm) = do
        (Word16
lidx, [StackMapFrame Low]
lst) <- m (Word16, [StackMapFrame Low])
a
        StackMapFrameType Low
frm' <- (Int -> m Word16)
-> StackMapFrameType High -> m (StackMapFrameType Low)
forall (s :: * -> *) (m :: * -> *).
(ByteCodeStaged s, DevolveM m) =>
(Int -> m Word16) -> s High -> m (s Low)
devolveBC Int -> m Word16
f StackMapFrameType High
frm
        Word16
tidx <- Int -> m Word16
f Int
DeltaOffset High
x
        let delta :: Word16
delta = if [StackMapFrame Low]
lst [StackMapFrame Low] -> [StackMapFrame Low] -> Bool
forall a. Eq a => a -> a -> Bool
/= [] then Word16 -> Word16 -> Word16
offsetDeltaInv Word16
lidx Word16
tidx else Word16
tidx
        (Word16, [StackMapFrame Low]) -> m (Word16, [StackMapFrame Low])
forall (m :: * -> *) a. Monad m => a -> m a
return (Word16
tidx, DeltaOffset Low -> StackMapFrameType Low -> StackMapFrame Low
forall r. DeltaOffset r -> StackMapFrameType r -> StackMapFrame r
StackMapFrame Word16
DeltaOffset Low
delta StackMapFrameType Low
frm' StackMapFrame Low -> [StackMapFrame Low] -> [StackMapFrame Low]
forall a. a -> [a] -> [a]
: [StackMapFrame Low]
lst)


offsetDelta ::
  Word16
  -- ^ Last Index
  -> Word16
  -- ^ Delta
  -> Word16
  -- ^ This Index
offsetDelta :: Word16 -> Word16 -> Word16
offsetDelta Word16
lidx Word16
delta
  = Word16
lidx Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word16
delta Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word16
1

offsetDeltaInv ::
  Word16
  -- ^ Last Index
  -> Word16
  -- ^ Current Index
  -> Word16
  -- ^ Delta
offsetDeltaInv :: Word16 -> Word16 -> Word16
offsetDeltaInv Word16
lidx Word16
tidx
  = Word16
tidx Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
- Word16
lidx Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
- Word16
1

instance ByteCodeStaged StackMapFrameType where
  evolveBC :: (Word16 -> m Int)
-> StackMapFrameType Low -> m (StackMapFrameType High)
evolveBC Word16 -> m Int
f StackMapFrameType Low
x =
    case StackMapFrameType Low
x of
      SameLocals1StackItemFrame VerificationTypeInfo Low
a ->
        VerificationTypeInfo High -> StackMapFrameType High
forall r. VerificationTypeInfo r -> StackMapFrameType r
SameLocals1StackItemFrame (VerificationTypeInfo High -> StackMapFrameType High)
-> m (VerificationTypeInfo High) -> m (StackMapFrameType High)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word16 -> m Int)
-> VerificationTypeInfo Low -> m (VerificationTypeInfo High)
forall (s :: * -> *) (m :: * -> *).
(ByteCodeStaged s, EvolveM m) =>
(Word16 -> m Int) -> s Low -> m (s High)
evolveBC Word16 -> m Int
f VerificationTypeInfo Low
a
      AppendFrame [VerificationTypeInfo Low]
ls ->
        [VerificationTypeInfo High] -> StackMapFrameType High
forall r. [VerificationTypeInfo r] -> StackMapFrameType r
AppendFrame ([VerificationTypeInfo High] -> StackMapFrameType High)
-> m [VerificationTypeInfo High] -> m (StackMapFrameType High)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (VerificationTypeInfo Low -> m (VerificationTypeInfo High))
-> [VerificationTypeInfo Low] -> m [VerificationTypeInfo High]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Word16 -> m Int)
-> VerificationTypeInfo Low -> m (VerificationTypeInfo High)
forall (s :: * -> *) (m :: * -> *).
(ByteCodeStaged s, EvolveM m) =>
(Word16 -> m Int) -> s Low -> m (s High)
evolveBC Word16 -> m Int
f) [VerificationTypeInfo Low]
ls
      FullFrame SizedList16 (VerificationTypeInfo Low)
bs SizedList16 (VerificationTypeInfo Low)
as ->
        SizedList16 (VerificationTypeInfo High)
-> SizedList16 (VerificationTypeInfo High)
-> StackMapFrameType High
forall r.
SizedList16 (VerificationTypeInfo r)
-> SizedList16 (VerificationTypeInfo r) -> StackMapFrameType r
FullFrame (SizedList16 (VerificationTypeInfo High)
 -> SizedList16 (VerificationTypeInfo High)
 -> StackMapFrameType High)
-> m (SizedList16 (VerificationTypeInfo High))
-> m (SizedList16 (VerificationTypeInfo High)
      -> StackMapFrameType High)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (VerificationTypeInfo Low -> m (VerificationTypeInfo High))
-> SizedList16 (VerificationTypeInfo Low)
-> m (SizedList16 (VerificationTypeInfo High))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Word16 -> m Int)
-> VerificationTypeInfo Low -> m (VerificationTypeInfo High)
forall (s :: * -> *) (m :: * -> *).
(ByteCodeStaged s, EvolveM m) =>
(Word16 -> m Int) -> s Low -> m (s High)
evolveBC Word16 -> m Int
f) SizedList16 (VerificationTypeInfo Low)
bs m (SizedList16 (VerificationTypeInfo High)
   -> StackMapFrameType High)
-> m (SizedList16 (VerificationTypeInfo High))
-> m (StackMapFrameType High)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (VerificationTypeInfo Low -> m (VerificationTypeInfo High))
-> SizedList16 (VerificationTypeInfo Low)
-> m (SizedList16 (VerificationTypeInfo High))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Word16 -> m Int)
-> VerificationTypeInfo Low -> m (VerificationTypeInfo High)
forall (s :: * -> *) (m :: * -> *).
(ByteCodeStaged s, EvolveM m) =>
(Word16 -> m Int) -> s Low -> m (s High)
evolveBC Word16 -> m Int
f) SizedList16 (VerificationTypeInfo Low)
as
      StackMapFrameType Low
a ->
        StackMapFrameType High -> m (StackMapFrameType High)
forall (m :: * -> *) a. Monad m => a -> m a
return (StackMapFrameType High -> m (StackMapFrameType High))
-> StackMapFrameType High -> m (StackMapFrameType High)
forall a b. (a -> b) -> a -> b
$ StackMapFrameType Low -> StackMapFrameType High
forall a b. a -> b
unsafeCoerce StackMapFrameType Low
a

  devolveBC :: (Int -> m Word16)
-> StackMapFrameType High -> m (StackMapFrameType Low)
devolveBC Int -> m Word16
f StackMapFrameType High
x =
    case StackMapFrameType High
x of
      SameLocals1StackItemFrame VerificationTypeInfo High
a ->
        VerificationTypeInfo Low -> StackMapFrameType Low
forall r. VerificationTypeInfo r -> StackMapFrameType r
SameLocals1StackItemFrame (VerificationTypeInfo Low -> StackMapFrameType Low)
-> m (VerificationTypeInfo Low) -> m (StackMapFrameType Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> m Word16)
-> VerificationTypeInfo High -> m (VerificationTypeInfo Low)
forall (s :: * -> *) (m :: * -> *).
(ByteCodeStaged s, DevolveM m) =>
(Int -> m Word16) -> s High -> m (s Low)
devolveBC Int -> m Word16
f VerificationTypeInfo High
a
      AppendFrame [VerificationTypeInfo High]
ls ->
        [VerificationTypeInfo Low] -> StackMapFrameType Low
forall r. [VerificationTypeInfo r] -> StackMapFrameType r
AppendFrame ([VerificationTypeInfo Low] -> StackMapFrameType Low)
-> m [VerificationTypeInfo Low] -> m (StackMapFrameType Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (VerificationTypeInfo High -> m (VerificationTypeInfo Low))
-> [VerificationTypeInfo High] -> m [VerificationTypeInfo Low]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Int -> m Word16)
-> VerificationTypeInfo High -> m (VerificationTypeInfo Low)
forall (s :: * -> *) (m :: * -> *).
(ByteCodeStaged s, DevolveM m) =>
(Int -> m Word16) -> s High -> m (s Low)
devolveBC Int -> m Word16
f) [VerificationTypeInfo High]
ls
      FullFrame SizedList16 (VerificationTypeInfo High)
bs SizedList16 (VerificationTypeInfo High)
as ->
        SizedList16 (VerificationTypeInfo Low)
-> SizedList16 (VerificationTypeInfo Low) -> StackMapFrameType Low
forall r.
SizedList16 (VerificationTypeInfo r)
-> SizedList16 (VerificationTypeInfo r) -> StackMapFrameType r
FullFrame (SizedList16 (VerificationTypeInfo Low)
 -> SizedList16 (VerificationTypeInfo Low) -> StackMapFrameType Low)
-> m (SizedList16 (VerificationTypeInfo Low))
-> m (SizedList16 (VerificationTypeInfo Low)
      -> StackMapFrameType Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (VerificationTypeInfo High -> m (VerificationTypeInfo Low))
-> SizedList16 (VerificationTypeInfo High)
-> m (SizedList16 (VerificationTypeInfo Low))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Int -> m Word16)
-> VerificationTypeInfo High -> m (VerificationTypeInfo Low)
forall (s :: * -> *) (m :: * -> *).
(ByteCodeStaged s, DevolveM m) =>
(Int -> m Word16) -> s High -> m (s Low)
devolveBC Int -> m Word16
f) SizedList16 (VerificationTypeInfo High)
bs m (SizedList16 (VerificationTypeInfo Low) -> StackMapFrameType Low)
-> m (SizedList16 (VerificationTypeInfo Low))
-> m (StackMapFrameType Low)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (VerificationTypeInfo High -> m (VerificationTypeInfo Low))
-> SizedList16 (VerificationTypeInfo High)
-> m (SizedList16 (VerificationTypeInfo Low))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Int -> m Word16)
-> VerificationTypeInfo High -> m (VerificationTypeInfo Low)
forall (s :: * -> *) (m :: * -> *).
(ByteCodeStaged s, DevolveM m) =>
(Int -> m Word16) -> s High -> m (s Low)
devolveBC Int -> m Word16
f) SizedList16 (VerificationTypeInfo High)
as
      StackMapFrameType High
a ->
        StackMapFrameType Low -> m (StackMapFrameType Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (StackMapFrameType Low -> m (StackMapFrameType Low))
-> StackMapFrameType Low -> m (StackMapFrameType Low)
forall a b. (a -> b) -> a -> b
$ StackMapFrameType High -> StackMapFrameType Low
forall a b. a -> b
unsafeCoerce StackMapFrameType High
a

instance ByteCodeStaged VerificationTypeInfo where
  devolveBC :: (Int -> m Word16)
-> VerificationTypeInfo High -> m (VerificationTypeInfo Low)
devolveBC Int -> m Word16
f VerificationTypeInfo High
x =
    case VerificationTypeInfo High
x of
      VTObject Ref JRefType High
a -> Word16 -> VerificationTypeInfo Low
forall r. Ref JRefType r -> VerificationTypeInfo r
VTObject (Word16 -> VerificationTypeInfo Low)
-> m Word16 -> m (VerificationTypeInfo Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JRefType -> m Word16
forall (m :: * -> *) r.
(DevolveM m, Referenceable r) =>
r -> m Word16
unlink Ref JRefType High
JRefType
a
      VTUninitialized DeltaOffset High
r -> Word16 -> VerificationTypeInfo Low
forall r. ByteCodeRef r -> VerificationTypeInfo r
VTUninitialized (Word16 -> VerificationTypeInfo Low)
-> m Word16 -> m (VerificationTypeInfo Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> m Word16
f Int
DeltaOffset High
r
      VerificationTypeInfo High
a         -> VerificationTypeInfo Low -> m (VerificationTypeInfo Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (VerificationTypeInfo Low -> m (VerificationTypeInfo Low))
-> VerificationTypeInfo Low -> m (VerificationTypeInfo Low)
forall a b. (a -> b) -> a -> b
$ VerificationTypeInfo High -> VerificationTypeInfo Low
forall a b. a -> b
unsafeCoerce VerificationTypeInfo High
a

  evolveBC :: (Word16 -> m Int)
-> VerificationTypeInfo Low -> m (VerificationTypeInfo High)
evolveBC Word16 -> m Int
f VerificationTypeInfo Low
x =
    case VerificationTypeInfo Low
x of
      VTObject Ref JRefType Low
a -> JRefType -> VerificationTypeInfo High
forall r. Ref JRefType r -> VerificationTypeInfo r
VTObject (JRefType -> VerificationTypeInfo High)
-> m JRefType -> m (VerificationTypeInfo High)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word16 -> m JRefType
forall (m :: * -> *) r.
(EvolveM m, Referenceable r) =>
Word16 -> m r
link Word16
Ref JRefType Low
a
      VTUninitialized DeltaOffset Low
r -> Int -> VerificationTypeInfo High
forall r. ByteCodeRef r -> VerificationTypeInfo r
VTUninitialized (Int -> VerificationTypeInfo High)
-> m Int -> m (VerificationTypeInfo High)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word16 -> m Int
f Word16
DeltaOffset Low
r
      VerificationTypeInfo Low
a         -> VerificationTypeInfo High -> m (VerificationTypeInfo High)
forall (m :: * -> *) a. Monad m => a -> m a
return (VerificationTypeInfo High -> m (VerificationTypeInfo High))
-> VerificationTypeInfo High -> m (VerificationTypeInfo High)
forall a b. (a -> b) -> a -> b
$ VerificationTypeInfo Low -> VerificationTypeInfo High
forall a b. a -> b
unsafeCoerce VerificationTypeInfo Low
a

$(deriveBaseWithBinary ''StackMapTable)
$(deriveBase ''StackMapFrame)
$(deriveBase ''StackMapFrameType)
$(deriveBase ''VerificationTypeInfo)