1 {-# LANGUAGE TypeFamilies, StandaloneDeriving, FlexibleInstances, FlexibleContexts, UndecidableInstances, RecordWildCards, OverloadedStrings #-}
2 module JVM.Converter where
10 import qualified Data.ByteString.Lazy as B
12 import qualified Data.Set as S
13 import qualified Data.Map as M
20 decompile :: B.ByteString -> Class
21 decompile bstr = convertClass $ decode bstr
23 decompileFile :: FilePath -> IO Class
24 decompileFile path = convertClass `fmap` decodeFile path
26 convertClass :: ClassFile -> Class
27 convertClass (ClassFile {..}) =
28 let pool = constantPoolArray constsPool
29 superName = className $ pool ! superClass
32 classAccess = convertAccess accessFlags,
33 this = className $ pool ! thisClass,
34 super = if superClass == 0 then Nothing else Just superName,
35 implements = map (\i -> className $ pool ! i) interfaces,
36 fields = map (convertField pool) classFields,
37 methods = map (convertMethod pool) classMethods,
38 classAttrs = convertAttrs pool classAttributes }
40 constantPoolArray :: [CpInfo] -> Pool
41 constantPoolArray list = pool
44 pool = listArray (1,n) $ map convert list
45 n = fromIntegral $ length list
47 convertNameType :: (HasSignature a, Binary (Signature a)) => Word16 -> NameType a
49 let (CNameType n s) = pool ! i
50 in NameType n (decode s)
52 convert (CONSTANT_Class i) = CClass $ getString $ pool ! i
53 convert (CONSTANT_Fieldref i j) = CField (className $ pool ! i) (convertNameType j)
54 convert (CONSTANT_Methodref i j) = CMethod (className $ pool ! i) (convertNameType j)
55 convert (CONSTANT_InterfaceMethodref i j) = CIfaceMethod (className $ pool ! i) (convertNameType j)
56 convert (CONSTANT_String i) = CString $ getString $ pool ! i
57 convert (CONSTANT_Integer x) = CInteger x
58 convert (CONSTANT_Float x) = CFloat x
59 convert (CONSTANT_Long x) = CLong (fromIntegral x)
60 convert (CONSTANT_Double x) = CDouble x
61 convert (CONSTANT_NameAndType i j) = CNameType (getString $ pool ! i) (getString $ pool ! j)
62 convert (CONSTANT_Utf8 _ bs) = CUTF8 bs
63 convert (CONSTANT_Unicode _ bs) = CUnicode bs
65 className' x = trace ("Class name: " ++ show x) B.empty
67 convertAccess :: Word16 -> Access
68 convertAccess w = S.fromList $ concat $ zipWith (\i f -> if testBit w i then [f] else []) [0..] $ [
81 convertField :: Pool -> FieldInfo -> Field
82 convertField pool (FieldInfo {..}) = Field {
83 fieldAccess = convertAccess fieldAccessFlags,
84 fieldName = getString $ pool ! fieldNameIndex,
85 fieldSignature = decode $ getString $ pool ! fieldSignatureIndex,
86 fieldAttrs = convertAttrs pool fieldAttributes }
88 convertMethod :: Pool -> MethodInfo -> Method
89 convertMethod pool (MethodInfo {..}) = Method {
90 methodAccess = convertAccess methodAccessFlags,
91 methodName = getString $ pool ! methodNameIndex,
92 methodSignature = decode $ getString $ pool ! methodSignatureIndex,
93 methodAttrs = convertAttrs pool methodAttributes }
95 convertAttrs :: Pool -> [AttributeInfo] -> Attributes
96 convertAttrs pool attrs = M.fromList $ map go attrs
98 go (AttributeInfo {..}) = (getString $ pool ! attributeName,
101 methodByName :: Class -> B.ByteString -> Maybe Method
102 methodByName cls name =
103 find (\m -> methodName m == name) (methods cls)
105 attrByName :: (HasAttributes a) => a -> B.ByteString -> Maybe B.ByteString
106 attrByName x name = M.lookup name (attributes x)
108 methodCode :: Class -> B.ByteString -> Maybe B.ByteString
109 methodCode cls name = do
110 method <- methodByName cls name
111 attrByName method "Code"