JVM/Types.hs

   1 {-# LANGUAGE TypeFamilies, StandaloneDeriving, FlexibleInstances, FlexibleContexts, UndecidableInstances #-}
   2 module JVM.Types where
   3
   4 import Codec.Binary.UTF8.String hiding (encode, decode)
   5 import Data.Array
   6 import qualified Data.ByteString.Lazy as B
   7 import Data.Word
   8 import Data.Char
   9 import Data.String
  10 import qualified Data.Set as S
  11 import qualified Data.Map as M
  12
  13 import JVM.ClassFile
  14
  15 instance IsString B.ByteString where
  16   fromString s = B.pack $ map (fromIntegral . ord) $ encodeString s
  17
  18 toString :: B.ByteString -> String
  19 toString bstr = decodeString $ map (chr . fromIntegral) $ B.unpack bstr
  20
  21 type Pool = Array Word16 Constant
  22
  23 class HasAttributes a where
  24   attributes :: a -> Attributes
  25
  26 data Class = Class {
  27   constantPool :: Pool,
  28   classAccess :: Access,
  29   this :: B.ByteString,        -- ^ this class name
  30   super :: Maybe B.ByteString, -- ^ super class name
  31   implements :: [B.ByteString], -- ^ implemented interfaces
  32   fields :: [Field],
  33   methods :: [Method],
  34   classAttrs :: Attributes
  35   }
  36   deriving (Eq, Show)
  37
  38 instance HasAttributes Class where
  39   attributes = classAttrs
  40
  41 class HasSignature a where
  42   type Signature a
  43
  44 data NameType a = NameType {
  45   ntName :: B.ByteString,
  46   ntSignature :: Signature a }
  47
  48 instance Show (Signature a) => Show (NameType a) where
  49   show (NameType n t) = toString n ++ ": " ++ show t
  50
  51 deriving instance Eq (Signature a) => Eq (NameType a)
  52
  53 data Constant =
  54     CClass {className :: B.ByteString}
  55   | CField {refClass :: B.ByteString, fieldNameType :: NameType Field}
  56   | CMethod {refClass :: B.ByteString, nameType :: NameType Method}
  57   | CIfaceMethod {refClass :: B.ByteString, nameType :: NameType Method}
  58   | CString B.ByteString
  59   | CInteger Word32
  60   | CFloat Float
  61   | CLong Integer
  62   | CDouble Double
  63   | CNameType B.ByteString B.ByteString
  64   | CUTF8 {getString :: B.ByteString}
  65   | CUnicode {getString :: B.ByteString}
  66   deriving (Eq)
  67
  68 instance Show Constant where
  69   show (CClass name) = "class " ++ toString name
  70   show (CField cls nt) = "field " ++ toString cls ++ "." ++ show nt
  71   show (CMethod cls nt) = "method " ++ toString cls ++ "." ++ show nt
  72   show (CIfaceMethod cls nt) = "interface method " ++ toString cls ++ "." ++ show nt
  73   show (CString s) = "String \"" ++ toString s ++ "\""
  74   show (CInteger x) = show x
  75   show (CFloat x) = show x
  76   show (CLong x) = show x
  77   show (CDouble x) = show x
  78   show (CNameType name tp) = toString name ++ ": " ++ toString tp
  79   show (CUTF8 s) = "UTF8 \"" ++ toString s ++ "\""
  80   show (CUnicode s) = "Unicode \"" ++ toString s ++ "\""
  81
  82 data Field = Field {
  83   fieldAccess :: Access,
  84   fieldName :: B.ByteString,
  85   fieldSignature :: FieldSignature,
  86   fieldAttrs :: Attributes }
  87   deriving (Eq, Show)
  88
  89 instance HasSignature Field where
  90   type Signature Field = FieldSignature
  91
  92 instance HasAttributes Field where
  93   attributes = fieldAttrs
  94
  95 data Method = Method {
  96   methodAccess :: Access,
  97   methodName :: B.ByteString,
  98   methodSignature :: MethodSignature,
  99   methodAttrs :: Attributes }
 100   deriving (Eq, Show)
 101
 102 instance HasSignature Method where
 103   type Signature Method = MethodSignature
 104
 105 instance HasAttributes Method where
 106   attributes = methodAttrs
 107
 108 type Access = S.Set AccessFlag
 109
 110 data AccessFlag =
 111     ACC_PUBLIC       -- 0x0001 Видимый для всех   Класс, Метод, Переменная
 112   | ACC_PRIVATE            -- 0x0002 Видимый только для определяемого класса         Метод, Переменная
 113   | ACC_PROTECTED        -- 0x0004 Видимый для подклассов   Метод, Переменная
 114   | ACC_STATIC       -- 0x0008 Переменная или метод статические    Метод, Переменная
 115   | ACC_FINAL        -- 0x0010 Нет дальнейшей подкласификации, обхода или присваивания после инициализации   Класс, Метод, Переменная
 116   | ACC_SYNCHRONIZED -- 0x0020 Использует возврат в блокировке монитора     Метод
 117   | ACC_VOLATILE           -- 0x0040 Не может помещать в кеш         Переменная
 118   | ACC_TRANSIENT        -- 0x0080 Не может боть написан или прочитан постоянным объектом управления   Перемення
 119   | ACC_NATIVE       -- 0x0100 Реализован в других языках        Метод
 120   | ACC_INTERFACE        -- 0x0200 интерфейс   Класс
 121   | ACC_ABSTRACT           -- 0x0400 Ничего не предусматривает   Класс, Метод
 122   deriving (Eq, Show, Ord)
 123
 124 data Attribute = Attribute {
 125   attrName :: B.ByteString,
 126   attrValue :: B.ByteString }
 127   deriving (Eq, Show)
 128
 129 class AttributeValue a where
 130   decodeAttribute :: B.ByteString -> a
 131   encodeAttribute :: a -> B.ByteString
 132
 133 type Attributes = M.Map B.ByteString B.ByteString
 134