X-Git-Url: http://wien.tomnetworks.com/gitweb/?a=blobdiff_plain;f=JVM%2FConverter.hs;h=6380168a71ea7997105f6e897deee63dd735447f;hb=fe123653d0ba6155561a0c73726a505b360df194;hp=a498c96e5319ee1e79637d59946c0e27ccb99e2e;hpb=013b531f9c2dd2db7cf17f74f3c1c651d4c7af98;p=hs-java.git

diff --git a/JVM/Converter.hs b/JVM/Converter.hs
index a498c96..6380168 100644
--- a/JVM/Converter.hs
+++ b/JVM/Converter.hs
@@ -16,7 +16,9 @@ import Data.List
 import Data.Word
 import Data.Bits
 import Data.Binary
+import Data.Default () -- import instances only
 import qualified Data.ByteString.Lazy as B
+import qualified Data.ByteString.Lazy.Char8 ()
 import qualified Data.Set as S
 import qualified Data.Map as M
 
@@ -39,10 +41,8 @@ classFile2Direct :: Class File -> Class Direct
 classFile2Direct (Class {..}) =
   let pool = poolFile2Direct constsPool
       superName = className $ pool ! superClass
-  in Class {
-      magic = 0xCAFEBABE,
-      minorVersion = 0,
-      majorVersion = 50,
+      d = defaultClass :: Class Direct
+  in d {
       constsPoolSize = fromIntegral (M.size pool),
       constsPool = pool,
       accessFlags = accessFile2Direct accessFlags,
@@ -58,13 +58,12 @@ classFile2Direct (Class {..}) =
       classAttributes = attributesFile2Direct pool classAttributes }
 
 classDirect2File :: Class Direct -> Class File
-classDirect2File (Class {..}) = Class {
-    magic = 0xCAFEBABE,
-    minorVersion = 0,
-    majorVersion = 50,
+classDirect2File (Class {..}) =
+  let d = defaultClass :: Class File
+  in d {
     constsPoolSize = fromIntegral (M.size poolInfo + 1),
     constsPool = poolInfo,
-    accessFlags = access2word16 accessFlags,
+    accessFlags = accessDirect2File accessFlags,
     thisClass = force "this" $ poolClassIndex poolInfo thisClass,
     superClass = force "super" $ poolClassIndex poolInfo superClass,
     interfacesCount = fromIntegral (length interfaces),
@@ -105,9 +104,9 @@ poolDirect2File pool = result
 
 -- | Find index of given string in the list of constants
 poolIndex :: (Throws NoItemInPool e) => Pool File -> B.ByteString -> EM e Word16
-poolIndex list name = case findIndex test (M.elems list) of
+poolIndex list name = case mapFindIndex test list of
                         Nothing -> throw (NoItemInPool name)
-                        Just i ->  return $ fromIntegral $ i+1
+                        Just i ->  return $ fromIntegral i
   where
     test (CUTF8 s)    | s == name = True
     test (CUnicode s) | s == name = True
@@ -115,11 +114,11 @@ poolIndex list name = case findIndex test (M.elems list) of
 
 -- | Find index of given string in the list of constants
 poolClassIndex :: (Throws NoItemInPool e) => Pool File -> B.ByteString -> EM e Word16
-poolClassIndex list name = case findIndex checkString (M.elems list) of
+poolClassIndex list name = case mapFindIndex checkString list of
                         Nothing -> throw (NoItemInPool name)
-                        Just i ->  case findIndex (checkClass $ fromIntegral $ i+1) (M.elems list) of
-                                     Nothing -> throw (NoItemInPool $ i+1)
-                                     Just j  -> return $ fromIntegral $ j+1
+                        Just i ->  case mapFindIndex (checkClass $ fromIntegral i) list of
+                                     Nothing -> throw (NoItemInPool i)
+                                     Just j  -> return $ fromIntegral j
   where
     checkString (CUTF8 s)    | s == name = True
     checkString (CUnicode s) | s == name = True
@@ -131,9 +130,9 @@ poolClassIndex list name = case findIndex checkString (M.elems list) of
 poolNTIndex list x@(NameType n t) = do
     ni <- poolIndex list n
     ti <- poolIndex list (byteString t)
-    case findIndex (check ni ti) (M.elems list) of
+    case mapFindIndex (check ni ti) list of
       Nothing -> throw (NoItemInPool x)
-      Just i  -> return $ fromIntegral (i+1)
+      Just i  -> return $ fromIntegral i
   where
     check ni ti (CNameType n' t')
       | (ni == n') && (ti == t') = True
@@ -141,7 +140,7 @@ poolNTIndex list x@(NameType n t) = do
 
 fieldDirect2File :: Pool File -> Field Direct -> Field File
 fieldDirect2File pool (Field {..}) = Field {
-    fieldAccessFlags = access2word16 fieldAccessFlags,
+    fieldAccessFlags = accessDirect2File fieldAccessFlags,
     fieldName = force "field name" $ poolIndex pool fieldName,
     fieldSignature = force "signature" $ poolIndex pool (encode fieldSignature),
     fieldAttributesCount = fromIntegral (arsize fieldAttributes),
@@ -152,7 +151,7 @@ fieldDirect2File pool (Field {..}) = Field {
 
 methodDirect2File :: Pool File -> Method Direct -> Method File
 methodDirect2File pool (Method {..}) = Method {
-    methodAccessFlags = access2word16 methodAccessFlags,
+    methodAccessFlags = accessDirect2File methodAccessFlags,
     methodName = force "method name" $ poolIndex pool methodName,
     methodSignature = force "method sig" $ poolIndex pool (encode methodSignature),
     methodAttributesCount = fromIntegral (arsize methodAttributes),
@@ -177,10 +176,13 @@ poolFile2Direct ps = pool
 
     convertNameType :: (HasSignature a) => Word16 -> NameType a
     convertNameType i =
-      let (CNameType n s) = pool ! i
-      in  NameType n (decode s)
+      case pool ! i of
+        CNameType n s -> NameType n (decode s)
+        x -> error $ "Unexpected: " ++ show i
 
-    convert (CClass i) = CClass $ getString $ pool ! i
+    convert (CClass i) = case pool ! i of
+                          CUTF8 name -> CClass name
+                          x -> error $ "Unexpected class name: " ++ show x ++ " at " ++ show i
     convert (CField i j) = CField (className $ pool ! i) (convertNameType j)
     convert (CMethod i j) = CMethod (className $ pool ! i) (convertNameType j)
     convert (CIfaceMethod i j) = CIfaceMethod (className $ pool ! i) (convertNameType j)
@@ -207,8 +209,8 @@ accessFile2Direct w = S.fromList $ concat $ zipWith (\i f -> if testBit w i then
    ACC_INTERFACE,
    ACC_ABSTRACT ]
 
-access2word16 :: AccessFlags Direct -> AccessFlags File
-access2word16 fs = bitsOr $ map toBit $ S.toList fs
+accessDirect2File :: AccessFlags Direct -> AccessFlags File
+accessDirect2File fs = bitsOr $ map toBit $ S.toList fs
   where
     bitsOr = foldl (.|.) 0
     toBit f = 1 `shiftL` (fromIntegral $ fromEnum f)