{-# LANGUAGE TupleSections #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
module Language.JVM.ConstantPool
(
ConstantPool (..)
, access
, append
, empty
, PoolAccessError (..)
) where
import Control.DeepSeq (NFData)
import Control.Monad.Except
import Data.Binary
import Data.Binary.Get
import Data.Binary.Put
import qualified Data.IntMap as IM
import GHC.Generics (Generic)
import Language.JVM.Constant
import Language.JVM.Stage
import Language.JVM.TH
newtype ConstantPool r = ConstantPool
{ unConstantPool :: IM.IntMap (Constant r)
}
instance Binary (ConstantPool Low) where
get = do
len <- fromIntegral <$> getWord16be
list <- go len 1
return . ConstantPool $ IM.fromList list
where
go len n | len > n = do
constant <- get
rest <- go len (n + constantSize constant)
return $ (n, constant) : rest
go _ _ = return []
put (ConstantPool p) = do
case IM.maxViewWithKey p of
Just ((key, e), _) -> do
putInt16be (fromIntegral (key + constantSize e))
forM_ (IM.toAscList p) (put . snd)
Nothing -> do
putInt16be 0
data PoolAccessError = PoolAccessError
{ paErrorRef :: !Word16
, paErrorMsg :: String
} deriving (Show, Eq, Generic)
instance NFData PoolAccessError
empty :: ConstantPool r
empty = ConstantPool (IM.empty)
access :: Index -> ConstantPool r -> Either PoolAccessError (Constant r)
access ref (ConstantPool cp) =
case IM.lookup (fromIntegral ref) cp of
Just x -> Right x
Nothing -> Left $ PoolAccessError ref "No such element."
append :: Constant r -> ConstantPool r -> (Index, ConstantPool r)
append c (ConstantPool cp) =
(fromIntegral i, ConstantPool $ IM.insert i c cp)
where
i =
case IM.toDescList cp of
(k, a):_ ->
k + constantSize a
_ -> 1
$(deriveBase ''ConstantPool)