fix constructor not handling nullliterals correctly

Reviewed-on: #5

README.md

@@ -5,7 +5,7 @@ Written in Haskell.
 # Cabal Commands
 run main
 ```
-cabal run
+cabal run compiler <FILENAME>
 ```
 
 run tests

Test/JavaSources/TestRecursion.java

@@ -5,7 +5,7 @@ public class TestRecursion {
 
     public TestRecursion(int n)
     {
-        value = n;
+        this.value = n;
 
         if(n > 0)
         {

Test/TestParser.hs

@@ -204,6 +204,13 @@ testExpressionConstructorCall = TestCase $
     assertEqual "expect constructor call" (StatementExpressionExpression (ConstructorCall "Foo" [])) $
     parseExpression [NEW,IDENTIFIER "Foo",LBRACE,RBRACE]
 
+testExpresssionExternalMethodCall = TestCase $
+    assertEqual "expect method call on sub" (StatementExpressionExpression (MethodCall (Reference "Obj") "foo" [])) $
+    parseExpression [IDENTIFIER "Obj",DOT,IDENTIFIER "foo",LBRACE,RBRACE]
+testExpressionAssignWithThis = TestCase $
+    assertEqual "expect assignment on Field" (StatementExpressionExpression (Assignment (BinaryOperation NameResolution (Reference "this") (Reference "x")) (Reference "y"))) $
+    parseExpression [THIS,DOT,IDENTIFIER "x",ASSIGN,IDENTIFIER "y"]
+
 testStatementIfThen = TestCase $
     assertEqual "expect empty ifthen" [If (Reference "a") (Block [Block []]) Nothing] $
     parseStatement [IF,LBRACE,IDENTIFIER "a",RBRACE,LBRACKET,RBRACKET]
@@ -292,6 +299,8 @@ tests = TestList [
     testExpressionSimpleFieldAccess,
     testExpressionFieldSubAccess,
     testExpressionConstructorCall,
+    testExpresssionExternalMethodCall,
+    testExpressionAssignWithThis,
     testStatementIfThen,
     testStatementIfThenElse,
     testStatementWhile,

src/Parser/JavaParser.y

@@ -265,6 +265,7 @@ conditionalorexpression : conditionalandexpression { $1 }
                 --  | conditionalorexpression LOGICALOR conditionalandexpression{ }
 
 lefthandside     : name { $1 }
+                 | primary DOT IDENTIFIER { BinaryOperation NameResolution $1 (Reference $3) }
 
 assignmentoperator : ASSIGN { Nothing }
                  | TIMESEQUAL { Just Multiplication }
@@ -287,8 +288,8 @@ postincrementexpression : postfixexpression INCREMENT { PostIncrement $1 }
 
 postdecrementexpression : postfixexpression DECREMENT { PostDecrement $1 }
 
-methodinvocation : simplename LBRACE   RBRACE  { MethodCall (Reference "this") $1 []  }
-                 | simplename LBRACE argumentlist RBRACE { MethodCall (Reference "this") $1 $3 }
+methodinvocation : name LBRACE RBRACE  { let (exp, functionname) = extractFunctionName $1 in (MethodCall exp functionname []) }
+                 | name LBRACE argumentlist RBRACE { let (exp, functionname) = extractFunctionName $1 in (MethodCall exp functionname $3) }
                  | primary  DOT IDENTIFIER LBRACE RBRACE  { MethodCall $1 $3 [] }
                  | primary  DOT IDENTIFIER LBRACE argumentlist  RBRACE  { MethodCall $1 $3 $5 }
      
@@ -374,8 +375,9 @@ data Declarator = Declarator Identifier (Maybe Expression)
 convertDeclarator :: DataType -> Declarator -> VariableDeclaration
 convertDeclarator dataType (Declarator id assigment) = VariableDeclaration dataType id assigment
 
-data StatementWithoutSub =  Statement
-
+extractFunctionName :: Expression -> (Expression, Identifier)
+extractFunctionName (BinaryOperation NameResolution exp (Reference functionname)) = (exp, functionname)
+extractFunctionName (Reference functionname) = ((Reference "this"), functionname)
 
 parseError :: ([Token], [String]) -> a
 parseError (errortoken, expected) = error ("parse error on token: " ++ show errortoken ++ "\nexpected one of:      " ++ show expected)

src/Typecheck.hs

@@ -37,14 +37,18 @@ typeCheckVariableDeclaration (VariableDeclaration dataType identifier maybeExpr)
         -- Type check the initializer expression if it exists
         checkedExpr = fmap (\expr -> typeCheckExpression expr symtab classes) maybeExpr
         exprType = fmap getTypeFromExpr checkedExpr
+        checkedExprWithType = case exprType of
+            Just "null" | isObjectType dataType -> Just (TypedExpression dataType NullLiteral)
+            _ -> checkedExpr
     in case (validType, redefined, exprType) of
         (False, _, _) -> error $ "Type '" ++ dataType ++ "' is not a valid type for variable '" ++ identifier ++ "'"
         (_, True, _) -> error $ "Variable '" ++ identifier ++ "' is redefined in the same scope"
         (_, _, Just t)
-            | t == "null" && isObjectType dataType -> VariableDeclaration dataType identifier checkedExpr
+            | t == "null" && isObjectType dataType -> VariableDeclaration dataType identifier checkedExprWithType
             | t /= dataType -> error $ "Type mismatch in declaration of '" ++ identifier ++ "': expected " ++ dataType ++ ", found " ++ t
-            | otherwise -> VariableDeclaration dataType identifier checkedExpr
-        (_, _, Nothing) -> VariableDeclaration dataType identifier checkedExpr
+            | otherwise -> VariableDeclaration dataType identifier checkedExprWithType
+        (_, _, Nothing) -> VariableDeclaration dataType identifier checkedExprWithType
+
 
 -- ********************************** Type Checking: Expressions **********************************
 
@@ -125,18 +129,21 @@ typeCheckStatementExpression (Assignment ref expr) symtab classes =
       ref' = typeCheckExpression ref symtab classes
       type' = getTypeFromExpr expr'
       type'' = getTypeFromExpr ref'
+      typeToAssign = if type' == "null" && isObjectType type'' then type'' else type'
+      exprWithType = if type' == "null" && isObjectType type'' then TypedExpression type'' NullLiteral else expr'
   in
-    if type'' == type' || (type' == "null" && isObjectType type'') then
-      TypedStatementExpression type'' (Assignment ref' expr')
+    if type'' == typeToAssign then
+      TypedStatementExpression type'' (Assignment ref' exprWithType)
     else
-      error $ "Type mismatch in assignment to variable: expected " ++ type'' ++ ", found " ++ type'
+      error $ "Type mismatch in assignment to variable: expected " ++ type'' ++ ", found " ++ typeToAssign
+
 
 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
@@ -144,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
-            args' = map (\arg -> typeCheckExpression arg symtab classes) args
-            -- Extract expected parameter types from the constructor's parameters
-            expectedTypes = [dataType | ParameterDeclaration dataType _ <- params]
-            argTypes = map getTypeFromExpr args'
-            -- Check if the types of the provided arguments match the expected types
-            typeMatches = zipWith (\expected actual -> if expected == actual then Nothing else Just (expected, actual)) expectedTypes argTypes
-            mismatchErrors = map (\(exp, act) -> "Expected type '" ++ exp ++ "', found '" ++ act ++ "'.") (catMaybes typeMatches)
+          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 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
+            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) ++ "."
 
 typeCheckStatementExpression (MethodCall expr methodName args) symtab classes =
     let objExprTyped = typeCheckExpression expr symtab classes
@@ -168,24 +182,30 @@ typeCheckStatementExpression (MethodCall expr methodName args) symtab classes =
                 Just (Class _ methods _) ->
                     case find (\(MethodDeclaration retType name params _) -> name == methodName) methods of
                         Just (MethodDeclaration retType _ params _) ->
-                            let args' = map (\arg -> typeCheckExpression arg symtab classes) args
+                            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, expType, argType)) expectedTypes argTypes
+                                typeMatches = zipWith
+                                    (\expType argType -> (expType == argType || (argType == "null" && isObjectType expType), expType, argType))
+                                    expectedTypes argTypes
                                 mismatches = filter (not . fst3) typeMatches
-                                    where fst3 (a, _, _) = a
-                            in
-                                if null mismatches && length args == length params then
-                                    TypedStatementExpression retType (MethodCall objExprTyped methodName args')
-                                else if not (null mismatches) then
-                                    error $ unlines $ ("Argument type mismatches for method '" ++ methodName ++ "':")
+                                fst3 (a, _, _) = a
+                            in if null mismatches && length args == length params
+                                then TypedStatementExpression retType (MethodCall objExprTyped methodName args')
+                                else if not (null mismatches)
+                                    then error $ unlines $ ("Argument type mismatches for method '" ++ methodName ++ "':")
                                         : [ "Expected: " ++ expType ++ ", Found: " ++ argType | (_, expType, argType) <- mismatches ]
-                                else
-                                    error $ "Incorrect number of arguments for method '" ++ methodName ++ "'. Expected " ++ show (length expectedTypes) ++ ", found " ++ show (length args) ++ "."
+                                    else error $ "Incorrect number of arguments for method '" ++ methodName ++ "'. Expected " ++ show (length expectedTypes) ++ ", found " ++ show (length args) ++ "."
                         Nothing -> error $ "Method '" ++ methodName ++ "' not found in class '" ++ objType ++ "'."
                 Nothing -> error $ "Class for object type '" ++ objType ++ "' not found."
         _ -> error "Invalid object type for method call. Object must have a class type."
-
+        
 typeCheckStatementExpression (PostIncrement expr) symtab classes =
   let expr' = typeCheckExpression expr symtab classes
       type' = getTypeFromExpr expr'
@@ -251,14 +271,18 @@ typeCheckStatement (LocalVariableDeclaration (VariableDeclaration dataType ident
         -- If there's an initializer expression, type check it
         let checkedExpr = fmap (\expr -> typeCheckExpression expr symtab classes) maybeExpr
             exprType = fmap getTypeFromExpr checkedExpr
+            checkedExprWithType = case (exprType, dataType) of
+                (Just "null", _) | isObjectType dataType -> Just (TypedExpression dataType NullLiteral)
+                _ -> checkedExpr
         in case exprType of
             Just t
                 | t == "null" && isObjectType dataType ->
-                    TypedStatement dataType (LocalVariableDeclaration (VariableDeclaration dataType identifier checkedExpr))
+                    TypedStatement dataType (LocalVariableDeclaration (VariableDeclaration dataType identifier checkedExprWithType))
                 | t /= dataType -> error $ "Type mismatch in declaration of '" ++ identifier ++ "': expected " ++ dataType ++ ", found " ++ t
-                | otherwise -> TypedStatement dataType (LocalVariableDeclaration (VariableDeclaration dataType identifier checkedExpr))
+                | otherwise -> TypedStatement dataType (LocalVariableDeclaration (VariableDeclaration dataType identifier checkedExprWithType))
             Nothing -> TypedStatement dataType (LocalVariableDeclaration (VariableDeclaration dataType identifier checkedExpr))
 
+
 typeCheckStatement (While cond stmt) symtab classes =
   let cond' = typeCheckExpression cond symtab classes
       stmt' =  typeCheckStatement stmt symtab classes
@@ -305,13 +329,17 @@ typeCheckStatement (Block statements) symtab classes =
 typeCheckStatement (Return expr) symtab classes =
   let methodReturnType = fromMaybe (error "Method return type not found in symbol table") (lookup "thisMeth" symtab)
       expr' = case expr of
-        Just e  -> Just (typeCheckExpression e symtab classes)
+        Just e  -> let eTyped = typeCheckExpression e symtab classes
+                   in if getTypeFromExpr eTyped == "null" && isObjectType methodReturnType 
+                      then Just (TypedExpression methodReturnType NullLiteral) 
+                      else Just eTyped
         Nothing -> Nothing
       returnType = maybe "void" getTypeFromExpr expr'
   in if returnType == methodReturnType || isSubtype returnType methodReturnType classes
        then TypedStatement returnType (Return expr')
        else error $ "Return: Return type mismatch: expected " ++ methodReturnType ++ ", found " ++ returnType
 
+
 typeCheckStatement (StatementExpressionStatement stmtExpr) symtab classes =
   let stmtExpr' = typeCheckStatementExpression stmtExpr symtab classes
    in TypedStatement (getTypeFromStmtExpr stmtExpr') (StatementExpressionStatement stmtExpr')