From baf93626340ca8bb9ceeea8a09ff45b619135fa5 Mon Sep 17 00:00:00 2001 From: MisterChaos96 Date: Thu, 13 Jun 2024 15:49:59 +0200 Subject: [PATCH] make implicit this to explicit this for field variables --- src/Typecheck.hs | 20 +++++++++++--------- 1 file changed, 11 insertions(+), 9 deletions(-) diff --git a/src/Typecheck.hs b/src/Typecheck.hs index d7eeac2..8374ea4 100644 --- a/src/Typecheck.hs +++ b/src/Typecheck.hs @@ -9,24 +9,27 @@ typeCheckCompilationUnit classes = map (`typeCheckClass` classes) classes typeCheckClass :: Class -> [Class] -> Class typeCheckClass (Class className methods fields) classes = let - -- Create a symbol table from class fields and method entries - -- TODO: Maybe remove method entries from the symbol table? - methodEntries = [(methodName, className) | MethodDeclaration _ methodName _ _ <- methods] - initalSymTab = ("this", className) : methodEntries + -- Fields dont need to be added to the symtab because they are looked upon automatically under this if its not a declared local variable + -- TODO: Maybe remove method entries from the symbol table? I dont think we need them but if yes the next line would be + -- initalSymTab = ("this", className) : methodEntries + -- methodEntries = [(methodName, className) | MethodDeclaration _ methodName _ _ <- methods] + initalSymTab = [("this", className)] checkedMethods = map (\method -> typeCheckMethodDeclaration method initalSymTab classes) methods in Class className checkedMethods fields typeCheckMethodDeclaration :: MethodDeclaration -> [(Identifier, DataType)] -> [Class] -> MethodDeclaration -typeCheckMethodDeclaration (MethodDeclaration retType name params body) classFields classes = +typeCheckMethodDeclaration (MethodDeclaration retType name params body) symtab classes = let methodParams = [(identifier, dataType) | ParameterDeclaration dataType identifier <- params] - initialSymtab = ("thisMeth", retType) : classFields ++ methodParams + initialSymtab = ("thisMeth", retType) : symtab ++ methodParams checkedBody = typeCheckStatement body initialSymtab classes bodyType = getTypeFromStmt checkedBody in if bodyType == retType || (bodyType == "void" && retType == "void") || (bodyType == "null" && isObjectType retType) || isSubtype bodyType retType classes then MethodDeclaration retType name params checkedBody else error $ "Method Declaration: Return type mismatch in method " ++ name ++ ": expected " ++ retType ++ ", found " ++ bodyType +-- TODO: It could be that TypeCheckVariableDeclaration is missing. If it comes up -> just check wether the type is correct. The maybe expression needs to be +-- checked as well. Also if its a class type, check wether the class exists. -- ********************************** Type Checking: Expressions ********************************** @@ -36,7 +39,6 @@ typeCheckExpression (CharacterLiteral c) _ _ = TypedExpression "char" (Character typeCheckExpression (BooleanLiteral b) _ _ = TypedExpression "boolean" (BooleanLiteral b) typeCheckExpression NullLiteral _ _ = TypedExpression "null" NullLiteral typeCheckExpression (Reference id) symtab classes = - -- TODO: maybe maje exception for "this" in first lookup? case lookup id symtab of Just t -> TypedExpression t (LocalVariable id) Nothing -> @@ -47,7 +49,7 @@ typeCheckExpression (Reference id) symtab classes = Just (Class _ _ fields) -> let fieldTypes = [dt | VariableDeclaration dt fieldId _ <- fields, fieldId == id] in case fieldTypes of - [fieldType] -> TypedExpression fieldType (FieldVariable id) + [fieldType] -> TypedExpression fieldType (BinaryOperation NameResolution (LocalVariable "this") (FieldVariable id)) [] -> error $ "Field '" ++ id ++ "' not found in class '" ++ className ++ "'" _ -> error $ "Ambiguous reference to field '" ++ id ++ "' in class '" ++ className ++ "'" Nothing -> error $ "Class '" ++ className ++ "' not found for 'this'" @@ -272,7 +274,7 @@ typeCheckStatement (Block statements) symtab classes = -- Initial accumulator: empty statements list, initial symbol table, empty types list (checkedStatements, finalSymtab, collectedTypes) = foldl processStatements ([], symtab, []) statements - -- Determine the block's type: unify all collected types, default to "Void" if none + -- Determine the block's type: unify all collected types, default to "void" if none (UpperBound) blockType = if null collectedTypes then "void" else foldl1 unifyReturnTypes collectedTypes in TypedStatement blockType (Block checkedStatements)