MisterChaos69/MiniJavaCompiler
2
2
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Compare commits

base: MisterChaos69:2b7d217e8a78f880890bb5ca5a8f44f8d9f996d8
Branches Tags
MisterChaos69:master
MisterChaos69:bytecode
MisterChaos69:create-parser
MisterChaos69:typechecker_addPublicPrivate
MisterChaos69:typedAST
MisterChaos69:documentation
..
compare: MisterChaos69:6f4143a60a5bf58e8832099c41b4be24d9052798
Branches Tags
MisterChaos69:master
MisterChaos69:bytecode
MisterChaos69:create-parser
MisterChaos69:typechecker_addPublicPrivate
MisterChaos69:typedAST
MisterChaos69:documentation

No commits in common. "2b7d217e8a78f880890bb5ca5a8f44f8d9f996d8" and "6f4143a60a5bf58e8832099c41b4be24d9052798" have entirely different histories.
2b7d217e8a ... 6f4143a60a

10 changed files with 245 additions and 284 deletions
Show Stats Expand all files Collapse all files

48
Test/TestParser.hs
View File

@ -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,
testStatementAssign,
testStatementMethodCallNoParams
testStatementWhile
]

4
project.cabal
View File

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

8
src/Ast.hs
View File

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

255
src/ByteCode/Generation/Assembler/ExpressionAndStatement.hs → src/ByteCode/Generation/Assembler/Expression.hs
View File

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

2
src/ByteCode/Generation/Assembler/Method.hs
View File

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

51
src/ByteCode/Generation/Assembler/Statement.hs Normal file
View File

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

29
src/ByteCode/Generation/Assembler/StatementExpression.hs Normal file
View File

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

10
src/Example.hs
View File

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

42
src/Parser/JavaParser.y
View File

@ -127,8 +127,8 @@ classorinterfacetype : simplename { $1 }
classmemberdeclaration : fielddeclaration { $1 }
| methoddeclaration { $1 }
constructordeclaration : constructordeclarator constructorbody { MethodDecl $ MethodDeclaration "void" "<init>" $1 $2 }
| modifiers constructordeclarator constructorbody { MethodDecl $ MethodDeclaration "void" "<init>" $2 $3 }
constructordeclaration : constructordeclarator constructorbody { case $1 of (classname, parameters) -> MethodDecl $ MethodDeclaration "void" "<init>" parameters $2 }
| 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 { [] }
| simplename LBRACE formalparameterlist RBRACE { $3 }
constructordeclarator : simplename LBRACE RBRACE { ($1, []) }
| 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 COMMA expression { $1 ++ [$3] }
argumentlist : expression { }
| 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 [] }
| simplename LBRACE argumentlist RBRACE { MethodCall (Reference "this") $1 $3 }
| primary DOT IDENTIFIER LBRACE RBRACE { MethodCall $1 $3 [] }
| primary DOT IDENTIFIER LBRACE argumentlist RBRACE { MethodCall $1 $3 $5 }
methodinvocation : name LBRACE RBRACE { }
| name LBRACE argumentlist RBRACE { }
| primary DOT IDENTIFIER LBRACE RBRACE { }
| 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 }
| postdecrementexpression { StatementExpressionExpression $1 }
| postincrementexpression { $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 { }

80
src/Typecheck.hs
View File

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