{-|
Module      : Language.JVM.Attribute.Code
Copyright   : (c) Christian Gram Kalhauge, 2018
License     : MIT
Maintainer  : kalhuage@cs.ucla.edu
-}
{-# 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

-- | 'Code' is an Attribute.
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"

-- | Code contains the actual byte-code. The 'i' type parameter is added to
-- allow indicate the two stages of the code file, before and after access to
-- the 'ConstantPool'. i should be either 'Ref' or 'Deref'.
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)
  -- ^ Inclusive program counter into 'code'
  , ExceptionTable r -> ByteCodeRef r
end       :: ! (ByteCodeRef r)
  -- ^ Exclusive program counter into 'code'
  , ExceptionTable r -> ByteCodeRef r
handler   :: ! (ByteCodeRef r)
  -- ^ A program counter into 'code' indicating the handler.
  , ExceptionTable r -> Ref (Maybe ClassName) r
catchType :: ! (Ref (Maybe ClassName) r)
  }

-- | Extracts a list of bytecode operation
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

-- | Extracts a list of bytecode instructions
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

-- | Returns the StackMapTable attribute if any
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)