X-Git-Url: http://wien.tomnetworks.com/gitweb/?a=blobdiff_plain;f=JVM%2FTypes.hs;h=6af75e704c9ec4fa5383a03fe86b9641ef21ce77;hb=7bccc38b8504325928429cced480f1714a7cf214;hp=5cdfb97608f9a0cb89549ca5f96d1d37fc3dc8a9;hpb=afbece7c7a823691d1e17743aec4d94a930864c8;p=hs-java.git

diff --git a/JVM/Types.hs b/JVM/Types.hs
index 5cdfb97..6af75e7 100644
--- a/JVM/Types.hs
+++ b/JVM/Types.hs
@@ -4,7 +4,6 @@ module JVM.Types where
 
 import Codec.Binary.UTF8.String hiding (encode, decode)
 import Control.Applicative
-import Data.Array
 import Data.Binary
 import Data.Binary.Put
 import qualified Data.ByteString.Lazy as B
@@ -18,148 +17,19 @@ import JVM.ClassFile
 instance IsString B.ByteString where
   fromString s = B.pack $ map (fromIntegral . ord) $ encodeString s
 
-toString :: B.ByteString -> String
-toString bstr = decodeString $ map (chr . fromIntegral) $ B.unpack bstr
-
 toCharList :: B.ByteString -> [Int]
 toCharList bstr = map fromIntegral $ B.unpack bstr
 
--- | Constant pool
-type Pool = Array Word16 Constant
+poolSize :: Pool stage -> Int
+poolSize = M.size
 
-asize :: (Ix i) => Array i e -> Int
-asize = length . elems
+(!) :: (Ord k) => M.Map k a -> k -> a
+(!) = (M.!)
 
 showListIx :: (Show a) => [a] -> String
 showListIx list = unlines $ zipWith s [1..] list
   where s i x = show i ++ ":\t" ++ show x
 
-class HasAttributes a where
-  attributes :: a -> Attributes
-
--- | Java class
-data Class = Class {
-  constantPool :: Pool,
-  classAccess :: Access,
-  this :: B.ByteString,        -- ^ this class name
-  super :: Maybe B.ByteString, -- ^ super class name
-  implements :: [B.ByteString], -- ^ implemented interfaces
-  fields :: [Field],
-  methods :: [Method],
-  classAttrs :: Attributes
-  }
-  deriving (Eq, Show)
-
-instance HasAttributes Class where
-  attributes = classAttrs
-
-class HasSignature a where
-  type Signature a
-
--- | Name and signature pair. Used for methods and fields.
-data NameType a = NameType {
-  ntName :: B.ByteString,
-  ntSignature :: Signature a }
-
-instance Show (Signature a) => Show (NameType a) where
-  show (NameType n t) = toString n ++ ": " ++ show t
-
-deriving instance Eq (Signature a) => Eq (NameType a)
-
--- | Constant pool item
-data Constant =
-    CClass B.ByteString
-  | CField {refClass :: B.ByteString, fieldNameType :: NameType Field}
-  | CMethod {refClass :: B.ByteString, nameType :: NameType Method}
-  | CIfaceMethod {refClass :: B.ByteString, nameType :: NameType Method}
-  | CString B.ByteString
-  | CInteger Word32
-  | CFloat Float
-  | CLong Integer
-  | CDouble Double
-  | CNameType B.ByteString B.ByteString
-  | CUTF8 {getString :: B.ByteString}
-  | CUnicode {getString :: B.ByteString}
-  deriving (Eq)
-
-className ::  Constant -> B.ByteString
-className (CClass s) = s
-className x = error $ "Not a class: " ++ show x
-
-instance Show Constant where
-  show (CClass name) = "class " ++ toString name
-  show (CField cls nt) = "field " ++ toString cls ++ "." ++ show nt
-  show (CMethod cls nt) = "method " ++ toString cls ++ "." ++ show nt
-  show (CIfaceMethod cls nt) = "interface method " ++ toString cls ++ "." ++ show nt
-  show (CString s) = "String \"" ++ toString s ++ "\""
-  show (CInteger x) = show x
-  show (CFloat x) = show x
-  show (CLong x) = show x
-  show (CDouble x) = show x
-  show (CNameType name tp) = toString name ++ ": " ++ toString tp
-  show (CUTF8 s) = "UTF8 \"" ++ toString s ++ "\""
-  show (CUnicode s) = "Unicode \"" ++ toString s ++ "\""
-
--- | Class field
-data Field = Field {
-  fieldAccess :: Access,
-  fieldName :: B.ByteString,
-  fieldSignature :: FieldSignature,
-  fieldAttrs :: Attributes }
-  deriving (Eq, Show)
-
-instance HasSignature Field where
-  type Signature Field = FieldSignature
-
-instance HasAttributes Field where
-  attributes = fieldAttrs
-
--- | Class method
-data Method = Method {
-  methodAccess :: Access,
-  methodName :: B.ByteString,
-  methodSignature :: MethodSignature,
-  methodAttrs :: Attributes }
-  deriving (Eq, Show)
-
-instance HasSignature Method where
-  type Signature Method = MethodSignature
-
-instance HasAttributes Method where
-  attributes = methodAttrs
-
--- | Set of access flags
-type Access = S.Set AccessFlag
-
--- | Access flags. Used for classess, methods, variables.
-data AccessFlag =
-    ACC_PUBLIC 	     -- ^ 0x0001 Visible for all
-  | ACC_PRIVATE 	   -- ^ 0x0002 Visible only for defined class
-  | ACC_PROTECTED 	 -- ^ 0x0004 Visible only for subclasses
-  | ACC_STATIC 	     -- ^ 0x0008 Static method or variable
-  | ACC_FINAL 	     -- ^ 0x0010 No further subclassing or assignments
-  | ACC_SYNCHRONIZED -- ^ 0x0020 Uses monitors
-  | ACC_VOLATILE 	   -- ^ 0x0040 Could not be cached
-  | ACC_TRANSIENT 	 -- ^ 0x0080 
-  | ACC_NATIVE 	     -- ^ 0x0100 Implemented in other language
-  | ACC_INTERFACE 	 -- ^ 0x0200 Class is interface
-  | ACC_ABSTRACT 	   -- ^ 0x0400 
-  deriving (Eq, Show, Ord, Enum)
-
--- | Generic attribute
-data Attribute = Attribute {
-  attrName :: B.ByteString,
-  attrValue :: B.ByteString }
-  deriving (Eq, Show)
-
--- | Set of attributes
-type Attributes = M.Map B.ByteString B.ByteString
-
-instance (Binary (Signature a)) => Binary (NameType a) where
-  put (NameType n t) = putLazyByteString n >> put t
-
-  get = NameType <$> get <*> get
-
 byteString ::  (Binary t) => t -> B.ByteString
 byteString x = runPut (put x)