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
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),
-- | 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
-- | 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
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
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),
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),
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)
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)