fixed typechecker trying to find a field of a class in the symboltable

This commit is contained in:

View File

@ -202,8 +202,8 @@ typeCheckExpression (BinaryOperation op expr1 expr2) symtab classes =
else else
error "Logical OR operation requires two operands of type boolean" error "Logical OR operation requires two operands of type boolean"
NameResolution -> NameResolution ->
case (expr1', expr2') of case (expr1', expr2) of
(TypedExpression t1 (Reference obj), TypedExpression t2 (Reference member)) -> (TypedExpression t1 (Reference obj), Reference member) ->
-- Lookup the class type of obj from the symbol table -- Lookup the class type of obj from the symbol table
let objectType = lookupType obj symtab let objectType = lookupType obj symtab
classDetails = find (\(Class className _ _) -> className == objectType) classes classDetails = find (\(Class className _ _) -> className == objectType) classes
@ -213,7 +213,7 @@ typeCheckExpression (BinaryOperation op expr1 expr2) symtab classes =
let fieldTypes = [dt | VariableDeclaration dt id _ <- fields, id == member] let fieldTypes = [dt | VariableDeclaration dt id _ <- fields, id == member]
methodTypes = [dt | MethodDeclaration dt id _ _ <- methods, id == member] methodTypes = [dt | MethodDeclaration dt id _ _ <- methods, id == member]
in case fieldTypes ++ methodTypes of in case fieldTypes ++ methodTypes of
[resolvedType] -> TypedExpression resolvedType (BinaryOperation op expr1' expr2') [resolvedType] -> TypedExpression resolvedType (BinaryOperation op expr1' (TypedExpression resolvedType (Reference member)))
[] -> error $ "Member '" ++ member ++ "' not found in class '" ++ objectType ++ "'" [] -> error $ "Member '" ++ member ++ "' not found in class '" ++ objectType ++ "'"
_ -> error $ "Ambiguous reference to '" ++ member ++ "' in class '" ++ objectType ++ "'" _ -> error $ "Ambiguous reference to '" ++ member ++ "' in class '" ++ objectType ++ "'"
Nothing -> error $ "Object '" ++ obj ++ "' does not correspond to a known class" Nothing -> error $ "Object '" ++ obj ++ "' does not correspond to a known class"
@ -241,7 +241,7 @@ typeCheckExpression (StatementExpressionExpression stmtExpr) symtab classes =
in TypedExpression (getTypeFromStmtExpr stmtExpr') (StatementExpressionExpression stmtExpr') in TypedExpression (getTypeFromStmtExpr stmtExpr') (StatementExpressionExpression stmtExpr')
-- ********************************** Type Checking: StatementExpressions ********************************** -- ********************************** Type Checking: StatementExpressions **********************************
-- TODO: Implement type checking for StatementExpressions
typeCheckStatementExpression :: StatementExpression -> [(Identifier, DataType)] -> [Class] -> StatementExpression typeCheckStatementExpression :: StatementExpression -> [(Identifier, DataType)] -> [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