Support for loading field/method signatures in Generate monad.

[hs-java.git] / JVM / ClassFile.hs

diff --git a/JVM/ClassFile.hs b/JVM/ClassFile.hs
index d2f30297e955b720cef6382d4e38ba6f08e802f9..02a7adaf60aec86bb253ef42cd872d020c96f4b6 100644 (file)
--- a/JVM/ClassFile.hs
+++ b/JVM/ClassFile.hs
@@ -23,6 +23,9 @@ module JVM.ClassFile
    -- * Misc
    HasSignature (..), HasAttributes (..),
    NameType (..),
+   fieldNameType, methodNameType,
+   lookupField, lookupMethod,
+   toString,
    className,
    apsize, arsize, arlist
   )
@@ -164,9 +167,9 @@ instance HasSignature a => Binary (NameType a) where
 -- | Constant pool item
 data Constant stage =
     CClass (Link stage B.ByteString)
-  | CField {refClass :: Link stage B.ByteString, fieldNameType :: Link stage (NameType Field)}
-  | CMethod {refClass :: Link stage B.ByteString, nameType :: Link stage (NameType Method)}
-  | CIfaceMethod {refClass :: Link stage B.ByteString, nameType :: Link stage (NameType Method)}
+  | CField (Link stage B.ByteString) (Link stage (NameType Field))
+  | CMethod (Link stage B.ByteString) (Link stage (NameType Method))
+  | CIfaceMethod (Link stage B.ByteString) (Link stage (NameType Method))
   | CString (Link stage B.ByteString)
   | CInteger Word32
   | CFloat Float
@@ -218,10 +221,16 @@ data Class stage = Class {
   classAttributes :: Attributes stage -- ^ Class attributes
   }
 
+deriving instance Eq (Class File)
+deriving instance Eq (Class Direct)
+deriving instance Show (Class File)
+deriving instance Show (Class Direct)
+
 deriving instance Eq (Constant File)
 deriving instance Eq (Constant Direct)
 deriving instance Show (Constant File)
 
+-- | Default (empty) class file definition.
 defaultClass :: (Default (AccessFlags stage), Default (Link stage B.ByteString), Default (Attributes stage))
              => Class stage
 defaultClass = Class {
@@ -503,6 +512,17 @@ 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)
+
 instance Binary (Field File) where
   put (Field {..}) = do
     put fieldAccessFlags 
@@ -532,6 +552,17 @@ deriving instance Eq (Method Direct)
 deriving instance Show (Method File)
 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