From 5a92a8e4a3a1da9114aec1c923a119c0255360b9 Mon Sep 17 00:00:00 2001
From: Ilya Portnov <portnov84@rambler.ru>
Date: Mon, 13 Jun 2011 18:51:26 +0600
Subject: [PATCH] Add some Show instances.

---
 JVM/ClassFile.hs | 27 ++++++++++++++++++++++++---
 JVM/Types.hs     | 23 +++++++++++++++++++++--
 disassemble.hs   |  5 +++++
 3 files changed, 50 insertions(+), 5 deletions(-)

diff --git a/JVM/ClassFile.hs b/JVM/ClassFile.hs
index 0f8a182..3a9f3bf 100644
--- a/JVM/ClassFile.hs
+++ b/JVM/ClassFile.hs
@@ -9,6 +9,7 @@ import Data.Binary.Get
 import Data.Binary.Put
 import Data.Word
 import Data.Char
+import Data.List
 import qualified Data.ByteString.Lazy as B
 
 import Debug.Trace
@@ -100,7 +101,20 @@ data FieldType =
   | BoolType   -- Z
   | ObjectType String -- L <class name>
   | Array (Maybe Int) FieldType
-  deriving (Eq, Show)
+  deriving (Eq)
+
+instance Show FieldType where
+  show SignedByte = "byte"
+  show CharByte = "char"
+  show DoubleType = "double"
+  show FloatType = "float"
+  show IntType = "int"
+  show LongInt = "long"
+  show ShortInt = "short"
+  show BoolType = "bool"
+  show (ObjectType s) = "Object " ++ s
+  show (Array Nothing t) = show t ++ "[]"
+  show (Array (Just n) t) = show t ++ "[" ++ show n ++ "]"
 
 type FieldSignature = FieldType
 
@@ -166,7 +180,11 @@ getToSemicolon = do
 data ReturnSignature =
     Returns FieldType
   | ReturnsVoid
-  deriving (Eq, Show)
+  deriving (Eq)
+
+instance Show ReturnSignature where
+  show (Returns t) = show t
+  show ReturnsVoid = "Void"
 
 instance Binary ReturnSignature where
   put (Returns sig) = put sig
@@ -182,7 +200,10 @@ type ArgumentSignature = FieldType
 
 data MethodSignature =
     MethodSignature [ArgumentSignature] ReturnSignature
-  deriving (Eq, Show)
+  deriving (Eq)
+
+instance Show MethodSignature where
+  show (MethodSignature args ret) = "(" ++ intercalate ", " (map show args) ++ ") returns " ++ show ret
 
 instance Binary MethodSignature where
   put (MethodSignature args ret) = do
diff --git a/JVM/Types.hs b/JVM/Types.hs
index 2f2f3a1..834af21 100644
--- a/JVM/Types.hs
+++ b/JVM/Types.hs
@@ -15,6 +15,9 @@ import JVM.ClassFile
 instance IsString B.ByteString where
   fromString s = B.pack $ map (fromIntegral . ord) $ encodeString s
 
+toString :: B.ByteString -> String
+toString bstr = decodeString $ map (chr . fromIntegral) $ B.unpack bstr
+
 type Pool = Array Word16 Constant
 
 class HasAttributes a where
@@ -42,7 +45,9 @@ data NameType a = NameType {
   ntName :: B.ByteString,
   ntSignature :: Signature a }
 
-deriving instance Show (Signature a) => Show (NameType a)
+instance Show (Signature a) => Show (NameType a) where
+  show (NameType n t) = toString n ++ ": " ++ show t
+
 deriving instance Eq (Signature a) => Eq (NameType a)
 
 data Constant =
@@ -58,7 +63,21 @@ data Constant =
   | CNameType B.ByteString B.ByteString
   | CUTF8 {getString :: B.ByteString}
   | CUnicode {getString :: B.ByteString}
-  deriving (Eq, Show)
+  deriving (Eq)
+
+instance Show Constant where
+  show (CClass name) = "class " ++ toString name
+  show (CField cls nt) = "field " ++ toString cls ++ "." ++ show nt
+  show (CMethod cls nt) = "method " ++ toString cls ++ "." ++ show nt
+  show (CIfaceMethod cls nt) = "interface method " ++ toString cls ++ "." ++ show nt
+  show (CString s) = "String \"" ++ toString s ++ "\""
+  show (CInteger x) = show x
+  show (CFloat x) = show x
+  show (CLong x) = show x
+  show (CDouble x) = show x
+  show (CNameType name tp) = toString name ++ ": " ++ toString tp
+  show (CUTF8 s) = "UTF8 \"" ++ toString s ++ "\""
+  show (CUnicode s) = "Unicode \"" ++ toString s ++ "\""
 
 data Field = Field {
   fieldAccess :: Access,
diff --git a/disassemble.hs b/disassemble.hs
index fc6e77f..619ef2c 100644
--- a/disassemble.hs
+++ b/disassemble.hs
@@ -1,7 +1,9 @@
 {-# LANGUAGE OverloadedStrings #-}
 import Control.Monad
+import Data.Array
 import System.Environment
 import qualified Data.ByteString.Lazy as B
+import Text.Printf
 
 import Data.BinaryState
 import JVM.Types
@@ -15,6 +17,9 @@ main = do
       cls <- decompileFile clspath
       putStr "Class: "
       B.putStrLn (this cls)
+      putStrLn "Constants pool:"
+      forM_ (assocs $ constantPool cls) $ \(i, c) ->
+        putStrLn $ printf "  #%d:\t%s" i (show c)
       putStrLn "Methods:"
       forM_ (methods cls) $ \m -> do
         putStr ">> Method "
-- 
2.25.1