From: Ilya Portnov Date: Sat, 18 Jun 2011 16:57:35 +0000 (+0600) Subject: Factor Data.BinaryState module out to binary-state package. X-Git-Tag: v0.3.2~49 X-Git-Url: http://wien.tomnetworks.com/gitweb/?p=hs-java.git;a=commitdiff_plain;h=75ef14887a83273e60e35c2f0e47d099550c9628 Factor Data.BinaryState module out to binary-state package. --- diff --git a/.gitignore b/.gitignore index d7b78e2..f64c10b 100644 --- a/.gitignore +++ b/.gitignore @@ -4,3 +4,5 @@ *.bytecode *.swp .*.swp +dump-class +dist/ diff --git a/Data/BinaryState.hs b/Data/BinaryState.hs deleted file mode 100644 index fc7fa1d..0000000 --- a/Data/BinaryState.hs +++ /dev/null @@ -1,97 +0,0 @@ -{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-} -module Data.BinaryState where - -import Control.Monad -import qualified Control.Monad.State as State -import qualified Data.Binary as Binary -import qualified Data.Binary.Put as Put -import qualified Data.Binary.Get as Get -import qualified Data.ByteString.Lazy as B -import Data.Word -import Data.Int - -type PutState s a = State.StateT s Put.PutM a -type GetState s a = State.StateT s Binary.Get a - -class BinaryState s a where - put :: a -> PutState s () - get :: GetState s a - -instance (Binary.Binary a) => BinaryState () a where - put x = putZ x - get = getZ - -putZ :: (Binary.Binary a) => a -> PutState s () -putZ x = State.lift (Binary.put x) - -getZ :: (Binary.Binary a) => GetState s a -getZ = State.lift Binary.get - ------------------------------------------------- - -encodeS :: (BinaryState s a) => s -> a -> B.ByteString -encodeS s a = Put.runPut $ State.evalStateT (put a) s - -decodeS :: (BinaryState s a) => s -> B.ByteString -> a -decodeS s str = Get.runGet (State.evalStateT get s) str - -decodeWith :: GetState s a -> s -> B.ByteString -> a -decodeWith getter s str = - let (x,_,_) = Get.runGetState (State.evalStateT getter s) str 0 - in x - -encodeFile :: BinaryState s a => FilePath -> s -> a -> IO () -encodeFile f s v = B.writeFile f (encodeS s v) - -decodeFile :: BinaryState s a => FilePath -> s -> IO a -decodeFile f s = liftM (decodeS s) (B.readFile f) - ------------------------------------------------- - -getByte :: GetState s Word8 -getByte = State.lift Binary.getWord8 - -liftOffset :: (Binary.Binary a) => Integer -> (a -> Binary.Put) -> a -> PutState Integer () -liftOffset d fn x = State.modify (+d) >> State.lift (fn x) - -putByte :: Word8 -> PutState Integer () -putByte x = liftOffset 1 Put.putWord8 x - -isEmpty :: GetState s Bool -isEmpty = State.lift Get.isEmpty - -skip :: Int -> GetState s () -skip n = State.lift (Get.skip n) - -getOffset :: PutState Integer Integer -getOffset = State.get - -bytesRead :: GetState s Int64 -bytesRead = State.lift Get.bytesRead - --------------------------------------------------- - -instance BinaryState Integer Word8 where - put x = putByte x - get = getZ - -instance BinaryState Integer Word16 where - put x = liftOffset 2 Binary.put x - get = getZ - -instance BinaryState Integer Word32 where - put x = liftOffset 4 Binary.put x - get = getZ - -instance (BinaryState s a, BinaryState s b) => BinaryState s (a,b) where - put (x,y) = put x >> put y - get = do - x <- get - y <- get - return (x,y) - --------------------------------------------------- - --- instance (Binary.Binary a, Storable a) => BinaryState Integer a where --- put x = liftOffset (fromIntegral $ sizeOf x) Binary.put x --- get = getZ diff --git a/Makefile b/Makefile index 815c13d..8477513 100644 --- a/Makefile +++ b/Makefile @@ -1,8 +1,8 @@ GHC=ghc --make -fwarn-unused-imports -all: disassemble +all: dump-class -disassemble: disassemble.hs */*.hs +dump-class: dump-class.hs */*.hs $(GHC) $< clean: diff --git a/disassemble.hs b/disassemble.hs deleted file mode 100644 index bb6512f..0000000 --- a/disassemble.hs +++ /dev/null @@ -1,37 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -module Main where - -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 -import JVM.Converter -import JVM.Assembler - -main = do - args <- getArgs - case args of - [clspath] -> 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 " - B.putStr (methodName m) - print (methodSignature m) - case attrByName m "Code" of - Nothing -> putStrLn "(no code)\n" - Just bytecode -> let code = decodeS (0 :: Integer) bytecode - in forM_ (codeInstructions code) $ \i -> do - putStr " " - print i - - _ -> error "Synopsis: disassemble File.class" diff --git a/dump-class.hs b/dump-class.hs new file mode 100644 index 0000000..bb6512f --- /dev/null +++ b/dump-class.hs @@ -0,0 +1,37 @@ +{-# LANGUAGE OverloadedStrings #-} +module Main where + +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 +import JVM.Converter +import JVM.Assembler + +main = do + args <- getArgs + case args of + [clspath] -> 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 " + B.putStr (methodName m) + print (methodSignature m) + case attrByName m "Code" of + Nothing -> putStrLn "(no code)\n" + Just bytecode -> let code = decodeS (0 :: Integer) bytecode + in forM_ (codeInstructions code) $ \i -> do + putStr " " + print i + + _ -> error "Synopsis: disassemble File.class" diff --git a/hs-java.cabal b/hs-java.cabal index 266f99f..eb46038 100644 --- a/hs-java.cabal +++ b/hs-java.cabal @@ -11,18 +11,17 @@ Build-Type: Simple Description: This package declares data types for Java .class files format and functions to assemble/disassemble Java bytecode. -Extra-source-files: disassemble.hs +Extra-source-files: dump-class.hs library - Exposed-Modules: Data.BinaryState - JVM.Types + Exposed-Modules: JVM.Types JVM.ClassFile JVM.Assembler JVM.Converter Build-Depends: base >= 3 && <= 5, haskell98, containers, binary, mtl, directory, filepath, utf8-string, array, - bytestring, data-binary-ieee754 + bytestring, data-binary-ieee754, binary-state ghc-options: -fwarn-unused-imports