Compare commits

...

4 Commits

6 changed files with 142 additions and 12 deletions

View File

@ -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

View File

@ -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

View File

@ -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)

View File

@ -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)

View File

@ -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)
@ -15,4 +17,13 @@ assembleStatementExpression
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)
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)

View File

@ -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 { }
| preincrementexpression { }
| predecrementexpression { }
| postincrementexpression { }
| postdecrementexpression { }
| methodinvocation { }
| classinstancecreationexpression { }
statementexpression : assignment { $1 }
-- | preincrementexpression { }
-- | predecrementexpression { }
-- | postincrementexpression { }
-- | postdecrementexpression { }
-- | methodinvocation { }
-- | 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 { }
-- | LBRACE expression RBRACE { }
| THIS { Reference "this" }
| LBRACE expression RBRACE { $2 }
-- | classinstancecreationexpression { }
-- | fieldaccess { }
-- | methodinvocation { }