Rearrange modules.
authorIlya Portnov <portnov84@rambler.ru>
Fri, 30 Sep 2011 12:54:33 +0000 (18:54 +0600)
committerIlya Portnov <portnov84@rambler.ru>
Fri, 30 Sep 2011 12:54:33 +0000 (18:54 +0600)
15 files changed:
JVM/Builder.hs [new file with mode: 0644]
JVM/Builder/Instructions.hs [new file with mode: 0644]
JVM/Builder/Monad.hs [new file with mode: 0644]
JVM/Common.hs [new file with mode: 0644]
JVM/Converter.hs
JVM/Dump.hs
JVM/Generator.hs [deleted file]
JVM/Generator/Instructions.hs [deleted file]
JVM/Types.hs [deleted file]
Java/IO.hs
Java/Lang.hs
Makefile
TestGen.hs
dump-class.hs
rebuild-class.hs

diff --git a/JVM/Builder.hs b/JVM/Builder.hs
new file mode 100644 (file)
index 0000000..f905ab6
--- /dev/null
@@ -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 (file)
index 0000000..3eec20f
--- /dev/null
@@ -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 (file)
index 0000000..85916e2
--- /dev/null
@@ -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 (file)
index 0000000..2a7397e
--- /dev/null
@@ -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)
+
index 82a1782134019ed7e0e8503286d3f35d753b5f6d..b780d0da284760152867b6ed92e541541fa02651 100644 (file)
@@ -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
index 02da46ae2a0d074b2dab39cc459c528795573816..f81aa4aff31a0ec658a43030e19eabbd293284eb 100644 (file)
@@ -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 (file)
index 34b27ed..0000000
+++ /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 (file)
index 4a7a450..0000000
+++ /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 (file)
index 6af75e7..0000000
+++ /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)
-
index e3a29977407d75c013c3b11f8eaf31b015a17d41..7f13efb0f4eb3bd65d5695147dc813fdbec552bb 100644 (file)
@@ -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
 
index d11f7bd5a715267bd7da3f243100f073d16b85f9..74c40fcd8303ce4063a9d34a03026240dfce9630 100644 (file)
@@ -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
index 84775139813292e81e65bf4c2d6fec29dd1b3273..a2aa34c4b40f0b0d058b3717e6ada48cb4496334 100644 (file)
--- 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
index a42fa052c64ee8e058ad68b17c4707dc13eb3315..5bb8daad810cd28c777405cfe49b83387f2ffc9b 100644 (file)
@@ -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
index 86e714f1ea73bb85ca50678870fa705ea00f6fc6..57053d6f4b5f704788663185f2bde2b3d79b689e 100644 (file)
@@ -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
index 337c5b2f9d95fd94907f270055450e5fa0aff034..45a98431ac1aa16e1adb235967a3084a98bf791c 100644 (file)
@@ -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