update block and local variable typecheck
This commit is contained in:
parent
dbdd2f85bd
commit
62bd191314
61
src/Ast.hs
61
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"
|
||||
|
Loading…
Reference in New Issue
Block a user