{-# LANGUAGE FlexibleContexts, TypeFamilies, OverloadedStrings #-}
-module JVM.Builder.Monad where
+-- | This module defines Generate monad, which helps generating JVM code and
+-- creating Java class constants pool.
+module JVM.Builder.Monad
+ (GState (..),
+ emptyGState,
+ Generate,
+ addToPool,
+ i0, i1, i8,
+ newMethod,
+ setStackSize, setMaxLocals,
+ generate
+ ) where
import Control.Monad.State as St
import Data.Word
import JVM.ClassFile
import JVM.Assembler
+-- | Generator state
data GState = GState {
- generated :: [Instruction],
- currentPool :: Pool Resolved,
- doneMethods :: [Method Resolved],
- currentMethod :: Maybe (Method Resolved),
- stackSize :: Word16,
- locals :: Word16 }
+ generated :: [Instruction], -- ^ Already generated code (in current method)
+ currentPool :: Pool Resolved, -- ^ Already generated constants pool
+ doneMethods :: [Method Resolved], -- ^ Already generated class methods
+ currentMethod :: Maybe (Method Resolved), -- ^ Current method
+ stackSize :: Word16, -- ^ Maximum stack size for current method
+ locals :: Word16 -- ^ Maximum number of local variables for current method
+ }
deriving (Eq,Show)
+-- | Empty generator state
+emptyGState :: GState
emptyGState = GState {
generated = [],
currentPool = M.empty,
stackSize = 496,
locals = 0 }
+-- | Generate monad
type Generate a = State GState a
+-- | Append a constant to pool
appendPool :: Constant Resolved -> Pool Resolved -> (Pool Resolved, Word16)
appendPool c pool =
let size = fromIntegral (M.size pool)
pool' = M.insert size c pool
in (pool', size)
+-- | Add a constant to pool
addItem :: Constant Resolved -> Generate Word16
addItem c = do
pool <- St.gets currentPool
St.put $ st {currentPool = pool'}
return (i+1)
+-- | Lookup in a pool
lookupPool :: Constant Resolved -> Pool Resolved -> Maybe Word16
lookupPool c pool =
fromIntegral `fmap` findIndex (== c) (M.elems pool)
let bsig = encode c
addItem (CUTF8 bsig)
+-- | Add a constant into pool
addToPool :: Constant Resolved -> Generate Word16
addToPool c@(CClass str) = do
addItem (CUTF8 str)
let code = generated st
St.put $ st {generated = code ++ [instr]}
+-- | Generate one (zero-arguments) instruction
i0 :: Instruction -> Generate ()
i0 = putInstruction
+-- | Generate one one-argument instruction
i1 :: (Word16 -> Instruction) -> Constant Resolved -> Generate ()
i1 fn c = do
ix <- addToPool c
i0 (fn ix)
+-- | Generate one one-argument instruction
i8 :: (Word8 -> Instruction) -> Constant Resolved -> Generate ()
i8 fn c = do
ix <- addToPool c
i0 (fn $ fromIntegral ix)
+-- | Set maximum stack size for current method
setStackSize :: Word16 -> Generate ()
setStackSize n = do
st <- St.get
St.put $ st {stackSize = n}
+-- | Set maximum number of local variables for current method
setMaxLocals :: Word16 -> Generate ()
setMaxLocals n = do
st <- St.get
St.put $ st {locals = n}
+-- | Start generating new method
startMethod :: [AccessFlag] -> B.ByteString -> MethodSignature -> Generate ()
startMethod flags name sig = do
addToPool (CString name)
St.put $ st {generated = [],
currentMethod = Just method }
+-- | End of method generation
endMethod :: Generate ()
endMethod = do
m <- St.gets currentMethod
currentMethod = Nothing,
doneMethods = doneMethods st ++ [method']}
-newMethod :: [AccessFlag] -> B.ByteString -> [ArgumentSignature] -> ReturnSignature -> Generate () -> Generate (NameType Method)
+-- | Generate new method
+newMethod :: [AccessFlag] -- ^ Access flags for method (public, static etc)
+ -> B.ByteString -- ^ Method name
+ -> [ArgumentSignature] -- ^ Signatures of method arguments
+ -> ReturnSignature -- ^ Method return signature
+ -> Generate () -- ^ Generator for method code
+ -> Generate (NameType Method)
newMethod flags name args ret gen = do
let sig = MethodSignature args ret
startMethod flags name sig
endMethod
return (NameType name sig)
+-- | Convert Generator state to method Code.
genCode :: GState -> Code
genCode st = Code {
codeStackSize = stackSize st,
where
len = fromIntegral $ B.length $ encodeInstructions (generated st)
+-- | Start class generation.
initClass :: B.ByteString -> Generate Word16
initClass name = do
addToPool (CClass "java/lang/Object")
addToPool (CClass name)
addToPool (CString "Code")
+-- | Generate a class
generate :: B.ByteString -> Generate () -> Class Resolved
generate name gen =
let generator = do