Use Data.Map.Map instead of Data.Array.Array for constants pool.

diff --git a/JVM/Assembler.hs b/JVM/Assembler.hs
index b86bdbba7c2372d362e3f1116cc96b06f6aaab88..31e00fea6ff1678c86bed9e76ef8cd10d7c962a3 100644 (file)
--- a/JVM/Assembler.hs
+++ b/JVM/Assembler.hs
@@ -18,10 +18,10 @@ module JVM.Assembler
 
 import Control.Monad
 import Control.Applicative
+import Data.Ix (inRange)
 import Data.Word
 import qualified Data.Binary as Binary
 import qualified Data.ByteString.Lazy as B
-import Data.Array
 
 import Data.BinaryState
 import JVM.ClassFile

diff --git a/JVM/Converter.hs b/JVM/Converter.hs
index 4fb0ec309f6608bf12494c3c4f7559bc31a73ddc..a5f9d106b41ece16fe93b00cdb32b7a5224361e1 100644 (file)
--- a/JVM/Converter.hs
+++ b/JVM/Converter.hs
@@ -17,7 +17,6 @@ import Data.Word
 import Data.Bits
 import Data.Binary
 import qualified Data.ByteString.Lazy as B
-import Data.Array
 import qualified Data.Set as S
 import qualified Data.Map as M
 
@@ -76,7 +75,7 @@ classFile (Class {..}) = ClassFile {
 toCPInfo :: Pool -> [CpInfo]
 toCPInfo pool = result
   where
-    result = map cpInfo $ elems pool
+    result = map cpInfo $ M.elems pool
 
     cpInfo (CClass name) = CONSTANT_Class (force "class" $ poolIndex result name)
     cpInfo (CField cls name) =
@@ -157,7 +156,7 @@ constantPoolArray :: [CpInfo] -> Pool
 constantPoolArray list = pool
   where
     pool :: Pool
-    pool = listArray (1,n) $ map convert list
+    pool = M.fromList $ zip [1..] $ map convert list
     n = fromIntegral $ length list
 
     convertNameType :: (HasSignature a, Binary (Signature a)) => Word16 -> NameType a

diff --git a/JVM/Dump.hs b/JVM/Dump.hs
index a5b2d196b27ee05ca4b74e24926ef0412f74458f..2012c8b94b5533eb706b93f63ad3b44c5336beca 100644 (file)
--- a/JVM/Dump.hs
+++ b/JVM/Dump.hs
@@ -2,7 +2,7 @@
 module JVM.Dump where
 
 import Control.Monad
-import Data.Array
+import qualified Data.Map as M
 import qualified Data.ByteString.Lazy as B
 import Text.Printf
 
@@ -15,7 +15,7 @@ dumpClass cls = do
     putStr "Class: "
     B.putStrLn (this cls)
     putStrLn "Constants pool:"
-    forM_ (assocs $ constantPool cls) $ \(i, c) ->
+    forM_ (M.assocs $ constantPool cls) $ \(i, c) ->
       putStrLn $ printf "  #%d:\t%s" i (show c)
     putStrLn "Methods:"
     forM_ (methods cls) $ \m -> do

diff --git a/JVM/Generator.hs b/JVM/Generator.hs
index 6fb663667198e7b197d707c41105b174256761f4..9db24e66cf5b5e9f69b93cc11c955738f0324f60 100644 (file)
--- a/JVM/Generator.hs
+++ b/JVM/Generator.hs
@@ -2,7 +2,6 @@
 module JVM.Generator where
 
 import Control.Monad.State as St
-import Data.Array
 import Data.Word
 import Data.List
 import Data.Binary
@@ -23,7 +22,7 @@ data GState = GState {
 
 emptyGState = GState {
   generated = [],
-  currentPool = listArray (0,0) [CInteger 0],
+  currentPool = M.empty,
   doneMethods = [],
   currentMethod = Nothing }
 
@@ -31,31 +30,24 @@ type Generate a = State GState a
 
 appendPool :: Constant -> Pool -> (Pool, Word16)
 appendPool c pool =
-  let list = assocs pool
-      size = fromIntegral (length list)
-      list' = list ++ [(size, c)]
-  in  (array (0, size) list',
-       size)
+  let size = fromIntegral (M.size pool)
+      pool' = M.insert size c pool
+  in  (pool', size)
 
 addItem :: Constant -> Generate Word16
 addItem c = do
   pool <- St.gets currentPool
-  if pool ! 0 == CInteger 0
-    then do
-         st <- St.get
-         St.put $ st {currentPool = listArray (0,0) [c]}
-         return 1
-    else case lookupPool c pool of
-          Just i -> return i
-          Nothing -> do
-            let (pool', i) = appendPool c pool
-            st <- St.get
-            St.put $ st {currentPool = pool'}
-            return (i+1)
+  case lookupPool c pool of
+    Just i -> return i
+    Nothing -> do
+      let (pool', i) = appendPool c pool
+      st <- St.get
+      St.put $ st {currentPool = pool'}
+      return (i+1)
 
 lookupPool :: Constant -> Pool -> Maybe Word16
 lookupPool c pool =
-  fromIntegral `fmap` findIndex (== c) (elems pool)
+  fromIntegral `fmap` findIndex (== c) (M.elems pool)
 
 addNT :: Binary (Signature a) => NameType a -> Generate Word16
 addNT (NameType name sig) = do

diff --git a/JVM/Types.hs b/JVM/Types.hs
index 5cdfb97608f9a0cb89549ca5f96d1d37fc3dc8a9..7ce6580c7140dc0531d4a5c86f9a37182b191226 100644 (file)
--- a/JVM/Types.hs
+++ b/JVM/Types.hs
@@ -4,7 +4,6 @@ module JVM.Types where
 
 import Codec.Binary.UTF8.String hiding (encode, decode)
 import Control.Applicative
-import Data.Array
 import Data.Binary
 import Data.Binary.Put
 import qualified Data.ByteString.Lazy as B
@@ -25,10 +24,13 @@ toCharList :: B.ByteString -> [Int]
 toCharList bstr = map fromIntegral $ B.unpack bstr
 
 -- | Constant pool
-type Pool = Array Word16 Constant
+type Pool = M.Map Word16 Constant
 
-asize :: (Ix i) => Array i e -> Int
-asize = length . elems
+poolSize :: Pool -> Int
+poolSize = M.size
+
+(!) :: (Ord k) => M.Map k a -> k -> a
+(!) = (M.!)
 
 showListIx :: (Show a) => [a] -> String
 showListIx list = unlines $ zipWith s [1..] list

diff --git a/rebuild-class.hs b/rebuild-class.hs
index abe19187fcb99a120f83b44a994bcb3c0502f64e..1265cf1207b9dd07db78da902197b4e049ff8d77 100644 (file)
--- a/rebuild-class.hs
+++ b/rebuild-class.hs
@@ -11,6 +11,7 @@ import JVM.Types
 import JVM.ClassFile
 import JVM.Converter
 import JVM.Assembler
+import JVM.Dump
 
 main = do
   args <- getArgs
@@ -18,22 +19,7 @@ main = do
     [clspath,outpath] -> do
       cls <- parseClassFile clspath
       clsfile <- decodeFile clspath :: IO ClassFile
-      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 "
-        B.putStr (methodName m)
-        print (methodSignature m)
-        case attrByName m "Code" of
-          Nothing -> putStrLn "(no code)\n"
-          Just bytecode -> let code = decodeMethod bytecode
-                           in  forM_ (codeInstructions code) $ \i -> do
-                                 putStr "  "
-                                 print i
+      dumpClass cls
       putStrLn $ "Source pool:\n" ++ showListIx (constsPool clsfile)
       let result = classFile cls
       putStrLn $ "Result pool:\n" ++ showListIx (constsPool result)