{-# LANGUAGE LexicalNegation #-}

{- | Converts abstract instructions into raw instructions
 This includes resolving labels into offsets
 TODO: this is very inefficient, requiring three passes over the instructions
-}
module JVM.Data.Convert.Instruction (CodeConverterEff, fullyRunCodeConverter, convertInstructions, fullyResolveAbs) where

import Data.Map (Map)
import Data.Map qualified as Map
import Data.Maybe
import JVM.Data.Abstract.Builder.Label
import JVM.Data.Abstract.ConstantPool (ConstantPoolEntry (..), FieldRef (..), MethodRef (..))
import JVM.Data.Abstract.Descriptor
import JVM.Data.Abstract.Instruction as Abs (Instruction, Instruction' (..), LDCEntry (..))
import JVM.Data.Abstract.Type
import JVM.Data.Convert.ConstantPool
import JVM.Data.Raw.Instruction as Raw (Instruction (..))

import Data.Word (Word16)
import Effectful
import Effectful.Error.Static
import Effectful.State.Static.Local
import JVM.Data.Convert.Monad
import JVM.Data.Raw.MagicNumbers qualified as MagicNumbers
import JVM.Data.Raw.Types (U1, U2, UnsafeNumConvert (unsafeNumConvert))

type CodeConverterEff r = (ConstantPool :> r, State ConvertState :> r, Error CodeConverterError :> r)

fullyRunCodeConverter :: (ConvertEff r') => Eff (State ConvertState : r') a -> Eff r' a
fullyRunCodeConverter :: forall (r' :: [Effect]) a.
ConvertEff r' =>
Eff (State ConvertState : r') a -> Eff r' a
fullyRunCodeConverter Eff (State ConvertState : r') a
r = do
    (a, _) <- ConvertState
-> Eff (State ConvertState : r') a -> Eff r' (a, ConvertState)
forall s (es :: [Effect]) a.
HasCallStack =>
s -> Eff (State s : es) a -> Eff es (a, s)
runState (U2 -> Map Label U2 -> ConvertState
ConvertState U2
0 Map Label U2
forall k a. Map k a
Map.empty) Eff (State ConvertState : r') a
r
    pure a

data ConvertState = ConvertState
    { ConvertState -> U2
currentOffset :: Word16
    , ConvertState -> Map Label U2
labelOffsets :: Map Label Word16
    }

countArguments :: MethodDescriptor -> Int
countArguments :: MethodDescriptor -> Int
countArguments (MethodDescriptor [FieldType]
args ReturnDescriptor
_) = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((FieldType -> Int) -> [FieldType] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map FieldType -> Int
countArgument [FieldType]
args)
  where
    countArgument :: FieldType -> Int
    countArgument :: FieldType -> Int
countArgument (PrimitiveFieldType PrimitiveType
Double) = Int
2
    countArgument (PrimitiveFieldType PrimitiveType
Long) = Int
2
    countArgument FieldType
_ = Int
1

-- | The size of an instruction in bytes, used for calculating jump offsets
instructionSize :: Abs.Instruction -> Word16
instructionSize :: Instruction -> U2
instructionSize (Abs.ALoad U2
n)
    | U2
n U2 -> U2 -> Bool
forall a. Ord a => a -> a -> Bool
<= U2
3 = U2
1
    | U2
n U2 -> U2 -> Bool
forall a. Ord a => a -> a -> Bool
<= U2
255 = U2
2
    | Bool
otherwise = U2
4 -- wide (1) + opcode (1) + index (2)
instructionSize (Abs.AStore U2
n)
    | U2
n U2 -> U2 -> Bool
forall a. Ord a => a -> a -> Bool
<= U2
3 = U2
1
    | U2
n U2 -> U2 -> Bool
forall a. Ord a => a -> a -> Bool
<= U2
255 = U2
2
    | Bool
otherwise = U2
4
instructionSize (Abs.ILoad U2
n)
    | U2
n U2 -> U2 -> Bool
forall a. Ord a => a -> a -> Bool
<= U2
3 = U2
1
    | U2
n U2 -> U2 -> Bool
forall a. Ord a => a -> a -> Bool
<= U2
255 = U2
2
    | Bool
otherwise = U2
4
instructionSize (Abs.IStore U2
n)
    | U2
n U2 -> U2 -> Bool
forall a. Ord a => a -> a -> Bool
<= U2
3 = U2
1
    | U2
n U2 -> U2 -> Bool
forall a. Ord a => a -> a -> Bool
<= U2
255 = U2
2
    | Bool
otherwise = U2
4
instructionSize Instruction
Abs.AReturn = U2
1
instructionSize Instruction
Abs.AConstNull = U2
1
instructionSize Instruction
Abs.IAnd = U2
1
instructionSize (Abs.IfEq Label
_) = U2
3
instructionSize (Abs.IfNe Label
_) = U2
3
instructionSize (Abs.IfLt Label
_) = U2
3
instructionSize (Abs.IfGe Label
_) = U2
3
instructionSize (Abs.IfGt Label
_) = U2
3
instructionSize (Abs.IfLe Label
_) = U2
3
instructionSize (Abs.Instanceof{}) = U2
3
instructionSize (Abs.InvokeStatic{}) = U2
3
instructionSize (Abs.InvokeVirtual{}) = U2
3
instructionSize (Abs.InvokeInterface{}) = U2
5
instructionSize (Abs.InvokeDynamic{}) = U2
5
instructionSize (Abs.InvokeSpecial{}) = U2
3
instructionSize Instruction
Abs.IOr = U2
1
instructionSize (Abs.Label Label
_) = U2
0
instructionSize (Abs.LDC LDCEntry
_) = U2
3
instructionSize (Abs.PutStatic{}) = U2
3
instructionSize (Abs.GetField{}) = U2
3
instructionSize (Abs.GetStatic{}) = U2
3
instructionSize (Abs.PutField{}) = U2
3
instructionSize (Abs.CheckCast ClassInfoType
_) = U2
3
instructionSize Instruction
Abs.Return = U2
1
instructionSize Instruction
Abs.IReturn = U2
1
instructionSize Instruction
Abs.IConst0 = U2
1
instructionSize Instruction
Abs.IConst1 = U2
1
instructionSize Instruction
Abs.Dup = U2
1
instructionSize (Abs.Goto Label
_) = U2
3
instructionSize (Abs.New ClassInfoType
_) = U2
3

convertInstructions :: (CodeConverterEff r) => [Abs.Instruction] -> Eff r [Raw.Instruction]
convertInstructions :: forall (r :: [Effect]).
CodeConverterEff r =>
[Instruction] -> Eff r [Instruction]
convertInstructions [Instruction]
xs = do
    withOffsets <- [Instruction] -> Eff r [OffsetInstruction Instruction]
forall (r :: [Effect]).
CodeConverterEff r =>
[Instruction] -> Eff r [OffsetInstruction Instruction]
insertAllLabels [Instruction]
xs
    insts <- traverse (resolveLabel . fmap (fmap UnresolvedLabel)) withOffsets
    catMaybes <$> traverse convertInstruction insts

data MaybeResolvedLabel = ResolvedLabel Word16 | UnresolvedLabel Label

data OffsetInstruction a = OffsetInstruction Word16 a
    deriving (Int -> OffsetInstruction a -> ShowS
[OffsetInstruction a] -> ShowS
OffsetInstruction a -> String
(Int -> OffsetInstruction a -> ShowS)
-> (OffsetInstruction a -> String)
-> ([OffsetInstruction a] -> ShowS)
-> Show (OffsetInstruction a)
forall a. Show a => Int -> OffsetInstruction a -> ShowS
forall a. Show a => [OffsetInstruction a] -> ShowS
forall a. Show a => OffsetInstruction a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> OffsetInstruction a -> ShowS
showsPrec :: Int -> OffsetInstruction a -> ShowS
$cshow :: forall a. Show a => OffsetInstruction a -> String
show :: OffsetInstruction a -> String
$cshowList :: forall a. Show a => [OffsetInstruction a] -> ShowS
showList :: [OffsetInstruction a] -> ShowS
Show, OffsetInstruction a -> OffsetInstruction a -> Bool
(OffsetInstruction a -> OffsetInstruction a -> Bool)
-> (OffsetInstruction a -> OffsetInstruction a -> Bool)
-> Eq (OffsetInstruction a)
forall a.
Eq a =>
OffsetInstruction a -> OffsetInstruction a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a.
Eq a =>
OffsetInstruction a -> OffsetInstruction a -> Bool
== :: OffsetInstruction a -> OffsetInstruction a -> Bool
$c/= :: forall a.
Eq a =>
OffsetInstruction a -> OffsetInstruction a -> Bool
/= :: OffsetInstruction a -> OffsetInstruction a -> Bool
Eq, Eq (OffsetInstruction a)
Eq (OffsetInstruction a) =>
(OffsetInstruction a -> OffsetInstruction a -> Ordering)
-> (OffsetInstruction a -> OffsetInstruction a -> Bool)
-> (OffsetInstruction a -> OffsetInstruction a -> Bool)
-> (OffsetInstruction a -> OffsetInstruction a -> Bool)
-> (OffsetInstruction a -> OffsetInstruction a -> Bool)
-> (OffsetInstruction a
    -> OffsetInstruction a -> OffsetInstruction a)
-> (OffsetInstruction a
    -> OffsetInstruction a -> OffsetInstruction a)
-> Ord (OffsetInstruction a)
OffsetInstruction a -> OffsetInstruction a -> Bool
OffsetInstruction a -> OffsetInstruction a -> Ordering
OffsetInstruction a -> OffsetInstruction a -> OffsetInstruction a
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
forall a. Ord a => Eq (OffsetInstruction a)
forall a.
Ord a =>
OffsetInstruction a -> OffsetInstruction a -> Bool
forall a.
Ord a =>
OffsetInstruction a -> OffsetInstruction a -> Ordering
forall a.
Ord a =>
OffsetInstruction a -> OffsetInstruction a -> OffsetInstruction a
$ccompare :: forall a.
Ord a =>
OffsetInstruction a -> OffsetInstruction a -> Ordering
compare :: OffsetInstruction a -> OffsetInstruction a -> Ordering
$c< :: forall a.
Ord a =>
OffsetInstruction a -> OffsetInstruction a -> Bool
< :: OffsetInstruction a -> OffsetInstruction a -> Bool
$c<= :: forall a.
Ord a =>
OffsetInstruction a -> OffsetInstruction a -> Bool
<= :: OffsetInstruction a -> OffsetInstruction a -> Bool
$c> :: forall a.
Ord a =>
OffsetInstruction a -> OffsetInstruction a -> Bool
> :: OffsetInstruction a -> OffsetInstruction a -> Bool
$c>= :: forall a.
Ord a =>
OffsetInstruction a -> OffsetInstruction a -> Bool
>= :: OffsetInstruction a -> OffsetInstruction a -> Bool
$cmax :: forall a.
Ord a =>
OffsetInstruction a -> OffsetInstruction a -> OffsetInstruction a
max :: OffsetInstruction a -> OffsetInstruction a -> OffsetInstruction a
$cmin :: forall a.
Ord a =>
OffsetInstruction a -> OffsetInstruction a -> OffsetInstruction a
min :: OffsetInstruction a -> OffsetInstruction a -> OffsetInstruction a
Ord, (forall a b.
 (a -> b) -> OffsetInstruction a -> OffsetInstruction b)
-> (forall a b. a -> OffsetInstruction b -> OffsetInstruction a)
-> Functor OffsetInstruction
forall a b. a -> OffsetInstruction b -> OffsetInstruction a
forall a b. (a -> b) -> OffsetInstruction a -> OffsetInstruction b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> OffsetInstruction a -> OffsetInstruction b
fmap :: forall a b. (a -> b) -> OffsetInstruction a -> OffsetInstruction b
$c<$ :: forall a b. a -> OffsetInstruction b -> OffsetInstruction a
<$ :: forall a b. a -> OffsetInstruction b -> OffsetInstruction a
Functor)

-- | Inserts the corresponding label offsets into the state
insertAllLabels :: (CodeConverterEff r) => [Abs.Instruction] -> Eff r [OffsetInstruction Abs.Instruction]
insertAllLabels :: forall (r :: [Effect]).
CodeConverterEff r =>
[Instruction] -> Eff r [OffsetInstruction Instruction]
insertAllLabels = (Instruction -> Eff r (OffsetInstruction Instruction))
-> [Instruction] -> Eff r [OffsetInstruction Instruction]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (\Instruction
x -> Instruction -> Eff r ()
forall (r :: [Effect]).
CodeConverterEff r =>
Instruction -> Eff r ()
incOffset Instruction
x Eff r ()
-> Eff r (OffsetInstruction Instruction)
-> Eff r (OffsetInstruction Instruction)
forall a b. Eff r a -> Eff r b -> Eff r b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Instruction -> Eff r (OffsetInstruction Instruction)
forall (r :: [Effect]).
CodeConverterEff r =>
Instruction -> Eff r (OffsetInstruction Instruction)
insertLabel Instruction
x)
  where
    incOffset :: (CodeConverterEff r) => Abs.Instruction -> Eff r ()
    incOffset :: forall (r :: [Effect]).
CodeConverterEff r =>
Instruction -> Eff r ()
incOffset (Label Label
_) = () -> Eff r ()
forall a. a -> Eff r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure () -- Label instructions have no representation in the bytecode, so they don't affect the offset
    incOffset Instruction
inst = do
        offset <- (ConvertState -> U2) -> Eff r U2
forall s (es :: [Effect]) a.
(HasCallStack, State s :> es) =>
(s -> a) -> Eff es a
gets (.currentOffset)
        let size = Instruction -> U2
instructionSize Instruction
inst
        modify (\ConvertState
s -> ConvertState
s{currentOffset = offset + size})

    insertLabel :: (CodeConverterEff r) => Abs.Instruction -> Eff r (OffsetInstruction Abs.Instruction)
    insertLabel :: forall (r :: [Effect]).
CodeConverterEff r =>
Instruction -> Eff r (OffsetInstruction Instruction)
insertLabel (Label Label
l) = do
        currentOffset <- (ConvertState -> U2) -> Eff r U2
forall s (es :: [Effect]) a.
(HasCallStack, State s :> es) =>
(s -> a) -> Eff es a
gets (.currentOffset)

        JVM.Data.Convert.Instruction.modifyM $ \ConvertState
s -> do
            case Label -> Map Label U2 -> Maybe U2
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Label
l ConvertState
s.labelOffsets of
                Just U2
_ -> CodeConverterError -> Eff r ConvertState
forall e (es :: [Effect]) a.
(HasCallStack, Error e :> es, Show e) =>
e -> Eff es a
throwError (Label -> U2 -> CodeConverterError
DuplicateLabel Label
l U2
currentOffset)
                Maybe U2
Nothing -> do
                    ConvertState -> Eff r ConvertState
forall a. a -> Eff r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConvertState
s{labelOffsets = Map.insert l currentOffset s.labelOffsets})
        pure (OffsetInstruction (error "Label offset should not be evaluated") (Label l))
    insertLabel Instruction
x = do
        offset <- (ConvertState -> U2) -> Eff r U2
forall s (es :: [Effect]) a.
(HasCallStack, State s :> es) =>
(s -> a) -> Eff es a
gets (.currentOffset)
        pure (OffsetInstruction (offset - instructionSize x) x)

modifyM :: ((State s) :> r) => (s -> Eff r s) -> Eff r ()
modifyM :: forall s (r :: [Effect]).
(State s :> r) =>
(s -> Eff r s) -> Eff r ()
modifyM s -> Eff r s
f = Eff r s
forall s (es :: [Effect]).
(HasCallStack, State s :> es) =>
Eff es s
get Eff r s -> (s -> Eff r s) -> Eff r s
forall a b. Eff r a -> (a -> Eff r b) -> Eff r b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= s -> Eff r s
f Eff r s -> (s -> Eff r ()) -> Eff r ()
forall a b. Eff r a -> (a -> Eff r b) -> Eff r b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= s -> Eff r ()
forall s (es :: [Effect]).
(HasCallStack, State s :> es) =>
s -> Eff es ()
put

-- | Turns labels into offsets where possible
resolveLabel :: (CodeConverterEff r) => OffsetInstruction (Abs.Instruction' MaybeResolvedLabel) -> Eff r (OffsetInstruction (Abs.Instruction' MaybeResolvedLabel))
resolveLabel :: forall (r :: [Effect]).
CodeConverterEff r =>
OffsetInstruction (Instruction' MaybeResolvedLabel)
-> Eff r (OffsetInstruction (Instruction' MaybeResolvedLabel))
resolveLabel (OffsetInstruction U2
instOffset Instruction' MaybeResolvedLabel
inst) =
    U2
-> Instruction' MaybeResolvedLabel
-> OffsetInstruction (Instruction' MaybeResolvedLabel)
forall a. U2 -> a -> OffsetInstruction a
OffsetInstruction U2
instOffset (Instruction' MaybeResolvedLabel
 -> OffsetInstruction (Instruction' MaybeResolvedLabel))
-> Eff r (Instruction' MaybeResolvedLabel)
-> Eff r (OffsetInstruction (Instruction' MaybeResolvedLabel))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Instruction' MaybeResolvedLabel
inst of
        Abs.IfEq MaybeResolvedLabel
l -> MaybeResolvedLabel -> Instruction' MaybeResolvedLabel
forall label. label -> Instruction' label
Abs.IfEq (MaybeResolvedLabel -> Instruction' MaybeResolvedLabel)
-> Eff r MaybeResolvedLabel
-> Eff r (Instruction' MaybeResolvedLabel)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MaybeResolvedLabel -> Eff r MaybeResolvedLabel
forall (r :: [Effect]).
CodeConverterEff r =>
MaybeResolvedLabel -> Eff r MaybeResolvedLabel
resolveLabelAbs MaybeResolvedLabel
l
        Abs.IfNe MaybeResolvedLabel
l -> MaybeResolvedLabel -> Instruction' MaybeResolvedLabel
forall label. label -> Instruction' label
Abs.IfNe (MaybeResolvedLabel -> Instruction' MaybeResolvedLabel)
-> Eff r MaybeResolvedLabel
-> Eff r (Instruction' MaybeResolvedLabel)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MaybeResolvedLabel -> Eff r MaybeResolvedLabel
forall (r :: [Effect]).
CodeConverterEff r =>
MaybeResolvedLabel -> Eff r MaybeResolvedLabel
resolveLabelAbs MaybeResolvedLabel
l
        Abs.IfLt MaybeResolvedLabel
l -> MaybeResolvedLabel -> Instruction' MaybeResolvedLabel
forall label. label -> Instruction' label
Abs.IfLt (MaybeResolvedLabel -> Instruction' MaybeResolvedLabel)
-> Eff r MaybeResolvedLabel
-> Eff r (Instruction' MaybeResolvedLabel)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MaybeResolvedLabel -> Eff r MaybeResolvedLabel
forall (r :: [Effect]).
CodeConverterEff r =>
MaybeResolvedLabel -> Eff r MaybeResolvedLabel
resolveLabelAbs MaybeResolvedLabel
l
        Abs.IfGe MaybeResolvedLabel
l -> MaybeResolvedLabel -> Instruction' MaybeResolvedLabel
forall label. label -> Instruction' label
Abs.IfGe (MaybeResolvedLabel -> Instruction' MaybeResolvedLabel)
-> Eff r MaybeResolvedLabel
-> Eff r (Instruction' MaybeResolvedLabel)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MaybeResolvedLabel -> Eff r MaybeResolvedLabel
forall (r :: [Effect]).
CodeConverterEff r =>
MaybeResolvedLabel -> Eff r MaybeResolvedLabel
resolveLabelAbs MaybeResolvedLabel
l
        Abs.IfGt MaybeResolvedLabel
l -> MaybeResolvedLabel -> Instruction' MaybeResolvedLabel
forall label. label -> Instruction' label
Abs.IfGt (MaybeResolvedLabel -> Instruction' MaybeResolvedLabel)
-> Eff r MaybeResolvedLabel
-> Eff r (Instruction' MaybeResolvedLabel)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MaybeResolvedLabel -> Eff r MaybeResolvedLabel
forall (r :: [Effect]).
CodeConverterEff r =>
MaybeResolvedLabel -> Eff r MaybeResolvedLabel
resolveLabelAbs MaybeResolvedLabel
l
        Abs.IfLe MaybeResolvedLabel
l -> MaybeResolvedLabel -> Instruction' MaybeResolvedLabel
forall label. label -> Instruction' label
Abs.IfLe (MaybeResolvedLabel -> Instruction' MaybeResolvedLabel)
-> Eff r MaybeResolvedLabel
-> Eff r (Instruction' MaybeResolvedLabel)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MaybeResolvedLabel -> Eff r MaybeResolvedLabel
forall (r :: [Effect]).
CodeConverterEff r =>
MaybeResolvedLabel -> Eff r MaybeResolvedLabel
resolveLabelAbs MaybeResolvedLabel
l
        Abs.Goto MaybeResolvedLabel
l -> MaybeResolvedLabel -> Instruction' MaybeResolvedLabel
forall label. label -> Instruction' label
Abs.Goto (MaybeResolvedLabel -> Instruction' MaybeResolvedLabel)
-> Eff r MaybeResolvedLabel
-> Eff r (Instruction' MaybeResolvedLabel)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MaybeResolvedLabel -> Eff r MaybeResolvedLabel
forall (r :: [Effect]).
CodeConverterEff r =>
MaybeResolvedLabel -> Eff r MaybeResolvedLabel
resolveLabelAbs MaybeResolvedLabel
l
        Instruction' MaybeResolvedLabel
_ -> Instruction' MaybeResolvedLabel
-> Eff r (Instruction' MaybeResolvedLabel)
forall a. a -> Eff r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Instruction' MaybeResolvedLabel
inst

fullyResolveAbs :: (CodeConverterEff r) => Label -> Eff r Word16
fullyResolveAbs :: forall (r :: [Effect]). CodeConverterEff r => Label -> Eff r U2
fullyResolveAbs Label
l = do
    x <- MaybeResolvedLabel -> Eff r MaybeResolvedLabel
forall (r :: [Effect]).
CodeConverterEff r =>
MaybeResolvedLabel -> Eff r MaybeResolvedLabel
resolveLabelAbs (Label -> MaybeResolvedLabel
UnresolvedLabel Label
l)
    mustBeResolvedAbs x

-- | Attempt to resolve a label to an __absolute__ offset
resolveLabelAbs :: (CodeConverterEff r) => MaybeResolvedLabel -> Eff r MaybeResolvedLabel
resolveLabelAbs :: forall (r :: [Effect]).
CodeConverterEff r =>
MaybeResolvedLabel -> Eff r MaybeResolvedLabel
resolveLabelAbs r :: MaybeResolvedLabel
r@(ResolvedLabel U2
_) = MaybeResolvedLabel -> Eff r MaybeResolvedLabel
forall a. a -> Eff r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MaybeResolvedLabel
r
resolveLabelAbs (UnresolvedLabel Label
l) = do
    offset <- (ConvertState -> Maybe U2) -> Eff r (Maybe U2)
forall s (es :: [Effect]) a.
(HasCallStack, State s :> es) =>
(s -> a) -> Eff es a
gets (Label -> Map Label U2 -> Maybe U2
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Label
l (Map Label U2 -> Maybe U2)
-> (ConvertState -> Map Label U2) -> ConvertState -> Maybe U2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.labelOffsets))
    case offset of
        Just U2
o -> MaybeResolvedLabel -> Eff r MaybeResolvedLabel
forall a. a -> Eff r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (U2 -> MaybeResolvedLabel
ResolvedLabel U2
o)
        Maybe U2
Nothing -> MaybeResolvedLabel -> Eff r MaybeResolvedLabel
forall a. a -> Eff r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Label -> MaybeResolvedLabel
UnresolvedLabel Label
l)

-- | Attempt to resolve a label to an __absolute__ offset, throwing an error if it cannot be resolved
mustBeResolvedAbs :: (CodeConverterEff r) => MaybeResolvedLabel -> Eff r Word16
mustBeResolvedAbs :: forall (r :: [Effect]).
CodeConverterEff r =>
MaybeResolvedLabel -> Eff r U2
mustBeResolvedAbs (ResolvedLabel U2
i) = U2 -> Eff r U2
forall a. a -> Eff r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure U2
i
mustBeResolvedAbs (UnresolvedLabel Label
l) = CodeConverterError -> Eff r U2
forall e (es :: [Effect]) a.
(HasCallStack, Error e :> es, Show e) =>
e -> Eff es a
throwError (Label -> CodeConverterError
UnmarkedLabel Label
l)

mustBeResolved :: (CodeConverterEff r) => Word16 -> MaybeResolvedLabel -> Eff r Word16
mustBeResolved :: forall (r :: [Effect]).
CodeConverterEff r =>
U2 -> MaybeResolvedLabel -> Eff r U2
mustBeResolved U2
instOffset = (U2 -> U2) -> Eff r U2 -> Eff r U2
forall a b. (a -> b) -> Eff r a -> Eff r b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (U2 -> U2 -> U2
forall a. Num a => a -> a -> a
- U2
instOffset) (Eff r U2 -> Eff r U2)
-> (MaybeResolvedLabel -> Eff r U2)
-> MaybeResolvedLabel
-> Eff r U2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MaybeResolvedLabel -> Eff r U2
forall (r :: [Effect]).
CodeConverterEff r =>
MaybeResolvedLabel -> Eff r U2
mustBeResolvedAbs

convertInstruction :: (CodeConverterEff r) => OffsetInstruction (Abs.Instruction' MaybeResolvedLabel) -> Eff r (Maybe Raw.Instruction)
convertInstruction :: forall (r :: [Effect]).
CodeConverterEff r =>
OffsetInstruction (Instruction' MaybeResolvedLabel)
-> Eff r (Maybe Instruction)
convertInstruction (OffsetInstruction U2
_ (Abs.Label MaybeResolvedLabel
_)) = Maybe Instruction -> Eff r (Maybe Instruction)
forall a. a -> Eff r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Instruction
forall a. Maybe a
Nothing
convertInstruction (OffsetInstruction U2
instOffset Instruction' MaybeResolvedLabel
o) = Instruction -> Maybe Instruction
forall a. a -> Maybe a
Just (Instruction -> Maybe Instruction)
-> Eff r Instruction -> Eff r (Maybe Instruction)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Instruction' MaybeResolvedLabel -> Eff r Instruction
convertInstruction Instruction' MaybeResolvedLabel
o
  where
    convertInstruction :: Instruction' MaybeResolvedLabel -> Eff r Instruction
convertInstruction (Abs.ALoad U2
0) = Instruction -> Eff r Instruction
forall a. a -> Eff r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Instruction
Raw.ALoad0
    convertInstruction (Abs.ALoad U2
1) = Instruction -> Eff r Instruction
forall a. a -> Eff r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Instruction
Raw.ALoad1
    convertInstruction (Abs.ALoad U2
2) = Instruction -> Eff r Instruction
forall a. a -> Eff r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Instruction
Raw.ALoad2
    convertInstruction (Abs.ALoad U2
3) = Instruction -> Eff r Instruction
forall a. a -> Eff r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Instruction
Raw.ALoad3
    convertInstruction (Abs.ALoad U2
idx)
        | Just U1
i <- forall a b. UnsafeNumConvert a b => a -> Maybe b
unsafeNumConvert @U2 @U1 U2
idx = Instruction -> Eff r Instruction
forall a. a -> Eff r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (U1 -> Instruction
Raw.ALoad U1
i)
        | Bool
otherwise = Instruction -> Eff r Instruction
forall a. a -> Eff r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (U1 -> U2 -> Instruction
Raw.Wide1 U1
MagicNumbers.instruction_aLoad U2
idx)
    convertInstruction (Abs.AStore U2
0) = Instruction -> Eff r Instruction
forall a. a -> Eff r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Instruction
Raw.AStore0
    convertInstruction (Abs.AStore U2
1) = Instruction -> Eff r Instruction
forall a. a -> Eff r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Instruction
Raw.AStore1
    convertInstruction (Abs.AStore U2
2) = Instruction -> Eff r Instruction
forall a. a -> Eff r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Instruction
Raw.AStore2
    convertInstruction (Abs.AStore U2
3) = Instruction -> Eff r Instruction
forall a. a -> Eff r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Instruction
Raw.AStore3
    convertInstruction (Abs.AStore U2
idx)
        | Just U1
i <- forall a b. UnsafeNumConvert a b => a -> Maybe b
unsafeNumConvert @U2 @U1 U2
idx = Instruction -> Eff r Instruction
forall a. a -> Eff r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (U1 -> Instruction
Raw.AStore U1
i)
        | Bool
otherwise = Instruction -> Eff r Instruction
forall a. a -> Eff r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (U1 -> U2 -> Instruction
Raw.Wide1 U1
MagicNumbers.instruction_aStore U2
idx)
    convertInstruction (Abs.ILoad U2
0) = Instruction -> Eff r Instruction
forall a. a -> Eff r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Instruction
Raw.ILoad0
    convertInstruction (Abs.ILoad U2
1) = Instruction -> Eff r Instruction
forall a. a -> Eff r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Instruction
Raw.ILoad1
    convertInstruction (Abs.ILoad U2
2) = Instruction -> Eff r Instruction
forall a. a -> Eff r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Instruction
Raw.ILoad2
    convertInstruction (Abs.ILoad U2
3) = Instruction -> Eff r Instruction
forall a. a -> Eff r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Instruction
Raw.ILoad3
    convertInstruction (Abs.ILoad U2
idx)
        | Just U1
i <- forall a b. UnsafeNumConvert a b => a -> Maybe b
unsafeNumConvert @U2 @U1 U2
idx = Instruction -> Eff r Instruction
forall a. a -> Eff r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (U1 -> Instruction
Raw.ILoad U1
i)
        | Bool
otherwise = Instruction -> Eff r Instruction
forall a. a -> Eff r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (U1 -> U2 -> Instruction
Raw.Wide1 U1
MagicNumbers.instruction_iLoad U2
idx)
    convertInstruction (Abs.IStore U2
0) = Instruction -> Eff r Instruction
forall a. a -> Eff r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Instruction
Raw.IStore0
    convertInstruction (Abs.IStore U2
1) = Instruction -> Eff r Instruction
forall a. a -> Eff r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Instruction
Raw.IStore1
    convertInstruction (Abs.IStore U2
2) = Instruction -> Eff r Instruction
forall a. a -> Eff r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Instruction
Raw.IStore2
    convertInstruction (Abs.IStore U2
3) = Instruction -> Eff r Instruction
forall a. a -> Eff r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Instruction
Raw.IStore3
    convertInstruction (Abs.IStore U2
idx)
        | Just U1
i <- forall a b. UnsafeNumConvert a b => a -> Maybe b
unsafeNumConvert @U2 @U1 U2
idx = Instruction -> Eff r Instruction
forall a. a -> Eff r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (U1 -> Instruction
Raw.IStore U1
i)
        | Bool
otherwise = Instruction -> Eff r Instruction
forall a. a -> Eff r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (U1 -> U2 -> Instruction
Raw.Wide1 U1
MagicNumbers.instruction_iStore U2
idx)
    convertInstruction Instruction' MaybeResolvedLabel
Abs.AConstNull = Instruction -> Eff r Instruction
forall a. a -> Eff r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Instruction
Raw.AConstNull
    convertInstruction (Abs.Instanceof ClassInfoType
t) = do
        idx <- ConstantPoolEntry -> Eff r U2
forall (r :: [Effect]).
(ConstantPool :> r) =>
ConstantPoolEntry -> Eff r U2
findIndexOf (ClassInfoType -> ConstantPoolEntry
CPClassEntry ClassInfoType
t)
        pure (Raw.Instanceof idx)
    convertInstruction (Abs.InvokeStatic ClassInfoType
c Text
n MethodDescriptor
m) = do
        idx <- ConstantPoolEntry -> Eff r U2
forall (r :: [Effect]).
(ConstantPool :> r) =>
ConstantPoolEntry -> Eff r U2
findIndexOf (MethodRef -> ConstantPoolEntry
CPMethodRefEntry (ClassInfoType -> Text -> MethodDescriptor -> MethodRef
MethodRef ClassInfoType
c Text
n MethodDescriptor
m))
        pure (Raw.InvokeStatic idx)
    convertInstruction (Abs.InvokeVirtual ClassInfoType
c Text
n MethodDescriptor
m) = do
        idx <- ConstantPoolEntry -> Eff r U2
forall (r :: [Effect]).
(ConstantPool :> r) =>
ConstantPoolEntry -> Eff r U2
findIndexOf (MethodRef -> ConstantPoolEntry
CPMethodRefEntry (ClassInfoType -> Text -> MethodDescriptor -> MethodRef
MethodRef ClassInfoType
c Text
n MethodDescriptor
m))
        pure (Raw.InvokeVirtual idx)
    convertInstruction (Abs.InvokeInterface ClassInfoType
c Text
n MethodDescriptor
m) = do
        idx <- ConstantPoolEntry -> Eff r U2
forall (r :: [Effect]).
(ConstantPool :> r) =>
ConstantPoolEntry -> Eff r U2
findIndexOf (MethodRef -> ConstantPoolEntry
CPInterfaceMethodRefEntry (ClassInfoType -> Text -> MethodDescriptor -> MethodRef
MethodRef ClassInfoType
c Text
n MethodDescriptor
m))
        let count = MethodDescriptor -> Int
countArguments MethodDescriptor
m
        pure (Raw.InvokeInterface idx (fromIntegral count))
    convertInstruction (Abs.InvokeSpecial ClassInfoType
c Text
n MethodDescriptor
m) = do
        idx <- ConstantPoolEntry -> Eff r U2
forall (r :: [Effect]).
(ConstantPool :> r) =>
ConstantPoolEntry -> Eff r U2
findIndexOf (MethodRef -> ConstantPoolEntry
CPMethodRefEntry (ClassInfoType -> Text -> MethodDescriptor -> MethodRef
MethodRef ClassInfoType
c Text
n MethodDescriptor
m))
        pure (Raw.InvokeSpecial idx)
    convertInstruction (Abs.LDC LDCEntry
ldc) = do
        idx <-
            ConstantPoolEntry -> Eff r U2
forall (r :: [Effect]).
(ConstantPool :> r) =>
ConstantPoolEntry -> Eff r U2
findIndexOf
                ( case LDCEntry
ldc of
                    LDCInt Int
i -> Int -> ConstantPoolEntry
CPIntegerEntry Int
i
                    LDCFloat Float
f -> Float -> ConstantPoolEntry
CPFloatEntry Float
f
                    LDCString Text
s -> Text -> ConstantPoolEntry
CPStringEntry Text
s
                    LDCClass ClassInfoType
c -> ClassInfoType -> ConstantPoolEntry
CPClassEntry ClassInfoType
c
                )

        pure (Raw.LDC_W idx) -- TODO: handle LDC vs LDC_W properly

    -- TODO: this should probably do a bounds check on the index
    convertInstruction (Abs.PutStatic ClassInfoType
c Text
n FieldType
t) = do
        idx <- ConstantPoolEntry -> Eff r U2
forall (r :: [Effect]).
(ConstantPool :> r) =>
ConstantPoolEntry -> Eff r U2
findIndexOf (FieldRef -> ConstantPoolEntry
CPFieldRefEntry (ClassInfoType -> Text -> FieldType -> FieldRef
FieldRef ClassInfoType
c Text
n FieldType
t))
        pure (Raw.PutStatic idx)
    convertInstruction (Abs.GetField ClassInfoType
c Text
n FieldType
t) = do
        idx <- ConstantPoolEntry -> Eff r U2
forall (r :: [Effect]).
(ConstantPool :> r) =>
ConstantPoolEntry -> Eff r U2
findIndexOf (FieldRef -> ConstantPoolEntry
CPFieldRefEntry (ClassInfoType -> Text -> FieldType -> FieldRef
FieldRef ClassInfoType
c Text
n FieldType
t))
        pure (Raw.GetField idx)
    convertInstruction (Abs.GetStatic ClassInfoType
c Text
n FieldType
t) = do
        idx <- ConstantPoolEntry -> Eff r U2
forall (r :: [Effect]).
(ConstantPool :> r) =>
ConstantPoolEntry -> Eff r U2
findIndexOf (FieldRef -> ConstantPoolEntry
CPFieldRefEntry (ClassInfoType -> Text -> FieldType -> FieldRef
FieldRef ClassInfoType
c Text
n FieldType
t))
        pure (Raw.GetStatic idx)
    convertInstruction (Abs.PutField ClassInfoType
c Text
n FieldType
t) = do
        idx <- ConstantPoolEntry -> Eff r U2
forall (r :: [Effect]).
(ConstantPool :> r) =>
ConstantPoolEntry -> Eff r U2
findIndexOf (FieldRef -> ConstantPoolEntry
CPFieldRefEntry (ClassInfoType -> Text -> FieldType -> FieldRef
FieldRef ClassInfoType
c Text
n FieldType
t))
        pure (Raw.PutField idx)
    convertInstruction Instruction' MaybeResolvedLabel
Abs.AReturn = Instruction -> Eff r Instruction
forall a. a -> Eff r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Instruction
Raw.AReturn
    convertInstruction Instruction' MaybeResolvedLabel
Abs.Return = Instruction -> Eff r Instruction
forall a. a -> Eff r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Instruction
Raw.Return
    convertInstruction Instruction' MaybeResolvedLabel
Abs.IReturn = Instruction -> Eff r Instruction
forall a. a -> Eff r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Instruction
Raw.IReturn
    convertInstruction Instruction' MaybeResolvedLabel
Abs.IConst0 = Instruction -> Eff r Instruction
forall a. a -> Eff r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Instruction
Raw.IConst0
    convertInstruction Instruction' MaybeResolvedLabel
Abs.IConst1 = Instruction -> Eff r Instruction
forall a. a -> Eff r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Instruction
Raw.IConst1
    convertInstruction Instruction' MaybeResolvedLabel
Abs.Dup = Instruction -> Eff r Instruction
forall a. a -> Eff r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Instruction
Raw.Dup
    convertInstruction (Abs.CheckCast ClassInfoType
t) = do
        idx <- ConstantPoolEntry -> Eff r U2
forall (r :: [Effect]).
(ConstantPool :> r) =>
ConstantPoolEntry -> Eff r U2
findIndexOf (ClassInfoType -> ConstantPoolEntry
CPClassEntry ClassInfoType
t)
        pure (Raw.CheckCast idx)
    convertInstruction (Abs.InvokeDynamic BootstrapMethod
bm Text
n MethodDescriptor
m) = do
        idx <- ConstantPoolEntry -> Eff r U2
forall (r :: [Effect]).
(ConstantPool :> r) =>
ConstantPoolEntry -> Eff r U2
findIndexOf (BootstrapMethod -> Text -> MethodDescriptor -> ConstantPoolEntry
CPInvokeDynamicEntry BootstrapMethod
bm Text
n MethodDescriptor
m)
        pure (Raw.InvokeDynamic idx)
    convertInstruction (Abs.IfEq MaybeResolvedLabel
offset) = U2 -> Instruction
Raw.IfEq (U2 -> Instruction) -> Eff r U2 -> Eff r Instruction
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> U2 -> MaybeResolvedLabel -> Eff r U2
forall (r :: [Effect]).
CodeConverterEff r =>
U2 -> MaybeResolvedLabel -> Eff r U2
mustBeResolved U2
instOffset MaybeResolvedLabel
offset
    convertInstruction (Abs.IfNe MaybeResolvedLabel
offset) = U2 -> Instruction
Raw.IfNe (U2 -> Instruction) -> Eff r U2 -> Eff r Instruction
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> U2 -> MaybeResolvedLabel -> Eff r U2
forall (r :: [Effect]).
CodeConverterEff r =>
U2 -> MaybeResolvedLabel -> Eff r U2
mustBeResolved U2
instOffset MaybeResolvedLabel
offset
    convertInstruction (Abs.IfLt MaybeResolvedLabel
offset) = U2 -> Instruction
Raw.IfLt (U2 -> Instruction) -> Eff r U2 -> Eff r Instruction
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> U2 -> MaybeResolvedLabel -> Eff r U2
forall (r :: [Effect]).
CodeConverterEff r =>
U2 -> MaybeResolvedLabel -> Eff r U2
mustBeResolved U2
instOffset MaybeResolvedLabel
offset
    convertInstruction (Abs.IfGe MaybeResolvedLabel
offset) = U2 -> Instruction
Raw.IfGe (U2 -> Instruction) -> Eff r U2 -> Eff r Instruction
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> U2 -> MaybeResolvedLabel -> Eff r U2
forall (r :: [Effect]).
CodeConverterEff r =>
U2 -> MaybeResolvedLabel -> Eff r U2
mustBeResolved U2
instOffset MaybeResolvedLabel
offset
    convertInstruction (Abs.IfGt MaybeResolvedLabel
offset) = U2 -> Instruction
Raw.IfGt (U2 -> Instruction) -> Eff r U2 -> Eff r Instruction
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> U2 -> MaybeResolvedLabel -> Eff r U2
forall (r :: [Effect]).
CodeConverterEff r =>
U2 -> MaybeResolvedLabel -> Eff r U2
mustBeResolved U2
instOffset MaybeResolvedLabel
offset
    convertInstruction (Abs.IfLe MaybeResolvedLabel
offset) = U2 -> Instruction
Raw.IfLe (U2 -> Instruction) -> Eff r U2 -> Eff r Instruction
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> U2 -> MaybeResolvedLabel -> Eff r U2
forall (r :: [Effect]).
CodeConverterEff r =>
U2 -> MaybeResolvedLabel -> Eff r U2
mustBeResolved U2
instOffset MaybeResolvedLabel
offset
    convertInstruction (Abs.Goto MaybeResolvedLabel
offset) = U2 -> Instruction
Raw.Goto (U2 -> Instruction) -> Eff r U2 -> Eff r Instruction
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> U2 -> MaybeResolvedLabel -> Eff r U2
forall (r :: [Effect]).
CodeConverterEff r =>
U2 -> MaybeResolvedLabel -> Eff r U2
mustBeResolved U2
instOffset MaybeResolvedLabel
offset
    convertInstruction (Abs.Label MaybeResolvedLabel
_) = String -> Eff r Instruction
forall a. HasCallStack => String -> a
error String
"unreachable"
    convertInstruction (Abs.New ClassInfoType
t) = do
        idx <- ConstantPoolEntry -> Eff r U2
forall (r :: [Effect]).
(ConstantPool :> r) =>
ConstantPoolEntry -> Eff r U2
findIndexOf (ClassInfoType -> ConstantPoolEntry
CPClassEntry ClassInfoType
t)
        pure (Raw.New idx)
    convertInstruction Instruction' MaybeResolvedLabel
Abs.IAnd = Instruction -> Eff r Instruction
forall a. a -> Eff r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Instruction
Raw.IAnd
    convertInstruction Instruction' MaybeResolvedLabel
Abs.IOr = Instruction -> Eff r Instruction
forall a. a -> Eff r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Instruction
Raw.IOr