X-Git-Url: http://wien.tomnetworks.com/gitweb/?a=blobdiff_plain;f=JVM%2FBuilder%2FMonad.hs;h=01e93f16c675b756c092765c0d563f74f2c9d1c7;hb=df6a40854e753a550abf25ce28fd5996651fd9db;hp=85916e29c85de454b93a55690415c8af33d50ac5;hpb=69b71af830218d6e1e20fae3cc42fdbaca1816ee;p=hs-java.git

diff --git a/JVM/Builder/Monad.hs b/JVM/Builder/Monad.hs
index 85916e2..01e93f1 100644
--- a/JVM/Builder/Monad.hs
+++ b/JVM/Builder/Monad.hs
@@ -1,5 +1,16 @@
 {-# 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
@@ -13,28 +24,39 @@ import JVM.Common ()  -- import instances only
 import JVM.ClassFile
 import JVM.Assembler
 
+-- | Generator state
 data GState = GState {
-  generated :: [Instruction],
-  currentPool :: Pool Resolved,
-  doneMethods :: [Method Resolved],
-  currentMethod :: Maybe (Method Resolved)}
+  generated :: [Instruction],               -- ^ Already generated code (in current method)
+  currentPool :: Pool Direct,             -- ^ Already generated constants pool
+  doneMethods :: [Method Direct],         -- ^ Already generated class methods
+  currentMethod :: Maybe (Method Direct), -- ^ 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,
   doneMethods = [],
-  currentMethod = Nothing }
+  currentMethod = Nothing,
+  stackSize = 496,
+  locals = 0 }
 
+-- | Generate monad
 type Generate a = State GState a
 
-appendPool :: Constant Resolved -> Pool Resolved -> (Pool Resolved, Word16)
+-- | Append a constant to pool
+appendPool :: Constant Direct -> Pool Direct -> (Pool Direct, Word16)
 appendPool c pool =
   let size = fromIntegral (M.size pool)
       pool' = M.insert size c pool
   in  (pool', size)
 
-addItem :: Constant Resolved -> Generate Word16
+-- | Add a constant to pool
+addItem :: Constant Direct -> Generate Word16
 addItem c = do
   pool <- St.gets currentPool
   case lookupPool c pool of
@@ -45,11 +67,12 @@ addItem c = do
       St.put $ st {currentPool = pool'}
       return (i+1)
 
-lookupPool :: Constant Resolved -> Pool Resolved -> Maybe Word16
+-- | Lookup in a pool
+lookupPool :: Constant Direct -> Pool Direct -> Maybe Word16
 lookupPool c pool =
   fromIntegral `fmap` findIndex (== c) (M.elems pool)
 
-addNT :: Binary (Signature a) => NameType a -> Generate Word16
+addNT :: HasSignature a => NameType a -> Generate Word16
 addNT (NameType name sig) = do
   let bsig = encode sig
   x <- addItem (CNameType name bsig)
@@ -62,7 +85,8 @@ addSig c@(MethodSignature args ret) = do
   let bsig = encode c
   addItem (CUTF8 bsig)
 
-addToPool :: Constant Resolved -> Generate Word16
+-- | Add a constant into pool
+addToPool :: Constant Direct -> Generate Word16
 addToPool c@(CClass str) = do
   addItem (CUTF8 str)
   addItem c
@@ -93,23 +117,41 @@ putInstruction instr = do
   let code = generated st
   St.put $ st {generated = code ++ [instr]}
 
+-- | Generate one (zero-arguments) instruction
 i0 :: Instruction -> Generate ()
 i0 = putInstruction
 
-i1 :: (Word16 -> Instruction) -> Constant Resolved -> Generate ()
+-- | Generate one one-argument instruction
+i1 :: (Word16 -> Instruction) -> Constant Direct -> Generate ()
 i1 fn c = do
   ix <- addToPool c
   i0 (fn ix)
 
-i8 :: (Word8 -> Instruction) -> Constant Resolved -> Generate ()
+-- | Generate one one-argument instruction
+i8 :: (Word8 -> Instruction) -> Constant Direct -> 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)
   addSig sig
+  setStackSize 4096
+  setMaxLocals 100
   st <- St.get
   let method = Method {
     methodAccessFlags = S.fromList flags,
@@ -120,6 +162,7 @@ startMethod flags name sig = do
   St.put $ st {generated = [],
                currentMethod = Just method }
 
+-- | End of method generation
 endMethod :: Generate ()
 endMethod = do
   m <- St.gets currentMethod
@@ -134,7 +177,13 @@ endMethod = do
                    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
@@ -142,10 +191,11 @@ newMethod flags name args ret gen = do
   endMethod
   return (NameType name sig)
 
+-- | Convert Generator state to method Code.
 genCode :: GState -> Code
 genCode st = Code {
-    codeStackSize = 4096,
-    codeMaxLocals = 100,
+    codeStackSize = stackSize st,
+    codeMaxLocals = locals st,
     codeLength = len,
     codeInstructions = generated st,
     codeExceptionsN = 0,
@@ -155,13 +205,15 @@ genCode st = Code {
   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 :: B.ByteString -> Generate () -> Class Resolved
+-- | Generate a class
+generate :: B.ByteString -> Generate () -> Class Direct
 generate name gen =
   let generator = do
         initClass name