Add initial typechecker for AST #2
@ -51,7 +51,7 @@ data Operation = Opiadd
|
|||||||
| Opastore Word16
|
| Opastore Word16
|
||||||
| Opistore Word16
|
| Opistore Word16
|
||||||
| Opputfield Word16
|
| Opputfield Word16
|
||||||
| OpgetField Word16
|
| Opgetfield Word16
|
||||||
deriving (Show, Eq)
|
deriving (Show, Eq)
|
||||||
|
|
||||||
|
|
||||||
@ -118,7 +118,7 @@ opcodeEncodingLength (Opiload _) = 3
|
|||||||
opcodeEncodingLength (Opastore _) = 3
|
opcodeEncodingLength (Opastore _) = 3
|
||||||
opcodeEncodingLength (Opistore _) = 3
|
opcodeEncodingLength (Opistore _) = 3
|
||||||
opcodeEncodingLength (Opputfield _) = 3
|
opcodeEncodingLength (Opputfield _) = 3
|
||||||
opcodeEncodingLength (OpgetField _) = 3
|
opcodeEncodingLength (Opgetfield _) = 3
|
||||||
|
|
||||||
class Serializable a where
|
class Serializable a where
|
||||||
serialize :: a -> [Word8]
|
serialize :: a -> [Word8]
|
||||||
@ -168,7 +168,7 @@ instance Serializable Operation where
|
|||||||
serialize (Opastore index) = [0xC4, 0x3A] ++ unpackWord16 index
|
serialize (Opastore index) = [0xC4, 0x3A] ++ unpackWord16 index
|
||||||
serialize (Opistore index) = [0xC4, 0x36] ++ unpackWord16 index
|
serialize (Opistore index) = [0xC4, 0x36] ++ unpackWord16 index
|
||||||
serialize (Opputfield index) = 0xB5 : unpackWord16 index
|
serialize (Opputfield index) = 0xB5 : unpackWord16 index
|
||||||
serialize (OpgetField index) = 0xB4 : unpackWord16 index
|
serialize (Opgetfield index) = 0xB4 : unpackWord16 index
|
||||||
|
|
||||||
instance Serializable Attribute where
|
instance Serializable Attribute where
|
||||||
serialize (CodeAttribute { attributeMaxStack = maxStack,
|
serialize (CodeAttribute { attributeMaxStack = maxStack,
|
||||||
|
@ -37,6 +37,24 @@ methodParameterDescriptor x = "L" ++ x ++ ";"
|
|||||||
memberInfoIsMethod :: [ConstantInfo] -> MemberInfo -> Bool
|
memberInfoIsMethod :: [ConstantInfo] -> MemberInfo -> Bool
|
||||||
memberInfoIsMethod constants info = elem '(' (memberInfoDescriptor constants info)
|
memberInfoIsMethod constants info = elem '(' (memberInfoDescriptor constants info)
|
||||||
|
|
||||||
|
findFieldIndex :: [ConstantInfo] -> String -> Maybe Int
|
||||||
|
findFieldIndex constants name = let
|
||||||
|
fieldRefNameInfos = [
|
||||||
|
-- we only skip one entry to get the name since the Java constant pool
|
||||||
|
-- is 1-indexed (why)
|
||||||
|
(index, constants!!(fromIntegral index + 1))
|
||||||
|
| (index, FieldRefInfo _ _) <- (zip [1..] constants)
|
||||||
|
]
|
||||||
|
fieldRefNames = map (\(index, nameInfo) -> case nameInfo of
|
||||||
|
Utf8Info fieldName -> (index, fieldName)
|
||||||
|
something_else -> error ("Expected UTF8Info but got" ++ show something_else))
|
||||||
|
fieldRefNameInfos
|
||||||
|
fieldIndex = find (\(index, fieldName) -> fieldName == name) fieldRefNames
|
||||||
|
in case fieldIndex of
|
||||||
|
Just (index, _) -> Just index
|
||||||
|
Nothing -> Nothing
|
||||||
|
|
||||||
|
|
||||||
findMethodIndex :: ClassFile -> String -> Maybe Int
|
findMethodIndex :: ClassFile -> String -> Maybe Int
|
||||||
findMethodIndex classFile name = let
|
findMethodIndex classFile name = let
|
||||||
constants = constantPool classFile
|
constants = constantPool classFile
|
||||||
@ -271,3 +289,8 @@ assembleExpression (constants, ops) (TypedExpression _ (UnaryOperation Minus exp
|
|||||||
(exprConstants, exprOps) = assembleExpression (constants, ops) expr
|
(exprConstants, exprOps) = assembleExpression (constants, ops) expr
|
||||||
in
|
in
|
||||||
(exprConstants, exprOps ++ [Opineg])
|
(exprConstants, exprOps ++ [Opineg])
|
||||||
|
assembleExpression (constants, ops) (TypedExpression _ (FieldVariable name)) = let
|
||||||
|
fieldIndex = findFieldIndex constants name
|
||||||
|
in case fieldIndex of
|
||||||
|
Just index -> (constants, ops ++ [Opaload 0, Opgetfield (fromIntegral index)])
|
||||||
|
Nothing -> error ("No such field found in constant pool: " ++ name)
|
||||||
|
Loading…
Reference in New Issue
Block a user