{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE RankNTypes #-}
module Language.JVM.ClassFileReader
( readClassFile
, writeClassFile
, writeClassFile'
, decodeClassFile
, encodeClassFile
, evolveClassFile
, devolveClassFile
, devolveClassFile'
, roundtripCopy
, Evolve
, ClassFileError
, EvolveConfig (..)
, runEvolve
, bootstrapConstantPool
, ConstantPoolBuilder
, runConstantPoolBuilder
, CPBuilder (..)
, builderFromConstantPool
, constantPoolFromBuilder
, cpbEmpty
) where
import Control.DeepSeq (NFData)
import Control.Monad.Except
import Control.Monad.Reader
import Control.Monad.State
import Data.Binary
import qualified Data.ByteString.Lazy as BL
import qualified Data.Map as Map
import qualified Data.List as List
import qualified Data.Text as Text
import GHC.Generics (Generic)
import Language.JVM.ClassFile
import Language.JVM.Constant
import Language.JVM.ConstantPool as CP
import Language.JVM.Staged
decodeClassFile :: BL.ByteString -> Either ClassFileError (ClassFile Low)
decodeClassFile :: ByteString -> Either ClassFileError (ClassFile Low)
decodeClassFile ByteString
bs = do
case ByteString
-> Either
(ByteString, ByteOffset, String)
(ByteString, ByteOffset, ClassFile Low)
forall a.
Binary a =>
ByteString
-> Either
(ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
decodeOrFail ByteString
bs of
Right (ByteString
rest, ByteOffset
off, ClassFile Low
cf)
| ByteString -> ByteOffset
BL.length ByteString
rest ByteOffset -> ByteOffset -> Bool
forall a. Eq a => a -> a -> Bool
== ByteOffset
0 -> ClassFile Low -> Either ClassFileError (ClassFile Low)
forall a b. b -> Either a b
Right ClassFile Low
cf
| Bool
otherwise ->
ByteString
-> ByteOffset -> String -> Either ClassFileError (ClassFile Low)
forall a b.
Show a =>
ByteString -> a -> String -> Either ClassFileError b
unreadable ByteString
rest ByteOffset
off String
"expected end of file"
Left (ByteString
rest, ByteOffset
off, String
msg) ->
ByteString
-> ByteOffset -> String -> Either ClassFileError (ClassFile Low)
forall a b.
Show a =>
ByteString -> a -> String -> Either ClassFileError b
unreadable ByteString
rest ByteOffset
off String
msg
where
unreadable :: ByteString -> a -> String -> Either ClassFileError b
unreadable ByteString
rest a
off String
msg =
ClassFileError -> Either ClassFileError b
forall a b. a -> Either a b
Left (ClassFileError -> Either ClassFileError b)
-> ClassFileError -> Either ClassFileError b
forall a b. (a -> b) -> a -> b
$ String -> ClassFileError
CFEUnreadableFile ((a -> String
forall a. Show a => a -> String
show a
off) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (ByteOffset -> String
forall a. Show a => a -> String
show (ByteOffset -> String) -> ByteOffset -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteOffset
BL.length ByteString
rest) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg)
encodeClassFile :: ClassFile Low -> BL.ByteString
encodeClassFile :: ClassFile Low -> ByteString
encodeClassFile ClassFile Low
clf = do
ClassFile Low -> ByteString
forall a. Binary a => a -> ByteString
encode ClassFile Low
clf
evolveClassFile ::
((AttributeLocation, Text.Text) -> Bool)
-> ClassFile Low
-> Either ClassFileError (ClassFile High)
evolveClassFile :: ((AttributeLocation, Text) -> Bool)
-> ClassFile Low -> Either ClassFileError (ClassFile High)
evolveClassFile (AttributeLocation, Text) -> Bool
fn ClassFile Low
cf = do
ConstantPool High
cp <- ConstantPool Low -> Either ClassFileError (ConstantPool High)
bootstrapConstantPool (ClassFile Low -> Choice (ConstantPool Low) () Low
forall r. ClassFile r -> Choice (ConstantPool r) () r
cConstantPool ClassFile Low
cf)
EvolveConfig
-> Evolve (ClassFile High)
-> Either ClassFileError (ClassFile High)
forall a. EvolveConfig -> Evolve a -> Either ClassFileError a
runEvolve ([String]
-> ConstantPool High
-> ((AttributeLocation, Text) -> Bool)
-> EvolveConfig
EvolveConfig [] ConstantPool High
cp (AttributeLocation, Text) -> Bool
fn ) (ClassFile Low -> Evolve (ClassFile High)
forall (s :: * -> *) (m :: * -> *).
(Staged s, EvolveM m) =>
s Low -> m (s High)
evolve ClassFile Low
cf)
devolveClassFile :: ClassFile High -> ClassFile Low
devolveClassFile :: ClassFile High -> ClassFile Low
devolveClassFile ClassFile High
cf =
let (ClassFile Low
cf', CPBuilder
cpb) = ConstantPoolBuilder (ClassFile Low)
-> CPBuilder -> (ClassFile Low, CPBuilder)
forall a. ConstantPoolBuilder a -> CPBuilder -> (a, CPBuilder)
runConstantPoolBuilder (ClassFile High -> ConstantPoolBuilder (ClassFile Low)
forall (s :: * -> *) (m :: * -> *).
(Staged s, DevolveM m) =>
s High -> m (s Low)
devolve ClassFile High
cf) CPBuilder
cpbEmpty in
ClassFile Low
cf' { cConstantPool :: Choice (ConstantPool Low) () Low
cConstantPool = [Constant Low] -> ConstantPool Low
forall (f :: * -> *) r.
Foldable f =>
f (Constant r) -> ConstantPool r
fromConstants ([Constant Low] -> [Constant Low]
forall a. [a] -> [a]
reverse ([Constant Low] -> [Constant Low])
-> [Constant Low] -> [Constant Low]
forall a b. (a -> b) -> a -> b
$ CPBuilder -> [Constant Low]
cpbConstants CPBuilder
cpb)}
devolveClassFile' :: ConstantPool Low -> ClassFile High -> ClassFile Low
devolveClassFile' :: ConstantPool Low -> ClassFile High -> ClassFile Low
devolveClassFile' ConstantPool Low
cp ClassFile High
cf =
let (ClassFile Low
cf', CPBuilder
cpb) = ConstantPoolBuilder (ClassFile Low)
-> CPBuilder -> (ClassFile Low, CPBuilder)
forall a. ConstantPoolBuilder a -> CPBuilder -> (a, CPBuilder)
runConstantPoolBuilder (ClassFile High -> ConstantPoolBuilder (ClassFile Low)
forall (s :: * -> *) (m :: * -> *).
(Staged s, DevolveM m) =>
s High -> m (s Low)
devolve ClassFile High
cf) (ConstantPool Low -> CPBuilder
builderFromConstantPool ConstantPool Low
cp) in
ClassFile Low
cf' { cConstantPool :: Choice (ConstantPool Low) () Low
cConstantPool = CPBuilder -> ConstantPool Low
constantPoolFromBuilder CPBuilder
cpb }
readClassFile :: BL.ByteString -> Either ClassFileError (ClassFile High)
readClassFile :: ByteString -> Either ClassFileError (ClassFile High)
readClassFile ByteString
bs = do
ClassFile Low
clf <- ByteString -> Either ClassFileError (ClassFile Low)
decodeClassFile ByteString
bs
((AttributeLocation, Text) -> Bool)
-> ClassFile Low -> Either ClassFileError (ClassFile High)
evolveClassFile (Bool -> (AttributeLocation, Text) -> Bool
forall a b. a -> b -> a
const Bool
True) ClassFile Low
clf
writeClassFile :: ClassFile High -> BL.ByteString
writeClassFile :: ClassFile High -> ByteString
writeClassFile =
ClassFile Low -> ByteString
encodeClassFile (ClassFile Low -> ByteString)
-> (ClassFile High -> ClassFile Low)
-> ClassFile High
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClassFile High -> ClassFile Low
devolveClassFile
writeClassFile' :: ConstantPool Low -> ClassFile High -> BL.ByteString
writeClassFile' :: ConstantPool Low -> ClassFile High -> ByteString
writeClassFile' ConstantPool Low
cp =
ClassFile Low -> ByteString
encodeClassFile (ClassFile Low -> ByteString)
-> (ClassFile High -> ClassFile Low)
-> ClassFile High
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConstantPool Low -> ClassFile High -> ClassFile Low
devolveClassFile' ConstantPool Low
cp
roundtripCopy :: FilePath -> FilePath -> IO ()
roundtripCopy :: String -> String -> IO ()
roundtripCopy String
f1 String
f2 = do
Right ClassFile High
cf <- ByteString -> Either ClassFileError (ClassFile High)
readClassFile (ByteString -> Either ClassFileError (ClassFile High))
-> IO ByteString -> IO (Either ClassFileError (ClassFile High))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ByteString
BL.readFile String
f1
String -> ByteString -> IO ()
BL.writeFile String
f2 (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ ClassFile High -> ByteString
writeClassFile ClassFile High
cf
data ClassFileError
= CFEPoolAccessError !String !PoolAccessError
| CFEInconsistentClassPool !String !String
| CFEConversionError !String !String
| CFEUnreadableFile !String
deriving (Int -> ClassFileError -> String -> String
[ClassFileError] -> String -> String
ClassFileError -> String
(Int -> ClassFileError -> String -> String)
-> (ClassFileError -> String)
-> ([ClassFileError] -> String -> String)
-> Show ClassFileError
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [ClassFileError] -> String -> String
$cshowList :: [ClassFileError] -> String -> String
show :: ClassFileError -> String
$cshow :: ClassFileError -> String
showsPrec :: Int -> ClassFileError -> String -> String
$cshowsPrec :: Int -> ClassFileError -> String -> String
Show, ClassFileError -> ClassFileError -> Bool
(ClassFileError -> ClassFileError -> Bool)
-> (ClassFileError -> ClassFileError -> Bool) -> Eq ClassFileError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClassFileError -> ClassFileError -> Bool
$c/= :: ClassFileError -> ClassFileError -> Bool
== :: ClassFileError -> ClassFileError -> Bool
$c== :: ClassFileError -> ClassFileError -> Bool
Eq, (forall x. ClassFileError -> Rep ClassFileError x)
-> (forall x. Rep ClassFileError x -> ClassFileError)
-> Generic ClassFileError
forall x. Rep ClassFileError x -> ClassFileError
forall x. ClassFileError -> Rep ClassFileError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ClassFileError x -> ClassFileError
$cfrom :: forall x. ClassFileError -> Rep ClassFileError x
Generic)
instance NFData ClassFileError
data EvolveConfig =
EvolveConfig
{ EvolveConfig -> [String]
ecLabel :: [String]
, EvolveConfig -> ConstantPool High
ecConstantPool :: ConstantPool High
, EvolveConfig -> (AttributeLocation, Text) -> Bool
ecAttributeFilter :: ((AttributeLocation, Text.Text) -> Bool)
}
newtype Evolve a =
Evolve (ReaderT EvolveConfig (Either ClassFileError) a)
deriving
( a -> Evolve b -> Evolve a
(a -> b) -> Evolve a -> Evolve b
(forall a b. (a -> b) -> Evolve a -> Evolve b)
-> (forall a b. a -> Evolve b -> Evolve a) -> Functor Evolve
forall a b. a -> Evolve b -> Evolve a
forall a b. (a -> b) -> Evolve a -> Evolve b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Evolve b -> Evolve a
$c<$ :: forall a b. a -> Evolve b -> Evolve a
fmap :: (a -> b) -> Evolve a -> Evolve b
$cfmap :: forall a b. (a -> b) -> Evolve a -> Evolve b
Functor
, Functor Evolve
a -> Evolve a
Functor Evolve
-> (forall a. a -> Evolve a)
-> (forall a b. Evolve (a -> b) -> Evolve a -> Evolve b)
-> (forall a b c.
(a -> b -> c) -> Evolve a -> Evolve b -> Evolve c)
-> (forall a b. Evolve a -> Evolve b -> Evolve b)
-> (forall a b. Evolve a -> Evolve b -> Evolve a)
-> Applicative Evolve
Evolve a -> Evolve b -> Evolve b
Evolve a -> Evolve b -> Evolve a
Evolve (a -> b) -> Evolve a -> Evolve b
(a -> b -> c) -> Evolve a -> Evolve b -> Evolve c
forall a. a -> Evolve a
forall a b. Evolve a -> Evolve b -> Evolve a
forall a b. Evolve a -> Evolve b -> Evolve b
forall a b. Evolve (a -> b) -> Evolve a -> Evolve b
forall a b c. (a -> b -> c) -> Evolve a -> Evolve b -> Evolve c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: Evolve a -> Evolve b -> Evolve a
$c<* :: forall a b. Evolve a -> Evolve b -> Evolve a
*> :: Evolve a -> Evolve b -> Evolve b
$c*> :: forall a b. Evolve a -> Evolve b -> Evolve b
liftA2 :: (a -> b -> c) -> Evolve a -> Evolve b -> Evolve c
$cliftA2 :: forall a b c. (a -> b -> c) -> Evolve a -> Evolve b -> Evolve c
<*> :: Evolve (a -> b) -> Evolve a -> Evolve b
$c<*> :: forall a b. Evolve (a -> b) -> Evolve a -> Evolve b
pure :: a -> Evolve a
$cpure :: forall a. a -> Evolve a
$cp1Applicative :: Functor Evolve
Applicative
, Applicative Evolve
a -> Evolve a
Applicative Evolve
-> (forall a b. Evolve a -> (a -> Evolve b) -> Evolve b)
-> (forall a b. Evolve a -> Evolve b -> Evolve b)
-> (forall a. a -> Evolve a)
-> Monad Evolve
Evolve a -> (a -> Evolve b) -> Evolve b
Evolve a -> Evolve b -> Evolve b
forall a. a -> Evolve a
forall a b. Evolve a -> Evolve b -> Evolve b
forall a b. Evolve a -> (a -> Evolve b) -> Evolve b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> Evolve a
$creturn :: forall a. a -> Evolve a
>> :: Evolve a -> Evolve b -> Evolve b
$c>> :: forall a b. Evolve a -> Evolve b -> Evolve b
>>= :: Evolve a -> (a -> Evolve b) -> Evolve b
$c>>= :: forall a b. Evolve a -> (a -> Evolve b) -> Evolve b
$cp1Monad :: Applicative Evolve
Monad
, MonadReader EvolveConfig
, MonadError ClassFileError
)
runEvolve :: EvolveConfig -> Evolve a -> Either ClassFileError a
runEvolve :: EvolveConfig -> Evolve a -> Either ClassFileError a
runEvolve EvolveConfig
ev (Evolve ReaderT EvolveConfig (Either ClassFileError) a
m) = ReaderT EvolveConfig (Either ClassFileError) a
-> EvolveConfig -> Either ClassFileError a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT EvolveConfig (Either ClassFileError) a
m EvolveConfig
ev
instance LabelM Evolve where
label :: String -> Evolve a -> Evolve a
label String
str (Evolve ReaderT EvolveConfig (Either ClassFileError) a
m) = do
ReaderT EvolveConfig (Either ClassFileError) a -> Evolve a
forall a.
ReaderT EvolveConfig (Either ClassFileError) a -> Evolve a
Evolve (ReaderT EvolveConfig (Either ClassFileError) a -> Evolve a)
-> (ReaderT EvolveConfig (Either ClassFileError) a
-> ReaderT EvolveConfig (Either ClassFileError) a)
-> ReaderT EvolveConfig (Either ClassFileError) a
-> Evolve a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EvolveConfig -> EvolveConfig)
-> ReaderT EvolveConfig (Either ClassFileError) a
-> ReaderT EvolveConfig (Either ClassFileError) a
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT (\EvolveConfig
ec -> EvolveConfig
ec { ecLabel :: [String]
ecLabel = String
str String -> [String] -> [String]
forall a. a -> [a] -> [a]
: EvolveConfig -> [String]
ecLabel EvolveConfig
ec}) (ReaderT EvolveConfig (Either ClassFileError) a -> Evolve a)
-> ReaderT EvolveConfig (Either ClassFileError) a -> Evolve a
forall a b. (a -> b) -> a -> b
$ ReaderT EvolveConfig (Either ClassFileError) a
m
showLvl :: [String] -> String
showLvl :: [String] -> String
showLvl = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
List.intercalate String
"/" ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall a. [a] -> [a]
reverse
instance EvolveM Evolve where
link :: Index -> Evolve r
link Index
w = do
EvolveConfig
ec <- Evolve EvolveConfig
forall r (m :: * -> *). MonadReader r m => m r
ask
let lvl :: String
lvl = [String] -> String
showLvl ( EvolveConfig -> [String]
ecLabel EvolveConfig
ec )
Constant High
r <- (PoolAccessError -> Evolve (Constant High))
-> (Constant High -> Evolve (Constant High))
-> Either PoolAccessError (Constant High)
-> Evolve (Constant High)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ClassFileError -> Evolve (Constant High)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ClassFileError -> Evolve (Constant High))
-> (PoolAccessError -> ClassFileError)
-> PoolAccessError
-> Evolve (Constant High)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PoolAccessError -> ClassFileError
CFEPoolAccessError String
lvl) Constant High -> Evolve (Constant High)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either PoolAccessError (Constant High) -> Evolve (Constant High))
-> Either PoolAccessError (Constant High) -> Evolve (Constant High)
forall a b. (a -> b) -> a -> b
$ Index
-> ConstantPool High -> Either PoolAccessError (Constant High)
forall r.
Index -> ConstantPool r -> Either PoolAccessError (Constant r)
access Index
w (EvolveConfig -> ConstantPool High
ecConstantPool EvolveConfig
ec)
(forall r. String -> Evolve r) -> Constant High -> Evolve r
forall a (m :: * -> *).
(Referenceable a, Monad m) =>
(forall a'. String -> m a') -> Constant High -> m a
fromConst (ClassFileError -> Evolve a'
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ClassFileError -> Evolve a')
-> (String -> ClassFileError) -> String -> Evolve a'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> ClassFileError
CFEInconsistentClassPool String
lvl) Constant High
r
attributeFilter :: Evolve ((AttributeLocation, Text) -> Bool)
attributeFilter =
(EvolveConfig -> (AttributeLocation, Text) -> Bool)
-> Evolve ((AttributeLocation, Text) -> Bool)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks EvolveConfig -> (AttributeLocation, Text) -> Bool
ecAttributeFilter
evolveError :: String -> Evolve r
evolveError String
msg = do
String
lvl <- (EvolveConfig -> String) -> Evolve String
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ([String] -> String
showLvl ([String] -> String)
-> (EvolveConfig -> [String]) -> EvolveConfig -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvolveConfig -> [String]
ecLabel)
ClassFileError -> Evolve r
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> String -> ClassFileError
CFEConversionError String
lvl String
msg)
bootstrapConstantPool :: ConstantPool Low -> Either ClassFileError (ConstantPool High)
bootstrapConstantPool :: ConstantPool Low -> Either ClassFileError (ConstantPool High)
bootstrapConstantPool ConstantPool Low
reffed =
case (ConstantPool High
-> Constant Low -> Either ClassFileError (Constant High))
-> ConstantPool Low
-> (ConstantPool High, [(ClassFileError, (Index, Constant Low))])
forall b.
(ConstantPool High -> Constant Low -> Either b (Constant High))
-> ConstantPool Low
-> (ConstantPool High, [(b, (Index, Constant Low))])
growPool ConstantPool High
-> Constant Low -> Either ClassFileError (Constant High)
forall (s :: * -> *).
Staged s =>
ConstantPool High -> s Low -> Either ClassFileError (s High)
improve ConstantPool Low
reffed of
(ConstantPool High
cp, []) ->
ConstantPool High -> Either ClassFileError (ConstantPool High)
forall a b. b -> Either a b
Right ConstantPool High
cp
(ConstantPool High
_, [(ClassFileError, (Index, Constant Low))]
xs) ->
ClassFileError -> Either ClassFileError (ConstantPool High)
forall a b. a -> Either a b
Left (ClassFileError -> Either ClassFileError (ConstantPool High))
-> (String -> ClassFileError)
-> String
-> Either ClassFileError (ConstantPool High)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> ClassFileError
CFEInconsistentClassPool String
"ConstantPool"
(String -> Either ClassFileError (ConstantPool High))
-> String -> Either ClassFileError (ConstantPool High)
forall a b. (a -> b) -> a -> b
$ String
"Could not load all constants in the constant pool: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ([(ClassFileError, (Index, Constant Low))] -> String
forall a. Show a => a -> String
show [(ClassFileError, (Index, Constant Low))]
xs)
where
improve :: ConstantPool High -> s Low -> Either ClassFileError (s High)
improve ConstantPool High
cp s Low
low =
EvolveConfig -> Evolve (s High) -> Either ClassFileError (s High)
forall a. EvolveConfig -> Evolve a -> Either ClassFileError a
runEvolve ([String]
-> ConstantPool High
-> ((AttributeLocation, Text) -> Bool)
-> EvolveConfig
EvolveConfig [] ConstantPool High
cp (Bool -> (AttributeLocation, Text) -> Bool
forall a b. a -> b -> a
const Bool
True)) (s Low -> Evolve (s High)
forall (s :: * -> *) (m :: * -> *).
(Staged s, EvolveM m) =>
s Low -> m (s High)
evolve s Low
low)
{-# SCC bootstrapConstantPool #-}
data CPBuilder = CPBuilder
{ CPBuilder -> Map (Constant Low) Index
cpbMapper :: Map.Map (Constant Low) Index
, CPBuilder -> Index
cpbNextIndex :: Index
, CPBuilder -> [Constant Low]
cpbConstants :: [Constant Low]
} deriving (Int -> CPBuilder -> String -> String
[CPBuilder] -> String -> String
CPBuilder -> String
(Int -> CPBuilder -> String -> String)
-> (CPBuilder -> String)
-> ([CPBuilder] -> String -> String)
-> Show CPBuilder
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [CPBuilder] -> String -> String
$cshowList :: [CPBuilder] -> String -> String
show :: CPBuilder -> String
$cshow :: CPBuilder -> String
showsPrec :: Int -> CPBuilder -> String -> String
$cshowsPrec :: Int -> CPBuilder -> String -> String
Show)
cpbEmpty :: CPBuilder
cpbEmpty :: CPBuilder
cpbEmpty = Map (Constant Low) Index -> Index -> [Constant Low] -> CPBuilder
CPBuilder Map (Constant Low) Index
forall k a. Map k a
Map.empty Index
1 []
builderFromConstantPool :: ConstantPool Low -> CPBuilder
builderFromConstantPool :: ConstantPool Low -> CPBuilder
builderFromConstantPool ConstantPool Low
cp =
Map (Constant Low) Index -> Index -> [Constant Low] -> CPBuilder
CPBuilder ([(Constant Low, Index)] -> Map (Constant Low) Index
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Constant Low, Index)] -> Map (Constant Low) Index)
-> (ConstantPool Low -> [(Constant Low, Index)])
-> ConstantPool Low
-> Map (Constant Low) Index
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Index, Constant Low) -> (Constant Low, Index))
-> [(Index, Constant Low)] -> [(Constant Low, Index)]
forall a b. (a -> b) -> [a] -> [b]
map (Index, Constant Low) -> (Constant Low, Index)
forall a b a. (Integral a, Num b) => (a, a) -> (a, b)
change ([(Index, Constant Low)] -> [(Constant Low, Index)])
-> (ConstantPool Low -> [(Index, Constant Low)])
-> ConstantPool Low
-> [(Constant Low, Index)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConstantPool Low -> [(Index, Constant Low)]
forall r. ConstantPool r -> [(Index, Constant r)]
listConstants (ConstantPool Low -> Map (Constant Low) Index)
-> ConstantPool Low -> Map (Constant Low) Index
forall a b. (a -> b) -> a -> b
$ ConstantPool Low
cp) (ConstantPool Low -> Index
forall r. ConstantPool r -> Index
nextIndex ConstantPool Low
cp) (((Index, Constant Low) -> Constant Low)
-> [(Index, Constant Low)] -> [Constant Low]
forall a b. (a -> b) -> [a] -> [b]
map (Index, Constant Low) -> Constant Low
forall a b. (a, b) -> b
snd [(Index, Constant Low)]
constants)
where
constants :: [(Index, Constant Low)]
constants = ConstantPool Low -> [(Index, Constant Low)]
forall r. ConstantPool r -> [(Index, Constant r)]
listConstants ConstantPool Low
cp
change :: (a, a) -> (a, b)
change (a
a, a
b) = (a
b, a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
a)
constantPoolFromBuilder :: CPBuilder -> ConstantPool Low
constantPoolFromBuilder :: CPBuilder -> ConstantPool Low
constantPoolFromBuilder CPBuilder
cpb =
[Constant Low] -> ConstantPool Low
forall (f :: * -> *) r.
Foldable f =>
f (Constant r) -> ConstantPool r
fromConstants ([Constant Low] -> [Constant Low]
forall a. [a] -> [a]
reverse ([Constant Low] -> [Constant Low])
-> [Constant Low] -> [Constant Low]
forall a b. (a -> b) -> a -> b
$ CPBuilder -> [Constant Low]
cpbConstants CPBuilder
cpb)
newtype ConstantPoolBuilder a =
ConstantPoolBuilder (State CPBuilder a)
deriving (Applicative ConstantPoolBuilder
a -> ConstantPoolBuilder a
Applicative ConstantPoolBuilder
-> (forall a b.
ConstantPoolBuilder a
-> (a -> ConstantPoolBuilder b) -> ConstantPoolBuilder b)
-> (forall a b.
ConstantPoolBuilder a
-> ConstantPoolBuilder b -> ConstantPoolBuilder b)
-> (forall a. a -> ConstantPoolBuilder a)
-> Monad ConstantPoolBuilder
ConstantPoolBuilder a
-> (a -> ConstantPoolBuilder b) -> ConstantPoolBuilder b
ConstantPoolBuilder a
-> ConstantPoolBuilder b -> ConstantPoolBuilder b
forall a. a -> ConstantPoolBuilder a
forall a b.
ConstantPoolBuilder a
-> ConstantPoolBuilder b -> ConstantPoolBuilder b
forall a b.
ConstantPoolBuilder a
-> (a -> ConstantPoolBuilder b) -> ConstantPoolBuilder b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> ConstantPoolBuilder a
$creturn :: forall a. a -> ConstantPoolBuilder a
>> :: ConstantPoolBuilder a
-> ConstantPoolBuilder b -> ConstantPoolBuilder b
$c>> :: forall a b.
ConstantPoolBuilder a
-> ConstantPoolBuilder b -> ConstantPoolBuilder b
>>= :: ConstantPoolBuilder a
-> (a -> ConstantPoolBuilder b) -> ConstantPoolBuilder b
$c>>= :: forall a b.
ConstantPoolBuilder a
-> (a -> ConstantPoolBuilder b) -> ConstantPoolBuilder b
$cp1Monad :: Applicative ConstantPoolBuilder
Monad, MonadState CPBuilder, a -> ConstantPoolBuilder b -> ConstantPoolBuilder a
(a -> b) -> ConstantPoolBuilder a -> ConstantPoolBuilder b
(forall a b.
(a -> b) -> ConstantPoolBuilder a -> ConstantPoolBuilder b)
-> (forall a b.
a -> ConstantPoolBuilder b -> ConstantPoolBuilder a)
-> Functor ConstantPoolBuilder
forall a b. a -> ConstantPoolBuilder b -> ConstantPoolBuilder a
forall a b.
(a -> b) -> ConstantPoolBuilder a -> ConstantPoolBuilder b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> ConstantPoolBuilder b -> ConstantPoolBuilder a
$c<$ :: forall a b. a -> ConstantPoolBuilder b -> ConstantPoolBuilder a
fmap :: (a -> b) -> ConstantPoolBuilder a -> ConstantPoolBuilder b
$cfmap :: forall a b.
(a -> b) -> ConstantPoolBuilder a -> ConstantPoolBuilder b
Functor, Functor ConstantPoolBuilder
a -> ConstantPoolBuilder a
Functor ConstantPoolBuilder
-> (forall a. a -> ConstantPoolBuilder a)
-> (forall a b.
ConstantPoolBuilder (a -> b)
-> ConstantPoolBuilder a -> ConstantPoolBuilder b)
-> (forall a b c.
(a -> b -> c)
-> ConstantPoolBuilder a
-> ConstantPoolBuilder b
-> ConstantPoolBuilder c)
-> (forall a b.
ConstantPoolBuilder a
-> ConstantPoolBuilder b -> ConstantPoolBuilder b)
-> (forall a b.
ConstantPoolBuilder a
-> ConstantPoolBuilder b -> ConstantPoolBuilder a)
-> Applicative ConstantPoolBuilder
ConstantPoolBuilder a
-> ConstantPoolBuilder b -> ConstantPoolBuilder b
ConstantPoolBuilder a
-> ConstantPoolBuilder b -> ConstantPoolBuilder a
ConstantPoolBuilder (a -> b)
-> ConstantPoolBuilder a -> ConstantPoolBuilder b
(a -> b -> c)
-> ConstantPoolBuilder a
-> ConstantPoolBuilder b
-> ConstantPoolBuilder c
forall a. a -> ConstantPoolBuilder a
forall a b.
ConstantPoolBuilder a
-> ConstantPoolBuilder b -> ConstantPoolBuilder a
forall a b.
ConstantPoolBuilder a
-> ConstantPoolBuilder b -> ConstantPoolBuilder b
forall a b.
ConstantPoolBuilder (a -> b)
-> ConstantPoolBuilder a -> ConstantPoolBuilder b
forall a b c.
(a -> b -> c)
-> ConstantPoolBuilder a
-> ConstantPoolBuilder b
-> ConstantPoolBuilder c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: ConstantPoolBuilder a
-> ConstantPoolBuilder b -> ConstantPoolBuilder a
$c<* :: forall a b.
ConstantPoolBuilder a
-> ConstantPoolBuilder b -> ConstantPoolBuilder a
*> :: ConstantPoolBuilder a
-> ConstantPoolBuilder b -> ConstantPoolBuilder b
$c*> :: forall a b.
ConstantPoolBuilder a
-> ConstantPoolBuilder b -> ConstantPoolBuilder b
liftA2 :: (a -> b -> c)
-> ConstantPoolBuilder a
-> ConstantPoolBuilder b
-> ConstantPoolBuilder c
$cliftA2 :: forall a b c.
(a -> b -> c)
-> ConstantPoolBuilder a
-> ConstantPoolBuilder b
-> ConstantPoolBuilder c
<*> :: ConstantPoolBuilder (a -> b)
-> ConstantPoolBuilder a -> ConstantPoolBuilder b
$c<*> :: forall a b.
ConstantPoolBuilder (a -> b)
-> ConstantPoolBuilder a -> ConstantPoolBuilder b
pure :: a -> ConstantPoolBuilder a
$cpure :: forall a. a -> ConstantPoolBuilder a
$cp1Applicative :: Functor ConstantPoolBuilder
Applicative)
runConstantPoolBuilder :: ConstantPoolBuilder a -> CPBuilder -> (a, CPBuilder)
runConstantPoolBuilder :: ConstantPoolBuilder a -> CPBuilder -> (a, CPBuilder)
runConstantPoolBuilder (ConstantPoolBuilder State CPBuilder a
m) CPBuilder
a =
State CPBuilder a -> CPBuilder -> (a, CPBuilder)
forall s a. State s a -> s -> (a, s)
runState State CPBuilder a
m CPBuilder
a
instance LabelM ConstantPoolBuilder
instance DevolveM ConstantPoolBuilder where
unlink :: r -> ConstantPoolBuilder Index
unlink r
r = do
Constant High
c <- r -> ConstantPoolBuilder (Constant High)
forall a (m :: * -> *).
(Referenceable a, Monad m) =>
a -> m (Constant High)
toConst r
r
Constant Low
c' <- Constant High -> ConstantPoolBuilder (Constant Low)
forall (s :: * -> *) (m :: * -> *).
(Staged s, DevolveM m) =>
s High -> m (s Low)
devolve Constant High
c
Maybe Index
mw <- (CPBuilder -> Maybe Index) -> ConstantPoolBuilder (Maybe Index)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Constant Low -> Map (Constant Low) Index -> Maybe Index
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Constant Low
c' (Map (Constant Low) Index -> Maybe Index)
-> (CPBuilder -> Map (Constant Low) Index)
-> CPBuilder
-> Maybe Index
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CPBuilder -> Map (Constant Low) Index
cpbMapper)
case Maybe Index
mw of
Just Index
w -> Index -> ConstantPoolBuilder Index
forall (m :: * -> *) a. Monad m => a -> m a
return Index
w
Maybe Index
Nothing -> do
Index
w <- (CPBuilder -> (Index, CPBuilder)) -> ConstantPoolBuilder Index
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state ((CPBuilder -> (Index, CPBuilder)) -> ConstantPoolBuilder Index)
-> (Constant Low -> CPBuilder -> (Index, CPBuilder))
-> Constant Low
-> ConstantPoolBuilder Index
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Constant Low -> CPBuilder -> (Index, CPBuilder)
stateCPBuilder (Constant Low -> ConstantPoolBuilder Index)
-> Constant Low -> ConstantPoolBuilder Index
forall a b. (a -> b) -> a -> b
$ Constant Low
c'
Index -> ConstantPoolBuilder Index
forall (m :: * -> *) a. Monad m => a -> m a
return Index
w
stateCPBuilder
:: Constant Low
-> CPBuilder
-> (Index, CPBuilder)
stateCPBuilder :: Constant Low -> CPBuilder -> (Index, CPBuilder)
stateCPBuilder Constant Low
c' CPBuilder
cpb =
let w :: Index
w = CPBuilder -> Index
cpbNextIndex CPBuilder
cpb
in ( Index
w
, CPBuilder
cpb
{ cpbNextIndex :: Index
cpbNextIndex = Index
w Index -> Index -> Index
forall a. Num a => a -> a -> a
+ Constant Low -> Index
forall r. Constant r -> Index
constantSize Constant Low
c'
, cpbConstants :: [Constant Low]
cpbConstants = Constant Low
c' Constant Low -> [Constant Low] -> [Constant Low]
forall a. a -> [a] -> [a]
: CPBuilder -> [Constant Low]
cpbConstants CPBuilder
cpb
, cpbMapper :: Map (Constant Low) Index
cpbMapper = Constant Low
-> Index -> Map (Constant Low) Index -> Map (Constant Low) Index
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Constant Low
c' Index
w (Map (Constant Low) Index -> Map (Constant Low) Index)
-> (CPBuilder -> Map (Constant Low) Index)
-> CPBuilder
-> Map (Constant Low) Index
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CPBuilder -> Map (Constant Low) Index
cpbMapper (CPBuilder -> Map (Constant Low) Index)
-> CPBuilder -> Map (Constant Low) Index
forall a b. (a -> b) -> a -> b
$ CPBuilder
cpb
})