From: Ilya Portnov Date: Fri, 30 Sep 2011 12:54:33 +0000 (+0600) Subject: Rearrange modules. X-Git-Tag: v0.3.2~33 X-Git-Url: http://wien.tomnetworks.com/gitweb/?p=hs-java.git;a=commitdiff_plain;h=69b71af830218d6e1e20fae3cc42fdbaca1816ee Rearrange modules. --- diff --git a/JVM/Builder.hs b/JVM/Builder.hs new file mode 100644 index 0000000..f905ab6 --- /dev/null +++ b/JVM/Builder.hs @@ -0,0 +1,9 @@ + +module JVM.Builder + (module JVM.Builder.Monad, + module JVM.Builder.Instructions) + where + +import JVM.Builder.Monad +import JVM.Builder.Instructions + diff --git a/JVM/Builder/Instructions.hs b/JVM/Builder/Instructions.hs new file mode 100644 index 0000000..3eec20f --- /dev/null +++ b/JVM/Builder/Instructions.hs @@ -0,0 +1,162 @@ + +module JVM.Builder.Instructions where + +import JVM.ClassFile +import JVM.Assembler +import JVM.Builder.Monad + +nop = i0 NOP +aconst_null = i0 ACONST_NULL +iconst_m1 = i0 ICONST_M1 +iconst_0 = i0 ICONST_0 +iconst_1 = i0 ICONST_1 +iconst_2 = i0 ICONST_2 +iconst_3 = i0 ICONST_3 +iconst_4 = i0 ICONST_4 +iconst_5 = i0 ICONST_5 +lconst_0 = i0 LCONST_0 +lconst_1 = i0 LCONST_1 +fconst_0 = i0 FCONST_0 +fconst_1 = i0 FCONST_1 +fconst_2 = i0 FCONST_2 +dconst_0 = i0 DCONST_0 +dconst_1 = i0 DCONST_1 + +bipush x = i0 (BIPUSH x) +sipush x = i0 (SIPUSH x) +ldc1 x = i8 LDC1 x +ldc2 x = i1 LDC2 x +ldc2w x = i1 LDC2W x +iload x = i8 ILOAD x +lload x = i8 LLOAD x +fload x = i8 FLOAD x +dload x = i8 DLOAD x +aload x = i8 ALOAD x + +iload_ x = i0 (ILOAD_ x) +lload_ x = i0 (LLOAD_ x) +fload_ x = i0 (FLOAD_ x) +dload_ x = i0 (DLOAD_ x) +aload_ x = i0 (ALOAD_ x) + +iaload = i0 IALOAD +laload = i0 LALOAD +faload = i0 FALOAD +daload = i0 DALOAD +aaload = i0 AALOAD +caload = i0 CALOAD +saload = i0 SALOAD + +istore x = i8 ISTORE x +lstore x = i8 LSTORE x +fstore x = i8 FSTORE x +dstore x = i8 DSTORE x +astore x = i8 ASTORE x + +istore_ x = i0 (ISTORE x) +lstore_ x = i0 (LSTORE x) +fstore_ x = i0 (FSTORE x) +dstore_ x = i0 (DSTORE x) +astore_ x = i0 (ASTORE x) + +iastore = i0 IASTORE +lastore = i0 LASTORE +fastore = i0 FASTORE +dastore = i0 DASTORE +aastore = i0 AASTORE +bastore = i0 BASTORE +castore = i0 CASTORE +sastore = i0 SASTORE + +pop = i0 POP +pop2 = i0 POP2 +dup = i0 DUP +dup_x1 = i0 DUP_X1 +dup_x2 = i0 DUP_X2 +dup2 = i0 DUP2 +dup2_x1 = i0 DUP2_X1 +dup2_x2 = i0 DUP2_X2 +swap = i0 SWAP +iadd = i0 IADD +ladd = i0 LADD +fadd = i0 FADD +dadd = i0 DADD +isub = i0 ISUB +lsub = i0 LSUB +fsub = i0 FSUB +dsub = i0 DSUB +imul = i0 IMUL +lmul = i0 LMUL +fmul = i0 FMUL +dmul = i0 DMUL +idiv = i0 IDIV +ldiv = i0 LDIV +fdiv = i0 FDIV +ddiv = i0 DDIV +irem = i0 IREM +lrem = i0 LREM +frem = i0 FREM +drem = i0 DREM +ineg = i0 INEG +lneg = i0 LNEG +fneg = i0 FNEG +dneg = i0 DNEG +ishl = i0 ISHL +lshl = i0 LSHL +ishr = i0 ISHR +lshr = i0 LSHR +iushr = i0 IUSHR +lushr = i0 LUSHR +iand = i0 IAND +land = i0 LAND +ior = i0 IOR +lor = i0 LOR +ixor = i0 IXOR +lxor = i0 LXOR + +iinc x y = i0 (IINC x y) + +i2l = i0 I2L +i2f = i0 I2F +i2d = i0 I2D +l2i = i0 L2I +l2f = i0 L2F +l2d = i0 L2D +f2i = i0 F2I +f2l = i0 F2L +f2d = i0 F2D +d2i = i0 D2I +d2l = i0 D2L +d2f = i0 D2F +i2b = i0 I2B +i2c = i0 I2C +i2s = i0 I2S +lcmp = i0 LCMP + +new cls = + i1 NEW (CClass cls) + +newArray t = + i0 (NEWARRAY $ atype2byte t) + +allocNewArray cls = + i1 ANEWARRAY (CClass cls) + +invokeVirtual cls sig = + i1 INVOKEVIRTUAL (CMethod cls sig) + +invokeStatic cls sig = + i1 INVOKESTATIC (CMethod cls sig) + +invokeSpecial cls sig = + i1 INVOKESPECIAL (CMethod cls sig) + +getStaticField cls sig = + i1 GETSTATIC (CField cls sig) + +loadString str = + i8 LDC1 (CString str) + +allocArray cls = + i1 ANEWARRAY (CClass cls) + diff --git a/JVM/Builder/Monad.hs b/JVM/Builder/Monad.hs new file mode 100644 index 0000000..85916e2 --- /dev/null +++ b/JVM/Builder/Monad.hs @@ -0,0 +1,188 @@ +{-# LANGUAGE FlexibleContexts, TypeFamilies, OverloadedStrings #-} +module JVM.Builder.Monad where + +import Control.Monad.State as St +import Data.Word +import Data.List +import Data.Binary +import qualified Data.Map as M +import qualified Data.Set as S +import qualified Data.ByteString.Lazy as B + +import JVM.Common () -- import instances only +import JVM.ClassFile +import JVM.Assembler + +data GState = GState { + generated :: [Instruction], + currentPool :: Pool Resolved, + doneMethods :: [Method Resolved], + currentMethod :: Maybe (Method Resolved)} + deriving (Eq,Show) + +emptyGState = GState { + generated = [], + currentPool = M.empty, + doneMethods = [], + currentMethod = Nothing } + +type Generate a = State GState a + +appendPool :: Constant Resolved -> Pool Resolved -> (Pool Resolved, Word16) +appendPool c pool = + let size = fromIntegral (M.size pool) + pool' = M.insert size c pool + in (pool', size) + +addItem :: Constant Resolved -> Generate Word16 +addItem c = do + pool <- St.gets currentPool + case lookupPool c pool of + Just i -> return (i+1) + Nothing -> do + let (pool', i) = appendPool c pool + st <- St.get + St.put $ st {currentPool = pool'} + return (i+1) + +lookupPool :: Constant Resolved -> Pool Resolved -> Maybe Word16 +lookupPool c pool = + fromIntegral `fmap` findIndex (== c) (M.elems pool) + +addNT :: Binary (Signature a) => NameType a -> Generate Word16 +addNT (NameType name sig) = do + let bsig = encode sig + x <- addItem (CNameType name bsig) + addItem (CUTF8 name) + addItem (CUTF8 bsig) + return x + +addSig :: MethodSignature -> Generate Word16 +addSig c@(MethodSignature args ret) = do + let bsig = encode c + addItem (CUTF8 bsig) + +addToPool :: Constant Resolved -> Generate Word16 +addToPool c@(CClass str) = do + addItem (CUTF8 str) + addItem c +addToPool c@(CField cls name) = do + addToPool (CClass cls) + addNT name + addItem c +addToPool c@(CMethod cls name) = do + addToPool (CClass cls) + addNT name + addItem c +addToPool c@(CIfaceMethod cls name) = do + addToPool (CClass cls) + addNT name + addItem c +addToPool c@(CString str) = do + addToPool (CUTF8 str) + addItem c +addToPool c@(CNameType name sig) = do + addItem (CUTF8 name) + addItem (CUTF8 sig) + addItem c +addToPool c = addItem c + +putInstruction :: Instruction -> Generate () +putInstruction instr = do + st <- St.get + let code = generated st + St.put $ st {generated = code ++ [instr]} + +i0 :: Instruction -> Generate () +i0 = putInstruction + +i1 :: (Word16 -> Instruction) -> Constant Resolved -> Generate () +i1 fn c = do + ix <- addToPool c + i0 (fn ix) + +i8 :: (Word8 -> Instruction) -> Constant Resolved -> Generate () +i8 fn c = do + ix <- addToPool c + i0 (fn $ fromIntegral ix) + +startMethod :: [AccessFlag] -> B.ByteString -> MethodSignature -> Generate () +startMethod flags name sig = do + addToPool (CString name) + addSig sig + st <- St.get + let method = Method { + methodAccessFlags = S.fromList flags, + methodName = name, + methodSignature = sig, + methodAttributesCount = 0, + methodAttributes = AR M.empty } + St.put $ st {generated = [], + currentMethod = Just method } + +endMethod :: Generate () +endMethod = do + m <- St.gets currentMethod + code <- St.gets genCode + case m of + Nothing -> fail "endMethod without startMethod!" + Just method -> do + let method' = method {methodAttributes = AR $ M.fromList [("Code", encodeMethod code)], + methodAttributesCount = 1} + st <- St.get + St.put $ st {generated = [], + currentMethod = Nothing, + doneMethods = doneMethods st ++ [method']} + +newMethod :: [AccessFlag] -> B.ByteString -> [ArgumentSignature] -> ReturnSignature -> Generate () -> Generate (NameType Method) +newMethod flags name args ret gen = do + let sig = MethodSignature args ret + startMethod flags name sig + gen + endMethod + return (NameType name sig) + +genCode :: GState -> Code +genCode st = Code { + codeStackSize = 4096, + codeMaxLocals = 100, + codeLength = len, + codeInstructions = generated st, + codeExceptionsN = 0, + codeExceptions = [], + codeAttrsN = 0, + codeAttributes = AP [] } + where + len = fromIntegral $ B.length $ encodeInstructions (generated st) + +initClass :: B.ByteString -> Generate Word16 +initClass name = do + addToPool (CClass "java/lang/Object") + addToPool (CClass name) + addToPool (CString "Code") + +generate :: B.ByteString -> Generate () -> Class Resolved +generate name gen = + let generator = do + initClass name + gen + res = execState generator emptyGState + code = genCode res + in Class { + magic = 0xCAFEBABE, + minorVersion = 0, + majorVersion = 50, + constsPoolSize = fromIntegral $ M.size (currentPool res), + constsPool = currentPool res, + accessFlags = S.fromList [ACC_PUBLIC, ACC_STATIC], + thisClass = name, + superClass = "java/lang/Object", + interfacesCount = 0, + interfaces = [], + classFieldsCount = 0, + classFields = [], + classMethodsCount = fromIntegral $ length (doneMethods res), + classMethods = doneMethods res, + classAttributesCount = 0, + classAttributes = AR M.empty } + diff --git a/JVM/Common.hs b/JVM/Common.hs new file mode 100644 index 0000000..2a7397e --- /dev/null +++ b/JVM/Common.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE TypeFamilies, StandaloneDeriving, FlexibleInstances, FlexibleContexts, UndecidableInstances #-} +-- | This module declares `high-level' data types for Java classes, methods etc. +module JVM.Common where + +import Codec.Binary.UTF8.String hiding (encode, decode) +import Control.Applicative +import Data.Binary +import Data.Binary.Put +import qualified Data.ByteString.Lazy as B +import Data.Char +import Data.String +import qualified Data.Set as S +import qualified Data.Map as M + +import JVM.ClassFile + +instance IsString B.ByteString where + fromString s = B.pack $ map (fromIntegral . ord) $ encodeString s + +toCharList :: B.ByteString -> [Int] +toCharList bstr = map fromIntegral $ B.unpack bstr + +poolSize :: Pool stage -> 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 + where s i x = show i ++ ":\t" ++ show x + +byteString :: (Binary t) => t -> B.ByteString +byteString x = runPut (put x) + diff --git a/JVM/Converter.hs b/JVM/Converter.hs index 82a1782..b780d0d 100644 --- a/JVM/Converter.hs +++ b/JVM/Converter.hs @@ -21,7 +21,7 @@ import qualified Data.Set as S import qualified Data.Map as M import JVM.ClassFile -import JVM.Types +import JVM.Common import JVM.Exceptions -- | Parse .class file data diff --git a/JVM/Dump.hs b/JVM/Dump.hs index 02da46a..f81aa4a 100644 --- a/JVM/Dump.hs +++ b/JVM/Dump.hs @@ -6,7 +6,7 @@ import qualified Data.Map as M import qualified Data.ByteString.Lazy as B import Text.Printf -import JVM.Types +import JVM.Common import JVM.ClassFile import JVM.Converter import JVM.Assembler diff --git a/JVM/Generator.hs b/JVM/Generator.hs deleted file mode 100644 index 34b27ed..0000000 --- a/JVM/Generator.hs +++ /dev/null @@ -1,188 +0,0 @@ -{-# LANGUAGE FlexibleContexts, TypeFamilies, OverloadedStrings #-} -module JVM.Generator where - -import Control.Monad.State as St -import Data.Word -import Data.List -import Data.Binary -import qualified Data.Map as M -import qualified Data.Set as S -import qualified Data.ByteString.Lazy as B - -import JVM.Types -import JVM.ClassFile -import JVM.Assembler - -data GState = GState { - generated :: [Instruction], - currentPool :: Pool Resolved, - doneMethods :: [Method Resolved], - currentMethod :: Maybe (Method Resolved)} - deriving (Eq,Show) - -emptyGState = GState { - generated = [], - currentPool = M.empty, - doneMethods = [], - currentMethod = Nothing } - -type Generate a = State GState a - -appendPool :: Constant Resolved -> Pool Resolved -> (Pool Resolved, Word16) -appendPool c pool = - let size = fromIntegral (M.size pool) - pool' = M.insert size c pool - in (pool', size) - -addItem :: Constant Resolved -> Generate Word16 -addItem c = do - pool <- St.gets currentPool - case lookupPool c pool of - Just i -> return (i+1) - Nothing -> do - let (pool', i) = appendPool c pool - st <- St.get - St.put $ st {currentPool = pool'} - return (i+1) - -lookupPool :: Constant Resolved -> Pool Resolved -> Maybe Word16 -lookupPool c pool = - fromIntegral `fmap` findIndex (== c) (M.elems pool) - -addNT :: Binary (Signature a) => NameType a -> Generate Word16 -addNT (NameType name sig) = do - let bsig = encode sig - x <- addItem (CNameType name bsig) - addItem (CUTF8 name) - addItem (CUTF8 bsig) - return x - -addSig :: MethodSignature -> Generate Word16 -addSig c@(MethodSignature args ret) = do - let bsig = encode c - addItem (CUTF8 bsig) - -addToPool :: Constant Resolved -> Generate Word16 -addToPool c@(CClass str) = do - addItem (CUTF8 str) - addItem c -addToPool c@(CField cls name) = do - addToPool (CClass cls) - addNT name - addItem c -addToPool c@(CMethod cls name) = do - addToPool (CClass cls) - addNT name - addItem c -addToPool c@(CIfaceMethod cls name) = do - addToPool (CClass cls) - addNT name - addItem c -addToPool c@(CString str) = do - addToPool (CUTF8 str) - addItem c -addToPool c@(CNameType name sig) = do - addItem (CUTF8 name) - addItem (CUTF8 sig) - addItem c -addToPool c = addItem c - -putInstruction :: Instruction -> Generate () -putInstruction instr = do - st <- St.get - let code = generated st - St.put $ st {generated = code ++ [instr]} - -i0 :: Instruction -> Generate () -i0 = putInstruction - -i1 :: (Word16 -> Instruction) -> Constant Resolved -> Generate () -i1 fn c = do - ix <- addToPool c - i0 (fn ix) - -i8 :: (Word8 -> Instruction) -> Constant Resolved -> Generate () -i8 fn c = do - ix <- addToPool c - i0 (fn $ fromIntegral ix) - -startMethod :: [AccessFlag] -> B.ByteString -> MethodSignature -> Generate () -startMethod flags name sig = do - addToPool (CString name) - addSig sig - st <- St.get - let method = Method { - methodAccessFlags = S.fromList flags, - methodName = name, - methodSignature = sig, - methodAttributesCount = 0, - methodAttributes = AR M.empty } - St.put $ st {generated = [], - currentMethod = Just method } - -endMethod :: Generate () -endMethod = do - m <- St.gets currentMethod - code <- St.gets genCode - case m of - Nothing -> fail "endMethod without startMethod!" - Just method -> do - let method' = method {methodAttributes = AR $ M.fromList [("Code", encodeMethod code)], - methodAttributesCount = 1} - st <- St.get - St.put $ st {generated = [], - currentMethod = Nothing, - doneMethods = doneMethods st ++ [method']} - -newMethod :: [AccessFlag] -> B.ByteString -> [ArgumentSignature] -> ReturnSignature -> Generate () -> Generate (NameType Method) -newMethod flags name args ret gen = do - let sig = MethodSignature args ret - startMethod flags name sig - gen - endMethod - return (NameType name sig) - -genCode :: GState -> Code -genCode st = Code { - codeStackSize = 4096, - codeMaxLocals = 100, - codeLength = len, - codeInstructions = generated st, - codeExceptionsN = 0, - codeExceptions = [], - codeAttrsN = 0, - codeAttributes = AP [] } - where - len = fromIntegral $ B.length $ encodeInstructions (generated st) - -initClass :: B.ByteString -> Generate Word16 -initClass name = do - addToPool (CClass "java/lang/Object") - addToPool (CClass name) - addToPool (CString "Code") - -generate :: B.ByteString -> Generate () -> Class Resolved -generate name gen = - let generator = do - initClass name - gen - res = execState generator emptyGState - code = genCode res - in Class { - magic = 0xCAFEBABE, - minorVersion = 0, - majorVersion = 50, - constsPoolSize = fromIntegral $ M.size (currentPool res), - constsPool = currentPool res, - accessFlags = S.fromList [ACC_PUBLIC, ACC_STATIC], - thisClass = name, - superClass = "java/lang/Object", - interfacesCount = 0, - interfaces = [], - classFieldsCount = 0, - classFields = [], - classMethodsCount = fromIntegral $ length (doneMethods res), - classMethods = doneMethods res, - classAttributesCount = 0, - classAttributes = AR M.empty } - diff --git a/JVM/Generator/Instructions.hs b/JVM/Generator/Instructions.hs deleted file mode 100644 index 4a7a450..0000000 --- a/JVM/Generator/Instructions.hs +++ /dev/null @@ -1,162 +0,0 @@ - -module JVM.Generator.Instructions where - -import JVM.ClassFile -import JVM.Assembler -import JVM.Generator - -nop = i0 NOP -aconst_null = i0 ACONST_NULL -iconst_m1 = i0 ICONST_M1 -iconst_0 = i0 ICONST_0 -iconst_1 = i0 ICONST_1 -iconst_2 = i0 ICONST_2 -iconst_3 = i0 ICONST_3 -iconst_4 = i0 ICONST_4 -iconst_5 = i0 ICONST_5 -lconst_0 = i0 LCONST_0 -lconst_1 = i0 LCONST_1 -fconst_0 = i0 FCONST_0 -fconst_1 = i0 FCONST_1 -fconst_2 = i0 FCONST_2 -dconst_0 = i0 DCONST_0 -dconst_1 = i0 DCONST_1 - -bipush x = i0 (BIPUSH x) -sipush x = i0 (SIPUSH x) -ldc1 x = i8 LDC1 x -ldc2 x = i1 LDC2 x -ldc2w x = i1 LDC2W x -iload x = i8 ILOAD x -lload x = i8 LLOAD x -fload x = i8 FLOAD x -dload x = i8 DLOAD x -aload x = i8 ALOAD x - -iload_ x = i0 (ILOAD_ x) -lload_ x = i0 (LLOAD_ x) -fload_ x = i0 (FLOAD_ x) -dload_ x = i0 (DLOAD_ x) -aload_ x = i0 (ALOAD_ x) - -iaload = i0 IALOAD -laload = i0 LALOAD -faload = i0 FALOAD -daload = i0 DALOAD -aaload = i0 AALOAD -caload = i0 CALOAD -saload = i0 SALOAD - -istore x = i8 ISTORE x -lstore x = i8 LSTORE x -fstore x = i8 FSTORE x -dstore x = i8 DSTORE x -astore x = i8 ASTORE x - -istore_ x = i0 (ISTORE x) -lstore_ x = i0 (LSTORE x) -fstore_ x = i0 (FSTORE x) -dstore_ x = i0 (DSTORE x) -astore_ x = i0 (ASTORE x) - -iastore = i0 IASTORE -lastore = i0 LASTORE -fastore = i0 FASTORE -dastore = i0 DASTORE -aastore = i0 AASTORE -bastore = i0 BASTORE -castore = i0 CASTORE -sastore = i0 SASTORE - -pop = i0 POP -pop2 = i0 POP2 -dup = i0 DUP -dup_x1 = i0 DUP_X1 -dup_x2 = i0 DUP_X2 -dup2 = i0 DUP2 -dup2_x1 = i0 DUP2_X1 -dup2_x2 = i0 DUP2_X2 -swap = i0 SWAP -iadd = i0 IADD -ladd = i0 LADD -fadd = i0 FADD -dadd = i0 DADD -isub = i0 ISUB -lsub = i0 LSUB -fsub = i0 FSUB -dsub = i0 DSUB -imul = i0 IMUL -lmul = i0 LMUL -fmul = i0 FMUL -dmul = i0 DMUL -idiv = i0 IDIV -ldiv = i0 LDIV -fdiv = i0 FDIV -ddiv = i0 DDIV -irem = i0 IREM -lrem = i0 LREM -frem = i0 FREM -drem = i0 DREM -ineg = i0 INEG -lneg = i0 LNEG -fneg = i0 FNEG -dneg = i0 DNEG -ishl = i0 ISHL -lshl = i0 LSHL -ishr = i0 ISHR -lshr = i0 LSHR -iushr = i0 IUSHR -lushr = i0 LUSHR -iand = i0 IAND -land = i0 LAND -ior = i0 IOR -lor = i0 LOR -ixor = i0 IXOR -lxor = i0 LXOR - -iinc x y = i0 (IINC x y) - -i2l = i0 I2L -i2f = i0 I2F -i2d = i0 I2D -l2i = i0 L2I -l2f = i0 L2F -l2d = i0 L2D -f2i = i0 F2I -f2l = i0 F2L -f2d = i0 F2D -d2i = i0 D2I -d2l = i0 D2L -d2f = i0 D2F -i2b = i0 I2B -i2c = i0 I2C -i2s = i0 I2S -lcmp = i0 LCMP - -new cls = - i1 NEW (CClass cls) - -newArray t = - i0 (NEWARRAY $ atype2byte t) - -allocNewArray cls = - i1 ANEWARRAY (CClass cls) - -invokeVirtual cls sig = - i1 INVOKEVIRTUAL (CMethod cls sig) - -invokeStatic cls sig = - i1 INVOKESTATIC (CMethod cls sig) - -invokeSpecial cls sig = - i1 INVOKESPECIAL (CMethod cls sig) - -getStaticField cls sig = - i1 GETSTATIC (CField cls sig) - -loadString str = - i8 LDC1 (CString str) - -allocArray cls = - i1 ANEWARRAY (CClass cls) - diff --git a/JVM/Types.hs b/JVM/Types.hs deleted file mode 100644 index 6af75e7..0000000 --- a/JVM/Types.hs +++ /dev/null @@ -1,35 +0,0 @@ -{-# LANGUAGE TypeFamilies, StandaloneDeriving, FlexibleInstances, FlexibleContexts, UndecidableInstances #-} --- | This module declares `high-level' data types for Java classes, methods etc. -module JVM.Types where - -import Codec.Binary.UTF8.String hiding (encode, decode) -import Control.Applicative -import Data.Binary -import Data.Binary.Put -import qualified Data.ByteString.Lazy as B -import Data.Char -import Data.String -import qualified Data.Set as S -import qualified Data.Map as M - -import JVM.ClassFile - -instance IsString B.ByteString where - fromString s = B.pack $ map (fromIntegral . ord) $ encodeString s - -toCharList :: B.ByteString -> [Int] -toCharList bstr = map fromIntegral $ B.unpack bstr - -poolSize :: Pool stage -> 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 - where s i x = show i ++ ":\t" ++ show x - -byteString :: (Binary t) => t -> B.ByteString -byteString x = runPut (put x) - diff --git a/Java/IO.hs b/Java/IO.hs index e3a2997..7f13efb 100644 --- a/Java/IO.hs +++ b/Java/IO.hs @@ -3,8 +3,8 @@ module Java.IO where import Data.String +import JVM.Common () -- import instances only import JVM.ClassFile -import JVM.Types import qualified Java.Lang diff --git a/Java/Lang.hs b/Java/Lang.hs index d11f7bd..74c40fc 100644 --- a/Java/Lang.hs +++ b/Java/Lang.hs @@ -3,8 +3,8 @@ module Java.Lang where import Data.String +import JVM.Common () -- import instances only import JVM.ClassFile -import JVM.Types objectClass = ObjectType object stringClass = ObjectType string diff --git a/Makefile b/Makefile index 8477513..a2aa34c 100644 --- a/Makefile +++ b/Makefile @@ -1,10 +1,16 @@ GHC=ghc --make -fwarn-unused-imports -all: dump-class +all: dump-class rebuild-class TestGen dump-class: dump-class.hs */*.hs $(GHC) $< +rebuild-class: rebuild-class.hs */*.hs + $(GHC) $< + +TestGen: TestGen.hs */*.hs + $(GHC) $< + clean: find . -name *.hi -delete find . -name *.o -delete diff --git a/TestGen.hs b/TestGen.hs index a42fa05..5bb8daa 100644 --- a/TestGen.hs +++ b/TestGen.hs @@ -2,12 +2,10 @@ import qualified Data.ByteString.Lazy as B -import JVM.Types import JVM.ClassFile import JVM.Converter import JVM.Assembler -import JVM.Generator -import JVM.Generator.Instructions +import JVM.Builder import qualified Java.Lang import qualified Java.IO diff --git a/dump-class.hs b/dump-class.hs index 86e714f..57053d6 100644 --- a/dump-class.hs +++ b/dump-class.hs @@ -9,7 +9,7 @@ import qualified Data.ByteString.Lazy as B import Text.Printf import qualified Data.Map as M -import JVM.Types +import JVM.Common import JVM.ClassFile import JVM.Converter import JVM.Dump diff --git a/rebuild-class.hs b/rebuild-class.hs index 337c5b2..45a9843 100644 --- a/rebuild-class.hs +++ b/rebuild-class.hs @@ -1,17 +1,13 @@ {-# LANGUAGE OverloadedStrings #-} -import Control.Monad -import Data.Array import Data.Binary import System.Environment import qualified Data.ByteString.Lazy as B -import Text.Printf import qualified Data.Map as M -import JVM.Types +import JVM.Common import JVM.ClassFile import JVM.Converter -import JVM.Assembler import JVM.Dump main = do