+ d = defaultClass :: Class Direct
+ in d {
+ constsPoolSize = fromIntegral (M.size pool),
+ constsPool = pool,
+ accessFlags = accessFile2Direct accessFlags,
+ thisClass = className $ pool ! thisClass,
+ superClass = if superClass == 0 then "" else superName,
+ interfacesCount = interfacesCount,
+ interfaces = map (\i -> className $ pool ! i) interfaces,
+ classFieldsCount = classFieldsCount,
+ classFields = map (fieldFile2Direct pool) classFields,
+ classMethodsCount = classMethodsCount,
+ classMethods = map (methodFile2Direct pool) classMethods,
+ classAttributesCount = classAttributesCount,
+ classAttributes = attributesFile2Direct pool classAttributes }
+
+classDirect2File :: Class Direct -> Class File
+classDirect2File (Class {..}) =
+ let d = defaultClass :: Class File
+ in d {
+ constsPoolSize = fromIntegral (M.size poolInfo + 1),
+ constsPool = poolInfo,
+ accessFlags = accessDirect2File accessFlags,
+ thisClass = force "this" $ poolClassIndex poolInfo thisClass,
+ superClass = force "super" $ poolClassIndex poolInfo superClass,
+ interfacesCount = fromIntegral (length interfaces),
+ interfaces = map (force "ifaces" . poolIndex poolInfo) interfaces,
+ classFieldsCount = fromIntegral (length classFields),
+ classFields = map (fieldDirect2File poolInfo) classFields,
+ classMethodsCount = fromIntegral (length classMethods),
+ classMethods = map (methodDirect2File poolInfo) classMethods,
+ classAttributesCount = fromIntegral $ arsize classAttributes,
+ classAttributes = to (arlist classAttributes) }
+ where
+ poolInfo = poolDirect2File constsPool
+ to :: [(B.ByteString, B.ByteString)] -> Attributes File
+ to pairs = AP (map (attrInfo poolInfo) pairs)
+
+poolDirect2File :: Pool Direct -> Pool File
+poolDirect2File pool = result
+ where
+ result = M.map cpInfo pool
+
+ cpInfo :: Constant Direct -> Constant File
+ cpInfo (CClass name) = CClass (force "class" $ poolIndex result name)
+ cpInfo (CField cls name) =
+ CField (force "field a" $ poolClassIndex result cls) (force "field b" $ poolNTIndex result name)
+ cpInfo (CMethod cls name) =
+ CMethod (force "method a" $ poolClassIndex result cls) (force ("method b: " ++ show name) $ poolNTIndex result name)
+ cpInfo (CIfaceMethod cls name) =
+ CIfaceMethod (force "iface method a" $ poolIndex result cls) (force "iface method b" $ poolNTIndex result name)
+ cpInfo (CString s) = CString (force "string" $ poolIndex result s)
+ cpInfo (CInteger x) = CInteger x
+ cpInfo (CFloat x) = CFloat x
+ cpInfo (CLong x) = CLong (fromIntegral x)
+ cpInfo (CDouble x) = CDouble x
+ cpInfo (CNameType n t) =
+ CNameType (force "name" $ poolIndex result n) (force "type" $ poolIndex result t)
+ cpInfo (CUTF8 s) = CUTF8 s
+ cpInfo (CUnicode s) = CUnicode s
+
+-- | 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
+ Nothing -> throw (NoItemInPool name)
+ Just i -> return $ fromIntegral $ i+1
+ where
+ test (CUTF8 s) | s == name = True
+ test (CUnicode s) | s == name = True
+ test _ = False
+
+-- | 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
+ 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
+ where
+ checkString (CUTF8 s) | s == name = True
+ checkString (CUnicode s) | s == name = True
+ checkString _ = False
+
+ checkClass i (CClass x) | i == x = True
+ checkClass _ _ = False
+
+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
+ Nothing -> throw (NoItemInPool x)
+ Just i -> return $ fromIntegral (i+1)