add name resolution, fix symbol table key, value switchup

src/Ast.hs

@@ -1,18 +1,20 @@
 module Ast where
 
+import Data.List (find)
+
 type CompilationUnit = [Class] 
 
 type DataType = 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 ->
-        NameResolution -> TypedExpression type1 (BinaryOperation op expr1' expr2')
+          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)
+                If {} -> (accSts ++ [checkedStmt], currentSymtab, if stmtType /= "void" then types ++ [stmtType] else types)
-                While _ _ -> (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)
+                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