projects
/
hs-java.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
clean up unused imports.
[hs-java.git]
/
JVM
/
Types.hs
diff --git
a/JVM/Types.hs
b/JVM/Types.hs
index 18f57ea98594016c6d33321c1c63a1ea39b675bd..e685e7933a56dc0539709c0d429dbf636d957984 100644
(file)
--- a/
JVM/Types.hs
+++ b/
JVM/Types.hs
@@
-3,9
+3,11
@@
module JVM.Types where
import Codec.Binary.UTF8.String hiding (encode, decode)
module JVM.Types where
import Codec.Binary.UTF8.String hiding (encode, decode)
+import Control.Applicative
import Data.Array
import Data.Array
+import Data.Binary
+import Data.Binary.Put
import qualified Data.ByteString.Lazy as B
import qualified Data.ByteString.Lazy as B
-import Data.Word
import Data.Char
import Data.String
import qualified Data.Set as S
import Data.Char
import Data.String
import qualified Data.Set as S
@@
-22,6
+24,13
@@
toString bstr = decodeString $ map (chr . fromIntegral) $ B.unpack bstr
-- | Constant pool
type Pool = Array Word16 Constant
-- | Constant pool
type Pool = Array Word16 Constant
+asize :: (Ix i) => Array i e -> Int
+asize = length . elems
+
+showListIx :: (Show a) => [a] -> String
+showListIx list = unlines $ zipWith s [1..] list
+ where s i x = show i ++ ":\t" ++ show x
+
class HasAttributes a where
attributes :: a -> Attributes
class HasAttributes a where
attributes :: a -> Attributes
@@
-56,7
+65,7
@@
deriving instance Eq (Signature a) => Eq (NameType a)
-- | Constant pool item
data Constant =
-- | Constant pool item
data Constant =
- CClass
{className :: B.ByteString}
+ CClass
B.ByteString
| CField {refClass :: B.ByteString, fieldNameType :: NameType Field}
| CMethod {refClass :: B.ByteString, nameType :: NameType Method}
| CIfaceMethod {refClass :: B.ByteString, nameType :: NameType Method}
| CField {refClass :: B.ByteString, fieldNameType :: NameType Field}
| CMethod {refClass :: B.ByteString, nameType :: NameType Method}
| CIfaceMethod {refClass :: B.ByteString, nameType :: NameType Method}
@@
-70,6
+79,10
@@
data Constant =
| CUnicode {getString :: B.ByteString}
deriving (Eq)
| CUnicode {getString :: B.ByteString}
deriving (Eq)
+className :: Constant -> B.ByteString
+className (CClass s) = s
+className x = error $ "Not a class: " ++ show x
+
instance Show Constant where
show (CClass name) = "class " ++ toString name
show (CField cls nt) = "field " ++ toString cls ++ "." ++ show nt
instance Show Constant where
show (CClass name) = "class " ++ toString name
show (CField cls nt) = "field " ++ toString cls ++ "." ++ show nt
@@
-128,7
+141,7
@@
data AccessFlag =
| ACC_NATIVE -- ^ 0x0100 Implemented in other language
| ACC_INTERFACE -- ^ 0x0200 Class is interface
| ACC_ABSTRACT -- ^ 0x0400
| ACC_NATIVE -- ^ 0x0100 Implemented in other language
| ACC_INTERFACE -- ^ 0x0200 Class is interface
| ACC_ABSTRACT -- ^ 0x0400
- deriving (Eq, Show, Ord)
+ deriving (Eq, Show, Ord
, Enum
)
-- | Generic attribute
data Attribute = Attribute {
-- | Generic attribute
data Attribute = Attribute {
@@
-139,3
+152,11
@@
data Attribute = Attribute {
-- | Set of attributes
type Attributes = M.Map B.ByteString B.ByteString
-- | Set of attributes
type Attributes = M.Map B.ByteString B.ByteString
+instance (Binary (Signature a)) => Binary (NameType a) where
+ put (NameType n t) = putLazyByteString n >> put t
+
+ get = NameType <$> get <*> get
+
+byteString :: (Binary t) => t -> B.ByteString
+byteString x = runPut (put x)
+