{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-|
Copyright   : (c) Christian Gram Kalhauge, 2018
License     : MIT
Maintainer  : kalhuage@cs.ucla.edu

-}
module Language.JVM.Staged
  ( Staged(..)

  -- * Monad Classes
  , LabelM(..)
  , EvolveM(..)
  , DevolveM(..)

  -- * AttributeLocation
  , AttributeLocation(..)

  -- * Re-exports
  , module Language.JVM.Stage
  , module Language.JVM.TH
  )
where

import qualified Data.Text                     as Text

import           Language.JVM.Constant
import           Language.JVM.Stage
import           Language.JVM.TH

class Monad m => LabelM m where
  label :: String -> m a -> m a
  -- ^ label the current position in the class-file, good for debugging
  label String
_ = m a -> m a
forall a. a -> a
id
  {-# INLINE label #-}

data AttributeLocation
  = ClassAttribute
  | MethodAttribute
  | CodeAttribute
  | FieldAttribute
  deriving (Int -> AttributeLocation -> ShowS
[AttributeLocation] -> ShowS
AttributeLocation -> String
(Int -> AttributeLocation -> ShowS)
-> (AttributeLocation -> String)
-> ([AttributeLocation] -> ShowS)
-> Show AttributeLocation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AttributeLocation] -> ShowS
$cshowList :: [AttributeLocation] -> ShowS
show :: AttributeLocation -> String
$cshow :: AttributeLocation -> String
showsPrec :: Int -> AttributeLocation -> ShowS
$cshowsPrec :: Int -> AttributeLocation -> ShowS
Show, AttributeLocation -> AttributeLocation -> Bool
(AttributeLocation -> AttributeLocation -> Bool)
-> (AttributeLocation -> AttributeLocation -> Bool)
-> Eq AttributeLocation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttributeLocation -> AttributeLocation -> Bool
$c/= :: AttributeLocation -> AttributeLocation -> Bool
== :: AttributeLocation -> AttributeLocation -> Bool
$c== :: AttributeLocation -> AttributeLocation -> Bool
Eq, Eq AttributeLocation
Eq AttributeLocation
-> (AttributeLocation -> AttributeLocation -> Ordering)
-> (AttributeLocation -> AttributeLocation -> Bool)
-> (AttributeLocation -> AttributeLocation -> Bool)
-> (AttributeLocation -> AttributeLocation -> Bool)
-> (AttributeLocation -> AttributeLocation -> Bool)
-> (AttributeLocation -> AttributeLocation -> AttributeLocation)
-> (AttributeLocation -> AttributeLocation -> AttributeLocation)
-> Ord AttributeLocation
AttributeLocation -> AttributeLocation -> Bool
AttributeLocation -> AttributeLocation -> Ordering
AttributeLocation -> AttributeLocation -> AttributeLocation
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
min :: AttributeLocation -> AttributeLocation -> AttributeLocation
$cmin :: AttributeLocation -> AttributeLocation -> AttributeLocation
max :: AttributeLocation -> AttributeLocation -> AttributeLocation
$cmax :: AttributeLocation -> AttributeLocation -> AttributeLocation
>= :: AttributeLocation -> AttributeLocation -> Bool
$c>= :: AttributeLocation -> AttributeLocation -> Bool
> :: AttributeLocation -> AttributeLocation -> Bool
$c> :: AttributeLocation -> AttributeLocation -> Bool
<= :: AttributeLocation -> AttributeLocation -> Bool
$c<= :: AttributeLocation -> AttributeLocation -> Bool
< :: AttributeLocation -> AttributeLocation -> Bool
$c< :: AttributeLocation -> AttributeLocation -> Bool
compare :: AttributeLocation -> AttributeLocation -> Ordering
$ccompare :: AttributeLocation -> AttributeLocation -> Ordering
$cp1Ord :: Eq AttributeLocation
Ord)

class LabelM m => EvolveM m where
  link :: Referenceable r => Index -> m r
  attributeFilter :: m ((AttributeLocation, Text.Text) -> Bool)
  evolveError :: String -> m r

class LabelM m => DevolveM m where
  unlink :: Referenceable r => r -> m Index

class Staged s where
  {-# MINIMAL stage | evolve, devolve #-}
  stage :: LabelM m => (forall s'. Staged s' => s' r -> m (s' r')) -> s r -> m (s r')
  stage forall (s' :: * -> *). Staged s' => s' r -> m (s' r')
f s r
a = s r -> m (s r')
forall (s' :: * -> *). Staged s' => s' r -> m (s' r')
f s r
a
  {-# INLINE stage #-}

  evolve ::  EvolveM m => s Low -> m (s High)
  evolve = (forall (s' :: * -> *). Staged s' => s' Low -> m (s' High))
-> s Low -> m (s High)
forall (s :: * -> *) (m :: * -> *) r r'.
(Staged s, LabelM m) =>
(forall (s' :: * -> *). Staged s' => s' r -> m (s' r'))
-> s r -> m (s r')
stage forall (s' :: * -> *). Staged s' => s' Low -> m (s' High)
forall (s :: * -> *) (m :: * -> *).
(Staged s, EvolveM m) =>
s Low -> m (s High)
evolve
  {-# INLINE evolve #-}

  devolve :: DevolveM m => s High -> m (s Low)
  devolve = (forall (s' :: * -> *). Staged s' => s' High -> m (s' Low))
-> s High -> m (s Low)
forall (s :: * -> *) (m :: * -> *) r r'.
(Staged s, LabelM m) =>
(forall (s' :: * -> *). Staged s' => s' r -> m (s' r'))
-> s r -> m (s r')
stage forall (s' :: * -> *). Staged s' => s' High -> m (s' Low)
forall (s :: * -> *) (m :: * -> *).
(Staged s, DevolveM m) =>
s High -> m (s Low)
devolve
  {-# INLINE devolve #-}

instance Staged Constant where
  evolve :: Constant Low -> m (Constant High)
evolve Constant Low
c = case Constant Low
c of
    CString    SizedByteString16
s -> Constant High -> m (Constant High)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Constant High -> m (Constant High))
-> Constant High -> m (Constant High)
forall a b. (a -> b) -> a -> b
$ SizedByteString16 -> Constant High
forall r. SizedByteString16 -> Constant r
CString SizedByteString16
s
    CInteger   Int32
i -> Constant High -> m (Constant High)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Constant High -> m (Constant High))
-> Constant High -> m (Constant High)
forall a b. (a -> b) -> a -> b
$ Int32 -> Constant High
forall r. Int32 -> Constant r
CInteger Int32
i
    CFloat     Float
d -> Constant High -> m (Constant High)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Constant High -> m (Constant High))
-> Constant High -> m (Constant High)
forall a b. (a -> b) -> a -> b
$ Float -> Constant High
forall r. Float -> Constant r
CFloat Float
d
    CLong      Int64
l -> Constant High -> m (Constant High)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Constant High -> m (Constant High))
-> Constant High -> m (Constant High)
forall a b. (a -> b) -> a -> b
$ Int64 -> Constant High
forall r. Int64 -> Constant r
CLong Int64
l
    CDouble    Double
d -> Constant High -> m (Constant High)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Constant High -> m (Constant High))
-> Constant High -> m (Constant High)
forall a b. (a -> b) -> a -> b
$ Double -> Constant High
forall r. Double -> Constant r
CDouble Double
d
    CClassRef  Ref Text Low
r -> String -> m (Constant High) -> m (Constant High)
forall (m :: * -> *) a. LabelM m => String -> m a -> m a
label String
"CClassRef" (m (Constant High) -> m (Constant High))
-> m (Constant High) -> m (Constant High)
forall a b. (a -> b) -> a -> b
$ Text -> Constant High
forall r. Ref Text r -> Constant r
CClassRef (Text -> Constant High) -> m Text -> m (Constant High)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Index -> m Text
forall (m :: * -> *) r.
(EvolveM m, Referenceable r) =>
Index -> m r
link Index
Ref Text Low
r
    CStringRef Ref ByteString Low
r -> String -> m (Constant High) -> m (Constant High)
forall (m :: * -> *) a. LabelM m => String -> m a -> m a
label String
"CStringRef" (m (Constant High) -> m (Constant High))
-> m (Constant High) -> m (Constant High)
forall a b. (a -> b) -> a -> b
$ ByteString -> Constant High
forall r. Ref ByteString r -> Constant r
CStringRef (ByteString -> Constant High) -> m ByteString -> m (Constant High)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Index -> m ByteString
forall (m :: * -> *) r.
(EvolveM m, Referenceable r) =>
Index -> m r
link Index
Ref ByteString Low
r
    CFieldRef (x, y) ->
      String -> m (Constant High) -> m (Constant High)
forall (m :: * -> *) a. LabelM m => String -> m a -> m a
label String
"CFieldRef"
        (m (Constant High) -> m (Constant High))
-> m (Constant High) -> m (Constant High)
forall a b. (a -> b) -> a -> b
$   AbsFieldId -> Constant High
forall r. Choice (Index, Index) AbsFieldId r -> Constant r
CFieldRef
        (AbsFieldId -> Constant High)
-> (InClass FieldId -> AbsFieldId)
-> InClass FieldId
-> Constant High
forall b c a. (b -> c) -> (a -> b) -> a -> c
.   InClass FieldId -> AbsFieldId
AbsFieldId
        (InClass FieldId -> Constant High)
-> m (InClass FieldId) -> m (Constant High)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ClassName -> FieldId -> InClass FieldId
forall a. ClassName -> a -> InClass a
InClass (ClassName -> FieldId -> InClass FieldId)
-> m ClassName -> m (FieldId -> InClass FieldId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Index -> m ClassName
forall (m :: * -> *) r.
(EvolveM m, Referenceable r) =>
Index -> m r
link Index
x m (FieldId -> InClass FieldId) -> m FieldId -> m (InClass FieldId)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Index -> m FieldId
forall (m :: * -> *) r.
(EvolveM m, Referenceable r) =>
Index -> m r
link Index
y)
    CMethodRef (x, y) ->
      String -> m (Constant High) -> m (Constant High)
forall (m :: * -> *) a. LabelM m => String -> m a -> m a
label String
"CMethodRef" (m (Constant High) -> m (Constant High))
-> m (Constant High) -> m (Constant High)
forall a b. (a -> b) -> a -> b
$ InRefType MethodId -> Constant High
forall r.
Choice (Index, Index) (InRefType MethodId) r -> Constant r
CMethodRef (InRefType MethodId -> Constant High)
-> m (InRefType MethodId) -> m (Constant High)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (JRefType -> MethodId -> InRefType MethodId
forall a. JRefType -> a -> InRefType a
InRefType (JRefType -> MethodId -> InRefType MethodId)
-> m JRefType -> m (MethodId -> InRefType MethodId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Index -> m JRefType
forall (m :: * -> *) r.
(EvolveM m, Referenceable r) =>
Index -> m r
link Index
x m (MethodId -> InRefType MethodId)
-> m MethodId -> m (InRefType MethodId)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Index -> m MethodId
forall (m :: * -> *) r.
(EvolveM m, Referenceable r) =>
Index -> m r
link Index
y)
    CInterfaceMethodRef (x, y) ->
      String -> m (Constant High) -> m (Constant High)
forall (m :: * -> *) a. LabelM m => String -> m a -> m a
label String
"CInterfaceMethodRef"
        (m (Constant High) -> m (Constant High))
-> m (Constant High) -> m (Constant High)
forall a b. (a -> b) -> a -> b
$   InRefType MethodId -> Constant High
forall r.
Choice (Index, Index) (InRefType MethodId) r -> Constant r
CInterfaceMethodRef
        (InRefType MethodId -> Constant High)
-> m (InRefType MethodId) -> m (Constant High)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (JRefType -> MethodId -> InRefType MethodId
forall a. JRefType -> a -> InRefType a
InRefType (JRefType -> MethodId -> InRefType MethodId)
-> m JRefType -> m (MethodId -> InRefType MethodId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Index -> m JRefType
forall (m :: * -> *) r.
(EvolveM m, Referenceable r) =>
Index -> m r
link Index
x m (MethodId -> InRefType MethodId)
-> m MethodId -> m (InRefType MethodId)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Index -> m MethodId
forall (m :: * -> *) r.
(EvolveM m, Referenceable r) =>
Index -> m r
link Index
y)
    CNameAndType Ref Text Low
r1 Ref Text Low
r2 ->
      String -> m (Constant High) -> m (Constant High)
forall (m :: * -> *) a. LabelM m => String -> m a -> m a
label String
"CNameAndType" (m (Constant High) -> m (Constant High))
-> m (Constant High) -> m (Constant High)
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Constant High
forall r. Ref Text r -> Ref Text r -> Constant r
CNameAndType (Text -> Text -> Constant High)
-> m Text -> m (Text -> Constant High)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Index -> m Text
forall (m :: * -> *) r.
(EvolveM m, Referenceable r) =>
Index -> m r
link Index
Ref Text Low
r1 m (Text -> Constant High) -> m Text -> m (Constant High)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Index -> m Text
forall (m :: * -> *) r.
(EvolveM m, Referenceable r) =>
Index -> m r
link Index
Ref Text Low
r2
    CMethodHandle  MethodHandle Low
mh -> String -> m (Constant High) -> m (Constant High)
forall (m :: * -> *) a. LabelM m => String -> m a -> m a
label String
"CMethodHandle" (m (Constant High) -> m (Constant High))
-> m (Constant High) -> m (Constant High)
forall a b. (a -> b) -> a -> b
$ MethodHandle High -> Constant High
forall r. MethodHandle r -> Constant r
CMethodHandle (MethodHandle High -> Constant High)
-> m (MethodHandle High) -> m (Constant High)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MethodHandle Low -> m (MethodHandle High)
forall (s :: * -> *) (m :: * -> *).
(Staged s, EvolveM m) =>
s Low -> m (s High)
evolve MethodHandle Low
mh
    CMethodType    Ref MethodDescriptor Low
r  -> String -> m (Constant High) -> m (Constant High)
forall (m :: * -> *) a. LabelM m => String -> m a -> m a
label String
"CMethodType" (m (Constant High) -> m (Constant High))
-> m (Constant High) -> m (Constant High)
forall a b. (a -> b) -> a -> b
$ MethodDescriptor -> Constant High
forall r. Ref MethodDescriptor r -> Constant r
CMethodType (MethodDescriptor -> Constant High)
-> m MethodDescriptor -> m (Constant High)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Index -> m MethodDescriptor
forall (m :: * -> *) r.
(EvolveM m, Referenceable r) =>
Index -> m r
link Index
Ref MethodDescriptor Low
r
    CInvokeDynamic InvokeDynamic Low
i  -> String -> m (Constant High) -> m (Constant High)
forall (m :: * -> *) a. LabelM m => String -> m a -> m a
label String
"CInvokeDynamic" (m (Constant High) -> m (Constant High))
-> m (Constant High) -> m (Constant High)
forall a b. (a -> b) -> a -> b
$ InvokeDynamic High -> Constant High
forall r. InvokeDynamic r -> Constant r
CInvokeDynamic (InvokeDynamic High -> Constant High)
-> m (InvokeDynamic High) -> m (Constant High)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InvokeDynamic Low -> m (InvokeDynamic High)
forall (s :: * -> *) (m :: * -> *).
(Staged s, EvolveM m) =>
s Low -> m (s High)
evolve InvokeDynamic Low
i

  devolve :: Constant High -> m (Constant Low)
devolve Constant High
c = case Constant High
c of
    CString    SizedByteString16
s -> Constant Low -> m (Constant Low)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Constant Low -> m (Constant Low))
-> Constant Low -> m (Constant Low)
forall a b. (a -> b) -> a -> b
$ SizedByteString16 -> Constant Low
forall r. SizedByteString16 -> Constant r
CString SizedByteString16
s
    CInteger   Int32
i -> Constant Low -> m (Constant Low)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Constant Low -> m (Constant Low))
-> Constant Low -> m (Constant Low)
forall a b. (a -> b) -> a -> b
$ Int32 -> Constant Low
forall r. Int32 -> Constant r
CInteger Int32
i
    CFloat     Float
d -> Constant Low -> m (Constant Low)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Constant Low -> m (Constant Low))
-> Constant Low -> m (Constant Low)
forall a b. (a -> b) -> a -> b
$ Float -> Constant Low
forall r. Float -> Constant r
CFloat Float
d
    CLong      Int64
l -> Constant Low -> m (Constant Low)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Constant Low -> m (Constant Low))
-> Constant Low -> m (Constant Low)
forall a b. (a -> b) -> a -> b
$ Int64 -> Constant Low
forall r. Int64 -> Constant r
CLong Int64
l
    CDouble    Double
d -> Constant Low -> m (Constant Low)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Constant Low -> m (Constant Low))
-> Constant Low -> m (Constant Low)
forall a b. (a -> b) -> a -> b
$ Double -> Constant Low
forall r. Double -> Constant r
CDouble Double
d
    CClassRef  Ref Text High
r -> String -> m (Constant Low) -> m (Constant Low)
forall (m :: * -> *) a. LabelM m => String -> m a -> m a
label String
"CClassRef" (m (Constant Low) -> m (Constant Low))
-> m (Constant Low) -> m (Constant Low)
forall a b. (a -> b) -> a -> b
$ Index -> Constant Low
forall r. Ref Text r -> Constant r
CClassRef (Index -> Constant Low) -> m Index -> m (Constant Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> m Index
forall (m :: * -> *) r.
(DevolveM m, Referenceable r) =>
r -> m Index
unlink Text
Ref Text High
r
    CStringRef Ref ByteString High
r -> String -> m (Constant Low) -> m (Constant Low)
forall (m :: * -> *) a. LabelM m => String -> m a -> m a
label String
"CStringRef" (m (Constant Low) -> m (Constant Low))
-> m (Constant Low) -> m (Constant Low)
forall a b. (a -> b) -> a -> b
$ Index -> Constant Low
forall r. Ref ByteString r -> Constant r
CStringRef (Index -> Constant Low) -> m Index -> m (Constant Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> m Index
forall (m :: * -> *) r.
(DevolveM m, Referenceable r) =>
r -> m Index
unlink ByteString
Ref ByteString High
r
    CFieldRef (AbsFieldId (InClass rt rid)) ->
      String -> m (Constant Low) -> m (Constant Low)
forall (m :: * -> *) a. LabelM m => String -> m a -> m a
label String
"CFieldRef" (m (Constant Low) -> m (Constant Low))
-> m (Constant Low) -> m (Constant Low)
forall a b. (a -> b) -> a -> b
$ (Index, Index) -> Constant Low
forall r. Choice (Index, Index) AbsFieldId r -> Constant r
CFieldRef ((Index, Index) -> Constant Low)
-> m (Index, Index) -> m (Constant Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((,) (Index -> Index -> (Index, Index))
-> m Index -> m (Index -> (Index, Index))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ClassName -> m Index
forall (m :: * -> *) r.
(DevolveM m, Referenceable r) =>
r -> m Index
unlink ClassName
rt m (Index -> (Index, Index)) -> m Index -> m (Index, Index)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldId -> m Index
forall (m :: * -> *) r.
(DevolveM m, Referenceable r) =>
r -> m Index
unlink FieldId
rid)
    CMethodRef (InRefType rt rid) ->
      String -> m (Constant Low) -> m (Constant Low)
forall (m :: * -> *) a. LabelM m => String -> m a -> m a
label String
"CMethodRef" (m (Constant Low) -> m (Constant Low))
-> m (Constant Low) -> m (Constant Low)
forall a b. (a -> b) -> a -> b
$ (Index, Index) -> Constant Low
forall r.
Choice (Index, Index) (InRefType MethodId) r -> Constant r
CMethodRef ((Index, Index) -> Constant Low)
-> m (Index, Index) -> m (Constant Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((,) (Index -> Index -> (Index, Index))
-> m Index -> m (Index -> (Index, Index))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JRefType -> m Index
forall (m :: * -> *) r.
(DevolveM m, Referenceable r) =>
r -> m Index
unlink JRefType
rt m (Index -> (Index, Index)) -> m Index -> m (Index, Index)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> MethodId -> m Index
forall (m :: * -> *) r.
(DevolveM m, Referenceable r) =>
r -> m Index
unlink MethodId
rid)
    CInterfaceMethodRef (InRefType rt rid) ->
      String -> m (Constant Low) -> m (Constant Low)
forall (m :: * -> *) a. LabelM m => String -> m a -> m a
label String
"CInterfaceMethodRef"
        (m (Constant Low) -> m (Constant Low))
-> m (Constant Low) -> m (Constant Low)
forall a b. (a -> b) -> a -> b
$   (Index, Index) -> Constant Low
forall r.
Choice (Index, Index) (InRefType MethodId) r -> Constant r
CInterfaceMethodRef
        ((Index, Index) -> Constant Low)
-> m (Index, Index) -> m (Constant Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((,) (Index -> Index -> (Index, Index))
-> m Index -> m (Index -> (Index, Index))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JRefType -> m Index
forall (m :: * -> *) r.
(DevolveM m, Referenceable r) =>
r -> m Index
unlink JRefType
rt m (Index -> (Index, Index)) -> m Index -> m (Index, Index)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> MethodId -> m Index
forall (m :: * -> *) r.
(DevolveM m, Referenceable r) =>
r -> m Index
unlink MethodId
rid)
    CNameAndType Ref Text High
r1 Ref Text High
r2 ->
      String -> m (Constant Low) -> m (Constant Low)
forall (m :: * -> *) a. LabelM m => String -> m a -> m a
label String
"CNameAndType" (m (Constant Low) -> m (Constant Low))
-> m (Constant Low) -> m (Constant Low)
forall a b. (a -> b) -> a -> b
$ Index -> Index -> Constant Low
forall r. Ref Text r -> Ref Text r -> Constant r
CNameAndType (Index -> Index -> Constant Low)
-> m Index -> m (Index -> Constant Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> m Index
forall (m :: * -> *) r.
(DevolveM m, Referenceable r) =>
r -> m Index
unlink Text
Ref Text High
r1 m (Index -> Constant Low) -> m Index -> m (Constant Low)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> m Index
forall (m :: * -> *) r.
(DevolveM m, Referenceable r) =>
r -> m Index
unlink Text
Ref Text High
r2
    CMethodHandle  MethodHandle High
mh -> String -> m (Constant Low) -> m (Constant Low)
forall (m :: * -> *) a. LabelM m => String -> m a -> m a
label String
"CMetho" (m (Constant Low) -> m (Constant Low))
-> m (Constant Low) -> m (Constant Low)
forall a b. (a -> b) -> a -> b
$ MethodHandle Low -> Constant Low
forall r. MethodHandle r -> Constant r
CMethodHandle (MethodHandle Low -> Constant Low)
-> m (MethodHandle Low) -> m (Constant Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MethodHandle High -> m (MethodHandle Low)
forall (s :: * -> *) (m :: * -> *).
(Staged s, DevolveM m) =>
s High -> m (s Low)
devolve MethodHandle High
mh
    CMethodType    Ref MethodDescriptor High
r  -> String -> m (Constant Low) -> m (Constant Low)
forall (m :: * -> *) a. LabelM m => String -> m a -> m a
label String
"CMethodType" (m (Constant Low) -> m (Constant Low))
-> m (Constant Low) -> m (Constant Low)
forall a b. (a -> b) -> a -> b
$ Index -> Constant Low
forall r. Ref MethodDescriptor r -> Constant r
CMethodType (Index -> Constant Low) -> m Index -> m (Constant Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MethodDescriptor -> m Index
forall (m :: * -> *) r.
(DevolveM m, Referenceable r) =>
r -> m Index
unlink Ref MethodDescriptor High
MethodDescriptor
r
    CInvokeDynamic InvokeDynamic High
i  -> String -> m (Constant Low) -> m (Constant Low)
forall (m :: * -> *) a. LabelM m => String -> m a -> m a
label String
"CInvokeDynamic" (m (Constant Low) -> m (Constant Low))
-> m (Constant Low) -> m (Constant Low)
forall a b. (a -> b) -> a -> b
$ InvokeDynamic Low -> Constant Low
forall r. InvokeDynamic r -> Constant r
CInvokeDynamic (InvokeDynamic Low -> Constant Low)
-> m (InvokeDynamic Low) -> m (Constant Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InvokeDynamic High -> m (InvokeDynamic Low)
forall (s :: * -> *) (m :: * -> *).
(Staged s, DevolveM m) =>
s High -> m (s Low)
devolve InvokeDynamic High
i


instance Staged InvokeDynamic where
  evolve :: InvokeDynamic Low -> m (InvokeDynamic High)
evolve (InvokeDynamic Index
w Ref MethodId Low
ref) = Index -> Ref MethodId High -> InvokeDynamic High
forall r. Index -> Ref MethodId r -> InvokeDynamic r
InvokeDynamic Index
w (MethodId -> InvokeDynamic High)
-> m MethodId -> m (InvokeDynamic High)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Index -> m MethodId
forall (m :: * -> *) r.
(EvolveM m, Referenceable r) =>
Index -> m r
link Index
Ref MethodId Low
ref

  devolve :: InvokeDynamic High -> m (InvokeDynamic Low)
devolve (InvokeDynamic Index
w Ref MethodId High
ref) = Index -> Ref MethodId Low -> InvokeDynamic Low
forall r. Index -> Ref MethodId r -> InvokeDynamic r
InvokeDynamic Index
w (Index -> InvokeDynamic Low) -> m Index -> m (InvokeDynamic Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MethodId -> m Index
forall (m :: * -> *) r.
(DevolveM m, Referenceable r) =>
r -> m Index
unlink Ref MethodId High
MethodId
ref

-- instance Staged MethodId where
--   evolve (MethodId n d) =
--     MethodId <$> link n <*> link d

--   devolve (MethodId n d) =
--     MethodId <$> unlink n <*> unlink d

-- instance Referenceable r => Staged (InClass r) where
--   evolve (InClass cn cid) =
--     InClass <$> link cn <*> link cid
--   devolve (InClass cn cid) =
--     InClass <$> unlink cn <*> unlink cid

-- instance Referenceable r => Staged (InRefType r) where
--   evolve (InRefType cn cid) =
--     InRefType <$> link cn <*> link cid
--   devolve (InRefType cn cid) =
--     InRefType <$> unlink cn <*> unlink cid

instance Staged MethodHandle where
  evolve :: MethodHandle Low -> m (MethodHandle High)
evolve MethodHandle Low
m = case MethodHandle Low
m of
    MHField     MethodHandleField Low
r -> MethodHandleField High -> MethodHandle High
forall r. MethodHandleField r -> MethodHandle r
MHField (MethodHandleField High -> MethodHandle High)
-> m (MethodHandleField High) -> m (MethodHandle High)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MethodHandleField Low -> m (MethodHandleField High)
forall (s :: * -> *) (m :: * -> *).
(Staged s, EvolveM m) =>
s Low -> m (s High)
evolve MethodHandleField Low
r
    MHMethod    MethodHandleMethod Low
r -> MethodHandleMethod High -> MethodHandle High
forall r. MethodHandleMethod r -> MethodHandle r
MHMethod (MethodHandleMethod High -> MethodHandle High)
-> m (MethodHandleMethod High) -> m (MethodHandle High)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MethodHandleMethod Low -> m (MethodHandleMethod High)
forall (s :: * -> *) (m :: * -> *).
(Staged s, EvolveM m) =>
s Low -> m (s High)
evolve MethodHandleMethod Low
r
    MHInterface MethodHandleInterface Low
r -> MethodHandleInterface High -> MethodHandle High
forall r. MethodHandleInterface r -> MethodHandle r
MHInterface (MethodHandleInterface High -> MethodHandle High)
-> m (MethodHandleInterface High) -> m (MethodHandle High)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MethodHandleInterface Low -> m (MethodHandleInterface High)
forall (s :: * -> *) (m :: * -> *).
(Staged s, EvolveM m) =>
s Low -> m (s High)
evolve MethodHandleInterface Low
r

  devolve :: MethodHandle High -> m (MethodHandle Low)
devolve MethodHandle High
m = case MethodHandle High
m of
    MHField     MethodHandleField High
r -> MethodHandleField Low -> MethodHandle Low
forall r. MethodHandleField r -> MethodHandle r
MHField (MethodHandleField Low -> MethodHandle Low)
-> m (MethodHandleField Low) -> m (MethodHandle Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MethodHandleField High -> m (MethodHandleField Low)
forall (s :: * -> *) (m :: * -> *).
(Staged s, DevolveM m) =>
s High -> m (s Low)
devolve MethodHandleField High
r
    MHMethod    MethodHandleMethod High
r -> MethodHandleMethod Low -> MethodHandle Low
forall r. MethodHandleMethod r -> MethodHandle r
MHMethod (MethodHandleMethod Low -> MethodHandle Low)
-> m (MethodHandleMethod Low) -> m (MethodHandle Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MethodHandleMethod High -> m (MethodHandleMethod Low)
forall (s :: * -> *) (m :: * -> *).
(Staged s, DevolveM m) =>
s High -> m (s Low)
devolve MethodHandleMethod High
r
    MHInterface MethodHandleInterface High
r -> MethodHandleInterface Low -> MethodHandle Low
forall r. MethodHandleInterface r -> MethodHandle r
MHInterface (MethodHandleInterface Low -> MethodHandle Low)
-> m (MethodHandleInterface Low) -> m (MethodHandle Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MethodHandleInterface High -> m (MethodHandleInterface Low)
forall (s :: * -> *) (m :: * -> *).
(Staged s, DevolveM m) =>
s High -> m (s Low)
devolve MethodHandleInterface High
r

instance Staged MethodHandleMethod where
  evolve :: MethodHandleMethod Low -> m (MethodHandleMethod High)
evolve MethodHandleMethod Low
g = case MethodHandleMethod Low
g of
    MHInvokeVirtual    Ref (InRefType MethodId) Low
m -> InRefType MethodId -> MethodHandleMethod High
forall r. Ref (InRefType MethodId) r -> MethodHandleMethod r
MHInvokeVirtual (InRefType MethodId -> MethodHandleMethod High)
-> m (InRefType MethodId) -> m (MethodHandleMethod High)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Index -> m (InRefType MethodId)
forall (m :: * -> *) r.
(EvolveM m, Referenceable r) =>
Index -> m r
link Index
Ref (InRefType MethodId) Low
m
    MHInvokeStatic     Ref AbsVariableMethodId Low
m -> AbsVariableMethodId -> MethodHandleMethod High
forall r. Ref AbsVariableMethodId r -> MethodHandleMethod r
MHInvokeStatic (AbsVariableMethodId -> MethodHandleMethod High)
-> m AbsVariableMethodId -> m (MethodHandleMethod High)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Index -> m AbsVariableMethodId
forall (m :: * -> *) r.
(EvolveM m, Referenceable r) =>
Index -> m r
link Index
Ref AbsVariableMethodId Low
m
    MHInvokeSpecial    Ref AbsVariableMethodId Low
m -> AbsVariableMethodId -> MethodHandleMethod High
forall r. Ref AbsVariableMethodId r -> MethodHandleMethod r
MHInvokeSpecial (AbsVariableMethodId -> MethodHandleMethod High)
-> m AbsVariableMethodId -> m (MethodHandleMethod High)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Index -> m AbsVariableMethodId
forall (m :: * -> *) r.
(EvolveM m, Referenceable r) =>
Index -> m r
link Index
Ref AbsVariableMethodId Low
m
    MHNewInvokeSpecial Ref (InRefType MethodId) Low
m -> InRefType MethodId -> MethodHandleMethod High
forall r. Ref (InRefType MethodId) r -> MethodHandleMethod r
MHNewInvokeSpecial (InRefType MethodId -> MethodHandleMethod High)
-> m (InRefType MethodId) -> m (MethodHandleMethod High)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Index -> m (InRefType MethodId)
forall (m :: * -> *) r.
(EvolveM m, Referenceable r) =>
Index -> m r
link Index
Ref (InRefType MethodId) Low
m

  devolve :: MethodHandleMethod High -> m (MethodHandleMethod Low)
devolve MethodHandleMethod High
g = case MethodHandleMethod High
g of
    MHInvokeVirtual    Ref (InRefType MethodId) High
m -> Index -> MethodHandleMethod Low
forall r. Ref (InRefType MethodId) r -> MethodHandleMethod r
MHInvokeVirtual (Index -> MethodHandleMethod Low)
-> m Index -> m (MethodHandleMethod Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InRefType MethodId -> m Index
forall (m :: * -> *) r.
(DevolveM m, Referenceable r) =>
r -> m Index
unlink Ref (InRefType MethodId) High
InRefType MethodId
m
    MHInvokeStatic     Ref AbsVariableMethodId High
m -> Index -> MethodHandleMethod Low
forall r. Ref AbsVariableMethodId r -> MethodHandleMethod r
MHInvokeStatic (Index -> MethodHandleMethod Low)
-> m Index -> m (MethodHandleMethod Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AbsVariableMethodId -> m Index
forall (m :: * -> *) r.
(DevolveM m, Referenceable r) =>
r -> m Index
unlink Ref AbsVariableMethodId High
AbsVariableMethodId
m
    MHInvokeSpecial    Ref AbsVariableMethodId High
m -> Index -> MethodHandleMethod Low
forall r. Ref AbsVariableMethodId r -> MethodHandleMethod r
MHInvokeSpecial (Index -> MethodHandleMethod Low)
-> m Index -> m (MethodHandleMethod Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AbsVariableMethodId -> m Index
forall (m :: * -> *) r.
(DevolveM m, Referenceable r) =>
r -> m Index
unlink Ref AbsVariableMethodId High
AbsVariableMethodId
m
    MHNewInvokeSpecial Ref (InRefType MethodId) High
m -> Index -> MethodHandleMethod Low
forall r. Ref (InRefType MethodId) r -> MethodHandleMethod r
MHNewInvokeSpecial (Index -> MethodHandleMethod Low)
-> m Index -> m (MethodHandleMethod Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InRefType MethodId -> m Index
forall (m :: * -> *) r.
(DevolveM m, Referenceable r) =>
r -> m Index
unlink Ref (InRefType MethodId) High
InRefType MethodId
m

instance Staged MethodHandleField where
  evolve :: MethodHandleField Low -> m (MethodHandleField High)
evolve (MethodHandleField MethodHandleFieldKind
k Ref AbsFieldId Low
ref) = MethodHandleFieldKind
-> Ref AbsFieldId High -> MethodHandleField High
forall r.
MethodHandleFieldKind -> Ref AbsFieldId r -> MethodHandleField r
MethodHandleField MethodHandleFieldKind
k (AbsFieldId -> MethodHandleField High)
-> m AbsFieldId -> m (MethodHandleField High)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Index -> m AbsFieldId
forall (m :: * -> *) r.
(EvolveM m, Referenceable r) =>
Index -> m r
link Index
Ref AbsFieldId Low
ref

  devolve :: MethodHandleField High -> m (MethodHandleField Low)
devolve (MethodHandleField MethodHandleFieldKind
k Ref AbsFieldId High
ref) = MethodHandleFieldKind
-> Ref AbsFieldId Low -> MethodHandleField Low
forall r.
MethodHandleFieldKind -> Ref AbsFieldId r -> MethodHandleField r
MethodHandleField MethodHandleFieldKind
k (Index -> MethodHandleField Low)
-> m Index -> m (MethodHandleField Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AbsFieldId -> m Index
forall (m :: * -> *) r.
(DevolveM m, Referenceable r) =>
r -> m Index
unlink Ref AbsFieldId High
AbsFieldId
ref

instance Staged MethodHandleInterface where
  evolve :: MethodHandleInterface Low -> m (MethodHandleInterface High)
evolve (MethodHandleInterface Ref AbsInterfaceMethodId Low
ref) = AbsInterfaceMethodId -> MethodHandleInterface High
forall r. Ref AbsInterfaceMethodId r -> MethodHandleInterface r
MethodHandleInterface (AbsInterfaceMethodId -> MethodHandleInterface High)
-> m AbsInterfaceMethodId -> m (MethodHandleInterface High)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Index -> m AbsInterfaceMethodId
forall (m :: * -> *) r.
(EvolveM m, Referenceable r) =>
Index -> m r
link Index
Ref AbsInterfaceMethodId Low
ref

  devolve :: MethodHandleInterface High -> m (MethodHandleInterface Low)
devolve (MethodHandleInterface Ref AbsInterfaceMethodId High
ref) = Index -> MethodHandleInterface Low
forall r. Ref AbsInterfaceMethodId r -> MethodHandleInterface r
MethodHandleInterface (Index -> MethodHandleInterface Low)
-> m Index -> m (MethodHandleInterface Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AbsInterfaceMethodId -> m Index
forall (m :: * -> *) r.
(DevolveM m, Referenceable r) =>
r -> m Index
unlink Ref AbsInterfaceMethodId High
AbsInterfaceMethodId
ref