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

Add initial typechecker for AST #2

Merged
mrab merged 121 commits from typedAST into master 2024-06-14 07:53:30 +00:00
Conversation 0 Commits 121 Files Changed 17 +6 -12
2 changed files with 6 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files
Showing only changes of commit f8b0b59c5d - Show all commits

2
src/Example.hs
View File

@ -89,7 +89,7 @@ exampleMethodCallAndAssignmentFail = Block [
LocalVariableDeclaration (VariableDeclaration "Person" "bob" (Just (StatementExpressionExpression (ConstructorCall "Person" [IntegerLiteral 30])))), LocalVariableDeclaration (VariableDeclaration "Person" "bob" (Just (StatementExpressionExpression (ConstructorCall "Person" [IntegerLiteral 30])))),
LocalVariableDeclaration (VariableDeclaration "int" "age" (Just (StatementExpressionExpression (MethodCall (Reference "bob") "getAge" [])))), LocalVariableDeclaration (VariableDeclaration "int" "age" (Just (StatementExpressionExpression (MethodCall (Reference "bob") "getAge" [])))),
StatementExpressionStatement (MethodCall (Reference "bob") "setAge" [IntegerLiteral 30]), StatementExpressionStatement (MethodCall (Reference "bob") "setAge" [IntegerLiteral 30]),
StatementExpressionStatement (Assignment (Reference "age") (Reference "age")) StatementExpressionStatement (Assignment (Reference "a") (Reference "age"))
] ]
exampleNameResolutionAssignment :: Statement exampleNameResolutionAssignment :: Statement

16
src/Typecheck.hs
View File

@ -52,7 +52,7 @@ typeCheckExpression (Reference id) symtab classes =
_ -> error $ "Ambiguous reference to field '" ++ id ++ "' in class '" ++ className ++ "'" _ -> error $ "Ambiguous reference to field '" ++ id ++ "' in class '" ++ className ++ "'"
Nothing -> error $ "Class '" ++ className ++ "' not found for 'this'" Nothing -> error $ "Class '" ++ className ++ "' not found for 'this'"
Nothing -> error $ "Context for 'this' not found in symbol table, unable to resolve '" ++ id ++ "'" Nothing -> error $ "Context for 'this' not found in symbol table, unable to resolve '" ++ id ++ "'"
typeCheckExpression (BinaryOperation op expr1 expr2) symtab classes = typeCheckExpression (BinaryOperation op expr1 expr2) symtab classes =
let expr1' = typeCheckExpression expr1 symtab classes let expr1' = typeCheckExpression expr1 symtab classes
expr2' = typeCheckExpression expr2 symtab classes expr2' = typeCheckExpression expr2 symtab classes
@ -89,10 +89,10 @@ typeCheckExpression (UnaryOperation op expr) symtab classes =
else else
error "Logical NOT operation requires an operand of type boolean" error "Logical NOT operation requires an operand of type boolean"
Minus -> Minus ->
if type' == "int" if type' == "int"
then then
TypedExpression "int" (UnaryOperation op expr') TypedExpression "int" (UnaryOperation op expr')
else if type' == "char" else if type' == "char"
then then
TypedExpression "char" (UnaryOperation op expr') TypedExpression "char" (UnaryOperation op expr')
else else
@ -147,11 +147,11 @@ typeCheckStatementExpression (Assignment ref expr) symtab classes =
type' = getTypeFromExpr expr' type' = getTypeFromExpr expr'
type'' = getTypeFromExpr ref' type'' = getTypeFromExpr ref'
in in
if type'' == type' then if type'' == type' then
TypedStatementExpression type' (Assignment ref' expr') TypedStatementExpression type' (Assignment ref' expr')
else else
error $ "Type mismatch in assignment to variable: expected " ++ type'' ++ ", found " ++ type' error $ "Type mismatch in assignment to variable: expected " ++ type'' ++ ", found " ++ type'
typeCheckStatementExpression (ConstructorCall className args) symtab classes = typeCheckStatementExpression (ConstructorCall className args) symtab classes =
case find (\(Class name _ _) -> name == className) classes of case find (\(Class name _ _) -> name == className) classes of
Nothing -> error $ "Class '" ++ className ++ "' not found." Nothing -> error $ "Class '" ++ className ++ "' not found."
@ -295,12 +295,6 @@ unifyReturnTypes dt1 dt2
| dt1 == dt2 = dt1 | dt1 == dt2 = dt1
| otherwise = "Object" | otherwise = "Object"
lookupType :: Identifier -> [(Identifier, DataType)] -> Maybe DataType
lookupType id symtab =
case lookup id symtab of
Just t -> Just t
Nothing -> Nothing
resolveResultType :: DataType -> DataType -> DataType resolveResultType :: DataType -> DataType -> DataType
resolveResultType "char" "char" = "char" resolveResultType "char" "char" = "char"
resolveResultType "int" "int" = "int" resolveResultType "int" "int" = "int"