From 8c3c3625b9f7affa8bfbfa2025709a3444b79e2c Mon Sep 17 00:00:00 2001 From: MisterChaos96 Date: Tue, 7 May 2024 16:34:34 +0200 Subject: [PATCH] fixed method and name resolution typecheck --- src/Typecheck.hs | 81 +++++++++++++++++++----------------------------- 1 file changed, 32 insertions(+), 49 deletions(-) diff --git a/src/Typecheck.hs b/src/Typecheck.hs index 5b3eddf..61aa87e 100644 --- a/src/Typecheck.hs +++ b/src/Typecheck.hs @@ -146,13 +146,10 @@ typeCheckExpression (BinaryOperation op expr1 expr2) symtab classes = Just (Class _ _ fields) -> let fieldTypes = [dt | VariableDeclaration dt id _ <- fields, id == member] 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 $ "Ambiguous reference to field '" ++ member ++ "' in class '" ++ objectType ++ "'" 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" typeCheckExpression (UnaryOperation op expr) symtab classes = @@ -177,7 +174,7 @@ typeCheckExpression (StatementExpressionExpression stmtExpr) symtab classes = in TypedExpression (getTypeFromStmtExpr stmtExpr') (StatementExpressionExpression stmtExpr') -- ********************************** Type Checking: StatementExpressions ********************************** --- TODO: Implement type checking for StatementExpressions + typeCheckStatementExpression :: StatementExpression -> [(Identifier, DataType)] -> [Class] -> StatementExpression typeCheckStatementExpression (Assignment id expr) symtab classes = let expr' = typeCheckExpression expr symtab classes @@ -213,31 +210,36 @@ typeCheckStatementExpression (ConstructorCall className args) symtab classes = else TypedStatementExpression className (ConstructorCall className args') -typeCheckStatementExpression (MethodCall methodName args) symtab classes = - case lookup methodName symtab of - Just className -> - case find (\(Class name _ _) -> name == className) 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 = zipWith (\expType argType -> (expType == argType, expType, argType)) expectedTypes argTypes - mismatches = filter (not . fst3) typeMatches - where fst3 (a, _, _) = a - in - if null mismatches && length args == length params then - TypedStatementExpression retType (MethodCall methodName args') - else if not (null mismatches) then - error $ unlines $ ("Argument type mismatches for method '" ++ methodName ++ "':") - : [ "Expected: " ++ expType ++ ", Found: " ++ argType | (_, expType, argType) <- mismatches ] - else - 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 $ "Class '" ++ className ++ "' not found." - Nothing -> error $ "Method or class context for '" ++ methodName ++ "' not found in symbol table." +typeCheckStatementExpression (MethodCall expr methodName args) symtab classes = + -- First, evaluate the object expression to find its type + let objExprTyped = typeCheckExpression expr symtab classes + 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 _) -> + -- Find the method within the class + case find (\(MethodDeclaration retType name params _) -> name == methodName) methods of + Just (MethodDeclaration retType _ params _) -> + -- Check arguments + let args' = map (\arg -> typeCheckExpression arg symtab classes) args + expectedTypes = [dataType | ParameterDeclaration dataType _ <- params] + argTypes = map getTypeFromExpr args' + typeMatches = zipWith (\expType argType -> (expType == argType, expType, argType)) expectedTypes argTypes + mismatches = filter (not . fst3) typeMatches + where fst3 (a, _, _) = a + in + if null mismatches && length args == length params then + TypedStatementExpression retType (MethodCall objExprTyped methodName args') + else if not (null mismatches) then + error $ unlines $ ("Argument type mismatches for method '" ++ methodName ++ "':") + : [ "Expected: " ++ expType ++ ", Found: " ++ argType | (_, expType, argType) <- mismatches ] + else + error $ "Incorrect number of arguments for method '" ++ methodName ++ "'. Expected " ++ show (length expectedTypes) ++ ", found " ++ show (length args) ++ "." + Nothing -> error $ "Method '" ++ methodName ++ "' not found in class '" ++ objType ++ "'." + Nothing -> error $ "Class for object type '" ++ objType ++ "' not found." + _ -> error "Invalid object type for method call. Object must have a class type." + -- ********************************** Type Checking: Statements ********************************** @@ -337,22 +339,3 @@ lookupType id symtab = case lookup id symtab of Just t -> t 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." \ No newline at end of file