From 62bd1913140b28535ff0641f4be987852bfb7166 Mon Sep 17 00:00:00 2001 From: MisterChaos96 Date: Mon, 6 May 2024 10:49:33 +0200 Subject: [PATCH] update block and local variable typecheck --- src/Ast.hs | 61 ++++++++++++++++++++++++++++++++++++------------------ 1 file changed, 41 insertions(+), 20 deletions(-) diff --git a/src/Ast.hs b/src/Ast.hs index 86a2f73..635954c 100644 --- a/src/Ast.hs +++ b/src/Ast.hs @@ -70,14 +70,14 @@ typeCheckClass (Class className methods fields) classes = let -- Create a symbol table from class fields classFields = [(dt, id) | VariableDeclaration dt id _ <- fields] - checkedMethods = map (\method -> typeCheckMethodDeclaration method classes classFields) methods + checkedMethods = map (\method -> typeCheckMethodDeclaration method classFields classes) methods in Class className checkedMethods fields -typeCheckMethodDeclaration :: MethodDeclaration -> [Class] -> [(DataType, Identifier)] -> MethodDeclaration -typeCheckMethodDeclaration (MethodDeclaration retType name params body) classes classFields = +typeCheckMethodDeclaration :: MethodDeclaration -> [(DataType, Identifier)] -> [Class] -> MethodDeclaration +typeCheckMethodDeclaration (MethodDeclaration retType name params body) classFields classes = let -- Combine class fields with method parameters to form the initial symbol table for the method - methodParams = [(dt, id) | ParameterDeclaration dt id <- params] + methodParams = [(dataType, identifier) | ParameterDeclaration dataType identifier <- params] -- Ensure method parameters shadow class fields if names collide initialSymtab = classFields ++ methodParams -- Type check the body of the method using the combined symbol table @@ -88,6 +88,7 @@ typeCheckMethodDeclaration (MethodDeclaration retType name params body) classes then MethodDeclaration retType name params checkedBody else error $ "Return type mismatch in method " ++ name ++ ": expected " ++ retType ++ ", found " ++ bodyType +-- ********************************** Type Checking: Expressions ********************************** typeCheckExpression :: Expression -> [(DataType, Identifier)] -> [Class] -> Expression typeCheckExpression (IntegerLiteral i) _ _ = TypedExpression "int" (IntegerLiteral i) @@ -193,6 +194,7 @@ typeCheckExpression (BinaryOperation op expr1 expr2) symtab classes = TypedExpression "boolean" (BinaryOperation op expr1' expr2') else error "Logical OR operation requires two operands of type boolean" + -- dont i have to lookup in classes if expr1 is in the list of classes? and if it is, then i have to check if expr2 is a method / variable in that class NameResolution -> TypedExpression type1 (BinaryOperation op expr1' expr2') typeCheckExpression (UnaryOperation op expr) symtab classes = @@ -216,6 +218,8 @@ typeCheckExpression (StatementExpressionExpression stmtExpr) symtab classes = let stmtExpr' = typeCheckStatementExpression stmtExpr symtab classes in TypedExpression (getTypeFromStmtExpr stmtExpr') (StatementExpressionExpression stmtExpr') +-- ********************************** Type Checking: StatementExpressions ********************************** + typeCheckStatementExpression :: StatementExpression -> [(DataType, Identifier)] -> [Class] -> StatementExpression typeCheckStatementExpression (Assignment id expr) symtab classes = let expr' = typeCheckExpression expr symtab classes @@ -235,6 +239,8 @@ typeCheckStatementExpression (MethodCall methodName args) symtab classes = let args' = map (\arg -> typeCheckExpression arg symtab classes) args in TypedStatementExpression "Object" (MethodCall methodName args') +-- ********************************** Type Checking: Statements ********************************** + typeCheckStatement :: Statement -> [(DataType, Identifier)] -> [Class] -> Statement typeCheckStatement (If cond thenStmt elseStmt) symtab classes = let cond' = typeCheckExpression cond symtab classes @@ -259,29 +265,42 @@ typeCheckStatement (While cond stmt) symtab classes = typeCheckStatement (Block statements) symtab classes = let - processStatements (accSts, retTypes) stmt = + -- Helper function to process each statement and manage the symbol table + processStatements (accSts, currentSymtab) stmt = case stmt of - Return maybeExpr -> - let checkedExpr = fmap (\expr -> typeCheckExpression expr symtab classes) maybeExpr - exprType = case checkedExpr of - Just (TypedExpression dt _) -> dt - Nothing -> "Void" -- Return with no expression is "Void" - in (accSts ++ [Return checkedExpr], retTypes ++ [exprType]) + LocalVariableDeclaration (VariableDeclaration dataType identifier maybeExpr) -> + let + -- Type check the expression if it exists + checkedExpr = fmap (\expr -> typeCheckExpression expr currentSymtab classes) maybeExpr + + -- Update the symbol table with the new variable + newSymtab = (dataType, identifier) : currentSymtab + newStmt = typeCheckStatement (LocalVariableDeclaration (VariableDeclaration dataType identifier checkedExpr)) newSymtab classes + in (accSts ++ [newStmt], newSymtab) + _ -> - -- Type check the statment and add it to the accumulator and pass the current return types - let checkedStmt = typeCheckStatement stmt symtab classes - in (accSts ++ [checkedStmt], retTypes) + -- For other statements, just type check using the current symbol table + let checkedStmt = typeCheckStatement stmt currentSymtab classes + in (accSts ++ [checkedStmt], currentSymtab) - -- Initialize with empty accumulators for statements and return types - (checkedStatements, returnTypes) = foldl processStatements ([], []) statements + -- Fold over the list of statements starting with the initial symbol table + (checkedStatements, finalSymtab) = foldl processStatements ([], symtab) statements - -- Determine the block type by unifying all return types, default to "Void" if none - blockType = case returnTypes of - [] -> "Void" - _ -> foldl1 unifyReturnTypes returnTypes + -- Determine the type of the block by examining the types of return statements + blockType = if any isReturnStatement checkedStatements + then foldl1 unifyReturnTypes [getTypeFromStmt s | s <- checkedStatements, isReturnStatement s] + else "Void" + + -- Function to check if a statement is a return statement + isReturnStatement (Return _) = True + isReturnStatement _ = False in TypedStatement blockType (Block checkedStatements) +typeCheckStatement (LocalVariableDeclaration (VariableDeclaration dataType identifier maybeExpr)) symtab classes = + let checkedExpr = fmap (\expr -> typeCheckExpression expr symtab classes) maybeExpr + in TypedStatement dataType (LocalVariableDeclaration (VariableDeclaration dataType identifier checkedExpr)) + typeCheckStatement (Return expr) symtab classes = let expr' = case expr of Just e -> Just (typeCheckExpression e symtab classes) @@ -290,6 +309,8 @@ typeCheckStatement (Return expr) symtab classes = Just e' -> TypedStatement (getTypeFromExpr e') (Return (Just e')) Nothing -> TypedStatement "void" (Return Nothing) +-- ********************************** Type Checking: Helpers ********************************** + getTypeFromExpr :: Expression -> DataType getTypeFromExpr (TypedExpression t _) = t getTypeFromExpr _ = error "Untyped expression found where typed was expected"