src/Example.hs

@@ -58,7 +58,7 @@ exampleConstructorCall :: Statement
 exampleConstructorCall = LocalVariableDeclaration (VariableDeclaration "Person" "bob" (Just (StatementExpressionExpression  (ConstructorCall "Person" [IntegerLiteral 30]))))
 
 exampleNameResolution :: Expression
-exampleNameResolution = BinaryOperation NameResolution (Reference "b") (Reference "age")
+exampleNameResolution = BinaryOperation NameResolution (Reference "bob2") (Reference "age")
 
 exampleBlockResolution :: Statement
 exampleBlockResolution = Block [
@@ -113,10 +113,12 @@ testClasses = [
         (Block [
             LocalVariableDeclaration (VariableDeclaration "Person" "bob" (Just (StatementExpressionExpression (ConstructorCall "Person" [IntegerLiteral 25])))),
             StatementExpressionStatement (MethodCall (Reference "bob") "setAge" [IntegerLiteral 30]),
-            LocalVariableDeclaration (VariableDeclaration "int" "bobAge" (Just (StatementExpressionExpression (MethodCall (Reference "bob") "getAge" [])))),
+            LocalVariableDeclaration (VariableDeclaration "int" "bobAge" (Just (StatementExpressionExpression (MethodCall (Reference "bob2") "getAge" [])))),
             Return (Just (Reference "bobAge"))
         ])
-    ] []
+    ] [
+        VariableDeclaration "Person" "bob2" Nothing
+    ]
  ]
 
 runTypeCheck :: IO ()
@@ -151,7 +153,7 @@ runTypeCheck = do
 
     catch (do
         print "====================================================================================="
-        evaluatedNameResolution <- evaluate (typeCheckExpression exampleNameResolution [("b", "Person")] sampleClasses)
+        evaluatedNameResolution <- evaluate (typeCheckExpression exampleNameResolution [("this", "Main")] testClasses)
         printSuccess "Type checking of name resolution completed successfully"
         printResult "Result Name Resolution:" evaluatedNameResolution
       ) handleError
@@ -189,7 +191,7 @@ runTypeCheck = do
         let mainClass = fromJust $ find (\(Class className _ _) -> className == "Main") testClasses
         case mainClass of
             Class _ [mainMethod] _ -> do
-                let result = typeCheckMethodDeclaration mainMethod [] testClasses
+                let result = typeCheckMethodDeclaration mainMethod [("this", "Main")] testClasses
                 printSuccess "Full program type checking completed successfully."
                 printResult "Main method result:" result
       ) handleError

src/Typecheck.hs

@@ -10,9 +10,9 @@ typeCheckClass :: Class -> [Class] -> Class
 typeCheckClass (Class className methods fields) classes =
     let
         -- Create a symbol table from class fields and method entries
-        classFields = [(id, dt) | VariableDeclaration dt id _ <- fields]
+        -- TODO: Maybe remove method entries from the symbol table?
         methodEntries = [(methodName, className) | MethodDeclaration _ methodName _ _ <- methods]
-        initalSymTab = ("this", className) : classFields ++ methodEntries
+        initalSymTab = ("this", className) : methodEntries
         checkedMethods = map (\method -> typeCheckMethodDeclaration method initalSymTab classes) methods
     in Class className checkedMethods fields
 
@@ -37,8 +37,21 @@ typeCheckExpression (CharacterLiteral c) _ _ = TypedExpression "char" (Character
 typeCheckExpression (BooleanLiteral b) _ _ = TypedExpression "boolean" (BooleanLiteral b)
 typeCheckExpression NullLiteral _ _ = TypedExpression "null" NullLiteral
 typeCheckExpression (Reference id) symtab classes =
-  let type' = lookupType id symtab
+  case lookup id symtab of
-   in TypedExpression type' (Reference id)
+    Just t -> TypedExpression t (LocalVariable id)
+    Nothing ->
+      case lookup "this" symtab of
+        Just className ->
+          let classDetails = find (\(Class name _ _) -> name == className) classes
+          in case classDetails of
+            Just (Class _ _ fields) ->
+              let fieldTypes = [dt | VariableDeclaration dt fieldId _ <- fields, fieldId == id]
+              in case fieldTypes of
+                [fieldType] -> TypedExpression fieldType (FieldVariable id)
+                [] -> error $ "Field '" ++ id ++ "' not found in class '" ++ className ++ "'"
+                _ -> error $ "Ambiguous reference to field '" ++ id ++ "' in class '" ++ className ++ "'"
+            Nothing -> error $ "Class '" ++ className ++ "' not found for 'this'"
+        Nothing -> error $ "Context for 'this' not found in symbol table, unable to resolve '" ++ id ++ "'"
 typeCheckExpression (BinaryOperation op expr1 expr2) symtab classes =
   let expr1' = typeCheckExpression expr1 symtab classes
       expr2' = typeCheckExpression expr2 symtab classes
@@ -137,18 +150,25 @@ typeCheckExpression (BinaryOperation op expr1 expr2) symtab classes =
               error "Logical OR operation requires two operands of type boolean"
         NameResolution ->
           case (expr1', expr2) of
-              (TypedExpression t1 (Reference obj), Reference member) ->
+            (TypedExpression objType (LocalVariable ident), Reference ident2) ->
-                  let objectType = lookupType obj symtab
+              case find (\(Class className _ _) -> className == objType) classes of
-                      classDetails = find (\(Class className _ _) -> className == objectType) classes
+                Just (Class _ _ fields) ->
-                  in case classDetails of
+                  let fieldTypes = [dt | VariableDeclaration dt id _ <- fields, id == ident2]
-                      Just (Class _ _ fields) ->
+                  in case fieldTypes of
-                          let fieldTypes = [dt | VariableDeclaration dt id _ <- fields, id == member]
+                    [resolvedType] -> TypedExpression resolvedType (BinaryOperation NameResolution expr1' (TypedExpression resolvedType (FieldVariable  ident2)))
-                          in case fieldTypes of
+                    [] -> error $ "Field '" ++ ident2 ++ "' not found in class '" ++ objType ++ "'"
-                              [resolvedType] -> TypedExpression resolvedType (BinaryOperation NameResolution expr1' (TypedExpression resolvedType expr2))
+                    _ -> error $ "Ambiguous reference to field '" ++ ident ++ "' in class '" ++ objType ++ "'"
-                              [] -> error $ "Field '" ++ member ++ "' not found in class '" ++ objectType ++ "'"
+                Nothing -> error $ "Class '" ++ objType ++ "' not found"
-                              _ -> error $ "Ambiguous reference to field '" ++ member ++ "' in class '" ++ objectType ++ "'"
+            (TypedExpression objType (FieldVariable ident), Reference ident2) ->
-                      Nothing -> error $ "Object '" ++ obj ++ "' does not correspond to a known class"
+              case find (\(Class className _ _) -> className == objType) classes of
-              _ -> error "Name resolution requires object reference and field name"
+                Just (Class _ _ fields) ->
+                  let fieldTypes = [dt | VariableDeclaration dt id _ <- fields, id == ident2]
+                  in case fieldTypes of
+                    [resolvedType] -> TypedExpression resolvedType (BinaryOperation NameResolution expr1' (TypedExpression resolvedType (FieldVariable  ident2)))
+                    [] -> error $ "Field '" ++ ident2 ++ "' not found in class '" ++ objType ++ "'"
+                    _ -> error $ "Ambiguous reference to field '" ++ ident ++ "' in class '" ++ objType ++ "'"
+                Nothing -> error $ "Class '" ++ objType ++ "' not found"
+            _ -> error "Name resolution requires object reference and field name"
 
 typeCheckExpression (UnaryOperation op expr) symtab classes =
   let expr' = typeCheckExpression expr symtab classes
@@ -177,12 +197,14 @@ typeCheckStatementExpression :: StatementExpression -> [(Identifier, DataType)]
 typeCheckStatementExpression (Assignment id expr) symtab classes =
   let expr' = typeCheckExpression expr symtab classes
       type' = getTypeFromExpr expr'
-      type'' = lookupType id symtab
+      maybeType'' = lookupType id symtab
-   in if type' == type''
+   in case maybeType'' of
-        then
+        Just type'' ->
-          TypedStatementExpression type' (Assignment id expr')
+          if type' == type'' then
-        else
+            TypedStatementExpression type' (Assignment id expr')
-          error "Assignment type mismatch"
+          else
+            error $ "Assignment type mismatch: expected " ++ type'' ++ ", found " ++ type'
+        Nothing -> error $ "Identifier '" ++ id ++ "' not found in symbol table"
 
 typeCheckStatementExpression (ConstructorCall className args) symtab classes =
   case find (\(Class name _ _) -> name == className) classes of
@@ -327,8 +349,8 @@ unifyReturnTypes dt1 dt2
     | dt1 == dt2 = dt1
     | otherwise  = "Object"
 
-lookupType :: Identifier -> [(Identifier, DataType)] -> DataType
+lookupType :: Identifier -> [(Identifier, DataType)] -> Maybe DataType
 lookupType id symtab =
   case lookup id symtab of
-    Just t  -> t
+    Just t  -> Just t
-    Nothing -> error ("Identifier " ++ id ++ " not found in symbol table")
+    Nothing -> Nothing