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

Merge branch 'typedAST' of ssh://gitea.hb.dhbw-stuttgart.de:2222/MisterChaos69/MiniJavaCompiler into bytecode

Browse Source
This commit is contained in:
mrab 2024-06-13 17:16:29 +02:00
commit 9a9c508fc7
1 changed files with 11 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
src/Typecheck.hs
View File

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