.gitignore

@@ -8,7 +8,6 @@ cabal-dev
 *.chs.h
 *.dyn_o
 *.dyn_hi
-*.java
 *.class
 *.local~*
 src/Parser/JavaParser.hs

Test/JavaSources/Main.java

@@ -0,0 +1,34 @@
+// compile (in project root) using:
+// javac -g:none -sourcepath Test/JavaSources/ Test/JavaSources/Main.java
+// compile all test files using:
+// ls Test/JavaSources/*.java | grep -v ".*Main.java" | xargs -I {} cabal run compiler {}
+// afterwards, run using
+// java -ea -cp Test/JavaSources/ Main
+
+public class Main {
+    public static void main(String[] args)
+    {
+        TestEmpty empty = new TestEmpty();
+        TestFields fields = new TestFields();
+        TestConstructor constructor = new TestConstructor(42);
+        TestMultipleClasses multipleClasses = new TestMultipleClasses();
+        TestRecursion recursion = new TestRecursion(10);
+        TestMalicious malicious = new TestMalicious();
+
+        // constructing a basic class works
+        assert empty != null;
+        // initializers (and default initializers to 0/null) work
+        assert fields.a == 0 && fields.b == 42;
+        // constructor parameters override initializers
+        assert constructor.a == 42;
+        // multiple classes within one file work. Referencing another classes fields/methods works.
+        assert multipleClasses.a.a == 42;
+        // self-referencing classes work.
+        assert recursion.child.child.child.child.child.value == 5;
+        // self-referencing methods work.
+        assert recursion.fibonacci(15) == 610;
+        // intentionally dodgy expressions work
+        assert malicious.assignNegativeIncrement(42) == -42;
+        assert malicious.tripleAddition(1, 2, 3) == 6;
+    }
+}

Test/JavaSources/TestConstructor.java

@@ -0,0 +1,9 @@
+public class TestConstructor
+{
+    public int a = -1;
+
+    public TestConstructor(int initial_value)
+    {
+        a = initial_value;
+    }
+}

Test/JavaSources/TestEmpty.java

@@ -0,0 +1,4 @@
+public class TestEmpty
+{
+    
+}

Test/JavaSources/TestFields.java

@@ -0,0 +1,5 @@
+public class TestFields
+{
+    public int a;
+    public int b = 42;
+}

Test/JavaSources/TestMalicious.java

@@ -0,0 +1,11 @@
+public class TestMalicious {
+    public int assignNegativeIncrement(int n)
+    {
+        return n=-++n+1;
+    }
+
+    public int tripleAddition(int a, int b, int c)
+    {
+        return a+++b+++c++;
+    }
+}

Test/JavaSources/TestMultipleClasses.java

@@ -0,0 +1,9 @@
+public class TestMultipleClasses
+{
+    public AnotherTestClass a = new AnotherTestClass();
+}
+
+class AnotherTestClass
+{
+    public int a = 42;
+}

Test/JavaSources/TestRecursion.java

@@ -0,0 +1,27 @@
+public class TestRecursion {
+
+    public int value = 0;
+    public TestRecursion child = null;
+
+    public TestRecursion(int n)
+    {
+        value = n;
+
+        if(n > 0)
+        {
+            child = new TestRecursion(n - 1);
+        }
+    }
+
+    public int fibonacci(int n)
+    {
+        if(n < 2)
+        {
+            return n;
+        }
+        else
+        {
+            return fibonacci(n - 1) + this.fibonacci(n - 2);
+        }
+    }    
+}

Test/TestByteCodeGenerator.hs

@@ -1,118 +0,0 @@
-module TestByteCodeGenerator where
-
-import Test.HUnit
-import ByteCode.ClassFile.Generator
-import ByteCode.ClassFile
-import ByteCode.Constants
-import Ast
-
-nakedClass = Class "Testklasse" [] []
-expectedClass = ClassFile {
-        constantPool = [
-            ClassInfo 4,
-            MethodRefInfo 1 3,
-            NameAndTypeInfo 5 6,
-            Utf8Info "java/lang/Object",
-            Utf8Info "<init>",
-            Utf8Info "()V",
-            Utf8Info "Code",
-            ClassInfo 9,
-            Utf8Info "Testklasse"
-        ],
-        accessFlags = accessPublic,
-        thisClass = 8,
-        superClass = 1,
-        fields = [],
-        methods = [],
-        attributes = []
-    }
-
-classWithFields = Class "Testklasse" [] [VariableDeclaration "int" "testvariable" Nothing]
-expectedClassWithFields = ClassFile {
-        constantPool = [
-            ClassInfo 4,
-            MethodRefInfo 1 3,
-            NameAndTypeInfo 5 6,
-            Utf8Info "java/lang/Object",
-            Utf8Info "<init>",
-            Utf8Info "()V",
-            Utf8Info "Code",
-            ClassInfo 9,
-            Utf8Info "Testklasse",
-            FieldRefInfo 8 11,
-            NameAndTypeInfo 12 13,
-            Utf8Info "testvariable",
-            Utf8Info "I"
-        ],
-        accessFlags = accessPublic,
-        thisClass = 8,
-        superClass = 1,
-        fields = [
-            MemberInfo {
-                memberAccessFlags = accessPublic,
-                memberNameIndex = 12,
-                memberDescriptorIndex = 13,
-                memberAttributes = []
-            }
-        ],
-        methods = [],
-        attributes = []
-    }
-
-method = MethodDeclaration "int" "add_two_numbers" [
-    ParameterDeclaration "int" "a",
-    ParameterDeclaration "int" "b" ]
-    (Block [Return (Just (BinaryOperation Addition (Reference "a") (Reference "b")))])
-
-
-classWithMethod = Class "Testklasse" [method] []
-expectedClassWithMethod = ClassFile {
-        constantPool = [
-            ClassInfo 4,
-            MethodRefInfo 1 3,
-            NameAndTypeInfo 5 6,
-            Utf8Info "java/lang/Object",
-            Utf8Info "<init>",
-            Utf8Info "()V",
-            Utf8Info "Code",
-            ClassInfo 9,
-            Utf8Info "Testklasse",
-            FieldRefInfo 8 11,
-            NameAndTypeInfo 12 13,
-            Utf8Info "add_two_numbers",
-            Utf8Info "(II)I"
-        ],
-        accessFlags = accessPublic,
-        thisClass = 8,
-        superClass = 1,
-        fields = [],
-        methods = [
-            MemberInfo {
-                memberAccessFlags = accessPublic,
-                memberNameIndex = 12,
-                memberDescriptorIndex = 13,
-                memberAttributes = [
-                    CodeAttribute {
-                        attributeMaxStack = 420,
-                        attributeMaxLocals = 420,
-                        attributeCode = [Opiadd]
-                    }
-                ]
-            }
-        ],
-        attributes = []
-    }
-
-testBasicConstantPool = TestCase $ assertEqual "basic constant pool" expectedClass $ classBuilder nakedClass emptyClassFile
-testFields = TestCase $ assertEqual "fields in constant pool" expectedClassWithFields $ classBuilder classWithFields emptyClassFile
-testMethodDescriptor = TestCase $ assertEqual "method descriptor" "(II)I" (methodDescriptor method)
-testMethodAssembly = TestCase $ assertEqual "method assembly" expectedClassWithMethod (classBuilder classWithMethod emptyClassFile)
-testFindMethodIndex = TestCase $ assertEqual "find method" (Just 0) (findMethodIndex expectedClassWithMethod "add_two_numbers")
-
-tests = TestList [
-    TestLabel "Basic constant pool" testBasicConstantPool,
-    TestLabel "Fields constant pool" testFields,
-    TestLabel "Method descriptor building" testMethodDescriptor,
-    TestLabel "Method assembly" testMethodAssembly,
-    TestLabel "Find method by name" testFindMethodIndex
-    ]

Test/TestSuite.hs

@@ -2,13 +2,11 @@ module Main where
 
 import Test.HUnit
 import TestLexer
-import TestByteCodeGenerator
 import TestParser
 
-
 tests = TestList [
-    TestLabel "TestLexer" TestLexer.tests,
+        TestLabel "TestLexer" TestLexer.tests,
-    TestLabel "TestParser" TestParser.tests,
+        TestLabel "TestParser" TestParser.tests
-    TestLabel "TestByteCodeGenerator" TestByteCodeGenerator.tests]
+    ]
 
 main = do runTestTTAndExit Main.tests

project.cabal

@@ -10,7 +10,8 @@ executable compiler
                         array,
                         HUnit,
                         utf8-string,
-                        bytestring
+                        bytestring,
+                        filepath
     default-language:   Haskell2010
     hs-source-dirs:     src
     build-tool-depends: alex:alex, happy:happy
@@ -32,15 +33,15 @@ test-suite tests
                         array,
                         HUnit,
                         utf8-string,
-                        bytestring
+                        bytestring,
+                        filepath
     build-tool-depends: alex:alex, happy:happy
     other-modules:      Parser.Lexer,
                         Parser.JavaParser,
                         Ast,
                         TestLexer,
                         TestParser,
-                        TestByteCodeGenerator,
                         ByteCode.ByteUtil,
                         ByteCode.ClassFile,
-                        ByteCode.ClassFile.Generator,
+                        ByteCode.Generator,
                         ByteCode.Constants

src/ByteCode/Generator.hs

@@ -2,9 +2,11 @@ module ByteCode.Generator(
     datatypeDescriptor,
     memberInfoName,
     memberInfoDescriptor,
+    methodDescriptor,
     returnOperation,
     binaryOperation,
     comparisonOperation,
+    findMethodIndex,
     ClassFileBuilder,
     Assembler,
     classBuilder
@@ -443,7 +445,7 @@ assembleStatementExpression
                 (constants_a, ops_a, _) = assembleExpression (constants, ops, lvars) expr
                 isPrimitive = elem dtype ["char", "boolean", "int"]
             in case localIndex of
-                Just index -> (constants_a, ops_a ++ if isPrimitive then [Opistore (fromIntegral index)] else [Opastore (fromIntegral index)], lvars)
+                Just index -> (constants_a, ops_a ++ if isPrimitive then [Opdup, Opistore (fromIntegral index)] else [Opastore (fromIntegral index)], lvars)
                 Nothing -> error ("No such local variable found in local variable pool: " ++ name)
         (TypedExpression dtype (FieldVariable name)) -> let
                 owner = resolveNameChainOwner (TypedExpression dtype receiver)
@@ -628,4 +630,4 @@ assembleMethod (constants, ops, lvars) (MethodDeclaration returntype name _ (Typ
             in
                 (constants_a, ops_a ++ [Opreturn], lvars_a)
         otherwise -> foldl assembleStatement (constants, ops, lvars) statements
-assembleMethod _ (MethodDeclaration _ _ _ stmt) = error ("Block expected for method body, got: " ++ show stmt) 
+assembleMethod _ (MethodDeclaration _ _ _ stmt) = error ("Typed block expected for method body, got: " ++ show stmt) 

src/Main.hs

@@ -7,22 +7,25 @@ import Parser.JavaParser
 import ByteCode.Generator
 import ByteCode.ClassFile
 import Data.ByteString (pack, writeFile)
+import System.Environment
+import System.FilePath.Posix (takeDirectory)
 
 main = do
-    -- read source code from disk
+    args <- getArgs
-    file <- readFile "Testklasse.java"
+    let filename = if (length args) > 0
+                    then args!!0
+                    else error "Missing filename, I need to know what to compile"
+    let outputDirectory = takeDirectory filename
+    print ("Compiling " ++ filename)
+    file <- readFile filename
 
-    -- parse source code
     let untypedAST = parse $ alexScanTokens file
-    -- typecheck AST
     let typedAST = (typeCheckCompilationUnit untypedAST)
-    -- assemble classes
     let assembledClasses = map (\(typedClass) -> classBuilder typedClass emptyClassFile) typedAST
 
-    -- write class files to disk
     mapM_ (\(classFile) -> let
             fileContent = pack (serialize classFile)
-            fileName = (className classFile) ++ ".class"
+            fileName = outputDirectory ++ "/" ++ (className classFile) ++ ".class"
         in Data.ByteString.writeFile fileName fileContent
         ) assembledClasses