increment/decrement

Test/TestParser.hs

@@ -159,6 +159,16 @@ testExpressionPlusEqual = TestCase $
 testExpressionMinusEqual = TestCase $
     assertEqual "expect assign and subtraction" (StatementExpressionExpression (Assignment (Reference "a") (BinaryOperation Subtraction (Reference "a") (IntegerLiteral 5)))) $
     parseExpression [IDENTIFIER "a",MINUSEQUAL,INTEGERLITERAL 5]
+testExpressionThis = TestCase $
+    assertEqual "expect this" (Reference "this") $
+    parseExpression [THIS]
+testExpressionBraced = TestCase $
+    assertEqual "expect braced expresssion" (BinaryOperation Multiplication (Reference "b") (BinaryOperation Addition (Reference "a") (IntegerLiteral 3))) $
+    parseExpression [IDENTIFIER "b",TIMES,LBRACE,IDENTIFIER "a",PLUS,INTEGERLITERAL 3,RBRACE]
+
+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]
 
 testStatementIfThen = TestCase $
     assertEqual "expect empty ifthen" [If (Reference "a") (Block [Block []]) Nothing] $
@@ -218,6 +228,9 @@ tests = TestList [
     testExpressionDivideEqual,
     testExpressionPlusEqual,
     testExpressionMinusEqual,
+    testExpressionBraced,
+    testExpressionThis,
+    testExpressionPrecedence,
     testStatementIfThen,
     testStatementIfThenElse,
     testStatementWhile

src/ByteCode/ClassFile.hs

@@ -32,6 +32,7 @@ data Operation = Opiadd
                | Opior
                | Opixor
                | Opineg
+               | Opdup
                | Opif_icmplt Word16
                | Opif_icmple Word16
                | Opif_icmpgt Word16
@@ -99,6 +100,7 @@ opcodeEncodingLength Opiand                 = 1
 opcodeEncodingLength Opior                  = 1
 opcodeEncodingLength Opixor                 = 1
 opcodeEncodingLength Opineg                 = 1
+opcodeEncodingLength Opdup                  = 1
 opcodeEncodingLength (Opif_icmplt _)        = 3
 opcodeEncodingLength (Opif_icmple _)        = 3
 opcodeEncodingLength (Opif_icmpgt _)        = 3
@@ -149,6 +151,7 @@ instance Serializable Operation where
     serialize Opior                     = [0x80]
     serialize Opixor                    = [0x82]
     serialize Opineg                    = [0x74]
+    serialize Opdup                     = [0x59]
     serialize (Opif_icmplt branch)      = 0xA1 : unpackWord16 branch
     serialize (Opif_icmple branch)      = 0xA4 : unpackWord16 branch
     serialize (Opif_icmpgt branch)      = 0xA3 : unpackWord16 branch

src/ByteCode/Generation/Assembler/Expression.hs

@@ -21,15 +21,20 @@ assembleExpression (constants, ops, lvars) (TypedExpression _ (BinaryOperation o
             cmp_ops = [cmp_op, Opsipush 0, Opgoto 6, Opsipush 1]
         in
             (bConstants, bOps ++ cmp_ops, lvars)
+
 assembleExpression (constants, ops, lvars) (TypedExpression _ (CharacterLiteral literal)) =
     (constants, ops ++ [Opsipush (fromIntegral (ord literal))], lvars)
+
 assembleExpression (constants, ops, lvars) (TypedExpression _ (BooleanLiteral literal)) =
     (constants, ops ++ [Opsipush (if literal then 1 else 0)], lvars)
+
 assembleExpression (constants, ops, lvars) (TypedExpression _ (IntegerLiteral literal))
     | literal <= 32767 && literal >= -32768 = (constants, ops ++ [Opsipush (fromIntegral literal)], lvars)
     | otherwise = (constants ++ [IntegerInfo (fromIntegral literal)], ops ++ [Opldc_w (fromIntegral (1 + length constants))], lvars)
+
 assembleExpression (constants, ops, lvars) (TypedExpression _ NullLiteral) =
     (constants, ops ++ [Opaconst_null], lvars)
+
 assembleExpression (constants, ops, lvars) (TypedExpression etype (UnaryOperation Not expr)) = let
         (exprConstants, exprOps, _) = assembleExpression (constants, ops, lvars) expr
         newConstant = fromIntegral (1 + length exprConstants)
@@ -37,19 +42,112 @@ assembleExpression (constants, ops, lvars) (TypedExpression etype (UnaryOperatio
         "int" -> (exprConstants ++ [IntegerInfo 0x7FFFFFFF], exprOps ++ [Opldc_w newConstant, Opixor], lvars)
         "char" -> (exprConstants, exprOps ++ [Opsipush 0xFFFF, Opixor], lvars)
         "boolean" -> (exprConstants, exprOps ++ [Opsipush 0x01, Opixor], lvars)
+
 assembleExpression (constants, ops, lvars) (TypedExpression _ (UnaryOperation Minus expr)) = let
         (exprConstants, exprOps, _) = assembleExpression (constants, ops, lvars) expr
     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
         Just index -> (constants, ops ++ [Opaload 0, Opgetfield (fromIntegral index)], lvars)
         Nothing -> error ("No such field found in constant pool: " ++ name)
+
 assembleExpression (constants, ops, lvars) (TypedExpression dtype (LocalVariable name)) = let
         localIndex = findIndex ((==) name) lvars
         isPrimitive = elem dtype ["char", "boolean", "int"]
     in case localIndex of
         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 _ expr = error ("unimplemented: " ++ show expr)

src/ByteCode/Generation/Assembler/Statement.hs

@@ -4,6 +4,7 @@ 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
@@ -43,4 +44,8 @@ assembleStatement (constants, ops, lvars) (TypedStatement _ (LocalVariableDeclar
         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

@@ -5,7 +5,9 @@ import ByteCode.ClassFile(ClassFile (..), ConstantInfo (..), MemberInfo(..), Ope
 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)
@@ -16,3 +18,12 @@ assembleStatementExpression
     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/Parser/JavaParser.y

@@ -215,7 +215,7 @@ localvariabledeclaration : type variabledeclarators { map LocalVariableDeclarati
 
 statementwithouttrailingsubstatement : block { [$1] }
                  | emptystatement { [] }
-                --  | expressionstatement { }
+                 | expressionstatement { [$1] }
                  | returnstatement { [$1] }
 
 ifthenstatement  : IF LBRACE expression  RBRACE  statement { If $3 (Block $5) Nothing }
@@ -229,7 +229,7 @@ assignmentexpression : conditionalexpression { $1 }
 
 emptystatement         :  SEMICOLON  { Block [] }
 
-expressionstatement : statementexpression  SEMICOLON { }
+expressionstatement : statementexpression  SEMICOLON { StatementExpressionStatement $1 }
 
 returnstatement  : RETURN  SEMICOLON  { Return Nothing }
                  | RETURN expression  SEMICOLON { Return $ Just $2 }
@@ -248,13 +248,13 @@ assignment       : lefthandside assignmentoperator assignmentexpression {
                         }
         
 
-statementexpression : assignment { }
+statementexpression : assignment { $1 }
-                 | preincrementexpression { }
+                --  | preincrementexpression { }
-                 | predecrementexpression { }
+                --  | predecrementexpression { }
-                 | postincrementexpression { }
+                --  | postincrementexpression { }
-                 | postdecrementexpression { }
+                --  | postdecrementexpression { }
-                 | methodinvocation { }
+                --  | methodinvocation { }
-                 | classinstancecreationexpression { }
+                --  | classinstancecreationexpression { }
 
 ifthenelsestatementnoshortif :IF LBRACE expression  RBRACE  statementnoshortif
                               ELSE statementnoshortif  { }
@@ -316,8 +316,8 @@ inclusiveorexpression : exclusiveorexpression { $1 }
                  | inclusiveorexpression OR exclusiveorexpression { BinaryOperation Or $1 $3 }
 
 primarynonewarray : literal { $1 }
-                --  | THIS { }
+                 | THIS { Reference "this" }
-                --  | LBRACE expression RBRACE  { }
+                 | LBRACE expression RBRACE  { $2 }
                 --  | classinstancecreationexpression { }
                 --  | fieldaccess { }
                 --  | methodinvocation { }