src/Typecheck.hs

@@ -141,9 +141,9 @@ typeCheckStatementExpression (Assignment ref expr) symtab classes =
 typeCheckStatementExpression (ConstructorCall className args) symtab classes =
   case find (\(Class name _ _) -> name == className) classes of
     Nothing -> error $ "Class '" ++ className ++ "' not found."
-    Just (Class _ methods fields) ->
+    Just (Class _ methods _) ->
       -- Find constructor matching the class name with void return type
-      case find (\(MethodDeclaration retType name params _) -> name == "<init>" && retType == "void") methods of
+      case find (\(MethodDeclaration _ name params _) -> name == "<init>") methods of
         -- If no constructor is found, assume standard constructor with no parameters
         Nothing ->
           if null args then
@@ -151,21 +151,28 @@ typeCheckStatementExpression (ConstructorCall className args) symtab classes =
           else
             error $ "No valid constructor found for class '" ++ className ++ "', but arguments were provided."
         Just (MethodDeclaration _ _ params _) ->
-          let
+          let args' = zipWith
-            args' = map (\arg -> typeCheckExpression arg symtab classes) args
+                  (\arg (ParameterDeclaration paramType _) ->
-            -- Extract expected parameter types from the constructor's parameters
+                    let argTyped = typeCheckExpression arg symtab classes
-            expectedTypes = [dataType | ParameterDeclaration dataType _ <- params]
+                    in if getTypeFromExpr argTyped == "null" && isObjectType paramType
-            argTypes = map getTypeFromExpr args'
+                      then TypedExpression paramType NullLiteral
-            -- Check if the types of the provided arguments match the expected types
+                      else argTyped
-            typeMatches = zipWith (\expected actual -> if expected == actual then Nothing else Just (expected, actual)) expectedTypes argTypes
+                  ) args params
-            mismatchErrors = map (\(exp, act) -> "Expected type '" ++ exp ++ "', found '" ++ act ++ "'.") (catMaybes typeMatches)
+              expectedTypes = [dataType | ParameterDeclaration dataType _ <- params]
+              argTypes = map getTypeFromExpr args'
+              typeMatches = zipWith
+                  (\expType argType -> (expType == argType || (argType == "null" && isObjectType expType), expType, argType))
+                  expectedTypes argTypes
+              mismatches = filter (not . fst3) typeMatches
+              fst3 (a, _, _) = a
           in
-            if length args /= length params then
+            if null mismatches && length args == length params then
-              error $ "Constructor for class '" ++ className ++ "' expects " ++ show (length params) ++ " arguments, but got " ++ show (length args) ++ "."
-            else if not (null mismatchErrors) then
-              error $ unlines $ ("Type mismatch in constructor arguments for class '" ++ className ++ "':") : mismatchErrors
-            else
               TypedStatementExpression className (ConstructorCall className args')
+            else if not (null mismatches) then
+              error $ unlines $ ("Type mismatch in constructor arguments for class '" ++ className ++ "':")
+                  : [ "Expected: " ++ expType ++ ", Found: " ++ argType | (_, expType, argType) <- mismatches ]
+            else
+              error $ "Incorrect number of arguments for constructor of class '" ++ className ++ "'. Expected " ++ show (length expectedTypes) ++ ", found " ++ show (length args) ++ "."
 
 typeCheckStatementExpression (MethodCall expr methodName args) symtab classes =
     let objExprTyped = typeCheckExpression expr symtab classes