{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveAnyClass     #-}
{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE FlexibleInstances  #-}
{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE StandaloneDeriving #-}
{-|
Module      : Language.JVM.Attribute.BootstrapMethods
Copyright   : (c) Christian Gram Kalhauge, 2017
License     : MIT
Maintainer  : kalhuage@cs.ucla.edu

Based on the BootstrapMethods Attribute, as documented
[here](http://docs.oracle.com/javase/specs/jvms/se8/html/jvms-4.html#jvms-4.7.23).
-}

module Language.JVM.Attribute.BootstrapMethods
  ( BootstrapMethods (..)
  , methods
  , BootstrapMethod (..)
  ) where

import           Language.JVM.Constant
import           Language.JVM.Attribute.Base
import           Language.JVM.Staged
import           Language.JVM.Utils

-- | 'BootstrapMethods' is an Attribute.
instance IsAttribute (BootstrapMethods Low) where
  attrName :: Const Text (BootstrapMethods Low)
attrName = Text -> Const Text (BootstrapMethods Low)
forall k a (b :: k). a -> Const a b
Const Text
"BootstrapMethods"

-- | Is a list of bootstrapped methods.
newtype BootstrapMethods r = BootstrapMethods
  { BootstrapMethods r -> SizedList16 (BootstrapMethod r)
methods' :: SizedList16 (BootstrapMethod r)
  }

-- | The methods as list
methods :: BootstrapMethods r -> [ BootstrapMethod r ]
methods :: BootstrapMethods r -> [BootstrapMethod r]
methods = SizedList Word16 (BootstrapMethod r) -> [BootstrapMethod r]
forall w a. SizedList w a -> [a]
unSizedList (SizedList Word16 (BootstrapMethod r) -> [BootstrapMethod r])
-> (BootstrapMethods r -> SizedList Word16 (BootstrapMethod r))
-> BootstrapMethods r
-> [BootstrapMethod r]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BootstrapMethods r -> SizedList Word16 (BootstrapMethod r)
forall r. BootstrapMethods r -> SizedList16 (BootstrapMethod r)
methods'

-- | A bootstraped methods.
data BootstrapMethod r = BootstrapMethod
  { BootstrapMethod r -> DeepRef MethodHandle r
method :: !(DeepRef MethodHandle r)
  , BootstrapMethod r -> SizedList16 (Ref JValue r)
arguments :: !(SizedList16 (Ref JValue r))
  }

instance Staged BootstrapMethods where
  stage :: (forall (s' :: * -> *). Staged s' => s' r -> m (s' r'))
-> BootstrapMethods r -> m (BootstrapMethods r')
stage forall (s' :: * -> *). Staged s' => s' r -> m (s' r')
f (BootstrapMethods SizedList16 (BootstrapMethod r)
m) =
    String -> m (BootstrapMethods r') -> m (BootstrapMethods r')
forall (m :: * -> *) a. LabelM m => String -> m a -> m a
label String
"BootstrapMethods" (m (BootstrapMethods r') -> m (BootstrapMethods r'))
-> m (BootstrapMethods r') -> m (BootstrapMethods r')
forall a b. (a -> b) -> a -> b
$ SizedList16 (BootstrapMethod r') -> BootstrapMethods r'
forall r. SizedList16 (BootstrapMethod r) -> BootstrapMethods r
BootstrapMethods (SizedList16 (BootstrapMethod r') -> BootstrapMethods r')
-> m (SizedList16 (BootstrapMethod r')) -> m (BootstrapMethods r')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (BootstrapMethod r -> m (BootstrapMethod r'))
-> SizedList16 (BootstrapMethod r)
-> m (SizedList16 (BootstrapMethod r'))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM BootstrapMethod r -> m (BootstrapMethod r')
forall (s' :: * -> *). Staged s' => s' r -> m (s' r')
f SizedList16 (BootstrapMethod r)
m

instance Staged BootstrapMethod where
  evolve :: BootstrapMethod Low -> m (BootstrapMethod High)
evolve (BootstrapMethod DeepRef MethodHandle Low
a SizedList16 (Ref JValue Low)
m) =
    MethodHandle High
-> SizedList Word16 JValue -> BootstrapMethod High
forall r.
DeepRef MethodHandle r
-> SizedList16 (Ref JValue r) -> BootstrapMethod r
BootstrapMethod (MethodHandle High
 -> SizedList Word16 JValue -> BootstrapMethod High)
-> m (MethodHandle High)
-> m (SizedList Word16 JValue -> BootstrapMethod High)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word16 -> m (MethodHandle High)
forall (m :: * -> *) r.
(EvolveM m, Referenceable r) =>
Word16 -> m r
link Word16
DeepRef MethodHandle Low
a m (SizedList Word16 JValue -> BootstrapMethod High)
-> m (SizedList Word16 JValue) -> m (BootstrapMethod High)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Word16 -> m JValue)
-> SizedList Word16 Word16 -> m (SizedList Word16 JValue)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Word16 -> m JValue
forall (m :: * -> *) r.
(EvolveM m, Referenceable r) =>
Word16 -> m r
link SizedList Word16 Word16
SizedList16 (Ref JValue Low)
m

  devolve :: BootstrapMethod High -> m (BootstrapMethod Low)
devolve (BootstrapMethod DeepRef MethodHandle High
a SizedList16 (Ref JValue High)
m) =
    Word16 -> SizedList Word16 Word16 -> BootstrapMethod Low
forall r.
DeepRef MethodHandle r
-> SizedList16 (Ref JValue r) -> BootstrapMethod r
BootstrapMethod (Word16 -> SizedList Word16 Word16 -> BootstrapMethod Low)
-> m Word16 -> m (SizedList Word16 Word16 -> BootstrapMethod Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MethodHandle High -> m Word16
forall (m :: * -> *) r.
(DevolveM m, Referenceable r) =>
r -> m Word16
unlink DeepRef MethodHandle High
MethodHandle High
a m (SizedList Word16 Word16 -> BootstrapMethod Low)
-> m (SizedList Word16 Word16) -> m (BootstrapMethod Low)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (JValue -> m Word16)
-> SizedList Word16 JValue -> m (SizedList Word16 Word16)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM JValue -> m Word16
forall (m :: * -> *) r.
(DevolveM m, Referenceable r) =>
r -> m Word16
unlink SizedList16 (Ref JValue High)
SizedList Word16 JValue
m

$(deriveBaseWithBinary ''BootstrapMethod)
$(deriveBaseWithBinary ''BootstrapMethods)