From 907c7d06647c07e3c757a0b1709f1501f2575826 Mon Sep 17 00:00:00 2001 From: "Ilya V. Portnov" Date: Tue, 4 Oct 2011 17:07:33 +0600 Subject: [PATCH] Better error handling. --- JVM/Builder/Instructions.hs | 256 ++++++++++++++++++------------------ JVM/Builder/Monad.hs | 117 ++++++++++------ JVM/Common.hs | 2 +- JVM/Exceptions.hs | 33 +++++ TestGen.hs | 10 +- 5 files changed, 242 insertions(+), 176 deletions(-) diff --git a/JVM/Builder/Instructions.hs b/JVM/Builder/Instructions.hs index 0d85d97..8577a44 100644 --- 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 :: 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) diff --git a/JVM/Builder/Monad.hs b/JVM/Builder/Monad.hs index 1c44e92..f283eac 100644 --- a/JVM/Builder/Monad.hs +++ b/JVM/Builder/Monad.hs @@ -1,4 +1,4 @@ -{-# 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 @@ -15,7 +15,9 @@ 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 @@ -26,16 +28,17 @@ import qualified Data.ByteString.Lazy as B 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) @@ -51,19 +54,46 @@ emptyGState = GState { 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 @@ -77,7 +107,7 @@ appendPool c pool = 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 @@ -93,7 +123,7 @@ lookupPool :: Constant Direct -> Pool Direct -> Maybe Word16 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) @@ -101,13 +131,13 @@ addNT (NameType name sig) = do 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 @@ -132,42 +162,42 @@ addToPool c@(CNameType name sig) = do 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 @@ -184,12 +214,12 @@ startMethod flags name sig = do 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} @@ -199,13 +229,13 @@ endMethod = do 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 @@ -214,32 +244,35 @@ newMethod flags name args ret gen = do 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 @@ -256,19 +289,18 @@ genCode st = 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 { @@ -281,12 +313,11 @@ generateIO cp name gen = do 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 { diff --git a/JVM/Common.hs b/JVM/Common.hs index 301c40c..60eb9f2 100644 --- a/JVM/Common.hs +++ b/JVM/Common.hs @@ -8,7 +8,7 @@ module JVM.Common byteString ) where -import Codec.Binary.UTF8.String (encodeString, decodeString) +import Codec.Binary.UTF8.String (encodeString) import Data.Binary import Data.Binary.Put import qualified Data.ByteString.Lazy as B diff --git a/JVM/Exceptions.hs b/JVM/Exceptions.hs index b90db45..2d47af4 100644 --- a/JVM/Exceptions.hs +++ b/JVM/Exceptions.hs @@ -2,6 +2,9 @@ module JVM.Exceptions where import Control.Monad.Exception +import qualified Data.ByteString.Lazy as B + +import JVM.ClassFile data NoItemInPool = forall a. Show a => NoItemInPool a deriving (Typeable) @@ -11,6 +14,36 @@ instance Exception NoItemInPool instance Show NoItemInPool where show (NoItemInPool s) = "Internal error: no such item in pool: <" ++ show s ++ ">" +data UnexpectedEndMethod = UnexpectedEndMethod + deriving (Typeable) + +instance Show UnexpectedEndMethod where + show UnexpectedEndMethod = "endMethod without startMethod!" + +instance Exception UnexpectedEndMethod + +data ENotLoaded = ClassFileNotLoaded FilePath + | JARNotLoaded FilePath String + deriving (Typeable) + +instance Show ENotLoaded where + show (ClassFileNotLoaded p) = "Class file was not loaded: " ++ p + show (JARNotLoaded p c) = "Class was not loaded from JAR: " ++ p ++ ": " ++ c + +instance Exception ENotLoaded + +data ENotFound = ClassNotFound String + | FieldNotFound String B.ByteString + | MethodNotFound String B.ByteString + deriving (Typeable) + +instance Show ENotFound where + show (ClassNotFound p) = "No such class in ClassPath: " ++ p + show (FieldNotFound c f) = "No such field in class " ++ c ++ ": " ++ toString f + show (MethodNotFound c m) = "No such method in class " ++ c ++ ": " ++ toString m + +instance Exception ENotFound + force :: String -> EM AnyException a -> a force s x = case tryEM x of diff --git a/TestGen.hs b/TestGen.hs index 31e71c0..e0af50b 100644 --- a/TestGen.hs +++ b/TestGen.hs @@ -1,24 +1,26 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings, FlexibleContexts #-} +import Control.Monad.Exception import qualified Data.ByteString.Lazy as B import JVM.ClassFile import JVM.Converter import JVM.Assembler import JVM.Builder +import JVM.Exceptions import Java.ClassPath import qualified Java.Lang import qualified Java.IO -test :: GenerateIO () +test :: (Throws ENotFound e, Throws ENotLoaded e, Throws UnexpectedEndMethod e) => GenerateIO e () test = do withClassPath $ do -- Add current directory (with Hello.class) to ClassPath addDirectory "." - -- Load method signature: Hello.hello() - helloJava <- getClassMethod "./Hello" "hello" + -- Load method signature: Hello.hello() from Hello.class + helloJava <- getClassMethod "Hello" "hello" -- Initializer method. Just calls java.lang.Object. newMethod [ACC_PUBLIC] "" [] ReturnsVoid $ do -- 2.25.1