MisterChaos69/MiniJavaCompiler
2
2
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

fixed method and name resolution typecheck

Browse Source
This commit is contained in:
Maybe Fabian Noll aber vielleicht auch nicht. Ist ein bisschen ne Glaubenssache :) 2024-05-07 16:34:34 +02:00
parent 358293d4d4
commit 8c3c3625b9
1 changed files with 32 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

51
src/Typecheck.hs
View File

@ -146,13 +146,10 @@ typeCheckExpression (BinaryOperation op expr1 expr2) symtab classes =
Just (Class _ _ fields) -> Just (Class _ _ fields) ->
let fieldTypes = [dt | VariableDeclaration dt id _ <- fields, id == member] let fieldTypes = [dt | VariableDeclaration dt id _ <- fields, id == member]
in case fieldTypes of in case fieldTypes of
[resolvedType] -> TypedExpression resolvedType (Reference member) [resolvedType] -> TypedExpression resolvedType (BinaryOperation NameResolution expr1' (TypedExpression resolvedType expr2))
[] -> error $ "Field '" ++ member ++ "' not found in class '" ++ objectType ++ "'" [] -> error $ "Field '" ++ member ++ "' not found in class '" ++ objectType ++ "'"
_ -> error $ "Ambiguous reference to field '" ++ member ++ "' in class '" ++ objectType ++ "'" _ -> error $ "Ambiguous reference to field '" ++ member ++ "' in class '" ++ objectType ++ "'"
Nothing -> error $ "Object '" ++ obj ++ "' does not correspond to a known class" Nothing -> error $ "Object '" ++ obj ++ "' does not correspond to a known class"
(TypedExpression t1 (Reference obj), StatementExpressionExpression (MethodCall methodName args)) ->
let objectType = lookupType obj symtab
in typeCheckExpression (checkMethod methodName args symtab classes objectType) symtab classes
_ -> error "Name resolution requires object reference and field name" _ -> error "Name resolution requires object reference and field name"
typeCheckExpression (UnaryOperation op expr) symtab classes = typeCheckExpression (UnaryOperation op expr) symtab classes =
@ -177,7 +174,7 @@ typeCheckExpression (StatementExpressionExpression stmtExpr) symtab classes =
in TypedExpression (getTypeFromStmtExpr stmtExpr') (StatementExpressionExpression stmtExpr') in TypedExpression (getTypeFromStmtExpr stmtExpr') (StatementExpressionExpression stmtExpr')
-- ********************************** Type Checking: StatementExpressions ********************************** -- ********************************** Type Checking: StatementExpressions **********************************
-- TODO: Implement type checking for StatementExpressions
typeCheckStatementExpression :: StatementExpression -> [(Identifier, DataType)] -> [Class] -> StatementExpression typeCheckStatementExpression :: StatementExpression -> [(Identifier, DataType)] -> [Class] -> StatementExpression
typeCheckStatementExpression (Assignment id expr) symtab classes = typeCheckStatementExpression (Assignment id expr) symtab classes =
let expr' = typeCheckExpression expr symtab classes let expr' = typeCheckExpression expr symtab classes
@ -213,15 +210,19 @@ typeCheckStatementExpression (ConstructorCall className args) symtab classes =
else else
TypedStatementExpression className (ConstructorCall className args') TypedStatementExpression className (ConstructorCall className args')
typeCheckStatementExpression (MethodCall methodName args) symtab classes = typeCheckStatementExpression (MethodCall expr methodName args) symtab classes =
case lookup methodName symtab of -- First, evaluate the object expression to find its type
Just className -> let objExprTyped = typeCheckExpression expr symtab classes
case find (\(Class name _ _) -> name == className) classes of in case objExprTyped of
TypedExpression objType _ ->
-- Look for the class of the object type to find the method
case find (\(Class className _ _) -> className == objType) classes of
Just (Class _ methods _) -> Just (Class _ methods _) ->
-- Find the method within the class
case find (\(MethodDeclaration retType name params _) -> name == methodName) methods of case find (\(MethodDeclaration retType name params _) -> name == methodName) methods of
Just (MethodDeclaration retType _ params _) -> Just (MethodDeclaration retType _ params _) ->
let -- Check arguments
args' = map (\arg -> typeCheckExpression arg symtab classes) args let args' = map (\arg -> typeCheckExpression arg symtab classes) args
expectedTypes = [dataType | ParameterDeclaration dataType _ <- params] expectedTypes = [dataType | ParameterDeclaration dataType _ <- params]
argTypes = map getTypeFromExpr args' argTypes = map getTypeFromExpr args'
typeMatches = zipWith (\expType argType -> (expType == argType, expType, argType)) expectedTypes argTypes typeMatches = zipWith (\expType argType -> (expType == argType, expType, argType)) expectedTypes argTypes
@ -229,15 +230,16 @@ typeCheckStatementExpression (MethodCall methodName args) symtab classes =
where fst3 (a, _, _) = a where fst3 (a, _, _) = a
in in
if null mismatches && length args == length params then if null mismatches && length args == length params then
TypedStatementExpression retType (MethodCall methodName args') TypedStatementExpression retType (MethodCall objExprTyped methodName args')
else if not (null mismatches) then else if not (null mismatches) then
error $ unlines $ ("Argument type mismatches for method '" ++ methodName ++ "':") error $ unlines $ ("Argument type mismatches for method '" ++ methodName ++ "':")
: [ "Expected: " ++ expType ++ ", Found: " ++ argType | (_, expType, argType) <- mismatches ] : [ "Expected: " ++ expType ++ ", Found: " ++ argType | (_, expType, argType) <- mismatches ]
else else
error $ "Incorrect number of arguments for method '" ++ methodName ++ "'. Expected " ++ show (length expectedTypes) ++ ", found " ++ show (length args) ++ "." error $ "Incorrect number of arguments for method '" ++ methodName ++ "'. Expected " ++ show (length expectedTypes) ++ ", found " ++ show (length args) ++ "."
Nothing -> error $ "Method '" ++ methodName ++ "' not found in class '" ++ className ++ "'." Nothing -> error $ "Method '" ++ methodName ++ "' not found in class '" ++ objType ++ "'."
Nothing -> error $ "Class '" ++ className ++ "' not found." Nothing -> error $ "Class for object type '" ++ objType ++ "' not found."
Nothing -> error $ "Method or class context for '" ++ methodName ++ "' not found in symbol table." _ -> error "Invalid object type for method call. Object must have a class type."
-- ********************************** Type Checking: Statements ********************************** -- ********************************** Type Checking: Statements **********************************
@ -337,22 +339,3 @@ lookupType id symtab =
case lookup id symtab of case lookup id symtab of
Just t -> t Just t -> t
Nothing -> error ("Identifier " ++ id ++ " not found in symbol table") Nothing -> error ("Identifier " ++ id ++ " not found in symbol table")
checkMethod :: Identifier -> [Expression] -> [(Identifier, DataType)] -> [Class] -> String -> Expression
checkMethod methodName args symtab classes objectType =
case find (\(Class className _ _) -> className == objectType) classes of
Just (Class _ methods _) ->
case find (\(MethodDeclaration retType name params _) -> name == methodName) methods of
Just (MethodDeclaration retType _ params _) ->
let
args' = map (\arg -> typeCheckExpression arg symtab classes) args
expectedTypes = [dataType | ParameterDeclaration dataType _ <- params]
argTypes = map getTypeFromExpr args'
typeMatches = all (uncurry (==)) (zip expectedTypes argTypes)
in
if typeMatches && length args == length params then
StatementExpressionExpression (TypedStatementExpression retType (MethodCall methodName args'))
else
error $ "Argument type mismatch for method '" ++ methodName ++ "' or incorrect number of arguments provided."
Nothing -> error $ "Method '" ++ methodName ++ "' not found in class '" ++ objectType ++ "'."
Nothing -> error $ "Class '" ++ objectType ++ "' not found."