Support both IO and clean version of Generate monad.

diff --git a/JVM/Builder/Instructions.hs b/JVM/Builder/Instructions.hs
index bc4948a777936c527ba61247ad02e99c7c032337..0d85d971429e915e3a3bb9877500f5dbd107dc64 100644 (file)
--- a/JVM/Builder/Instructions.hs
+++ b/JVM/Builder/Instructions.hs
@@ -10,294 +10,294 @@ import JVM.ClassFile
 import JVM.Assembler
 import JVM.Builder.Monad
 
-nop ::  Generate ()
+nop :: Generator g => g ()
 nop = i0 NOP
-aconst_null ::  Generate ()
+aconst_null :: Generator g => g ()
 aconst_null = i0 ACONST_NULL
-iconst_m1 ::  Generate ()
+iconst_m1 :: Generator g => g ()
 iconst_m1 = i0 ICONST_M1
-iconst_0 ::  Generate ()
+iconst_0 :: Generator g => g ()
 iconst_0 = i0 ICONST_0
-iconst_1 ::  Generate ()
+iconst_1 :: Generator g => g ()
 iconst_1 = i0 ICONST_1
-iconst_2 ::  Generate ()
+iconst_2 :: Generator g => g ()
 iconst_2 = i0 ICONST_2
-iconst_3 ::  Generate ()
+iconst_3 :: Generator g => g ()
 iconst_3 = i0 ICONST_3
-iconst_4 ::  Generate ()
+iconst_4 :: Generator g => g ()
 iconst_4 = i0 ICONST_4
-iconst_5 ::  Generate ()
+iconst_5 :: Generator g => g ()
 iconst_5 = i0 ICONST_5
-lconst_0 ::  Generate ()
+lconst_0 :: Generator g => g ()
 lconst_0 = i0 LCONST_0
-lconst_1 ::  Generate ()
+lconst_1 :: Generator g => g ()
 lconst_1 = i0 LCONST_1
-fconst_0 ::  Generate ()
+fconst_0 :: Generator g => g ()
 fconst_0 = i0 FCONST_0
-fconst_1 ::  Generate ()
+fconst_1 :: Generator g => g ()
 fconst_1 = i0 FCONST_1
-fconst_2 ::  Generate ()
+fconst_2 :: Generator g => g ()
 fconst_2 = i0 FCONST_2
-dconst_0 ::  Generate ()
+dconst_0 :: Generator g => g ()
 dconst_0 = i0 DCONST_0
-dconst_1 ::  Generate ()
+dconst_1 :: Generator g => g ()
 dconst_1 = i0 DCONST_1
 
-bipush ::  Word8 -> Generate ()
+bipush :: Generator g => Word8 -> g ()
 bipush x = i0 (BIPUSH x)
-sipush ::  Word16 -> Generate ()
+sipush :: Generator g => Word16 -> g ()
 sipush x = i0 (SIPUSH x)
 
-ldc1 ::  Constant Direct -> Generate ()
+ldc1 :: Generator g => Constant Direct -> g ()
 ldc1 x = i8 LDC1 x
-ldc2 ::  Constant Direct -> Generate ()
+ldc2 :: Generator g => Constant Direct -> g ()
 ldc2 x = i1 LDC2 x
-ldc2w ::  Constant Direct -> Generate ()
+ldc2w :: Generator g => Constant Direct -> g ()
 ldc2w x = i1 LDC2W x
-iload ::  Constant Direct -> Generate ()
+iload :: Generator g => Constant Direct -> g ()
 iload x = i8 ILOAD x
-lload ::  Constant Direct -> Generate ()
+lload :: Generator g => Constant Direct -> g ()
 lload x = i8 LLOAD x
-fload ::  Constant Direct -> Generate ()
+fload :: Generator g => Constant Direct -> g ()
 fload x = i8 FLOAD x
-dload ::  Constant Direct -> Generate ()
+dload :: Generator g => Constant Direct -> g ()
 dload x = i8 DLOAD x
-aload ::  Constant Direct -> Generate ()
+aload :: Generator g => Constant Direct -> g ()
 aload x = i8 ALOAD x
 
-iload_ ::  IMM -> Generate ()
+iload_ :: Generator g => IMM -> g ()
 iload_ x = i0 (ILOAD_ x)
-lload_ ::  IMM -> Generate ()
+lload_ :: Generator g => IMM -> g ()
 lload_ x = i0 (LLOAD_ x)
-fload_ ::  IMM -> Generate ()
+fload_ :: Generator g => IMM -> g ()
 fload_ x = i0 (FLOAD_ x)
-dload_ ::  IMM -> Generate ()
+dload_ :: Generator g => IMM -> g ()
 dload_ x = i0 (DLOAD_ x)
-aload_ ::  IMM -> Generate ()
+aload_ :: Generator g => IMM -> g ()
 aload_ x = i0 (ALOAD_ x)
 
-iaload ::  Generate ()
+iaload :: Generator g => g ()
 iaload = i0 IALOAD
-laload ::  Generate ()
+laload :: Generator g => g ()
 laload = i0 LALOAD
-faload ::  Generate ()
+faload :: Generator g => g ()
 faload = i0 FALOAD
-daload ::  Generate ()
+daload :: Generator g => g ()
 daload = i0 DALOAD
-aaload ::  Generate ()
+aaload :: Generator g => g ()
 aaload = i0 AALOAD
-caload ::  Generate ()
+caload :: Generator g => g ()
 caload = i0 CALOAD
-saload ::  Generate ()
+saload :: Generator g => g ()
 saload = i0 SALOAD
 
-istore ::  Constant Direct -> Generate ()
+istore :: Generator g => Constant Direct -> g ()
 istore x = i8 ISTORE x
-lstore ::  Constant Direct -> Generate ()
+lstore :: Generator g => Constant Direct -> g ()
 lstore x = i8 LSTORE x
-fstore ::  Constant Direct -> Generate ()
+fstore :: Generator g => Constant Direct -> g ()
 fstore x = i8 FSTORE x
-dstore ::  Constant Direct -> Generate ()
+dstore :: Generator g => Constant Direct -> g ()
 dstore x = i8 DSTORE x
-astore ::  Constant Direct -> Generate ()
+astore :: Generator g => Constant Direct -> g ()
 astore x = i8 ASTORE x
 
-istore_ ::  Word8 -> Generate ()
+istore_ :: Generator g => Word8 -> g ()
 istore_ x = i0 (ISTORE x)
-lstore_ ::  Word8 -> Generate ()
+lstore_ :: Generator g => Word8 -> g ()
 lstore_ x = i0 (LSTORE x)
-fstore_ ::  Word8 -> Generate ()
+fstore_ :: Generator g => Word8 -> g ()
 fstore_ x = i0 (FSTORE x)
-dstore_ ::  Word8 -> Generate ()
+dstore_ :: Generator g => Word8 -> g ()
 dstore_ x = i0 (DSTORE x)
-astore_ ::  Word8 -> Generate ()
+astore_ :: Generator g => Word8 -> g ()
 astore_ x = i0 (ASTORE x)
 
-iastore ::  Generate ()
+iastore :: Generator g => g ()
 iastore = i0 IASTORE
-lastore ::  Generate ()
+lastore :: Generator g => g ()
 lastore = i0 LASTORE
-fastore ::  Generate ()
+fastore :: Generator g => g ()
 fastore = i0 FASTORE
-dastore ::  Generate ()
+dastore :: Generator g => g ()
 dastore = i0 DASTORE
-aastore ::  Generate ()
+aastore :: Generator g => g ()
 aastore = i0 AASTORE
-bastore ::  Generate ()
+bastore :: Generator g => g ()
 bastore = i0 BASTORE
-castore ::  Generate ()
+castore :: Generator g => g ()
 castore = i0 CASTORE
-sastore ::  Generate ()
+sastore :: Generator g => g ()
 sastore = i0 SASTORE
 
-pop ::  Generate ()
+pop :: Generator g => g ()
 pop     = i0 POP    
-pop2 ::  Generate ()
+pop2 :: Generator g => g ()
 pop2    = i0 POP2   
-dup ::  Generate ()
+dup :: Generator g => g ()
 dup     = i0 DUP    
-dup_x1 ::  Generate ()
+dup_x1 :: Generator g => g ()
 dup_x1  = i0 DUP_X1 
-dup_x2 ::  Generate ()
+dup_x2 :: Generator g => g ()
 dup_x2  = i0 DUP_X2 
-dup2 ::  Generate ()
+dup2 :: Generator g => g ()
 dup2    = i0 DUP2   
-dup2_x1 ::  Generate ()
+dup2_x1 :: Generator g => g ()
 dup2_x1 = i0 DUP2_X1
-dup2_x2 ::  Generate ()
+dup2_x2 :: Generator g => g ()
 dup2_x2 = i0 DUP2_X2
-swap ::  Generate ()
+swap :: Generator g => g ()
 swap    = i0 SWAP   
-iadd ::  Generate ()
+iadd :: Generator g => g ()
 iadd    = i0 IADD   
-ladd ::  Generate ()
+ladd :: Generator g => g ()
 ladd    = i0 LADD   
-fadd ::  Generate ()
+fadd :: Generator g => g ()
 fadd    = i0 FADD   
-dadd ::  Generate ()
+dadd :: Generator g => g ()
 dadd    = i0 DADD   
-isub ::  Generate ()
+isub :: Generator g => g ()
 isub    = i0 ISUB   
-lsub ::  Generate ()
+lsub :: Generator g => g ()
 lsub    = i0 LSUB   
-fsub ::  Generate ()
+fsub :: Generator g => g ()
 fsub    = i0 FSUB   
-dsub ::  Generate ()
+dsub :: Generator g => g ()
 dsub    = i0 DSUB   
-imul ::  Generate ()
+imul :: Generator g => g ()
 imul    = i0 IMUL   
-lmul ::  Generate ()
+lmul :: Generator g => g ()
 lmul    = i0 LMUL   
-fmul ::  Generate ()
+fmul :: Generator g => g ()
 fmul    = i0 FMUL   
-dmul ::  Generate ()
+dmul :: Generator g => g ()
 dmul    = i0 DMUL   
-idiv ::  Generate ()
+idiv :: Generator g => g ()
 idiv    = i0 IDIV   
-ldiv ::  Generate ()
+ldiv :: Generator g => g ()
 ldiv    = i0 LDIV   
-fdiv ::  Generate ()
+fdiv :: Generator g => g ()
 fdiv    = i0 FDIV   
-ddiv ::  Generate ()
+ddiv :: Generator g => g ()
 ddiv    = i0 DDIV   
-irem ::  Generate ()
+irem :: Generator g => g ()
 irem    = i0 IREM   
-lrem ::  Generate ()
+lrem :: Generator g => g ()
 lrem    = i0 LREM   
-frem ::  Generate ()
+frem :: Generator g => g ()
 frem    = i0 FREM   
-drem ::  Generate ()
+drem :: Generator g => g ()
 drem    = i0 DREM   
-ineg ::  Generate ()
+ineg :: Generator g => g ()
 ineg    = i0 INEG   
-lneg ::  Generate ()
+lneg :: Generator g => g ()
 lneg    = i0 LNEG   
-fneg ::  Generate ()
+fneg :: Generator g => g ()
 fneg    = i0 FNEG   
-dneg ::  Generate ()
+dneg :: Generator g => g ()
 dneg    = i0 DNEG   
-ishl ::  Generate ()
+ishl :: Generator g => g ()
 ishl    = i0 ISHL   
-lshl ::  Generate ()
+lshl :: Generator g => g ()
 lshl    = i0 LSHL   
-ishr ::  Generate ()
+ishr :: Generator g => g ()
 ishr    = i0 ISHR   
-lshr ::  Generate ()
+lshr :: Generator g => g ()
 lshr    = i0 LSHR   
-iushr ::  Generate ()
+iushr :: Generator g => g ()
 iushr   = i0 IUSHR  
-lushr ::  Generate ()
+lushr :: Generator g => g ()
 lushr   = i0 LUSHR  
-iand ::  Generate ()
+iand :: Generator g => g ()
 iand    = i0 IAND   
-land ::  Generate ()
+land :: Generator g => g ()
 land    = i0 LAND   
-ior ::  Generate ()
+ior :: Generator g => g ()
 ior     = i0 IOR    
-lor ::  Generate ()
+lor :: Generator g => g ()
 lor     = i0 LOR    
-ixor ::  Generate ()
+ixor :: Generator g => g ()
 ixor    = i0 IXOR   
-lxor ::  Generate ()
+lxor :: Generator g => g ()
 lxor    = i0 LXOR   
 
-iinc ::  Word8 -> Word8 -> Generate ()
+iinc :: Generator g => Word8 -> Word8 -> g ()
 iinc x y = i0 (IINC x y)
 
-i2l ::  Generate ()
+i2l :: Generator g => g ()
 i2l  = i0 I2L 
-i2f ::  Generate ()
+i2f :: Generator g => g ()
 i2f  = i0 I2F 
-i2d ::  Generate ()
+i2d :: Generator g => g ()
 i2d  = i0 I2D 
-l2i ::  Generate ()
+l2i :: Generator g => g ()
 l2i  = i0 L2I 
-l2f ::  Generate ()
+l2f :: Generator g => g ()
 l2f  = i0 L2F 
-l2d ::  Generate ()
+l2d :: Generator g => g ()
 l2d  = i0 L2D 
-f2i ::  Generate ()
+f2i :: Generator g => g ()
 f2i  = i0 F2I 
-f2l ::  Generate ()
+f2l :: Generator g => g ()
 f2l  = i0 F2L 
-f2d ::  Generate ()
+f2d :: Generator g => g ()
 f2d  = i0 F2D 
-d2i ::  Generate ()
+d2i :: Generator g => g ()
 d2i  = i0 D2I 
-d2l ::  Generate ()
+d2l :: Generator g => g ()
 d2l  = i0 D2L 
-d2f ::  Generate ()
+d2f :: Generator g => g ()
 d2f  = i0 D2F 
-i2b ::  Generate ()
+i2b :: Generator g => g ()
 i2b  = i0 I2B 
-i2c ::  Generate ()
+i2c :: Generator g => g ()
 i2c  = i0 I2C 
-i2s ::  Generate ()
+i2s :: Generator g => g ()
 i2s  = i0 I2S 
-lcmp ::  Generate ()
+lcmp :: Generator g => g ()
 lcmp = i0 LCMP
 
 -- | Wide instruction
-wide :: (Word8 -> Instruction) -> Constant Direct -> Generate ()
+wide :: Generator g => (Word8 -> Instruction) -> Constant Direct -> g ()
 wide fn c = do
   ix <- addToPool c
   let ix0 = fromIntegral (ix `div` 0x100) :: Word8
       ix1 = fromIntegral (ix `mod` 0x100) :: Word8
   i0 (WIDE ix0 $ fn ix1)
 
-new ::  B.ByteString -> Generate ()
+new :: Generator g => B.ByteString -> g ()
 new cls =
   i1 NEW (CClass cls)
 
-newArray ::  ArrayType -> Generate ()
+newArray :: Generator g => ArrayType -> g ()
 newArray t =
   i0 (NEWARRAY $ atype2byte t)
 
-allocNewArray ::  B.ByteString -> Generate ()
+allocNewArray :: Generator g => B.ByteString -> g ()
 allocNewArray cls =
   i1 ANEWARRAY (CClass cls)
 
-invokeVirtual ::  B.ByteString -> NameType Method -> Generate ()
+invokeVirtual :: Generator g => B.ByteString -> NameType Method -> g ()
 invokeVirtual cls sig =
   i1 INVOKEVIRTUAL (CMethod cls sig)
 
-invokeStatic ::  B.ByteString -> NameType Method -> Generate ()
+invokeStatic :: Generator g => B.ByteString -> NameType Method -> g ()
 invokeStatic cls sig =
   i1 INVOKESTATIC (CMethod cls sig)
 
-invokeSpecial ::  B.ByteString -> NameType Method -> Generate ()
+invokeSpecial :: Generator g => B.ByteString -> NameType Method -> g ()
 invokeSpecial cls sig =
   i1 INVOKESPECIAL (CMethod cls sig)
 
-getStaticField ::  B.ByteString -> NameType Field -> Generate ()
+getStaticField :: Generator g => B.ByteString -> NameType Field -> g ()
 getStaticField cls sig =
   i1 GETSTATIC (CField cls sig)
 
-loadString ::  B.ByteString -> Generate ()
+loadString :: Generator g => B.ByteString -> g ()
 loadString str =
   i8 LDC1 (CString str)
 
-allocArray ::  B.ByteString -> Generate ()
+allocArray :: Generator g => B.ByteString -> g ()
 allocArray cls =
   i1 ANEWARRAY (CClass cls)
 

diff --git a/JVM/Builder/Monad.hs b/JVM/Builder/Monad.hs
index 005492fd95ba99f2b771736cd59e2e81df568b5b..1c44e929447035b5d271248d3289bde09e533bb7 100644 (file)
--- a/JVM/Builder/Monad.hs
+++ b/JVM/Builder/Monad.hs
@@ -1,17 +1,18 @@
-{-# LANGUAGE FlexibleContexts, TypeFamilies, OverloadedStrings #-}
+{-# LANGUAGE FlexibleContexts, TypeFamilies, OverloadedStrings, TypeSynonymInstances, FlexibleInstances #-}
 -- | This module defines Generate monad, which helps generating JVM code and
 -- creating Java class constants pool.
 module JVM.Builder.Monad
   (GState (..),
    emptyGState,
-   Generate,
+   Generator (..),
+   Generate, GenerateIO,
    addToPool,
    i0, i1, i8,
    newMethod,
    setStackSize, setMaxLocals,
    withClassPath,
    getClassField, getClassMethod,
-   generate
+   generate, generateIO
   ) where
 
 import Control.Monad.State as St
@@ -50,11 +51,19 @@ emptyGState = GState {
   locals = 0,
   classPath = []}
 
+class (Monad m, MonadState GState m) => Generator m where
+
 -- | Generate monad
-type Generate a = StateT GState IO a
+type GenerateIO a = StateT GState IO a
+
+type Generate a = State GState a
+
+instance Generator (StateT GState IO) where
+
+instance Generator (State GState) where
 
 -- | Update ClassPath
-withClassPath :: ClassPath () -> Generate ()
+withClassPath :: ClassPath () -> GenerateIO ()
 withClassPath cp = do
   res <- liftIO $ execClassPath cp
   st <- St.get
@@ -68,7 +77,7 @@ appendPool c pool =
   in  (pool', size)
 
 -- | Add a constant to pool
-addItem :: Constant Direct -> Generate Word16
+addItem :: (Generator g) => Constant Direct -> g Word16
 addItem c = do
   pool <- St.gets currentPool
   case lookupPool c pool of
@@ -84,7 +93,7 @@ lookupPool :: Constant Direct -> Pool Direct -> Maybe Word16
 lookupPool c pool =
   fromIntegral `fmap` findIndex (== c) (M.elems pool)
 
-addNT :: HasSignature a => NameType a -> Generate Word16
+addNT :: (Generator g, HasSignature a) => NameType a -> g Word16
 addNT (NameType name sig) = do
   let bsig = encode sig
   x <- addItem (CNameType name bsig)
@@ -92,13 +101,13 @@ addNT (NameType name sig) = do
   addItem (CUTF8 bsig)
   return x
 
-addSig :: MethodSignature -> Generate Word16
+addSig :: (Generator g) => MethodSignature -> g Word16
 addSig c@(MethodSignature args ret) = do
   let bsig = encode c
   addItem (CUTF8 bsig)
 
 -- | Add a constant into pool
-addToPool :: Constant Direct -> Generate Word16
+addToPool :: (Generator g) => Constant Direct -> g Word16
 addToPool c@(CClass str) = do
   addItem (CUTF8 str)
   addItem c
@@ -123,42 +132,42 @@ addToPool c@(CNameType name sig) = do
   addItem c
 addToPool c = addItem c
 
-putInstruction :: Instruction -> Generate ()
+putInstruction :: (Generator g) => Instruction -> g ()
 putInstruction instr = do
   st <- St.get
   let code = generated st
   St.put $ st {generated = code ++ [instr]}
 
 -- | Generate one (zero-arguments) instruction
-i0 :: Instruction -> Generate ()
+i0 :: (Generator g) => Instruction -> g ()
 i0 = putInstruction
 
 -- | Generate one one-argument instruction
-i1 :: (Word16 -> Instruction) -> Constant Direct -> Generate ()
+i1 :: (Generator g) => (Word16 -> Instruction) -> Constant Direct -> g ()
 i1 fn c = do
   ix <- addToPool c
   i0 (fn ix)
 
 -- | Generate one one-argument instruction
-i8 :: (Word8 -> Instruction) -> Constant Direct -> Generate ()
+i8 :: (Generator g) => (Word8 -> Instruction) -> Constant Direct -> g ()
 i8 fn c = do
   ix <- addToPool c
   i0 (fn $ fromIntegral ix)
 
 -- | Set maximum stack size for current method
-setStackSize :: Word16 -> Generate ()
+setStackSize :: (Generator g) => Word16 -> g ()
 setStackSize n = do
   st <- St.get
   St.put $ st {stackSize = n}
 
 -- | Set maximum number of local variables for current method
-setMaxLocals :: Word16 -> Generate ()
+setMaxLocals :: (Generator g) => Word16 -> g ()
 setMaxLocals n = do
   st <- St.get
   St.put $ st {locals = n}
 
 -- | Start generating new method
-startMethod :: [AccessFlag] -> B.ByteString -> MethodSignature -> Generate ()
+startMethod :: (Generator g) => [AccessFlag] -> B.ByteString -> MethodSignature -> g ()
 startMethod flags name sig = do
   addToPool (CString name)
   addSig sig
@@ -175,7 +184,7 @@ startMethod flags name sig = do
                currentMethod = Just method }
 
 -- | End of method generation
-endMethod :: Generate ()
+endMethod :: (Generator g) => g ()
 endMethod = do
   m <- St.gets currentMethod
   code <- St.gets genCode
@@ -190,12 +199,13 @@ endMethod = do
                    doneMethods = doneMethods st ++ [method']}
 
 -- | Generate new method
-newMethod :: [AccessFlag]               -- ^ Access flags for method (public, static etc)
+newMethod :: (Generator g)
+          => [AccessFlag]               -- ^ Access flags for method (public, static etc)
           -> B.ByteString               -- ^ Method name
           -> [ArgumentSignature]        -- ^ Signatures of method arguments
           -> ReturnSignature            -- ^ Method return signature
-          -> Generate ()                -- ^ Generator for method code
-          -> Generate (NameType Method)
+          -> g ()                -- ^ Generator for method code
+          -> g (NameType Method)
 newMethod flags name args ret gen = do
   let sig = MethodSignature args ret
   startMethod flags name sig
@@ -204,7 +214,7 @@ newMethod flags name args ret gen = do
   return (NameType name sig)
 
 -- | Get a class from current ClassPath
-getClass :: String -> Generate (Class Direct)
+getClass :: String -> GenerateIO (Class Direct)
 getClass name = do
   cp <- St.gets classPath
   res <- liftIO $ getEntry cp name
@@ -216,7 +226,7 @@ getClass name = do
     Nothing -> fail $ "No such class in ClassPath: " ++ name
 
 -- | Get class field signature from current ClassPath
-getClassField :: String -> B.ByteString -> Generate (NameType Field)
+getClassField :: String -> B.ByteString -> GenerateIO (NameType Field)
 getClassField clsName fldName = do
   cls <- getClass clsName
   case lookupField fldName cls of
@@ -224,7 +234,7 @@ getClassField clsName fldName = do
     Nothing  -> fail $ "No such field in class " ++ clsName ++ ": " ++ toString fldName
 
 -- | Get class method signature from current ClassPath
-getClassMethod :: String -> B.ByteString -> Generate (NameType Method)
+getClassMethod :: String -> B.ByteString -> GenerateIO (NameType Method)
 getClassMethod clsName mName = do
   cls <- getClass clsName
   case lookupMethod mName cls of
@@ -246,15 +256,15 @@ genCode st = Code {
     len = fromIntegral $ B.length $ encodeInstructions (generated st)
 
 -- | Start class generation.
-initClass :: B.ByteString -> Generate Word16
+initClass :: (Generator g) => B.ByteString -> g Word16
 initClass name = do
   addToPool (CClass "java/lang/Object")
   addToPool (CClass name)
   addToPool (CString "Code")
 
 -- | Generate a class
-generate :: [Tree CPEntry] -> B.ByteString -> Generate () -> IO (Class Direct)
-generate cp name gen = do
+generateIO :: [Tree CPEntry] -> B.ByteString -> GenerateIO () -> IO (Class Direct)
+generateIO cp name gen = do
   let generator = do
         initClass name
         gen
@@ -270,3 +280,21 @@ generate cp name gen = do
         classMethodsCount = fromIntegral $ length (doneMethods res),
         classMethods = doneMethods res }
 
+-- | Generate a class
+generate :: [Tree CPEntry] -> B.ByteString -> Generate () -> Class Direct
+generate cp name gen =
+  let generator = do
+        initClass name
+        gen
+      res = execState generator (emptyGState {classPath = cp})
+      code = genCode res
+      d = defaultClass :: Class Direct
+  in  d {
+        constsPoolSize = fromIntegral $ M.size (currentPool res),
+        constsPool = currentPool res,
+        accessFlags = S.fromList [ACC_PUBLIC, ACC_STATIC],
+        thisClass = name,
+        superClass = "java/lang/Object",
+        classMethodsCount = fromIntegral $ length (doneMethods res),
+        classMethods = doneMethods res }
+

diff --git a/JVM/Common.hs b/JVM/Common.hs
index 1b0e5eb022e012076f6605712d9e2538aefe0b57..301c40c433ea52b7a6e964aec521c088d0eb5589 100644 (file)
--- a/JVM/Common.hs
+++ b/JVM/Common.hs
@@ -8,14 +8,20 @@ module JVM.Common
   byteString
   ) where
 
+import Codec.Binary.UTF8.String (encodeString, decodeString)
 import Data.Binary
 import Data.Binary.Put
 import qualified Data.ByteString.Lazy as B
 import qualified Data.Map as M
 import Data.Default
+import Data.Char
+import Data.String
 
 import JVM.ClassFile
 
+instance IsString B.ByteString where
+  fromString s = B.pack $ map (fromIntegral . ord) $ encodeString s
+
 instance Default B.ByteString where
   def = B.empty
 

diff --git a/JVM/Converter.hs b/JVM/Converter.hs
index 0c26dd156c0e91afcf6c638106fc651ea9a53933..52b3483943995dd2e6ddb44e5a14bc2dfd36c18d 100644 (file)
--- a/JVM/Converter.hs
+++ b/JVM/Converter.hs
@@ -18,7 +18,6 @@ import Data.Bits
 import Data.Binary
 import Data.Default () -- import instances only
 import qualified Data.ByteString.Lazy as B
-import qualified Data.ByteString.Lazy.Char8 ()
 import qualified Data.Set as S
 import qualified Data.Map as M
 

diff --git a/TestGen.hs b/TestGen.hs
index f21912c58e863481124923c72bbb70eddac2dea5..31e71c0676ae0255d345a46d8ac1d6a502dd1dd5 100644 (file)
--- a/TestGen.hs
+++ b/TestGen.hs
@@ -11,7 +11,7 @@ import Java.ClassPath
 import qualified Java.Lang
 import qualified Java.IO
 
-test :: Generate ()
+test :: GenerateIO ()
 test = do
   withClassPath $ do
       -- Add current directory (with Hello.class) to ClassPath
@@ -63,6 +63,6 @@ test = do
 
 main :: IO ()
 main = do
-  testClass <- generate [] "Test" test
+  testClass <- generateIO [] "Test" test
   B.writeFile "Test.class" (encodeClass testClass)