update block and local variable typecheck

This commit is contained in:

View File

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