From c6d4e51116f1ca78ecbbbc4ce422fb33ce25ad19 Mon Sep 17 00:00:00 2001
From: "Ilya V. Portnov" <i.portnov@compassplus.ru>
Date: Tue, 4 Oct 2011 11:43:58 +0600
Subject: [PATCH] Support for loading field/method signatures in Generate
 monad.

---
 Hello.java           |  7 +++----
 JVM/Builder/Monad.hs | 27 +++++++++++++++++++++++++++
 JVM/ClassFile.hs     | 17 +++++++++++++++++
 TestGen.hs           |  7 +++++++
 4 files changed, 54 insertions(+), 4 deletions(-)

diff --git a/Hello.java b/Hello.java
index 33b7645..bf7d547 100644
--- a/Hello.java
+++ b/Hello.java
@@ -1,11 +1,10 @@
 public class Hello {
   public static void main(String[] args) {
-    hello(5);
+    hello();
   }
 
-  static void hello(int n) {
-    System.out.println("Здравствуй, мир!");
-    System.out.printf("Argument: %d", n);
+  static void hello() {
+    System.out.println("Hello Java world!");
   }
 }
 
diff --git a/JVM/Builder/Monad.hs b/JVM/Builder/Monad.hs
index f5b1d74..623a44e 100644
--- a/JVM/Builder/Monad.hs
+++ b/JVM/Builder/Monad.hs
@@ -9,6 +9,8 @@ module JVM.Builder.Monad
    i0, i1, i8,
    newMethod,
    setStackSize, setMaxLocals,
+   withClassPath,
+   getClassField, getClassMethod,
    generate
   ) where
 
@@ -200,6 +202,31 @@ newMethod flags name args ret gen = do
   endMethod
   return (NameType name sig)
 
+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
+
+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
+
+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 {
diff --git a/JVM/ClassFile.hs b/JVM/ClassFile.hs
index 623585a..02a7ada 100644
--- a/JVM/ClassFile.hs
+++ b/JVM/ClassFile.hs
@@ -24,6 +24,7 @@ module JVM.ClassFile
    HasSignature (..), HasAttributes (..),
    NameType (..),
    fieldNameType, methodNameType,
+   lookupField, lookupMethod,
    toString,
    className,
    apsize, arsize, arlist
@@ -511,6 +512,14 @@ deriving instance Eq (Field Direct)
 deriving instance Show (Field File)
 deriving instance Show (Field Direct)
 
+lookupField :: B.ByteString -> Class Direct -> Maybe (Field Direct)
+lookupField name cls = look (classFields cls)
+  where
+    look [] = Nothing
+    look (f:fs)
+      | fieldName f == name = Just f
+      | otherwise           = look fs
+
 fieldNameType :: Field Direct -> NameType Field
 fieldNameType f = NameType (fieldName f) (fieldSignature f)
 
@@ -546,6 +555,14 @@ deriving instance Show (Method Direct)
 methodNameType :: Method Direct -> NameType Method
 methodNameType m = NameType (methodName m) (methodSignature m)
 
+lookupMethod :: B.ByteString -> Class Direct -> Maybe (Method Direct)
+lookupMethod name cls = look (classMethods cls)
+  where
+    look [] = Nothing
+    look (f:fs)
+      | methodName f == name = Just f
+      | otherwise           = look fs
+
 instance Binary (Method File) where
   put (Method {..}) = do
     put methodAccessFlags
diff --git a/TestGen.hs b/TestGen.hs
index 900a422..0e5ff90 100644
--- a/TestGen.hs
+++ b/TestGen.hs
@@ -6,12 +6,18 @@ import JVM.ClassFile
 import JVM.Converter
 import JVM.Assembler
 import JVM.Builder
+import Java.ClassPath
 
 import qualified Java.Lang
 import qualified Java.IO
 
 test :: Generate ()
 test = do
+  withClassPath $ do
+      addDirectory "."
+
+  helloJava <- getClassMethod "./Hello" "hello"
+
   newMethod [ACC_PUBLIC] "<init>" [] ReturnsVoid $ do
       setStackSize 1
 
@@ -35,6 +41,7 @@ test = do
       invokeStatic Java.Lang.integer Java.Lang.valueOfInteger
       aastore
       invokeVirtual Java.IO.printStream Java.IO.printf
+      invokeStatic "Hello" helloJava
       pop
       i0 RETURN
 
-- 
2.25.1