import JVM.Assembler
import JVM.Builder.Monad
-nop :: Generator g => g ()
+nop :: Generator e g => g e ()
nop = i0 NOP
-aconst_null :: Generator g => g ()
+aconst_null :: Generator e g => g e ()
aconst_null = i0 ACONST_NULL
-iconst_m1 :: Generator g => g ()
+iconst_m1 :: Generator e g => g e ()
iconst_m1 = i0 ICONST_M1
-iconst_0 :: Generator g => g ()
+iconst_0 :: Generator e g => g e ()
iconst_0 = i0 ICONST_0
-iconst_1 :: Generator g => g ()
+iconst_1 :: Generator e g => g e ()
iconst_1 = i0 ICONST_1
-iconst_2 :: Generator g => g ()
+iconst_2 :: Generator e g => g e ()
iconst_2 = i0 ICONST_2
-iconst_3 :: Generator g => g ()
+iconst_3 :: Generator e g => g e ()
iconst_3 = i0 ICONST_3
-iconst_4 :: Generator g => g ()
+iconst_4 :: Generator e g => g e ()
iconst_4 = i0 ICONST_4
-iconst_5 :: Generator g => g ()
+iconst_5 :: Generator e g => g e ()
iconst_5 = i0 ICONST_5
-lconst_0 :: Generator g => g ()
+lconst_0 :: Generator e g => g e ()
lconst_0 = i0 LCONST_0
-lconst_1 :: Generator g => g ()
+lconst_1 :: Generator e g => g e ()
lconst_1 = i0 LCONST_1
-fconst_0 :: Generator g => g ()
+fconst_0 :: Generator e g => g e ()
fconst_0 = i0 FCONST_0
-fconst_1 :: Generator g => g ()
+fconst_1 :: Generator e g => g e ()
fconst_1 = i0 FCONST_1
-fconst_2 :: Generator g => g ()
+fconst_2 :: Generator e g => g e ()
fconst_2 = i0 FCONST_2
-dconst_0 :: Generator g => g ()
+dconst_0 :: Generator e g => g e ()
dconst_0 = i0 DCONST_0
-dconst_1 :: Generator g => g ()
+dconst_1 :: Generator e g => g e ()
dconst_1 = i0 DCONST_1
-bipush :: Generator g => Word8 -> g ()
+bipush :: Generator e g => Word8 -> g e ()
bipush x = i0 (BIPUSH x)
-sipush :: Generator g => Word16 -> g ()
+sipush :: Generator e g => Word16 -> g e ()
sipush x = i0 (SIPUSH x)
-ldc1 :: Generator g => Constant Direct -> g ()
+ldc1 :: Generator e g => Constant Direct -> g e ()
ldc1 x = i8 LDC1 x
-ldc2 :: Generator g => Constant Direct -> g ()
+ldc2 :: Generator e g => Constant Direct -> g e ()
ldc2 x = i1 LDC2 x
-ldc2w :: Generator g => Constant Direct -> g ()
+ldc2w :: Generator e g => Constant Direct -> g e ()
ldc2w x = i1 LDC2W x
-iload :: Generator g => Constant Direct -> g ()
+iload :: Generator e g => Constant Direct -> g e ()
iload x = i8 ILOAD x
-lload :: Generator g => Constant Direct -> g ()
+lload :: Generator e g => Constant Direct -> g e ()
lload x = i8 LLOAD x
-fload :: Generator g => Constant Direct -> g ()
+fload :: Generator e g => Constant Direct -> g e ()
fload x = i8 FLOAD x
-dload :: Generator g => Constant Direct -> g ()
+dload :: Generator e g => Constant Direct -> g e ()
dload x = i8 DLOAD x
-aload :: Generator g => Constant Direct -> g ()
+aload :: Generator e g => Constant Direct -> g e ()
aload x = i8 ALOAD x
-iload_ :: Generator g => IMM -> g ()
+iload_ :: Generator e g => IMM -> g e ()
iload_ x = i0 (ILOAD_ x)
-lload_ :: Generator g => IMM -> g ()
+lload_ :: Generator e g => IMM -> g e ()
lload_ x = i0 (LLOAD_ x)
-fload_ :: Generator g => IMM -> g ()
+fload_ :: Generator e g => IMM -> g e ()
fload_ x = i0 (FLOAD_ x)
-dload_ :: Generator g => IMM -> g ()
+dload_ :: Generator e g => IMM -> g e ()
dload_ x = i0 (DLOAD_ x)
-aload_ :: Generator g => IMM -> g ()
+aload_ :: Generator e g => IMM -> g e ()
aload_ x = i0 (ALOAD_ x)
-iaload :: Generator g => g ()
+iaload :: Generator e g => g e ()
iaload = i0 IALOAD
-laload :: Generator g => g ()
+laload :: Generator e g => g e ()
laload = i0 LALOAD
-faload :: Generator g => g ()
+faload :: Generator e g => g e ()
faload = i0 FALOAD
-daload :: Generator g => g ()
+daload :: Generator e g => g e ()
daload = i0 DALOAD
-aaload :: Generator g => g ()
+aaload :: Generator e g => g e ()
aaload = i0 AALOAD
-caload :: Generator g => g ()
+caload :: Generator e g => g e ()
caload = i0 CALOAD
-saload :: Generator g => g ()
+saload :: Generator e g => g e ()
saload = i0 SALOAD
-istore :: Generator g => Constant Direct -> g ()
+istore :: Generator e g => Constant Direct -> g e ()
istore x = i8 ISTORE x
-lstore :: Generator g => Constant Direct -> g ()
+lstore :: Generator e g => Constant Direct -> g e ()
lstore x = i8 LSTORE x
-fstore :: Generator g => Constant Direct -> g ()
+fstore :: Generator e g => Constant Direct -> g e ()
fstore x = i8 FSTORE x
-dstore :: Generator g => Constant Direct -> g ()
+dstore :: Generator e g => Constant Direct -> g e ()
dstore x = i8 DSTORE x
-astore :: Generator g => Constant Direct -> g ()
+astore :: Generator e g => Constant Direct -> g e ()
astore x = i8 ASTORE x
-istore_ :: Generator g => Word8 -> g ()
+istore_ :: Generator e g => Word8 -> g e ()
istore_ x = i0 (ISTORE x)
-lstore_ :: Generator g => Word8 -> g ()
+lstore_ :: Generator e g => Word8 -> g e ()
lstore_ x = i0 (LSTORE x)
-fstore_ :: Generator g => Word8 -> g ()
+fstore_ :: Generator e g => Word8 -> g e ()
fstore_ x = i0 (FSTORE x)
-dstore_ :: Generator g => Word8 -> g ()
+dstore_ :: Generator e g => Word8 -> g e ()
dstore_ x = i0 (DSTORE x)
-astore_ :: Generator g => Word8 -> g ()
+astore_ :: Generator e g => Word8 -> g e ()
astore_ x = i0 (ASTORE x)
-iastore :: Generator g => g ()
+iastore :: Generator e g => g e ()
iastore = i0 IASTORE
-lastore :: Generator g => g ()
+lastore :: Generator e g => g e ()
lastore = i0 LASTORE
-fastore :: Generator g => g ()
+fastore :: Generator e g => g e ()
fastore = i0 FASTORE
-dastore :: Generator g => g ()
+dastore :: Generator e g => g e ()
dastore = i0 DASTORE
-aastore :: Generator g => g ()
+aastore :: Generator e g => g e ()
aastore = i0 AASTORE
-bastore :: Generator g => g ()
+bastore :: Generator e g => g e ()
bastore = i0 BASTORE
-castore :: Generator g => g ()
+castore :: Generator e g => g e ()
castore = i0 CASTORE
-sastore :: Generator g => g ()
+sastore :: Generator e g => g e ()
sastore = i0 SASTORE
-pop :: Generator g => g ()
+pop :: Generator e g => g e ()
pop = i0 POP
-pop2 :: Generator g => g ()
+pop2 :: Generator e g => g e ()
pop2 = i0 POP2
-dup :: Generator g => g ()
+dup :: Generator e g => g e ()
dup = i0 DUP
-dup_x1 :: Generator g => g ()
+dup_x1 :: Generator e g => g e ()
dup_x1 = i0 DUP_X1
-dup_x2 :: Generator g => g ()
+dup_x2 :: Generator e g => g e ()
dup_x2 = i0 DUP_X2
-dup2 :: Generator g => g ()
+dup2 :: Generator e g => g e ()
dup2 = i0 DUP2
-dup2_x1 :: Generator g => g ()
+dup2_x1 :: Generator e g => g e ()
dup2_x1 = i0 DUP2_X1
-dup2_x2 :: Generator g => g ()
+dup2_x2 :: Generator e g => g e ()
dup2_x2 = i0 DUP2_X2
-swap :: Generator g => g ()
+swap :: Generator e g => g e ()
swap = i0 SWAP
-iadd :: Generator g => g ()
+iadd :: Generator e g => g e ()
iadd = i0 IADD
-ladd :: Generator g => g ()
+ladd :: Generator e g => g e ()
ladd = i0 LADD
-fadd :: Generator g => g ()
+fadd :: Generator e g => g e ()
fadd = i0 FADD
-dadd :: Generator g => g ()
+dadd :: Generator e g => g e ()
dadd = i0 DADD
-isub :: Generator g => g ()
+isub :: Generator e g => g e ()
isub = i0 ISUB
-lsub :: Generator g => g ()
+lsub :: Generator e g => g e ()
lsub = i0 LSUB
-fsub :: Generator g => g ()
+fsub :: Generator e g => g e ()
fsub = i0 FSUB
-dsub :: Generator g => g ()
+dsub :: Generator e g => g e ()
dsub = i0 DSUB
-imul :: Generator g => g ()
+imul :: Generator e g => g e ()
imul = i0 IMUL
-lmul :: Generator g => g ()
+lmul :: Generator e g => g e ()
lmul = i0 LMUL
-fmul :: Generator g => g ()
+fmul :: Generator e g => g e ()
fmul = i0 FMUL
-dmul :: Generator g => g ()
+dmul :: Generator e g => g e ()
dmul = i0 DMUL
-idiv :: Generator g => g ()
+idiv :: Generator e g => g e ()
idiv = i0 IDIV
-ldiv :: Generator g => g ()
+ldiv :: Generator e g => g e ()
ldiv = i0 LDIV
-fdiv :: Generator g => g ()
+fdiv :: Generator e g => g e ()
fdiv = i0 FDIV
-ddiv :: Generator g => g ()
+ddiv :: Generator e g => g e ()
ddiv = i0 DDIV
-irem :: Generator g => g ()
+irem :: Generator e g => g e ()
irem = i0 IREM
-lrem :: Generator g => g ()
+lrem :: Generator e g => g e ()
lrem = i0 LREM
-frem :: Generator g => g ()
+frem :: Generator e g => g e ()
frem = i0 FREM
-drem :: Generator g => g ()
+drem :: Generator e g => g e ()
drem = i0 DREM
-ineg :: Generator g => g ()
+ineg :: Generator e g => g e ()
ineg = i0 INEG
-lneg :: Generator g => g ()
+lneg :: Generator e g => g e ()
lneg = i0 LNEG
-fneg :: Generator g => g ()
+fneg :: Generator e g => g e ()
fneg = i0 FNEG
-dneg :: Generator g => g ()
+dneg :: Generator e g => g e ()
dneg = i0 DNEG
-ishl :: Generator g => g ()
+ishl :: Generator e g => g e ()
ishl = i0 ISHL
-lshl :: Generator g => g ()
+lshl :: Generator e g => g e ()
lshl = i0 LSHL
-ishr :: Generator g => g ()
+ishr :: Generator e g => g e ()
ishr = i0 ISHR
-lshr :: Generator g => g ()
+lshr :: Generator e g => g e ()
lshr = i0 LSHR
-iushr :: Generator g => g ()
+iushr :: Generator e g => g e ()
iushr = i0 IUSHR
-lushr :: Generator g => g ()
+lushr :: Generator e g => g e ()
lushr = i0 LUSHR
-iand :: Generator g => g ()
+iand :: Generator e g => g e ()
iand = i0 IAND
-land :: Generator g => g ()
+land :: Generator e g => g e ()
land = i0 LAND
-ior :: Generator g => g ()
+ior :: Generator e g => g e ()
ior = i0 IOR
-lor :: Generator g => g ()
+lor :: Generator e g => g e ()
lor = i0 LOR
-ixor :: Generator g => g ()
+ixor :: Generator e g => g e ()
ixor = i0 IXOR
-lxor :: Generator g => g ()
+lxor :: Generator e g => g e ()
lxor = i0 LXOR
-iinc :: Generator g => Word8 -> Word8 -> g ()
+iinc :: Generator e g => Word8 -> Word8 -> g e ()
iinc x y = i0 (IINC x y)
-i2l :: Generator g => g ()
+i2l :: Generator e g => g e ()
i2l = i0 I2L
-i2f :: Generator g => g ()
+i2f :: Generator e g => g e ()
i2f = i0 I2F
-i2d :: Generator g => g ()
+i2d :: Generator e g => g e ()
i2d = i0 I2D
-l2i :: Generator g => g ()
+l2i :: Generator e g => g e ()
l2i = i0 L2I
-l2f :: Generator g => g ()
+l2f :: Generator e g => g e ()
l2f = i0 L2F
-l2d :: Generator g => g ()
+l2d :: Generator e g => g e ()
l2d = i0 L2D
-f2i :: Generator g => g ()
+f2i :: Generator e g => g e ()
f2i = i0 F2I
-f2l :: Generator g => g ()
+f2l :: Generator e g => g e ()
f2l = i0 F2L
-f2d :: Generator g => g ()
+f2d :: Generator e g => g e ()
f2d = i0 F2D
-d2i :: Generator g => g ()
+d2i :: Generator e g => g e ()
d2i = i0 D2I
-d2l :: Generator g => g ()
+d2l :: Generator e g => g e ()
d2l = i0 D2L
-d2f :: Generator g => g ()
+d2f :: Generator e g => g e ()
d2f = i0 D2F
-i2b :: Generator g => g ()
+i2b :: Generator e g => g e ()
i2b = i0 I2B
-i2c :: Generator g => g ()
+i2c :: Generator e g => g e ()
i2c = i0 I2C
-i2s :: Generator g => g ()
+i2s :: Generator e g => g e ()
i2s = i0 I2S
-lcmp :: Generator g => g ()
+lcmp :: Generator e g => g e ()
lcmp = i0 LCMP
-- | Wide instruction
-wide :: Generator g => (Word8 -> Instruction) -> Constant Direct -> g ()
+wide :: Generator e g => (Word8 -> Instruction) -> Constant Direct -> g e ()
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 :: Generator g => B.ByteString -> g ()
+new :: Generator e g => B.ByteString -> g e ()
new cls =
i1 NEW (CClass cls)
-newArray :: Generator g => ArrayType -> g ()
+newArray :: Generator e g => ArrayType -> g e ()
newArray t =
i0 (NEWARRAY $ atype2byte t)
-allocNewArray :: Generator g => B.ByteString -> g ()
+allocNewArray :: Generator e g => B.ByteString -> g e ()
allocNewArray cls =
i1 ANEWARRAY (CClass cls)
-invokeVirtual :: Generator g => B.ByteString -> NameType Method -> g ()
+invokeVirtual :: Generator e g => B.ByteString -> NameType Method -> g e ()
invokeVirtual cls sig =
i1 INVOKEVIRTUAL (CMethod cls sig)
-invokeStatic :: Generator g => B.ByteString -> NameType Method -> g ()
+invokeStatic :: Generator e g => B.ByteString -> NameType Method -> g e ()
invokeStatic cls sig =
i1 INVOKESTATIC (CMethod cls sig)
-invokeSpecial :: Generator g => B.ByteString -> NameType Method -> g ()
+invokeSpecial :: Generator e g => B.ByteString -> NameType Method -> g e ()
invokeSpecial cls sig =
i1 INVOKESPECIAL (CMethod cls sig)
-getStaticField :: Generator g => B.ByteString -> NameType Field -> g ()
+getStaticField :: Generator e g => B.ByteString -> NameType Field -> g e ()
getStaticField cls sig =
i1 GETSTATIC (CField cls sig)
-loadString :: Generator g => B.ByteString -> g ()
+loadString :: Generator e g => B.ByteString -> g e ()
loadString str =
i8 LDC1 (CString str)
-allocArray :: Generator g => B.ByteString -> g ()
+allocArray :: Generator e g => B.ByteString -> g e ()
allocArray cls =
i1 ANEWARRAY (CClass cls)
-{-# LANGUAGE FlexibleContexts, TypeFamilies, OverloadedStrings, TypeSynonymInstances, FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts, TypeFamilies, OverloadedStrings, TypeSynonymInstances, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances, GeneralizedNewtypeDeriving, ScopedTypeVariables #-}
-- | This module defines Generate monad, which helps generating JVM code and
-- creating Java class constants pool.
module JVM.Builder.Monad
generate, generateIO
) where
+import Prelude hiding (catch)
import Control.Monad.State as St
+import Control.Monad.Exception
import Data.Word
import Data.List
import Data.Binary
import JVM.Common () -- import instances only
import JVM.ClassFile
import JVM.Assembler
+import JVM.Exceptions
import Java.ClassPath
-- | Generator state
data GState = GState {
- generated :: [Instruction], -- ^ Already generated code (in current method)
+ generated :: [Instruction], -- ^ Already generated code (in current method)
currentPool :: Pool Direct, -- ^ Already generated constants pool
doneMethods :: [Method Direct], -- ^ Already generated class methods
currentMethod :: Maybe (Method Direct), -- ^ Current method
- stackSize :: Word16, -- ^ Maximum stack size for current method
- locals :: Word16, -- ^ Maximum number of local variables for current method
+ stackSize :: Word16, -- ^ Maximum stack size for current method
+ locals :: Word16, -- ^ Maximum number of local variables for current method
classPath :: [Tree CPEntry]
}
deriving (Eq,Show)
locals = 0,
classPath = []}
-class (Monad m, MonadState GState m) => Generator m where
+class (Monad (g e), MonadState GState (g e)) => Generator e g where
+ throwG :: (Exception x, Throws x e) => x -> g e a
-- | Generate monad
-type GenerateIO a = StateT GState IO a
+newtype Generate e a = Generate {
+ runGenerate :: EMT e (State GState) a }
+ deriving (Monad, MonadState GState)
-type Generate a = State GState a
+instance MonadState st (EMT e (StateT st IO)) where
+ get = lift St.get
+ put x = lift (St.put x)
-instance Generator (StateT GState IO) where
+instance MonadState st (EMT e (State st)) where
+ get = lift St.get
+ put x = lift (St.put x)
-instance Generator (State GState) where
+-- | IO version of Generate monad
+newtype GenerateIO e a = GenerateIO {
+ runGenerateIO :: EMT e (StateT GState IO) a }
+ deriving (Monad, MonadState GState, MonadIO)
+
+instance MonadIO (EMT e (StateT GState IO)) where
+ liftIO action = lift $ liftIO action
+
+instance Generator e GenerateIO where
+ throwG e = GenerateIO (throw e)
+
+instance (MonadState GState (EMT e (State GState))) => Generator e Generate where
+ throwG e = Generate (throw e)
+
+execGenerateIO cp (GenerateIO emt) = do
+ let caught = emt `catch` (\(e :: SomeException) -> fail $ show e)
+ execStateT (runEMT caught) (emptyGState {classPath = cp})
+
+execGenerate cp (Generate emt) = do
+ let caught = emt `catch` (\(e :: SomeException) -> fail $ show e)
+ execState (runEMT caught) (emptyGState {classPath = cp})
-- | Update ClassPath
-withClassPath :: ClassPath () -> GenerateIO ()
+withClassPath :: ClassPath () -> GenerateIO e ()
withClassPath cp = do
res <- liftIO $ execClassPath cp
st <- St.get
in (pool', size)
-- | Add a constant to pool
-addItem :: (Generator g) => Constant Direct -> g Word16
+addItem :: (Generator e g) => Constant Direct -> g e Word16
addItem c = do
pool <- St.gets currentPool
case lookupPool c pool of
lookupPool c pool =
fromIntegral `fmap` findIndex (== c) (M.elems pool)
-addNT :: (Generator g, HasSignature a) => NameType a -> g Word16
+addNT :: (Generator e g, HasSignature a) => NameType a -> g e Word16
addNT (NameType name sig) = do
let bsig = encode sig
x <- addItem (CNameType name bsig)
addItem (CUTF8 bsig)
return x
-addSig :: (Generator g) => MethodSignature -> g Word16
+addSig :: (Generator e g) => MethodSignature -> g e Word16
addSig c@(MethodSignature args ret) = do
let bsig = encode c
addItem (CUTF8 bsig)
-- | Add a constant into pool
-addToPool :: (Generator g) => Constant Direct -> g Word16
+addToPool :: (Generator e g) => Constant Direct -> g e Word16
addToPool c@(CClass str) = do
addItem (CUTF8 str)
addItem c
addItem c
addToPool c = addItem c
-putInstruction :: (Generator g) => Instruction -> g ()
+putInstruction :: (Generator e g) => Instruction -> g e ()
putInstruction instr = do
st <- St.get
let code = generated st
St.put $ st {generated = code ++ [instr]}
-- | Generate one (zero-arguments) instruction
-i0 :: (Generator g) => Instruction -> g ()
+i0 :: (Generator e g) => Instruction -> g e ()
i0 = putInstruction
-- | Generate one one-argument instruction
-i1 :: (Generator g) => (Word16 -> Instruction) -> Constant Direct -> g ()
+i1 :: (Generator e g) => (Word16 -> Instruction) -> Constant Direct -> g e ()
i1 fn c = do
ix <- addToPool c
i0 (fn ix)
-- | Generate one one-argument instruction
-i8 :: (Generator g) => (Word8 -> Instruction) -> Constant Direct -> g ()
+i8 :: (Generator e g) => (Word8 -> Instruction) -> Constant Direct -> g e ()
i8 fn c = do
ix <- addToPool c
i0 (fn $ fromIntegral ix)
-- | Set maximum stack size for current method
-setStackSize :: (Generator g) => Word16 -> g ()
+setStackSize :: (Generator e g) => Word16 -> g e ()
setStackSize n = do
st <- St.get
St.put $ st {stackSize = n}
-- | Set maximum number of local variables for current method
-setMaxLocals :: (Generator g) => Word16 -> g ()
+setMaxLocals :: (Generator e g) => Word16 -> g e ()
setMaxLocals n = do
st <- St.get
St.put $ st {locals = n}
-- | Start generating new method
-startMethod :: (Generator g) => [AccessFlag] -> B.ByteString -> MethodSignature -> g ()
+startMethod :: (Generator e g) => [AccessFlag] -> B.ByteString -> MethodSignature -> g e ()
startMethod flags name sig = do
addToPool (CString name)
addSig sig
currentMethod = Just method }
-- | End of method generation
-endMethod :: (Generator g) => g ()
+endMethod :: (Generator e g, Throws UnexpectedEndMethod e) => g e ()
endMethod = do
m <- St.gets currentMethod
code <- St.gets genCode
case m of
- Nothing -> fail "endMethod without startMethod!"
+ Nothing -> throwG UnexpectedEndMethod
Just method -> do
let method' = method {methodAttributes = AR $ M.fromList [("Code", encodeMethod code)],
methodAttributesCount = 1}
doneMethods = doneMethods st ++ [method']}
-- | Generate new method
-newMethod :: (Generator g)
- => [AccessFlag] -- ^ Access flags for method (public, static etc)
- -> B.ByteString -- ^ Method name
- -> [ArgumentSignature] -- ^ Signatures of method arguments
- -> ReturnSignature -- ^ Method return signature
- -> g () -- ^ Generator for method code
- -> g (NameType Method)
+newMethod :: (Generator e g, Throws UnexpectedEndMethod e)
+ => [AccessFlag] -- ^ Access flags for method (public, static etc)
+ -> B.ByteString -- ^ Method name
+ -> [ArgumentSignature] -- ^ Signatures of method arguments
+ -> ReturnSignature -- ^ Method return signature
+ -> g e () -- ^ Generator for method code
+ -> g e (NameType Method)
newMethod flags name args ret gen = do
let sig = MethodSignature args ret
startMethod flags name sig
return (NameType name sig)
-- | Get a class from current ClassPath
-getClass :: String -> GenerateIO (Class Direct)
+getClass :: (Throws ENotLoaded e, Throws ENotFound e)
+ => String -> GenerateIO e (Class Direct)
getClass name = do
cp <- St.gets classPath
res <- liftIO $ getEntry cp name
case res of
- Just (NotLoaded p) -> fail $ "Class file was not loaded: " ++ p
+ Just (NotLoaded p) -> throwG (ClassFileNotLoaded p)
Just (Loaded _ c) -> return c
- Just (NotLoadedJAR p c) -> fail $ "Class was not loaded from JAR " ++ p ++ ": " ++ c
+ Just (NotLoadedJAR p c) -> throwG (JARNotLoaded p c)
Just (LoadedJAR _ c) -> return c
- Nothing -> fail $ "No such class in ClassPath: " ++ name
+ Nothing -> throwG (ClassNotFound name)
-- | Get class field signature from current ClassPath
-getClassField :: String -> B.ByteString -> GenerateIO (NameType Field)
+getClassField :: (Throws ENotFound e, Throws ENotLoaded e)
+ => String -> B.ByteString -> GenerateIO e (NameType Field)
getClassField clsName fldName = do
cls <- getClass clsName
case lookupField fldName cls of
Just fld -> return (fieldNameType fld)
- Nothing -> fail $ "No such field in class " ++ clsName ++ ": " ++ toString fldName
+ Nothing -> throwG (FieldNotFound clsName fldName)
-- | Get class method signature from current ClassPath
-getClassMethod :: String -> B.ByteString -> GenerateIO (NameType Method)
+getClassMethod :: (Throws ENotFound e, Throws ENotLoaded e)
+ => String -> B.ByteString -> GenerateIO e (NameType Method)
getClassMethod clsName mName = do
cls <- getClass clsName
case lookupMethod mName cls of
Just m -> return (methodNameType m)
- Nothing -> fail $ "No such method in class " ++ clsName ++ ": " ++ toString mName
+ Nothing -> throwG (MethodNotFound clsName mName)
-- | Convert Generator state to method Code.
genCode :: GState -> Code
len = fromIntegral $ B.length $ encodeInstructions (generated st)
-- | Start class generation.
-initClass :: (Generator g) => B.ByteString -> g Word16
+initClass :: (Generator e g) => B.ByteString -> g e Word16
initClass name = do
addToPool (CClass "java/lang/Object")
addToPool (CClass name)
addToPool (CString "Code")
-- | Generate a class
-generateIO :: [Tree CPEntry] -> B.ByteString -> GenerateIO () -> IO (Class Direct)
generateIO cp name gen = do
let generator = do
initClass name
gen
- res <- execStateT generator (emptyGState {classPath = cp})
+ res <- execGenerateIO cp generator
let code = genCode res
d = defaultClass :: Class Direct
return $ d {
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})
+ res = execGenerate cp generator
code = genCode res
d = defaultClass :: Class Direct
in d {
projects / hs-java.git / commitdiff