JVM/Types.hs

   1 {-# LANGUAGE TypeFamilies, StandaloneDeriving, FlexibleInstances, FlexibleContexts, UndecidableInstances #-}
   2 -- | This module declares `high-level' data types for Java classes, methods etc.
   3 module JVM.Types where
   4
   5 import Codec.Binary.UTF8.String hiding (encode, decode)
   6 import Data.Array
   7 import qualified Data.ByteString.Lazy as B
   8 import Data.Word
   9 import Data.Char
  10 import Data.String
  11 import qualified Data.Set as S
  12 import qualified Data.Map as M
  13
  14 import JVM.ClassFile
  15
  16 instance IsString B.ByteString where
  17   fromString s = B.pack $ map (fromIntegral . ord) $ encodeString s
  18
  19 toString :: B.ByteString -> String
  20 toString bstr = decodeString $ map (chr . fromIntegral) $ B.unpack bstr
  21
  22 -- | Constant pool
  23 type Pool = Array Word16 Constant
  24
  25 class HasAttributes a where
  26   attributes :: a -> Attributes
  27
  28 -- | Java class
  29 data Class = Class {
  30   constantPool :: Pool,
  31   classAccess :: Access,
  32   this :: B.ByteString,        -- ^ this class name
  33   super :: Maybe B.ByteString, -- ^ super class name
  34   implements :: [B.ByteString], -- ^ implemented interfaces
  35   fields :: [Field],
  36   methods :: [Method],
  37   classAttrs :: Attributes
  38   }
  39   deriving (Eq, Show)
  40
  41 instance HasAttributes Class where
  42   attributes = classAttrs
  43
  44 class HasSignature a where
  45   type Signature a
  46
  47 -- | Name and signature pair. Used for methods and fields.
  48 data NameType a = NameType {
  49   ntName :: B.ByteString,
  50   ntSignature :: Signature a }
  51
  52 instance Show (Signature a) => Show (NameType a) where
  53   show (NameType n t) = toString n ++ ": " ++ show t
  54
  55 deriving instance Eq (Signature a) => Eq (NameType a)
  56
  57 -- | Constant pool item
  58 data Constant =
  59     CClass {className :: B.ByteString}
  60   | CField {refClass :: B.ByteString, fieldNameType :: NameType Field}
  61   | CMethod {refClass :: B.ByteString, nameType :: NameType Method}
  62   | CIfaceMethod {refClass :: B.ByteString, nameType :: NameType Method}
  63   | CString B.ByteString
  64   | CInteger Word32
  65   | CFloat Float
  66   | CLong Integer
  67   | CDouble Double
  68   | CNameType B.ByteString B.ByteString
  69   | CUTF8 {getString :: B.ByteString}
  70   | CUnicode {getString :: B.ByteString}
  71   deriving (Eq)
  72
  73 instance Show Constant where
  74   show (CClass name) = "class " ++ toString name
  75   show (CField cls nt) = "field " ++ toString cls ++ "." ++ show nt
  76   show (CMethod cls nt) = "method " ++ toString cls ++ "." ++ show nt
  77   show (CIfaceMethod cls nt) = "interface method " ++ toString cls ++ "." ++ show nt
  78   show (CString s) = "String \"" ++ toString s ++ "\""
  79   show (CInteger x) = show x
  80   show (CFloat x) = show x
  81   show (CLong x) = show x
  82   show (CDouble x) = show x
  83   show (CNameType name tp) = toString name ++ ": " ++ toString tp
  84   show (CUTF8 s) = "UTF8 \"" ++ toString s ++ "\""
  85   show (CUnicode s) = "Unicode \"" ++ toString s ++ "\""
  86
  87 -- | Class field
  88 data Field = Field {
  89   fieldAccess :: Access,
  90   fieldName :: B.ByteString,
  91   fieldSignature :: FieldSignature,
  92   fieldAttrs :: Attributes }
  93   deriving (Eq, Show)
  94
  95 instance HasSignature Field where
  96   type Signature Field = FieldSignature
  97
  98 instance HasAttributes Field where
  99   attributes = fieldAttrs
 100
 101 -- | Class method
 102 data Method = Method {
 103   methodAccess :: Access,
 104   methodName :: B.ByteString,
 105   methodSignature :: MethodSignature,
 106   methodAttrs :: Attributes }
 107   deriving (Eq, Show)
 108
 109 instance HasSignature Method where
 110   type Signature Method = MethodSignature
 111
 112 instance HasAttributes Method where
 113   attributes = methodAttrs
 114
 115 -- | Set of access flags
 116 type Access = S.Set AccessFlag
 117
 118 -- | Access flags. Used for classess, methods, variables.
 119 data AccessFlag =
 120     ACC_PUBLIC       -- 0x0001 Visible for all
 121   | ACC_PRIVATE            -- 0x0002 Visible only for defined class
 122   | ACC_PROTECTED        -- 0x0004 Visible only for subclasses
 123   | ACC_STATIC       -- 0x0008 Static method or variable
 124   | ACC_FINAL        -- 0x0010 No further subclassing or assignments
 125   | ACC_SYNCHRONIZED -- 0x0020 Uses monitors
 126   | ACC_VOLATILE           -- 0x0040 Could not be cached
 127   | ACC_TRANSIENT        -- 0x0080
 128   | ACC_NATIVE       -- 0x0100 Implemented in other language
 129   | ACC_INTERFACE        -- 0x0200 Class is interface
 130   | ACC_ABSTRACT           -- 0x0400
 131   deriving (Eq, Show, Ord)
 132
 133 -- | Generic attribute
 134 data Attribute = Attribute {
 135   attrName :: B.ByteString,
 136   attrValue :: B.ByteString }
 137   deriving (Eq, Show)
 138
 139 -- | Set of attributes
 140 type Attributes = M.Map B.ByteString B.ByteString
 141