Test/TestParser.hs

@@ -52,12 +52,6 @@ testClassWithMethodAndField = TestCase $
 testClassWithConstructor = TestCase $
     assertEqual "expect class with constructor" [Class "WithConstructor" [MethodDeclaration "void" "<init>" [] (Block [])] []] $
     parse [CLASS,IDENTIFIER "WithConstructor",LBRACKET,IDENTIFIER "WithConstructor",LBRACE,RBRACE,LBRACKET,RBRACKET,RBRACKET]
-testConstructorWithParams = TestCase $
-    assertEqual "expect constructor with params" [Class "WithParams" [MethodDeclaration "void" "<init>" [ParameterDeclaration "int" "p1"] (Block [])] []] $
-    parse [CLASS,IDENTIFIER "WithParams",LBRACKET,IDENTIFIER "WithParams",LBRACE,INT,IDENTIFIER "p1",RBRACE,LBRACKET,RBRACKET,RBRACKET]
-testConstructorWithStatements = TestCase $
-    assertEqual "expect constructor with statement" [Class "WithConstructor" [MethodDeclaration "void" "<init>" [] (Block [Return Nothing])] []] $
-    parse [CLASS,IDENTIFIER "WithConstructor",LBRACKET,IDENTIFIER "WithConstructor",LBRACE,RBRACE,LBRACKET,RETURN,SEMICOLON,RBRACKET,RBRACKET]
 
 
 testEmptyBlock = TestCase $ assertEqual "expect empty block" [Block []] $ parseStatement [LBRACKET,RBRACKET]
@@ -139,16 +133,16 @@ testExpressionOr = TestCase $
     assertEqual "expect or expression" (BinaryOperation Or (Reference "bar") (Reference "baz")) $
     parseExpression [IDENTIFIER "bar",OR,IDENTIFIER "baz"]
 testExpressionPostIncrement = TestCase $
-    assertEqual "expect PostIncrement" (StatementExpressionExpression $ PostIncrement (Reference "a")) $
+    assertEqual "expect PostIncrement" (UnaryOperation PostIncrement (Reference "a")) $
     parseExpression [IDENTIFIER "a",INCREMENT]
 testExpressionPostDecrement = TestCase $
-    assertEqual "expect PostDecrement" (StatementExpressionExpression $ PostDecrement (Reference "a")) $
+    assertEqual "expect PostDecrement" (UnaryOperation PostDecrement (Reference "a")) $
     parseExpression [IDENTIFIER "a",DECREMENT]
 testExpressionPreIncrement = TestCase $
-    assertEqual "expect PreIncrement" (StatementExpressionExpression $ PreIncrement (Reference "a")) $
+    assertEqual "expect PreIncrement" (UnaryOperation PreIncrement (Reference "a")) $
     parseExpression [INCREMENT,IDENTIFIER "a"]
 testExpressionPreDecrement = TestCase $
-    assertEqual "expect PreIncrement" (StatementExpressionExpression $ PreDecrement (Reference "a")) $
+    assertEqual "expect PreIncrement" (UnaryOperation PreDecrement (Reference "a")) $
     parseExpression [DECREMENT,IDENTIFIER "a"]
 testExpressionAssign = TestCase $
     assertEqual "expect assign 5 to a" (StatementExpressionExpression (Assignment (Reference "a") (IntegerLiteral 5))) $
@@ -176,22 +170,6 @@ testExpressionPrecedence = TestCase $
     assertEqual "expect times to be inner expression" (BinaryOperation Addition (BinaryOperation Multiplication (Reference "b") (Reference "a")) (IntegerLiteral 3)) $
     parseExpression [IDENTIFIER "b",TIMES,IDENTIFIER "a",PLUS,INTEGERLITERAL 3]
 
-testExpressionMethodCallNoParams = TestCase $
-    assertEqual "expect methodcall no params" (StatementExpressionExpression (MethodCall (Reference "this") "foo" [])) $
-    parseExpression [IDENTIFIER "foo",LBRACE,RBRACE]
-testExpressionMethodCallOneParam = TestCase $
-    assertEqual "expect methodcall one param" (StatementExpressionExpression (MethodCall (Reference "this") "foo" [Reference "a"])) $
-    parseExpression [IDENTIFIER "foo",LBRACE,IDENTIFIER "a",RBRACE]
-testExpressionMethodCallTwoParams = TestCase $
-    assertEqual "expect methocall two params" (StatementExpressionExpression (MethodCall (Reference "this") "foo" [Reference "a", IntegerLiteral 5])) $
-    parseExpression [IDENTIFIER "foo",LBRACE,IDENTIFIER "a",COMMA,INTEGERLITERAL 5,RBRACE]
-testExpressionThisMethodCall = TestCase $
-    assertEqual "expect this methocall" (StatementExpressionExpression (MethodCall (Reference "this") "foo" [])) $
-    parseExpression [THIS,DOT,IDENTIFIER "foo",LBRACE,RBRACE]
-testExpressionThisMethodCallParam = TestCase $
-    assertEqual "expect this methocall" (StatementExpressionExpression (MethodCall (Reference "this") "foo" [Reference "x"])) $
-    parseExpression [THIS,DOT,IDENTIFIER "foo",LBRACE,IDENTIFIER "x",RBRACE]
-
 testStatementIfThen = TestCase $
     assertEqual "expect empty ifthen" [If (Reference "a") (Block [Block []]) Nothing] $
     parseStatement [IF,LBRACE,IDENTIFIER "a",RBRACE,LBRACKET,RBRACKET]
@@ -201,13 +179,6 @@ testStatementIfThenElse = TestCase $
 testStatementWhile = TestCase $
     assertEqual "expect while" [While (Reference "a") (Block [Block []])] $
     parseStatement [WHILE,LBRACE,IDENTIFIER "a",RBRACE,LBRACKET,RBRACKET]
-testStatementAssign = TestCase $
-    assertEqual "expect assign 5" [StatementExpressionStatement (Assignment (Reference "a") (IntegerLiteral 5))] $
-    parseStatement [IDENTIFIER "a",ASSIGN,INTEGERLITERAL 5,SEMICOLON]
-
-testStatementMethodCallNoParams = TestCase $
-    assertEqual "expect methodcall statement no params" [StatementExpressionStatement (MethodCall (Reference "this") "foo" [])] $
-    parseStatement [IDENTIFIER "foo",LBRACE,RBRACE,SEMICOLON]
 
 
 
@@ -226,8 +197,6 @@ tests = TestList [
     testEmptyMethodWithParams,
     testClassWithMethodAndField,
     testClassWithConstructor,
-    testConstructorWithParams,
-    testConstructorWithStatements,
     testEmptyBlock,
     testBlockWithLocalVarDecl,
     testBlockWithMultipleLocalVarDecls,
@@ -262,14 +231,7 @@ tests = TestList [
     testExpressionBraced,
     testExpressionThis,
     testExpressionPrecedence,
-    testExpressionMethodCallNoParams,
-    testExpressionMethodCallOneParam,
-    testExpressionMethodCallTwoParams,
-    testExpressionThisMethodCall,
-    testExpressionThisMethodCallParam,
     testStatementIfThen,
     testStatementIfThenElse,
-    testStatementWhile,
+    testStatementWhile
-    testStatementAssign,
-    testStatementMethodCallNoParams
     ]

project.cabal

@@ -22,8 +22,10 @@ executable compiler
                         ByteCode.ByteUtil,
                         ByteCode.ClassFile,
                         ByteCode.Generation.Generator,
-                        ByteCode.Generation.Assembler.ExpressionAndStatement,
+                        ByteCode.Generation.Assembler.Expression,
                         ByteCode.Generation.Assembler.Method,
+                        ByteCode.Generation.Assembler.Statement,
+                        ByteCode.Generation.Assembler.StatementExpression,
                         ByteCode.Generation.Builder.Class,
                         ByteCode.Generation.Builder.Field,
                         ByteCode.Generation.Builder.Method,

src/Ast.hs

@@ -24,10 +24,6 @@ data StatementExpression
   | ConstructorCall DataType [Expression]
   | MethodCall Expression Identifier [Expression]
   | TypedStatementExpression DataType StatementExpression
-  | PostIncrement Expression
-  | PostDecrement Expression
-  | PreIncrement Expression
-  | PreDecrement Expression
   deriving (Show, Eq)
 
 data BinaryOperator
@@ -53,6 +49,10 @@ data BinaryOperator
 data UnaryOperator
   = Not
   | Minus
+  | PostIncrement
+  | PostDecrement
+  | PreIncrement
+  | PreDecrement
   deriving (Show, Eq)
 
 data Expression

src/ByteCode/Generation/Assembler/Expression.hs

@@ -1,4 +1,4 @@
-module ByteCode.Generation.Assembler.ExpressionAndStatement where
+module ByteCode.Generation.Assembler.Expression where
 
 import Ast
 import ByteCode.ClassFile(ClassFile (..), ConstantInfo (..), MemberInfo(..), Operation(..), Attribute(..), opcodeEncodingLength)
@@ -48,6 +48,95 @@ assembleExpression (constants, ops, lvars) (TypedExpression _ (UnaryOperation Mi
     in
         (exprConstants, exprOps ++ [Opineg], lvars)
 
+assembleExpression
+    (constants, ops, lvars)
+    (TypedExpression _ (UnaryOperation PreIncrement (TypedExpression dtype (LocalVariable name)))) = let
+        localIndex = findIndex ((==) name) lvars
+        expr = (TypedExpression dtype (LocalVariable name))
+        (exprConstants, exprOps, _) = assembleExpression (constants, ops, lvars) expr
+        incrOps = exprOps ++ [Opsipush 1, Opiadd, Opdup]
+    in case localIndex of
+        Just index -> (exprConstants, incrOps ++ [Opistore (fromIntegral index)], lvars)
+        Nothing -> error("No such local variable found in local variable pool: " ++ name)
+
+assembleExpression
+    (constants, ops, lvars)
+    (TypedExpression _ (UnaryOperation PostIncrement (TypedExpression dtype (LocalVariable name)))) = let
+        localIndex = findIndex ((==) name) lvars
+        expr = (TypedExpression dtype (LocalVariable name))
+        (exprConstants, exprOps, _) = assembleExpression (constants, ops, lvars) expr
+        incrOps = exprOps ++ [Opdup, Opsipush 1, Opiadd]
+    in case localIndex of
+        Just index -> (exprConstants, incrOps ++ [Opistore (fromIntegral index)], lvars)
+        Nothing -> error("No such local variable found in local variable pool: " ++ name)
+
+assembleExpression
+    (constants, ops, lvars)
+    (TypedExpression _ (UnaryOperation PreDecrement (TypedExpression dtype (LocalVariable name)))) = let
+        localIndex = findIndex ((==) name) lvars
+        expr = (TypedExpression dtype (LocalVariable name))
+        (exprConstants, exprOps, _) = assembleExpression (constants, ops, lvars) expr
+        incrOps = exprOps ++ [Opsipush 1, Opiadd, Opisub]
+    in case localIndex of
+        Just index -> (exprConstants, incrOps ++ [Opistore (fromIntegral index)], lvars)
+        Nothing -> error("No such local variable found in local variable pool: " ++ name)
+
+assembleExpression
+    (constants, ops, lvars)
+    (TypedExpression _ (UnaryOperation PostDecrement (TypedExpression dtype (LocalVariable name)))) = let
+        localIndex = findIndex ((==) name) lvars
+        expr = (TypedExpression dtype (LocalVariable name))
+        (exprConstants, exprOps, _) = assembleExpression (constants, ops, lvars) expr
+        incrOps = exprOps ++ [Opdup, Opsipush 1, Opisub]
+    in case localIndex of
+        Just index -> (exprConstants, incrOps ++ [Opistore (fromIntegral index)], lvars)
+        Nothing -> error("No such local variable found in local variable pool: " ++ name)
+
+assembleExpression
+    (constants, ops, lvars)
+    (TypedExpression _ (UnaryOperation PreIncrement (TypedExpression dtype (FieldVariable name)))) = let
+        fieldIndex = findFieldIndex constants name
+        expr = (TypedExpression dtype (FieldVariable name))
+        (exprConstants, exprOps, _) = assembleExpression (constants, ops ++ [Opaload 0], lvars) expr
+        incrOps = exprOps ++ [Opsipush 1, Opiadd, Opdup]
+    in case fieldIndex of
+        Just index -> (exprConstants, incrOps ++ [Opputfield (fromIntegral index)], lvars)
+        Nothing -> error("No such field variable found in field variable pool: " ++ name)
+
+assembleExpression
+    (constants, ops, lvars)
+    (TypedExpression _ (UnaryOperation PostIncrement (TypedExpression dtype (FieldVariable name)))) = let
+        fieldIndex = findFieldIndex constants name
+        expr = (TypedExpression dtype (FieldVariable name))
+        (exprConstants, exprOps, _) = assembleExpression (constants, ops ++ [Opaload 0], lvars) expr
+        incrOps = exprOps ++ [Opdup, Opsipush 1, Opiadd]
+    in case fieldIndex of
+        Just index -> (exprConstants, incrOps ++ [Opputfield (fromIntegral index)], lvars)
+        Nothing -> error("No such field variable found in field variable pool: " ++ name)
+
+assembleExpression
+    (constants, ops, lvars)
+    (TypedExpression _ (UnaryOperation PreDecrement (TypedExpression dtype (FieldVariable name)))) = let
+        fieldIndex = findFieldIndex constants name
+        expr = (TypedExpression dtype (FieldVariable name))
+        (exprConstants, exprOps, _) = assembleExpression (constants, ops ++ [Opaload 0], lvars) expr
+        incrOps = exprOps ++ [Opsipush 1, Opiadd, Opisub]
+    in case fieldIndex of
+        Just index -> (exprConstants, incrOps ++ [Opputfield (fromIntegral index)], lvars)
+        Nothing -> error("No such field variable found in field variable pool: " ++ name)
+
+assembleExpression
+    (constants, ops, lvars)
+    (TypedExpression _ (UnaryOperation PostDecrement (TypedExpression dtype (FieldVariable name)))) = let
+        fieldIndex = findFieldIndex constants name
+        expr = (TypedExpression dtype (FieldVariable name))
+        (exprConstants, exprOps, _) = assembleExpression (constants, ops ++ [Opaload 0], lvars) expr
+        incrOps = exprOps ++ [Opdup, Opsipush 1, Opisub]
+    in case fieldIndex of
+        Just index -> (exprConstants, incrOps ++ [Opputfield (fromIntegral index)], lvars)
+        Nothing -> error("No such field variable found in field variable pool: " ++ name)
+
+
 assembleExpression (constants, ops, lvars) (TypedExpression _ (FieldVariable name)) = let
         fieldIndex = findFieldIndex constants name
     in case fieldIndex of
@@ -61,168 +150,4 @@ assembleExpression (constants, ops, lvars) (TypedExpression dtype (LocalVariable
         Just index -> (constants, ops ++ if isPrimitive then [Opiload (fromIntegral index)] else [Opaload (fromIntegral index)], lvars)
         Nothing -> error ("No such local variable found in local variable pool: " ++ name)
 
-assembleExpression (constants, ops, lvars) (TypedExpression dtype (StatementExpressionExpression stmtexp)) =
-        assembleStatementExpression (constants, ops, lvars) stmtexp
-
 assembleExpression _ expr = error ("unimplemented: " ++ show expr)
-
-
-
-
--- TODO untested
-assembleStatementExpression :: Assembler StatementExpression
-assembleStatementExpression
-    (constants, ops, lvars)
-    (TypedStatementExpression _ (Assignment (TypedExpression dtype (LocalVariable name)) expr)) = let
-        localIndex = findIndex ((==) name) lvars
-        (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)
-        Nothing -> error ("No such local variable found in local variable pool: " ++ name)
-
-assembleStatementExpression
-    (constants, ops, lvars)
-    (TypedStatementExpression _ (Assignment (TypedExpression dtype (FieldVariable name)) expr)) = let
-        fieldIndex = findFieldIndex constants name
-        (constants_a, ops_a, _) = assembleExpression (constants, ops ++ [Opaload 0], lvars) expr
-    in case fieldIndex of
-        Just index -> (constants_a, ops_a ++ [Opputfield (fromIntegral index)], lvars)
-        Nothing -> error ("No such field variable found in constant pool: " ++ name)
-
-
-assembleStatementExpression
-    (constants, ops, lvars)
-    (TypedStatementExpression _ (PreIncrement (TypedExpression dtype (LocalVariable name)))) = let
-        localIndex = findIndex ((==) name) lvars
-        expr = (TypedExpression dtype (LocalVariable name))
-        (exprConstants, exprOps, _) = assembleExpression (constants, ops, lvars) expr
-        incrOps = exprOps ++ [Opsipush 1, Opiadd, Opdup]
-    in case localIndex of
-        Just index -> (exprConstants, incrOps ++ [Opistore (fromIntegral index)], lvars)
-        Nothing -> error("No such local variable found in local variable pool: " ++ name)
-
-assembleStatementExpression
-    (constants, ops, lvars)
-    (TypedStatementExpression _ (PostIncrement (TypedExpression dtype (LocalVariable name)))) = let
-        localIndex = findIndex ((==) name) lvars
-        expr = (TypedExpression dtype (LocalVariable name))
-        (exprConstants, exprOps, _) = assembleExpression (constants, ops, lvars) expr
-        incrOps = exprOps ++ [Opdup, Opsipush 1, Opiadd]
-    in case localIndex of
-        Just index -> (exprConstants, incrOps ++ [Opistore (fromIntegral index)], lvars)
-        Nothing -> error("No such local variable found in local variable pool: " ++ name)
-
-assembleStatementExpression
-    (constants, ops, lvars)
-    (TypedStatementExpression _ (PreDecrement (TypedExpression dtype (LocalVariable name)))) = let
-        localIndex = findIndex ((==) name) lvars
-        expr = (TypedExpression dtype (LocalVariable name))
-        (exprConstants, exprOps, _) = assembleExpression (constants, ops, lvars) expr
-        incrOps = exprOps ++ [Opsipush 1, Opiadd, Opisub]
-    in case localIndex of
-        Just index -> (exprConstants, incrOps ++ [Opistore (fromIntegral index)], lvars)
-        Nothing -> error("No such local variable found in local variable pool: " ++ name)
-
-assembleStatementExpression
-    (constants, ops, lvars)
-    (TypedStatementExpression _ (PostDecrement (TypedExpression dtype (LocalVariable name)))) = let
-        localIndex = findIndex ((==) name) lvars
-        expr = (TypedExpression dtype (LocalVariable name))
-        (exprConstants, exprOps, _) = assembleExpression (constants, ops, lvars) expr
-        incrOps = exprOps ++ [Opdup, Opsipush 1, Opisub]
-    in case localIndex of
-        Just index -> (exprConstants, incrOps ++ [Opistore (fromIntegral index)], lvars)
-        Nothing -> error("No such local variable found in local variable pool: " ++ name)
-
-assembleStatementExpression
-    (constants, ops, lvars)
-    (TypedStatementExpression _ (PreIncrement (TypedExpression dtype (FieldVariable name)))) = let
-        fieldIndex = findFieldIndex constants name
-        expr = (TypedExpression dtype (FieldVariable name))
-        (exprConstants, exprOps, _) = assembleExpression (constants, ops ++ [Opaload 0], lvars) expr
-        incrOps = exprOps ++ [Opsipush 1, Opiadd, Opdup]
-    in case fieldIndex of
-        Just index -> (exprConstants, incrOps ++ [Opputfield (fromIntegral index)], lvars)
-        Nothing -> error("No such field variable found in field variable pool: " ++ name)
-
-assembleStatementExpression
-    (constants, ops, lvars)
-    (TypedStatementExpression _ (PostIncrement (TypedExpression dtype (FieldVariable name)))) = let
-        fieldIndex = findFieldIndex constants name
-        expr = (TypedExpression dtype (FieldVariable name))
-        (exprConstants, exprOps, _) = assembleExpression (constants, ops ++ [Opaload 0], lvars) expr
-        incrOps = exprOps ++ [Opdup, Opsipush 1, Opiadd]
-    in case fieldIndex of
-        Just index -> (exprConstants, incrOps ++ [Opputfield (fromIntegral index)], lvars)
-        Nothing -> error("No such field variable found in field variable pool: " ++ name)
-
-assembleStatementExpression
-    (constants, ops, lvars)
-    (TypedStatementExpression _ (PreDecrement (TypedExpression dtype (FieldVariable name)))) = let
-        fieldIndex = findFieldIndex constants name
-        expr = (TypedExpression dtype (FieldVariable name))
-        (exprConstants, exprOps, _) = assembleExpression (constants, ops ++ [Opaload 0], lvars) expr
-        incrOps = exprOps ++ [Opsipush 1, Opiadd, Opisub]
-    in case fieldIndex of
-        Just index -> (exprConstants, incrOps ++ [Opputfield (fromIntegral index)], lvars)
-        Nothing -> error("No such field variable found in field variable pool: " ++ name)
-
-assembleStatementExpression
-    (constants, ops, lvars)
-    (TypedStatementExpression _ (PostDecrement (TypedExpression dtype (FieldVariable name)))) = let
-        fieldIndex = findFieldIndex constants name
-        expr = (TypedExpression dtype (FieldVariable name))
-        (exprConstants, exprOps, _) = assembleExpression (constants, ops ++ [Opaload 0], lvars) expr
-        incrOps = exprOps ++ [Opdup, Opsipush 1, Opisub]
-    in case fieldIndex of
-        Just index -> (exprConstants, incrOps ++ [Opputfield (fromIntegral index)], lvars)
-        Nothing -> error("No such field variable found in field variable pool: " ++ name)
-
-
-
-
-
-assembleStatement :: Assembler Statement
-assembleStatement (constants, ops, lvars) (TypedStatement stype (Return expr)) = case expr of
-    Nothing -> (constants, ops ++ [Opreturn], lvars)
-    Just expr -> let
-            (expr_constants, expr_ops, _) = assembleExpression (constants, ops, lvars) expr
-        in
-            (expr_constants, expr_ops ++ [returnOperation stype], lvars)
-assembleStatement (constants, ops, lvars) (TypedStatement _ (Block statements)) =
-    foldl assembleStatement (constants, ops, lvars) statements
-assembleStatement (constants, ops, lvars) (TypedStatement _ (If expr if_stmt else_stmt)) = let
-        (constants_cmp, ops_cmp, _) = assembleExpression (constants, [], lvars) expr
-        (constants_ifa, ops_ifa, _) = assembleStatement (constants_cmp, [], lvars) if_stmt
-        (constants_elsea, ops_elsea, _) = case else_stmt of
-            Nothing -> (constants_ifa, [], lvars)
-            Just stmt -> assembleStatement (constants_ifa, [], lvars) stmt
-        -- +6 because we insert 2 gotos, one for if, one for else
-        if_length = sum (map opcodeEncodingLength ops_ifa) + 6
-        -- +3 because we need to account for the goto in the if statement.
-        else_length = sum (map opcodeEncodingLength ops_elsea) + 3
-    in
-        (constants_ifa, ops ++ ops_cmp ++ [Opsipush 0, Opif_icmpeq if_length] ++ ops_ifa ++ [Opgoto else_length] ++ ops_elsea, lvars)
-assembleStatement (constants, ops, lvars) (TypedStatement _ (While expr stmt)) = let
-        (constants_cmp, ops_cmp, _) = assembleExpression (constants, [], lvars) expr
-        (constants_stmta, ops_stmta, _) = assembleStatement (constants_cmp, [], lvars) stmt
-        -- +3 because we insert 2 gotos, one for the comparison, one for the goto back to the comparison
-        stmt_length = sum (map opcodeEncodingLength ops_stmta) + 6
-        entire_length = stmt_length + sum (map opcodeEncodingLength ops_cmp)
-    in
-        (constants_stmta, ops ++ ops_cmp ++ [Opsipush 0, Opif_icmpeq stmt_length] ++ ops_stmta ++ [Opgoto (-entire_length)], lvars)
-assembleStatement (constants, ops, lvars) (TypedStatement _ (LocalVariableDeclaration (VariableDeclaration dtype name expr))) = let
-        isPrimitive = elem dtype ["char", "boolean", "int"]
-        (constants_init, ops_init, _) = case expr of
-            Just exp -> assembleExpression (constants, ops, lvars) exp
-            Nothing -> (constants, ops ++ if isPrimitive then [Opsipush 0] else [Opaconst_null], lvars)
-        localIndex = fromIntegral (length lvars)
-        storeLocal = if isPrimitive then [Opistore localIndex] else [Opastore localIndex]
-    in
-        (constants_init, ops_init ++ storeLocal, lvars ++ [name])
-
-assembleStatement (constants, ops, lvars) (TypedStatement _ (StatementExpressionStatement expr)) =
-    assembleStatementExpression (constants, ops, lvars) expr
-
-assembleStatement _ stmt = error ("Not yet implemented: " ++ show stmt)

src/ByteCode/Generation/Assembler/Method.hs

@@ -3,7 +3,7 @@ module ByteCode.Generation.Assembler.Method where
 import Ast
 import ByteCode.ClassFile(ClassFile (..), ConstantInfo (..), MemberInfo(..), Operation(..), Attribute(..), opcodeEncodingLength)
 import ByteCode.Generation.Generator
-import ByteCode.Generation.Assembler.ExpressionAndStatement
+import ByteCode.Generation.Assembler.Statement
 
 assembleMethod :: Assembler MethodDeclaration
 assembleMethod (constants, ops, lvars) (MethodDeclaration _ name _ (TypedStatement _ (Block statements)))

src/ByteCode/Generation/Assembler/Statement.hs

@@ -0,0 +1,51 @@
+module ByteCode.Generation.Assembler.Statement where
+
+import Ast
+import ByteCode.ClassFile(ClassFile (..), ConstantInfo (..), MemberInfo(..), Operation(..), Attribute(..), opcodeEncodingLength)
+import ByteCode.Generation.Generator
+import ByteCode.Generation.Assembler.Expression
+import ByteCode.Generation.Assembler.StatementExpression
+
+assembleStatement :: Assembler Statement
+assembleStatement (constants, ops, lvars) (TypedStatement stype (Return expr)) = case expr of
+    Nothing -> (constants, ops ++ [Opreturn], lvars)
+    Just expr -> let
+            (expr_constants, expr_ops, _) = assembleExpression (constants, ops, lvars) expr
+        in
+            (expr_constants, expr_ops ++ [returnOperation stype], lvars)
+assembleStatement (constants, ops, lvars) (TypedStatement _ (Block statements)) =
+    foldl assembleStatement (constants, ops, lvars) statements
+assembleStatement (constants, ops, lvars) (TypedStatement _ (If expr if_stmt else_stmt)) = let
+        (constants_cmp, ops_cmp, _) = assembleExpression (constants, [], lvars) expr
+        (constants_ifa, ops_ifa, _) = assembleStatement (constants_cmp, [], lvars) if_stmt
+        (constants_elsea, ops_elsea, _) = case else_stmt of
+            Nothing -> (constants_ifa, [], lvars)
+            Just stmt -> assembleStatement (constants_ifa, [], lvars) stmt
+        -- +6 because we insert 2 gotos, one for if, one for else
+        if_length = sum (map opcodeEncodingLength ops_ifa) + 6
+        -- +3 because we need to account for the goto in the if statement.
+        else_length = sum (map opcodeEncodingLength ops_elsea) + 3
+    in
+        (constants_ifa, ops ++ ops_cmp ++ [Opsipush 0, Opif_icmpeq if_length] ++ ops_ifa ++ [Opgoto else_length] ++ ops_elsea, lvars)
+assembleStatement (constants, ops, lvars) (TypedStatement _ (While expr stmt)) = let
+        (constants_cmp, ops_cmp, _) = assembleExpression (constants, [], lvars) expr
+        (constants_stmta, ops_stmta, _) = assembleStatement (constants_cmp, [], lvars) stmt
+        -- +3 because we insert 2 gotos, one for the comparison, one for the goto back to the comparison
+        stmt_length = sum (map opcodeEncodingLength ops_stmta) + 6
+        entire_length = stmt_length + sum (map opcodeEncodingLength ops_cmp)
+    in
+        (constants_stmta, ops ++ ops_cmp ++ [Opsipush 0, Opif_icmpeq stmt_length] ++ ops_stmta ++ [Opgoto (-entire_length)], lvars)
+assembleStatement (constants, ops, lvars) (TypedStatement _ (LocalVariableDeclaration (VariableDeclaration dtype name expr))) = let
+        isPrimitive = elem dtype ["char", "boolean", "int"]
+        (constants_init, ops_init, _) = case expr of
+            Just exp -> assembleExpression (constants, ops, lvars) exp
+            Nothing -> (constants, ops ++ if isPrimitive then [Opsipush 0] else [Opaconst_null], lvars)
+        localIndex = fromIntegral (length lvars)
+        storeLocal = if isPrimitive then [Opistore localIndex] else [Opastore localIndex]
+    in
+        (constants_init, ops_init ++ storeLocal, lvars ++ [name])
+
+assembleStatement (constants, ops, lvars) (TypedStatement _ (StatementExpressionStatement expr)) =
+    assembleStatementExpression (constants, ops, lvars) expr
+
+assembleStatement _ stmt = error ("Not yet implemented: " ++ show stmt)

src/ByteCode/Generation/Assembler/StatementExpression.hs

@@ -0,0 +1,29 @@
+module ByteCode.Generation.Assembler.StatementExpression where
+
+import Ast
+import ByteCode.ClassFile(ClassFile (..), ConstantInfo (..), MemberInfo(..), Operation(..), Attribute(..), opcodeEncodingLength)
+import ByteCode.Generation.Generator
+import Data.List
+import ByteCode.Generation.Assembler.Expression
+import ByteCode.Generation.Builder.Field
+
+-- TODO untested
+assembleStatementExpression :: Assembler StatementExpression
+assembleStatementExpression
+    (constants, ops, lvars)
+    (TypedStatementExpression _ (Assignment (TypedExpression dtype (LocalVariable name)) expr)) = let
+        localIndex = findIndex ((==) name) lvars
+        (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)
+        Nothing -> error ("No such local variable found in local variable pool: " ++ name)
+
+assembleStatementExpression
+    (constants, ops, lvars)
+    (TypedStatementExpression _ (Assignment (TypedExpression dtype (FieldVariable name)) expr)) = let
+        fieldIndex = findFieldIndex constants name
+        (constants_a, ops_a, _) = assembleExpression (constants, ops ++ [Opaload 0], lvars) expr
+    in case fieldIndex of
+        Just index -> (constants_a, ops_a ++ [Opputfield (fromIntegral index)], lvars)
+        Nothing -> error ("No such field variable found in constant pool: " ++ name)

src/Example.hs

@@ -110,9 +110,6 @@ exampleNullDeclarationFail = LocalVariableDeclaration (VariableDeclaration "int"
 exampleNullAssignment :: Statement
 exampleNullAssignment = StatementExpressionStatement (Assignment (Reference "a") NullLiteral)
 
-exampleIncrement :: Statement
-exampleIncrement = StatementExpressionStatement (PostIncrement (Reference "a"))
-
 testClasses :: [Class]
 testClasses = [
     Class "Person" [
@@ -258,10 +255,3 @@ runTypeCheck = do
         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/Parser/JavaParser.y

@@ -127,8 +127,8 @@ classorinterfacetype : simplename { $1 }
 classmemberdeclaration : fielddeclaration { $1 }
                  | methoddeclaration { $1 }
 
-constructordeclaration : constructordeclarator constructorbody { MethodDecl $ MethodDeclaration "void" "<init>" $1 $2 }
+constructordeclaration : constructordeclarator constructorbody { case $1 of (classname, parameters) -> MethodDecl $ MethodDeclaration "void" "<init>" parameters $2 }
-                 |  modifiers constructordeclarator constructorbody { MethodDecl $ MethodDeclaration "void" "<init>" $2 $3 }
+                 |  modifiers constructordeclarator constructorbody { case $2 of (classname, parameters) -> MethodDecl $ MethodDeclaration "void" "<init>" parameters $3 }
 
 fielddeclaration : type variabledeclarators  SEMICOLON { FieldDecls $ map (convertDeclarator $1) $2 }
                  | modifiers type variabledeclarators  SEMICOLON { FieldDecls $ map (convertDeclarator $2) $3 }
@@ -138,12 +138,12 @@ methoddeclaration : methodheader methodbody { case $1 of (returnType, (name, par
 block            : LBRACKET   RBRACKET { Block [] }
                  | LBRACKET  blockstatements  RBRACKET { Block $2 }
 
-constructordeclarator :  simplename LBRACE  RBRACE  { [] }
+constructordeclarator :  simplename LBRACE  RBRACE  { ($1, []) }
-                 |  simplename LBRACE formalparameterlist RBRACE  { $3 }
+                 |  simplename LBRACE formalparameterlist RBRACE  { ($1, $3) }
 
 constructorbody  : LBRACKET RBRACKET { Block [] }
                 --  | LBRACKET explicitconstructorinvocation  RBRACKET { }
-                 | LBRACKET blockstatements  RBRACKET { Block $2 }
+                --  | LBRACKET blockstatements  RBRACKET { }
                 --  | LBRACKET explicitconstructorinvocation blockstatements RBRACKET { }
 
 methodheader     : type  methoddeclarator { ($1, $2) }
@@ -189,8 +189,8 @@ blockstatement         : localvariabledeclarationstatement { $1 } -- expected ty
 
 formalparameter  : type variabledeclaratorid { ParameterDeclaration $1 $2 }
 
-argumentlist     : expression { [$1] }
+argumentlist     : expression { }
-                 | argumentlist  COMMA  expression { $1 ++ [$3] }
+                 | argumentlist  COMMA  expression { }
 
 numerictype      : integraltype { $1 }
 
@@ -253,7 +253,7 @@ statementexpression : assignment { $1 }
                 --  | predecrementexpression { }
                 --  | postincrementexpression { }
                 --  | postdecrementexpression { }
-                 | methodinvocation { $1 }
+                --  | methodinvocation { }
                 --  | classinstancecreationexpression { }
 
 ifthenelsestatementnoshortif :IF LBRACE expression  RBRACE  statementnoshortif
@@ -279,18 +279,18 @@ assignmentoperator : ASSIGN { Nothing }
                  | XOREQUAL { Just BitwiseXor }
                  | OREQUAL{ Just BitwiseOr }
 
-preincrementexpression : INCREMENT unaryexpression { PreIncrement $2 }
+preincrementexpression : INCREMENT unaryexpression { UnaryOperation PreIncrement $2 }
 
-predecrementexpression : DECREMENT unaryexpression { PreDecrement $2 }
+predecrementexpression : DECREMENT unaryexpression { UnaryOperation PreDecrement $2 }
 
-postincrementexpression : postfixexpression INCREMENT { PostIncrement $1 }
+postincrementexpression : postfixexpression INCREMENT { UnaryOperation PostIncrement $1 }
 
-postdecrementexpression : postfixexpression DECREMENT { PostDecrement $1 }
+postdecrementexpression : postfixexpression DECREMENT { UnaryOperation PostDecrement $1 }
 
-methodinvocation : simplename LBRACE   RBRACE  { MethodCall (Reference "this") $1 []  }
+methodinvocation : name LBRACE   RBRACE  { }
-                 | simplename LBRACE argumentlist RBRACE { MethodCall (Reference "this") $1 $3 }
+                 | name LBRACE argumentlist RBRACE { }
-                 | primary  DOT IDENTIFIER LBRACE RBRACE  { MethodCall $1 $3 [] }
+                 | primary  DOT IDENTIFIER LBRACE RBRACE  { }
-                 | primary  DOT IDENTIFIER LBRACE argumentlist  RBRACE  { MethodCall $1 $3 $5 }
+                 | primary  DOT IDENTIFIER LBRACE argumentlist  RBRACE  { }
      
 classinstancecreationexpression : NEW classtype LBRACE   RBRACE  { }
                  | NEW classtype LBRACE  argumentlist  RBRACE  { }
@@ -300,15 +300,15 @@ conditionalandexpression : inclusiveorexpression { $1 }
 fieldaccess      : primary  DOT IDENTIFIER { }
 
 unaryexpression         : unaryexpressionnotplusminus { $1 }
-                 | predecrementexpression { StatementExpressionExpression $1 }
+                 | predecrementexpression { $1 }
                  | PLUS unaryexpression { $2 }
                  | MINUS unaryexpression { UnaryOperation Minus $2 }
-                 | preincrementexpression { StatementExpressionExpression $1 }
+                 | preincrementexpression { $1 }
 
 postfixexpression : primary { $1 }
                  | name { $1 }
-                 | postincrementexpression { StatementExpressionExpression $1 }
+                 | postincrementexpression { $1 }
-                 | postdecrementexpression { StatementExpressionExpression $1 }
+                 | postdecrementexpression{ $1 }
 
 primary                 : primarynonewarray { $1 }
 
@@ -320,7 +320,7 @@ primarynonewarray : literal { $1 }
                  | LBRACE expression RBRACE  { $2 }
                 --  | classinstancecreationexpression { }
                 --  | fieldaccess { }
-                 | methodinvocation { StatementExpressionExpression $1 }
+                --  | methodinvocation { }
 
 unaryexpressionnotplusminus : postfixexpression { $1 }
                 --  | TILDE unaryexpression { }

src/Typecheck.hs

@@ -89,11 +89,50 @@ typeCheckExpression (UnaryOperation op expr) symtab classes =
             else
               error "Logical NOT operation requires an operand of type boolean"
         Minus ->
-          if type' == "int" || type' == "char"
+          if type' == "int"
             then
-              TypedExpression type' (UnaryOperation op expr')
+              TypedExpression "int" (UnaryOperation op expr')
+          else if type' == "char"
+            then
+              TypedExpression "char" (UnaryOperation op expr')
             else
               error "Unary minus operation requires an operand of type int or char"
+        PostIncrement ->
+          if type' == "int"
+            then
+              TypedExpression "int" (UnaryOperation op expr')
+          else if type' == "char"
+            then
+              TypedExpression "char" (UnaryOperation op expr')
+            else
+              error "Post-increment operation requires an operand of type int or char"
+        PostDecrement ->
+          if type' == "int"
+            then
+              TypedExpression "int" (UnaryOperation op expr')
+          else if type' == "char"
+            then
+              TypedExpression "char" (UnaryOperation op expr')
+            else
+              error "Post-decrement operation requires an operand of type int or char"
+        PreIncrement ->
+          if type' == "int"
+            then
+              TypedExpression "int" (UnaryOperation op expr')
+          else if type' == "char"
+            then
+              TypedExpression "char" (UnaryOperation op expr')
+            else
+              error "Pre-increment operation requires an operand of type int or char"
+        PreDecrement ->
+          if type' == "int"
+            then
+              TypedExpression "int" (UnaryOperation op expr')
+          else if type' == "char"
+            then
+              TypedExpression "char" (UnaryOperation op expr')
+            else
+              error "Pre-decrement operation requires an operand of type int or char"
 
 typeCheckExpression (StatementExpressionExpression stmtExpr) symtab classes =
   let stmtExpr' = typeCheckStatementExpression stmtExpr symtab classes
@@ -163,42 +202,6 @@ typeCheckStatementExpression (MethodCall expr methodName args) symtab classes =
                 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'
-   in if type' == "int" || type' == "char"
-        then
-          TypedStatementExpression type' (PostIncrement expr')
-        else
-          error "Post-increment operation requires an operand of type int or char"
-
-typeCheckStatementExpression (PostDecrement expr) symtab classes =
-  let expr' = typeCheckExpression expr symtab classes
-      type' = getTypeFromExpr expr'
-   in if type' == "int" || type' == "char"
-        then
-          TypedStatementExpression type' (PostDecrement expr')
-        else
-          error "Post-decrement operation requires an operand of type int or char"
-
-typeCheckStatementExpression (PreIncrement expr) symtab classes =
-  let expr' = typeCheckExpression expr symtab classes
-      type' = getTypeFromExpr expr'
-   in if type' == "int" || type' == "char"
-        then
-          TypedStatementExpression type' (PreIncrement expr')
-        else
-          error "Pre-increment operation requires an operand of type int or char"
-
-typeCheckStatementExpression (PreDecrement expr) symtab classes =
-  let expr' = typeCheckExpression expr symtab classes
-      type' = getTypeFromExpr expr'
-   in if type' == "int" || type' == "char"
-        then
-          TypedStatementExpression type' (PreDecrement expr')
-        else
-          error "Pre-decrement operation requires an operand of type int or char"
-
 -- ********************************** Type Checking: Statements **********************************
 
 typeCheckStatement :: Statement -> [(Identifier, DataType)] -> [Class] -> Statement
@@ -255,7 +258,6 @@ typeCheckStatement (Block statements) symtab classes =
                 If {} -> (accSts ++ [checkedStmt], currentSymtab, if stmtType /= "void" then types ++ [stmtType] else types)
                 While _ _ -> (accSts ++ [checkedStmt], currentSymtab, if stmtType /= "void" then types ++ [stmtType] else types)
                 Return _ -> (accSts ++ [checkedStmt], currentSymtab, if stmtType /= "void" then types ++ [stmtType] else types)
-                Block _ -> (accSts ++ [checkedStmt], currentSymtab, if stmtType /= "void" then types ++ [stmtType] else types)
                 _ -> (accSts ++ [checkedStmt], currentSymtab, types)
 
         -- Initial accumulator: empty statements list, initial symbol table, empty types list