Test/JavaSources/Main.java

@@ -16,7 +16,6 @@ public class Main {
         TestRecursion recursion = new TestRecursion(10);
         TestMalicious malicious = new TestMalicious();
         TestLoop loop = new TestLoop();
-        TestMethodOverload overload = new TestMethodOverload();
 
         // constructing a basic class works
         assert empty != null;
@@ -35,12 +34,6 @@ public class Main {
         // self-referencing methods work.
         assert recursion.fibonacci(15) == 610;
         assert loop.factorial(5) == 120;
-        // methods with the same name but different parameters work
-        assert overload.MethodOverload() == 42;
-        assert overload.MethodOverload(15) == 42 + 15;
-        // constructor overloading works, too.
-        assert (new TestConstructorOverload()).a == 42;
-        assert (new TestConstructorOverload(12)).a == 12;
         // intentionally dodgy expressions work
         assert malicious.assignNegativeIncrement(42) == -42;
         assert malicious.tripleAddition(1, 2, 3) == 6;

Test/JavaSources/TestConstructorOverload.java

@@ -1,12 +1,13 @@
 public class TestConstructorOverload {
 
-    public int a = 42;
-
     TestConstructorOverload() {
-        // nothing here, so a will assume the default value 42.
     }
 
     TestConstructorOverload(int a) {
-        this.a = a;
+    }
+
+    public void test() {
+        int a = 3;
+        TestConstructorOverload test = new TestConstructorOverload(a);
     }
 }

Test/JavaSources/TestMethodOverload.java

@@ -1,10 +1,14 @@
 public class TestMethodOverload {
 
-    public int MethodOverload() {
-        return 42;
+    public void MethodOverload() {
     }
 
-    public int MethodOverload(int a) {
-        return 42 + a;
+    public void MethodOverload(int a) {
     }
+
+    public void test() {
+        int a = 3;
+        MethodOverload(a);
+    }
+    
 }

project.cabal

@@ -18,6 +18,7 @@ executable compiler
     other-modules:      Parser.Lexer,
                         Parser.JavaParser,
                         Ast,
+                        Example,
                         Typecheck,
                         ByteCode.Util,
                         ByteCode.ByteUtil,

src/ByteCode/Builder.hs

@@ -56,13 +56,10 @@ methodBuilder (MethodDeclaration returntype name parameters statement) input = l
             methods = methods input ++ [method]
         }
 
-constructorBuilder :: ClassFileBuilder ConstructorDeclaration
-constructorBuilder (ConstructorDeclaration name parameters statement) = methodBuilder (MethodDeclaration "void" "<init>" parameters statement)
-
 
 methodAssembler :: ClassFileBuilder MethodDeclaration
 methodAssembler (MethodDeclaration returntype name parameters statement) input = let
-        methodConstantIndex = findMethodIndex input (MethodDeclaration returntype name parameters statement) 
+        methodConstantIndex = findMethodIndex input name
     in case methodConstantIndex of
         Nothing -> error ("Cannot find method entry in method pool for method: " ++ name)
         Just index -> let
@@ -87,12 +84,9 @@ methodAssembler (MethodDeclaration returntype name parameters statement) input =
                             methods = pre ++ (assembledMethod : post)
                         }
 
-constructorAssembler :: ClassFileBuilder ConstructorDeclaration
-constructorAssembler (ConstructorDeclaration name parameters statement) = methodAssembler (MethodDeclaration "void" "<init>" parameters statement)
-
 
 classBuilder :: ClassFileBuilder Class
-classBuilder (Class name constructors methods fields) _ = let
+classBuilder (Class name methods fields) _ = let
         baseConstants = [
             ClassInfo 4,
             MethodRefInfo 1 3,
@@ -114,15 +108,15 @@ classBuilder (Class name constructors methods fields) _ = let
             attributes = []
         }
 
+        -- if a class has no constructor, inject an empty one.
+        methodsWithInjectedConstructor = injectDefaultConstructor methods
         -- for every constructor, prepend all initialization assignments for fields.
-        constructorsWithInitializers = injectFieldInitializers name fields constructors
+        methodsWithInjectedInitializers = injectFieldInitializers name fields methodsWithInjectedConstructor
 
-        -- add fields, then method bodies, then constructor bodies to the classfile. After all referable names are known,
-        -- assemble the methods and constructors into bytecode.
-        fieldsAdded = foldr fieldBuilder nakedClassFile fields
-        methodsAdded = foldr methodBuilder fieldsAdded methods
-        constructorsAdded = foldr constructorBuilder methodsAdded constructorsWithInitializers
-        methodsAssembled = foldr methodAssembler constructorsAdded methods
-        constructorsAssembled = foldr constructorAssembler methodsAssembled constructorsWithInitializers
+        -- add fields, then method bodies to the classfile. After all referable names are known,
+        -- assemble the methods into bytecode.
+        classFileWithFields = foldr fieldBuilder nakedClassFile fields
+        classFileWithMethods = foldr methodBuilder classFileWithFields methodsWithInjectedInitializers
+        classFileWithAssembledMethods = foldr methodAssembler classFileWithMethods methodsWithInjectedInitializers
     in
-        constructorsAssembled
+        classFileWithAssembledMethods

src/ByteCode/Util.hs

@@ -1,5 +1,3 @@
-{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
-{-# HLINT ignore "Use lambda-case" #-}
 module ByteCode.Util where
 
 import Data.Int
@@ -133,12 +131,11 @@ comparisonOffset anything_else = Nothing
 isComparisonOperation :: Operation -> Bool
 isComparisonOperation op = isJust (comparisonOffset op)
 
-findMethodIndex :: ClassFile -> MethodDeclaration -> Maybe Int
-findMethodIndex classFile (MethodDeclaration rtype name params stmt) = let
+findMethodIndex :: ClassFile -> String -> Maybe Int
+findMethodIndex classFile name = let
         constants = constantPool classFile
-        descriptor = methodDescriptor (MethodDeclaration rtype name params stmt)
     in
-        findIndex (\method -> memberInfoIsMethod constants method && memberInfoName constants method == name && memberInfoDescriptor constants method == descriptor) (methods classFile)
+        findIndex (\method -> memberInfoIsMethod constants method && memberInfoName constants method == name) (methods classFile)
 
 findClassIndex :: [ConstantInfo] -> String -> Maybe Int
 findClassIndex constants name = let
@@ -214,11 +211,16 @@ findMemberIndex constants (cname, fname, ftype) = let
         allMembers = getKnownMembers constants
         desiredMember = find (\(index, (c, f, ft)) -> (c, f, ft) == (cname, fname, ftype)) allMembers
     in
-        fmap fst desiredMember
+        fmap (\(index, _) -> index) desiredMember
 
-injectFieldInitializers :: String -> [VariableDeclaration] -> [ConstructorDeclaration] -> [ConstructorDeclaration]
-injectFieldInitializers classname vars constructors = let
-        initializers = mapMaybe (\variable -> case variable of
+injectDefaultConstructor :: [MethodDeclaration] -> [MethodDeclaration]
+injectDefaultConstructor pre
+    | any (\(MethodDeclaration _ name _ _) -> name == "<init>") pre = pre
+    | otherwise = pre ++ [MethodDeclaration "void" "<init>" [] (TypedStatement "void" (Block []))]
+
+injectFieldInitializers :: String -> [VariableDeclaration] -> [MethodDeclaration] -> [MethodDeclaration]
+injectFieldInitializers classname vars pre = let
+        initializers = mapMaybe (\(variable) -> case variable of
                 VariableDeclaration dtype name (Just initializer) -> Just (
                         TypedStatement dtype (
                             StatementExpressionStatement (
@@ -233,11 +235,10 @@ injectFieldInitializers classname vars constructors = let
                 otherwise -> Nothing
             ) vars
     in
-        map (\con -> let
-                    ConstructorDeclaration classname params (TypedStatement "void" (Block statements)) = con
-                in
-                    ConstructorDeclaration classname params (TypedStatement "void" (Block (initializers ++ statements)))
-            ) constructors
+        map (\method -> case method of
+                MethodDeclaration "void" "<init>" params (TypedStatement "void" (Block statements)) -> MethodDeclaration "void" "<init>" params (TypedStatement "void" (Block (initializers ++ statements)))
+                _ -> method
+            ) pre
 
 -- effect of one instruction/operation on the stack
 operationStackCost :: [ConstantInfo] -> Operation -> Int

src/Example.hs

@@ -0,0 +1,267 @@
+module Example where
+
+import Ast
+import Typecheck
+import Control.Exception (catch, evaluate, SomeException, displayException)
+import Control.Exception.Base
+import System.IO (stderr, hPutStrLn)
+import Data.Maybe
+import Data.List
+
+green, red, yellow, blue, magenta, cyan, white :: String -> String
+green str = "\x1b[32m" ++ str ++ "\x1b[0m"
+red str = "\x1b[31m" ++ str ++ "\x1b[0m"
+yellow str = "\x1b[33m" ++ str ++ "\x1b[0m"
+blue str = "\x1b[34m" ++ str ++ "\x1b[0m"
+magenta str = "\x1b[35m" ++ str ++ "\x1b[0m"
+cyan str = "\x1b[36m" ++ str ++ "\x1b[0m"
+white str = "\x1b[37m" ++ str ++ "\x1b[0m"
+
+printSuccess :: String -> IO ()
+printSuccess msg = putStrLn $ green "Success:" ++ white msg
+
+handleError :: SomeException -> IO ()
+handleError e = hPutStrLn stderr $ red ("Error: " ++ displayException e)
+
+printResult :: Show a => String -> a -> IO ()
+printResult title result = do
+    putStrLn $ green title
+    print result
+
+sampleClasses :: [Class]
+sampleClasses = [
+    Class "Person" [
+        MethodDeclaration "void" "setAge" [ParameterDeclaration "int" "newAge"]
+        (Block [
+            LocalVariableDeclaration (VariableDeclaration "int" "age" (Just (Reference "newAge")))
+        ]),
+        MethodDeclaration "int" "getAge" [] (Return (Just (Reference "age"))),
+        MethodDeclaration "Person" "Person" [ParameterDeclaration "int" "initialAge"] (Block [])
+    ] [
+        VariableDeclaration "int" "age" (Just (IntegerLiteral 25))
+    ]
+ ]
+
+initialSymtab :: [(DataType, Identifier)]
+initialSymtab = []
+
+exampleExpression :: Expression
+exampleExpression = BinaryOperation NameResolution (Reference "bob") (Reference "age")
+
+exampleAssignment :: Expression
+exampleAssignment = StatementExpressionExpression (Assignment (Reference "a") (IntegerLiteral 30))
+
+exampleMethodCall :: Statement
+exampleMethodCall = StatementExpressionStatement (MethodCall (Reference "this") "setAge" [IntegerLiteral 30])
+
+exampleConstructorCall :: Statement
+exampleConstructorCall = LocalVariableDeclaration (VariableDeclaration "Person" "bob" (Just (StatementExpressionExpression  (ConstructorCall "Person" [IntegerLiteral 30]))))
+
+exampleNameResolution :: Expression
+exampleNameResolution = BinaryOperation NameResolution (Reference "bob2") (Reference "age")
+
+exampleBlockResolution :: Statement
+exampleBlockResolution = Block [
+    LocalVariableDeclaration (VariableDeclaration "Person" "bob" (Just (StatementExpressionExpression  (ConstructorCall "Person" [IntegerLiteral 30])))),
+    LocalVariableDeclaration (VariableDeclaration "int" "age" (Just (StatementExpressionExpression (MethodCall (Reference "bob") "getAge" [])))),
+    StatementExpressionStatement (MethodCall (Reference "bob") "setAge" [IntegerLiteral 30])
+    ]
+
+exampleBlockResolutionFail :: Statement
+exampleBlockResolutionFail = Block [
+    LocalVariableDeclaration (VariableDeclaration "Person" "bob" (Just (StatementExpressionExpression  (ConstructorCall "Person" [IntegerLiteral 30])))),
+    LocalVariableDeclaration (VariableDeclaration "bool" "age" (Just (StatementExpressionExpression (MethodCall (Reference "bob") "getAge" [])))),
+    StatementExpressionStatement (MethodCall (Reference "bob") "setAge" [IntegerLiteral 30])
+    ]
+
+exampleMethodCallAndAssignment :: Statement
+exampleMethodCallAndAssignment = Block [
+    LocalVariableDeclaration (VariableDeclaration "Person" "bob" (Just (StatementExpressionExpression  (ConstructorCall "Person" [IntegerLiteral 30])))),
+    LocalVariableDeclaration (VariableDeclaration "int" "age" (Just (StatementExpressionExpression (MethodCall (Reference "bob") "getAge" [])))),
+    StatementExpressionStatement (MethodCall (Reference "bob") "setAge" [IntegerLiteral 30]),
+    LocalVariableDeclaration (VariableDeclaration "int" "a" Nothing),
+    StatementExpressionStatement (Assignment (Reference "a") (Reference "age"))
+    ]
+
+
+exampleMethodCallAndAssignmentFail :: Statement
+exampleMethodCallAndAssignmentFail = Block [
+    LocalVariableDeclaration (VariableDeclaration "Person" "bob" (Just (StatementExpressionExpression  (ConstructorCall "Person" [IntegerLiteral 30])))),
+    LocalVariableDeclaration (VariableDeclaration "int" "age" (Just (StatementExpressionExpression (MethodCall (Reference "bob") "getAge" [])))),
+    StatementExpressionStatement (MethodCall (Reference "bob") "setAge" [IntegerLiteral 30]),
+    StatementExpressionStatement (Assignment (Reference "a") (Reference "age"))
+    ]
+
+exampleNameResolutionAssignment :: Statement
+exampleNameResolutionAssignment = Block [
+    LocalVariableDeclaration (VariableDeclaration "Person" "bob" (Just (StatementExpressionExpression  (ConstructorCall "Person" [IntegerLiteral 30])))),
+    StatementExpressionStatement (Assignment (BinaryOperation NameResolution (Reference "bob") (Reference "age")) (IntegerLiteral 30))
+    ]
+
+exampleCharIntOperation :: Expression
+exampleCharIntOperation = BinaryOperation Addition (CharacterLiteral 'a') (IntegerLiteral 1)
+
+exampleNullDeclaration :: Statement
+exampleNullDeclaration = LocalVariableDeclaration (VariableDeclaration "Person" "bob" (Just NullLiteral))
+
+exampleNullDeclarationFail :: Statement
+exampleNullDeclarationFail = LocalVariableDeclaration (VariableDeclaration "int" "a" (Just NullLiteral))
+
+exampleNullAssignment :: Statement
+exampleNullAssignment = StatementExpressionStatement (Assignment (Reference "a") NullLiteral)
+
+exampleIncrement :: Statement
+exampleIncrement = StatementExpressionStatement (PostIncrement (Reference "a"))
+
+testClasses :: [Class]
+testClasses = [
+    Class "Person" [
+        MethodDeclaration "Person" "Person" [ParameterDeclaration "int" "initialAge"]
+        (Block [
+            Return (Just (Reference "this"))
+        ]),
+        MethodDeclaration "void" "setAge" [ParameterDeclaration "int" "newAge"]
+        (Block [
+            LocalVariableDeclaration (VariableDeclaration "int" "age" (Just (Reference "newAge")))
+        ]),
+        MethodDeclaration "int" "getAge" []
+        (Return (Just (Reference "age")))
+    ] [
+        VariableDeclaration "int" "age" Nothing  -- initially unassigned
+    ],
+    Class "Main" [
+        MethodDeclaration "int" "main" []
+        (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 "bob2") "getAge" [])))),
+            Return (Just (Reference "bobAge"))
+        ])
+    ] [
+        VariableDeclaration "Person" "bob2" Nothing
+    ]
+ ]
+
+runTypeCheck :: IO ()
+runTypeCheck = do
+    catch (do
+        print "====================================================================================="
+        evaluatedExpression <- evaluate (typeCheckExpression exampleExpression [("bob", "Person")] sampleClasses)
+        printSuccess "Type checking of expression completed successfully"
+        printResult "Result Expression:" evaluatedExpression
+      ) handleError
+
+    catch (do
+        print "====================================================================================="
+        evaluatedAssignment <- evaluate (typeCheckExpression exampleAssignment [("a", "int")] sampleClasses)
+        printSuccess "Type checking of assignment completed successfully"
+        printResult "Result Assignment:" evaluatedAssignment
+      ) handleError
+
+    catch (do
+        print "====================================================================================="
+        evaluatedMethodCall <- evaluate (typeCheckStatement exampleMethodCall [("this", "Person"), ("setAge", "Person"), ("getAge", "Person")] sampleClasses)
+        printSuccess "Type checking of method call this completed successfully"
+        printResult "Result MethodCall:" evaluatedMethodCall
+      ) handleError
+
+    catch (do
+        print "====================================================================================="
+        evaluatedConstructorCall <- evaluate (typeCheckStatement exampleConstructorCall [] sampleClasses)
+        printSuccess "Type checking of constructor call completed successfully"
+        printResult "Result Constructor Call:" evaluatedConstructorCall
+      ) handleError
+
+    catch (do
+        print "====================================================================================="
+        evaluatedNameResolution <- evaluate (typeCheckExpression exampleNameResolution [("this", "Main")] testClasses)
+        printSuccess "Type checking of name resolution completed successfully"
+        printResult "Result Name Resolution:" evaluatedNameResolution
+      ) handleError
+
+    catch (do
+        print "====================================================================================="
+        evaluatedBlockResolution <- evaluate (typeCheckStatement exampleBlockResolution [] sampleClasses)
+        printSuccess "Type checking of block resolution completed successfully"
+        printResult "Result Block Resolution:" evaluatedBlockResolution
+      ) handleError
+
+    catch (do
+        print "====================================================================================="
+        evaluatedBlockResolutionFail <- evaluate (typeCheckStatement exampleBlockResolutionFail [] sampleClasses)
+        printSuccess "Type checking of block resolution failed"
+        printResult "Result Block Resolution:" evaluatedBlockResolutionFail
+      ) handleError
+
+    catch (do
+        print "====================================================================================="
+        evaluatedMethodCallAndAssignment <- evaluate (typeCheckStatement exampleMethodCallAndAssignment [] sampleClasses)
+        printSuccess "Type checking of method call and assignment completed successfully"
+        printResult "Result Method Call and Assignment:" evaluatedMethodCallAndAssignment
+      ) handleError
+
+    catch (do
+        print "====================================================================================="
+        evaluatedMethodCallAndAssignmentFail <- evaluate (typeCheckStatement exampleMethodCallAndAssignmentFail [] sampleClasses)
+        printSuccess "Type checking of method call and assignment failed"
+        printResult "Result Method Call and Assignment:" evaluatedMethodCallAndAssignmentFail
+      ) handleError
+
+    catch (do
+        print "====================================================================================="
+        let mainClass = fromJust $ find (\(Class className _ _) -> className == "Main") testClasses
+        case mainClass of
+            Class _ [mainMethod] _ -> do
+                let result = typeCheckMethodDeclaration mainMethod [("this", "Main")] testClasses
+                printSuccess "Full program type checking completed successfully."
+                printResult "Main method result:" result
+      ) handleError
+
+    catch (do
+        print "====================================================================================="
+        let typedProgram = typeCheckCompilationUnit testClasses
+        printSuccess "Type checking of Program completed successfully"
+        printResult "Typed Program:" typedProgram
+        ) handleError
+
+    catch (do
+        print "====================================================================================="
+        typedAssignment <- evaluate (typeCheckStatement exampleNameResolutionAssignment [] sampleClasses)
+        printSuccess "Type checking of name resolution assignment completed successfully"
+        printResult "Result Name Resolution Assignment:" typedAssignment
+        ) handleError
+
+    catch (do
+        print "====================================================================================="
+        evaluatedCharIntOperation <- evaluate (typeCheckExpression exampleCharIntOperation [] sampleClasses)
+        printSuccess "Type checking of char int operation completed successfully"
+        printResult "Result Char Int Operation:" evaluatedCharIntOperation
+        ) handleError
+
+    catch (do
+        print "====================================================================================="
+        evaluatedNullDeclaration <- evaluate (typeCheckStatement exampleNullDeclaration [] sampleClasses)
+        printSuccess "Type checking of null declaration completed successfully"
+        printResult "Result Null Declaration:" evaluatedNullDeclaration
+        ) handleError
+
+    catch (do
+        print "====================================================================================="
+        evaluatedNullDeclarationFail <- evaluate (typeCheckStatement exampleNullDeclarationFail [] sampleClasses)
+        printSuccess "Type checking of null declaration failed"
+        printResult "Result Null Declaration:" evaluatedNullDeclarationFail
+        ) handleError
+
+    catch (do
+        print "====================================================================================="
+        evaluatedNullAssignment <- evaluate (typeCheckStatement exampleNullAssignment [("a", "Person")] sampleClasses)
+        printSuccess "Type checking of null assignment completed successfully"
+        printResult "Result Null Assignment:" evaluatedNullAssignment
+        ) handleError
+
+    catch (do
+        print "====================================================================================="
+        evaluatedIncrement <- evaluate (typeCheckStatement exampleIncrement [("a", "int")] sampleClasses)
+        printSuccess "Type checking of increment completed successfully"
+        printResult "Result Increment:" evaluatedIncrement
+        ) handleError

src/Typecheck.hs

@@ -5,20 +5,7 @@ import Ast
 
 
 typeCheckCompilationUnit :: CompilationUnit -> CompilationUnit
-typeCheckCompilationUnit classes =
-    let
-        -- Helper function to add a default constructor if none are present
-        ensureDefaultConstructor :: Class -> Class
-        ensureDefaultConstructor (Class className constructors methods fields) =
-            let
-                defaultConstructor = ConstructorDeclaration className [] (Block [])
-                constructorsWithDefault = if null constructors then [defaultConstructor] else constructors
-            in Class className constructorsWithDefault methods fields
-
-        -- Inject default constructors into all classes
-        classesWithDefaultConstructors = map ensureDefaultConstructor classes
-
-    in map (`typeCheckClass` classesWithDefaultConstructors) classesWithDefaultConstructors
+typeCheckCompilationUnit classes = map (`typeCheckClass` classes) classes
 
 typeCheckClass :: Class -> [Class] -> Class
 typeCheckClass (Class className constructors methods fields) classes =