{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE UndecidableInstances #-}

{- | Conversion of the high level constant pool types to the low level representation.
This uses the 'H2JVM.Internal.IndexedMap.IndexedMap' type to keep the constant pool free from duplication.
-}
module H2JVM.Internal.Convert.ConstantPool (ConstantPoolEff, ConstantPoolEffs, ConstantPoolState (..), runConstantPool, runConstantPoolWith, runConstantPoolWithPure, findIndexOf) where

import Control.Monad ((>=>))
import Data.Text.Encoding
import Data.Word (Word32)
import Effectful
import Effectful.Error.Static
import Effectful.State.Static.Local
import Witch

import Data.Vector qualified as V

import H2JVM.ConstantPool
import H2JVM.Internal.Convert.Error
import H2JVM.Internal.Convert.Numbers
import H2JVM.Internal.Convert.Type
import H2JVM.Internal.IndexedMap (IndexedMap)
import H2JVM.Internal.Raw.ConstantPool
import H2JVM.Internal.Raw.MagicNumbers
import H2JVM.Internal.Raw.Types
import H2JVM.Internal.Util (bug)

import H2JVM.Internal.IndexedMap qualified as IM
import H2JVM.Internal.Raw.ClassFile qualified as Raw

-- | Accumulated state of the constant pool.
data ConstantPoolState = ConstantPoolState
    { ConstantPoolState -> IndexedMap ConstantPoolInfo
constantPool :: IndexedMap ConstantPoolInfo
    -- ^ A bidirectional mapping from index to a 'ConstantPoolInfo'.
    , ConstantPoolState -> IndexedMap BootstrapMethod
bootstrapMethods :: IndexedMap Raw.BootstrapMethod
    -- ^ A bidirectional mapping from an index to a 'Raw.BootstrapMethod'.
    }
    deriving (ConstantPoolState -> ConstantPoolState -> Bool
(ConstantPoolState -> ConstantPoolState -> Bool)
-> (ConstantPoolState -> ConstantPoolState -> Bool)
-> Eq ConstantPoolState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConstantPoolState -> ConstantPoolState -> Bool
== :: ConstantPoolState -> ConstantPoolState -> Bool
$c/= :: ConstantPoolState -> ConstantPoolState -> Bool
/= :: ConstantPoolState -> ConstantPoolState -> Bool
Eq, Eq ConstantPoolState
Eq ConstantPoolState =>
(ConstantPoolState -> ConstantPoolState -> Ordering)
-> (ConstantPoolState -> ConstantPoolState -> Bool)
-> (ConstantPoolState -> ConstantPoolState -> Bool)
-> (ConstantPoolState -> ConstantPoolState -> Bool)
-> (ConstantPoolState -> ConstantPoolState -> Bool)
-> (ConstantPoolState -> ConstantPoolState -> ConstantPoolState)
-> (ConstantPoolState -> ConstantPoolState -> ConstantPoolState)
-> Ord ConstantPoolState
ConstantPoolState -> ConstantPoolState -> Bool
ConstantPoolState -> ConstantPoolState -> Ordering
ConstantPoolState -> ConstantPoolState -> ConstantPoolState
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ConstantPoolState -> ConstantPoolState -> Ordering
compare :: ConstantPoolState -> ConstantPoolState -> Ordering
$c< :: ConstantPoolState -> ConstantPoolState -> Bool
< :: ConstantPoolState -> ConstantPoolState -> Bool
$c<= :: ConstantPoolState -> ConstantPoolState -> Bool
<= :: ConstantPoolState -> ConstantPoolState -> Bool
$c> :: ConstantPoolState -> ConstantPoolState -> Bool
> :: ConstantPoolState -> ConstantPoolState -> Bool
$c>= :: ConstantPoolState -> ConstantPoolState -> Bool
>= :: ConstantPoolState -> ConstantPoolState -> Bool
$cmax :: ConstantPoolState -> ConstantPoolState -> ConstantPoolState
max :: ConstantPoolState -> ConstantPoolState -> ConstantPoolState
$cmin :: ConstantPoolState -> ConstantPoolState -> ConstantPoolState
min :: ConstantPoolState -> ConstantPoolState -> ConstantPoolState
Ord, Int -> ConstantPoolState -> ShowS
[ConstantPoolState] -> ShowS
ConstantPoolState -> String
(Int -> ConstantPoolState -> ShowS)
-> (ConstantPoolState -> String)
-> ([ConstantPoolState] -> ShowS)
-> Show ConstantPoolState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConstantPoolState -> ShowS
showsPrec :: Int -> ConstantPoolState -> ShowS
$cshow :: ConstantPoolState -> String
show :: ConstantPoolState -> String
$cshowList :: [ConstantPoolState] -> ShowS
showList :: [ConstantPoolState] -> ShowS
Show)

-- | A simple state monad for accumulating a 'ConstantPoolState'
type ConstantPoolEff r = (State ConstantPoolState :> r, Error CodeConverterError :> r)

type ConstantPoolEffs r = State ConstantPoolState ': Error CodeConverterError ': r

runConstantPoolWith :: ConstantPoolState -> Eff (ConstantPoolEffs r) a -> Eff (Error CodeConverterError ': r) (a, ConstantPoolState)
runConstantPoolWith :: forall (r :: [(* -> *) -> * -> *]) a.
ConstantPoolState
-> Eff (ConstantPoolEffs r) a
-> Eff (Error CodeConverterError : r) (a, ConstantPoolState)
runConstantPoolWith ConstantPoolState
s =
    ConstantPoolState
-> Eff (ConstantPoolEffs r) a
-> Eff (Error CodeConverterError : r) (a, ConstantPoolState)
forall s (es :: [(* -> *) -> * -> *]) a.
HasCallStack =>
s -> Eff (State s : es) a -> Eff es (a, s)
runState ConstantPoolState
s
        (Eff (ConstantPoolEffs r) a
 -> Eff (Error CodeConverterError : r) (a, ConstantPoolState))
-> (Eff (ConstantPoolEffs r) a -> Eff (ConstantPoolEffs r) a)
-> Eff (ConstantPoolEffs r) a
-> Eff (Error CodeConverterError : r) (a, ConstantPoolState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff (ConstantPoolEffs r) a -> Eff (ConstantPoolEffs r) a
forall (subEs :: [(* -> *) -> * -> *]) (es :: [(* -> *) -> * -> *])
       a.
Subset subEs es =>
Eff subEs a -> Eff es a
inject

runConstantPoolWithPure :: ConstantPoolState -> Eff (ConstantPoolEffs r) a -> Eff r (Either CodeConverterError (a, ConstantPoolState))
runConstantPoolWithPure :: forall (r :: [(* -> *) -> * -> *]) a.
ConstantPoolState
-> Eff (ConstantPoolEffs r) a
-> Eff r (Either CodeConverterError (a, ConstantPoolState))
runConstantPoolWithPure ConstantPoolState
s = Eff (Error CodeConverterError : r) (a, ConstantPoolState)
-> Eff r (Either CodeConverterError (a, ConstantPoolState))
forall e (es :: [(* -> *) -> * -> *]) a.
HasCallStack =>
Eff (Error e : es) a -> Eff es (Either e a)
runErrorNoCallStack (Eff (Error CodeConverterError : r) (a, ConstantPoolState)
 -> Eff r (Either CodeConverterError (a, ConstantPoolState)))
-> (Eff (ConstantPoolEffs r) a
    -> Eff (Error CodeConverterError : r) (a, ConstantPoolState))
-> Eff (ConstantPoolEffs r) a
-> Eff r (Either CodeConverterError (a, ConstantPoolState))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConstantPoolState
-> Eff (ConstantPoolEffs r) a
-> Eff (Error CodeConverterError : r) (a, ConstantPoolState)
forall s (es :: [(* -> *) -> * -> *]) a.
HasCallStack =>
s -> Eff (State s : es) a -> Eff es (a, s)
runState ConstantPoolState
s (Eff (ConstantPoolEffs r) a
 -> Eff (Error CodeConverterError : r) (a, ConstantPoolState))
-> (Eff (ConstantPoolEffs r) a -> Eff (ConstantPoolEffs r) a)
-> Eff (ConstantPoolEffs r) a
-> Eff (Error CodeConverterError : r) (a, ConstantPoolState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff (ConstantPoolEffs r) a -> Eff (ConstantPoolEffs r) a
forall (subEs :: [(* -> *) -> * -> *]) (es :: [(* -> *) -> * -> *])
       a.
Subset subEs es =>
Eff subEs a -> Eff es a
inject

-- | Run a 'ConstantPool' effect with an empty initial state.
runConstantPool :: Eff (ConstantPoolEffs r) a -> Eff (Error CodeConverterError ': r) (a, ConstantPoolState)
runConstantPool :: forall (r :: [(* -> *) -> * -> *]) a.
Eff (ConstantPoolEffs r) a
-> Eff (Error CodeConverterError : r) (a, ConstantPoolState)
runConstantPool = ConstantPoolState
-> Eff (ConstantPoolEffs r) a
-> Eff (Error CodeConverterError : r) (a, ConstantPoolState)
forall (r :: [(* -> *) -> * -> *]) a.
ConstantPoolState
-> Eff (ConstantPoolEffs r) a
-> Eff (Error CodeConverterError : r) (a, ConstantPoolState)
runConstantPoolWith ConstantPoolState
forall a. Monoid a => a
mempty

{- | Insert or lookup a value within one of the fields of 'ConstantPoolState'.
Essentially a wrapper of 'IM.lookupOrInsert' over some getter and setter function.
-}
lookupOrInsertMOver ::
    (ConstantPoolEff r, Ord a) =>
    a ->
    -- | Getter function.
    (ConstantPoolState -> IndexedMap a) ->
    -- | Setter function.
    (ConstantPoolState -> IndexedMap a -> ConstantPoolState) ->
    -- | Index into the constant pool.
    Eff r Word32
lookupOrInsertMOver :: forall (r :: [(* -> *) -> * -> *]) a.
(ConstantPoolEff r, Ord a) =>
a
-> (ConstantPoolState -> IndexedMap a)
-> (ConstantPoolState -> IndexedMap a -> ConstantPoolState)
-> Eff r Word32
lookupOrInsertMOver a
cpInfo ConstantPoolState -> IndexedMap a
getter ConstantPoolState -> IndexedMap a -> ConstantPoolState
setter = do
    cp <- Eff r ConstantPoolState
forall s (es :: [(* -> *) -> * -> *]).
(HasCallStack, State s :> es) =>
Eff es s
get
    let (i, newCP) = IM.lookupOrInsert cpInfo (getter cp)
    put (setter cp newCP)
    pure $ IM.indexValue i

-- | Insert or lookup a value within the 'constantPool' field of 'ConstantPoolState'.
lookupOrInsertMCP :: ConstantPoolEff r => ConstantPoolInfo -> Eff r Word32
lookupOrInsertMCP :: forall (r :: [(* -> *) -> * -> *]).
ConstantPoolEff r =>
ConstantPoolInfo -> Eff r Word32
lookupOrInsertMCP ConstantPoolInfo
cpInfo = ConstantPoolInfo
-> (ConstantPoolState -> IndexedMap ConstantPoolInfo)
-> (ConstantPoolState
    -> IndexedMap ConstantPoolInfo -> ConstantPoolState)
-> Eff r Word32
forall (r :: [(* -> *) -> * -> *]) a.
(ConstantPoolEff r, Ord a) =>
a
-> (ConstantPoolState -> IndexedMap a)
-> (ConstantPoolState -> IndexedMap a -> ConstantPoolState)
-> Eff r Word32
lookupOrInsertMOver ConstantPoolInfo
cpInfo (.constantPool) (\ConstantPoolState
s IndexedMap ConstantPoolInfo
x -> ConstantPoolState
s{constantPool = x})

-- | Insert or lookup a value within the 'bootstrapMethods' field of 'ConstantPoolState'.
lookupOrInsertMBM :: ConstantPoolEff r => Raw.BootstrapMethod -> Eff r Word32
lookupOrInsertMBM :: forall (r :: [(* -> *) -> * -> *]).
ConstantPoolEff r =>
BootstrapMethod -> Eff r Word32
lookupOrInsertMBM BootstrapMethod
bmInfo = BootstrapMethod
-> (ConstantPoolState -> IndexedMap BootstrapMethod)
-> (ConstantPoolState
    -> IndexedMap BootstrapMethod -> ConstantPoolState)
-> Eff r Word32
forall (r :: [(* -> *) -> * -> *]) a.
(ConstantPoolEff r, Ord a) =>
a
-> (ConstantPoolState -> IndexedMap a)
-> (ConstantPoolState -> IndexedMap a -> ConstantPoolState)
-> Eff r Word32
lookupOrInsertMOver BootstrapMethod
bmInfo (.bootstrapMethods) (\ConstantPoolState
s IndexedMap BootstrapMethod
x -> ConstantPoolState
s{bootstrapMethods = x})

{- | Transform a single, high-level 'ConstantPoolEntry' into a raw constant pool entry by upserting it into the 'ConstantPoolState'.
Returns the index of the upserted entry.
A little bit partial in the case of invalid/overflowing indices, which should be impossible in most normal cases.
-}
transformEntry :: (HasCallStack, ConstantPoolEff r, Error CodeConverterError :> r) => ConstantPoolEntry -> Eff r Word32
transformEntry :: forall (r :: [(* -> *) -> * -> *]).
(HasCallStack, ConstantPoolEff r, Error CodeConverterError :> r) =>
ConstantPoolEntry -> Eff r Word32
transformEntry (CPUTF8Entry Text
text) = ConstantPoolInfo -> Eff r Word32
forall (r :: [(* -> *) -> * -> *]).
ConstantPoolEff r =>
ConstantPoolInfo -> Eff r Word32
lookupOrInsertMCP (ByteString -> ConstantPoolInfo
UTF8Info (ByteString -> ConstantPoolInfo) -> ByteString -> ConstantPoolInfo
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
text)
transformEntry (CPIntegerEntry Int32
i) = ConstantPoolInfo -> Eff r Word32
forall (r :: [(* -> *) -> * -> *]).
ConstantPoolEff r =>
ConstantPoolInfo -> Eff r Word32
lookupOrInsertMCP (Word32 -> ConstantPoolInfo
IntegerInfo (Word32 -> ConstantPoolInfo) -> Word32 -> ConstantPoolInfo
forall a b. (a -> b) -> a -> b
$ Int32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
i)
transformEntry (CPFloatEntry Float
f) = ConstantPoolInfo -> Eff r Word32
forall (r :: [(* -> *) -> * -> *]).
ConstantPoolEff r =>
ConstantPoolInfo -> Eff r Word32
lookupOrInsertMCP (Word32 -> ConstantPoolInfo
FloatInfo (Float -> Word32
toJVMFloat Float
f))
transformEntry (CPStringEntry Text
msg) = do
    i <- ConstantPoolEntry -> Eff r Word32
forall (r :: [(* -> *) -> * -> *]).
(HasCallStack, ConstantPoolEff r, Error CodeConverterError :> r) =>
ConstantPoolEntry -> Eff r Word32
transformEntry (Text -> ConstantPoolEntry
CPUTF8Entry Text
msg)
    lookupOrInsertMCP (StringInfo $ unsafeInto i)
transformEntry (CPLongEntry Int64
i) = do
    let (Word32
high, Word32
low) = Int64 -> (Word32, Word32)
toJVMLong Int64
i
    ConstantPoolInfo -> Eff r Word32
forall (r :: [(* -> *) -> * -> *]).
ConstantPoolEff r =>
ConstantPoolInfo -> Eff r Word32
lookupOrInsertMCP (Word32 -> Word32 -> ConstantPoolInfo
LongInfo Word32
high Word32
low)
transformEntry (CPDoubleEntry Double
d) = do
    let (Word32
high, Word32
low) = Int64 -> (Word32, Word32)
toJVMLong (Double -> Int64
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Double
d)
    ConstantPoolInfo -> Eff r Word32
forall (r :: [(* -> *) -> * -> *]).
ConstantPoolEff r =>
ConstantPoolInfo -> Eff r Word32
lookupOrInsertMCP (Word32 -> Word32 -> ConstantPoolInfo
DoubleInfo Word32
high Word32
low)
transformEntry (CPClassEntry ClassInfoType
name) = do
    let className :: Text
className = ClassInfoType -> Text
classInfoTypeDescriptor ClassInfoType
name
    nameIndex <- ConstantPoolEntry -> Eff r Word32
forall (r :: [(* -> *) -> * -> *]).
(HasCallStack, ConstantPoolEff r, Error CodeConverterError :> r) =>
ConstantPoolEntry -> Eff r Word32
transformEntry (Text -> ConstantPoolEntry
CPUTF8Entry Text
className)
    lookupOrInsertMCP (ClassInfo $ unsafeInto nameIndex)
transformEntry (CPMethodRefEntry (MethodRef ClassInfoType
classRef Text
name MethodDescriptor
methodDescriptor)) = do
    classIndex <- ConstantPoolEntry -> Eff r Word32
forall (r :: [(* -> *) -> * -> *]).
(HasCallStack, ConstantPoolEff r, Error CodeConverterError :> r) =>
ConstantPoolEntry -> Eff r Word32
transformEntry (ClassInfoType -> ConstantPoolEntry
CPClassEntry ClassInfoType
classRef)
    nameAndTypeIndex <- transformEntry (CPNameAndTypeEntry name (convertMethodDescriptor methodDescriptor))
    lookupOrInsertMCP (MethodRefInfo (unsafeInto classIndex) (unsafeInto nameAndTypeIndex))
transformEntry (CPInterfaceMethodRefEntry (MethodRef ClassInfoType
classRef Text
name MethodDescriptor
methodDescriptor)) = do
    classIndex <- ConstantPoolEntry -> Eff r Word32
forall (r :: [(* -> *) -> * -> *]).
(HasCallStack, ConstantPoolEff r, Error CodeConverterError :> r) =>
ConstantPoolEntry -> Eff r Word32
transformEntry (ClassInfoType -> ConstantPoolEntry
CPClassEntry ClassInfoType
classRef)
    nameAndTypeIndex <- transformEntry (CPNameAndTypeEntry name (convertMethodDescriptor methodDescriptor))
    lookupOrInsertMCP (InterfaceMethodRefInfo (unsafeInto classIndex) (unsafeInto nameAndTypeIndex))
transformEntry (CPNameAndTypeEntry Text
name Text
descriptor) = do
    nameIndex <- ConstantPoolEntry -> Eff r Word32
forall (r :: [(* -> *) -> * -> *]).
(HasCallStack, ConstantPoolEff r, Error CodeConverterError :> r) =>
ConstantPoolEntry -> Eff r Word32
transformEntry (Text -> ConstantPoolEntry
CPUTF8Entry Text
name)
    descriptorIndex <- transformEntry (CPUTF8Entry descriptor)
    lookupOrInsertMCP (NameAndTypeInfo (unsafeInto nameIndex) (unsafeInto descriptorIndex))
transformEntry (CPFieldRefEntry (FieldRef ClassInfoType
classRef Text
name FieldType
fieldType)) = do
    classIndex <- ConstantPoolEntry -> Eff r Word32
forall (r :: [(* -> *) -> * -> *]).
(HasCallStack, ConstantPoolEff r, Error CodeConverterError :> r) =>
ConstantPoolEntry -> Eff r Word32
transformEntry (ClassInfoType -> ConstantPoolEntry
CPClassEntry ClassInfoType
classRef)
    nameAndTypeIndex <- transformEntry (CPNameAndTypeEntry name (fieldTypeDescriptor fieldType))
    lookupOrInsertMCP (FieldRefInfo (unsafeInto classIndex) (unsafeInto nameAndTypeIndex))
transformEntry (CPMethodHandleEntry MethodHandleEntry
methodHandleEntry) = do
    let transformFieldMHE :: FieldRef -> Eff r U2
transformFieldMHE f :: FieldRef
f@(FieldRef{}) = ConstantPoolEntry -> Eff r U2
forall (r :: [(* -> *) -> * -> *]).
(HasCallStack, ConstantPoolEff r) =>
ConstantPoolEntry -> Eff r U2
findIndexOf (FieldRef -> ConstantPoolEntry
CPFieldRefEntry FieldRef
f)
    let transformMethodMHE :: MethodRef -> Eff r U2
transformMethodMHE m :: MethodRef
m@(MethodRef{}) = ConstantPoolEntry -> Eff r U2
forall (r :: [(* -> *) -> * -> *]).
(HasCallStack, ConstantPoolEff r) =>
ConstantPoolEntry -> Eff r U2
findIndexOf (MethodRef -> ConstantPoolEntry
CPMethodRefEntry MethodRef
m)

    (referenceKind, referenceIndex) <- case MethodHandleEntry
methodHandleEntry of
        MHGetField FieldRef
fr -> do
            fri <- FieldRef -> Eff r U2
forall {r :: [(* -> *) -> * -> *]}.
(State ConstantPoolState :> r, Error CodeConverterError :> r) =>
FieldRef -> Eff r U2
transformFieldMHE FieldRef
fr
            pure (_REF_getField, fri)
        MHGetStatic FieldRef
fr -> do
            fri <- FieldRef -> Eff r U2
forall {r :: [(* -> *) -> * -> *]}.
(State ConstantPoolState :> r, Error CodeConverterError :> r) =>
FieldRef -> Eff r U2
transformFieldMHE FieldRef
fr
            pure (_REF_getStatic, fri)
        MHPutField FieldRef
fr -> do
            fri <- FieldRef -> Eff r U2
forall {r :: [(* -> *) -> * -> *]}.
(State ConstantPoolState :> r, Error CodeConverterError :> r) =>
FieldRef -> Eff r U2
transformFieldMHE FieldRef
fr
            pure (_REF_putField, fri)
        MHPutStatic FieldRef
fr -> do
            fri <- FieldRef -> Eff r U2
forall {r :: [(* -> *) -> * -> *]}.
(State ConstantPoolState :> r, Error CodeConverterError :> r) =>
FieldRef -> Eff r U2
transformFieldMHE FieldRef
fr
            pure (_REF_putStatic, fri)
        MHInvokeVirtual MethodRef
mr -> do
            mri <- MethodRef -> Eff r U2
forall {r :: [(* -> *) -> * -> *]}.
(State ConstantPoolState :> r, Error CodeConverterError :> r) =>
MethodRef -> Eff r U2
transformMethodMHE MethodRef
mr
            pure (_REF_invokeVirtual, mri)
        MHNewInvokeSpecial MethodRef
mr -> do
            mri <- MethodRef -> Eff r U2
forall {r :: [(* -> *) -> * -> *]}.
(State ConstantPoolState :> r, Error CodeConverterError :> r) =>
MethodRef -> Eff r U2
transformMethodMHE MethodRef
mr
            pure (_REF_newInvokeSpecial, mri)
        MHInvokeStatic MethodRef
mr -> do
            mri <- MethodRef -> Eff r U2
forall {r :: [(* -> *) -> * -> *]}.
(State ConstantPoolState :> r, Error CodeConverterError :> r) =>
MethodRef -> Eff r U2
transformMethodMHE MethodRef
mr
            pure (_REF_invokeStatic, mri)
        MHInvokeSpecial MethodRef
mr -> do
            mri <- MethodRef -> Eff r U2
forall {r :: [(* -> *) -> * -> *]}.
(State ConstantPoolState :> r, Error CodeConverterError :> r) =>
MethodRef -> Eff r U2
transformMethodMHE MethodRef
mr
            pure (_REF_invokeSpecial, mri)
        MHInvokeInterface MethodRef
mr -> do
            mri <- MethodRef -> Eff r U2
forall {r :: [(* -> *) -> * -> *]}.
(State ConstantPoolState :> r, Error CodeConverterError :> r) =>
MethodRef -> Eff r U2
transformMethodMHE MethodRef
mr
            pure (_REF_invokeInterface, mri)
    lookupOrInsertMCP (MethodHandleInfo referenceKind referenceIndex)
transformEntry (CPInvokeDynamicEntry BootstrapMethod
bootstrapMethod Text
name MethodDescriptor
methodDescriptor) = do
    nameAndTypeIndex <- ConstantPoolEntry -> Eff r U2
forall (r :: [(* -> *) -> * -> *]).
(HasCallStack, ConstantPoolEff r) =>
ConstantPoolEntry -> Eff r U2
findIndexOf (Text -> Text -> ConstantPoolEntry
CPNameAndTypeEntry Text
name (MethodDescriptor -> Text
convertMethodDescriptor MethodDescriptor
methodDescriptor))
    bmIndex <- convertBootstrapMethod bootstrapMethod
    if bmIndex == 0 -- bootstrap methods are 0 indexed because of course they are
    -- since IndexedMap is 1-indexed, this should always be at least 1
    -- but it's better to guard against it here explicitly than get a more obscure underflow error from unsafeInto
        then bug "Invalid Bootstrap Method Index 0"
        else
            lookupOrInsertMCP
                ( InvokeDynamicInfo
                    (unsafeInto bmIndex - 1)
                    (into nameAndTypeIndex)
                )
transformEntry (CPMethodTypeEntry MethodDescriptor
methodDescriptor) = do
    descriptorIndex <- ConstantPoolEntry -> Eff r Word32
forall (r :: [(* -> *) -> * -> *]).
(HasCallStack, ConstantPoolEff r, Error CodeConverterError :> r) =>
ConstantPoolEntry -> Eff r Word32
transformEntry (Text -> ConstantPoolEntry
CPUTF8Entry (MethodDescriptor -> Text
convertMethodDescriptor MethodDescriptor
methodDescriptor))
    lookupOrInsertMCP (MethodTypeInfo (unsafeInto descriptorIndex))

-- | Convert a 'BootstrapMethod' to its low level representation by upserting it into the 'ConstantPoolState'.
convertBootstrapMethod :: ConstantPoolEff r => BootstrapMethod -> Eff r Word32
convertBootstrapMethod :: forall (r :: [(* -> *) -> * -> *]).
ConstantPoolEff r =>
BootstrapMethod -> Eff r Word32
convertBootstrapMethod (BootstrapMethod MethodHandleEntry
mhEntry [BootstrapArgument]
args) = do
    mhIndex <- ConstantPoolEntry -> Eff r U2
forall (r :: [(* -> *) -> * -> *]).
(HasCallStack, ConstantPoolEff r) =>
ConstantPoolEntry -> Eff r U2
findIndexOf (MethodHandleEntry -> ConstantPoolEntry
CPMethodHandleEntry MethodHandleEntry
mhEntry) -- upsert a method handle entry to the CP
    bsArgs <- traverse (findIndexOf . bmArgToCPEntry) args -- upsert each argument into the CP
    let bootstrapMethod = U2 -> Vector U2 -> BootstrapMethod
Raw.BootstrapMethod (U2 -> U2
forall target source. From source target => source -> target
into U2
mhIndex) ([U2] -> Vector U2
forall a. [a] -> Vector a
V.fromList [U2]
bsArgs) -- construct raw BM
    lookupOrInsertMBM bootstrapMethod -- upsert BM

instance Semigroup ConstantPoolState where
    (ConstantPoolState IndexedMap ConstantPoolInfo
cp1 IndexedMap BootstrapMethod
bm1) <> :: ConstantPoolState -> ConstantPoolState -> ConstantPoolState
<> (ConstantPoolState IndexedMap ConstantPoolInfo
cp2 IndexedMap BootstrapMethod
bm2) = IndexedMap ConstantPoolInfo
-> IndexedMap BootstrapMethod -> ConstantPoolState
ConstantPoolState (IndexedMap ConstantPoolInfo
cp1 IndexedMap ConstantPoolInfo
-> IndexedMap ConstantPoolInfo -> IndexedMap ConstantPoolInfo
forall a. Semigroup a => a -> a -> a
<> IndexedMap ConstantPoolInfo
cp2) (IndexedMap BootstrapMethod
bm1 IndexedMap BootstrapMethod
-> IndexedMap BootstrapMethod -> IndexedMap BootstrapMethod
forall a. Semigroup a => a -> a -> a
<> IndexedMap BootstrapMethod
bm2)

instance Monoid ConstantPoolState where
    mempty :: ConstantPoolState
mempty = IndexedMap ConstantPoolInfo
-> IndexedMap BootstrapMethod -> ConstantPoolState
ConstantPoolState IndexedMap ConstantPoolInfo
forall a. Monoid a => a
mempty IndexedMap BootstrapMethod
forall a. Monoid a => a
mempty

-- | Find the index of a constant pool entry, inserting it in the first free location if it doesn't exist.
findIndexOf :: forall r. (HasCallStack, ConstantPoolEff r) => ConstantPoolEntry -> Eff r U2
findIndexOf :: forall (r :: [(* -> *) -> * -> *]).
(HasCallStack, ConstantPoolEff r) =>
ConstantPoolEntry -> Eff r U2
findIndexOf = ConstantPoolEntry -> Eff r Word32
forall (r :: [(* -> *) -> * -> *]).
(HasCallStack, ConstantPoolEff r, Error CodeConverterError :> r) =>
ConstantPoolEntry -> Eff r Word32
transformEntry (ConstantPoolEntry -> Eff r Word32)
-> (Word32 -> Eff r U2) -> ConstantPoolEntry -> Eff r U2
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Word32 -> Eff r U2
toU2OrError
  where
    toU2OrError :: Word32 -> Eff r U2
    toU2OrError :: Word32 -> Eff r U2
toU2OrError Word32
i =
        if Word32
i Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
> U2 -> Word32
forall target source. From source target => source -> target
into (forall a. Bounded a => a
maxBound @U2)
            then CodeConverterError -> Eff r U2
forall e (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, Error e :> es, Show e) =>
e -> Eff es a
throwError CodeConverterError
ConstantPoolOverflow
            else U2 -> Eff r U2
forall a. a -> Eff r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (U2 -> Eff r U2) -> U2 -> Eff r U2
forall a b. (a -> b) -> a -> b
$ Word32 -> U2
forall target source.
(HasCallStack, TryFrom source target, Show source, Typeable source,
 Typeable target) =>
source -> target
unsafeInto Word32
i