i0, i1, i8,
newMethod,
setStackSize, setMaxLocals,
+ withClassPath,
+ getClassField, getClassMethod,
generate
) where
import JVM.Common () -- import instances only
import JVM.ClassFile
import JVM.Assembler
+import Java.ClassPath
-- | Generator state
data GState = GState {
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
+ locals :: Word16, -- ^ Maximum number of local variables for current method
+ classPath :: [Tree CPEntry]
}
deriving (Eq,Show)
doneMethods = [],
currentMethod = Nothing,
stackSize = 496,
- locals = 0 }
+ locals = 0,
+ classPath = []}
-- | Generate monad
-type Generate a = State GState a
+type Generate a = StateT GState IO a
+
+-- | Update ClassPath
+withClassPath :: ClassPath () -> Generate ()
+withClassPath cp = do
+ res <- liftIO $ execClassPath cp
+ st <- St.get
+ St.put $ st {classPath = res}
-- | Append a constant to pool
appendPool :: Constant Direct -> Pool Direct -> (Pool Direct, Word16)
endMethod
return (NameType name sig)
+-- | Get a class from current ClassPath
+getClass :: String -> Generate (Class Direct)
+getClass name = do
+ cp <- St.gets classPath
+ res <- liftIO $ getEntry cp name
+ case res of
+ Just (NotLoaded p) -> fail $ "Class file was not loaded: " ++ p
+ Just (Loaded _ c) -> return c
+ Just (NotLoadedJAR p c) -> fail $ "Class was not loaded from JAR " ++ p ++ ": " ++ c
+ Just (LoadedJAR _ c) -> return c
+ Nothing -> fail $ "No such class in ClassPath: " ++ name
+
+-- | Get class field signature from current ClassPath
+getClassField :: String -> B.ByteString -> Generate (NameType Field)
+getClassField clsName fldName = do
+ cls <- getClass clsName
+ case lookupField fldName cls of
+ Just fld -> return (fieldNameType fld)
+ Nothing -> fail $ "No such field in class " ++ clsName ++ ": " ++ toString fldName
+
+-- | Get class method signature from current ClassPath
+getClassMethod :: String -> B.ByteString -> Generate (NameType Method)
+getClassMethod clsName mName = do
+ cls <- getClass clsName
+ case lookupMethod mName cls of
+ Just m -> return (methodNameType m)
+ Nothing -> fail $ "No such method in class " ++ clsName ++ ": " ++ toString mName
+
-- | Convert Generator state to method Code.
genCode :: GState -> Code
genCode st = Code {
addToPool (CString "Code")
-- | Generate a class
-generate :: B.ByteString -> Generate () -> Class Direct
-generate name gen =
+generate :: [Tree CPEntry] -> B.ByteString -> Generate () -> IO (Class Direct)
+generate cp name gen = do
let generator = do
initClass name
gen
- res = execState generator emptyGState
- code = genCode res
+ res <- execStateT generator (emptyGState {classPath = cp})
+ let code = genCode res
d = defaultClass :: Class Direct
- in d {
+ return $ d {
constsPoolSize = fromIntegral $ M.size (currentPool res),
constsPool = currentPool res,
accessFlags = S.fromList [ACC_PUBLIC, ACC_STATIC],