Add initial typechecker for AST #2

Merged
mrab merged 121 commits from typedAST into master 2024-06-14 07:53:30 +00:00
2 changed files with 26 additions and 3 deletions
Showing only changes of commit b095678769 - Show all commits

View File

@ -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,

View File

@ -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)