JVM/Converter.hs

   1 {-# LANGUAGE TypeFamilies, StandaloneDeriving, FlexibleInstances, FlexibleContexts, UndecidableInstances, RecordWildCards, OverloadedStrings #-}
   2 -- | Functions to convert from low-level .class format representation and
   3 -- high-level Java classes, methods etc representation
   4 module JVM.Converter
   5   (decompile, decompileFile,
   6    convertClass,
   7    methodByName,
   8    attrByName,
   9    methodCode
  10   )
  11   where
  12
  13 import Data.List
  14 import Data.Word
  15 import Data.Bits
  16 import Data.Binary
  17 import Data.Char
  18 import Data.String
  19 import qualified Data.ByteString.Lazy as B
  20 import Data.Array
  21 import qualified Data.Set as S
  22 import qualified Data.Map as M
  23
  24 import Debug.Trace
  25
  26 import JVM.ClassFile
  27 import JVM.Types
  28
  29 -- | Parse .class file data
  30 decompile :: B.ByteString -> Class
  31 decompile bstr = convertClass $ decode bstr
  32
  33 -- | Parse class data from file
  34 decompileFile :: FilePath -> IO Class
  35 decompileFile path = convertClass `fmap` decodeFile path
  36
  37 convertClass :: ClassFile -> Class
  38 convertClass (ClassFile {..}) =
  39   let pool = constantPoolArray constsPool
  40       superName = className $ pool ! superClass
  41   in Class {
  42       constantPool = pool,
  43       classAccess = convertAccess accessFlags,
  44       this = className $ pool ! thisClass,
  45       super = if superClass == 0 then Nothing else Just superName,
  46       implements = map (\i -> className $ pool ! i) interfaces,
  47       fields = map (convertField pool) classFields,
  48       methods = map (convertMethod pool) classMethods,
  49       classAttrs = convertAttrs pool classAttributes }
  50
  51 constantPoolArray :: [CpInfo] -> Pool
  52 constantPoolArray list = pool
  53   where
  54     pool :: Pool
  55     pool = listArray (1,n) $ map convert list
  56     n = fromIntegral $ length list
  57
  58     convertNameType :: (HasSignature a, Binary (Signature a)) => Word16 -> NameType a
  59     convertNameType i =
  60       let (CNameType n s) = pool ! i
  61       in  NameType n (decode s)
  62
  63     convert (CONSTANT_Class i) = CClass $ getString $ pool ! i
  64     convert (CONSTANT_Fieldref i j) = CField (className $ pool ! i) (convertNameType j)
  65     convert (CONSTANT_Methodref i j) = CMethod (className $ pool ! i) (convertNameType j)
  66     convert (CONSTANT_InterfaceMethodref i j) = CIfaceMethod (className $ pool ! i) (convertNameType j)
  67     convert (CONSTANT_String i) = CString $ getString $ pool ! i
  68     convert (CONSTANT_Integer x) = CInteger x
  69     convert (CONSTANT_Float x)   = CFloat x
  70     convert (CONSTANT_Long x)    = CLong (fromIntegral x)
  71     convert (CONSTANT_Double x)  = CDouble x
  72     convert (CONSTANT_NameAndType i j) = CNameType (getString $ pool ! i) (getString $ pool ! j)
  73     convert (CONSTANT_Utf8 _ bs) = CUTF8 bs
  74     convert (CONSTANT_Unicode _ bs) = CUnicode bs
  75
  76 convertAccess :: Word16 -> Access
  77 convertAccess w = S.fromList $ concat $ zipWith (\i f -> if testBit w i then [f] else []) [0..] $ [
  78    ACC_PUBLIC,
  79    ACC_PRIVATE,
  80    ACC_PROTECTED,
  81    ACC_STATIC,
  82    ACC_FINAL,
  83    ACC_SYNCHRONIZED,
  84    ACC_VOLATILE,
  85    ACC_TRANSIENT,
  86    ACC_NATIVE,
  87    ACC_INTERFACE,
  88    ACC_ABSTRACT ]
  89
  90 convertField :: Pool -> FieldInfo -> Field
  91 convertField pool (FieldInfo {..}) = Field {
  92   fieldAccess = convertAccess fieldAccessFlags,
  93   fieldName = getString $ pool ! fieldNameIndex,
  94   fieldSignature = decode $ getString $ pool ! fieldSignatureIndex,
  95   fieldAttrs = convertAttrs pool fieldAttributes }
  96
  97 convertMethod :: Pool -> MethodInfo -> Method
  98 convertMethod pool (MethodInfo {..}) = Method {
  99   methodAccess = convertAccess methodAccessFlags,
 100   methodName = getString $ pool ! methodNameIndex,
 101   methodSignature = decode $ getString $ pool ! methodSignatureIndex,
 102   methodAttrs = convertAttrs pool methodAttributes }
 103
 104 convertAttrs :: Pool -> [AttributeInfo] -> Attributes
 105 convertAttrs pool attrs = M.fromList $ map go attrs
 106   where
 107     go (AttributeInfo {..}) = (getString $ pool ! attributeName,
 108                                attributeValue)
 109
 110 -- | Try to get class method by name
 111 methodByName :: Class -> B.ByteString -> Maybe Method
 112 methodByName cls name =
 113   find (\m -> methodName m == name) (methods cls)
 114
 115 -- | Try to get object attribute by name
 116 attrByName :: (HasAttributes a) => a -> B.ByteString -> Maybe B.ByteString
 117 attrByName x name = M.lookup name (attributes x)
 118
 119 -- | Try to get Code for class method (no Code for interface methods)
 120 methodCode :: Class
 121            -> B.ByteString       -- ^ Method name
 122            -> Maybe B.ByteString
 123 methodCode cls name = do
 124   method <- methodByName cls name
 125   attrByName method "Code"
 126