From 551564c1e46fc926629bd12a3bd73ae7bd976687 Mon Sep 17 00:00:00 2001 From: "Ilya V. Portnov" Date: Fri, 30 Sep 2011 11:56:21 +0600 Subject: [PATCH] Use Data.Map.Map instead of Data.Array.Array for constants pool. --- JVM/Assembler.hs | 2 +- JVM/Converter.hs | 5 ++--- JVM/Dump.hs | 4 ++-- JVM/Generator.hs | 32 ++++++++++++-------------------- JVM/Types.hs | 10 ++++++---- rebuild-class.hs | 18 ++---------------- 6 files changed, 25 insertions(+), 46 deletions(-) diff --git a/JVM/Assembler.hs b/JVM/Assembler.hs index b86bdbb..31e00fe 100644 --- 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 4fb0ec3..a5f9d10 100644 --- 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 a5b2d19..2012c8b 100644 --- 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 6fb6636..9db24e6 100644 --- 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 5cdfb97..7ce6580 100644 --- 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 abe1918..1265cf1 100644 --- 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) -- 2.25.1