MisterChaos69/MiniJavaCompiler
2
2
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

add public private to typecheck

Browse Source
This commit is contained in:
Maybe Fabian Noll aber vielleicht auch nicht. Ist ein bisschen ne Glaubenssache :) 2024-07-04 16:59:52 +02:00
parent 53061fb73d
commit ab7077d8f0
1 changed files with 74 additions and 66 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

138
src/Typecheck.hs
View File

@ -1,19 +1,19 @@
module Typecheck where module Typecheck where
import Data.List (find) import Data.List (find)
import Data.Maybe import Data.Maybe
import Ast import Ast
typeCheckCompilationUnit :: CompilationUnit -> CompilationUnit typeCheckCompilationUnit :: CompilationUnit -> CompilationUnit
typeCheckCompilationUnit classes = typeCheckCompilationUnit classes =
let let
-- Helper function to add a default constructor if none are present -- Helper function to add a default constructor if none are present
ensureDefaultConstructor :: Class -> Class ensureDefaultConstructor :: Class -> Class
ensureDefaultConstructor (Class className constructors methods fields) = ensureDefaultConstructor (Class className modifier constructors methods fields) =
let let
defaultConstructor = ConstructorDeclaration className [] (Block []) defaultConstructor = ConstructorDeclaration modifier className [] (Block [])
constructorsWithDefault = if null constructors then [defaultConstructor] else constructors constructorsWithDefault = if null constructors then [defaultConstructor] else constructors
in Class className constructorsWithDefault methods fields in Class className modifier constructorsWithDefault methods fields
-- Inject default constructors into all classes -- Inject default constructors into all classes
classesWithDefaultConstructors = map ensureDefaultConstructor classes classesWithDefaultConstructors = map ensureDefaultConstructor classes
@ -21,7 +21,7 @@ typeCheckCompilationUnit classes =
in map (`typeCheckClass` classesWithDefaultConstructors) classesWithDefaultConstructors in map (`typeCheckClass` classesWithDefaultConstructors) classesWithDefaultConstructors
typeCheckClass :: Class -> [Class] -> Class typeCheckClass :: Class -> [Class] -> Class
typeCheckClass (Class className constructors methods fields) classes = typeCheckClass (Class className modifier constructors methods fields) classes =
let let
-- Fields and methods dont need to be added to the symtab because they are looked upon automatically under "this" -- Fields and methods dont need to be added to the symtab because they are looked upon automatically under "this"
-- if its not a declared local variable. Also shadowing wouldnt be possible then. -- if its not a declared local variable. Also shadowing wouldnt be possible then.
@ -29,10 +29,10 @@ typeCheckClass (Class className constructors methods fields) classes =
checkedConstructors = map (\constructor -> typeCheckConstructorDeclaration constructor initalSymTab classes) constructors checkedConstructors = map (\constructor -> typeCheckConstructorDeclaration constructor initalSymTab classes) constructors
checkedMethods = map (\method -> typeCheckMethodDeclaration method initalSymTab classes) methods checkedMethods = map (\method -> typeCheckMethodDeclaration method initalSymTab classes) methods
checkedFields = map (\field -> typeCheckVariableDeclaration field initalSymTab classes) fields checkedFields = map (\field -> typeCheckVariableDeclaration field initalSymTab classes) fields
in Class className checkedConstructors checkedMethods checkedFields in Class className modifier checkedConstructors checkedMethods checkedFields
typeCheckConstructorDeclaration :: ConstructorDeclaration -> [(Identifier, DataType)] -> [Class] -> ConstructorDeclaration typeCheckConstructorDeclaration :: ConstructorDeclaration -> [(Identifier, DataType)] -> [Class] -> ConstructorDeclaration
typeCheckConstructorDeclaration (ConstructorDeclaration name params body) symtab classes = typeCheckConstructorDeclaration (ConstructorDeclaration modifier name params body) symtab classes =
let let
constructorParams = [(identifier, dataType) | ParameterDeclaration dataType identifier <- params] constructorParams = [(identifier, dataType) | ParameterDeclaration dataType identifier <- params]
initialSymtab = symtab ++ constructorParams initialSymtab = symtab ++ constructorParams
@ -41,24 +41,23 @@ typeCheckConstructorDeclaration (ConstructorDeclaration name params body) symtab
bodyType = getTypeFromStmt checkedBody bodyType = getTypeFromStmt checkedBody
in if name == className in if name == className
then if bodyType == "void" then if bodyType == "void"
then ConstructorDeclaration name params checkedBody then ConstructorDeclaration modifier name params checkedBody
else error $ "Constructor Declaration: Return type mismatch in constructor " ++ name ++ ": expected void, found " ++ bodyType else error $ "Constructor Declaration: Return type mismatch in constructor " ++ name ++ ": expected void, found " ++ bodyType
else error $ "Constructor Declaration: Constructor name " ++ name ++ " does not match class name " ++ className else error $ "Constructor Declaration: Constructor name " ++ name ++ " does not match class name " ++ className
typeCheckMethodDeclaration :: MethodDeclaration -> [(Identifier, DataType)] -> [Class] -> MethodDeclaration typeCheckMethodDeclaration :: MethodDeclaration -> [(Identifier, DataType)] -> [Class] -> MethodDeclaration
typeCheckMethodDeclaration (MethodDeclaration retType name params body) symtab classes = typeCheckMethodDeclaration (MethodDeclaration retType modifier name params body) symtab classes =
let let
methodParams = [(identifier, dataType) | ParameterDeclaration dataType identifier <- params] methodParams = [(identifier, dataType) | ParameterDeclaration dataType identifier <- params]
initialSymtab = ("thisMeth", retType) : symtab ++ methodParams initialSymtab = ("thisMeth", retType) : symtab ++ methodParams
checkedBody = typeCheckStatement body initialSymtab classes checkedBody = typeCheckStatement body initialSymtab classes
bodyType = getTypeFromStmt checkedBody bodyType = getTypeFromStmt checkedBody
in if bodyType == retType || (bodyType == "void" && retType == "void") || (bodyType == "null" && isObjectType retType) || isSubtype bodyType retType classes in if bodyType == retType || (bodyType == "void" && retType == "void") || (bodyType == "null" && isObjectType retType) || isSubtype bodyType retType classes
then MethodDeclaration retType name params checkedBody then MethodDeclaration retType modifier name params checkedBody
else error $ "Method Declaration: Return type mismatch in method " ++ name ++ ": expected " ++ retType ++ ", found " ++ bodyType else error $ "Method Declaration: Return type mismatch in method " ++ name ++ ": expected " ++ retType ++ ", found " ++ bodyType
typeCheckVariableDeclaration :: VariableDeclaration -> [(Identifier, DataType)] -> [Class] -> VariableDeclaration typeCheckVariableDeclaration :: VariableDeclaration -> [(Identifier, DataType)] -> [Class] -> VariableDeclaration
typeCheckVariableDeclaration (VariableDeclaration dataType identifier maybeExpr) symtab classes = typeCheckVariableDeclaration (VariableDeclaration dataType modifier identifier maybeExpr) symtab classes =
let let
-- Ensure the type is valid (either a primitive type or a valid class name) -- Ensure the type is valid (either a primitive type or a valid class name)
validType = dataType `elem` ["int", "boolean", "char"] || isUserDefinedClass dataType classes validType = dataType `elem` ["int", "boolean", "char"] || isUserDefinedClass dataType classes
@ -74,11 +73,10 @@ typeCheckVariableDeclaration (VariableDeclaration dataType identifier maybeExpr)
(False, _, _) -> error $ "Type '" ++ dataType ++ "' is not a valid type for variable '" ++ identifier ++ "'" (False, _, _) -> error $ "Type '" ++ dataType ++ "' is not a valid type for variable '" ++ identifier ++ "'"
(_, True, _) -> error $ "Variable '" ++ identifier ++ "' is redefined in the same scope" (_, True, _) -> error $ "Variable '" ++ identifier ++ "' is redefined in the same scope"
(_, _, Just t) (_, _, Just t)
| t == "null" && isObjectType dataType -> VariableDeclaration dataType identifier checkedExprWithType | t == "null" && isObjectType dataType -> VariableDeclaration dataType modifier identifier checkedExprWithType
| t /= dataType -> error $ "Type mismatch in declaration of '" ++ identifier ++ "': expected " ++ dataType ++ ", found " ++ t | t /= dataType -> error $ "Type mismatch in declaration of '" ++ identifier ++ "': expected " ++ dataType ++ ", found " ++ t
| otherwise -> VariableDeclaration dataType identifier checkedExprWithType | otherwise -> VariableDeclaration dataType modifier identifier checkedExprWithType
(_, _, Nothing) -> VariableDeclaration dataType identifier checkedExprWithType (_, _, Nothing) -> VariableDeclaration dataType modifier identifier checkedExprWithType
-- ********************************** Type Checking: Expressions ********************************** -- ********************************** Type Checking: Expressions **********************************
@ -93,10 +91,10 @@ typeCheckExpression (Reference id) symtab classes =
Nothing -> Nothing ->
case lookup "this" symtab of case lookup "this" symtab of
Just className -> Just className ->
let classDetails = find (\(Class name _ _ _) -> name == className) classes let classDetails = find (\(Class name _ _ _ _) -> name == className) classes
in case classDetails of in case classDetails of
Just (Class _ _ _ fields) -> Just (Class _ _ _ _ fields) ->
let fieldTypes = [dt | VariableDeclaration dt fieldId _ <- fields, fieldId == id] let fieldTypes = [dt | VariableDeclaration dt modifier fieldId _ <- fields, fieldId == id]
-- this case only happens when its a field of its own class so the implicit this will be converted to explicit this -- this case only happens when its a field of its own class so the implicit this will be converted to explicit this
in case fieldTypes of in case fieldTypes of
[fieldType] -> TypedExpression fieldType (BinaryOperation NameResolution (TypedExpression className (LocalVariable "this")) (TypedExpression fieldType (FieldVariable id))) [fieldType] -> TypedExpression fieldType (BinaryOperation NameResolution (TypedExpression className (LocalVariable "this")) (TypedExpression fieldType (FieldVariable id)))
@ -167,35 +165,36 @@ typeCheckStatementExpression (Assignment ref expr) symtab classes =
else else
error $ "Type mismatch in assignment to variable: expected " ++ type'' ++ ", found " ++ typeToAssign error $ "Type mismatch in assignment to variable: expected " ++ type'' ++ ", found " ++ typeToAssign
typeCheckStatementExpression (ConstructorCall className args) symtab classes = typeCheckStatementExpression (ConstructorCall className args) symtab classes =
case find (\(Class name _ _ _) -> name == className) classes of case find (\(Class name _ _ _ _) -> name == className) classes of
Nothing -> error $ "Class '" ++ className ++ "' not found." Nothing -> error $ "Class '" ++ className ++ "' not found."
Just (Class _ constructors _ _) -> Just (Class _ modifier constructors _ _) ->
let let matchParams (ParameterDeclaration paramType _) arg =
matchParams (ParameterDeclaration paramType _) arg = let argTyped = typeCheckExpression arg symtab classes
let argTyped = typeCheckExpression arg symtab classes argType = getTypeFromExpr argTyped
argType = getTypeFromExpr argTyped in if argType == "null" && isObjectType paramType
in if argType == "null" && isObjectType paramType then Just (TypedExpression paramType NullLiteral)
then Just (TypedExpression paramType NullLiteral) else if argType == paramType
else if argType == paramType then Just argTyped
then Just argTyped else Nothing
else Nothing
matchConstructor (ConstructorDeclaration name params _) = matchConstructor (ConstructorDeclaration constructorModifier name params _)
let matchedArgs = sequence $ zipWith matchParams params args | constructorModifier == "public" = fmap (\checkedArgs -> (ConstructorDeclaration constructorModifier name params (Block []), checkedArgs)) (sequence $ zipWith matchParams params args)
in fmap (\checkedArgs -> (params, checkedArgs)) matchedArgs | constructorModifier == "private" = if checkAccess className (lookup "this" symtab)
then fmap (\checkedArgs -> (ConstructorDeclaration constructorModifier name params (Block []), checkedArgs)) (sequence $ zipWith matchParams params args)
else Nothing
| otherwise = Nothing
validConstructors = filter (\(params, _) -> length params == length args) $ mapMaybe matchConstructor constructors validConstructors = filter (\(ConstructorDeclaration _ _ params _, _) -> length params == length args) $ mapMaybe matchConstructor constructors
expectedSignatures = [ map (\(ParameterDeclaration t _) -> t) params | ConstructorDeclaration _ params _ <- constructors ] expectedSignatures = [ map (\(ParameterDeclaration t _) -> t) params | ConstructorDeclaration _ _ params _ <- constructors ]
actualSignature = map (\arg -> getTypeFromExpr (typeCheckExpression arg symtab classes)) args actualSignature = map (\arg -> getTypeFromExpr (typeCheckExpression arg symtab classes)) args
mismatchDetails = "Constructor not found for class '" ++ className ++ "' with given arguments.\n" ++ mismatchDetails = "Constructor not found for class '" ++ className ++ "' with given arguments.\n" ++
"Expected signatures:\n" ++ show expectedSignatures ++ "Expected signatures:\n" ++ show expectedSignatures ++
"\nActual arguments:" ++ show actualSignature "\nActual arguments:" ++ show actualSignature
in case validConstructors of in case validConstructors of
[(_, checkedArgs)] -> [(ConstructorDeclaration _ _ params _, checkedArgs)] ->
TypedStatementExpression className (ConstructorCall className checkedArgs) TypedStatementExpression className (ConstructorCall className checkedArgs)
[] -> error mismatchDetails [] -> error mismatchDetails
_ -> error $ "Multiple matching constructors found for class '" ++ className ++ "' with given arguments." _ -> error $ "Multiple matching constructors found for class '" ++ className ++ "' with given arguments."
@ -204,8 +203,8 @@ typeCheckStatementExpression (MethodCall expr methodName args) symtab classes =
let objExprTyped = typeCheckExpression expr symtab classes let objExprTyped = typeCheckExpression expr symtab classes
in case objExprTyped of in case objExprTyped of
TypedExpression objType _ -> TypedExpression objType _ ->
case find (\(Class className _ _ _) -> className == objType) classes of case find (\(Class className _ _ _ _) -> className == objType) classes of
Just (Class _ _ methods _) -> Just (Class className _ _ methods _) ->
let matchParams (ParameterDeclaration paramType _) arg = let matchParams (ParameterDeclaration paramType _) arg =
let argTyped = typeCheckExpression arg symtab classes let argTyped = typeCheckExpression arg symtab classes
argType = getTypeFromExpr argTyped argType = getTypeFromExpr argTyped
@ -215,20 +214,23 @@ typeCheckStatementExpression (MethodCall expr methodName args) symtab classes =
then Just argTyped then Just argTyped
else Nothing else Nothing
matchMethod (MethodDeclaration retType name params _) = matchMethod (MethodDeclaration retType modifier name params _)
let matchedArgs = sequence $ zipWith matchParams params args | modifier == "public" = fmap (\checkedArgs -> (MethodDeclaration retType modifier name params (Block []), checkedArgs)) (sequence $ zipWith matchParams params args)
in fmap (\checkedArgs -> (MethodDeclaration retType name params (Block []), checkedArgs)) matchedArgs | modifier == "private" = if checkAccess className (lookup "this" symtab)
then fmap (\checkedArgs -> (MethodDeclaration retType modifier name params (Block []), checkedArgs)) (sequence $ zipWith matchParams params args)
else Nothing
| otherwise = Nothing
validMethods = filter (\(MethodDeclaration _ name params _, _) -> name == methodName && length params == length args) $ mapMaybe matchMethod methods validMethods = filter (\(MethodDeclaration _ _ name params _, _) -> name == methodName && length params == length args) $ mapMaybe matchMethod methods
expectedSignatures = [ map (\(ParameterDeclaration t _) -> t) params | MethodDeclaration _ name params _ <- methods, name == methodName ] expectedSignatures = [ map (\(ParameterDeclaration t _) -> t) params | MethodDeclaration _ _ name params _ <- methods, name == methodName ]
actualSignature = map (\arg -> getTypeFromExpr (typeCheckExpression arg symtab classes)) args actualSignature = map (\arg -> getTypeFromExpr (typeCheckExpression arg symtab classes)) args
mismatchDetails = "Method not found for class '" ++ objType ++ "' with given arguments.\n" ++ mismatchDetails = "Method not found for class '" ++ objType ++ "' with given arguments.\n" ++
"Expected signatures for method '" ++ methodName ++ "':\n" ++ unlines (map show expectedSignatures) ++ "Expected signatures for method '" ++ methodName ++ "':\n" ++ unlines (map show expectedSignatures) ++
"Actual arguments:\n" ++ show actualSignature "Actual arguments:\n" ++ show actualSignature
in case validMethods of in case validMethods of
[(MethodDeclaration retType _ params _, checkedArgs)] -> [(MethodDeclaration retType _ _ params _, checkedArgs)] ->
TypedStatementExpression retType (MethodCall objExprTyped methodName checkedArgs) TypedStatementExpression retType (MethodCall objExprTyped methodName checkedArgs)
[] -> error mismatchDetails [] -> error mismatchDetails
_ -> error $ "Multiple matching methods found for class '" ++ objType ++ "' and method '" ++ methodName ++ "' with given arguments." _ -> error $ "Multiple matching methods found for class '" ++ objType ++ "' and method '" ++ methodName ++ "' with given arguments."
@ -236,6 +238,7 @@ typeCheckStatementExpression (MethodCall expr methodName args) symtab classes =
Nothing -> error $ "Class for object type '" ++ objType ++ "' not found." Nothing -> error $ "Class for object type '" ++ objType ++ "' not found."
_ -> error "Invalid object type for method call. Object must have a class type." _ -> error "Invalid object type for method call. Object must have a class type."
typeCheckStatementExpression (PostIncrement expr) symtab classes = typeCheckStatementExpression (PostIncrement expr) symtab classes =
let expr' = typeCheckExpression expr symtab classes let expr' = typeCheckExpression expr symtab classes
type' = getTypeFromExpr expr' type' = getTypeFromExpr expr'
@ -292,8 +295,7 @@ typeCheckStatement (If cond thenStmt elseStmt) symtab classes =
then TypedStatement ifType (If cond' thenStmt' elseStmt') then TypedStatement ifType (If cond' thenStmt' elseStmt')
else error "If condition must be of type boolean" else error "If condition must be of type boolean"
typeCheckStatement (LocalVariableDeclaration (VariableDeclaration dataType modifier identifier maybeExpr)) symtab classes =
typeCheckStatement (LocalVariableDeclaration (VariableDeclaration dataType identifier maybeExpr)) symtab classes =
-- Check for redefinition in the current scope -- Check for redefinition in the current scope
if any ((== identifier) . snd) symtab if any ((== identifier) . snd) symtab
then error $ "Variable '" ++ identifier ++ "' is redefined in the same scope" then error $ "Variable '" ++ identifier ++ "' is redefined in the same scope"
@ -307,11 +309,10 @@ typeCheckStatement (LocalVariableDeclaration (VariableDeclaration dataType ident
in case exprType of in case exprType of
Just t Just t
| t == "null" && isObjectType dataType -> | t == "null" && isObjectType dataType ->
TypedStatement dataType (LocalVariableDeclaration (VariableDeclaration dataType identifier checkedExprWithType)) TypedStatement dataType (LocalVariableDeclaration (VariableDeclaration dataType modifier identifier checkedExprWithType))
| t /= dataType -> error $ "Type mismatch in declaration of '" ++ identifier ++ "': expected " ++ dataType ++ ", found " ++ t | t /= dataType -> error $ "Type mismatch in declaration of '" ++ identifier ++ "': expected " ++ dataType ++ ", found " ++ t
| otherwise -> TypedStatement dataType (LocalVariableDeclaration (VariableDeclaration dataType identifier checkedExprWithType)) | otherwise -> TypedStatement dataType (LocalVariableDeclaration (VariableDeclaration dataType modifier identifier checkedExprWithType))
Nothing -> TypedStatement dataType (LocalVariableDeclaration (VariableDeclaration dataType identifier checkedExpr)) Nothing -> TypedStatement dataType (LocalVariableDeclaration (VariableDeclaration dataType modifier identifier checkedExpr))
typeCheckStatement (While cond stmt) symtab classes = typeCheckStatement (While cond stmt) symtab classes =
let cond' = typeCheckExpression cond symtab classes let cond' = typeCheckExpression cond symtab classes
@ -326,7 +327,7 @@ typeCheckStatement (Block statements) symtab classes =
let let
processStatements (accSts, currentSymtab, types) stmt = processStatements (accSts, currentSymtab, types) stmt =
case stmt of case stmt of
LocalVariableDeclaration (VariableDeclaration dataType identifier maybeExpr) -> LocalVariableDeclaration (VariableDeclaration dataType modifier identifier maybeExpr) ->
let let
alreadyDefined = any (\(id, _) -> id == identifier) currentSymtab alreadyDefined = any (\(id, _) -> id == identifier) currentSymtab
newSymtab = if alreadyDefined newSymtab = if alreadyDefined
@ -355,7 +356,6 @@ typeCheckStatement (Block statements) symtab classes =
in TypedStatement blockType (Block checkedStatements) in TypedStatement blockType (Block checkedStatements)
typeCheckStatement (Return expr) symtab classes = typeCheckStatement (Return expr) symtab classes =
let methodReturnType = fromMaybe (error "Method return type not found in symbol table") (lookup "thisMeth" symtab) let methodReturnType = fromMaybe (error "Method return type not found in symbol table") (lookup "thisMeth" symtab)
expr' = case expr of expr' = case expr of
@ -369,7 +369,6 @@ typeCheckStatement (Return expr) symtab classes =
then TypedStatement returnType (Return expr') then TypedStatement returnType (Return expr')
else error $ "Return: Return type mismatch: expected " ++ methodReturnType ++ ", found " ++ returnType else error $ "Return: Return type mismatch: expected " ++ methodReturnType ++ ", found " ++ returnType
typeCheckStatement (StatementExpressionStatement stmtExpr) symtab classes = typeCheckStatement (StatementExpressionStatement stmtExpr) symtab classes =
let stmtExpr' = typeCheckStatementExpression stmtExpr symtab classes let stmtExpr' = typeCheckStatementExpression stmtExpr symtab classes
in TypedStatement (getTypeFromStmtExpr stmtExpr') (StatementExpressionStatement stmtExpr') in TypedStatement (getTypeFromStmtExpr stmtExpr') (StatementExpressionStatement stmtExpr')
@ -385,7 +384,7 @@ isSubtype subType superType classes
| otherwise = False | otherwise = False
isUserDefinedClass :: DataType -> [Class] -> Bool isUserDefinedClass :: DataType -> [Class] -> Bool
isUserDefinedClass dt classes = dt `elem` map (\(Class name _ _ _) -> name) classes isUserDefinedClass dt classes = dt `elem` map (\(Class name _ _ _ _) -> name) classes
isObjectType :: DataType -> Bool isObjectType :: DataType -> Bool
isObjectType dt = dt /= "int" && dt /= "boolean" && dt /= "char" isObjectType dt = dt /= "int" && dt /= "boolean" && dt /= "char"
@ -446,7 +445,6 @@ checkEqualityOperation op expr1' expr2' type1 type2
error $ "Equality operation " ++ show op ++ " requires that null can only be compared with object types. Found types: " ++ type1 ++ " and " ++ type2 error $ "Equality operation " ++ show op ++ " requires that null can only be compared with object types. Found types: " ++ type1 ++ " and " ++ type2
| otherwise = error $ "Equality operation " ++ show op ++ " encountered unexpected types: " ++ type1 ++ " and " ++ type2 | otherwise = error $ "Equality operation " ++ show op ++ " encountered unexpected types: " ++ type1 ++ " and " ++ type2
checkLogicalOperation :: BinaryOperator -> Expression -> Expression -> DataType -> DataType -> Expression checkLogicalOperation :: BinaryOperator -> Expression -> Expression -> DataType -> DataType -> Expression
checkLogicalOperation op expr1' expr2' type1 type2 checkLogicalOperation op expr1' expr2' type1 type2
| type1 == "boolean" && type2 == "boolean" = | type1 == "boolean" && type2 == "boolean" =
@ -457,12 +455,22 @@ resolveNameResolution :: Expression -> Expression -> [(Identifier, DataType)] ->
resolveNameResolution expr1' (Reference ident2) symtab classes = resolveNameResolution expr1' (Reference ident2) symtab classes =
case getTypeFromExpr expr1' of case getTypeFromExpr expr1' of
objType -> objType ->
case find (\(Class className _ _ _) -> className == objType) classes of case find (\(Class className _ _ _ _) -> className == objType) classes of
Just (Class _ _ _ fields) -> Just (Class _ _ _ _ fields) ->
let fieldTypes = [dt | VariableDeclaration dt id _ <- fields, id == ident2] let fieldDetails = [(dt, mod) | VariableDeclaration dt mod id _ <- fields, id == ident2]
in case fieldTypes of className = objType
[resolvedType] -> TypedExpression resolvedType (BinaryOperation NameResolution expr1' (TypedExpression resolvedType (FieldVariable ident2))) in case fieldDetails of
[(resolvedType, mod)] ->
if mod == "public" || (mod == "private" && checkAccess objType (lookup "this" symtab))
then TypedExpression resolvedType (BinaryOperation NameResolution expr1' (TypedExpression resolvedType (FieldVariable ident2)))
else error $ "Field '" ++ ident2 ++ "' is private and cannot be accessed outside its class."
[] -> error $ "Field '" ++ ident2 ++ "' not found in class '" ++ objType ++ "'" [] -> error $ "Field '" ++ ident2 ++ "' not found in class '" ++ objType ++ "'"
_ -> error $ "Ambiguous reference to field '" ++ ident2 ++ "' in class '" ++ objType ++ "'" _ -> error $ "Ambiguous reference to field '" ++ ident2 ++ "' in class '" ++ objType ++ "'"
Nothing -> error $ "Class '" ++ objType ++ "' not found" Nothing -> error $ "Class '" ++ objType ++ "' not found"
resolveNameResolution _ _ _ _ = error "Name resolution requires object reference and field name" resolveNameResolution _ _ _ _ = error "Name resolution requires object reference and field name"
checkAccess :: DataType -> Maybe DataType -> Bool
checkAccess objType (Just thisClass) = objType == thisClass
checkAccess _ Nothing = False