{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE LambdaCase #-}
module Language.JVM.Attribute.StackMapTable
( StackMapTable (..)
, DeltaOffset
, StackMapFrame (..)
, StackMapFrameType (..)
, emptyStackMapTable
, VerificationTypeInfo (..)
, 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
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"
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 []
type DeltaOffset i = Choice Word16 Int i
data StackMapFrame r = StackMapFrame
{ StackMapFrame r -> DeltaOffset r
deltaOffset :: DeltaOffset r
, StackMapFrame r -> StackMapFrameType r
frameType :: StackMapFrameType r
}
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
data VerificationTypeInfo r
= VTTop
| VTInteger
| VTFloat
| VTLong
| VTDouble
| VTNull
| VTUninitializedThis
| VTObject !(Ref JRefType r)
| VTUninitialized !(ByteCodeRef r)
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
-> Word16
-> Word16
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
-> Word16
-> Word16
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)