add new constructortypecheck with overloading

Test/JavaSources/TestConstructorOverload.java

@@ -0,0 +1,13 @@
+public class TestConstructorOverload {
+
+    TestConstructorOverload() {
+    }
+
+    TestConstructorOverload(int a) {
+    }
+
+    public void test() {
+        int a = 3;
+        TestConstructorOverload test = new TestConstructorOverload(a);
+    }
+}

Test/JavaSources/TestSingleton.java

@@ -0,0 +1,15 @@
+public class TestSingleton {
+
+    TestSingleton instance;
+
+    TestSingleton() {
+    }
+
+    public TestSingleton getInstance() {
+        if (instance == null) {
+            instance = new TestSingleton();
+        }
+        return instance;
+    }
+
+}

src/Typecheck.hs

@@ -3,18 +3,35 @@ import Data.List (find)
 import Data.Maybe
 import Ast
 
+
 typeCheckCompilationUnit :: CompilationUnit -> CompilationUnit
 typeCheckCompilationUnit classes = map (`typeCheckClass` classes) classes
 
 typeCheckClass :: Class -> [Class] -> Class
-typeCheckClass (Class className methods fields) classes =
+typeCheckClass (Class className constructors methods fields) classes =
     let
         -- 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.
         initalSymTab = [("this", className)]
+        checkedConstructors = map (\constructor -> typeCheckConstructorDeclaration constructor initalSymTab classes) constructors
         checkedMethods = map (\method -> typeCheckMethodDeclaration method initalSymTab classes) methods
         checkedFields = map (\field -> typeCheckVariableDeclaration field initalSymTab classes) fields
-    in Class className checkedMethods checkedFields
+    in Class className checkedConstructors checkedMethods checkedFields
+
+typeCheckConstructorDeclaration :: ConstructorDeclaration -> [(Identifier, DataType)] -> [Class] -> ConstructorDeclaration
+typeCheckConstructorDeclaration (ConstructorDeclaration name params body) symtab classes =
+    let
+        constructorParams = [(identifier, dataType) | ParameterDeclaration dataType identifier <- params]
+        initialSymtab = symtab ++ constructorParams
+        className = fromMaybe (error "Constructor Declaration: 'this' not found in symtab") (lookup "this" symtab)
+        checkedBody = typeCheckStatement body initialSymtab classes
+        bodyType = getTypeFromStmt checkedBody
+    in if name == className
+       then if bodyType == "void"
+            then ConstructorDeclaration name params checkedBody
+            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
+
 
 typeCheckMethodDeclaration :: MethodDeclaration -> [(Identifier, DataType)] -> [Class] -> MethodDeclaration
 typeCheckMethodDeclaration (MethodDeclaration retType name params body) symtab classes =
@@ -63,9 +80,9 @@ typeCheckExpression (Reference id) symtab classes =
     Nothing ->
       case lookup "this" symtab of
         Just className ->
-          let classDetails = find (\(Class name _ _) -> name == className) classes
+          let classDetails = find (\(Class name _ _ _) -> name == className) classes
           in case classDetails of
-            Just (Class _ _ fields) ->
+            Just (Class _ _ _ fields) ->
               let fieldTypes = [dt | VariableDeclaration dt 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
               in case fieldTypes of
@@ -139,40 +156,36 @@ typeCheckStatementExpression (Assignment ref expr) 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."
-    Just (Class _ methods _) ->
-      -- Find constructor matching the class name with void return type
-      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
-            TypedStatementExpression className (ConstructorCall className args)
-          else
-            error $ "No valid constructor found for class '" ++ className ++ "', but arguments were provided."
-        Just (MethodDeclaration _ _ params _) ->
-          let args' = zipWith
-                  (\arg (ParameterDeclaration paramType _) ->
-                    let argTyped = typeCheckExpression arg symtab classes
-                    in if getTypeFromExpr argTyped == "null" && isObjectType paramType
-                      then TypedExpression paramType NullLiteral
-                      else argTyped
-                  ) args params
-              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 null mismatches && length args == length params then
-              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) ++ "."
+    Just (Class _ constructors _ _) ->
+      let
+        matchParams (ParameterDeclaration paramType _) arg =
+          let argTyped = typeCheckExpression arg symtab classes
+              argType = getTypeFromExpr argTyped
+          in if argType == "null" && isObjectType paramType
+             then Just (TypedExpression paramType NullLiteral)
+             else if argType == paramType
+             then Just argTyped
+             else Nothing
+
+        matchConstructor (ConstructorDeclaration name params _) =
+          let matchedArgs = sequence $ zipWith matchParams params args
+          in fmap (\checkedArgs -> (params, checkedArgs)) matchedArgs
+
+        validConstructors = filter (\(params, _) -> length params == length args) $ mapMaybe matchConstructor constructors
+
+        expectedSignatures = [ map (\(ParameterDeclaration t _) -> t) params | ConstructorDeclaration _ params _ <- constructors ]
+        actualSignature = map (\arg -> getTypeFromExpr (typeCheckExpression arg symtab classes)) args
+        mismatchDetails = "Constructor not found for class '" ++ className ++ "' with given arguments.\n" ++
+                          "Expected signatures:\n" ++  show expectedSignatures ++
+                          "\nActual arguments:" ++ show actualSignature
+
+      in case validConstructors of
+           [(_, checkedArgs)] ->
+             TypedStatementExpression className (ConstructorCall className checkedArgs)
+           [] -> error mismatchDetails
+           _  -> error $ "Multiple matching constructors found for class '" ++ className ++ "' with given arguments."
 
 typeCheckStatementExpression (MethodCall expr methodName args) symtab classes =
     let objExprTyped = typeCheckExpression expr symtab classes
@@ -181,7 +194,7 @@ typeCheckStatementExpression (MethodCall expr methodName args) symtab classes =
             case find (\(Class className _ _ _) -> className == objType) classes of
                 Just (Class _ _ methods _) ->
                     let matchParams (ParameterDeclaration paramType _) arg =
-                                        let argTyped = typeCheckExpression arg symtab classes
+                            let argTyped = typeCheckExpression arg symtab classes
                                 argType = getTypeFromExpr argTyped
                             in if argType == "null" && isObjectType paramType
                                then Just (TypedExpression paramType NullLiteral)
@@ -359,7 +372,7 @@ isSubtype subType superType classes
   | otherwise = False
 
 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 dt = dt /= "int" && dt /= "boolean" && dt /= "char"
@@ -431,8 +444,8 @@ resolveNameResolution :: Expression -> Expression -> [(Identifier, DataType)] ->
 resolveNameResolution expr1' (Reference ident2) symtab classes =
   case getTypeFromExpr expr1' of
     objType ->
-      case find (\(Class className _ _) -> className == objType) classes of
-        Just (Class _ _ fields) ->
+      case find (\(Class className _ _ _) -> className == objType) classes of
+        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)))