project.cabal

@@ -22,10 +22,8 @@ executable compiler
                         ByteCode.ByteUtil,
                         ByteCode.ClassFile,
                         ByteCode.Generation.Generator,
-                        ByteCode.Generation.Assembler.Expression,
+                        ByteCode.Generation.Assembler.ExpressionAndStatement,
                         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/ByteCode/Generation/Assembler/ExpressionAndStatement.hs

@@ -1,4 +1,4 @@
-module ByteCode.Generation.Assembler.Expression where
+module ByteCode.Generation.Assembler.ExpressionAndStatement where
 
 import Ast
 import ByteCode.ClassFile(ClassFile (..), ConstantInfo (..), MemberInfo(..), Operation(..), Attribute(..), opcodeEncodingLength)
@@ -48,95 +48,6 @@ 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
@@ -150,4 +61,168 @@ 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.Statement
+import ByteCode.Generation.Assembler.ExpressionAndStatement
 
 assembleMethod :: Assembler MethodDeclaration
 assembleMethod (constants, ops, lvars) (MethodDeclaration _ name _ (TypedStatement _ (Block statements)))

src/ByteCode/Generation/Assembler/Statement.hs

@@ -1,51 +0,0 @@
-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

@@ -1,29 +0,0 @@
-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)