From f14470d8cc7c8a7e905fde8074b6c69fd5cd109f Mon Sep 17 00:00:00 2001 From: MisterChaos96 Date: Mon, 6 May 2024 23:15:10 +0200 Subject: [PATCH] add name resolution, fix symbol table key, value switchup --- src/Ast.hs | 88 ++++++++++++++++++++++++++++++++++-------------------- 1 file changed, 55 insertions(+), 33 deletions(-) diff --git a/src/Ast.hs b/src/Ast.hs index 7bc2ba1..411fc01 100644 --- a/src/Ast.hs +++ b/src/Ast.hs @@ -1,18 +1,20 @@ module Ast where -type CompilationUnit = [Class] +import Data.List (find) + +type CompilationUnit = [Class] type DataType = String -type Identifier = String +type Identifier = String -data ParameterDeclaration = ParameterDeclaration DataType Identifier +data ParameterDeclaration = ParameterDeclaration DataType Identifier deriving (Show) -data VariableDeclaration = VariableDeclaration DataType Identifier (Maybe Expression) +data VariableDeclaration = VariableDeclaration DataType Identifier (Maybe Expression) deriving (Show) -data Class = Class DataType [MethodDeclaration] [VariableDeclaration] +data Class = Class DataType [MethodDeclaration] [VariableDeclaration] deriving (Show) -data MethodDeclaration = MethodDeclaration DataType Identifier [ParameterDeclaration] Statement +data MethodDeclaration = MethodDeclaration DataType Identifier [ParameterDeclaration] Statement deriving (Show) data Statement = If Expression Statement (Maybe Statement) @@ -22,12 +24,14 @@ data Statement | Return (Maybe Expression) | StatementExpressionStatement StatementExpression | TypedStatement DataType Statement + deriving (Show) data StatementExpression = Assignment Identifier Expression | ConstructorCall DataType [Expression] | MethodCall Identifier [Expression] | TypedStatementExpression DataType StatementExpression + deriving (Show) data BinaryOperator = Addition @@ -46,10 +50,12 @@ data BinaryOperator | And | Or | NameResolution + deriving (Show) data UnaryOperator = Not | Minus + deriving (Show) data Expression = IntegerLiteral Int @@ -61,6 +67,7 @@ data Expression | UnaryOperation UnaryOperator Expression | StatementExpressionExpression StatementExpression | TypedExpression DataType Expression + deriving (Show) typeCheckCompilationUnit :: CompilationUnit -> CompilationUnit typeCheckCompilationUnit classes = map (`typeCheckClass` classes) classes @@ -69,28 +76,28 @@ typeCheckClass :: Class -> [Class] -> Class typeCheckClass (Class className methods fields) classes = let -- Create a symbol table from class fields - classFields = [(dt, id) | VariableDeclaration dt id _ <- fields] + classFields = [(id, dt) | VariableDeclaration dt id _ <- fields] checkedMethods = map (\method -> typeCheckMethodDeclaration method classFields classes) methods in Class className checkedMethods fields -typeCheckMethodDeclaration :: MethodDeclaration -> [(DataType, Identifier)] -> [Class] -> MethodDeclaration +typeCheckMethodDeclaration :: MethodDeclaration -> [(Identifier, DataType)] -> [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 = [(dataType, identifier) | ParameterDeclaration dataType identifier <- params] + methodParams = [(identifier, dataType) | 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 checkedBody = typeCheckStatement body initialSymtab classes bodyType = getTypeFromStmt checkedBody -- Check if the type of the body matches the declared return type - in if bodyType == retType || (bodyType == "Void" && retType == "void") + in if bodyType == retType || (bodyType == "void" && retType == "void") 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 :: Expression -> [(Identifier, DataType)] -> [Class] -> Expression typeCheckExpression (IntegerLiteral i) _ _ = TypedExpression "int" (IntegerLiteral i) typeCheckExpression (CharacterLiteral c) _ _ = TypedExpression "char" (CharacterLiteral c) typeCheckExpression (BooleanLiteral b) _ _ = TypedExpression "boolean" (BooleanLiteral b) @@ -194,8 +201,23 @@ 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') + NameResolution -> + case (expr1', expr2') of + (TypedExpression t1 (Reference obj), TypedExpression t2 (Reference member)) -> + -- Lookup the class type of obj from the symbol table + let objectType = lookupType obj symtab + classDetails = find (\(Class className _ _) -> className == objectType) classes + in case classDetails of + Just (Class _ methods fields) -> + -- Check both fields and methods to find a match for member + let fieldTypes = [dt | VariableDeclaration dt id _ <- fields, id == member] + methodTypes = [dt | MethodDeclaration dt id _ _ <- methods, id == member] + in case fieldTypes ++ methodTypes of + [resolvedType] -> TypedExpression resolvedType (BinaryOperation op expr1' expr2') + [] -> error $ "Member '" ++ member ++ "' not found in class '" ++ objectType ++ "'" + _ -> error $ "Ambiguous reference to '" ++ member ++ "' in class '" ++ objectType ++ "'" + Nothing -> error $ "Object '" ++ obj ++ "' does not correspond to a known class" + _ -> error "Name resolution requires object reference and member name" typeCheckExpression (UnaryOperation op expr) symtab classes = let expr' = typeCheckExpression expr symtab classes @@ -220,7 +242,7 @@ typeCheckExpression (StatementExpressionExpression stmtExpr) symtab classes = -- ********************************** Type Checking: StatementExpressions ********************************** -typeCheckStatementExpression :: StatementExpression -> [(DataType, Identifier)] -> [Class] -> StatementExpression +typeCheckStatementExpression :: StatementExpression -> [(Identifier, DataType)] -> [Class] -> StatementExpression typeCheckStatementExpression (Assignment id expr) symtab classes = let expr' = typeCheckExpression expr symtab classes type' = getTypeFromExpr expr' @@ -241,7 +263,7 @@ typeCheckStatementExpression (MethodCall methodName args) symtab classes = -- ********************************** Type Checking: Statements ********************************** -typeCheckStatement :: Statement -> [(DataType, Identifier)] -> [Class] -> Statement +typeCheckStatement :: Statement -> [(Identifier, DataType)] -> [Class] -> Statement typeCheckStatement (If cond thenStmt elseStmt) symtab classes = let cond' = typeCheckExpression cond symtab classes thenStmt' = typeCheckStatement thenStmt symtab classes @@ -254,6 +276,18 @@ typeCheckStatement (If cond thenStmt elseStmt) symtab classes = else error "If condition must be of type boolean" +typeCheckStatement (LocalVariableDeclaration (VariableDeclaration dataType identifier maybeExpr)) symtab classes = + -- Check for redefinition in the current scope + if any ((== identifier) . snd) symtab + then error $ "Variable '" ++ identifier ++ "' is redefined in the same scope" + else + -- If there's an initializer expression, type check it + let checkedExpr = fmap (\expr -> typeCheckExpression expr symtab classes) maybeExpr + exprType = fmap getTypeFromExpr checkedExpr + in case exprType of + Just t | t /= dataType -> error $ "Type mismatch in declaration of '" ++ identifier ++ "': expected " ++ dataType ++ ", found " ++ t + _ -> TypedStatement dataType (LocalVariableDeclaration (VariableDeclaration dataType identifier checkedExpr)) + typeCheckStatement (While cond stmt) symtab classes = let cond' = typeCheckExpression cond symtab classes stmt' = typeCheckStatement stmt symtab classes @@ -273,34 +307,22 @@ typeCheckStatement (Block statements) symtab classes = LocalVariableDeclaration (VariableDeclaration dataType identifier maybeExpr) -> let checkedExpr = fmap (\expr -> typeCheckExpression expr currentSymtab classes) maybeExpr - newSymtab = (dataType, identifier) : currentSymtab + newSymtab = (identifier, dataType) : currentSymtab in (accSts ++ [checkedStmt], newSymtab, types) - If {} -> (accSts ++ [checkedStmt], currentSymtab, if stmtType /= "Void" then types ++ [stmtType] else types) - While _ _ -> (accSts ++ [checkedStmt], currentSymtab, if stmtType /= "Void" then types ++ [stmtType] else types) - Return _ -> (accSts ++ [checkedStmt], currentSymtab, if stmtType /= "Void" then types ++ [stmtType] else types) + If {} -> (accSts ++ [checkedStmt], currentSymtab, if stmtType /= "void" then types ++ [stmtType] else types) + While _ _ -> (accSts ++ [checkedStmt], currentSymtab, if stmtType /= "void" then types ++ [stmtType] else types) + Return _ -> (accSts ++ [checkedStmt], currentSymtab, if stmtType /= "void" then types ++ [stmtType] else types) _ -> (accSts ++ [checkedStmt], currentSymtab, types) -- Initial accumulator: empty statements list, initial symbol table, empty types list (checkedStatements, finalSymtab, collectedTypes) = foldl processStatements ([], symtab, []) statements -- Determine the block's type: unify all collected types, default to "Void" if none - blockType = if null collectedTypes then "Void" else foldl1 unifyReturnTypes collectedTypes + blockType = if null collectedTypes then "void" else foldl1 unifyReturnTypes collectedTypes in TypedStatement blockType (Block checkedStatements) -typeCheckStatement (LocalVariableDeclaration (VariableDeclaration dataType identifier maybeExpr)) symtab classes = - -- Check for redefinition in the current scope - if any ((== identifier) . snd) symtab - then error $ "Variable '" ++ identifier ++ "' is redefined in the same scope" - else - -- If there's an initializer expression, type check it - let checkedExpr = fmap (\expr -> typeCheckExpression expr symtab classes) maybeExpr - exprType = fmap getTypeFromExpr checkedExpr - in case exprType of - Just t | t /= dataType -> error $ "Type mismatch in declaration of '" ++ identifier ++ "': expected " ++ dataType ++ ", found " ++ t - _ -> TypedStatement dataType (LocalVariableDeclaration (VariableDeclaration dataType identifier checkedExpr)) - typeCheckStatement (Return expr) symtab classes = let expr' = case expr of Just e -> Just (typeCheckExpression e symtab classes) @@ -328,7 +350,7 @@ unifyReturnTypes dt1 dt2 | dt1 == dt2 = dt1 | otherwise = "Object" -lookupType :: Identifier -> [(DataType, Identifier)] -> DataType +lookupType :: Identifier -> [(Identifier, DataType)] -> DataType lookupType id symtab = case lookup id symtab of Just t -> t