fixed method/constructor overloading in bytecode generator

Test/JavaSources/Main.java

@@ -16,6 +16,7 @@ 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;
@@ -34,6 +35,12 @@ 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,13 +1,12 @@
 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,14 +1,10 @@
 public class TestMethodOverload {
 
-    public void MethodOverload() {
+    public int MethodOverload() {
+        return 42;
     }
 
-    public void MethodOverload(int a) {
+    public int MethodOverload(int a) {
+        return 42 + a;
     }
-
-    public void test() {
-        int a = 3;
-        MethodOverload(a);
-    }
-    
 }

project.cabal

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

src/ByteCode/Builder.hs

@@ -56,10 +56,13 @@ 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 name
+        methodConstantIndex = findMethodIndex input (MethodDeclaration returntype name parameters statement) 
     in case methodConstantIndex of
         Nothing -> error ("Cannot find method entry in method pool for method: " ++ name)
         Just index -> let
@@ -84,9 +87,12 @@ 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 methods fields) _ = let
+classBuilder (Class name constructors methods fields) _ = let
         baseConstants = [
             ClassInfo 4,
             MethodRefInfo 1 3,
@@ -108,15 +114,15 @@ classBuilder (Class name 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.
-        methodsWithInjectedInitializers = injectFieldInitializers name fields methodsWithInjectedConstructor
+        constructorsWithInitializers = injectFieldInitializers name fields constructors
 
-        -- add fields, then method bodies to the classfile. After all referable names are known,
+        -- add fields, then method bodies, then constructor bodies to the classfile. After all referable names are known,
-        -- assemble the methods into bytecode.
+        -- assemble the methods and constructors into bytecode.
-        classFileWithFields = foldr fieldBuilder nakedClassFile fields
+        fieldsAdded = foldr fieldBuilder nakedClassFile fields
-        classFileWithMethods = foldr methodBuilder classFileWithFields methodsWithInjectedInitializers
+        methodsAdded = foldr methodBuilder fieldsAdded methods
-        classFileWithAssembledMethods = foldr methodAssembler classFileWithMethods methodsWithInjectedInitializers
+        constructorsAdded = foldr constructorBuilder methodsAdded constructorsWithInitializers
+        methodsAssembled = foldr methodAssembler constructorsAdded methods
+        constructorsAssembled = foldr constructorAssembler methodsAssembled constructorsWithInitializers
     in
-        classFileWithAssembledMethods
+        constructorsAssembled

src/ByteCode/Util.hs

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

src/Example.hs

@@ -1,267 +0,0 @@
-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,7 +5,20 @@ import Ast
 
 
 typeCheckCompilationUnit :: CompilationUnit -> CompilationUnit
-typeCheckCompilationUnit classes = map (`typeCheckClass` classes) classes
+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
 
 typeCheckClass :: Class -> [Class] -> Class
 typeCheckClass (Class className constructors methods fields) classes =