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
|
let
|
||||||
-- Create a symbol table from class fields
|
-- Create a symbol table from class fields
|
||||||
classFields = [(dt, id) | VariableDeclaration dt id _ <- 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
|
in Class className checkedMethods fields
|
||||||
|
|
||||||
typeCheckMethodDeclaration :: MethodDeclaration -> [Class] -> [(DataType, Identifier)] -> MethodDeclaration
|
typeCheckMethodDeclaration :: MethodDeclaration -> [(DataType, Identifier)] -> [Class] -> MethodDeclaration
|
||||||
typeCheckMethodDeclaration (MethodDeclaration retType name params body) classes classFields =
|
typeCheckMethodDeclaration (MethodDeclaration retType name params body) classFields classes =
|
||||||
let
|
let
|
||||||
-- Combine class fields with method parameters to form the initial symbol table for the method
|
-- 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
|
-- Ensure method parameters shadow class fields if names collide
|
||||||
initialSymtab = classFields ++ methodParams
|
initialSymtab = classFields ++ methodParams
|
||||||
-- Type check the body of the method using the combined symbol table
|
-- 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
|
then MethodDeclaration retType name params checkedBody
|
||||||
else error $ "Return type mismatch in method " ++ name ++ ": expected " ++ retType ++ ", found " ++ bodyType
|
else error $ "Return type mismatch in method " ++ name ++ ": expected " ++ retType ++ ", found " ++ bodyType
|
||||||
|
|
||||||
|
-- ********************************** Type Checking: Expressions **********************************
|
||||||
|
|
||||||
typeCheckExpression :: Expression -> [(DataType, Identifier)] -> [Class] -> Expression
|
typeCheckExpression :: Expression -> [(DataType, Identifier)] -> [Class] -> Expression
|
||||||
typeCheckExpression (IntegerLiteral i) _ _ = TypedExpression "int" (IntegerLiteral i)
|
typeCheckExpression (IntegerLiteral i) _ _ = TypedExpression "int" (IntegerLiteral i)
|
||||||
@ -193,6 +194,7 @@ typeCheckExpression (BinaryOperation op expr1 expr2) symtab classes =
|
|||||||
TypedExpression "boolean" (BinaryOperation op expr1' expr2')
|
TypedExpression "boolean" (BinaryOperation op expr1' expr2')
|
||||||
else
|
else
|
||||||
error "Logical OR operation requires two operands of type boolean"
|
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')
|
NameResolution -> TypedExpression type1 (BinaryOperation op expr1' expr2')
|
||||||
|
|
||||||
typeCheckExpression (UnaryOperation op expr) symtab classes =
|
typeCheckExpression (UnaryOperation op expr) symtab classes =
|
||||||
@ -216,6 +218,8 @@ typeCheckExpression (StatementExpressionExpression stmtExpr) symtab classes =
|
|||||||
let stmtExpr' = typeCheckStatementExpression stmtExpr symtab classes
|
let stmtExpr' = typeCheckStatementExpression stmtExpr symtab classes
|
||||||
in TypedExpression (getTypeFromStmtExpr stmtExpr') (StatementExpressionExpression stmtExpr')
|
in TypedExpression (getTypeFromStmtExpr stmtExpr') (StatementExpressionExpression stmtExpr')
|
||||||
|
|
||||||
|
-- ********************************** Type Checking: StatementExpressions **********************************
|
||||||
|
|
||||||
typeCheckStatementExpression :: StatementExpression -> [(DataType, Identifier)] -> [Class] -> StatementExpression
|
typeCheckStatementExpression :: StatementExpression -> [(DataType, Identifier)] -> [Class] -> StatementExpression
|
||||||
typeCheckStatementExpression (Assignment id expr) symtab classes =
|
typeCheckStatementExpression (Assignment id expr) symtab classes =
|
||||||
let expr' = typeCheckExpression 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
|
let args' = map (\arg -> typeCheckExpression arg symtab classes) args
|
||||||
in TypedStatementExpression "Object" (MethodCall methodName args')
|
in TypedStatementExpression "Object" (MethodCall methodName args')
|
||||||
|
|
||||||
|
-- ********************************** Type Checking: Statements **********************************
|
||||||
|
|
||||||
typeCheckStatement :: Statement -> [(DataType, Identifier)] -> [Class] -> Statement
|
typeCheckStatement :: Statement -> [(DataType, Identifier)] -> [Class] -> Statement
|
||||||
typeCheckStatement (If cond thenStmt elseStmt) symtab classes =
|
typeCheckStatement (If cond thenStmt elseStmt) symtab classes =
|
||||||
let cond' = typeCheckExpression cond symtab classes
|
let cond' = typeCheckExpression cond symtab classes
|
||||||
@ -259,29 +265,42 @@ typeCheckStatement (While cond stmt) symtab classes =
|
|||||||
|
|
||||||
typeCheckStatement (Block statements) symtab classes =
|
typeCheckStatement (Block statements) symtab classes =
|
||||||
let
|
let
|
||||||
processStatements (accSts, retTypes) stmt =
|
-- Helper function to process each statement and manage the symbol table
|
||||||
|
processStatements (accSts, currentSymtab) stmt =
|
||||||
case stmt of
|
case stmt of
|
||||||
Return maybeExpr ->
|
LocalVariableDeclaration (VariableDeclaration dataType identifier maybeExpr) ->
|
||||||
let checkedExpr = fmap (\expr -> typeCheckExpression expr symtab classes) maybeExpr
|
let
|
||||||
exprType = case checkedExpr of
|
-- Type check the expression if it exists
|
||||||
Just (TypedExpression dt _) -> dt
|
checkedExpr = fmap (\expr -> typeCheckExpression expr currentSymtab classes) maybeExpr
|
||||||
Nothing -> "Void" -- Return with no expression is "Void"
|
|
||||||
in (accSts ++ [Return checkedExpr], retTypes ++ [exprType])
|
-- 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
|
-- For other statements, just type check using the current symbol table
|
||||||
let checkedStmt = typeCheckStatement stmt symtab classes
|
let checkedStmt = typeCheckStatement stmt currentSymtab classes
|
||||||
in (accSts ++ [checkedStmt], retTypes)
|
in (accSts ++ [checkedStmt], currentSymtab)
|
||||||
|
|
||||||
-- Initialize with empty accumulators for statements and return types
|
-- Fold over the list of statements starting with the initial symbol table
|
||||||
(checkedStatements, returnTypes) = foldl processStatements ([], []) statements
|
(checkedStatements, finalSymtab) = foldl processStatements ([], symtab) statements
|
||||||
|
|
||||||
-- Determine the block type by unifying all return types, default to "Void" if none
|
-- Determine the type of the block by examining the types of return statements
|
||||||
blockType = case returnTypes of
|
blockType = if any isReturnStatement checkedStatements
|
||||||
[] -> "Void"
|
then foldl1 unifyReturnTypes [getTypeFromStmt s | s <- checkedStatements, isReturnStatement s]
|
||||||
_ -> foldl1 unifyReturnTypes returnTypes
|
else "Void"
|
||||||
|
|
||||||
|
-- Function to check if a statement is a return statement
|
||||||
|
isReturnStatement (Return _) = True
|
||||||
|
isReturnStatement _ = False
|
||||||
|
|
||||||
in TypedStatement blockType (Block checkedStatements)
|
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 =
|
typeCheckStatement (Return expr) symtab classes =
|
||||||
let expr' = case expr of
|
let expr' = case expr of
|
||||||
Just e -> Just (typeCheckExpression e symtab classes)
|
Just e -> Just (typeCheckExpression e symtab classes)
|
||||||
@ -290,6 +309,8 @@ typeCheckStatement (Return expr) symtab classes =
|
|||||||
Just e' -> TypedStatement (getTypeFromExpr e') (Return (Just e'))
|
Just e' -> TypedStatement (getTypeFromExpr e') (Return (Just e'))
|
||||||
Nothing -> TypedStatement "void" (Return Nothing)
|
Nothing -> TypedStatement "void" (Return Nothing)
|
||||||
|
|
||||||
|
-- ********************************** Type Checking: Helpers **********************************
|
||||||
|
|
||||||
getTypeFromExpr :: Expression -> DataType
|
getTypeFromExpr :: Expression -> DataType
|
||||||
getTypeFromExpr (TypedExpression t _) = t
|
getTypeFromExpr (TypedExpression t _) = t
|
||||||
getTypeFromExpr _ = error "Untyped expression found where typed was expected"
|
getTypeFromExpr _ = error "Untyped expression found where typed was expected"
|
||||||
|
Loading…
Reference in New Issue
Block a user