{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
module Language.JVM.Attribute.Code
( Code (..)
, CodeAttributes (..)
, emptyCodeAttributes
, ExceptionTable (..)
, codeStackMapTable
, codeByteCodeOprs
, codeByteCodeInsts
) where
import Prelude hiding (fail)
import Data.Binary
import Data.Monoid
import qualified Data.Vector as V
import Language.JVM.Attribute.Base
import Language.JVM.Attribute.LineNumberTable
import Language.JVM.Attribute.StackMapTable
import Language.JVM.Attribute.Annotations
import Language.JVM.ByteCode
import Language.JVM.Constant
import Language.JVM.Staged
import Language.JVM.Utils
instance IsAttribute (Code Low) where
attrName :: Const Text (Code Low)
attrName = Text -> Const Text (Code Low)
forall k a (b :: k). a -> Const a b
Const Text
"Code"
data Code r = Code
{ Code r -> Word16
codeMaxStack :: !(Word16)
, Code r -> Word16
codeMaxLocals :: !(Word16)
, Code r -> ByteCode r
codeByteCode :: !(ByteCode r)
, Code r -> SizedList16 (ExceptionTable r)
codeExceptionTable :: !(SizedList16 (ExceptionTable r))
, Code r -> Attributes CodeAttributes r
codeAttributes :: !(Attributes CodeAttributes r)
}
data ExceptionTable r = ExceptionTable
{ ExceptionTable r -> ByteCodeRef r
start :: ! (ByteCodeRef r)
, ExceptionTable r -> ByteCodeRef r
end :: ! (ByteCodeRef r)
, ExceptionTable r -> ByteCodeRef r
handler :: ! (ByteCodeRef r)
, ExceptionTable r -> Ref (Maybe ClassName) r
catchType :: ! (Ref (Maybe ClassName) r)
}
codeByteCodeOprs :: Code High -> V.Vector (ByteCodeOpr High)
codeByteCodeOprs :: Code High -> Vector (ByteCodeOpr High)
codeByteCodeOprs =
(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) -> Vector (ByteCodeOpr High))
-> (Code High -> Vector (ByteCodeInst High))
-> Code High
-> Vector (ByteCodeOpr High)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code High -> Vector (ByteCodeInst High)
forall i. Code i -> Vector (ByteCodeInst i)
codeByteCodeInsts
codeByteCodeInsts :: Code i -> V.Vector (ByteCodeInst i)
codeByteCodeInsts :: Code i -> Vector (ByteCodeInst i)
codeByteCodeInsts =
ByteCode i -> Vector (ByteCodeInst i)
forall i. ByteCode i -> Vector (ByteCodeInst i)
byteCodeInstructions (ByteCode i -> Vector (ByteCodeInst i))
-> (Code i -> ByteCode i) -> Code i -> Vector (ByteCodeInst i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code i -> ByteCode i
forall r. Code r -> ByteCode r
codeByteCode
codeStackMapTable :: Code High -> Maybe (StackMapTable High)
codeStackMapTable :: Code High -> Maybe (StackMapTable High)
codeStackMapTable =
[StackMapTable High] -> Maybe (StackMapTable High)
forall a. [a] -> Maybe a
firstOne ([StackMapTable High] -> Maybe (StackMapTable High))
-> (Code High -> [StackMapTable High])
-> Code High
-> Maybe (StackMapTable High)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeAttributes High -> [StackMapTable High]
forall r. CodeAttributes r -> [StackMapTable r]
caStackMapTable (CodeAttributes High -> [StackMapTable High])
-> (Code High -> CodeAttributes High)
-> Code High
-> [StackMapTable High]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code High -> CodeAttributes High
forall r. Code r -> Attributes CodeAttributes r
codeAttributes
data CodeAttributes r = CodeAttributes
{ CodeAttributes r -> [StackMapTable r]
caStackMapTable :: [ StackMapTable r ]
, CodeAttributes r -> [LineNumberTable r]
caLineNumberTable :: [ LineNumberTable r ]
, CodeAttributes r
-> [RuntimeVisibleTypeAnnotations CodeTypeAnnotation r]
caVisibleTypeAnnotations ::
[ RuntimeVisibleTypeAnnotations CodeTypeAnnotation r ]
, CodeAttributes r
-> [RuntimeInvisibleTypeAnnotations CodeTypeAnnotation r]
caInvisibleTypeAnnotations ::
[ RuntimeInvisibleTypeAnnotations CodeTypeAnnotation r ]
, CodeAttributes r -> [Attribute r]
caOthers :: [ Attribute r ]
}
emptyCodeAttributes :: CodeAttributes High
emptyCodeAttributes :: CodeAttributes High
emptyCodeAttributes = [StackMapTable High]
-> [LineNumberTable High]
-> [RuntimeVisibleTypeAnnotations CodeTypeAnnotation High]
-> [RuntimeInvisibleTypeAnnotations CodeTypeAnnotation High]
-> [Attribute High]
-> CodeAttributes High
forall r.
[StackMapTable r]
-> [LineNumberTable r]
-> [RuntimeVisibleTypeAnnotations CodeTypeAnnotation r]
-> [RuntimeInvisibleTypeAnnotations CodeTypeAnnotation r]
-> [Attribute r]
-> CodeAttributes r
CodeAttributes [] [] [] [] []
instance Staged Code where
evolve :: Code Low -> m (Code High)
evolve Code{Word16
Attributes CodeAttributes Low
SizedList16 (ExceptionTable Low)
ByteCode Low
codeAttributes :: Attributes CodeAttributes Low
codeExceptionTable :: SizedList16 (ExceptionTable Low)
codeByteCode :: ByteCode Low
codeMaxLocals :: Word16
codeMaxStack :: Word16
codeAttributes :: forall r. Code r -> Attributes CodeAttributes r
codeExceptionTable :: forall r. Code r -> SizedList16 (ExceptionTable r)
codeByteCode :: forall r. Code r -> ByteCode r
codeMaxLocals :: forall r. Code r -> Word16
codeMaxStack :: forall r. Code r -> Word16
..} = String -> m (Code High) -> m (Code High)
forall (m :: * -> *) a. LabelM m => String -> m a -> m a
label String
"Code" (m (Code High) -> m (Code High)) -> m (Code High) -> m (Code High)
forall a b. (a -> b) -> a -> b
$ do
(OffsetMap
offsets, ByteCode High
codeByteCode) <- ByteCode Low -> m (OffsetMap, ByteCode High)
forall (m :: * -> *).
EvolveM m =>
ByteCode Low -> m (OffsetMap, ByteCode High)
evolveByteCode ByteCode Low
codeByteCode
let evolver :: Word16 -> m ByteCodeIndex
evolver = (OffsetMap -> Word16 -> m ByteCodeIndex
forall (m :: * -> *).
EvolveM m =>
OffsetMap -> Word16 -> m ByteCodeIndex
evolveOffset OffsetMap
offsets)
SizedList Word16 (ExceptionTable High)
codeExceptionTable <- (ExceptionTable Low -> m (ExceptionTable High))
-> SizedList16 (ExceptionTable Low)
-> m (SizedList Word16 (ExceptionTable High))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Word16 -> m ByteCodeIndex)
-> ExceptionTable Low -> m (ExceptionTable High)
forall (s :: * -> *) (m :: * -> *).
(ByteCodeStaged s, EvolveM m) =>
(Word16 -> m ByteCodeIndex) -> s Low -> m (s High)
evolveBC Word16 -> m ByteCodeIndex
evolver) SizedList16 (ExceptionTable Low)
codeExceptionTable
CodeAttributes High
codeAttributes <- (Endo (CodeAttributes High) -> CodeAttributes High)
-> m (Endo (CodeAttributes High)) -> m (CodeAttributes High)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Endo (CodeAttributes High)
-> CodeAttributes High -> CodeAttributes High
forall a. Endo a -> a -> a
`appEndo` CodeAttributes High
emptyCodeAttributes) (m (Endo (CodeAttributes High)) -> m (CodeAttributes High))
-> ((Attribute High -> m (Endo (CodeAttributes High)))
-> m (Endo (CodeAttributes High)))
-> (Attribute High -> m (Endo (CodeAttributes High)))
-> m (CodeAttributes High)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttributeLocation
-> SizedList Word16 (Attribute Low)
-> (Attribute High -> m (Endo (CodeAttributes High)))
-> m (Endo (CodeAttributes High))
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, EvolveM m, Monoid a) =>
AttributeLocation
-> f (Attribute Low) -> (Attribute High -> m a) -> m a
fromAttributes AttributeLocation
CodeAttribute Attributes CodeAttributes Low
SizedList Word16 (Attribute Low)
codeAttributes
((Attribute High -> m (Endo (CodeAttributes High)))
-> m (CodeAttributes High))
-> (Attribute High -> m (Endo (CodeAttributes High)))
-> m (CodeAttributes High)
forall a b. (a -> b) -> a -> b
$ (Word16 -> m ByteCodeIndex)
-> [ByteCodeAttributeCollector (CodeAttributes High)]
-> (Attribute High -> CodeAttributes High -> CodeAttributes High)
-> Attribute High
-> m (Endo (CodeAttributes High))
forall c (m :: * -> *).
EvolveM m =>
(Word16 -> m ByteCodeIndex)
-> [ByteCodeAttributeCollector c]
-> (Attribute High -> c -> c)
-> Attribute High
-> m (Endo c)
collectBC Word16 -> m ByteCodeIndex
evolver
[ (StackMapTable High -> CodeAttributes High -> CodeAttributes High)
-> ByteCodeAttributeCollector (CodeAttributes High)
forall c (a :: * -> *).
(IsAttribute (a Low), ByteCodeStaged a) =>
(a High -> c -> c) -> ByteCodeAttributeCollector c
BCAttr (\StackMapTable High
e CodeAttributes High
a -> CodeAttributes High
a {caStackMapTable :: [StackMapTable High]
caStackMapTable = StackMapTable High
e StackMapTable High -> [StackMapTable High] -> [StackMapTable High]
forall a. a -> [a] -> [a]
: CodeAttributes High -> [StackMapTable High]
forall r. CodeAttributes r -> [StackMapTable r]
caStackMapTable CodeAttributes High
a})
, (LineNumberTable High
-> CodeAttributes High -> CodeAttributes High)
-> ByteCodeAttributeCollector (CodeAttributes High)
forall c (a :: * -> *).
(IsAttribute (a Low), ByteCodeStaged a) =>
(a High -> c -> c) -> ByteCodeAttributeCollector c
BCAttr (\LineNumberTable High
e CodeAttributes High
a -> CodeAttributes High
a {caLineNumberTable :: [LineNumberTable High]
caLineNumberTable = LineNumberTable High
e LineNumberTable High
-> [LineNumberTable High] -> [LineNumberTable High]
forall a. a -> [a] -> [a]
: CodeAttributes High -> [LineNumberTable High]
forall r. CodeAttributes r -> [LineNumberTable r]
caLineNumberTable CodeAttributes High
a})
, (RuntimeVisibleTypeAnnotations CodeTypeAnnotation High
-> CodeAttributes High -> CodeAttributes High)
-> ByteCodeAttributeCollector (CodeAttributes High)
forall c (a :: * -> *).
(IsAttribute (a Low), ByteCodeStaged a) =>
(a High -> c -> c) -> ByteCodeAttributeCollector c
BCAttr (\RuntimeVisibleTypeAnnotations CodeTypeAnnotation High
e CodeAttributes High
a -> CodeAttributes High
a {caVisibleTypeAnnotations :: [RuntimeVisibleTypeAnnotations CodeTypeAnnotation High]
caVisibleTypeAnnotations = RuntimeVisibleTypeAnnotations CodeTypeAnnotation High
e RuntimeVisibleTypeAnnotations CodeTypeAnnotation High
-> [RuntimeVisibleTypeAnnotations CodeTypeAnnotation High]
-> [RuntimeVisibleTypeAnnotations CodeTypeAnnotation High]
forall a. a -> [a] -> [a]
: CodeAttributes High
-> [RuntimeVisibleTypeAnnotations CodeTypeAnnotation High]
forall r.
CodeAttributes r
-> [RuntimeVisibleTypeAnnotations CodeTypeAnnotation r]
caVisibleTypeAnnotations CodeAttributes High
a})
, (RuntimeInvisibleTypeAnnotations CodeTypeAnnotation High
-> CodeAttributes High -> CodeAttributes High)
-> ByteCodeAttributeCollector (CodeAttributes High)
forall c (a :: * -> *).
(IsAttribute (a Low), ByteCodeStaged a) =>
(a High -> c -> c) -> ByteCodeAttributeCollector c
BCAttr (\RuntimeInvisibleTypeAnnotations CodeTypeAnnotation High
e CodeAttributes High
a -> CodeAttributes High
a {caInvisibleTypeAnnotations :: [RuntimeInvisibleTypeAnnotations CodeTypeAnnotation High]
caInvisibleTypeAnnotations = RuntimeInvisibleTypeAnnotations CodeTypeAnnotation High
e RuntimeInvisibleTypeAnnotations CodeTypeAnnotation High
-> [RuntimeInvisibleTypeAnnotations CodeTypeAnnotation High]
-> [RuntimeInvisibleTypeAnnotations CodeTypeAnnotation High]
forall a. a -> [a] -> [a]
: CodeAttributes High
-> [RuntimeInvisibleTypeAnnotations CodeTypeAnnotation High]
forall r.
CodeAttributes r
-> [RuntimeInvisibleTypeAnnotations CodeTypeAnnotation r]
caInvisibleTypeAnnotations CodeAttributes High
a})
]
(\Attribute High
e CodeAttributes High
a -> CodeAttributes High
a {caOthers :: [Attribute High]
caOthers = Attribute High
e Attribute High -> [Attribute High] -> [Attribute High]
forall a. a -> [a] -> [a]
: CodeAttributes High -> [Attribute High]
forall r. CodeAttributes r -> [Attribute r]
caOthers CodeAttributes High
a})
Code High -> m (Code High)
forall (m :: * -> *) a. Monad m => a -> m a
return (Code High -> m (Code High)) -> Code High -> m (Code High)
forall a b. (a -> b) -> a -> b
$ Code :: forall r.
Word16
-> Word16
-> ByteCode r
-> SizedList16 (ExceptionTable r)
-> Attributes CodeAttributes r
-> Code r
Code {Word16
Choice
(SizedList Word16 (Attribute High)) (CodeAttributes High) High
SizedList Word16 (ExceptionTable High)
ByteCode High
CodeAttributes High
codeAttributes :: CodeAttributes High
codeExceptionTable :: SizedList Word16 (ExceptionTable High)
codeByteCode :: ByteCode High
codeMaxLocals :: Word16
codeMaxStack :: Word16
codeAttributes :: Choice
(SizedList Word16 (Attribute High)) (CodeAttributes High) High
codeExceptionTable :: SizedList Word16 (ExceptionTable High)
codeByteCode :: ByteCode High
codeMaxLocals :: Word16
codeMaxStack :: Word16
..}
devolve :: Code High -> m (Code Low)
devolve Code{Word16
Choice
(SizedList Word16 (Attribute High)) (CodeAttributes High) High
SizedList Word16 (ExceptionTable High)
ByteCode High
codeAttributes :: Choice
(SizedList Word16 (Attribute High)) (CodeAttributes High) High
codeExceptionTable :: SizedList Word16 (ExceptionTable High)
codeByteCode :: ByteCode High
codeMaxLocals :: Word16
codeMaxStack :: Word16
codeAttributes :: forall r. Code r -> Attributes CodeAttributes r
codeExceptionTable :: forall r. Code r -> SizedList16 (ExceptionTable r)
codeByteCode :: forall r. Code r -> ByteCode r
codeMaxLocals :: forall r. Code r -> Word16
codeMaxStack :: forall r. Code r -> Word16
..} = do
ByteCode Low
codeByteCode <- ByteCode High -> m (ByteCode Low)
forall (m :: * -> *).
DevolveM m =>
ByteCode High -> m (ByteCode Low)
devolveByteCode ByteCode High
codeByteCode
let bcdevolver :: ByteCodeIndex -> m Word16
bcdevolver = ByteCode Low -> ByteCodeIndex -> m Word16
forall (m :: * -> *).
DevolveM m =>
ByteCode Low -> ByteCodeIndex -> m Word16
devolveOffset ByteCode Low
codeByteCode
SizedList16 (ExceptionTable Low)
codeExceptionTable <-
(ExceptionTable High -> m (ExceptionTable Low))
-> SizedList Word16 (ExceptionTable High)
-> m (SizedList16 (ExceptionTable Low))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ByteCodeIndex -> m Word16)
-> ExceptionTable High -> m (ExceptionTable Low)
forall (s :: * -> *) (m :: * -> *).
(ByteCodeStaged s, DevolveM m) =>
(ByteCodeIndex -> m Word16) -> s High -> m (s Low)
devolveBC ByteCodeIndex -> m Word16
bcdevolver) SizedList Word16 (ExceptionTable High)
codeExceptionTable
SizedList Word16 (Attribute Low)
codeAttributes <- [Attribute Low] -> SizedList Word16 (Attribute Low)
forall w a. [a] -> SizedList w a
SizedList ([Attribute Low] -> SizedList Word16 (Attribute Low))
-> m [Attribute Low] -> m (SizedList Word16 (Attribute Low))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ByteCodeIndex -> m Word16)
-> CodeAttributes High -> m [Attribute Low]
forall (f :: * -> *).
DevolveM f =>
(ByteCodeIndex -> f Word16)
-> CodeAttributes High -> f [Attribute Low]
fromCodeAttributes ByteCodeIndex -> m Word16
bcdevolver Choice
(SizedList Word16 (Attribute High)) (CodeAttributes High) High
CodeAttributes High
codeAttributes
Code Low -> m (Code Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (Code Low -> m (Code Low)) -> Code Low -> m (Code Low)
forall a b. (a -> b) -> a -> b
$ Code :: forall r.
Word16
-> Word16
-> ByteCode r
-> SizedList16 (ExceptionTable r)
-> Attributes CodeAttributes r
-> Code r
Code {Word16
Attributes CodeAttributes Low
SizedList Word16 (Attribute Low)
SizedList16 (ExceptionTable Low)
ByteCode Low
codeAttributes :: SizedList Word16 (Attribute Low)
codeExceptionTable :: SizedList16 (ExceptionTable Low)
codeByteCode :: ByteCode Low
codeMaxLocals :: Word16
codeMaxStack :: Word16
codeAttributes :: Attributes CodeAttributes Low
codeExceptionTable :: SizedList16 (ExceptionTable Low)
codeByteCode :: ByteCode Low
codeMaxLocals :: Word16
codeMaxStack :: Word16
..}
where
fromCodeAttributes :: (ByteCodeIndex -> f Word16)
-> CodeAttributes High -> f [Attribute Low]
fromCodeAttributes ByteCodeIndex -> f Word16
bcdevolver CodeAttributes {[Attribute High]
[StackMapTable High]
[LineNumberTable High]
[RuntimeInvisibleTypeAnnotations CodeTypeAnnotation High]
[RuntimeVisibleTypeAnnotations CodeTypeAnnotation High]
caOthers :: [Attribute High]
caInvisibleTypeAnnotations :: [RuntimeInvisibleTypeAnnotations CodeTypeAnnotation High]
caVisibleTypeAnnotations :: [RuntimeVisibleTypeAnnotations CodeTypeAnnotation High]
caLineNumberTable :: [LineNumberTable High]
caStackMapTable :: [StackMapTable High]
caOthers :: forall r. CodeAttributes r -> [Attribute r]
caInvisibleTypeAnnotations :: forall r.
CodeAttributes r
-> [RuntimeInvisibleTypeAnnotations CodeTypeAnnotation r]
caVisibleTypeAnnotations :: forall r.
CodeAttributes r
-> [RuntimeVisibleTypeAnnotations CodeTypeAnnotation r]
caLineNumberTable :: forall r. CodeAttributes r -> [LineNumberTable r]
caStackMapTable :: forall r. CodeAttributes r -> [StackMapTable r]
..} =
[[Attribute Low]] -> [Attribute Low]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Attribute Low]] -> [Attribute Low])
-> f [[Attribute Low]] -> f [Attribute Low]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [f [Attribute Low]] -> f [[Attribute Low]]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
[ (StackMapTable High -> f (Attribute Low))
-> [StackMapTable High] -> f [Attribute Low]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ByteCodeIndex -> f Word16)
-> StackMapTable High -> f (Attribute Low)
forall (a :: * -> *) (m :: * -> *).
(IsAttribute (a Low), ByteCodeStaged a, DevolveM m) =>
(ByteCodeIndex -> m Word16) -> a High -> m (Attribute Low)
toBCAttribute ByteCodeIndex -> f Word16
bcdevolver) [StackMapTable High]
caStackMapTable
, (LineNumberTable High -> f (Attribute Low))
-> [LineNumberTable High] -> f [Attribute Low]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ByteCodeIndex -> f Word16)
-> LineNumberTable High -> f (Attribute Low)
forall (a :: * -> *) (m :: * -> *).
(IsAttribute (a Low), ByteCodeStaged a, DevolveM m) =>
(ByteCodeIndex -> m Word16) -> a High -> m (Attribute Low)
toBCAttribute ByteCodeIndex -> f Word16
bcdevolver) [LineNumberTable High]
caLineNumberTable
, (RuntimeVisibleTypeAnnotations CodeTypeAnnotation High
-> f (Attribute Low))
-> [RuntimeVisibleTypeAnnotations CodeTypeAnnotation High]
-> f [Attribute Low]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ByteCodeIndex -> f Word16)
-> RuntimeVisibleTypeAnnotations CodeTypeAnnotation High
-> f (Attribute Low)
forall (a :: * -> *) (m :: * -> *).
(IsAttribute (a Low), ByteCodeStaged a, DevolveM m) =>
(ByteCodeIndex -> m Word16) -> a High -> m (Attribute Low)
toBCAttribute ByteCodeIndex -> f Word16
bcdevolver) [RuntimeVisibleTypeAnnotations CodeTypeAnnotation High]
caVisibleTypeAnnotations
, (RuntimeInvisibleTypeAnnotations CodeTypeAnnotation High
-> f (Attribute Low))
-> [RuntimeInvisibleTypeAnnotations CodeTypeAnnotation High]
-> f [Attribute Low]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ByteCodeIndex -> f Word16)
-> RuntimeInvisibleTypeAnnotations CodeTypeAnnotation High
-> f (Attribute Low)
forall (a :: * -> *) (m :: * -> *).
(IsAttribute (a Low), ByteCodeStaged a, DevolveM m) =>
(ByteCodeIndex -> m Word16) -> a High -> m (Attribute Low)
toBCAttribute ByteCodeIndex -> f Word16
bcdevolver) [RuntimeInvisibleTypeAnnotations CodeTypeAnnotation High]
caInvisibleTypeAnnotations
, (Attribute High -> f (Attribute Low))
-> [Attribute High] -> f [Attribute Low]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Attribute High -> f (Attribute Low)
forall (s :: * -> *) (m :: * -> *).
(Staged s, DevolveM m) =>
s High -> m (s Low)
devolve [Attribute High]
caOthers
]
instance ByteCodeStaged ExceptionTable where
evolveBC :: (Word16 -> m ByteCodeIndex)
-> ExceptionTable Low -> m (ExceptionTable High)
evolveBC Word16 -> m ByteCodeIndex
f ExceptionTable{ByteCodeRef Low
Ref (Maybe ClassName) Low
catchType :: Ref (Maybe ClassName) Low
handler :: ByteCodeRef Low
end :: ByteCodeRef Low
start :: ByteCodeRef Low
catchType :: forall r. ExceptionTable r -> Ref (Maybe ClassName) r
handler :: forall r. ExceptionTable r -> ByteCodeRef r
end :: forall r. ExceptionTable r -> ByteCodeRef r
start :: forall r. ExceptionTable r -> ByteCodeRef r
..} = String -> m (ExceptionTable High) -> m (ExceptionTable High)
forall (m :: * -> *) a. LabelM m => String -> m a -> m a
label String
"ExceptionTable" (m (ExceptionTable High) -> m (ExceptionTable High))
-> m (ExceptionTable High) -> m (ExceptionTable High)
forall a b. (a -> b) -> a -> b
$ do
Maybe ClassName
catchType <- case Ref (Maybe ClassName) Low
catchType of
Ref (Maybe ClassName) Low
0 -> Maybe ClassName -> m (Maybe ClassName)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ClassName
forall a. Maybe a
Nothing
Ref (Maybe ClassName) Low
n -> ClassName -> Maybe ClassName
forall a. a -> Maybe a
Just (ClassName -> Maybe ClassName)
-> m ClassName -> m (Maybe ClassName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word16 -> m ClassName
forall (m :: * -> *) r.
(EvolveM m, Referenceable r) =>
Word16 -> m r
link Word16
Ref (Maybe ClassName) Low
n
ByteCodeIndex
start <- Word16 -> m ByteCodeIndex
f Word16
ByteCodeRef Low
start
ByteCodeIndex
end <- Word16 -> m ByteCodeIndex
f Word16
ByteCodeRef Low
end
ByteCodeIndex
handler <- Word16 -> m ByteCodeIndex
f Word16
ByteCodeRef Low
handler
ExceptionTable High -> m (ExceptionTable High)
forall (m :: * -> *) a. Monad m => a -> m a
return (ExceptionTable High -> m (ExceptionTable High))
-> ExceptionTable High -> m (ExceptionTable High)
forall a b. (a -> b) -> a -> b
$ ExceptionTable :: forall r.
ByteCodeRef r
-> ByteCodeRef r
-> ByteCodeRef r
-> Ref (Maybe ClassName) r
-> ExceptionTable r
ExceptionTable {ByteCodeIndex
Maybe ClassName
Choice Word16 ByteCodeIndex High
Choice Word16 (Maybe ClassName) High
handler :: ByteCodeIndex
end :: ByteCodeIndex
start :: ByteCodeIndex
catchType :: Maybe ClassName
catchType :: Choice Word16 (Maybe ClassName) High
handler :: Choice Word16 ByteCodeIndex High
end :: Choice Word16 ByteCodeIndex High
start :: Choice Word16 ByteCodeIndex High
..}
devolveBC :: (ByteCodeIndex -> m Word16)
-> ExceptionTable High -> m (ExceptionTable Low)
devolveBC ByteCodeIndex -> m Word16
f ExceptionTable{Choice Word16 ByteCodeIndex High
Choice Word16 (Maybe ClassName) High
catchType :: Choice Word16 (Maybe ClassName) High
handler :: Choice Word16 ByteCodeIndex High
end :: Choice Word16 ByteCodeIndex High
start :: Choice Word16 ByteCodeIndex High
catchType :: forall r. ExceptionTable r -> Ref (Maybe ClassName) r
handler :: forall r. ExceptionTable r -> ByteCodeRef r
end :: forall r. ExceptionTable r -> ByteCodeRef r
start :: forall r. ExceptionTable r -> ByteCodeRef r
..} = do
Word16
catchType <- case Choice Word16 (Maybe ClassName) High
catchType of
Just s -> ClassName -> m Word16
forall (m :: * -> *) r.
(DevolveM m, Referenceable r) =>
r -> m Word16
unlink ClassName
s
Choice Word16 (Maybe ClassName) High
Nothing -> Word16 -> m Word16
forall (m :: * -> *) a. Monad m => a -> m a
return (Word16 -> m Word16) -> Word16 -> m Word16
forall a b. (a -> b) -> a -> b
$ Word16
0
Word16
start <- ByteCodeIndex -> m Word16
f ByteCodeIndex
Choice Word16 ByteCodeIndex High
start
Word16
end <- ByteCodeIndex -> m Word16
f ByteCodeIndex
Choice Word16 ByteCodeIndex High
end
Word16
handler <- ByteCodeIndex -> m Word16
f ByteCodeIndex
Choice Word16 ByteCodeIndex High
handler
ExceptionTable Low -> m (ExceptionTable Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ExceptionTable Low -> m (ExceptionTable Low))
-> ExceptionTable Low -> m (ExceptionTable Low)
forall a b. (a -> b) -> a -> b
$ ExceptionTable :: forall r.
ByteCodeRef r
-> ByteCodeRef r
-> ByteCodeRef r
-> Ref (Maybe ClassName) r
-> ExceptionTable r
ExceptionTable {Word16
ByteCodeRef Low
Ref (Maybe ClassName) Low
handler :: Word16
end :: Word16
start :: Word16
catchType :: Word16
catchType :: Ref (Maybe ClassName) Low
handler :: ByteCodeRef Low
end :: ByteCodeRef Low
start :: ByteCodeRef Low
..}
$(deriveBaseWithBinary ''Code)
$(deriveBaseWithBinary ''ExceptionTable)
$(deriveBase ''CodeAttributes)