From e04c475c5533db5eb8479e745102dc8c2bb858c6 Mon Sep 17 00:00:00 2001 From: Marvin Schlegel Date: Mon, 6 May 2024 10:16:57 +0200 Subject: [PATCH 01/98] parser add custom type fields --- Test/TestParser.hs | 7 ++++++- src/Parser/JavaParser.y | 12 ++++++------ 2 files changed, 12 insertions(+), 7 deletions(-) diff --git a/Test/TestParser.hs b/Test/TestParser.hs index ce3f2cc..3fd30f0 100644 --- a/Test/TestParser.hs +++ b/Test/TestParser.hs @@ -18,11 +18,16 @@ testBooleanField = TestCase $ testIntField = TestCase $ assertEqual "expect class with int field" [Class "WithInt" [] [VariableDeclaration "int" "value" Nothing]] $ parse [CLASS,IDENTIFIER "WithInt",LBRACKET,INT,IDENTIFIER "value",SEMICOLON,RBRACKET] +testCustomTypeField = TestCase $ + assertEqual "expect class with foo field" [Class "WithFoo" [] [VariableDeclaration "Foo" "value" Nothing]] $ + parse [CLASS,IDENTIFIER "WithFoo",LBRACKET,IDENTIFIER "Foo",IDENTIFIER "value",SEMICOLON,RBRACKET] + tests = TestList [ testSingleEmptyClass, testTwoEmptyClasses, testBooleanField, - testIntField + testIntField, + testCustomTypeField ] \ No newline at end of file diff --git a/src/Parser/JavaParser.y b/src/Parser/JavaParser.y index bfe74b2..bcfec2f 100644 --- a/src/Parser/JavaParser.y +++ b/src/Parser/JavaParser.y @@ -80,14 +80,14 @@ compilationunit : typedeclarations { $1 } typedeclarations : typedeclaration { [$1] } | typedeclarations typedeclaration { $1 ++ [$2] } -name : qualifiedname { } - | simplename { } +name : simplename { $1 } + -- | qualifiedname { } typedeclaration : classdeclaration { $1 } qualifiedname : name DOT IDENTIFIER { } -simplename : IDENTIFIER { } +simplename : IDENTIFIER { $1 } classdeclaration : CLASS IDENTIFIER classbody { case $3 of (methods, fields) -> Class $2 methods fields } -- | modifiers CLASS IDENTIFIER classbody { case $4 of (methods, fields) -> Class $3 methods fields } @@ -120,7 +120,7 @@ classtype : classorinterfacetype{ } classbodydeclaration : classmemberdeclaration { $1 } -- | constructordeclaration { FieldDecl $ VariableDeclaration "int" "a" Nothing } -- TODO -classorinterfacetype : name{ } +classorinterfacetype : name { $1 } classmemberdeclaration : fielddeclaration { $1 } -- | methoddeclaration { } @@ -150,7 +150,7 @@ methodheader : type methoddeclarator { } | modifiers VOID methoddeclarator { } type : primitivetype { $1 } - -- | referencetype { } + | referencetype { $1 } variabledeclarators : variabledeclarator { [$1] } -- | variabledeclarators COMMA variabledeclarator { $1 ++ [$3] } @@ -176,7 +176,7 @@ methoddeclarator : IDENTIFIER LBRACE RBRACE { } primitivetype : BOOLEAN { "boolean" } | numerictype { $1 } -referencetype : classorinterfacetype { } +referencetype : classorinterfacetype { $1 } variabledeclarator : variabledeclaratorid { Declarator $1 Nothing } From 32cce1f137d4ab41439fa3648ce866a8cb0a4b17 Mon Sep 17 00:00:00 2001 From: Marvin Schlegel Date: Mon, 6 May 2024 10:33:37 +0200 Subject: [PATCH 02/98] parser implement multiple declarations --- Test/TestParser.hs | 10 ++++++++-- src/Parser/JavaParser.y | 12 ++++++------ 2 files changed, 14 insertions(+), 8 deletions(-) diff --git a/Test/TestParser.hs b/Test/TestParser.hs index 3fd30f0..35f25ab 100644 --- a/Test/TestParser.hs +++ b/Test/TestParser.hs @@ -21,7 +21,12 @@ testIntField = TestCase $ testCustomTypeField = TestCase $ assertEqual "expect class with foo field" [Class "WithFoo" [] [VariableDeclaration "Foo" "value" Nothing]] $ parse [CLASS,IDENTIFIER "WithFoo",LBRACKET,IDENTIFIER "Foo",IDENTIFIER "value",SEMICOLON,RBRACKET] - +testMultipleDeclarationSameLine = TestCase $ + assertEqual "expect class with two int fields" [Class "TwoInts" [] [VariableDeclaration "int" "num1" Nothing, VariableDeclaration "int" "num2" Nothing]] $ + parse [CLASS,IDENTIFIER "TwoInts",LBRACKET,INT,IDENTIFIER "num1",COMMA,IDENTIFIER "num2",SEMICOLON,RBRACKET] +testMultipleDeclarations = TestCase $ + assertEqual "expect class with int and char field" [Class "Multiple" [] [VariableDeclaration "int" "value" Nothing, VariableDeclaration "char" "letter" Nothing]] $ + parse [CLASS,IDENTIFIER "Multiple",LBRACKET,INT,IDENTIFIER "value",SEMICOLON,CHAR,IDENTIFIER "letter",SEMICOLON,RBRACKET] tests = TestList [ @@ -29,5 +34,6 @@ tests = TestList [ testTwoEmptyClasses, testBooleanField, testIntField, - testCustomTypeField + testCustomTypeField, + testMultipleDeclarations ] \ No newline at end of file diff --git a/src/Parser/JavaParser.y b/src/Parser/JavaParser.y index bcfec2f..69fe9f2 100644 --- a/src/Parser/JavaParser.y +++ b/src/Parser/JavaParser.y @@ -103,11 +103,11 @@ classbodydeclarations : classbodydeclaration { MethodDecl method -> ([method], []) FieldDecls fields -> ([], fields) } - -- | classbodydeclarations classbodydeclaration { - -- case ($1, $2) of - -- ((methods, fields), MethodDecl method) -> ((methods ++ [method]), fields) - -- ((methods, fields), FieldDecl field) -> (methods, (fields ++ [field])) - -- } + | classbodydeclarations classbodydeclaration { + case ($1, $2) of + ((methods, fields), MethodDecl method) -> ((methods ++ [method]), fields) + ((methods, fields), FieldDecls newFields) -> (methods, (fields ++ newFields)) + } modifier : PUBLIC { } | PROTECTED { } @@ -153,7 +153,7 @@ type : primitivetype { $1 } | referencetype { $1 } variabledeclarators : variabledeclarator { [$1] } - -- | variabledeclarators COMMA variabledeclarator { $1 ++ [$3] } + | variabledeclarators COMMA variabledeclarator { $1 ++ [$3] } methodbody : block { } | SEMICOLON { } From bea9a039a8a60a93f5763d7e6f2d59ac9ff10e6c Mon Sep 17 00:00:00 2001 From: Marvin Schlegel Date: Mon, 6 May 2024 10:09:50 +0200 Subject: [PATCH 03/98] parser add modifier --- Test/TestParser.hs | 6 +++++- src/Parser/JavaParser.y | 7 ++----- 2 files changed, 7 insertions(+), 6 deletions(-) diff --git a/Test/TestParser.hs b/Test/TestParser.hs index 35f25ab..b979794 100644 --- a/Test/TestParser.hs +++ b/Test/TestParser.hs @@ -27,6 +27,9 @@ testMultipleDeclarationSameLine = TestCase $ testMultipleDeclarations = TestCase $ assertEqual "expect class with int and char field" [Class "Multiple" [] [VariableDeclaration "int" "value" Nothing, VariableDeclaration "char" "letter" Nothing]] $ parse [CLASS,IDENTIFIER "Multiple",LBRACKET,INT,IDENTIFIER "value",SEMICOLON,CHAR,IDENTIFIER "letter",SEMICOLON,RBRACKET] +testWithModifier = TestCase $ + assertEqual "expect class with int field" [Class "WithInt" [] [VariableDeclaration "int" "value" Nothing]] $ + parse [ABSTRACT,CLASS,IDENTIFIER "WithInt",LBRACKET,PUBLIC,INT,IDENTIFIER "value",SEMICOLON,RBRACKET] tests = TestList [ @@ -35,5 +38,6 @@ tests = TestList [ testBooleanField, testIntField, testCustomTypeField, - testMultipleDeclarations + testMultipleDeclarations, + testWithModifier ] \ No newline at end of file diff --git a/src/Parser/JavaParser.y b/src/Parser/JavaParser.y index 69fe9f2..8d772eb 100644 --- a/src/Parser/JavaParser.y +++ b/src/Parser/JavaParser.y @@ -90,7 +90,7 @@ qualifiedname : name DOT IDENTIFIER { } simplename : IDENTIFIER { $1 } classdeclaration : CLASS IDENTIFIER classbody { case $3 of (methods, fields) -> Class $2 methods fields } - -- | modifiers CLASS IDENTIFIER classbody { case $4 of (methods, fields) -> Class $3 methods fields } + | modifiers CLASS IDENTIFIER classbody { case $4 of (methods, fields) -> Class $3 methods fields } classbody : LBRACKET RBRACKET { ([], []) } | LBRACKET classbodydeclarations RBRACKET { $2 } @@ -129,7 +129,7 @@ constructordeclaration : constructordeclarator constructorbody { } | modifiers constructordeclarator constructorbody { } fielddeclaration : type variabledeclarators SEMICOLON { FieldDecls $ map (convertDeclarator $1) $2 } - -- | modifiers type variabledeclarators SEMICOLON {} + | modifiers type variabledeclarators SEMICOLON { FieldDecls $ map (convertDeclarator $2) $3 } methoddeclaration : methodheader methodbody { } @@ -365,9 +365,6 @@ data MethodOrFieldDeclaration = MethodDecl MethodDeclaration data Declarator = Declarator Identifier (Maybe Expression) --- convertDeclaratorList :: [DataType] -> MethodOrFieldDeclaration --- convertDeclaratorList = FieldDecls $ map - convertDeclarator :: DataType -> Declarator -> VariableDeclaration convertDeclarator dataType (Declarator id assigment) = VariableDeclaration dataType id assigment From d3ea0d6d7bc0d3e19c32bdc9cc78422f5dbee270 Mon Sep 17 00:00:00 2001 From: Marvin Schlegel Date: Mon, 6 May 2024 23:34:03 +0200 Subject: [PATCH 04/98] parser add empty methods --- Test/TestParser.hs | 6 +++++- src/Parser/JavaParser.y | 24 ++++++++++++------------ 2 files changed, 17 insertions(+), 13 deletions(-) diff --git a/Test/TestParser.hs b/Test/TestParser.hs index b979794..4e0694b 100644 --- a/Test/TestParser.hs +++ b/Test/TestParser.hs @@ -30,6 +30,9 @@ testMultipleDeclarations = TestCase $ testWithModifier = TestCase $ assertEqual "expect class with int field" [Class "WithInt" [] [VariableDeclaration "int" "value" Nothing]] $ parse [ABSTRACT,CLASS,IDENTIFIER "WithInt",LBRACKET,PUBLIC,INT,IDENTIFIER "value",SEMICOLON,RBRACKET] +testMethod = TestCase $ + assertEqual "expect class with method" [Class "WithMethod" [MethodDeclaration "int" "foo" [] (Block [])] []] $ + parse [CLASS,IDENTIFIER "WithMethod",LBRACKET,INT,IDENTIFIER "foo",LBRACE,RBRACE,SEMICOLON,RBRACKET] tests = TestList [ @@ -39,5 +42,6 @@ tests = TestList [ testIntField, testCustomTypeField, testMultipleDeclarations, - testWithModifier + testWithModifier, + testMethod ] \ No newline at end of file diff --git a/src/Parser/JavaParser.y b/src/Parser/JavaParser.y index 8d772eb..d48b7e2 100644 --- a/src/Parser/JavaParser.y +++ b/src/Parser/JavaParser.y @@ -123,7 +123,7 @@ classbodydeclaration : classmemberdeclaration { $1 } classorinterfacetype : name { $1 } classmemberdeclaration : fielddeclaration { $1 } - -- | methoddeclaration { } + | methoddeclaration { $1 } constructordeclaration : constructordeclarator constructorbody { } | modifiers constructordeclarator constructorbody { } @@ -131,10 +131,10 @@ constructordeclaration : constructordeclarator constructorbody { } fielddeclaration : type variabledeclarators SEMICOLON { FieldDecls $ map (convertDeclarator $1) $2 } | modifiers type variabledeclarators SEMICOLON { FieldDecls $ map (convertDeclarator $2) $3 } -methoddeclaration : methodheader methodbody { } +methoddeclaration : methodheader methodbody { case $1 of (returnType, (name, parameters)) -> MethodDecl (MethodDeclaration returnType name parameters $2) } -block : LBRACKET RBRACKET { } - | LBRACKET blockstatements RBRACKET { } +block : LBRACKET RBRACKET { Block [] } + -- | LBRACKET blockstatements RBRACKET { } constructordeclarator : simplename LBRACE RBRACE { } | simplename LBRACE formalparameterlist RBRACE { } @@ -144,10 +144,10 @@ constructorbody : LBRACKET RBRACKET { } | LBRACKET blockstatements RBRACKET { } | LBRACKET explicitconstructorinvocation blockstatements RBRACKET { } -methodheader : type methoddeclarator { } - | modifiers type methoddeclarator { } - | VOID methoddeclarator { } - | modifiers VOID methoddeclarator { } +methodheader : type methoddeclarator { ($1, $2) } + -- | modifiers type methoddeclarator { } + -- | VOID methoddeclarator { } + -- | modifiers VOID methoddeclarator { } type : primitivetype { $1 } | referencetype { $1 } @@ -155,8 +155,8 @@ type : primitivetype { $1 } variabledeclarators : variabledeclarator { [$1] } | variabledeclarators COMMA variabledeclarator { $1 ++ [$3] } -methodbody : block { } - | SEMICOLON { } +methodbody : block { $1 } + | SEMICOLON { Block [] } blockstatements : blockstatement { } | blockstatements blockstatement { } @@ -170,8 +170,8 @@ explicitconstructorinvocation : THIS LBRACE RBRACE SEMICOLON { } classtypelist : classtype { } | classtypelist COMMA classtype { } -methoddeclarator : IDENTIFIER LBRACE RBRACE { } - | IDENTIFIER LBRACE formalparameterlist RBRACE { } +methoddeclarator : IDENTIFIER LBRACE RBRACE { ($1, []) } + -- | IDENTIFIER LBRACE formalparameterlist RBRACE { } primitivetype : BOOLEAN { "boolean" } | numerictype { $1 } From e3fa3efd952e14cfe51c702ebde07b655b869d20 Mon Sep 17 00:00:00 2001 From: Marvin Schlegel Date: Mon, 6 May 2024 23:51:33 +0200 Subject: [PATCH 05/98] add void methods --- Test/TestParser.hs | 13 +++++++++++-- src/Parser/JavaParser.y | 8 ++++---- 2 files changed, 15 insertions(+), 6 deletions(-) diff --git a/Test/TestParser.hs b/Test/TestParser.hs index 4e0694b..85b899b 100644 --- a/Test/TestParser.hs +++ b/Test/TestParser.hs @@ -30,9 +30,16 @@ testMultipleDeclarations = TestCase $ testWithModifier = TestCase $ assertEqual "expect class with int field" [Class "WithInt" [] [VariableDeclaration "int" "value" Nothing]] $ parse [ABSTRACT,CLASS,IDENTIFIER "WithInt",LBRACKET,PUBLIC,INT,IDENTIFIER "value",SEMICOLON,RBRACKET] -testMethod = TestCase $ + +testEmptyMethod = TestCase $ assertEqual "expect class with method" [Class "WithMethod" [MethodDeclaration "int" "foo" [] (Block [])] []] $ parse [CLASS,IDENTIFIER "WithMethod",LBRACKET,INT,IDENTIFIER "foo",LBRACE,RBRACE,SEMICOLON,RBRACKET] +testEmptyPrivateMethod = TestCase $ + assertEqual "expect class with method" [Class "WithMethod" [MethodDeclaration "int" "foo" [] (Block [])] []] $ + parse [CLASS,IDENTIFIER "WithMethod",LBRACKET,PRIVATE,INT,IDENTIFIER "foo",LBRACE,RBRACE,LBRACKET,RBRACKET,RBRACKET] +testEmptyVoidMethod = TestCase $ + assertEqual "expect class with method" [Class "WithMethod" [MethodDeclaration "void" "foo" [] (Block [])] []] $ + parse [CLASS,IDENTIFIER "WithMethod",LBRACKET,VOID,IDENTIFIER "foo",LBRACE,RBRACE,LBRACKET,RBRACKET,RBRACKET] tests = TestList [ @@ -43,5 +50,7 @@ tests = TestList [ testCustomTypeField, testMultipleDeclarations, testWithModifier, - testMethod + testEmptyMethod, + testEmptyPrivateMethod, + testEmptyVoidMethod ] \ No newline at end of file diff --git a/src/Parser/JavaParser.y b/src/Parser/JavaParser.y index d48b7e2..ec3788c 100644 --- a/src/Parser/JavaParser.y +++ b/src/Parser/JavaParser.y @@ -144,10 +144,10 @@ constructorbody : LBRACKET RBRACKET { } | LBRACKET blockstatements RBRACKET { } | LBRACKET explicitconstructorinvocation blockstatements RBRACKET { } -methodheader : type methoddeclarator { ($1, $2) } - -- | modifiers type methoddeclarator { } - -- | VOID methoddeclarator { } - -- | modifiers VOID methoddeclarator { } +methodheader : type methoddeclarator { ($1, $2) } + | modifiers type methoddeclarator { ($2, $3) } + | VOID methoddeclarator { ("void", $2) } + | modifiers VOID methoddeclarator { ("void", $3)} type : primitivetype { $1 } | referencetype { $1 } From 158197b44007e20b4aeb633c17bd96329646564b Mon Sep 17 00:00:00 2001 From: Marvin Schlegel Date: Tue, 7 May 2024 15:03:04 +0200 Subject: [PATCH 06/98] parser implement methods with params --- Test/TestParser.hs | 14 +++++++++++++- src/Parser/JavaParser.y | 8 ++++---- 2 files changed, 17 insertions(+), 5 deletions(-) diff --git a/Test/TestParser.hs b/Test/TestParser.hs index 85b899b..8e1aaa7 100644 --- a/Test/TestParser.hs +++ b/Test/TestParser.hs @@ -40,6 +40,15 @@ testEmptyPrivateMethod = TestCase $ testEmptyVoidMethod = TestCase $ assertEqual "expect class with method" [Class "WithMethod" [MethodDeclaration "void" "foo" [] (Block [])] []] $ parse [CLASS,IDENTIFIER "WithMethod",LBRACKET,VOID,IDENTIFIER "foo",LBRACE,RBRACE,LBRACKET,RBRACKET,RBRACKET] +testEmptyMethodWithParam = TestCase $ + assertEqual "expect class with method with param" [Class "WithParam" [MethodDeclaration "void" "foo" [ParameterDeclaration "int" "param"] (Block [])] []] $ + parse [CLASS,IDENTIFIER "WithParam",LBRACKET,VOID,IDENTIFIER "foo",LBRACE,INT,IDENTIFIER "param",RBRACE,SEMICOLON,RBRACKET] +testEmptyMethodWithParams = TestCase $ + assertEqual "expect class with multiple params" [Class "WithParams" [MethodDeclaration "void" "foo" [ParameterDeclaration "int" "p1",ParameterDeclaration "Custom" "p2"] (Block [])] []] $ + parse [CLASS,IDENTIFIER "WithParams",LBRACKET,VOID,IDENTIFIER "foo",LBRACE,INT,IDENTIFIER "p1",COMMA,IDENTIFIER "Custom",IDENTIFIER "p2",RBRACE,SEMICOLON,RBRACKET] +testClassWithMethodAndField = TestCase $ + assertEqual "expect class with method and field" [Class "WithMethodAndField" [MethodDeclaration "void" "foo" [] (Block []), MethodDeclaration "int" "bar" [] (Block [])] [VariableDeclaration "int" "value" Nothing]] $ + parse [CLASS,IDENTIFIER "WithMethodAndField",LBRACKET,VOID,IDENTIFIER "foo",LBRACE,RBRACE,LBRACKET,RBRACKET,INT,IDENTIFIER "value",SEMICOLON,INT,IDENTIFIER "bar",LBRACE,RBRACE,SEMICOLON,RBRACKET] tests = TestList [ @@ -52,5 +61,8 @@ tests = TestList [ testWithModifier, testEmptyMethod, testEmptyPrivateMethod, - testEmptyVoidMethod + testEmptyVoidMethod, + testEmptyMethodWithParam, + testEmptyMethodWithParams, + testClassWithMethodAndField ] \ No newline at end of file diff --git a/src/Parser/JavaParser.y b/src/Parser/JavaParser.y index ec3788c..8edb2df 100644 --- a/src/Parser/JavaParser.y +++ b/src/Parser/JavaParser.y @@ -161,8 +161,8 @@ methodbody : block { $1 } blockstatements : blockstatement { } | blockstatements blockstatement { } -formalparameterlist : formalparameter { } - | formalparameterlist COMMA formalparameter{ } +formalparameterlist : formalparameter { [$1] } + | formalparameterlist COMMA formalparameter { $1 ++ [$3] } explicitconstructorinvocation : THIS LBRACE RBRACE SEMICOLON { } | THIS LBRACE argumentlist RBRACE SEMICOLON { } @@ -171,7 +171,7 @@ classtypelist : classtype { } | classtypelist COMMA classtype { } methoddeclarator : IDENTIFIER LBRACE RBRACE { ($1, []) } - -- | IDENTIFIER LBRACE formalparameterlist RBRACE { } + | IDENTIFIER LBRACE formalparameterlist RBRACE { ($1, $3) } primitivetype : BOOLEAN { "boolean" } | numerictype { $1 } @@ -185,7 +185,7 @@ variabledeclarator : variabledeclaratorid { Declarator $1 Nothing } blockstatement : localvariabledeclarationstatement { } | statement { } -formalparameter : type variabledeclaratorid { } +formalparameter : type variabledeclaratorid { ParameterDeclaration $1 $2 } argumentlist : expression { } | argumentlist COMMA expression { } From 5e8a2a90eda390cbe5272e209fdc085ad7d51077 Mon Sep 17 00:00:00 2001 From: Marvin Schlegel Date: Wed, 8 May 2024 00:00:18 +0200 Subject: [PATCH 07/98] parser improve error messages --- src/Parser/JavaParser.y | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/Parser/JavaParser.y b/src/Parser/JavaParser.y index 8edb2df..6c249ac 100644 --- a/src/Parser/JavaParser.y +++ b/src/Parser/JavaParser.y @@ -7,6 +7,7 @@ import Parser.Lexer %name parse %tokentype { Token } %error { parseError } +%errorhandlertype explist %token BOOLEAN { BOOLEAN } @@ -368,7 +369,7 @@ data Declarator = Declarator Identifier (Maybe Expression) convertDeclarator :: DataType -> Declarator -> VariableDeclaration convertDeclarator dataType (Declarator id assigment) = VariableDeclaration dataType id assigment -parseError :: [Token] -> a -parseError msg = error ("Parse error: " ++ show msg) +parseError :: ([Token], [String]) -> a +parseError (errortoken, expected) = error ("parse error on token: " ++ show errortoken ++ "\nexpected one of: " ++ show expected) } From fecc7eceaa9777139ce3dbbadfba0376bc51dc0f Mon Sep 17 00:00:00 2001 From: Marvin Schlegel Date: Wed, 8 May 2024 00:02:38 +0200 Subject: [PATCH 08/98] parser add constructor --- Test/TestParser.hs | 6 +++++- src/Parser/JavaParser.y | 18 +++++++++--------- 2 files changed, 14 insertions(+), 10 deletions(-) diff --git a/Test/TestParser.hs b/Test/TestParser.hs index 8e1aaa7..b078def 100644 --- a/Test/TestParser.hs +++ b/Test/TestParser.hs @@ -49,6 +49,9 @@ testEmptyMethodWithParams = TestCase $ testClassWithMethodAndField = TestCase $ assertEqual "expect class with method and field" [Class "WithMethodAndField" [MethodDeclaration "void" "foo" [] (Block []), MethodDeclaration "int" "bar" [] (Block [])] [VariableDeclaration "int" "value" Nothing]] $ parse [CLASS,IDENTIFIER "WithMethodAndField",LBRACKET,VOID,IDENTIFIER "foo",LBRACE,RBRACE,LBRACKET,RBRACKET,INT,IDENTIFIER "value",SEMICOLON,INT,IDENTIFIER "bar",LBRACE,RBRACE,SEMICOLON,RBRACKET] +testClassWithConstructor = TestCase $ + assertEqual "expect class with constructor" [Class "WithConstructor" [MethodDeclaration "WithConstructor" "" [] (Block [])] []] $ + parse [CLASS,IDENTIFIER "WithConstructor",LBRACKET,IDENTIFIER "WithConstructor",LBRACE,RBRACE,LBRACKET,RBRACKET,RBRACKET] tests = TestList [ @@ -64,5 +67,6 @@ tests = TestList [ testEmptyVoidMethod, testEmptyMethodWithParam, testEmptyMethodWithParams, - testClassWithMethodAndField + testClassWithMethodAndField, + testClassWithConstructor ] \ No newline at end of file diff --git a/src/Parser/JavaParser.y b/src/Parser/JavaParser.y index 6c249ac..d323009 100644 --- a/src/Parser/JavaParser.y +++ b/src/Parser/JavaParser.y @@ -119,15 +119,15 @@ modifier : PUBLIC { } classtype : classorinterfacetype{ } classbodydeclaration : classmemberdeclaration { $1 } - -- | constructordeclaration { FieldDecl $ VariableDeclaration "int" "a" Nothing } -- TODO + | constructordeclaration { $1 } classorinterfacetype : name { $1 } classmemberdeclaration : fielddeclaration { $1 } | methoddeclaration { $1 } -constructordeclaration : constructordeclarator constructorbody { } - | modifiers constructordeclarator constructorbody { } +constructordeclaration : constructordeclarator constructorbody { case $1 of (classname, parameters) -> MethodDecl $ MethodDeclaration classname "" parameters $2 } + | modifiers constructordeclarator constructorbody { case $2 of (classname, parameters) -> MethodDecl $ MethodDeclaration classname "" parameters $3 } fielddeclaration : type variabledeclarators SEMICOLON { FieldDecls $ map (convertDeclarator $1) $2 } | modifiers type variabledeclarators SEMICOLON { FieldDecls $ map (convertDeclarator $2) $3 } @@ -137,13 +137,13 @@ methoddeclaration : methodheader methodbody { case $1 of (returnType, (name, par block : LBRACKET RBRACKET { Block [] } -- | LBRACKET blockstatements RBRACKET { } -constructordeclarator : simplename LBRACE RBRACE { } - | simplename LBRACE formalparameterlist RBRACE { } +constructordeclarator : simplename LBRACE RBRACE { ($1, []) } + | simplename LBRACE formalparameterlist RBRACE { ($1, $3) } -constructorbody : LBRACKET RBRACKET { } - | LBRACKET explicitconstructorinvocation RBRACKET { } - | LBRACKET blockstatements RBRACKET { } - | LBRACKET explicitconstructorinvocation blockstatements RBRACKET { } +constructorbody : LBRACKET RBRACKET { Block [] } + -- | LBRACKET explicitconstructorinvocation RBRACKET { } + -- | LBRACKET blockstatements RBRACKET { } + -- | LBRACKET explicitconstructorinvocation blockstatements RBRACKET { } methodheader : type methoddeclarator { ($1, $2) } | modifiers type methoddeclarator { ($2, $3) } From 2f81f8266186dd6ef3666343c3ae7dd0537bb06e Mon Sep 17 00:00:00 2001 From: Marvin Schlegel Date: Wed, 8 May 2024 10:20:55 +0200 Subject: [PATCH 09/98] parser implement localvardeclaration --- Test/TestParser.hs | 10 +++++++++- src/Parser/JavaParser.y | 17 +++++++++-------- 2 files changed, 18 insertions(+), 9 deletions(-) diff --git a/Test/TestParser.hs b/Test/TestParser.hs index b078def..1a3484b 100644 --- a/Test/TestParser.hs +++ b/Test/TestParser.hs @@ -54,6 +54,12 @@ testClassWithConstructor = TestCase $ parse [CLASS,IDENTIFIER "WithConstructor",LBRACKET,IDENTIFIER "WithConstructor",LBRACE,RBRACE,LBRACKET,RBRACKET,RBRACKET] +testEmptyBlock = TestCase $ assertEqual "expect empty block" (Block []) $ parseBlock [LBRACKET,RBRACKET] +testBlockWithLocalVarDecl = TestCase $ + assertEqual "expect block with local var delcaration" (Block [LocalVariableDeclaration $ VariableDeclaration "int" "localvar" Nothing]) $ + parseBlock [LBRACKET,INT,IDENTIFIER "localvar",SEMICOLON,RBRACKET] + + tests = TestList [ testSingleEmptyClass, testTwoEmptyClasses, @@ -68,5 +74,7 @@ tests = TestList [ testEmptyMethodWithParam, testEmptyMethodWithParams, testClassWithMethodAndField, - testClassWithConstructor + testClassWithConstructor, + testEmptyBlock, + testBlockWithLocalVarDecl ] \ No newline at end of file diff --git a/src/Parser/JavaParser.y b/src/Parser/JavaParser.y index d323009..a0a7a3c 100644 --- a/src/Parser/JavaParser.y +++ b/src/Parser/JavaParser.y @@ -1,10 +1,11 @@ { -module Parser.JavaParser (parse) where +module Parser.JavaParser (parse, parseBlock) where import Ast import Parser.Lexer } %name parse +%name parseBlock block %tokentype { Token } %error { parseError } %errorhandlertype explist @@ -135,7 +136,7 @@ fielddeclaration : type variabledeclarators SEMICOLON { FieldDecls $ map (conve methoddeclaration : methodheader methodbody { case $1 of (returnType, (name, parameters)) -> MethodDecl (MethodDeclaration returnType name parameters $2) } block : LBRACKET RBRACKET { Block [] } - -- | LBRACKET blockstatements RBRACKET { } + | LBRACKET blockstatements RBRACKET { $2 } constructordeclarator : simplename LBRACE RBRACE { ($1, []) } | simplename LBRACE formalparameterlist RBRACE { ($1, $3) } @@ -159,8 +160,8 @@ variabledeclarators : variabledeclarator { [$1] } methodbody : block { $1 } | SEMICOLON { Block [] } -blockstatements : blockstatement { } - | blockstatements blockstatement { } +blockstatements : blockstatement { Block $1 } + -- | blockstatements blockstatement { } formalparameterlist : formalparameter { [$1] } | formalparameterlist COMMA formalparameter { $1 ++ [$3] } @@ -183,8 +184,8 @@ referencetype : classorinterfacetype { $1 } variabledeclarator : variabledeclaratorid { Declarator $1 Nothing } -- | variabledeclaratorid ASSIGN variableinitializer { Declarator $1 Nothing } -- TODO -blockstatement : localvariabledeclarationstatement { } - | statement { } +blockstatement : localvariabledeclarationstatement { $1 } + -- | statement { } formalparameter : type variabledeclaratorid { ParameterDeclaration $1 $2 } @@ -197,7 +198,7 @@ variabledeclaratorid : IDENTIFIER { $1 } variableinitializer : expression { } -localvariabledeclarationstatement : localvariabledeclaration SEMICOLON { } +localvariabledeclarationstatement : localvariabledeclaration SEMICOLON { $1 } statement : statementwithouttrailingsubstatement{ } | ifthenstatement { } @@ -210,7 +211,7 @@ expression : assignmentexpression { } integraltype : INT { "int" } | CHAR { "char" } -localvariabledeclaration : type variabledeclarators { } +localvariabledeclaration : type variabledeclarators { map LocalVariableDeclaration $ map (convertDeclarator $1) $2 } statementwithouttrailingsubstatement : block { } | emptystatement { } From a4b933d6593b90fc0f9288f4c614e2dff446156c Mon Sep 17 00:00:00 2001 From: Marvin Schlegel Date: Wed, 8 May 2024 10:30:50 +0200 Subject: [PATCH 10/98] parser implement multiple blockstatements --- Test/TestParser.hs | 6 +++++- src/Parser/JavaParser.y | 2 +- 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/Test/TestParser.hs b/Test/TestParser.hs index 1a3484b..28bdd00 100644 --- a/Test/TestParser.hs +++ b/Test/TestParser.hs @@ -58,6 +58,9 @@ testEmptyBlock = TestCase $ assertEqual "expect empty block" (Block []) $ parseB testBlockWithLocalVarDecl = TestCase $ assertEqual "expect block with local var delcaration" (Block [LocalVariableDeclaration $ VariableDeclaration "int" "localvar" Nothing]) $ parseBlock [LBRACKET,INT,IDENTIFIER "localvar",SEMICOLON,RBRACKET] +testBlockWithMultipleLocalVarDecls = TestCase $ + assertEqual "expect block with multiple local var declarations" (Block [LocalVariableDeclaration $ VariableDeclaration "int" "var1" Nothing, LocalVariableDeclaration $ VariableDeclaration "boolean" "var2" Nothing]) $ + parseBlock [LBRACKET,INT,IDENTIFIER "var1",SEMICOLON,BOOLEAN,IDENTIFIER "var2",SEMICOLON,RBRACKET] tests = TestList [ @@ -76,5 +79,6 @@ tests = TestList [ testClassWithMethodAndField, testClassWithConstructor, testEmptyBlock, - testBlockWithLocalVarDecl + testBlockWithLocalVarDecl, + testBlockWithMultipleLocalVarDecls ] \ No newline at end of file diff --git a/src/Parser/JavaParser.y b/src/Parser/JavaParser.y index a0a7a3c..5c423b5 100644 --- a/src/Parser/JavaParser.y +++ b/src/Parser/JavaParser.y @@ -161,7 +161,7 @@ methodbody : block { $1 } | SEMICOLON { Block [] } blockstatements : blockstatement { Block $1 } - -- | blockstatements blockstatement { } + | blockstatements blockstatement { case $1 of Block stmts -> Block (stmts ++ $2)} formalparameterlist : formalparameter { [$1] } | formalparameterlist COMMA formalparameter { $1 ++ [$3] } From e8151ad2f09b609a1e99d4be048c7fe069b5e3e9 Mon Sep 17 00:00:00 2001 From: Marvin Schlegel Date: Wed, 8 May 2024 10:37:40 +0200 Subject: [PATCH 11/98] parser implement nested blocks --- Test/TestParser.hs | 6 +++++- src/Parser/JavaParser.y | 18 +++++++++--------- 2 files changed, 14 insertions(+), 10 deletions(-) diff --git a/Test/TestParser.hs b/Test/TestParser.hs index 28bdd00..c000d6b 100644 --- a/Test/TestParser.hs +++ b/Test/TestParser.hs @@ -61,6 +61,9 @@ testBlockWithLocalVarDecl = TestCase $ testBlockWithMultipleLocalVarDecls = TestCase $ assertEqual "expect block with multiple local var declarations" (Block [LocalVariableDeclaration $ VariableDeclaration "int" "var1" Nothing, LocalVariableDeclaration $ VariableDeclaration "boolean" "var2" Nothing]) $ parseBlock [LBRACKET,INT,IDENTIFIER "var1",SEMICOLON,BOOLEAN,IDENTIFIER "var2",SEMICOLON,RBRACKET] +testNestedBlocks = TestCase $ + assertEqual "expect block with block inside" (Block [Block []]) $ + parseBlock [LBRACKET,LBRACKET,RBRACKET,RBRACKET] tests = TestList [ @@ -80,5 +83,6 @@ tests = TestList [ testClassWithConstructor, testEmptyBlock, testBlockWithLocalVarDecl, - testBlockWithMultipleLocalVarDecls + testBlockWithMultipleLocalVarDecls, + testNestedBlocks ] \ No newline at end of file diff --git a/src/Parser/JavaParser.y b/src/Parser/JavaParser.y index 5c423b5..fe309da 100644 --- a/src/Parser/JavaParser.y +++ b/src/Parser/JavaParser.y @@ -185,7 +185,7 @@ variabledeclarator : variabledeclaratorid { Declarator $1 Nothing } -- | variabledeclaratorid ASSIGN variableinitializer { Declarator $1 Nothing } -- TODO blockstatement : localvariabledeclarationstatement { $1 } - -- | statement { } + | statement { [$1] } formalparameter : type variabledeclaratorid { ParameterDeclaration $1 $2 } @@ -200,10 +200,10 @@ variableinitializer : expression { } localvariabledeclarationstatement : localvariabledeclaration SEMICOLON { $1 } -statement : statementwithouttrailingsubstatement{ } - | ifthenstatement { } - | ifthenelsestatement { } - | whilestatement { } +statement : statementwithouttrailingsubstatement{ $1 } + -- | ifthenstatement { } + -- | ifthenelsestatement { } + -- | whilestatement { } expression : assignmentexpression { } @@ -213,10 +213,10 @@ integraltype : INT { "int" } localvariabledeclaration : type variabledeclarators { map LocalVariableDeclaration $ map (convertDeclarator $1) $2 } -statementwithouttrailingsubstatement : block { } - | emptystatement { } - | expressionstatement { } - | returnstatement { } +statementwithouttrailingsubstatement : block { $1 } + -- | emptystatement { } + -- | expressionstatement { } + -- | returnstatement { } ifthenstatement : IF LBRACE expression RBRACE statement { } From ebfb912183f6b5c7cc716a3096f429b407456235 Mon Sep 17 00:00:00 2001 From: Marvin Schlegel Date: Wed, 8 May 2024 11:05:02 +0200 Subject: [PATCH 12/98] parser add emptystatement --- Test/TestParser.hs | 7 +++++-- src/Parser/JavaParser.y | 18 +++++++++--------- 2 files changed, 14 insertions(+), 11 deletions(-) diff --git a/Test/TestParser.hs b/Test/TestParser.hs index c000d6b..53a08a6 100644 --- a/Test/TestParser.hs +++ b/Test/TestParser.hs @@ -64,7 +64,9 @@ testBlockWithMultipleLocalVarDecls = TestCase $ testNestedBlocks = TestCase $ assertEqual "expect block with block inside" (Block [Block []]) $ parseBlock [LBRACKET,LBRACKET,RBRACKET,RBRACKET] - +testBlockWithEmptyStatement = TestCase $ + assertEqual "expect empty block" (Block []) $ + parseBlock [LBRACKET,SEMICOLON,SEMICOLON,RBRACKET] tests = TestList [ testSingleEmptyClass, @@ -84,5 +86,6 @@ tests = TestList [ testEmptyBlock, testBlockWithLocalVarDecl, testBlockWithMultipleLocalVarDecls, - testNestedBlocks + testNestedBlocks, + testBlockWithEmptyStatement ] \ No newline at end of file diff --git a/src/Parser/JavaParser.y b/src/Parser/JavaParser.y index fe309da..d2cf382 100644 --- a/src/Parser/JavaParser.y +++ b/src/Parser/JavaParser.y @@ -136,7 +136,7 @@ fielddeclaration : type variabledeclarators SEMICOLON { FieldDecls $ map (conve methoddeclaration : methodheader methodbody { case $1 of (returnType, (name, parameters)) -> MethodDecl (MethodDeclaration returnType name parameters $2) } block : LBRACKET RBRACKET { Block [] } - | LBRACKET blockstatements RBRACKET { $2 } + | LBRACKET blockstatements RBRACKET { Block $2 } constructordeclarator : simplename LBRACE RBRACE { ($1, []) } | simplename LBRACE formalparameterlist RBRACE { ($1, $3) } @@ -160,8 +160,8 @@ variabledeclarators : variabledeclarator { [$1] } methodbody : block { $1 } | SEMICOLON { Block [] } -blockstatements : blockstatement { Block $1 } - | blockstatements blockstatement { case $1 of Block stmts -> Block (stmts ++ $2)} +blockstatements : blockstatement { $1 } + | blockstatements blockstatement { $1 ++ $2} formalparameterlist : formalparameter { [$1] } | formalparameterlist COMMA formalparameter { $1 ++ [$3] } @@ -185,7 +185,7 @@ variabledeclarator : variabledeclaratorid { Declarator $1 Nothing } -- | variabledeclaratorid ASSIGN variableinitializer { Declarator $1 Nothing } -- TODO blockstatement : localvariabledeclarationstatement { $1 } - | statement { [$1] } + | statement { $1 } formalparameter : type variabledeclaratorid { ParameterDeclaration $1 $2 } @@ -213,8 +213,8 @@ integraltype : INT { "int" } localvariabledeclaration : type variabledeclarators { map LocalVariableDeclaration $ map (convertDeclarator $1) $2 } -statementwithouttrailingsubstatement : block { $1 } - -- | emptystatement { } +statementwithouttrailingsubstatement : block { [$1] } + | emptystatement { [] } -- | expressionstatement { } -- | returnstatement { } @@ -227,7 +227,7 @@ whilestatement : WHILE LBRACE expression RBRACE statement { } assignmentexpression : conditionalexpression { } | assignment{ } -emptystatement : SEMICOLON { } +emptystatement : SEMICOLON { Block [] } expressionstatement : statementexpression SEMICOLON { } @@ -338,8 +338,8 @@ andexpression : equalityexpression { } | andexpression AND equalityexpression { } equalityexpression : relationalexpression { } - | equalityexpression EQUAL relationalexpression { } - | equalityexpression NOTEQUAL relationalexpression { } + -- | equalityexpression EQUAL relationalexpression { } + -- | equalityexpression NOTEQUAL relationalexpression { } relationalexpression : shiftexpression { } | relationalexpression LESS shiftexpression { } From c8ce7f4b43ba4aa23f0a213b6cda139ef95c0586 Mon Sep 17 00:00:00 2001 From: Marvin Schlegel Date: Wed, 8 May 2024 13:16:00 +0200 Subject: [PATCH 13/98] parser implement int initializiation --- Test/TestParser.hs | 11 +++- src/Parser/JavaParser.y | 139 ++++++++++++++++++++-------------------- 2 files changed, 80 insertions(+), 70 deletions(-) diff --git a/Test/TestParser.hs b/Test/TestParser.hs index 53a08a6..7a79ba8 100644 --- a/Test/TestParser.hs +++ b/Test/TestParser.hs @@ -68,6 +68,13 @@ testBlockWithEmptyStatement = TestCase $ assertEqual "expect empty block" (Block []) $ parseBlock [LBRACKET,SEMICOLON,SEMICOLON,RBRACKET] +testExpressionIntLiteral = TestCase $ + assertEqual "expect IntLiteral" (IntegerLiteral 3) $ + parseExpression [INTEGERLITERAL 3] +testFieldWithInitialization = TestCase $ + assertEqual "expect Class with initialized field" [Class "WithInitField" [] [VariableDeclaration "int" "number" $ Just $ IntegerLiteral 3]] $ + parse [CLASS,IDENTIFIER "WithInitField",LBRACKET,INT,IDENTIFIER "number",ASSIGN,INTEGERLITERAL 3,SEMICOLON,RBRACKET] + tests = TestList [ testSingleEmptyClass, testTwoEmptyClasses, @@ -87,5 +94,7 @@ tests = TestList [ testBlockWithLocalVarDecl, testBlockWithMultipleLocalVarDecls, testNestedBlocks, - testBlockWithEmptyStatement + testBlockWithEmptyStatement, + testExpressionIntLiteral, + testFieldWithInitialization ] \ No newline at end of file diff --git a/src/Parser/JavaParser.y b/src/Parser/JavaParser.y index d2cf382..9dd31c6 100644 --- a/src/Parser/JavaParser.y +++ b/src/Parser/JavaParser.y @@ -1,11 +1,12 @@ { -module Parser.JavaParser (parse, parseBlock) where +module Parser.JavaParser (parse, parseBlock, parseExpression) where import Ast import Parser.Lexer } %name parse %name parseBlock block +%name parseExpression expression %tokentype { Token } %error { parseError } %errorhandlertype explist @@ -182,7 +183,7 @@ referencetype : classorinterfacetype { $1 } variabledeclarator : variabledeclaratorid { Declarator $1 Nothing } - -- | variabledeclaratorid ASSIGN variableinitializer { Declarator $1 Nothing } -- TODO + | variabledeclaratorid ASSIGN variableinitializer { Declarator $1 (Just $3) } blockstatement : localvariabledeclarationstatement { $1 } | statement { $1 } @@ -196,7 +197,7 @@ numerictype : integraltype { $1 } variabledeclaratorid : IDENTIFIER { $1 } -variableinitializer : expression { } +variableinitializer : expression { $1 } localvariabledeclarationstatement : localvariabledeclaration SEMICOLON { $1 } @@ -206,7 +207,7 @@ statement : statementwithouttrailingsubstatement{ $1 } -- | whilestatement { } -expression : assignmentexpression { } +expression : assignmentexpression { $1 } integraltype : INT { "int" } | CHAR { "char" } @@ -224,8 +225,8 @@ ifthenelsestatement : IF LBRACE expression RBRACE statementnoshortif ELSE state whilestatement : WHILE LBRACE expression RBRACE statement { } -assignmentexpression : conditionalexpression { } - | assignment{ } +assignmentexpression : conditionalexpression { $1 } + -- | assignment { } emptystatement : SEMICOLON { Block [] } @@ -238,10 +239,10 @@ statementnoshortif : statementwithouttrailingsubstatement { } | ifthenelsestatementnoshortif { } | whilestatementnoshortif { } -conditionalexpression : conditionalorexpression { } - | conditionalorexpression QUESMARK expression COLON conditionalexpression { } +conditionalexpression : conditionalorexpression { $1 } + -- | conditionalorexpression QUESMARK expression COLON conditionalexpression { } -assignment :lefthandside assignmentoperator assignmentexpression { } +assignment : lefthandside assignmentoperator assignmentexpression { } statementexpression : assignment { } @@ -257,23 +258,23 @@ ifthenelsestatementnoshortif :IF LBRACE expression RBRACE statementnoshortif whilestatementnoshortif : WHILE LBRACE expression RBRACE statementnoshortif { } -conditionalorexpression : conditionalandexpression { } - | conditionalorexpression LOGICALOR conditionalandexpression{ } +conditionalorexpression : conditionalandexpression { $1 } + -- | conditionalorexpression LOGICALOR conditionalandexpression{ } -lefthandside : name { } +lefthandside : name { $1 } assignmentoperator : ASSIGN{ } - | TIMESEQUAL { } - | DIVIDEEQUAL { } - | MODULOEQUAL { } - | PLUSEQUAL { } - | MINUSEQUAL { } - | SHIFTLEFTEQUAL { } - | SIGNEDSHIFTRIGHTEQUAL { } - | UNSIGNEDSHIFTRIGHTEQUAL { } - | ANDEQUAL { } - | XOREQUAL { } - | OREQUAL{ } + -- | TIMESEQUAL { } + -- | DIVIDEEQUAL { } + -- | MODULOEQUAL { } + -- | PLUSEQUAL { } + -- | MINUSEQUAL { } + -- | SHIFTLEFTEQUAL { } + -- | SIGNEDSHIFTRIGHTEQUAL { } + -- | UNSIGNEDSHIFTRIGHTEQUAL { } + -- | ANDEQUAL { } + -- | XOREQUAL { } + -- | OREQUAL{ } preincrementexpression : INCREMENT unaryexpression { } @@ -291,73 +292,73 @@ methodinvocation : name LBRACE RBRACE { } classinstancecreationexpression : NEW classtype LBRACE RBRACE { } | NEW classtype LBRACE argumentlist RBRACE { } -conditionalandexpression : inclusiveorexpression { } +conditionalandexpression : inclusiveorexpression { $1 } fieldaccess : primary DOT IDENTIFIER { } -unaryexpression : preincrementexpression { } - | predecrementexpression { } - | PLUS unaryexpression { } - | MINUS unaryexpression { } - | unaryexpressionnotplusminus { } +unaryexpression : unaryexpressionnotplusminus { $1 } + -- | predecrementexpression { } + -- | PLUS unaryexpression { } + -- | MINUS unaryexpression { } + -- | preincrementexpression { $1 } -postfixexpression : primary { } - | name { } - | postincrementexpression { } - | postdecrementexpression{ } +postfixexpression : primary { $1 } + -- | name { } + -- | postincrementexpression { } + -- | postdecrementexpression{ } -primary : primarynonewarray { } +primary : primarynonewarray { $1 } -inclusiveorexpression : exclusiveorexpression { } - | inclusiveorexpression OR exclusiveorexpression { } +inclusiveorexpression : exclusiveorexpression { $1 } + -- | inclusiveorexpression OR exclusiveorexpression { } -primarynonewarray : literal { } - | THIS { } - | LBRACE expression RBRACE { } - | classinstancecreationexpression { } - | fieldaccess { } - | methodinvocation { } +primarynonewarray : literal { $1 } + -- | THIS { } + -- | LBRACE expression RBRACE { } + -- | classinstancecreationexpression { } + -- | fieldaccess { } + -- | methodinvocation { } -unaryexpressionnotplusminus : postfixexpression { } - | TILDE unaryexpression { } - | EXCLMARK unaryexpression { } - | castexpression{ } +unaryexpressionnotplusminus : postfixexpression { $1 } + -- | TILDE unaryexpression { } + -- | EXCLMARK unaryexpression { } + -- | castexpression{ } -exclusiveorexpression : andexpression { } - | exclusiveorexpression XOR andexpression { } +exclusiveorexpression : andexpression { $1 } + -- | exclusiveorexpression XOR andexpression { } -literal : INTLITERAL { } - | BOOLLITERAL { } - | CHARLITERAL { } - | JNULL { } +literal : INTLITERAL { IntegerLiteral $1 } + -- | BOOLLITERAL { } + -- | CHARLITERAL { } + -- | JNULL { } castexpression : LBRACE primitivetype RBRACE unaryexpression { } | LBRACE expression RBRACE unaryexpressionnotplusminus{ } -andexpression : equalityexpression { } - | andexpression AND equalityexpression { } +andexpression : equalityexpression { $1 } + -- | andexpression AND equalityexpression { } -equalityexpression : relationalexpression { } +equalityexpression : relationalexpression { $1 } -- | equalityexpression EQUAL relationalexpression { } -- | equalityexpression NOTEQUAL relationalexpression { } -relationalexpression : shiftexpression { } - | relationalexpression LESS shiftexpression { } - | relationalexpression GREATER shiftexpression { } - | relationalexpression LESSEQUAL shiftexpression { } - | relationalexpression GREATEREQUAL shiftexpression { } - | relationalexpression INSTANCEOF referencetype { } +relationalexpression : shiftexpression { $1 } + -- | relationalexpression LESS shiftexpression { } + -- | relationalexpression GREATER shiftexpression { } + -- | relationalexpression LESSEQUAL shiftexpression { } + -- | relationalexpression GREATEREQUAL shiftexpression { } + -- | relationalexpression INSTANCEOF referencetype { } -shiftexpression : additiveexpression { } +shiftexpression : additiveexpression { $1 } -additiveexpression : multiplicativeexpression { } - | additiveexpression PLUS multiplicativeexpression { } - | additiveexpression MINUS multiplicativeexpression { } +additiveexpression : multiplicativeexpression { $1 } + -- | additiveexpression PLUS multiplicativeexpression { } + -- | additiveexpression MINUS multiplicativeexpression { } -multiplicativeexpression : unaryexpression { } - | multiplicativeexpression MUL unaryexpression { } - | multiplicativeexpression DIV unaryexpression { } - | multiplicativeexpression MOD unaryexpression { } +multiplicativeexpression : unaryexpression { $1 } + -- | multiplicativeexpression MUL unaryexpression { } + -- | multiplicativeexpression DIV unaryexpression { } + -- | multiplicativeexpression MOD unaryexpression { } { From c49b7f556c055432dc18236311c3b0cc65a09e7a Mon Sep 17 00:00:00 2001 From: Marvin Schlegel Date: Wed, 8 May 2024 13:29:10 +0200 Subject: [PATCH 14/98] parser implement varibale initialization --- Test/TestParser.hs | 10 +++++++++- src/Parser/JavaParser.y | 6 +++--- 2 files changed, 12 insertions(+), 4 deletions(-) diff --git a/Test/TestParser.hs b/Test/TestParser.hs index 7a79ba8..4a18581 100644 --- a/Test/TestParser.hs +++ b/Test/TestParser.hs @@ -74,6 +74,12 @@ testExpressionIntLiteral = TestCase $ testFieldWithInitialization = TestCase $ assertEqual "expect Class with initialized field" [Class "WithInitField" [] [VariableDeclaration "int" "number" $ Just $ IntegerLiteral 3]] $ parse [CLASS,IDENTIFIER "WithInitField",LBRACKET,INT,IDENTIFIER "number",ASSIGN,INTEGERLITERAL 3,SEMICOLON,RBRACKET] +testLocalBoolWithInitialization = TestCase $ + assertEqual "expect block with with initialized local var" (Block [LocalVariableDeclaration $ VariableDeclaration "boolean" "b" $ Just $ BooleanLiteral False]) $ + parseBlock [LBRACKET,BOOLEAN,IDENTIFIER "b",ASSIGN,BOOLLITERAL False,SEMICOLON,RBRACKET] +testFieldNullWithInitialization = TestCase $ + assertEqual "expect Class with initialized field" [Class "WithInitField" [] [VariableDeclaration "Object" "bar" $ Just NullLiteral]] $ + parse [CLASS,IDENTIFIER "WithInitField",LBRACKET,IDENTIFIER "Object",IDENTIFIER "bar",ASSIGN,NULLLITERAL,SEMICOLON,RBRACKET] tests = TestList [ testSingleEmptyClass, @@ -96,5 +102,7 @@ tests = TestList [ testNestedBlocks, testBlockWithEmptyStatement, testExpressionIntLiteral, - testFieldWithInitialization + testFieldWithInitialization, + testLocalBoolWithInitialization, + testFieldNullWithInitialization ] \ No newline at end of file diff --git a/src/Parser/JavaParser.y b/src/Parser/JavaParser.y index 9dd31c6..b0a8173 100644 --- a/src/Parser/JavaParser.y +++ b/src/Parser/JavaParser.y @@ -328,9 +328,9 @@ exclusiveorexpression : andexpression { $1 } -- | exclusiveorexpression XOR andexpression { } literal : INTLITERAL { IntegerLiteral $1 } - -- | BOOLLITERAL { } - -- | CHARLITERAL { } - -- | JNULL { } + | BOOLLITERAL { BooleanLiteral $1 } + | CHARLITERAL { CharacterLiteral $1 } + | JNULL { NullLiteral } castexpression : LBRACE primitivetype RBRACE unaryexpression { } | LBRACE expression RBRACE unaryexpressionnotplusminus{ } From d54c7cd7e67d4111b40661906571225126d007d4 Mon Sep 17 00:00:00 2001 From: mrab Date: Wed, 8 May 2024 15:23:18 +0200 Subject: [PATCH 15/98] Working pipeline for whole compiler --- Test/TestByteCodeGenerator.hs | 4 +- src/ByteCode/ClassFile.hs | 2 +- src/ByteCode/ClassFile/Generator.hs | 72 +++++++++++++++++++++++++---- src/Main.hs | 13 +++++- 4 files changed, 79 insertions(+), 12 deletions(-) diff --git a/Test/TestByteCodeGenerator.hs b/Test/TestByteCodeGenerator.hs index 3e44349..2c6f4d2 100644 --- a/Test/TestByteCodeGenerator.hs +++ b/Test/TestByteCodeGenerator.hs @@ -107,10 +107,12 @@ testBasicConstantPool = TestCase $ assertEqual "basic constant pool" expectedCla testFields = TestCase $ assertEqual "fields in constant pool" expectedClassWithFields $ classBuilder classWithFields emptyClassFile testMethodDescriptor = TestCase $ assertEqual "method descriptor" "(II)I" (methodDescriptor method) testMethodAssembly = TestCase $ assertEqual "method assembly" expectedClassWithMethod (classBuilder classWithMethod emptyClassFile) +testFindMethodIndex = TestCase $ assertEqual "find method" (Just 0) (findMethodIndex expectedClassWithMethod "add_two_numbers") tests = TestList [ TestLabel "Basic constant pool" testBasicConstantPool, TestLabel "Fields constant pool" testFields, TestLabel "Method descriptor building" testMethodDescriptor, - TestLabel "Method assembly" testMethodAssembly + TestLabel "Method assembly" testMethodAssembly, + TestLabel "Find method by name" testFindMethodIndex ] \ No newline at end of file diff --git a/src/ByteCode/ClassFile.hs b/src/ByteCode/ClassFile.hs index a7b0779..bdae918 100644 --- a/src/ByteCode/ClassFile.hs +++ b/src/ByteCode/ClassFile.hs @@ -151,7 +151,7 @@ instance Serializable Attribute where ++ unpackWord16 0 -- attributes_count instance Serializable ClassFile where - serialize classfile = unpackWord32 0xC0FEBABE -- magic + serialize classfile = unpackWord32 0xCAFEBABE -- magic ++ unpackWord16 0 -- minor version ++ unpackWord16 49 -- major version ++ unpackWord16 (fromIntegral (1 + length (constantPool classfile))) -- constant pool count diff --git a/src/ByteCode/ClassFile/Generator.hs b/src/ByteCode/ClassFile/Generator.hs index 3bdd0ec..a80c081 100644 --- a/src/ByteCode/ClassFile/Generator.hs +++ b/src/ByteCode/ClassFile/Generator.hs @@ -3,12 +3,17 @@ module ByteCode.ClassFile.Generator( datatypeDescriptor, methodParameterDescriptor, methodDescriptor, + memberInfoIsMethod, + memberInfoName, + memberInfoDescriptor, + findMethodIndex ) where import ByteCode.Constants import ByteCode.ClassFile (ClassFile (..), ConstantInfo (..), MemberInfo(..), Operation(..), Attribute(..)) import Ast import Data.Char +import Data.List type ClassFileBuilder a = a -> ClassFile -> ClassFile @@ -28,6 +33,39 @@ methodParameterDescriptor "char" = "C" methodParameterDescriptor "boolean" = "B" methodParameterDescriptor x = "L" ++ x ++ ";" +memberInfoIsMethod :: [ConstantInfo] -> MemberInfo -> Bool +memberInfoIsMethod constants info = elem '(' (memberInfoDescriptor constants info) + +findMethodIndex :: ClassFile -> String -> Maybe Int +findMethodIndex classFile name = let + constants = constantPool classFile + in + findIndex (\method -> ((memberInfoIsMethod constants method) && (memberInfoName constants method) == name)) (methods classFile) + +memberInfoDescriptor :: [ConstantInfo] -> MemberInfo -> String +memberInfoDescriptor constants MemberInfo { + memberAccessFlags = _, + memberNameIndex = _, + memberDescriptorIndex = descriptorIndex, + memberAttributes = _ } = let + descriptor = constants!!((fromIntegral descriptorIndex) - 1) + in case descriptor of + Utf8Info descriptorText -> descriptorText + _ -> ("Invalid Item at Constant pool index " ++ show descriptorIndex) + + +memberInfoName :: [ConstantInfo] -> MemberInfo -> String +memberInfoName constants MemberInfo { + memberAccessFlags = _, + memberNameIndex = nameIndex, + memberDescriptorIndex = _, + memberAttributes = _ } = let + name = constants!!((fromIntegral nameIndex) - 1) + in case name of + Utf8Info nameText -> nameText + _ -> ("Invalid Item at Constant pool index " ++ show nameIndex) + + methodDescriptor :: MethodDeclaration -> String methodDescriptor (MethodDeclaration returntype _ parameters _) = let parameter_types = [datatype | ParameterDeclaration datatype _ <- parameters] @@ -37,6 +75,7 @@ methodDescriptor (MethodDeclaration returntype _ parameters _) = let ++ ")" ++ datatypeDescriptor returntype + classBuilder :: ClassFileBuilder Class classBuilder (Class name methods fields) _ = let baseConstants = [ @@ -58,8 +97,12 @@ classBuilder (Class name methods fields) _ = let methods = [], attributes = [] } + + classFileWithFields = foldr fieldBuilder nakedClassFile fields + classFileWithMethods = foldr methodBuilder classFileWithFields methods + classFileWithAssembledMethods = foldr methodAssembler classFileWithMethods methods in - foldr methodBuilder (foldr fieldBuilder nakedClassFile fields) methods + classFileWithAssembledMethods @@ -88,30 +131,43 @@ methodBuilder :: ClassFileBuilder MethodDeclaration methodBuilder (MethodDeclaration returntype name parameters statement) input = let baseIndex = 1 + length (constantPool input) constants = [ - FieldRefInfo (fromIntegral (thisClass input)) (fromIntegral (baseIndex + 1)), - NameAndTypeInfo (fromIntegral (baseIndex + 2)) (fromIntegral (baseIndex + 3)), Utf8Info name, Utf8Info (methodDescriptor (MethodDeclaration returntype name parameters (Block []))) ] - --code = assembleByteCode statement + method = MemberInfo { memberAccessFlags = accessPublic, - memberNameIndex = (fromIntegral (baseIndex + 2)), - memberDescriptorIndex = (fromIntegral (baseIndex + 3)), + memberNameIndex = (fromIntegral baseIndex), + memberDescriptorIndex = (fromIntegral (baseIndex + 1)), memberAttributes = [ CodeAttribute { attributeMaxStack = 420, attributeMaxLocals = 420, - attributeCode = [Opiadd] + attributeCode = [Opreturn] } ] } in input { constantPool = (constantPool input) ++ constants, - methods = (fields input) ++ [method] + methods = (methods input) ++ [method] } + +methodAssembler :: ClassFileBuilder MethodDeclaration +methodAssembler (MethodDeclaration returntype name parameters statement) input = let + code = CodeAttribute { + attributeMaxStack = 420, + attributeMaxLocals = 420, + attributeCode = [Opiadd] + } + --methodConstantIndex = + in + input + + + + type Assembler a = a -> ([ConstantInfo], [Operation]) -> ([ConstantInfo], [Operation]) returnOperation :: DataType -> Operation diff --git a/src/Main.hs b/src/Main.hs index 5ee22ff..5ad66c4 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -2,7 +2,16 @@ module Main where import Example import Typecheck +import Parser.Lexer (alexScanTokens) +import Parser.JavaParser +import ByteCode.ClassFile.Generator +import ByteCode.ClassFile +import Data.ByteString (pack, writeFile) main = do - Example.runTypeCheck - + let untypedAST = parse $ alexScanTokens "class Testklasse {int a; int b; void something(){} void something_else(){} Testklasse(){}}" + let typedAST = head (typeCheckCompilationUnit untypedAST) + let abstractClassFile = classBuilder typedAST emptyClassFile + let assembledClassFile = pack (serialize abstractClassFile) + + Data.ByteString.writeFile "Testklasse.class" assembledClassFile From decc909c23e9b2bbc44a2be7e00695cd20f768e3 Mon Sep 17 00:00:00 2001 From: Marvin Schlegel Date: Mon, 6 May 2024 10:16:57 +0200 Subject: [PATCH 16/98] parser add custom type fields --- Test/TestParser.hs | 7 ++++++- src/Parser/JavaParser.y | 12 ++++++------ 2 files changed, 12 insertions(+), 7 deletions(-) diff --git a/Test/TestParser.hs b/Test/TestParser.hs index ce3f2cc..3fd30f0 100644 --- a/Test/TestParser.hs +++ b/Test/TestParser.hs @@ -18,11 +18,16 @@ testBooleanField = TestCase $ testIntField = TestCase $ assertEqual "expect class with int field" [Class "WithInt" [] [VariableDeclaration "int" "value" Nothing]] $ parse [CLASS,IDENTIFIER "WithInt",LBRACKET,INT,IDENTIFIER "value",SEMICOLON,RBRACKET] +testCustomTypeField = TestCase $ + assertEqual "expect class with foo field" [Class "WithFoo" [] [VariableDeclaration "Foo" "value" Nothing]] $ + parse [CLASS,IDENTIFIER "WithFoo",LBRACKET,IDENTIFIER "Foo",IDENTIFIER "value",SEMICOLON,RBRACKET] + tests = TestList [ testSingleEmptyClass, testTwoEmptyClasses, testBooleanField, - testIntField + testIntField, + testCustomTypeField ] \ No newline at end of file diff --git a/src/Parser/JavaParser.y b/src/Parser/JavaParser.y index bfe74b2..bcfec2f 100644 --- a/src/Parser/JavaParser.y +++ b/src/Parser/JavaParser.y @@ -80,14 +80,14 @@ compilationunit : typedeclarations { $1 } typedeclarations : typedeclaration { [$1] } | typedeclarations typedeclaration { $1 ++ [$2] } -name : qualifiedname { } - | simplename { } +name : simplename { $1 } + -- | qualifiedname { } typedeclaration : classdeclaration { $1 } qualifiedname : name DOT IDENTIFIER { } -simplename : IDENTIFIER { } +simplename : IDENTIFIER { $1 } classdeclaration : CLASS IDENTIFIER classbody { case $3 of (methods, fields) -> Class $2 methods fields } -- | modifiers CLASS IDENTIFIER classbody { case $4 of (methods, fields) -> Class $3 methods fields } @@ -120,7 +120,7 @@ classtype : classorinterfacetype{ } classbodydeclaration : classmemberdeclaration { $1 } -- | constructordeclaration { FieldDecl $ VariableDeclaration "int" "a" Nothing } -- TODO -classorinterfacetype : name{ } +classorinterfacetype : name { $1 } classmemberdeclaration : fielddeclaration { $1 } -- | methoddeclaration { } @@ -150,7 +150,7 @@ methodheader : type methoddeclarator { } | modifiers VOID methoddeclarator { } type : primitivetype { $1 } - -- | referencetype { } + | referencetype { $1 } variabledeclarators : variabledeclarator { [$1] } -- | variabledeclarators COMMA variabledeclarator { $1 ++ [$3] } @@ -176,7 +176,7 @@ methoddeclarator : IDENTIFIER LBRACE RBRACE { } primitivetype : BOOLEAN { "boolean" } | numerictype { $1 } -referencetype : classorinterfacetype { } +referencetype : classorinterfacetype { $1 } variabledeclarator : variabledeclaratorid { Declarator $1 Nothing } From 301b87c9ac878827823b46543f5b6602fba24e8a Mon Sep 17 00:00:00 2001 From: Marvin Schlegel Date: Mon, 6 May 2024 10:33:37 +0200 Subject: [PATCH 17/98] parser implement multiple declarations --- Test/TestParser.hs | 10 ++++++++-- src/Parser/JavaParser.y | 12 ++++++------ 2 files changed, 14 insertions(+), 8 deletions(-) diff --git a/Test/TestParser.hs b/Test/TestParser.hs index 3fd30f0..35f25ab 100644 --- a/Test/TestParser.hs +++ b/Test/TestParser.hs @@ -21,7 +21,12 @@ testIntField = TestCase $ testCustomTypeField = TestCase $ assertEqual "expect class with foo field" [Class "WithFoo" [] [VariableDeclaration "Foo" "value" Nothing]] $ parse [CLASS,IDENTIFIER "WithFoo",LBRACKET,IDENTIFIER "Foo",IDENTIFIER "value",SEMICOLON,RBRACKET] - +testMultipleDeclarationSameLine = TestCase $ + assertEqual "expect class with two int fields" [Class "TwoInts" [] [VariableDeclaration "int" "num1" Nothing, VariableDeclaration "int" "num2" Nothing]] $ + parse [CLASS,IDENTIFIER "TwoInts",LBRACKET,INT,IDENTIFIER "num1",COMMA,IDENTIFIER "num2",SEMICOLON,RBRACKET] +testMultipleDeclarations = TestCase $ + assertEqual "expect class with int and char field" [Class "Multiple" [] [VariableDeclaration "int" "value" Nothing, VariableDeclaration "char" "letter" Nothing]] $ + parse [CLASS,IDENTIFIER "Multiple",LBRACKET,INT,IDENTIFIER "value",SEMICOLON,CHAR,IDENTIFIER "letter",SEMICOLON,RBRACKET] tests = TestList [ @@ -29,5 +34,6 @@ tests = TestList [ testTwoEmptyClasses, testBooleanField, testIntField, - testCustomTypeField + testCustomTypeField, + testMultipleDeclarations ] \ No newline at end of file diff --git a/src/Parser/JavaParser.y b/src/Parser/JavaParser.y index bcfec2f..69fe9f2 100644 --- a/src/Parser/JavaParser.y +++ b/src/Parser/JavaParser.y @@ -103,11 +103,11 @@ classbodydeclarations : classbodydeclaration { MethodDecl method -> ([method], []) FieldDecls fields -> ([], fields) } - -- | classbodydeclarations classbodydeclaration { - -- case ($1, $2) of - -- ((methods, fields), MethodDecl method) -> ((methods ++ [method]), fields) - -- ((methods, fields), FieldDecl field) -> (methods, (fields ++ [field])) - -- } + | classbodydeclarations classbodydeclaration { + case ($1, $2) of + ((methods, fields), MethodDecl method) -> ((methods ++ [method]), fields) + ((methods, fields), FieldDecls newFields) -> (methods, (fields ++ newFields)) + } modifier : PUBLIC { } | PROTECTED { } @@ -153,7 +153,7 @@ type : primitivetype { $1 } | referencetype { $1 } variabledeclarators : variabledeclarator { [$1] } - -- | variabledeclarators COMMA variabledeclarator { $1 ++ [$3] } + | variabledeclarators COMMA variabledeclarator { $1 ++ [$3] } methodbody : block { } | SEMICOLON { } From 5e90f0d0eefad7f0363acfec496d9261769c7478 Mon Sep 17 00:00:00 2001 From: Marvin Schlegel Date: Mon, 6 May 2024 10:09:50 +0200 Subject: [PATCH 18/98] parser add modifier --- Test/TestParser.hs | 6 +++++- src/Parser/JavaParser.y | 7 ++----- 2 files changed, 7 insertions(+), 6 deletions(-) diff --git a/Test/TestParser.hs b/Test/TestParser.hs index 35f25ab..b979794 100644 --- a/Test/TestParser.hs +++ b/Test/TestParser.hs @@ -27,6 +27,9 @@ testMultipleDeclarationSameLine = TestCase $ testMultipleDeclarations = TestCase $ assertEqual "expect class with int and char field" [Class "Multiple" [] [VariableDeclaration "int" "value" Nothing, VariableDeclaration "char" "letter" Nothing]] $ parse [CLASS,IDENTIFIER "Multiple",LBRACKET,INT,IDENTIFIER "value",SEMICOLON,CHAR,IDENTIFIER "letter",SEMICOLON,RBRACKET] +testWithModifier = TestCase $ + assertEqual "expect class with int field" [Class "WithInt" [] [VariableDeclaration "int" "value" Nothing]] $ + parse [ABSTRACT,CLASS,IDENTIFIER "WithInt",LBRACKET,PUBLIC,INT,IDENTIFIER "value",SEMICOLON,RBRACKET] tests = TestList [ @@ -35,5 +38,6 @@ tests = TestList [ testBooleanField, testIntField, testCustomTypeField, - testMultipleDeclarations + testMultipleDeclarations, + testWithModifier ] \ No newline at end of file diff --git a/src/Parser/JavaParser.y b/src/Parser/JavaParser.y index 69fe9f2..8d772eb 100644 --- a/src/Parser/JavaParser.y +++ b/src/Parser/JavaParser.y @@ -90,7 +90,7 @@ qualifiedname : name DOT IDENTIFIER { } simplename : IDENTIFIER { $1 } classdeclaration : CLASS IDENTIFIER classbody { case $3 of (methods, fields) -> Class $2 methods fields } - -- | modifiers CLASS IDENTIFIER classbody { case $4 of (methods, fields) -> Class $3 methods fields } + | modifiers CLASS IDENTIFIER classbody { case $4 of (methods, fields) -> Class $3 methods fields } classbody : LBRACKET RBRACKET { ([], []) } | LBRACKET classbodydeclarations RBRACKET { $2 } @@ -129,7 +129,7 @@ constructordeclaration : constructordeclarator constructorbody { } | modifiers constructordeclarator constructorbody { } fielddeclaration : type variabledeclarators SEMICOLON { FieldDecls $ map (convertDeclarator $1) $2 } - -- | modifiers type variabledeclarators SEMICOLON {} + | modifiers type variabledeclarators SEMICOLON { FieldDecls $ map (convertDeclarator $2) $3 } methoddeclaration : methodheader methodbody { } @@ -365,9 +365,6 @@ data MethodOrFieldDeclaration = MethodDecl MethodDeclaration data Declarator = Declarator Identifier (Maybe Expression) --- convertDeclaratorList :: [DataType] -> MethodOrFieldDeclaration --- convertDeclaratorList = FieldDecls $ map - convertDeclarator :: DataType -> Declarator -> VariableDeclaration convertDeclarator dataType (Declarator id assigment) = VariableDeclaration dataType id assigment From f57f360abf77835d64f2540dc6fb1ef750d405ac Mon Sep 17 00:00:00 2001 From: Marvin Schlegel Date: Mon, 6 May 2024 23:34:03 +0200 Subject: [PATCH 19/98] parser add empty methods --- Test/TestParser.hs | 6 +++++- src/Parser/JavaParser.y | 24 ++++++++++++------------ 2 files changed, 17 insertions(+), 13 deletions(-) diff --git a/Test/TestParser.hs b/Test/TestParser.hs index b979794..4e0694b 100644 --- a/Test/TestParser.hs +++ b/Test/TestParser.hs @@ -30,6 +30,9 @@ testMultipleDeclarations = TestCase $ testWithModifier = TestCase $ assertEqual "expect class with int field" [Class "WithInt" [] [VariableDeclaration "int" "value" Nothing]] $ parse [ABSTRACT,CLASS,IDENTIFIER "WithInt",LBRACKET,PUBLIC,INT,IDENTIFIER "value",SEMICOLON,RBRACKET] +testMethod = TestCase $ + assertEqual "expect class with method" [Class "WithMethod" [MethodDeclaration "int" "foo" [] (Block [])] []] $ + parse [CLASS,IDENTIFIER "WithMethod",LBRACKET,INT,IDENTIFIER "foo",LBRACE,RBRACE,SEMICOLON,RBRACKET] tests = TestList [ @@ -39,5 +42,6 @@ tests = TestList [ testIntField, testCustomTypeField, testMultipleDeclarations, - testWithModifier + testWithModifier, + testMethod ] \ No newline at end of file diff --git a/src/Parser/JavaParser.y b/src/Parser/JavaParser.y index 8d772eb..d48b7e2 100644 --- a/src/Parser/JavaParser.y +++ b/src/Parser/JavaParser.y @@ -123,7 +123,7 @@ classbodydeclaration : classmemberdeclaration { $1 } classorinterfacetype : name { $1 } classmemberdeclaration : fielddeclaration { $1 } - -- | methoddeclaration { } + | methoddeclaration { $1 } constructordeclaration : constructordeclarator constructorbody { } | modifiers constructordeclarator constructorbody { } @@ -131,10 +131,10 @@ constructordeclaration : constructordeclarator constructorbody { } fielddeclaration : type variabledeclarators SEMICOLON { FieldDecls $ map (convertDeclarator $1) $2 } | modifiers type variabledeclarators SEMICOLON { FieldDecls $ map (convertDeclarator $2) $3 } -methoddeclaration : methodheader methodbody { } +methoddeclaration : methodheader methodbody { case $1 of (returnType, (name, parameters)) -> MethodDecl (MethodDeclaration returnType name parameters $2) } -block : LBRACKET RBRACKET { } - | LBRACKET blockstatements RBRACKET { } +block : LBRACKET RBRACKET { Block [] } + -- | LBRACKET blockstatements RBRACKET { } constructordeclarator : simplename LBRACE RBRACE { } | simplename LBRACE formalparameterlist RBRACE { } @@ -144,10 +144,10 @@ constructorbody : LBRACKET RBRACKET { } | LBRACKET blockstatements RBRACKET { } | LBRACKET explicitconstructorinvocation blockstatements RBRACKET { } -methodheader : type methoddeclarator { } - | modifiers type methoddeclarator { } - | VOID methoddeclarator { } - | modifiers VOID methoddeclarator { } +methodheader : type methoddeclarator { ($1, $2) } + -- | modifiers type methoddeclarator { } + -- | VOID methoddeclarator { } + -- | modifiers VOID methoddeclarator { } type : primitivetype { $1 } | referencetype { $1 } @@ -155,8 +155,8 @@ type : primitivetype { $1 } variabledeclarators : variabledeclarator { [$1] } | variabledeclarators COMMA variabledeclarator { $1 ++ [$3] } -methodbody : block { } - | SEMICOLON { } +methodbody : block { $1 } + | SEMICOLON { Block [] } blockstatements : blockstatement { } | blockstatements blockstatement { } @@ -170,8 +170,8 @@ explicitconstructorinvocation : THIS LBRACE RBRACE SEMICOLON { } classtypelist : classtype { } | classtypelist COMMA classtype { } -methoddeclarator : IDENTIFIER LBRACE RBRACE { } - | IDENTIFIER LBRACE formalparameterlist RBRACE { } +methoddeclarator : IDENTIFIER LBRACE RBRACE { ($1, []) } + -- | IDENTIFIER LBRACE formalparameterlist RBRACE { } primitivetype : BOOLEAN { "boolean" } | numerictype { $1 } From 3130f7f7d462b3db3c8b8c9cadc8f3a8aecab802 Mon Sep 17 00:00:00 2001 From: Marvin Schlegel Date: Mon, 6 May 2024 23:51:33 +0200 Subject: [PATCH 20/98] add void methods --- Test/TestParser.hs | 13 +++++++++++-- src/Parser/JavaParser.y | 8 ++++---- 2 files changed, 15 insertions(+), 6 deletions(-) diff --git a/Test/TestParser.hs b/Test/TestParser.hs index 4e0694b..85b899b 100644 --- a/Test/TestParser.hs +++ b/Test/TestParser.hs @@ -30,9 +30,16 @@ testMultipleDeclarations = TestCase $ testWithModifier = TestCase $ assertEqual "expect class with int field" [Class "WithInt" [] [VariableDeclaration "int" "value" Nothing]] $ parse [ABSTRACT,CLASS,IDENTIFIER "WithInt",LBRACKET,PUBLIC,INT,IDENTIFIER "value",SEMICOLON,RBRACKET] -testMethod = TestCase $ + +testEmptyMethod = TestCase $ assertEqual "expect class with method" [Class "WithMethod" [MethodDeclaration "int" "foo" [] (Block [])] []] $ parse [CLASS,IDENTIFIER "WithMethod",LBRACKET,INT,IDENTIFIER "foo",LBRACE,RBRACE,SEMICOLON,RBRACKET] +testEmptyPrivateMethod = TestCase $ + assertEqual "expect class with method" [Class "WithMethod" [MethodDeclaration "int" "foo" [] (Block [])] []] $ + parse [CLASS,IDENTIFIER "WithMethod",LBRACKET,PRIVATE,INT,IDENTIFIER "foo",LBRACE,RBRACE,LBRACKET,RBRACKET,RBRACKET] +testEmptyVoidMethod = TestCase $ + assertEqual "expect class with method" [Class "WithMethod" [MethodDeclaration "void" "foo" [] (Block [])] []] $ + parse [CLASS,IDENTIFIER "WithMethod",LBRACKET,VOID,IDENTIFIER "foo",LBRACE,RBRACE,LBRACKET,RBRACKET,RBRACKET] tests = TestList [ @@ -43,5 +50,7 @@ tests = TestList [ testCustomTypeField, testMultipleDeclarations, testWithModifier, - testMethod + testEmptyMethod, + testEmptyPrivateMethod, + testEmptyVoidMethod ] \ No newline at end of file diff --git a/src/Parser/JavaParser.y b/src/Parser/JavaParser.y index d48b7e2..ec3788c 100644 --- a/src/Parser/JavaParser.y +++ b/src/Parser/JavaParser.y @@ -144,10 +144,10 @@ constructorbody : LBRACKET RBRACKET { } | LBRACKET blockstatements RBRACKET { } | LBRACKET explicitconstructorinvocation blockstatements RBRACKET { } -methodheader : type methoddeclarator { ($1, $2) } - -- | modifiers type methoddeclarator { } - -- | VOID methoddeclarator { } - -- | modifiers VOID methoddeclarator { } +methodheader : type methoddeclarator { ($1, $2) } + | modifiers type methoddeclarator { ($2, $3) } + | VOID methoddeclarator { ("void", $2) } + | modifiers VOID methoddeclarator { ("void", $3)} type : primitivetype { $1 } | referencetype { $1 } From f183b8b1833eb84b1283ca336cd9c6331636a3f1 Mon Sep 17 00:00:00 2001 From: Marvin Schlegel Date: Tue, 7 May 2024 15:03:04 +0200 Subject: [PATCH 21/98] parser implement methods with params --- Test/TestParser.hs | 14 +++++++++++++- src/Parser/JavaParser.y | 8 ++++---- 2 files changed, 17 insertions(+), 5 deletions(-) diff --git a/Test/TestParser.hs b/Test/TestParser.hs index 85b899b..8e1aaa7 100644 --- a/Test/TestParser.hs +++ b/Test/TestParser.hs @@ -40,6 +40,15 @@ testEmptyPrivateMethod = TestCase $ testEmptyVoidMethod = TestCase $ assertEqual "expect class with method" [Class "WithMethod" [MethodDeclaration "void" "foo" [] (Block [])] []] $ parse [CLASS,IDENTIFIER "WithMethod",LBRACKET,VOID,IDENTIFIER "foo",LBRACE,RBRACE,LBRACKET,RBRACKET,RBRACKET] +testEmptyMethodWithParam = TestCase $ + assertEqual "expect class with method with param" [Class "WithParam" [MethodDeclaration "void" "foo" [ParameterDeclaration "int" "param"] (Block [])] []] $ + parse [CLASS,IDENTIFIER "WithParam",LBRACKET,VOID,IDENTIFIER "foo",LBRACE,INT,IDENTIFIER "param",RBRACE,SEMICOLON,RBRACKET] +testEmptyMethodWithParams = TestCase $ + assertEqual "expect class with multiple params" [Class "WithParams" [MethodDeclaration "void" "foo" [ParameterDeclaration "int" "p1",ParameterDeclaration "Custom" "p2"] (Block [])] []] $ + parse [CLASS,IDENTIFIER "WithParams",LBRACKET,VOID,IDENTIFIER "foo",LBRACE,INT,IDENTIFIER "p1",COMMA,IDENTIFIER "Custom",IDENTIFIER "p2",RBRACE,SEMICOLON,RBRACKET] +testClassWithMethodAndField = TestCase $ + assertEqual "expect class with method and field" [Class "WithMethodAndField" [MethodDeclaration "void" "foo" [] (Block []), MethodDeclaration "int" "bar" [] (Block [])] [VariableDeclaration "int" "value" Nothing]] $ + parse [CLASS,IDENTIFIER "WithMethodAndField",LBRACKET,VOID,IDENTIFIER "foo",LBRACE,RBRACE,LBRACKET,RBRACKET,INT,IDENTIFIER "value",SEMICOLON,INT,IDENTIFIER "bar",LBRACE,RBRACE,SEMICOLON,RBRACKET] tests = TestList [ @@ -52,5 +61,8 @@ tests = TestList [ testWithModifier, testEmptyMethod, testEmptyPrivateMethod, - testEmptyVoidMethod + testEmptyVoidMethod, + testEmptyMethodWithParam, + testEmptyMethodWithParams, + testClassWithMethodAndField ] \ No newline at end of file diff --git a/src/Parser/JavaParser.y b/src/Parser/JavaParser.y index ec3788c..8edb2df 100644 --- a/src/Parser/JavaParser.y +++ b/src/Parser/JavaParser.y @@ -161,8 +161,8 @@ methodbody : block { $1 } blockstatements : blockstatement { } | blockstatements blockstatement { } -formalparameterlist : formalparameter { } - | formalparameterlist COMMA formalparameter{ } +formalparameterlist : formalparameter { [$1] } + | formalparameterlist COMMA formalparameter { $1 ++ [$3] } explicitconstructorinvocation : THIS LBRACE RBRACE SEMICOLON { } | THIS LBRACE argumentlist RBRACE SEMICOLON { } @@ -171,7 +171,7 @@ classtypelist : classtype { } | classtypelist COMMA classtype { } methoddeclarator : IDENTIFIER LBRACE RBRACE { ($1, []) } - -- | IDENTIFIER LBRACE formalparameterlist RBRACE { } + | IDENTIFIER LBRACE formalparameterlist RBRACE { ($1, $3) } primitivetype : BOOLEAN { "boolean" } | numerictype { $1 } @@ -185,7 +185,7 @@ variabledeclarator : variabledeclaratorid { Declarator $1 Nothing } blockstatement : localvariabledeclarationstatement { } | statement { } -formalparameter : type variabledeclaratorid { } +formalparameter : type variabledeclaratorid { ParameterDeclaration $1 $2 } argumentlist : expression { } | argumentlist COMMA expression { } From 9e6f31479f0ffca7ac497f46925c8653e1f7ee2e Mon Sep 17 00:00:00 2001 From: Marvin Schlegel Date: Wed, 8 May 2024 00:00:18 +0200 Subject: [PATCH 22/98] parser improve error messages --- src/Parser/JavaParser.y | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/Parser/JavaParser.y b/src/Parser/JavaParser.y index 8edb2df..6c249ac 100644 --- a/src/Parser/JavaParser.y +++ b/src/Parser/JavaParser.y @@ -7,6 +7,7 @@ import Parser.Lexer %name parse %tokentype { Token } %error { parseError } +%errorhandlertype explist %token BOOLEAN { BOOLEAN } @@ -368,7 +369,7 @@ data Declarator = Declarator Identifier (Maybe Expression) convertDeclarator :: DataType -> Declarator -> VariableDeclaration convertDeclarator dataType (Declarator id assigment) = VariableDeclaration dataType id assigment -parseError :: [Token] -> a -parseError msg = error ("Parse error: " ++ show msg) +parseError :: ([Token], [String]) -> a +parseError (errortoken, expected) = error ("parse error on token: " ++ show errortoken ++ "\nexpected one of: " ++ show expected) } From ea18431b771609ee03c3e2828c81c62e4d695ea6 Mon Sep 17 00:00:00 2001 From: Marvin Schlegel Date: Wed, 8 May 2024 00:02:38 +0200 Subject: [PATCH 23/98] parser add constructor --- Test/TestParser.hs | 6 +++++- src/Parser/JavaParser.y | 18 +++++++++--------- 2 files changed, 14 insertions(+), 10 deletions(-) diff --git a/Test/TestParser.hs b/Test/TestParser.hs index 8e1aaa7..b078def 100644 --- a/Test/TestParser.hs +++ b/Test/TestParser.hs @@ -49,6 +49,9 @@ testEmptyMethodWithParams = TestCase $ testClassWithMethodAndField = TestCase $ assertEqual "expect class with method and field" [Class "WithMethodAndField" [MethodDeclaration "void" "foo" [] (Block []), MethodDeclaration "int" "bar" [] (Block [])] [VariableDeclaration "int" "value" Nothing]] $ parse [CLASS,IDENTIFIER "WithMethodAndField",LBRACKET,VOID,IDENTIFIER "foo",LBRACE,RBRACE,LBRACKET,RBRACKET,INT,IDENTIFIER "value",SEMICOLON,INT,IDENTIFIER "bar",LBRACE,RBRACE,SEMICOLON,RBRACKET] +testClassWithConstructor = TestCase $ + assertEqual "expect class with constructor" [Class "WithConstructor" [MethodDeclaration "WithConstructor" "" [] (Block [])] []] $ + parse [CLASS,IDENTIFIER "WithConstructor",LBRACKET,IDENTIFIER "WithConstructor",LBRACE,RBRACE,LBRACKET,RBRACKET,RBRACKET] tests = TestList [ @@ -64,5 +67,6 @@ tests = TestList [ testEmptyVoidMethod, testEmptyMethodWithParam, testEmptyMethodWithParams, - testClassWithMethodAndField + testClassWithMethodAndField, + testClassWithConstructor ] \ No newline at end of file diff --git a/src/Parser/JavaParser.y b/src/Parser/JavaParser.y index 6c249ac..d323009 100644 --- a/src/Parser/JavaParser.y +++ b/src/Parser/JavaParser.y @@ -119,15 +119,15 @@ modifier : PUBLIC { } classtype : classorinterfacetype{ } classbodydeclaration : classmemberdeclaration { $1 } - -- | constructordeclaration { FieldDecl $ VariableDeclaration "int" "a" Nothing } -- TODO + | constructordeclaration { $1 } classorinterfacetype : name { $1 } classmemberdeclaration : fielddeclaration { $1 } | methoddeclaration { $1 } -constructordeclaration : constructordeclarator constructorbody { } - | modifiers constructordeclarator constructorbody { } +constructordeclaration : constructordeclarator constructorbody { case $1 of (classname, parameters) -> MethodDecl $ MethodDeclaration classname "" parameters $2 } + | modifiers constructordeclarator constructorbody { case $2 of (classname, parameters) -> MethodDecl $ MethodDeclaration classname "" parameters $3 } fielddeclaration : type variabledeclarators SEMICOLON { FieldDecls $ map (convertDeclarator $1) $2 } | modifiers type variabledeclarators SEMICOLON { FieldDecls $ map (convertDeclarator $2) $3 } @@ -137,13 +137,13 @@ methoddeclaration : methodheader methodbody { case $1 of (returnType, (name, par block : LBRACKET RBRACKET { Block [] } -- | LBRACKET blockstatements RBRACKET { } -constructordeclarator : simplename LBRACE RBRACE { } - | simplename LBRACE formalparameterlist RBRACE { } +constructordeclarator : simplename LBRACE RBRACE { ($1, []) } + | simplename LBRACE formalparameterlist RBRACE { ($1, $3) } -constructorbody : LBRACKET RBRACKET { } - | LBRACKET explicitconstructorinvocation RBRACKET { } - | LBRACKET blockstatements RBRACKET { } - | LBRACKET explicitconstructorinvocation blockstatements RBRACKET { } +constructorbody : LBRACKET RBRACKET { Block [] } + -- | LBRACKET explicitconstructorinvocation RBRACKET { } + -- | LBRACKET blockstatements RBRACKET { } + -- | LBRACKET explicitconstructorinvocation blockstatements RBRACKET { } methodheader : type methoddeclarator { ($1, $2) } | modifiers type methoddeclarator { ($2, $3) } From 58367a95e6a9e398e4048f8b5af4fc691a8367f5 Mon Sep 17 00:00:00 2001 From: Marvin Schlegel Date: Wed, 8 May 2024 10:20:55 +0200 Subject: [PATCH 24/98] parser implement localvardeclaration --- Test/TestParser.hs | 10 +++++++++- src/Parser/JavaParser.y | 17 +++++++++-------- 2 files changed, 18 insertions(+), 9 deletions(-) diff --git a/Test/TestParser.hs b/Test/TestParser.hs index b078def..1a3484b 100644 --- a/Test/TestParser.hs +++ b/Test/TestParser.hs @@ -54,6 +54,12 @@ testClassWithConstructor = TestCase $ parse [CLASS,IDENTIFIER "WithConstructor",LBRACKET,IDENTIFIER "WithConstructor",LBRACE,RBRACE,LBRACKET,RBRACKET,RBRACKET] +testEmptyBlock = TestCase $ assertEqual "expect empty block" (Block []) $ parseBlock [LBRACKET,RBRACKET] +testBlockWithLocalVarDecl = TestCase $ + assertEqual "expect block with local var delcaration" (Block [LocalVariableDeclaration $ VariableDeclaration "int" "localvar" Nothing]) $ + parseBlock [LBRACKET,INT,IDENTIFIER "localvar",SEMICOLON,RBRACKET] + + tests = TestList [ testSingleEmptyClass, testTwoEmptyClasses, @@ -68,5 +74,7 @@ tests = TestList [ testEmptyMethodWithParam, testEmptyMethodWithParams, testClassWithMethodAndField, - testClassWithConstructor + testClassWithConstructor, + testEmptyBlock, + testBlockWithLocalVarDecl ] \ No newline at end of file diff --git a/src/Parser/JavaParser.y b/src/Parser/JavaParser.y index d323009..a0a7a3c 100644 --- a/src/Parser/JavaParser.y +++ b/src/Parser/JavaParser.y @@ -1,10 +1,11 @@ { -module Parser.JavaParser (parse) where +module Parser.JavaParser (parse, parseBlock) where import Ast import Parser.Lexer } %name parse +%name parseBlock block %tokentype { Token } %error { parseError } %errorhandlertype explist @@ -135,7 +136,7 @@ fielddeclaration : type variabledeclarators SEMICOLON { FieldDecls $ map (conve methoddeclaration : methodheader methodbody { case $1 of (returnType, (name, parameters)) -> MethodDecl (MethodDeclaration returnType name parameters $2) } block : LBRACKET RBRACKET { Block [] } - -- | LBRACKET blockstatements RBRACKET { } + | LBRACKET blockstatements RBRACKET { $2 } constructordeclarator : simplename LBRACE RBRACE { ($1, []) } | simplename LBRACE formalparameterlist RBRACE { ($1, $3) } @@ -159,8 +160,8 @@ variabledeclarators : variabledeclarator { [$1] } methodbody : block { $1 } | SEMICOLON { Block [] } -blockstatements : blockstatement { } - | blockstatements blockstatement { } +blockstatements : blockstatement { Block $1 } + -- | blockstatements blockstatement { } formalparameterlist : formalparameter { [$1] } | formalparameterlist COMMA formalparameter { $1 ++ [$3] } @@ -183,8 +184,8 @@ referencetype : classorinterfacetype { $1 } variabledeclarator : variabledeclaratorid { Declarator $1 Nothing } -- | variabledeclaratorid ASSIGN variableinitializer { Declarator $1 Nothing } -- TODO -blockstatement : localvariabledeclarationstatement { } - | statement { } +blockstatement : localvariabledeclarationstatement { $1 } + -- | statement { } formalparameter : type variabledeclaratorid { ParameterDeclaration $1 $2 } @@ -197,7 +198,7 @@ variabledeclaratorid : IDENTIFIER { $1 } variableinitializer : expression { } -localvariabledeclarationstatement : localvariabledeclaration SEMICOLON { } +localvariabledeclarationstatement : localvariabledeclaration SEMICOLON { $1 } statement : statementwithouttrailingsubstatement{ } | ifthenstatement { } @@ -210,7 +211,7 @@ expression : assignmentexpression { } integraltype : INT { "int" } | CHAR { "char" } -localvariabledeclaration : type variabledeclarators { } +localvariabledeclaration : type variabledeclarators { map LocalVariableDeclaration $ map (convertDeclarator $1) $2 } statementwithouttrailingsubstatement : block { } | emptystatement { } From 98321fa1624817c08245cacb41bb955ff4f7a406 Mon Sep 17 00:00:00 2001 From: Marvin Schlegel Date: Wed, 8 May 2024 10:30:50 +0200 Subject: [PATCH 25/98] parser implement multiple blockstatements --- Test/TestParser.hs | 6 +++++- src/Parser/JavaParser.y | 2 +- 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/Test/TestParser.hs b/Test/TestParser.hs index 1a3484b..28bdd00 100644 --- a/Test/TestParser.hs +++ b/Test/TestParser.hs @@ -58,6 +58,9 @@ testEmptyBlock = TestCase $ assertEqual "expect empty block" (Block []) $ parseB testBlockWithLocalVarDecl = TestCase $ assertEqual "expect block with local var delcaration" (Block [LocalVariableDeclaration $ VariableDeclaration "int" "localvar" Nothing]) $ parseBlock [LBRACKET,INT,IDENTIFIER "localvar",SEMICOLON,RBRACKET] +testBlockWithMultipleLocalVarDecls = TestCase $ + assertEqual "expect block with multiple local var declarations" (Block [LocalVariableDeclaration $ VariableDeclaration "int" "var1" Nothing, LocalVariableDeclaration $ VariableDeclaration "boolean" "var2" Nothing]) $ + parseBlock [LBRACKET,INT,IDENTIFIER "var1",SEMICOLON,BOOLEAN,IDENTIFIER "var2",SEMICOLON,RBRACKET] tests = TestList [ @@ -76,5 +79,6 @@ tests = TestList [ testClassWithMethodAndField, testClassWithConstructor, testEmptyBlock, - testBlockWithLocalVarDecl + testBlockWithLocalVarDecl, + testBlockWithMultipleLocalVarDecls ] \ No newline at end of file diff --git a/src/Parser/JavaParser.y b/src/Parser/JavaParser.y index a0a7a3c..5c423b5 100644 --- a/src/Parser/JavaParser.y +++ b/src/Parser/JavaParser.y @@ -161,7 +161,7 @@ methodbody : block { $1 } | SEMICOLON { Block [] } blockstatements : blockstatement { Block $1 } - -- | blockstatements blockstatement { } + | blockstatements blockstatement { case $1 of Block stmts -> Block (stmts ++ $2)} formalparameterlist : formalparameter { [$1] } | formalparameterlist COMMA formalparameter { $1 ++ [$3] } From b82e205bcdacbe711ffe09f5211ff820b8be5e64 Mon Sep 17 00:00:00 2001 From: Marvin Schlegel Date: Wed, 8 May 2024 10:37:40 +0200 Subject: [PATCH 26/98] parser implement nested blocks --- Test/TestParser.hs | 6 +++++- src/Parser/JavaParser.y | 18 +++++++++--------- 2 files changed, 14 insertions(+), 10 deletions(-) diff --git a/Test/TestParser.hs b/Test/TestParser.hs index 28bdd00..c000d6b 100644 --- a/Test/TestParser.hs +++ b/Test/TestParser.hs @@ -61,6 +61,9 @@ testBlockWithLocalVarDecl = TestCase $ testBlockWithMultipleLocalVarDecls = TestCase $ assertEqual "expect block with multiple local var declarations" (Block [LocalVariableDeclaration $ VariableDeclaration "int" "var1" Nothing, LocalVariableDeclaration $ VariableDeclaration "boolean" "var2" Nothing]) $ parseBlock [LBRACKET,INT,IDENTIFIER "var1",SEMICOLON,BOOLEAN,IDENTIFIER "var2",SEMICOLON,RBRACKET] +testNestedBlocks = TestCase $ + assertEqual "expect block with block inside" (Block [Block []]) $ + parseBlock [LBRACKET,LBRACKET,RBRACKET,RBRACKET] tests = TestList [ @@ -80,5 +83,6 @@ tests = TestList [ testClassWithConstructor, testEmptyBlock, testBlockWithLocalVarDecl, - testBlockWithMultipleLocalVarDecls + testBlockWithMultipleLocalVarDecls, + testNestedBlocks ] \ No newline at end of file diff --git a/src/Parser/JavaParser.y b/src/Parser/JavaParser.y index 5c423b5..fe309da 100644 --- a/src/Parser/JavaParser.y +++ b/src/Parser/JavaParser.y @@ -185,7 +185,7 @@ variabledeclarator : variabledeclaratorid { Declarator $1 Nothing } -- | variabledeclaratorid ASSIGN variableinitializer { Declarator $1 Nothing } -- TODO blockstatement : localvariabledeclarationstatement { $1 } - -- | statement { } + | statement { [$1] } formalparameter : type variabledeclaratorid { ParameterDeclaration $1 $2 } @@ -200,10 +200,10 @@ variableinitializer : expression { } localvariabledeclarationstatement : localvariabledeclaration SEMICOLON { $1 } -statement : statementwithouttrailingsubstatement{ } - | ifthenstatement { } - | ifthenelsestatement { } - | whilestatement { } +statement : statementwithouttrailingsubstatement{ $1 } + -- | ifthenstatement { } + -- | ifthenelsestatement { } + -- | whilestatement { } expression : assignmentexpression { } @@ -213,10 +213,10 @@ integraltype : INT { "int" } localvariabledeclaration : type variabledeclarators { map LocalVariableDeclaration $ map (convertDeclarator $1) $2 } -statementwithouttrailingsubstatement : block { } - | emptystatement { } - | expressionstatement { } - | returnstatement { } +statementwithouttrailingsubstatement : block { $1 } + -- | emptystatement { } + -- | expressionstatement { } + -- | returnstatement { } ifthenstatement : IF LBRACE expression RBRACE statement { } From b957f512ada6771e0985ec4bc8c1db06847d831a Mon Sep 17 00:00:00 2001 From: Marvin Schlegel Date: Wed, 8 May 2024 11:05:02 +0200 Subject: [PATCH 27/98] parser add emptystatement --- Test/TestParser.hs | 7 +++++-- src/Parser/JavaParser.y | 18 +++++++++--------- 2 files changed, 14 insertions(+), 11 deletions(-) diff --git a/Test/TestParser.hs b/Test/TestParser.hs index c000d6b..53a08a6 100644 --- a/Test/TestParser.hs +++ b/Test/TestParser.hs @@ -64,7 +64,9 @@ testBlockWithMultipleLocalVarDecls = TestCase $ testNestedBlocks = TestCase $ assertEqual "expect block with block inside" (Block [Block []]) $ parseBlock [LBRACKET,LBRACKET,RBRACKET,RBRACKET] - +testBlockWithEmptyStatement = TestCase $ + assertEqual "expect empty block" (Block []) $ + parseBlock [LBRACKET,SEMICOLON,SEMICOLON,RBRACKET] tests = TestList [ testSingleEmptyClass, @@ -84,5 +86,6 @@ tests = TestList [ testEmptyBlock, testBlockWithLocalVarDecl, testBlockWithMultipleLocalVarDecls, - testNestedBlocks + testNestedBlocks, + testBlockWithEmptyStatement ] \ No newline at end of file diff --git a/src/Parser/JavaParser.y b/src/Parser/JavaParser.y index fe309da..d2cf382 100644 --- a/src/Parser/JavaParser.y +++ b/src/Parser/JavaParser.y @@ -136,7 +136,7 @@ fielddeclaration : type variabledeclarators SEMICOLON { FieldDecls $ map (conve methoddeclaration : methodheader methodbody { case $1 of (returnType, (name, parameters)) -> MethodDecl (MethodDeclaration returnType name parameters $2) } block : LBRACKET RBRACKET { Block [] } - | LBRACKET blockstatements RBRACKET { $2 } + | LBRACKET blockstatements RBRACKET { Block $2 } constructordeclarator : simplename LBRACE RBRACE { ($1, []) } | simplename LBRACE formalparameterlist RBRACE { ($1, $3) } @@ -160,8 +160,8 @@ variabledeclarators : variabledeclarator { [$1] } methodbody : block { $1 } | SEMICOLON { Block [] } -blockstatements : blockstatement { Block $1 } - | blockstatements blockstatement { case $1 of Block stmts -> Block (stmts ++ $2)} +blockstatements : blockstatement { $1 } + | blockstatements blockstatement { $1 ++ $2} formalparameterlist : formalparameter { [$1] } | formalparameterlist COMMA formalparameter { $1 ++ [$3] } @@ -185,7 +185,7 @@ variabledeclarator : variabledeclaratorid { Declarator $1 Nothing } -- | variabledeclaratorid ASSIGN variableinitializer { Declarator $1 Nothing } -- TODO blockstatement : localvariabledeclarationstatement { $1 } - | statement { [$1] } + | statement { $1 } formalparameter : type variabledeclaratorid { ParameterDeclaration $1 $2 } @@ -213,8 +213,8 @@ integraltype : INT { "int" } localvariabledeclaration : type variabledeclarators { map LocalVariableDeclaration $ map (convertDeclarator $1) $2 } -statementwithouttrailingsubstatement : block { $1 } - -- | emptystatement { } +statementwithouttrailingsubstatement : block { [$1] } + | emptystatement { [] } -- | expressionstatement { } -- | returnstatement { } @@ -227,7 +227,7 @@ whilestatement : WHILE LBRACE expression RBRACE statement { } assignmentexpression : conditionalexpression { } | assignment{ } -emptystatement : SEMICOLON { } +emptystatement : SEMICOLON { Block [] } expressionstatement : statementexpression SEMICOLON { } @@ -338,8 +338,8 @@ andexpression : equalityexpression { } | andexpression AND equalityexpression { } equalityexpression : relationalexpression { } - | equalityexpression EQUAL relationalexpression { } - | equalityexpression NOTEQUAL relationalexpression { } + -- | equalityexpression EQUAL relationalexpression { } + -- | equalityexpression NOTEQUAL relationalexpression { } relationalexpression : shiftexpression { } | relationalexpression LESS shiftexpression { } From ebf54bf4cbd6de4fa94fa456764bbfe549bba10e Mon Sep 17 00:00:00 2001 From: Marvin Schlegel Date: Wed, 8 May 2024 13:16:00 +0200 Subject: [PATCH 28/98] parser implement int initializiation --- Test/TestParser.hs | 11 +++- src/Parser/JavaParser.y | 139 ++++++++++++++++++++-------------------- 2 files changed, 80 insertions(+), 70 deletions(-) diff --git a/Test/TestParser.hs b/Test/TestParser.hs index 53a08a6..7a79ba8 100644 --- a/Test/TestParser.hs +++ b/Test/TestParser.hs @@ -68,6 +68,13 @@ testBlockWithEmptyStatement = TestCase $ assertEqual "expect empty block" (Block []) $ parseBlock [LBRACKET,SEMICOLON,SEMICOLON,RBRACKET] +testExpressionIntLiteral = TestCase $ + assertEqual "expect IntLiteral" (IntegerLiteral 3) $ + parseExpression [INTEGERLITERAL 3] +testFieldWithInitialization = TestCase $ + assertEqual "expect Class with initialized field" [Class "WithInitField" [] [VariableDeclaration "int" "number" $ Just $ IntegerLiteral 3]] $ + parse [CLASS,IDENTIFIER "WithInitField",LBRACKET,INT,IDENTIFIER "number",ASSIGN,INTEGERLITERAL 3,SEMICOLON,RBRACKET] + tests = TestList [ testSingleEmptyClass, testTwoEmptyClasses, @@ -87,5 +94,7 @@ tests = TestList [ testBlockWithLocalVarDecl, testBlockWithMultipleLocalVarDecls, testNestedBlocks, - testBlockWithEmptyStatement + testBlockWithEmptyStatement, + testExpressionIntLiteral, + testFieldWithInitialization ] \ No newline at end of file diff --git a/src/Parser/JavaParser.y b/src/Parser/JavaParser.y index d2cf382..9dd31c6 100644 --- a/src/Parser/JavaParser.y +++ b/src/Parser/JavaParser.y @@ -1,11 +1,12 @@ { -module Parser.JavaParser (parse, parseBlock) where +module Parser.JavaParser (parse, parseBlock, parseExpression) where import Ast import Parser.Lexer } %name parse %name parseBlock block +%name parseExpression expression %tokentype { Token } %error { parseError } %errorhandlertype explist @@ -182,7 +183,7 @@ referencetype : classorinterfacetype { $1 } variabledeclarator : variabledeclaratorid { Declarator $1 Nothing } - -- | variabledeclaratorid ASSIGN variableinitializer { Declarator $1 Nothing } -- TODO + | variabledeclaratorid ASSIGN variableinitializer { Declarator $1 (Just $3) } blockstatement : localvariabledeclarationstatement { $1 } | statement { $1 } @@ -196,7 +197,7 @@ numerictype : integraltype { $1 } variabledeclaratorid : IDENTIFIER { $1 } -variableinitializer : expression { } +variableinitializer : expression { $1 } localvariabledeclarationstatement : localvariabledeclaration SEMICOLON { $1 } @@ -206,7 +207,7 @@ statement : statementwithouttrailingsubstatement{ $1 } -- | whilestatement { } -expression : assignmentexpression { } +expression : assignmentexpression { $1 } integraltype : INT { "int" } | CHAR { "char" } @@ -224,8 +225,8 @@ ifthenelsestatement : IF LBRACE expression RBRACE statementnoshortif ELSE state whilestatement : WHILE LBRACE expression RBRACE statement { } -assignmentexpression : conditionalexpression { } - | assignment{ } +assignmentexpression : conditionalexpression { $1 } + -- | assignment { } emptystatement : SEMICOLON { Block [] } @@ -238,10 +239,10 @@ statementnoshortif : statementwithouttrailingsubstatement { } | ifthenelsestatementnoshortif { } | whilestatementnoshortif { } -conditionalexpression : conditionalorexpression { } - | conditionalorexpression QUESMARK expression COLON conditionalexpression { } +conditionalexpression : conditionalorexpression { $1 } + -- | conditionalorexpression QUESMARK expression COLON conditionalexpression { } -assignment :lefthandside assignmentoperator assignmentexpression { } +assignment : lefthandside assignmentoperator assignmentexpression { } statementexpression : assignment { } @@ -257,23 +258,23 @@ ifthenelsestatementnoshortif :IF LBRACE expression RBRACE statementnoshortif whilestatementnoshortif : WHILE LBRACE expression RBRACE statementnoshortif { } -conditionalorexpression : conditionalandexpression { } - | conditionalorexpression LOGICALOR conditionalandexpression{ } +conditionalorexpression : conditionalandexpression { $1 } + -- | conditionalorexpression LOGICALOR conditionalandexpression{ } -lefthandside : name { } +lefthandside : name { $1 } assignmentoperator : ASSIGN{ } - | TIMESEQUAL { } - | DIVIDEEQUAL { } - | MODULOEQUAL { } - | PLUSEQUAL { } - | MINUSEQUAL { } - | SHIFTLEFTEQUAL { } - | SIGNEDSHIFTRIGHTEQUAL { } - | UNSIGNEDSHIFTRIGHTEQUAL { } - | ANDEQUAL { } - | XOREQUAL { } - | OREQUAL{ } + -- | TIMESEQUAL { } + -- | DIVIDEEQUAL { } + -- | MODULOEQUAL { } + -- | PLUSEQUAL { } + -- | MINUSEQUAL { } + -- | SHIFTLEFTEQUAL { } + -- | SIGNEDSHIFTRIGHTEQUAL { } + -- | UNSIGNEDSHIFTRIGHTEQUAL { } + -- | ANDEQUAL { } + -- | XOREQUAL { } + -- | OREQUAL{ } preincrementexpression : INCREMENT unaryexpression { } @@ -291,73 +292,73 @@ methodinvocation : name LBRACE RBRACE { } classinstancecreationexpression : NEW classtype LBRACE RBRACE { } | NEW classtype LBRACE argumentlist RBRACE { } -conditionalandexpression : inclusiveorexpression { } +conditionalandexpression : inclusiveorexpression { $1 } fieldaccess : primary DOT IDENTIFIER { } -unaryexpression : preincrementexpression { } - | predecrementexpression { } - | PLUS unaryexpression { } - | MINUS unaryexpression { } - | unaryexpressionnotplusminus { } +unaryexpression : unaryexpressionnotplusminus { $1 } + -- | predecrementexpression { } + -- | PLUS unaryexpression { } + -- | MINUS unaryexpression { } + -- | preincrementexpression { $1 } -postfixexpression : primary { } - | name { } - | postincrementexpression { } - | postdecrementexpression{ } +postfixexpression : primary { $1 } + -- | name { } + -- | postincrementexpression { } + -- | postdecrementexpression{ } -primary : primarynonewarray { } +primary : primarynonewarray { $1 } -inclusiveorexpression : exclusiveorexpression { } - | inclusiveorexpression OR exclusiveorexpression { } +inclusiveorexpression : exclusiveorexpression { $1 } + -- | inclusiveorexpression OR exclusiveorexpression { } -primarynonewarray : literal { } - | THIS { } - | LBRACE expression RBRACE { } - | classinstancecreationexpression { } - | fieldaccess { } - | methodinvocation { } +primarynonewarray : literal { $1 } + -- | THIS { } + -- | LBRACE expression RBRACE { } + -- | classinstancecreationexpression { } + -- | fieldaccess { } + -- | methodinvocation { } -unaryexpressionnotplusminus : postfixexpression { } - | TILDE unaryexpression { } - | EXCLMARK unaryexpression { } - | castexpression{ } +unaryexpressionnotplusminus : postfixexpression { $1 } + -- | TILDE unaryexpression { } + -- | EXCLMARK unaryexpression { } + -- | castexpression{ } -exclusiveorexpression : andexpression { } - | exclusiveorexpression XOR andexpression { } +exclusiveorexpression : andexpression { $1 } + -- | exclusiveorexpression XOR andexpression { } -literal : INTLITERAL { } - | BOOLLITERAL { } - | CHARLITERAL { } - | JNULL { } +literal : INTLITERAL { IntegerLiteral $1 } + -- | BOOLLITERAL { } + -- | CHARLITERAL { } + -- | JNULL { } castexpression : LBRACE primitivetype RBRACE unaryexpression { } | LBRACE expression RBRACE unaryexpressionnotplusminus{ } -andexpression : equalityexpression { } - | andexpression AND equalityexpression { } +andexpression : equalityexpression { $1 } + -- | andexpression AND equalityexpression { } -equalityexpression : relationalexpression { } +equalityexpression : relationalexpression { $1 } -- | equalityexpression EQUAL relationalexpression { } -- | equalityexpression NOTEQUAL relationalexpression { } -relationalexpression : shiftexpression { } - | relationalexpression LESS shiftexpression { } - | relationalexpression GREATER shiftexpression { } - | relationalexpression LESSEQUAL shiftexpression { } - | relationalexpression GREATEREQUAL shiftexpression { } - | relationalexpression INSTANCEOF referencetype { } +relationalexpression : shiftexpression { $1 } + -- | relationalexpression LESS shiftexpression { } + -- | relationalexpression GREATER shiftexpression { } + -- | relationalexpression LESSEQUAL shiftexpression { } + -- | relationalexpression GREATEREQUAL shiftexpression { } + -- | relationalexpression INSTANCEOF referencetype { } -shiftexpression : additiveexpression { } +shiftexpression : additiveexpression { $1 } -additiveexpression : multiplicativeexpression { } - | additiveexpression PLUS multiplicativeexpression { } - | additiveexpression MINUS multiplicativeexpression { } +additiveexpression : multiplicativeexpression { $1 } + -- | additiveexpression PLUS multiplicativeexpression { } + -- | additiveexpression MINUS multiplicativeexpression { } -multiplicativeexpression : unaryexpression { } - | multiplicativeexpression MUL unaryexpression { } - | multiplicativeexpression DIV unaryexpression { } - | multiplicativeexpression MOD unaryexpression { } +multiplicativeexpression : unaryexpression { $1 } + -- | multiplicativeexpression MUL unaryexpression { } + -- | multiplicativeexpression DIV unaryexpression { } + -- | multiplicativeexpression MOD unaryexpression { } { From 90fa658c8ffa558337f69c606b0bb0fa92efa3cb Mon Sep 17 00:00:00 2001 From: Marvin Schlegel Date: Wed, 8 May 2024 13:29:10 +0200 Subject: [PATCH 29/98] parser implement varibale initialization --- Test/TestParser.hs | 10 +++++++++- src/Parser/JavaParser.y | 6 +++--- 2 files changed, 12 insertions(+), 4 deletions(-) diff --git a/Test/TestParser.hs b/Test/TestParser.hs index 7a79ba8..4a18581 100644 --- a/Test/TestParser.hs +++ b/Test/TestParser.hs @@ -74,6 +74,12 @@ testExpressionIntLiteral = TestCase $ testFieldWithInitialization = TestCase $ assertEqual "expect Class with initialized field" [Class "WithInitField" [] [VariableDeclaration "int" "number" $ Just $ IntegerLiteral 3]] $ parse [CLASS,IDENTIFIER "WithInitField",LBRACKET,INT,IDENTIFIER "number",ASSIGN,INTEGERLITERAL 3,SEMICOLON,RBRACKET] +testLocalBoolWithInitialization = TestCase $ + assertEqual "expect block with with initialized local var" (Block [LocalVariableDeclaration $ VariableDeclaration "boolean" "b" $ Just $ BooleanLiteral False]) $ + parseBlock [LBRACKET,BOOLEAN,IDENTIFIER "b",ASSIGN,BOOLLITERAL False,SEMICOLON,RBRACKET] +testFieldNullWithInitialization = TestCase $ + assertEqual "expect Class with initialized field" [Class "WithInitField" [] [VariableDeclaration "Object" "bar" $ Just NullLiteral]] $ + parse [CLASS,IDENTIFIER "WithInitField",LBRACKET,IDENTIFIER "Object",IDENTIFIER "bar",ASSIGN,NULLLITERAL,SEMICOLON,RBRACKET] tests = TestList [ testSingleEmptyClass, @@ -96,5 +102,7 @@ tests = TestList [ testNestedBlocks, testBlockWithEmptyStatement, testExpressionIntLiteral, - testFieldWithInitialization + testFieldWithInitialization, + testLocalBoolWithInitialization, + testFieldNullWithInitialization ] \ No newline at end of file diff --git a/src/Parser/JavaParser.y b/src/Parser/JavaParser.y index 9dd31c6..b0a8173 100644 --- a/src/Parser/JavaParser.y +++ b/src/Parser/JavaParser.y @@ -328,9 +328,9 @@ exclusiveorexpression : andexpression { $1 } -- | exclusiveorexpression XOR andexpression { } literal : INTLITERAL { IntegerLiteral $1 } - -- | BOOLLITERAL { } - -- | CHARLITERAL { } - -- | JNULL { } + | BOOLLITERAL { BooleanLiteral $1 } + | CHARLITERAL { CharacterLiteral $1 } + | JNULL { NullLiteral } castexpression : LBRACE primitivetype RBRACE unaryexpression { } | LBRACE expression RBRACE unaryexpressionnotplusminus{ } From f82776e6365e69cae9100babf38185c9d37a84e5 Mon Sep 17 00:00:00 2001 From: Marvin Schlegel Date: Wed, 8 May 2024 15:52:44 +0200 Subject: [PATCH 30/98] parser add return --- Test/TestParser.hs | 6 +++++- src/Parser/JavaParser.y | 6 +++--- 2 files changed, 8 insertions(+), 4 deletions(-) diff --git a/Test/TestParser.hs b/Test/TestParser.hs index 4a18581..1caec8f 100644 --- a/Test/TestParser.hs +++ b/Test/TestParser.hs @@ -80,6 +80,9 @@ testLocalBoolWithInitialization = TestCase $ testFieldNullWithInitialization = TestCase $ assertEqual "expect Class with initialized field" [Class "WithInitField" [] [VariableDeclaration "Object" "bar" $ Just NullLiteral]] $ parse [CLASS,IDENTIFIER "WithInitField",LBRACKET,IDENTIFIER "Object",IDENTIFIER "bar",ASSIGN,NULLLITERAL,SEMICOLON,RBRACKET] +testReturnVoid = TestCase $ + assertEqual "expect block with return nothing" (Block [Return Nothing]) $ + parseBlock [LBRACKET,RETURN,SEMICOLON,RBRACKET] tests = TestList [ testSingleEmptyClass, @@ -104,5 +107,6 @@ tests = TestList [ testExpressionIntLiteral, testFieldWithInitialization, testLocalBoolWithInitialization, - testFieldNullWithInitialization + testFieldNullWithInitialization, + testReturnVoid ] \ No newline at end of file diff --git a/src/Parser/JavaParser.y b/src/Parser/JavaParser.y index b0a8173..c92f6f1 100644 --- a/src/Parser/JavaParser.y +++ b/src/Parser/JavaParser.y @@ -217,7 +217,7 @@ localvariabledeclaration : type variabledeclarators { map LocalVariableDeclarati statementwithouttrailingsubstatement : block { [$1] } | emptystatement { [] } -- | expressionstatement { } - -- | returnstatement { } + | returnstatement { [$1] } ifthenstatement : IF LBRACE expression RBRACE statement { } @@ -232,8 +232,8 @@ emptystatement : SEMICOLON { Block [] } expressionstatement : statementexpression SEMICOLON { } -returnstatement : RETURN SEMICOLON { } - | RETURN expression SEMICOLON { } +returnstatement : RETURN SEMICOLON { Return Nothing } + | RETURN expression SEMICOLON { Return $ Just $2 } statementnoshortif : statementwithouttrailingsubstatement { } | ifthenelsestatementnoshortif { } From 4f61431c79edcc5ff20a54deda532897d0571d4e Mon Sep 17 00:00:00 2001 From: Marvin Schlegel Date: Wed, 8 May 2024 16:59:10 +0200 Subject: [PATCH 31/98] parser add unary not, plus and minus --- Test/TestParser.hs | 11 ++++++++++- src/Parser/JavaParser.y | 8 ++++---- 2 files changed, 14 insertions(+), 5 deletions(-) diff --git a/Test/TestParser.hs b/Test/TestParser.hs index 1caec8f..acb7ee7 100644 --- a/Test/TestParser.hs +++ b/Test/TestParser.hs @@ -84,6 +84,13 @@ testReturnVoid = TestCase $ assertEqual "expect block with return nothing" (Block [Return Nothing]) $ parseBlock [LBRACKET,RETURN,SEMICOLON,RBRACKET] +testExpressionNot = TestCase $ + assertEqual "expect expression not" (UnaryOperation Not (Reference "boar")) $ + parseExpression [NOT,IDENTIFIER "boar"] +testExpressionMinus = TestCase $ + assertEqual "expect expression minus" (UnaryOperation Minus (Reference "boo")) $ + parseExpression [MINUS,IDENTIFIER "boo"] + tests = TestList [ testSingleEmptyClass, testTwoEmptyClasses, @@ -108,5 +115,7 @@ tests = TestList [ testFieldWithInitialization, testLocalBoolWithInitialization, testFieldNullWithInitialization, - testReturnVoid + testReturnVoid, + testExpressionNot, + testExpressionMinus ] \ No newline at end of file diff --git a/src/Parser/JavaParser.y b/src/Parser/JavaParser.y index c92f6f1..61bd1f1 100644 --- a/src/Parser/JavaParser.y +++ b/src/Parser/JavaParser.y @@ -298,12 +298,12 @@ fieldaccess : primary DOT IDENTIFIER { } unaryexpression : unaryexpressionnotplusminus { $1 } -- | predecrementexpression { } - -- | PLUS unaryexpression { } - -- | MINUS unaryexpression { } + | PLUS unaryexpression { $2 } + | MINUS unaryexpression { UnaryOperation Minus $2 } -- | preincrementexpression { $1 } postfixexpression : primary { $1 } - -- | name { } + | name { Reference $1 } -- | postincrementexpression { } -- | postdecrementexpression{ } @@ -321,7 +321,7 @@ primarynonewarray : literal { $1 } unaryexpressionnotplusminus : postfixexpression { $1 } -- | TILDE unaryexpression { } - -- | EXCLMARK unaryexpression { } + | EXCLMARK unaryexpression { UnaryOperation Not $2 } -- | castexpression{ } exclusiveorexpression : andexpression { $1 } From 1d5463582ff521f11117beee895082aacd4e5182 Mon Sep 17 00:00:00 2001 From: Fabian Noll Date: Wed, 8 May 2024 17:39:43 +0200 Subject: [PATCH 32/98] add differentiation between local and field variable --- src/Example.hs | 12 ++++---- src/Typecheck.hs | 72 +++++++++++++++++++++++++++++++----------------- 2 files changed, 54 insertions(+), 30 deletions(-) diff --git a/src/Example.hs b/src/Example.hs index 7f345b3..5c9cb51 100644 --- a/src/Example.hs +++ b/src/Example.hs @@ -58,7 +58,7 @@ exampleConstructorCall :: Statement exampleConstructorCall = LocalVariableDeclaration (VariableDeclaration "Person" "bob" (Just (StatementExpressionExpression (ConstructorCall "Person" [IntegerLiteral 30])))) exampleNameResolution :: Expression -exampleNameResolution = BinaryOperation NameResolution (Reference "b") (Reference "age") +exampleNameResolution = BinaryOperation NameResolution (Reference "bob2") (Reference "age") exampleBlockResolution :: Statement exampleBlockResolution = Block [ @@ -113,10 +113,12 @@ testClasses = [ (Block [ LocalVariableDeclaration (VariableDeclaration "Person" "bob" (Just (StatementExpressionExpression (ConstructorCall "Person" [IntegerLiteral 25])))), StatementExpressionStatement (MethodCall (Reference "bob") "setAge" [IntegerLiteral 30]), - LocalVariableDeclaration (VariableDeclaration "int" "bobAge" (Just (StatementExpressionExpression (MethodCall (Reference "bob") "getAge" [])))), + LocalVariableDeclaration (VariableDeclaration "int" "bobAge" (Just (StatementExpressionExpression (MethodCall (Reference "bob2") "getAge" [])))), Return (Just (Reference "bobAge")) ]) - ] [] + ] [ + VariableDeclaration "Person" "bob2" Nothing + ] ] runTypeCheck :: IO () @@ -151,7 +153,7 @@ runTypeCheck = do catch (do print "=====================================================================================" - evaluatedNameResolution <- evaluate (typeCheckExpression exampleNameResolution [("b", "Person")] sampleClasses) + evaluatedNameResolution <- evaluate (typeCheckExpression exampleNameResolution [("this", "Main")] testClasses) printSuccess "Type checking of name resolution completed successfully" printResult "Result Name Resolution:" evaluatedNameResolution ) handleError @@ -189,7 +191,7 @@ runTypeCheck = do let mainClass = fromJust $ find (\(Class className _ _) -> className == "Main") testClasses case mainClass of Class _ [mainMethod] _ -> do - let result = typeCheckMethodDeclaration mainMethod [] testClasses + let result = typeCheckMethodDeclaration mainMethod [("this", "Main")] testClasses printSuccess "Full program type checking completed successfully." printResult "Main method result:" result ) handleError diff --git a/src/Typecheck.hs b/src/Typecheck.hs index 7cdc3a7..5f1f28c 100644 --- a/src/Typecheck.hs +++ b/src/Typecheck.hs @@ -10,9 +10,9 @@ typeCheckClass :: Class -> [Class] -> Class typeCheckClass (Class className methods fields) classes = let -- Create a symbol table from class fields and method entries - classFields = [(id, dt) | VariableDeclaration dt id _ <- fields] + -- TODO: Maybe remove method entries from the symbol table? methodEntries = [(methodName, className) | MethodDeclaration _ methodName _ _ <- methods] - initalSymTab = ("this", className) : classFields ++ methodEntries + initalSymTab = ("this", className) : methodEntries checkedMethods = map (\method -> typeCheckMethodDeclaration method initalSymTab classes) methods in Class className checkedMethods fields @@ -37,8 +37,21 @@ typeCheckExpression (CharacterLiteral c) _ _ = TypedExpression "char" (Character typeCheckExpression (BooleanLiteral b) _ _ = TypedExpression "boolean" (BooleanLiteral b) typeCheckExpression NullLiteral _ _ = TypedExpression "null" NullLiteral typeCheckExpression (Reference id) symtab classes = - let type' = lookupType id symtab - in TypedExpression type' (Reference id) + case lookup id symtab of + Just t -> TypedExpression t (LocalVariable id) + Nothing -> + case lookup "this" symtab of + Just className -> + let classDetails = find (\(Class name _ _) -> name == className) classes + in case classDetails of + Just (Class _ _ fields) -> + let fieldTypes = [dt | VariableDeclaration dt fieldId _ <- fields, fieldId == id] + in case fieldTypes of + [fieldType] -> TypedExpression fieldType (FieldVariable id) + [] -> error $ "Field '" ++ id ++ "' not found in class '" ++ className ++ "'" + _ -> error $ "Ambiguous reference to field '" ++ id ++ "' in class '" ++ className ++ "'" + Nothing -> error $ "Class '" ++ className ++ "' not found for 'this'" + Nothing -> error $ "Context for 'this' not found in symbol table, unable to resolve '" ++ id ++ "'" typeCheckExpression (BinaryOperation op expr1 expr2) symtab classes = let expr1' = typeCheckExpression expr1 symtab classes expr2' = typeCheckExpression expr2 symtab classes @@ -137,18 +150,25 @@ typeCheckExpression (BinaryOperation op expr1 expr2) symtab classes = error "Logical OR operation requires two operands of type boolean" NameResolution -> case (expr1', expr2) of - (TypedExpression t1 (Reference obj), Reference member) -> - let objectType = lookupType obj symtab - classDetails = find (\(Class className _ _) -> className == objectType) classes - in case classDetails of - Just (Class _ _ fields) -> - let fieldTypes = [dt | VariableDeclaration dt id _ <- fields, id == member] - in case fieldTypes of - [resolvedType] -> TypedExpression resolvedType (BinaryOperation NameResolution expr1' (TypedExpression resolvedType expr2)) - [] -> error $ "Field '" ++ member ++ "' not found in class '" ++ objectType ++ "'" - _ -> error $ "Ambiguous reference to field '" ++ member ++ "' in class '" ++ objectType ++ "'" - Nothing -> error $ "Object '" ++ obj ++ "' does not correspond to a known class" - _ -> error "Name resolution requires object reference and field name" + (TypedExpression objType (LocalVariable ident), Reference ident2) -> + case find (\(Class className _ _) -> className == objType) classes of + Just (Class _ _ fields) -> + let fieldTypes = [dt | VariableDeclaration dt id _ <- fields, id == ident2] + in case fieldTypes of + [resolvedType] -> TypedExpression resolvedType (BinaryOperation NameResolution expr1' (TypedExpression resolvedType (FieldVariable ident2))) + [] -> error $ "Field '" ++ ident2 ++ "' not found in class '" ++ objType ++ "'" + _ -> error $ "Ambiguous reference to field '" ++ ident ++ "' in class '" ++ objType ++ "'" + Nothing -> error $ "Class '" ++ objType ++ "' not found" + (TypedExpression objType (FieldVariable ident), Reference ident2) -> + case find (\(Class className _ _) -> className == objType) classes of + Just (Class _ _ fields) -> + let fieldTypes = [dt | VariableDeclaration dt id _ <- fields, id == ident2] + in case fieldTypes of + [resolvedType] -> TypedExpression resolvedType (BinaryOperation NameResolution expr1' (TypedExpression resolvedType (FieldVariable ident2))) + [] -> error $ "Field '" ++ ident2 ++ "' not found in class '" ++ objType ++ "'" + _ -> error $ "Ambiguous reference to field '" ++ ident ++ "' in class '" ++ objType ++ "'" + Nothing -> error $ "Class '" ++ objType ++ "' not found" + _ -> error "Name resolution requires object reference and field name" typeCheckExpression (UnaryOperation op expr) symtab classes = let expr' = typeCheckExpression expr symtab classes @@ -177,12 +197,14 @@ typeCheckStatementExpression :: StatementExpression -> [(Identifier, DataType)] typeCheckStatementExpression (Assignment id expr) symtab classes = let expr' = typeCheckExpression expr symtab classes type' = getTypeFromExpr expr' - type'' = lookupType id symtab - in if type' == type'' - then - TypedStatementExpression type' (Assignment id expr') - else - error "Assignment type mismatch" + maybeType'' = lookupType id symtab + in case maybeType'' of + Just type'' -> + if type' == type'' then + TypedStatementExpression type' (Assignment id expr') + else + error $ "Assignment type mismatch: expected " ++ type'' ++ ", found " ++ type' + Nothing -> error $ "Identifier '" ++ id ++ "' not found in symbol table" typeCheckStatementExpression (ConstructorCall className args) symtab classes = case find (\(Class name _ _) -> name == className) classes of @@ -327,8 +349,8 @@ unifyReturnTypes dt1 dt2 | dt1 == dt2 = dt1 | otherwise = "Object" -lookupType :: Identifier -> [(Identifier, DataType)] -> DataType +lookupType :: Identifier -> [(Identifier, DataType)] -> Maybe DataType lookupType id symtab = case lookup id symtab of - Just t -> t - Nothing -> error ("Identifier " ++ id ++ " not found in symbol table") + Just t -> Just t + Nothing -> Nothing From de078639fc971eaf9965033ac35b6cfc76caa621 Mon Sep 17 00:00:00 2001 From: Marvin Schlegel Date: Wed, 8 May 2024 22:57:21 +0200 Subject: [PATCH 33/98] parser add multiplication, division, modulo, addition, subtraction --- Test/TestParser.hs | 42 ++++++++++++++++++++++++++++++++++++++++- src/Ast.hs | 1 + src/Parser/JavaParser.y | 22 ++++++++++----------- 3 files changed, 53 insertions(+), 12 deletions(-) diff --git a/Test/TestParser.hs b/Test/TestParser.hs index acb7ee7..a3ba800 100644 --- a/Test/TestParser.hs +++ b/Test/TestParser.hs @@ -90,6 +90,40 @@ testExpressionNot = TestCase $ testExpressionMinus = TestCase $ assertEqual "expect expression minus" (UnaryOperation Minus (Reference "boo")) $ parseExpression [MINUS,IDENTIFIER "boo"] +testExpressionMultiplication = TestCase $ + assertEqual "expect multiplication" (BinaryOperation Multiplication (Reference "bar") (IntegerLiteral 3)) $ + parseExpression [IDENTIFIER "bar",TIMES,INTEGERLITERAL 3] +testExpressionDivision = TestCase $ + assertEqual "expect division" (BinaryOperation Division (Reference "bar") (IntegerLiteral 3)) $ + parseExpression [IDENTIFIER "bar",DIV,INTEGERLITERAL 3] +testExpressionModulo = TestCase $ + assertEqual "expect modulo operation" (BinaryOperation Modulo (Reference "bar") (IntegerLiteral 3)) $ + parseExpression [IDENTIFIER "bar",MODULO,INTEGERLITERAL 3] +testExpressionAddition = TestCase $ + assertEqual "expect addition" (BinaryOperation Addition (Reference "bar") (IntegerLiteral 3)) $ + parseExpression [IDENTIFIER "bar",PLUS,INTEGERLITERAL 3] +testExpressionSubtraction = TestCase $ + assertEqual "expect subtraction" (BinaryOperation Subtraction (Reference "bar") (IntegerLiteral 3)) $ + parseExpression [IDENTIFIER "bar",MINUS,INTEGERLITERAL 3] +testExpressionLessThan = TestCase $ + assertEqual "expect comparision less than" (BinaryOperation CompareLessThan (Reference "bar") (IntegerLiteral 3)) $ + parseExpression [IDENTIFIER "bar",LESS,INTEGERLITERAL 3] +testExpressionGreaterThan = TestCase $ + assertEqual "expect comparision greater than" (BinaryOperation CompareGreaterThan (Reference "bar") (IntegerLiteral 3)) $ + parseExpression [IDENTIFIER "bar",GREATER,INTEGERLITERAL 3] +testExpressionLessThanEqual = TestCase $ + assertEqual "expect comparision less than or equal" (BinaryOperation CompareLessOrEqual (Reference "bar") (IntegerLiteral 3)) $ + parseExpression [IDENTIFIER "bar",LESSEQUAL,INTEGERLITERAL 3] +testExpressionGreaterThanOrEqual = TestCase $ + assertEqual "expect comparision greater than or equal" (BinaryOperation CompareGreaterOrEqual (Reference "bar") (IntegerLiteral 3)) $ + parseExpression [IDENTIFIER "bar",GREATEREQUAL,INTEGERLITERAL 3] +testExpressionEqual = TestCase $ + assertEqual "expect comparison equal" (BinaryOperation CompareEqual (Reference "bar") (IntegerLiteral 3)) $ + parseExpression [IDENTIFIER "bar",EQUAL,INTEGERLITERAL 3] +testExpressionNotEqual = TestCase $ + assertEqual "expect comparison equal" (BinaryOperation CompareNotEqual (Reference "bar") (IntegerLiteral 3)) $ + parseExpression [IDENTIFIER "bar",NOTEQUAL,INTEGERLITERAL 3] + tests = TestList [ testSingleEmptyClass, @@ -117,5 +151,11 @@ tests = TestList [ testFieldNullWithInitialization, testReturnVoid, testExpressionNot, - testExpressionMinus + testExpressionMinus, + testExpressionLessThan, + testExpressionGreaterThan, + testExpressionLessThanEqual, + testExpressionGreaterThanOrEqual, + testExpressionEqual, + testExpressionNotEqual ] \ No newline at end of file diff --git a/src/Ast.hs b/src/Ast.hs index e04cd3d..48dc6c6 100644 --- a/src/Ast.hs +++ b/src/Ast.hs @@ -31,6 +31,7 @@ data BinaryOperator | Subtraction | Multiplication | Division + | Modulo | BitwiseAnd | BitwiseOr | BitwiseXor diff --git a/src/Parser/JavaParser.y b/src/Parser/JavaParser.y index 61bd1f1..9ba26bc 100644 --- a/src/Parser/JavaParser.y +++ b/src/Parser/JavaParser.y @@ -339,26 +339,26 @@ andexpression : equalityexpression { $1 } -- | andexpression AND equalityexpression { } equalityexpression : relationalexpression { $1 } - -- | equalityexpression EQUAL relationalexpression { } - -- | equalityexpression NOTEQUAL relationalexpression { } + | equalityexpression EQUAL relationalexpression { BinaryOperation CompareEqual $1 $3 } + | equalityexpression NOTEQUAL relationalexpression { BinaryOperation CompareNotEqual $1 $3 } relationalexpression : shiftexpression { $1 } - -- | relationalexpression LESS shiftexpression { } - -- | relationalexpression GREATER shiftexpression { } - -- | relationalexpression LESSEQUAL shiftexpression { } - -- | relationalexpression GREATEREQUAL shiftexpression { } + | relationalexpression LESS shiftexpression { BinaryOperation CompareLessThan $1 $3 } + | relationalexpression GREATER shiftexpression { BinaryOperation CompareGreaterThan $1 $3 } + | relationalexpression LESSEQUAL shiftexpression { BinaryOperation CompareLessOrEqual $1 $3 } + | relationalexpression GREATEREQUAL shiftexpression { BinaryOperation CompareGreaterOrEqual $1 $3 } -- | relationalexpression INSTANCEOF referencetype { } shiftexpression : additiveexpression { $1 } additiveexpression : multiplicativeexpression { $1 } - -- | additiveexpression PLUS multiplicativeexpression { } - -- | additiveexpression MINUS multiplicativeexpression { } + | additiveexpression PLUS multiplicativeexpression { BinaryOperation Addition $1 $3 } + | additiveexpression MINUS multiplicativeexpression { BinaryOperation Subtraction $1 $3 } multiplicativeexpression : unaryexpression { $1 } - -- | multiplicativeexpression MUL unaryexpression { } - -- | multiplicativeexpression DIV unaryexpression { } - -- | multiplicativeexpression MOD unaryexpression { } + | multiplicativeexpression MUL unaryexpression { BinaryOperation Multiplication $1 $3 } + | multiplicativeexpression DIV unaryexpression { BinaryOperation Division $1 $3 } + | multiplicativeexpression MOD unaryexpression { BinaryOperation Modulo $1 $3 } { From c29aa13d69c21bd1b0dbc4fa4eea6eda3ef543bf Mon Sep 17 00:00:00 2001 From: Marvin Schlegel Date: Thu, 9 May 2024 00:09:08 +0200 Subject: [PATCH 34/98] parser add and, or, xor --- Test/TestParser.hs | 14 +++++++++++++- src/Parser/JavaParser.y | 7 +++---- 2 files changed, 16 insertions(+), 5 deletions(-) diff --git a/Test/TestParser.hs b/Test/TestParser.hs index a3ba800..5e8eec5 100644 --- a/Test/TestParser.hs +++ b/Test/TestParser.hs @@ -123,6 +123,15 @@ testExpressionEqual = TestCase $ testExpressionNotEqual = TestCase $ assertEqual "expect comparison equal" (BinaryOperation CompareNotEqual (Reference "bar") (IntegerLiteral 3)) $ parseExpression [IDENTIFIER "bar",NOTEQUAL,INTEGERLITERAL 3] +testExpressionAnd = TestCase $ + assertEqual "expect and expression" (BinaryOperation And (Reference "bar") (Reference "baz")) $ + parseExpression [IDENTIFIER "bar",AND,IDENTIFIER "baz"] +testExpressionXor = TestCase $ + assertEqual "expect xor expression" (BinaryOperation BitwiseXor (Reference "bar") (Reference "baz")) $ + parseExpression [IDENTIFIER "bar",XOR,IDENTIFIER "baz"] +testExpressionOr = TestCase $ + assertEqual "expect or expression" (BinaryOperation Or (Reference "bar") (Reference "baz")) $ + parseExpression [IDENTIFIER "bar",OR,IDENTIFIER "baz"] tests = TestList [ @@ -157,5 +166,8 @@ tests = TestList [ testExpressionLessThanEqual, testExpressionGreaterThanOrEqual, testExpressionEqual, - testExpressionNotEqual + testExpressionNotEqual, + testExpressionAnd, + testExpressionXor, + testExpressionOr ] \ No newline at end of file diff --git a/src/Parser/JavaParser.y b/src/Parser/JavaParser.y index 9ba26bc..68be06c 100644 --- a/src/Parser/JavaParser.y +++ b/src/Parser/JavaParser.y @@ -44,7 +44,6 @@ import Parser.Lexer JNULL { NULLLITERAL } BOOLLITERAL { BOOLLITERAL $$ } DIV { DIV } - LOGICALOR { OR } NOTEQUAL { NOTEQUAL } INSTANCEOF { INSTANCEOF } ANDEQUAL { ANDEQUAL } @@ -310,7 +309,7 @@ postfixexpression : primary { $1 } primary : primarynonewarray { $1 } inclusiveorexpression : exclusiveorexpression { $1 } - -- | inclusiveorexpression OR exclusiveorexpression { } + | inclusiveorexpression OR exclusiveorexpression { BinaryOperation Or $1 $3 } primarynonewarray : literal { $1 } -- | THIS { } @@ -325,7 +324,7 @@ unaryexpressionnotplusminus : postfixexpression { $1 } -- | castexpression{ } exclusiveorexpression : andexpression { $1 } - -- | exclusiveorexpression XOR andexpression { } + | exclusiveorexpression XOR andexpression { BinaryOperation BitwiseXor $1 $3 } literal : INTLITERAL { IntegerLiteral $1 } | BOOLLITERAL { BooleanLiteral $1 } @@ -336,7 +335,7 @@ castexpression : LBRACE primitivetype RBRACE unaryexpression { } | LBRACE expression RBRACE unaryexpressionnotplusminus{ } andexpression : equalityexpression { $1 } - -- | andexpression AND equalityexpression { } + | andexpression AND equalityexpression { BinaryOperation And $1 $3 } equalityexpression : relationalexpression { $1 } | equalityexpression EQUAL relationalexpression { BinaryOperation CompareEqual $1 $3 } From 20184c5e266a40384804698c8fecca07a3faf3ae Mon Sep 17 00:00:00 2001 From: Fabian Noll Date: Mon, 13 May 2024 13:13:24 +0200 Subject: [PATCH 35/98] add modulus to AST and Typecheck --- src/Ast.hs | 1 + src/Typecheck.hs | 6 ++++++ 2 files changed, 7 insertions(+) diff --git a/src/Ast.hs b/src/Ast.hs index 6253aa6..6554290 100644 --- a/src/Ast.hs +++ b/src/Ast.hs @@ -30,6 +30,7 @@ data BinaryOperator | Subtraction | Multiplication | Division + | Modulus | BitwiseAnd | BitwiseOr | BitwiseXor diff --git a/src/Typecheck.hs b/src/Typecheck.hs index 5f1f28c..7a7ac8d 100644 --- a/src/Typecheck.hs +++ b/src/Typecheck.hs @@ -82,6 +82,12 @@ typeCheckExpression (BinaryOperation op expr1 expr2) symtab classes = TypedExpression "int" (BinaryOperation op expr1' expr2') else error "Division operation requires two operands of type int" + Modulus -> + if type1 == "int" && type2 == "int" + then + TypedExpression "int" (BinaryOperation op expr1' expr2') + else + error "Modulus operation requires two operands of type int" BitwiseAnd -> if type1 == "int" && type2 == "int" then From e350c23db1ae68f9aec4f68ffd7a48374b016763 Mon Sep 17 00:00:00 2001 From: Fabian Noll Date: Tue, 14 May 2024 09:36:18 +0200 Subject: [PATCH 36/98] fix spelling error --- src/Ast.hs | 2 +- src/Typecheck.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Ast.hs b/src/Ast.hs index 6554290..90dcc43 100644 --- a/src/Ast.hs +++ b/src/Ast.hs @@ -30,7 +30,7 @@ data BinaryOperator | Subtraction | Multiplication | Division - | Modulus + | Modulo | BitwiseAnd | BitwiseOr | BitwiseXor diff --git a/src/Typecheck.hs b/src/Typecheck.hs index 7a7ac8d..981d4d8 100644 --- a/src/Typecheck.hs +++ b/src/Typecheck.hs @@ -82,7 +82,7 @@ typeCheckExpression (BinaryOperation op expr1 expr2) symtab classes = TypedExpression "int" (BinaryOperation op expr1' expr2') else error "Division operation requires two operands of type int" - Modulus -> + Modulo -> if type1 == "int" && type2 == "int" then TypedExpression "int" (BinaryOperation op expr1' expr2') From 666fb4ee1a1beed363102aae90401445aeca1aca Mon Sep 17 00:00:00 2001 From: Fabian Noll Date: Tue, 14 May 2024 10:04:00 +0200 Subject: [PATCH 37/98] Assignment now rakes expression instead of identifier --- src/Ast.hs | 2 +- src/Example.hs | 19 ++++++++++++++++--- src/Typecheck.hs | 19 +++++++++---------- 3 files changed, 26 insertions(+), 14 deletions(-) diff --git a/src/Ast.hs b/src/Ast.hs index 90dcc43..cce19aa 100644 --- a/src/Ast.hs +++ b/src/Ast.hs @@ -19,7 +19,7 @@ data Statement deriving (Show) data StatementExpression - = Assignment Identifier Expression + = Assignment Expression Expression | ConstructorCall DataType [Expression] | MethodCall Expression Identifier [Expression] | TypedStatementExpression DataType StatementExpression diff --git a/src/Example.hs b/src/Example.hs index 5c9cb51..e36c64d 100644 --- a/src/Example.hs +++ b/src/Example.hs @@ -49,7 +49,7 @@ exampleExpression :: Expression exampleExpression = BinaryOperation NameResolution (Reference "bob") (Reference "age") exampleAssignment :: Expression -exampleAssignment = StatementExpressionExpression (Assignment "a" (IntegerLiteral 30)) +exampleAssignment = StatementExpressionExpression (Assignment (Reference "a") (IntegerLiteral 30)) exampleMethodCall :: Statement exampleMethodCall = StatementExpressionStatement (MethodCall (Reference "this") "setAge" [IntegerLiteral 30]) @@ -80,7 +80,7 @@ exampleMethodCallAndAssignment = Block [ LocalVariableDeclaration (VariableDeclaration "int" "age" (Just (StatementExpressionExpression (MethodCall (Reference "bob") "getAge" [])))), StatementExpressionStatement (MethodCall (Reference "bob") "setAge" [IntegerLiteral 30]), LocalVariableDeclaration (VariableDeclaration "int" "a" Nothing), - StatementExpressionStatement (Assignment "a" (Reference "age")) + StatementExpressionStatement (Assignment (Reference "a") (Reference "age")) ] @@ -89,7 +89,13 @@ exampleMethodCallAndAssignmentFail = Block [ LocalVariableDeclaration (VariableDeclaration "Person" "bob" (Just (StatementExpressionExpression (ConstructorCall "Person" [IntegerLiteral 30])))), LocalVariableDeclaration (VariableDeclaration "int" "age" (Just (StatementExpressionExpression (MethodCall (Reference "bob") "getAge" [])))), StatementExpressionStatement (MethodCall (Reference "bob") "setAge" [IntegerLiteral 30]), - StatementExpressionStatement (Assignment "a" (Reference "age")) + StatementExpressionStatement (Assignment (Reference "age") (Reference "age")) + ] + +exampleNameResolutionAssignment :: Statement +exampleNameResolutionAssignment = Block [ + LocalVariableDeclaration (VariableDeclaration "Person" "bob" (Just (StatementExpressionExpression (ConstructorCall "Person" [IntegerLiteral 30])))), + StatementExpressionStatement (Assignment (BinaryOperation NameResolution (Reference "bob") (Reference "age")) (IntegerLiteral 30)) ] testClasses :: [Class] @@ -202,4 +208,11 @@ runTypeCheck = do printSuccess "Type checking of Program completed successfully" printResult "Typed Program:" typedProgram ) handleError + + catch (do + print "=====================================================================================" + typedAssignment <- evaluate (typeCheckStatement exampleNameResolutionAssignment [] sampleClasses) + printSuccess "Type checking of name resolution assignment completed successfully" + printResult "Result Name Resolution Assignment:" typedAssignment + ) handleError diff --git a/src/Typecheck.hs b/src/Typecheck.hs index 981d4d8..0346c5d 100644 --- a/src/Typecheck.hs +++ b/src/Typecheck.hs @@ -200,18 +200,17 @@ typeCheckExpression (StatementExpressionExpression stmtExpr) symtab classes = -- ********************************** Type Checking: StatementExpressions ********************************** typeCheckStatementExpression :: StatementExpression -> [(Identifier, DataType)] -> [Class] -> StatementExpression -typeCheckStatementExpression (Assignment id expr) symtab classes = +typeCheckStatementExpression (Assignment ref expr) symtab classes = let expr' = typeCheckExpression expr symtab classes + ref' = typeCheckExpression ref symtab classes type' = getTypeFromExpr expr' - maybeType'' = lookupType id symtab - in case maybeType'' of - Just type'' -> - if type' == type'' then - TypedStatementExpression type' (Assignment id expr') - else - error $ "Assignment type mismatch: expected " ++ type'' ++ ", found " ++ type' - Nothing -> error $ "Identifier '" ++ id ++ "' not found in symbol table" - + type'' = getTypeFromExpr ref' + in + if type'' == type' then + TypedStatementExpression type' (Assignment ref' expr') + else + error $ "Type mismatch in assignment to variable: expected " ++ type'' ++ ", found " ++ type' + typeCheckStatementExpression (ConstructorCall className args) symtab classes = case find (\(Class name _ _) -> name == className) classes of Nothing -> error $ "Class '" ++ className ++ "' not found." From 64829c2086cce87e2b66ac66174aa9b3eefd4dd1 Mon Sep 17 00:00:00 2001 From: Marvin Schlegel Date: Tue, 14 May 2024 10:16:56 +0200 Subject: [PATCH 38/98] replace parseBlock with parseStatement --- Test/TestParser.hs | 26 +++++++++++++------------- src/Parser/JavaParser.y | 4 ++-- 2 files changed, 15 insertions(+), 15 deletions(-) diff --git a/Test/TestParser.hs b/Test/TestParser.hs index 5e8eec5..a9885ea 100644 --- a/Test/TestParser.hs +++ b/Test/TestParser.hs @@ -54,19 +54,19 @@ testClassWithConstructor = TestCase $ parse [CLASS,IDENTIFIER "WithConstructor",LBRACKET,IDENTIFIER "WithConstructor",LBRACE,RBRACE,LBRACKET,RBRACKET,RBRACKET] -testEmptyBlock = TestCase $ assertEqual "expect empty block" (Block []) $ parseBlock [LBRACKET,RBRACKET] +testEmptyBlock = TestCase $ assertEqual "expect empty block" [Block []] $ parseStatement [LBRACKET,RBRACKET] testBlockWithLocalVarDecl = TestCase $ - assertEqual "expect block with local var delcaration" (Block [LocalVariableDeclaration $ VariableDeclaration "int" "localvar" Nothing]) $ - parseBlock [LBRACKET,INT,IDENTIFIER "localvar",SEMICOLON,RBRACKET] + assertEqual "expect block with local var delcaration" [Block [LocalVariableDeclaration $ VariableDeclaration "int" "localvar" Nothing]] $ + parseStatement [LBRACKET,INT,IDENTIFIER "localvar",SEMICOLON,RBRACKET] testBlockWithMultipleLocalVarDecls = TestCase $ - assertEqual "expect block with multiple local var declarations" (Block [LocalVariableDeclaration $ VariableDeclaration "int" "var1" Nothing, LocalVariableDeclaration $ VariableDeclaration "boolean" "var2" Nothing]) $ - parseBlock [LBRACKET,INT,IDENTIFIER "var1",SEMICOLON,BOOLEAN,IDENTIFIER "var2",SEMICOLON,RBRACKET] + assertEqual "expect block with multiple local var declarations" [Block [LocalVariableDeclaration $ VariableDeclaration "int" "var1" Nothing, LocalVariableDeclaration $ VariableDeclaration "boolean" "var2" Nothing]] $ + parseStatement [LBRACKET,INT,IDENTIFIER "var1",SEMICOLON,BOOLEAN,IDENTIFIER "var2",SEMICOLON,RBRACKET] testNestedBlocks = TestCase $ - assertEqual "expect block with block inside" (Block [Block []]) $ - parseBlock [LBRACKET,LBRACKET,RBRACKET,RBRACKET] + assertEqual "expect block with block inside" [Block [Block []]] $ + parseStatement [LBRACKET,LBRACKET,RBRACKET,RBRACKET] testBlockWithEmptyStatement = TestCase $ - assertEqual "expect empty block" (Block []) $ - parseBlock [LBRACKET,SEMICOLON,SEMICOLON,RBRACKET] + assertEqual "expect empty block" [Block []] $ + parseStatement [LBRACKET,SEMICOLON,SEMICOLON,RBRACKET] testExpressionIntLiteral = TestCase $ assertEqual "expect IntLiteral" (IntegerLiteral 3) $ @@ -75,14 +75,14 @@ testFieldWithInitialization = TestCase $ assertEqual "expect Class with initialized field" [Class "WithInitField" [] [VariableDeclaration "int" "number" $ Just $ IntegerLiteral 3]] $ parse [CLASS,IDENTIFIER "WithInitField",LBRACKET,INT,IDENTIFIER "number",ASSIGN,INTEGERLITERAL 3,SEMICOLON,RBRACKET] testLocalBoolWithInitialization = TestCase $ - assertEqual "expect block with with initialized local var" (Block [LocalVariableDeclaration $ VariableDeclaration "boolean" "b" $ Just $ BooleanLiteral False]) $ - parseBlock [LBRACKET,BOOLEAN,IDENTIFIER "b",ASSIGN,BOOLLITERAL False,SEMICOLON,RBRACKET] + assertEqual "expect block with with initialized local var" [Block [LocalVariableDeclaration $ VariableDeclaration "boolean" "b" $ Just $ BooleanLiteral False]] $ + parseStatement [LBRACKET,BOOLEAN,IDENTIFIER "b",ASSIGN,BOOLLITERAL False,SEMICOLON,RBRACKET] testFieldNullWithInitialization = TestCase $ assertEqual "expect Class with initialized field" [Class "WithInitField" [] [VariableDeclaration "Object" "bar" $ Just NullLiteral]] $ parse [CLASS,IDENTIFIER "WithInitField",LBRACKET,IDENTIFIER "Object",IDENTIFIER "bar",ASSIGN,NULLLITERAL,SEMICOLON,RBRACKET] testReturnVoid = TestCase $ - assertEqual "expect block with return nothing" (Block [Return Nothing]) $ - parseBlock [LBRACKET,RETURN,SEMICOLON,RBRACKET] + assertEqual "expect block with return nothing" [Block [Return Nothing]] $ + parseStatement [LBRACKET,RETURN,SEMICOLON,RBRACKET] testExpressionNot = TestCase $ assertEqual "expect expression not" (UnaryOperation Not (Reference "boar")) $ diff --git a/src/Parser/JavaParser.y b/src/Parser/JavaParser.y index 68be06c..49fbeb1 100644 --- a/src/Parser/JavaParser.y +++ b/src/Parser/JavaParser.y @@ -1,11 +1,11 @@ { -module Parser.JavaParser (parse, parseBlock, parseExpression) where +module Parser.JavaParser (parse, parseStatement, parseExpression) where import Ast import Parser.Lexer } %name parse -%name parseBlock block +%name parseStatement statement %name parseExpression expression %tokentype { Token } %error { parseError } From 09469e0e4541a7d59e690aa3ffe6ed79e02b86da Mon Sep 17 00:00:00 2001 From: mrab Date: Tue, 14 May 2024 10:28:57 +0200 Subject: [PATCH 39/98] added boolean expression assembly --- src/ByteCode/ClassFile.hs | 34 ++++++++++++++++++++++++++++- src/ByteCode/ClassFile/Generator.hs | 34 ++++++++++++++++++++++------- src/Main.hs | 2 +- 3 files changed, 60 insertions(+), 10 deletions(-) diff --git a/src/ByteCode/ClassFile.hs b/src/ByteCode/ClassFile.hs index bdae918..a27be11 100644 --- a/src/ByteCode/ClassFile.hs +++ b/src/ByteCode/ClassFile.hs @@ -5,7 +5,8 @@ module ByteCode.ClassFile( ClassFile(..), Operation(..), serialize, - emptyClassFile + emptyClassFile, + opcodeEncodingLength ) where import Data.Word @@ -41,6 +42,7 @@ data Operation = Opiadd | Opreturn | Opireturn | Opareturn + | Opgoto Word16 | Opsipush Word16 | Opldc_w Word16 | Opaload Word16 @@ -87,6 +89,35 @@ emptyClassFile = ClassFile { attributes = [] } +opcodeEncodingLength :: Operation -> Word16 +opcodeEncodingLength Opiadd = 1 +opcodeEncodingLength Opisub = 1 +opcodeEncodingLength Opimul = 1 +opcodeEncodingLength Opidiv = 1 +opcodeEncodingLength Opiand = 1 +opcodeEncodingLength Opior = 1 +opcodeEncodingLength Opixor = 1 +opcodeEncodingLength Opineg = 1 +opcodeEncodingLength (Opif_icmplt _) = 3 +opcodeEncodingLength (Opif_icmple _) = 3 +opcodeEncodingLength (Opif_icmpgt _) = 3 +opcodeEncodingLength (Opif_icmpge _) = 3 +opcodeEncodingLength (Opif_icmpeq _) = 3 +opcodeEncodingLength (Opif_icmpne _) = 3 +opcodeEncodingLength Opaconst_null = 1 +opcodeEncodingLength Opreturn = 1 +opcodeEncodingLength Opireturn = 1 +opcodeEncodingLength Opareturn = 1 +opcodeEncodingLength (Opgoto _) = 3 +opcodeEncodingLength (Opsipush _) = 3 +opcodeEncodingLength (Opldc_w _) = 3 +opcodeEncodingLength (Opaload _) = 3 +opcodeEncodingLength (Opiload _) = 3 +opcodeEncodingLength (Opastore _) = 3 +opcodeEncodingLength (Opistore _) = 3 +opcodeEncodingLength (Opputfield _) = 3 +opcodeEncodingLength (OpgetField _) = 3 + class Serializable a where serialize :: a -> [Word8] @@ -126,6 +157,7 @@ instance Serializable Operation where serialize Opreturn = [0xB1] serialize Opireturn = [0xAC] serialize Opareturn = [0xB0] + serialize (Opgoto index) = 0xA7 : unpackWord16 index serialize (Opsipush index) = 0x11 : unpackWord16 index serialize (Opldc_w index) = 0x13 : unpackWord16 index serialize (Opaload index) = [0xC4, 0x19] ++ unpackWord16 index diff --git a/src/ByteCode/ClassFile/Generator.hs b/src/ByteCode/ClassFile/Generator.hs index a80c081..8f7287a 100644 --- a/src/ByteCode/ClassFile/Generator.hs +++ b/src/ByteCode/ClassFile/Generator.hs @@ -10,10 +10,11 @@ module ByteCode.ClassFile.Generator( ) where import ByteCode.Constants -import ByteCode.ClassFile (ClassFile (..), ConstantInfo (..), MemberInfo(..), Operation(..), Attribute(..)) +import ByteCode.ClassFile (ClassFile (..), ConstantInfo (..), MemberInfo(..), Operation(..), Attribute(..), opcodeEncodingLength) import Ast import Data.Char import Data.List +import Data.Word type ClassFileBuilder a = a -> ClassFile -> ClassFile @@ -176,13 +177,22 @@ returnOperation dtype | otherwise = Opareturn binaryOperation :: BinaryOperator -> Operation -binaryOperation Addition = Opiadd -binaryOperation Subtraction = Opisub -binaryOperation Multiplication = Opimul -binaryOperation Division = Opidiv -binaryOperation BitwiseAnd = Opiand -binaryOperation BitwiseOr = Opior -binaryOperation BitwiseXor = Opixor +binaryOperation Addition = Opiadd +binaryOperation Subtraction = Opisub +binaryOperation Multiplication = Opimul +binaryOperation Division = Opidiv +binaryOperation BitwiseAnd = Opiand +binaryOperation BitwiseOr = Opior +binaryOperation BitwiseXor = Opixor + +comparisonOperation :: BinaryOperator -> Word16 -> Operation +comparisonOperation CompareEqual branchLocation = Opif_icmpeq branchLocation +comparisonOperation CompareNotEqual branchLocation = Opif_icmpne branchLocation +comparisonOperation CompareLessThan branchLocation = Opif_icmplt branchLocation +comparisonOperation CompareLessOrEqual branchLocation = Opif_icmple branchLocation +comparisonOperation CompareGreaterThan branchLocation = Opif_icmpgt branchLocation +comparisonOperation CompareGreaterOrEqual branchLocation = Opif_icmpge branchLocation + assembleMethod :: Assembler MethodDeclaration assembleMethod (MethodDeclaration _ _ _ (Block statements)) (constants, ops) = @@ -203,6 +213,14 @@ assembleExpression (TypedExpression _ (BinaryOperation op a b)) (constants, ops) (bConstants, bOps) = assembleExpression b (aConstants, aOps) in (bConstants, bOps ++ [binaryOperation op]) + | elem op [CompareEqual, CompareNotEqual, CompareLessThan, CompareLessOrEqual, CompareGreaterThan, CompareGreaterOrEqual] = let + (aConstants, aOps) = assembleExpression a (constants, ops) + (bConstants, bOps) = assembleExpression b (aConstants, aOps) + current_offset = sum (map opcodeEncodingLength bOps) + cmp_op = comparisonOperation op (fromIntegral (current_offset + 10)) + cmp_ops = [cmp_op, Opsipush 1, Opgoto (fromIntegral (current_offset + 13)), Opsipush 0] + in + (bConstants, bOps ++ cmp_ops) assembleExpression (TypedExpression _ (CharacterLiteral literal)) (constants, ops) = (constants, ops ++ [Opsipush (fromIntegral (ord literal))]) assembleExpression (TypedExpression _ (BooleanLiteral literal)) (constants, ops) = diff --git a/src/Main.hs b/src/Main.hs index 5ad66c4..130ed20 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -9,7 +9,7 @@ import ByteCode.ClassFile import Data.ByteString (pack, writeFile) main = do - let untypedAST = parse $ alexScanTokens "class Testklasse {int a; int b; void something(){} void something_else(){} Testklasse(){}}" + let untypedAST = parse $ alexScanTokens "class Testklasse {int a; int b; void something(){} void something_else(){}}" let typedAST = head (typeCheckCompilationUnit untypedAST) let abstractClassFile = classBuilder typedAST emptyClassFile let assembledClassFile = pack (serialize abstractClassFile) From 86e15b58567da3aebdf152f61c68bb82caa6914c Mon Sep 17 00:00:00 2001 From: mrab Date: Tue, 14 May 2024 11:12:12 +0200 Subject: [PATCH 40/98] method assembly is actually used (yay) --- src/ByteCode/ClassFile/Generator.hs | 39 +++++++++++++++++------------ src/Main.hs | 2 +- 2 files changed, 24 insertions(+), 17 deletions(-) diff --git a/src/ByteCode/ClassFile/Generator.hs b/src/ByteCode/ClassFile/Generator.hs index 8f7287a..a482f16 100644 --- a/src/ByteCode/ClassFile/Generator.hs +++ b/src/ByteCode/ClassFile/Generator.hs @@ -140,13 +140,7 @@ methodBuilder (MethodDeclaration returntype name parameters statement) input = l memberAccessFlags = accessPublic, memberNameIndex = (fromIntegral baseIndex), memberDescriptorIndex = (fromIntegral (baseIndex + 1)), - memberAttributes = [ - CodeAttribute { - attributeMaxStack = 420, - attributeMaxLocals = 420, - attributeCode = [Opreturn] - } - ] + memberAttributes = [] } in input { @@ -157,14 +151,26 @@ methodBuilder (MethodDeclaration returntype name parameters statement) input = l methodAssembler :: ClassFileBuilder MethodDeclaration methodAssembler (MethodDeclaration returntype name parameters statement) input = let - code = CodeAttribute { - attributeMaxStack = 420, - attributeMaxLocals = 420, - attributeCode = [Opiadd] - } - --methodConstantIndex = - in - input + methodConstantIndex = findMethodIndex input name + in case methodConstantIndex of + Nothing -> error ("Cannot find method entry in method pool for method: " ++ name) + Just index -> let + declaration = MethodDeclaration returntype name parameters statement + (pre, method : post) = splitAt index (methods input) + (_, bytecode) = assembleMethod declaration (constantPool input, []) + assembledMethod = method { + memberAttributes = [ + CodeAttribute { + attributeMaxStack = 420, + attributeMaxLocals = 420, + attributeCode = bytecode + } + ] + } + in + input { + methods = pre ++ (assembledMethod : post) + } @@ -195,8 +201,9 @@ comparisonOperation CompareGreaterOrEqual branchLocation = Opif_icmpge branchLoc assembleMethod :: Assembler MethodDeclaration -assembleMethod (MethodDeclaration _ _ _ (Block statements)) (constants, ops) = +assembleMethod (MethodDeclaration _ _ _ (TypedStatement _ (Block statements))) (constants, ops) = foldr assembleStatement (constants, ops) statements +assembleMethod (MethodDeclaration _ _ _ stmt) (_, _) = error ("Block expected for method body, got: " ++ show stmt) assembleStatement :: Assembler Statement assembleStatement (TypedStatement stype (Return expr)) (constants, ops) = case expr of diff --git a/src/Main.hs b/src/Main.hs index 130ed20..c2ffd1b 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -9,7 +9,7 @@ import ByteCode.ClassFile import Data.ByteString (pack, writeFile) main = do - let untypedAST = parse $ alexScanTokens "class Testklasse {int a; int b; void something(){} void something_else(){}}" + let untypedAST = parse $ alexScanTokens "class Testklasse {void something(){return;}}" let typedAST = head (typeCheckCompilationUnit untypedAST) let abstractClassFile = classBuilder typedAST emptyClassFile let assembledClassFile = pack (serialize abstractClassFile) From 3fa97361725eb974e0decca41a07e8438951d5ed Mon Sep 17 00:00:00 2001 From: Fabian Noll Date: Tue, 14 May 2024 11:19:26 +0200 Subject: [PATCH 41/98] add post and pre operations --- src/Ast.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/Ast.hs b/src/Ast.hs index cce19aa..7f60c8e 100644 --- a/src/Ast.hs +++ b/src/Ast.hs @@ -48,6 +48,10 @@ data BinaryOperator data UnaryOperator = Not | Minus + | PostIncrement + | PostDecrement + | PreIncrement + | PreDecrement deriving (Show) data Expression From fae3498bd99460fb77710d58cf9666273b55c793 Mon Sep 17 00:00:00 2001 From: Fabian Noll Date: Tue, 14 May 2024 11:21:06 +0200 Subject: [PATCH 42/98] Refactor BinaryOperations and add char operations --- src/Example.hs | 10 ++ src/Typecheck.hs | 232 +++++++++++++++++++++++------------------------ 2 files changed, 123 insertions(+), 119 deletions(-) diff --git a/src/Example.hs b/src/Example.hs index e36c64d..28cf40c 100644 --- a/src/Example.hs +++ b/src/Example.hs @@ -98,6 +98,9 @@ exampleNameResolutionAssignment = Block [ StatementExpressionStatement (Assignment (BinaryOperation NameResolution (Reference "bob") (Reference "age")) (IntegerLiteral 30)) ] +exampleCharIntOperation :: Expression +exampleCharIntOperation = BinaryOperation Addition (CharacterLiteral 'a') (IntegerLiteral 1) + testClasses :: [Class] testClasses = [ Class "Person" [ @@ -216,3 +219,10 @@ runTypeCheck = do printResult "Result Name Resolution Assignment:" typedAssignment ) handleError + catch (do + print "=====================================================================================" + evaluatedCharIntOperation <- evaluate (typeCheckExpression exampleCharIntOperation [] sampleClasses) + printSuccess "Type checking of char int operation completed successfully" + printResult "Result Char Int Operation:" evaluatedCharIntOperation + ) handleError + diff --git a/src/Typecheck.hs b/src/Typecheck.hs index 0346c5d..34a3b1f 100644 --- a/src/Typecheck.hs +++ b/src/Typecheck.hs @@ -52,129 +52,31 @@ typeCheckExpression (Reference id) symtab classes = _ -> error $ "Ambiguous reference to field '" ++ id ++ "' in class '" ++ className ++ "'" Nothing -> error $ "Class '" ++ className ++ "' not found for 'this'" Nothing -> error $ "Context for 'this' not found in symbol table, unable to resolve '" ++ id ++ "'" + typeCheckExpression (BinaryOperation op expr1 expr2) symtab classes = let expr1' = typeCheckExpression expr1 symtab classes expr2' = typeCheckExpression expr2 symtab classes type1 = getTypeFromExpr expr1' type2 = getTypeFromExpr expr2' + resultType = resolveResultType type1 type2 in case op of - Addition -> - if type1 == "int" && type2 == "int" - then - TypedExpression "int" (BinaryOperation op expr1' expr2') - else - error "Addition operation requires two operands of type int" - Subtraction -> - if type1 == "int" && type2 == "int" - then - TypedExpression "int" (BinaryOperation op expr1' expr2') - else - error "Subtraction operation requires two operands of type int" - Multiplication -> - if type1 == "int" && type2 == "int" - then - TypedExpression "int" (BinaryOperation op expr1' expr2') - else - error "Multiplication operation requires two operands of type int" - Division -> - if type1 == "int" && type2 == "int" - then - TypedExpression "int" (BinaryOperation op expr1' expr2') - else - error "Division operation requires two operands of type int" - Modulo -> - if type1 == "int" && type2 == "int" - then - TypedExpression "int" (BinaryOperation op expr1' expr2') - else - error "Modulus operation requires two operands of type int" - BitwiseAnd -> - if type1 == "int" && type2 == "int" - then - TypedExpression "int" (BinaryOperation op expr1' expr2') - else - error "Bitwise AND operation requires two operands of type int" - BitwiseOr -> - if type1 == "int" && type2 == "int" - then - TypedExpression "int" (BinaryOperation op expr1' expr2') - else - error "Bitwise OR operation requires two operands of type int" - BitwiseXor -> - if type1 == "int" && type2 == "int" - then - TypedExpression "int" (BinaryOperation op expr1' expr2') - else - error "Bitwise XOR operation requires two operands of type int" - CompareLessThan -> - if type1 == "int" && type2 == "int" - then - TypedExpression "boolean" (BinaryOperation op expr1' expr2') - else - error "Less than operation requires two operands of type int" - CompareLessOrEqual -> - if type1 == "int" && type2 == "int" - then - TypedExpression "boolean" (BinaryOperation op expr1' expr2') - else - error "Less than or equal operation requires two operands of type int" - CompareGreaterThan -> - if type1 == "int" && type2 == "int" - then - TypedExpression "boolean" (BinaryOperation op expr1' expr2') - else - error "Greater than operation requires two operands of type int" - CompareGreaterOrEqual -> - if type1 == "int" && type2 == "int" - then - TypedExpression "boolean" (BinaryOperation op expr1' expr2') - else - error "Greater than or equal operation requires two operands of type int" - CompareEqual -> - if type1 == type2 - then - TypedExpression "boolean" (BinaryOperation op expr1' expr2') - else - error "Equality operation requires two operands of the same type" - CompareNotEqual -> - if type1 == type2 - then - TypedExpression "boolean" (BinaryOperation op expr1' expr2') - else - error "Inequality operation requires two operands of the same type" - And -> - if type1 == "boolean" && type2 == "boolean" - then - TypedExpression "boolean" (BinaryOperation op expr1' expr2') - else - error "Logical AND operation requires two operands of type boolean" - Or -> - if type1 == "boolean" && type2 == "boolean" - then - TypedExpression "boolean" (BinaryOperation op expr1' expr2') - else - error "Logical OR operation requires two operands of type boolean" - NameResolution -> - case (expr1', expr2) of - (TypedExpression objType (LocalVariable ident), Reference ident2) -> - case find (\(Class className _ _) -> className == objType) classes of - Just (Class _ _ fields) -> - let fieldTypes = [dt | VariableDeclaration dt id _ <- fields, id == ident2] - in case fieldTypes of - [resolvedType] -> TypedExpression resolvedType (BinaryOperation NameResolution expr1' (TypedExpression resolvedType (FieldVariable ident2))) - [] -> error $ "Field '" ++ ident2 ++ "' not found in class '" ++ objType ++ "'" - _ -> error $ "Ambiguous reference to field '" ++ ident ++ "' in class '" ++ objType ++ "'" - Nothing -> error $ "Class '" ++ objType ++ "' not found" - (TypedExpression objType (FieldVariable ident), Reference ident2) -> - case find (\(Class className _ _) -> className == objType) classes of - Just (Class _ _ fields) -> - let fieldTypes = [dt | VariableDeclaration dt id _ <- fields, id == ident2] - in case fieldTypes of - [resolvedType] -> TypedExpression resolvedType (BinaryOperation NameResolution expr1' (TypedExpression resolvedType (FieldVariable ident2))) - [] -> error $ "Field '" ++ ident2 ++ "' not found in class '" ++ objType ++ "'" - _ -> error $ "Ambiguous reference to field '" ++ ident ++ "' in class '" ++ objType ++ "'" - Nothing -> error $ "Class '" ++ objType ++ "' not found" - _ -> error "Name resolution requires object reference and field name" + Addition -> checkArithmeticOperation op expr1' expr2' type1 type2 resultType + Subtraction -> checkArithmeticOperation op expr1' expr2' type1 type2 resultType + Multiplication -> checkArithmeticOperation op expr1' expr2' type1 type2 resultType + Division -> checkArithmeticOperation op expr1' expr2' type1 type2 resultType + Modulo -> checkArithmeticOperation op expr1' expr2' type1 type2 resultType + BitwiseAnd -> checkBitwiseOperation op expr1' expr2' type1 type2 + BitwiseOr -> checkBitwiseOperation op expr1' expr2' type1 type2 + BitwiseXor -> checkBitwiseOperation op expr1' expr2' type1 type2 + CompareLessThan -> checkComparisonOperation op expr1' expr2' type1 type2 + CompareLessOrEqual -> checkComparisonOperation op expr1' expr2' type1 type2 + CompareGreaterThan -> checkComparisonOperation op expr1' expr2' type1 type2 + CompareGreaterOrEqual -> checkComparisonOperation op expr1' expr2' type1 type2 + CompareEqual -> checkEqualityOperation op expr1' expr2' type1 type2 + CompareNotEqual -> checkEqualityOperation op expr1' expr2' type1 type2 + And -> checkLogicalOperation op expr1' expr2' type1 type2 + Or -> checkLogicalOperation op expr1' expr2' type1 type2 + NameResolution -> resolveNameResolution expr1' expr2 symtab classes typeCheckExpression (UnaryOperation op expr) symtab classes = let expr' = typeCheckExpression expr symtab classes @@ -187,11 +89,50 @@ typeCheckExpression (UnaryOperation op expr) symtab classes = else error "Logical NOT operation requires an operand of type boolean" Minus -> + if type' == "int" + then + 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 "Unary minus operation requires an operand of type int" + 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 @@ -329,7 +270,7 @@ typeCheckStatement (Return expr) symtab classes = Nothing -> Nothing in case expr' of Just e' -> TypedStatement (getTypeFromExpr e') (Return (Just e')) - Nothing -> TypedStatement "Void" (Return Nothing) + Nothing -> TypedStatement "void" (Return Nothing) typeCheckStatement (StatementExpressionStatement stmtExpr) symtab classes = let stmtExpr' = typeCheckStatementExpression stmtExpr symtab classes @@ -359,3 +300,56 @@ lookupType id symtab = case lookup id symtab of Just t -> Just t Nothing -> Nothing + +resolveResultType :: DataType -> DataType -> DataType +resolveResultType "char" "char" = "char" +resolveResultType "int" "int" = "int" +resolveResultType "char" "int" = "int" +resolveResultType "int" "char" = "int" +resolveResultType t1 t2 + | t1 == t2 = t1 + | otherwise = error $ "Incompatible types: " ++ t1 ++ " and " ++ t2 + +checkArithmeticOperation :: BinaryOperator -> Expression -> Expression -> DataType -> DataType -> DataType -> Expression +checkArithmeticOperation op expr1' expr2' type1 type2 resultType + | (type1 == "int" || type1 == "char") && (type2 == "int" || type2 == "char") = + TypedExpression resultType (BinaryOperation op expr1' expr2') + | otherwise = error $ "Arithmetic operation " ++ show op ++ " requires operands of type int or char" + +checkBitwiseOperation :: BinaryOperator -> Expression -> Expression -> DataType -> DataType -> Expression +checkBitwiseOperation op expr1' expr2' type1 type2 + | type1 == "int" && type2 == "int" = + TypedExpression "int" (BinaryOperation op expr1' expr2') + | otherwise = error $ "Bitwise operation " ++ show op ++ " requires operands of type int" + +checkComparisonOperation :: BinaryOperator -> Expression -> Expression -> DataType -> DataType -> Expression +checkComparisonOperation op expr1' expr2' type1 type2 + | (type1 == "int" || type1 == "char") && (type2 == "int" || type2 == "char") = + TypedExpression "boolean" (BinaryOperation op expr1' expr2') + | otherwise = error $ "Comparison operation " ++ show op ++ " requires operands of type int or char" + +checkEqualityOperation :: BinaryOperator -> Expression -> Expression -> DataType -> DataType -> Expression +checkEqualityOperation op expr1' expr2' type1 type2 + | type1 == type2 = + TypedExpression "boolean" (BinaryOperation op expr1' expr2') + | otherwise = error $ "Equality operation " ++ show op ++ " requires operands of the same type" + +checkLogicalOperation :: BinaryOperator -> Expression -> Expression -> DataType -> DataType -> Expression +checkLogicalOperation op expr1' expr2' type1 type2 + | type1 == "boolean" && type2 == "boolean" = + TypedExpression "boolean" (BinaryOperation op expr1' expr2') + | otherwise = error $ "Logical operation " ++ show op ++ " requires operands of type boolean" + +resolveNameResolution :: Expression -> Expression -> [(Identifier, DataType)] -> [Class] -> Expression +resolveNameResolution expr1' (Reference ident2) symtab classes = + case getTypeFromExpr expr1' of + objType -> + case find (\(Class className _ _) -> className == objType) classes of + Just (Class _ _ fields) -> + let fieldTypes = [dt | VariableDeclaration dt id _ <- fields, id == ident2] + in case fieldTypes of + [resolvedType] -> TypedExpression resolvedType (BinaryOperation NameResolution expr1' (TypedExpression resolvedType (FieldVariable ident2))) + [] -> error $ "Field '" ++ ident2 ++ "' not found in class '" ++ objType ++ "'" + _ -> error $ "Ambiguous reference to field '" ++ ident2 ++ "' in class '" ++ objType ++ "'" + Nothing -> error $ "Class '" ++ objType ++ "' not found" +resolveNameResolution _ _ _ _ = error "Name resolution requires object reference and field name" From f8b0b59c5d9c67bcec9f94e5bc875d193c4275cf Mon Sep 17 00:00:00 2001 From: Fabian Noll Date: Tue, 14 May 2024 11:26:27 +0200 Subject: [PATCH 43/98] refactor unused function --- src/Example.hs | 2 +- src/Typecheck.hs | 16 +++++----------- 2 files changed, 6 insertions(+), 12 deletions(-) diff --git a/src/Example.hs b/src/Example.hs index 28cf40c..db4213f 100644 --- a/src/Example.hs +++ b/src/Example.hs @@ -89,7 +89,7 @@ exampleMethodCallAndAssignmentFail = Block [ LocalVariableDeclaration (VariableDeclaration "Person" "bob" (Just (StatementExpressionExpression (ConstructorCall "Person" [IntegerLiteral 30])))), LocalVariableDeclaration (VariableDeclaration "int" "age" (Just (StatementExpressionExpression (MethodCall (Reference "bob") "getAge" [])))), StatementExpressionStatement (MethodCall (Reference "bob") "setAge" [IntegerLiteral 30]), - StatementExpressionStatement (Assignment (Reference "age") (Reference "age")) + StatementExpressionStatement (Assignment (Reference "a") (Reference "age")) ] exampleNameResolutionAssignment :: Statement diff --git a/src/Typecheck.hs b/src/Typecheck.hs index 34a3b1f..0032d46 100644 --- a/src/Typecheck.hs +++ b/src/Typecheck.hs @@ -52,7 +52,7 @@ typeCheckExpression (Reference id) symtab classes = _ -> error $ "Ambiguous reference to field '" ++ id ++ "' in class '" ++ className ++ "'" Nothing -> error $ "Class '" ++ className ++ "' not found for 'this'" Nothing -> error $ "Context for 'this' not found in symbol table, unable to resolve '" ++ id ++ "'" - + typeCheckExpression (BinaryOperation op expr1 expr2) symtab classes = let expr1' = typeCheckExpression expr1 symtab classes expr2' = typeCheckExpression expr2 symtab classes @@ -89,10 +89,10 @@ typeCheckExpression (UnaryOperation op expr) symtab classes = else error "Logical NOT operation requires an operand of type boolean" Minus -> - if type' == "int" + if type' == "int" then TypedExpression "int" (UnaryOperation op expr') - else if type' == "char" + else if type' == "char" then TypedExpression "char" (UnaryOperation op expr') else @@ -147,11 +147,11 @@ typeCheckStatementExpression (Assignment ref expr) symtab classes = type' = getTypeFromExpr expr' type'' = getTypeFromExpr ref' in - if type'' == type' then + if type'' == type' then TypedStatementExpression type' (Assignment ref' expr') else error $ "Type mismatch in assignment to variable: expected " ++ type'' ++ ", found " ++ type' - + typeCheckStatementExpression (ConstructorCall className args) symtab classes = case find (\(Class name _ _) -> name == className) classes of Nothing -> error $ "Class '" ++ className ++ "' not found." @@ -295,12 +295,6 @@ unifyReturnTypes dt1 dt2 | dt1 == dt2 = dt1 | otherwise = "Object" -lookupType :: Identifier -> [(Identifier, DataType)] -> Maybe DataType -lookupType id symtab = - case lookup id symtab of - Just t -> Just t - Nothing -> Nothing - resolveResultType :: DataType -> DataType -> DataType resolveResultType "char" "char" = "char" resolveResultType "int" "int" = "int" From 7ba9743b0a7ccc2ac7144ce00d615c0b4a5db6d2 Mon Sep 17 00:00:00 2001 From: Marvin Schlegel Date: Tue, 14 May 2024 11:34:57 +0200 Subject: [PATCH 44/98] parser add increment decrement --- Test/TestParser.hs | 18 +++++++++++++++++- src/Parser/JavaParser.y | 16 ++++++++-------- 2 files changed, 25 insertions(+), 9 deletions(-) diff --git a/Test/TestParser.hs b/Test/TestParser.hs index a9885ea..d85b9f5 100644 --- a/Test/TestParser.hs +++ b/Test/TestParser.hs @@ -132,6 +132,18 @@ testExpressionXor = TestCase $ testExpressionOr = TestCase $ assertEqual "expect or expression" (BinaryOperation Or (Reference "bar") (Reference "baz")) $ parseExpression [IDENTIFIER "bar",OR,IDENTIFIER "baz"] +testExpressionPostIncrement = TestCase $ + assertEqual "expect PostIncrement" (UnaryOperation PostIncrement (Reference "a")) $ + parseExpression [IDENTIFIER "a",INCREMENT] +testExpressionPostDecrement = TestCase $ + assertEqual "expect PostDecrement" (UnaryOperation PostDecrement (Reference "a")) $ + parseExpression [IDENTIFIER "a",DECREMENT] +testExpressionPreIncrement = TestCase $ + assertEqual "expect PreIncrement" (UnaryOperation PreIncrement (Reference "a")) $ + parseExpression [INCREMENT,IDENTIFIER "a"] +testExpressionPreDecrement = TestCase $ + assertEqual "expect PreIncrement" (UnaryOperation PreDecrement (Reference "a")) $ + parseExpression [DECREMENT,IDENTIFIER "a"] tests = TestList [ @@ -169,5 +181,9 @@ tests = TestList [ testExpressionNotEqual, testExpressionAnd, testExpressionXor, - testExpressionOr + testExpressionOr, + testExpressionPostIncrement, + testExpressionPostDecrement, + testExpressionPreIncrement, + testExpressionPreDecrement ] \ No newline at end of file diff --git a/src/Parser/JavaParser.y b/src/Parser/JavaParser.y index 49fbeb1..53828ea 100644 --- a/src/Parser/JavaParser.y +++ b/src/Parser/JavaParser.y @@ -275,13 +275,13 @@ assignmentoperator : ASSIGN{ } -- | XOREQUAL { } -- | OREQUAL{ } -preincrementexpression : INCREMENT unaryexpression { } +preincrementexpression : INCREMENT unaryexpression { UnaryOperation PreIncrement $2 } -predecrementexpression : DECREMENT unaryexpression { } +predecrementexpression : DECREMENT unaryexpression { UnaryOperation PreDecrement $2 } -postincrementexpression : postfixexpression INCREMENT { } +postincrementexpression : postfixexpression INCREMENT { UnaryOperation PostIncrement $1 } -postdecrementexpression : postfixexpression DECREMENT { } +postdecrementexpression : postfixexpression DECREMENT { UnaryOperation PostDecrement $1 } methodinvocation : name LBRACE RBRACE { } | name LBRACE argumentlist RBRACE { } @@ -296,15 +296,15 @@ conditionalandexpression : inclusiveorexpression { $1 } fieldaccess : primary DOT IDENTIFIER { } unaryexpression : unaryexpressionnotplusminus { $1 } - -- | predecrementexpression { } + | predecrementexpression { $1 } | PLUS unaryexpression { $2 } | MINUS unaryexpression { UnaryOperation Minus $2 } - -- | preincrementexpression { $1 } + | preincrementexpression { $1 } postfixexpression : primary { $1 } | name { Reference $1 } - -- | postincrementexpression { } - -- | postdecrementexpression{ } + | postincrementexpression { $1 } + | postdecrementexpression{ $1 } primary : primarynonewarray { $1 } From d1d9a5d6e1f44b24972b3004e4ef2eb46e32daca Mon Sep 17 00:00:00 2001 From: mrab Date: Tue, 14 May 2024 12:29:55 +0200 Subject: [PATCH 45/98] constructor and method call using this --- src/ByteCode/ClassFile.hs | 111 ++++++++++++++-------------- src/ByteCode/ClassFile/Generator.hs | 18 +++-- src/Main.hs | 2 +- src/Typecheck.hs | 2 +- 4 files changed, 72 insertions(+), 61 deletions(-) diff --git a/src/ByteCode/ClassFile.hs b/src/ByteCode/ClassFile.hs index a27be11..7798cf8 100644 --- a/src/ByteCode/ClassFile.hs +++ b/src/ByteCode/ClassFile.hs @@ -42,6 +42,7 @@ data Operation = Opiadd | Opreturn | Opireturn | Opareturn + | Opinvokespecial Word16 | Opgoto Word16 | Opsipush Word16 | Opldc_w Word16 @@ -90,33 +91,34 @@ emptyClassFile = ClassFile { } opcodeEncodingLength :: Operation -> Word16 -opcodeEncodingLength Opiadd = 1 -opcodeEncodingLength Opisub = 1 -opcodeEncodingLength Opimul = 1 -opcodeEncodingLength Opidiv = 1 -opcodeEncodingLength Opiand = 1 -opcodeEncodingLength Opior = 1 -opcodeEncodingLength Opixor = 1 -opcodeEncodingLength Opineg = 1 -opcodeEncodingLength (Opif_icmplt _) = 3 -opcodeEncodingLength (Opif_icmple _) = 3 -opcodeEncodingLength (Opif_icmpgt _) = 3 -opcodeEncodingLength (Opif_icmpge _) = 3 -opcodeEncodingLength (Opif_icmpeq _) = 3 -opcodeEncodingLength (Opif_icmpne _) = 3 -opcodeEncodingLength Opaconst_null = 1 -opcodeEncodingLength Opreturn = 1 -opcodeEncodingLength Opireturn = 1 -opcodeEncodingLength Opareturn = 1 -opcodeEncodingLength (Opgoto _) = 3 -opcodeEncodingLength (Opsipush _) = 3 -opcodeEncodingLength (Opldc_w _) = 3 -opcodeEncodingLength (Opaload _) = 3 -opcodeEncodingLength (Opiload _) = 3 -opcodeEncodingLength (Opastore _) = 3 -opcodeEncodingLength (Opistore _) = 3 -opcodeEncodingLength (Opputfield _) = 3 -opcodeEncodingLength (OpgetField _) = 3 +opcodeEncodingLength Opiadd = 1 +opcodeEncodingLength Opisub = 1 +opcodeEncodingLength Opimul = 1 +opcodeEncodingLength Opidiv = 1 +opcodeEncodingLength Opiand = 1 +opcodeEncodingLength Opior = 1 +opcodeEncodingLength Opixor = 1 +opcodeEncodingLength Opineg = 1 +opcodeEncodingLength (Opif_icmplt _) = 3 +opcodeEncodingLength (Opif_icmple _) = 3 +opcodeEncodingLength (Opif_icmpgt _) = 3 +opcodeEncodingLength (Opif_icmpge _) = 3 +opcodeEncodingLength (Opif_icmpeq _) = 3 +opcodeEncodingLength (Opif_icmpne _) = 3 +opcodeEncodingLength Opaconst_null = 1 +opcodeEncodingLength Opreturn = 1 +opcodeEncodingLength Opireturn = 1 +opcodeEncodingLength Opareturn = 1 +opcodeEncodingLength (Opinvokespecial _) = 3 +opcodeEncodingLength (Opgoto _) = 3 +opcodeEncodingLength (Opsipush _) = 3 +opcodeEncodingLength (Opldc_w _) = 3 +opcodeEncodingLength (Opaload _) = 3 +opcodeEncodingLength (Opiload _) = 3 +opcodeEncodingLength (Opastore _) = 3 +opcodeEncodingLength (Opistore _) = 3 +opcodeEncodingLength (Opputfield _) = 3 +opcodeEncodingLength (OpgetField _) = 3 class Serializable a where serialize :: a -> [Word8] @@ -139,33 +141,34 @@ instance Serializable MemberInfo where ++ concatMap serialize (memberAttributes member) instance Serializable Operation where - serialize Opiadd = [0x60] - serialize Opisub = [0x64] - serialize Opimul = [0x68] - serialize Opidiv = [0x6C] - serialize Opiand = [0x7E] - serialize Opior = [0x80] - serialize Opixor = [0x82] - serialize Opineg = [0x74] - serialize (Opif_icmplt branch) = 0xA1 : unpackWord16 branch - serialize (Opif_icmple branch) = 0xA4 : unpackWord16 branch - serialize (Opif_icmpgt branch) = 0xA3 : unpackWord16 branch - serialize (Opif_icmpge branch) = 0xA2 : unpackWord16 branch - serialize (Opif_icmpeq branch) = 0x9F : unpackWord16 branch - serialize (Opif_icmpne branch) = 0xA0 : unpackWord16 branch - serialize Opaconst_null = [0x01] - serialize Opreturn = [0xB1] - serialize Opireturn = [0xAC] - serialize Opareturn = [0xB0] - serialize (Opgoto index) = 0xA7 : unpackWord16 index - serialize (Opsipush index) = 0x11 : unpackWord16 index - serialize (Opldc_w index) = 0x13 : unpackWord16 index - serialize (Opaload index) = [0xC4, 0x19] ++ unpackWord16 index - serialize (Opiload index) = [0xC4, 0x15] ++ unpackWord16 index - serialize (Opastore index) = [0xC4, 0x3A] ++ unpackWord16 index - serialize (Opistore index) = [0xC4, 0x36] ++ unpackWord16 index - serialize (Opputfield index) = 0xB5 : unpackWord16 index - serialize (OpgetField index) = 0xB4 : unpackWord16 index + serialize Opiadd = [0x60] + serialize Opisub = [0x64] + serialize Opimul = [0x68] + serialize Opidiv = [0x6C] + serialize Opiand = [0x7E] + serialize Opior = [0x80] + serialize Opixor = [0x82] + serialize Opineg = [0x74] + serialize (Opif_icmplt branch) = 0xA1 : unpackWord16 branch + serialize (Opif_icmple branch) = 0xA4 : unpackWord16 branch + serialize (Opif_icmpgt branch) = 0xA3 : unpackWord16 branch + serialize (Opif_icmpge branch) = 0xA2 : unpackWord16 branch + serialize (Opif_icmpeq branch) = 0x9F : unpackWord16 branch + serialize (Opif_icmpne branch) = 0xA0 : unpackWord16 branch + serialize Opaconst_null = [0x01] + serialize Opreturn = [0xB1] + serialize Opireturn = [0xAC] + serialize Opareturn = [0xB0] + serialize (Opinvokespecial index) = 0xB7 : unpackWord16 index + serialize (Opgoto index) = 0xA7 : unpackWord16 index + serialize (Opsipush index) = 0x11 : unpackWord16 index + serialize (Opldc_w index) = 0x13 : unpackWord16 index + serialize (Opaload index) = [0xC4, 0x19] ++ unpackWord16 index + serialize (Opiload index) = [0xC4, 0x15] ++ unpackWord16 index + serialize (Opastore index) = [0xC4, 0x3A] ++ unpackWord16 index + serialize (Opistore index) = [0xC4, 0x36] ++ unpackWord16 index + serialize (Opputfield index) = 0xB5 : unpackWord16 index + serialize (OpgetField index) = 0xB4 : unpackWord16 index instance Serializable Attribute where serialize (CodeAttribute { attributeMaxStack = maxStack, diff --git a/src/ByteCode/ClassFile/Generator.hs b/src/ByteCode/ClassFile/Generator.hs index a482f16..866c375 100644 --- a/src/ByteCode/ClassFile/Generator.hs +++ b/src/ByteCode/ClassFile/Generator.hs @@ -201,8 +201,17 @@ comparisonOperation CompareGreaterOrEqual branchLocation = Opif_icmpge branchLoc assembleMethod :: Assembler MethodDeclaration -assembleMethod (MethodDeclaration _ _ _ (TypedStatement _ (Block statements))) (constants, ops) = - foldr assembleStatement (constants, ops) statements +assembleMethod (MethodDeclaration _ name _ (TypedStatement _ (Block statements))) (constants, ops) + | name == "" = let + (constants_a, ops_a) = foldr assembleStatement (constants, ops) statements + init_ops = [Opaload 0, Opinvokespecial 2] + in + (constants_a, init_ops ++ ops_a) + | otherwise = let + (constants_a, ops_a) = foldr assembleStatement (constants, ops) statements + init_ops = [Opaload 0] + in + (constants_a, init_ops ++ ops_a) assembleMethod (MethodDeclaration _ _ _ stmt) (_, _) = error ("Block expected for method body, got: " ++ show stmt) assembleStatement :: Assembler Statement @@ -223,9 +232,8 @@ assembleExpression (TypedExpression _ (BinaryOperation op a b)) (constants, ops) | elem op [CompareEqual, CompareNotEqual, CompareLessThan, CompareLessOrEqual, CompareGreaterThan, CompareGreaterOrEqual] = let (aConstants, aOps) = assembleExpression a (constants, ops) (bConstants, bOps) = assembleExpression b (aConstants, aOps) - current_offset = sum (map opcodeEncodingLength bOps) - cmp_op = comparisonOperation op (fromIntegral (current_offset + 10)) - cmp_ops = [cmp_op, Opsipush 1, Opgoto (fromIntegral (current_offset + 13)), Opsipush 0] + cmp_op = comparisonOperation op 9 + cmp_ops = [cmp_op, Opsipush 0, Opgoto 6, Opsipush 1] in (bConstants, bOps ++ cmp_ops) assembleExpression (TypedExpression _ (CharacterLiteral literal)) (constants, ops) = diff --git a/src/Main.hs b/src/Main.hs index c2ffd1b..c9f5c18 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -9,7 +9,7 @@ import ByteCode.ClassFile import Data.ByteString (pack, writeFile) main = do - let untypedAST = parse $ alexScanTokens "class Testklasse {void something(){return;}}" + let untypedAST = parse $ alexScanTokens "class Testklasse {Testklasse(){} boolean something(){return 5 + 8 - 12 * 22 > 9 - 2 + 3;}}" let typedAST = head (typeCheckCompilationUnit untypedAST) let abstractClassFile = classBuilder typedAST emptyClassFile let assembledClassFile = pack (serialize abstractClassFile) diff --git a/src/Typecheck.hs b/src/Typecheck.hs index 7cdc3a7..e411894 100644 --- a/src/Typecheck.hs +++ b/src/Typecheck.hs @@ -302,7 +302,7 @@ typeCheckStatement (Return expr) symtab classes = Nothing -> Nothing in case expr' of Just e' -> TypedStatement (getTypeFromExpr e') (Return (Just e')) - Nothing -> TypedStatement "Void" (Return Nothing) + Nothing -> TypedStatement "void" (Return Nothing) typeCheckStatement (StatementExpressionStatement stmtExpr) symtab classes = let stmtExpr' = typeCheckStatementExpression stmtExpr symtab classes From aa3b196ab55d94a5c953ff9384df19043c2c89b0 Mon Sep 17 00:00:00 2001 From: Marvin Schlegel Date: Tue, 14 May 2024 12:33:42 +0200 Subject: [PATCH 46/98] set constructor return type void --- Test/TestParser.hs | 2 +- src/Parser/JavaParser.y | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/Test/TestParser.hs b/Test/TestParser.hs index d85b9f5..ba54821 100644 --- a/Test/TestParser.hs +++ b/Test/TestParser.hs @@ -50,7 +50,7 @@ testClassWithMethodAndField = TestCase $ assertEqual "expect class with method and field" [Class "WithMethodAndField" [MethodDeclaration "void" "foo" [] (Block []), MethodDeclaration "int" "bar" [] (Block [])] [VariableDeclaration "int" "value" Nothing]] $ parse [CLASS,IDENTIFIER "WithMethodAndField",LBRACKET,VOID,IDENTIFIER "foo",LBRACE,RBRACE,LBRACKET,RBRACKET,INT,IDENTIFIER "value",SEMICOLON,INT,IDENTIFIER "bar",LBRACE,RBRACE,SEMICOLON,RBRACKET] testClassWithConstructor = TestCase $ - assertEqual "expect class with constructor" [Class "WithConstructor" [MethodDeclaration "WithConstructor" "" [] (Block [])] []] $ + assertEqual "expect class with constructor" [Class "WithConstructor" [MethodDeclaration "void" "" [] (Block [])] []] $ parse [CLASS,IDENTIFIER "WithConstructor",LBRACKET,IDENTIFIER "WithConstructor",LBRACE,RBRACE,LBRACKET,RBRACKET,RBRACKET] diff --git a/src/Parser/JavaParser.y b/src/Parser/JavaParser.y index 53828ea..e51afb4 100644 --- a/src/Parser/JavaParser.y +++ b/src/Parser/JavaParser.y @@ -127,8 +127,8 @@ classorinterfacetype : name { $1 } classmemberdeclaration : fielddeclaration { $1 } | methoddeclaration { $1 } -constructordeclaration : constructordeclarator constructorbody { case $1 of (classname, parameters) -> MethodDecl $ MethodDeclaration classname "" parameters $2 } - | modifiers constructordeclarator constructorbody { case $2 of (classname, parameters) -> MethodDecl $ MethodDeclaration classname "" parameters $3 } +constructordeclaration : constructordeclarator constructorbody { case $1 of (classname, parameters) -> MethodDecl $ MethodDeclaration "void" "" parameters $2 } + | modifiers constructordeclarator constructorbody { case $2 of (classname, parameters) -> MethodDecl $ MethodDeclaration "void" "" parameters $3 } fielddeclaration : type variabledeclarators SEMICOLON { FieldDecls $ map (convertDeclarator $1) $2 } | modifiers type variabledeclarators SEMICOLON { FieldDecls $ map (convertDeclarator $2) $3 } From f9f984568f0800234ed43562724aaa0db6473249 Mon Sep 17 00:00:00 2001 From: mrab Date: Tue, 14 May 2024 13:20:37 +0200 Subject: [PATCH 47/98] block and if assembly (no else) --- src/ByteCode/ClassFile/Generator.hs | 11 ++++++++++- src/Main.hs | 4 +++- 2 files changed, 13 insertions(+), 2 deletions(-) diff --git a/src/ByteCode/ClassFile/Generator.hs b/src/ByteCode/ClassFile/Generator.hs index 866c375..69382b3 100644 --- a/src/ByteCode/ClassFile/Generator.hs +++ b/src/ByteCode/ClassFile/Generator.hs @@ -206,7 +206,7 @@ assembleMethod (MethodDeclaration _ name _ (TypedStatement _ (Block statements)) (constants_a, ops_a) = foldr assembleStatement (constants, ops) statements init_ops = [Opaload 0, Opinvokespecial 2] in - (constants_a, init_ops ++ ops_a) + (constants_a, init_ops ++ ops_a ++ [Opreturn]) | otherwise = let (constants_a, ops_a) = foldr assembleStatement (constants, ops) statements init_ops = [Opaload 0] @@ -221,6 +221,15 @@ assembleStatement (TypedStatement stype (Return expr)) (constants, ops) = case e (expr_constants, expr_ops) = assembleExpression expr (constants, ops) in (expr_constants, expr_ops ++ [returnOperation stype]) +assembleStatement (TypedStatement _ (Block statements)) (constants, ops) = + foldr assembleStatement (constants, ops) statements +assembleStatement (TypedStatement _ (If expr if_stmt else_stmt)) (constants, ops) = let + (constants_cmp, ops_cmp) = assembleExpression expr (constants, []) + (constants_ifa, ops_ifa) = assembleStatement if_stmt (constants_cmp, []) + skip_length = sum (map opcodeEncodingLength ops_ifa) + in + (constants_ifa, ops ++ ops_cmp ++ [Opsipush 0, Opif_icmpeq skip_length] ++ ops_ifa) + assembleExpression :: Assembler Expression assembleExpression (TypedExpression _ (BinaryOperation op a b)) (constants, ops) diff --git a/src/Main.hs b/src/Main.hs index c9f5c18..858d5bb 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -9,7 +9,9 @@ import ByteCode.ClassFile import Data.ByteString (pack, writeFile) main = do - let untypedAST = parse $ alexScanTokens "class Testklasse {Testklasse(){} boolean something(){return 5 + 8 - 12 * 22 > 9 - 2 + 3;}}" + file <- readFile "Testklasse.java" + + let untypedAST = parse $ alexScanTokens file let typedAST = head (typeCheckCompilationUnit untypedAST) let abstractClassFile = classBuilder typedAST emptyClassFile let assembledClassFile = pack (serialize abstractClassFile) From fef619ac03ace67e4d9d39764e14b328960a9486 Mon Sep 17 00:00:00 2001 From: Marvin Schlegel Date: Tue, 14 May 2024 13:20:46 +0200 Subject: [PATCH 48/98] parser add if then --- src/Parser/JavaParser.y | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/Parser/JavaParser.y b/src/Parser/JavaParser.y index e51afb4..b64cb27 100644 --- a/src/Parser/JavaParser.y +++ b/src/Parser/JavaParser.y @@ -184,7 +184,7 @@ referencetype : classorinterfacetype { $1 } variabledeclarator : variabledeclaratorid { Declarator $1 Nothing } | variabledeclaratorid ASSIGN variableinitializer { Declarator $1 (Just $3) } -blockstatement : localvariabledeclarationstatement { $1 } +blockstatement : localvariabledeclarationstatement { $1 } -- expected type statement | statement { $1 } formalparameter : type variabledeclaratorid { ParameterDeclaration $1 $2 } @@ -200,8 +200,8 @@ variableinitializer : expression { $1 } localvariabledeclarationstatement : localvariabledeclaration SEMICOLON { $1 } -statement : statementwithouttrailingsubstatement{ $1 } - -- | ifthenstatement { } +statement : statementwithouttrailingsubstatement{ $1 } -- statement returns a list of statements + | ifthenstatement { [$1] } -- | ifthenelsestatement { } -- | whilestatement { } @@ -218,7 +218,7 @@ statementwithouttrailingsubstatement : block { [$1] } -- | expressionstatement { } | returnstatement { [$1] } -ifthenstatement : IF LBRACE expression RBRACE statement { } +ifthenstatement : IF LBRACE expression RBRACE statement { If $3 (Block $5) Nothing } ifthenelsestatement : IF LBRACE expression RBRACE statementnoshortif ELSE statement { } From 5723f6c66296d9b886a135930a150322b8e5edd8 Mon Sep 17 00:00:00 2001 From: Marvin Schlegel Date: Tue, 14 May 2024 13:57:01 +0200 Subject: [PATCH 49/98] parser add ifthenelse --- Test/TestParser.hs | 11 ++++++++++- src/Parser/JavaParser.y | 13 ++++++++----- 2 files changed, 18 insertions(+), 6 deletions(-) diff --git a/Test/TestParser.hs b/Test/TestParser.hs index ba54821..b7cd93e 100644 --- a/Test/TestParser.hs +++ b/Test/TestParser.hs @@ -145,6 +145,13 @@ testExpressionPreDecrement = TestCase $ assertEqual "expect PreIncrement" (UnaryOperation PreDecrement (Reference "a")) $ parseExpression [DECREMENT,IDENTIFIER "a"] +testStatementIfThen = TestCase $ + assertEqual "expect empty ifthen" [If (Reference "a") (Block [Block []]) Nothing] $ + parseStatement [IF,LBRACE,IDENTIFIER "a",RBRACE,LBRACKET,RBRACKET] +testStatementIfThenElse = TestCase $ + assertEqual "expect empty ifthen" [If (Reference "a") (Block [Block []]) (Just (Block [Block []]))] $ + parseStatement [IF,LBRACE,IDENTIFIER "a",RBRACE,LBRACKET,RBRACKET,ELSE,LBRACKET,RBRACKET] + tests = TestList [ testSingleEmptyClass, @@ -185,5 +192,7 @@ tests = TestList [ testExpressionPostIncrement, testExpressionPostDecrement, testExpressionPreIncrement, - testExpressionPreDecrement + testExpressionPreDecrement, + testStatementIfThen, + testStatementIfThenElse ] \ No newline at end of file diff --git a/src/Parser/JavaParser.y b/src/Parser/JavaParser.y index b64cb27..2e80289 100644 --- a/src/Parser/JavaParser.y +++ b/src/Parser/JavaParser.y @@ -202,7 +202,7 @@ localvariabledeclarationstatement : localvariabledeclaration SEMICOLON { $1 } statement : statementwithouttrailingsubstatement{ $1 } -- statement returns a list of statements | ifthenstatement { [$1] } - -- | ifthenelsestatement { } + | ifthenelsestatement { [$1] } -- | whilestatement { } @@ -220,7 +220,7 @@ statementwithouttrailingsubstatement : block { [$1] } ifthenstatement : IF LBRACE expression RBRACE statement { If $3 (Block $5) Nothing } -ifthenelsestatement : IF LBRACE expression RBRACE statementnoshortif ELSE statement { } +ifthenelsestatement : IF LBRACE expression RBRACE statementnoshortif ELSE statement { If $3 (Block $5) (Just (Block $7)) } whilestatement : WHILE LBRACE expression RBRACE statement { } @@ -234,9 +234,9 @@ expressionstatement : statementexpression SEMICOLON { } returnstatement : RETURN SEMICOLON { Return Nothing } | RETURN expression SEMICOLON { Return $ Just $2 } -statementnoshortif : statementwithouttrailingsubstatement { } - | ifthenelsestatementnoshortif { } - | whilestatementnoshortif { } +statementnoshortif : statementwithouttrailingsubstatement { $1 } + -- | ifthenelsestatementnoshortif { } + -- | whilestatementnoshortif { } conditionalexpression : conditionalorexpression { $1 } -- | conditionalorexpression QUESMARK expression COLON conditionalexpression { } @@ -370,6 +370,9 @@ data Declarator = Declarator Identifier (Maybe Expression) convertDeclarator :: DataType -> Declarator -> VariableDeclaration convertDeclarator dataType (Declarator id assigment) = VariableDeclaration dataType id assigment +data StatementWithoutSub = Statement + + parseError :: ([Token], [String]) -> a parseError (errortoken, expected) = error ("parse error on token: " ++ show errortoken ++ "\nexpected one of: " ++ show expected) From a179dec3ea71a3b92c00812a08f4be34bef9f79a Mon Sep 17 00:00:00 2001 From: mrab Date: Tue, 14 May 2024 13:57:20 +0200 Subject: [PATCH 50/98] else Assembly --- src/ByteCode/ClassFile/Generator.hs | 81 +++++++++++++++-------------- 1 file changed, 43 insertions(+), 38 deletions(-) diff --git a/src/ByteCode/ClassFile/Generator.hs b/src/ByteCode/ClassFile/Generator.hs index 69382b3..fef967c 100644 --- a/src/ByteCode/ClassFile/Generator.hs +++ b/src/ByteCode/ClassFile/Generator.hs @@ -52,7 +52,7 @@ memberInfoDescriptor constants MemberInfo { descriptor = constants!!((fromIntegral descriptorIndex) - 1) in case descriptor of Utf8Info descriptorText -> descriptorText - _ -> ("Invalid Item at Constant pool index " ++ show descriptorIndex) + _ -> ("Invalid Item at Constant pool index " ++ show descriptorIndex) memberInfoName :: [ConstantInfo] -> MemberInfo -> String @@ -64,11 +64,11 @@ memberInfoName constants MemberInfo { name = constants!!((fromIntegral nameIndex) - 1) in case name of Utf8Info nameText -> nameText - _ -> ("Invalid Item at Constant pool index " ++ show nameIndex) + _ -> ("Invalid Item at Constant pool index " ++ show nameIndex) methodDescriptor :: MethodDeclaration -> String -methodDescriptor (MethodDeclaration returntype _ parameters _) = let +methodDescriptor (MethodDeclaration returntype _ parameters _) = let parameter_types = [datatype | ParameterDeclaration datatype _ <- parameters] in "(" @@ -104,8 +104,8 @@ classBuilder (Class name methods fields) _ = let classFileWithAssembledMethods = foldr methodAssembler classFileWithMethods methods in classFileWithAssembledMethods - - + + fieldBuilder :: ClassFileBuilder VariableDeclaration fieldBuilder (VariableDeclaration datatype name _) input = let @@ -135,7 +135,7 @@ methodBuilder (MethodDeclaration returntype name parameters statement) input = l Utf8Info name, Utf8Info (methodDescriptor (MethodDeclaration returntype name parameters (Block []))) ] - + method = MemberInfo { memberAccessFlags = accessPublic, memberNameIndex = (fromIntegral baseIndex), @@ -157,7 +157,7 @@ methodAssembler (MethodDeclaration returntype name parameters statement) input = Just index -> let declaration = MethodDeclaration returntype name parameters statement (pre, method : post) = splitAt index (methods input) - (_, bytecode) = assembleMethod declaration (constantPool input, []) + (_, bytecode) = assembleMethod (constantPool input, []) declaration assembledMethod = method { memberAttributes = [ CodeAttribute { @@ -171,11 +171,11 @@ methodAssembler (MethodDeclaration returntype name parameters statement) input = input { methods = pre ++ (assembledMethod : post) } - -type Assembler a = a -> ([ConstantInfo], [Operation]) -> ([ConstantInfo], [Operation]) + +type Assembler a = ([ConstantInfo], [Operation]) -> a -> ([ConstantInfo], [Operation]) returnOperation :: DataType -> Operation returnOperation dtype @@ -201,67 +201,72 @@ comparisonOperation CompareGreaterOrEqual branchLocation = Opif_icmpge branchLoc assembleMethod :: Assembler MethodDeclaration -assembleMethod (MethodDeclaration _ name _ (TypedStatement _ (Block statements))) (constants, ops) - | name == "" = let - (constants_a, ops_a) = foldr assembleStatement (constants, ops) statements +assembleMethod (constants, ops) (MethodDeclaration _ name _ (TypedStatement _ (Block statements))) + | name == "" = let + (constants_a, ops_a) = foldl assembleStatement (constants, ops) statements init_ops = [Opaload 0, Opinvokespecial 2] in (constants_a, init_ops ++ ops_a ++ [Opreturn]) | otherwise = let - (constants_a, ops_a) = foldr assembleStatement (constants, ops) statements + (constants_a, ops_a) = foldl assembleStatement (constants, ops) statements init_ops = [Opaload 0] in (constants_a, init_ops ++ ops_a) -assembleMethod (MethodDeclaration _ _ _ stmt) (_, _) = error ("Block expected for method body, got: " ++ show stmt) +assembleMethod _ (MethodDeclaration _ _ _ stmt) = error ("Block expected for method body, got: " ++ show stmt) assembleStatement :: Assembler Statement -assembleStatement (TypedStatement stype (Return expr)) (constants, ops) = case expr of +assembleStatement (constants, ops) (TypedStatement stype (Return expr)) = case expr of Nothing -> (constants, ops ++ [Opreturn]) Just expr -> let - (expr_constants, expr_ops) = assembleExpression expr (constants, ops) - in + (expr_constants, expr_ops) = assembleExpression (constants, ops) expr + in (expr_constants, expr_ops ++ [returnOperation stype]) -assembleStatement (TypedStatement _ (Block statements)) (constants, ops) = - foldr assembleStatement (constants, ops) statements -assembleStatement (TypedStatement _ (If expr if_stmt else_stmt)) (constants, ops) = let - (constants_cmp, ops_cmp) = assembleExpression expr (constants, []) - (constants_ifa, ops_ifa) = assembleStatement if_stmt (constants_cmp, []) - skip_length = sum (map opcodeEncodingLength ops_ifa) +assembleStatement (constants, ops) (TypedStatement _ (Block statements)) = + foldl assembleStatement (constants, ops) statements +assembleStatement (constants, ops) (TypedStatement _ (If expr if_stmt else_stmt)) = let + (constants_cmp, ops_cmp) = assembleExpression (constants, []) expr + (constants_ifa, ops_ifa) = assembleStatement (constants_cmp, []) if_stmt + (constants_elsea, ops_elsea) = case else_stmt of + Nothing -> (constants_ifa, []) + Just stmt -> assembleStatement (constants_ifa, []) stmt + -- +6 because we insert 2 gotos, one for if, one for else + if_length = sum (map opcodeEncodingLength ops_ifa) + 6 + else_length = sum (map opcodeEncodingLength ops_ifa) in - (constants_ifa, ops ++ ops_cmp ++ [Opsipush 0, Opif_icmpeq skip_length] ++ ops_ifa) - + (constants_ifa, ops ++ ops_cmp ++ [Opsipush 0, Opif_icmpeq if_length] ++ ops_ifa ++ [Opgoto else_length] ++ ops_elsea) +assembleStatement stmt _ = error ("Not yet implemented: " ++ show stmt) assembleExpression :: Assembler Expression -assembleExpression (TypedExpression _ (BinaryOperation op a b)) (constants, ops) +assembleExpression (constants, ops) (TypedExpression _ (BinaryOperation op a b)) | elem op [Addition, Subtraction, Multiplication, Division, BitwiseAnd, BitwiseOr, BitwiseXor] = let - (aConstants, aOps) = assembleExpression a (constants, ops) - (bConstants, bOps) = assembleExpression b (aConstants, aOps) + (aConstants, aOps) = assembleExpression (constants, ops) a + (bConstants, bOps) = assembleExpression (aConstants, aOps) b in (bConstants, bOps ++ [binaryOperation op]) | elem op [CompareEqual, CompareNotEqual, CompareLessThan, CompareLessOrEqual, CompareGreaterThan, CompareGreaterOrEqual] = let - (aConstants, aOps) = assembleExpression a (constants, ops) - (bConstants, bOps) = assembleExpression b (aConstants, aOps) + (aConstants, aOps) = assembleExpression (constants, ops) a + (bConstants, bOps) = assembleExpression (aConstants, aOps) b cmp_op = comparisonOperation op 9 cmp_ops = [cmp_op, Opsipush 0, Opgoto 6, Opsipush 1] in (bConstants, bOps ++ cmp_ops) -assembleExpression (TypedExpression _ (CharacterLiteral literal)) (constants, ops) = +assembleExpression (constants, ops) (TypedExpression _ (CharacterLiteral literal)) = (constants, ops ++ [Opsipush (fromIntegral (ord literal))]) -assembleExpression (TypedExpression _ (BooleanLiteral literal)) (constants, ops) = +assembleExpression (constants, ops) (TypedExpression _ (BooleanLiteral literal)) = (constants, ops ++ [Opsipush (if literal then 1 else 0)]) -assembleExpression (TypedExpression _ (IntegerLiteral literal)) (constants, ops) +assembleExpression (constants, ops) (TypedExpression _ (IntegerLiteral literal)) | literal <= 32767 && literal >= -32768 = (constants, ops ++ [Opsipush (fromIntegral literal)]) | otherwise = (constants ++ [IntegerInfo (fromIntegral literal)], ops ++ [Opldc_w (fromIntegral (1 + length constants))]) -assembleExpression (TypedExpression _ NullLiteral) (constants, ops) = +assembleExpression (constants, ops) (TypedExpression _ NullLiteral) = (constants, ops ++ [Opaconst_null]) -assembleExpression (TypedExpression etype (UnaryOperation Not expr)) (constants, ops) = let - (exprConstants, exprOps) = assembleExpression expr (constants, ops) +assembleExpression (constants, ops) (TypedExpression etype (UnaryOperation Not expr)) = let + (exprConstants, exprOps) = assembleExpression (constants, ops) expr newConstant = fromIntegral (1 + length exprConstants) in case etype of "int" -> (exprConstants ++ [IntegerInfo 0x7FFFFFFF], exprOps ++ [Opldc_w newConstant, Opixor]) "char" -> (exprConstants, exprOps ++ [Opsipush 0xFFFF, Opixor]) "boolean" -> (exprConstants, exprOps ++ [Opsipush 0x01, Opixor]) -assembleExpression (TypedExpression _ (UnaryOperation Minus expr)) (constants, ops) = let - (exprConstants, exprOps) = assembleExpression expr (constants, ops) +assembleExpression (constants, ops) (TypedExpression _ (UnaryOperation Minus expr)) = let + (exprConstants, exprOps) = assembleExpression (constants, ops) expr in (exprConstants, exprOps ++ [Opineg]) From a4fff37b07aaac7b3249066cfd3e58db68a46cbf Mon Sep 17 00:00:00 2001 From: mrab Date: Tue, 14 May 2024 14:09:24 +0200 Subject: [PATCH 51/98] Bugfix: else assembly --- src/ByteCode/ClassFile/Generator.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/ByteCode/ClassFile/Generator.hs b/src/ByteCode/ClassFile/Generator.hs index fef967c..37919e0 100644 --- a/src/ByteCode/ClassFile/Generator.hs +++ b/src/ByteCode/ClassFile/Generator.hs @@ -231,7 +231,8 @@ assembleStatement (constants, ops) (TypedStatement _ (If expr if_stmt else_stmt) Just stmt -> assembleStatement (constants_ifa, []) stmt -- +6 because we insert 2 gotos, one for if, one for else if_length = sum (map opcodeEncodingLength ops_ifa) + 6 - else_length = sum (map opcodeEncodingLength ops_ifa) + -- +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) assembleStatement stmt _ = error ("Not yet implemented: " ++ show stmt) From 524c667c43d41790c0100f09d0985cdefc68f6f2 Mon Sep 17 00:00:00 2001 From: Marvin Schlegel Date: Tue, 14 May 2024 16:48:45 +0200 Subject: [PATCH 52/98] parser add while loop --- Test/TestParser.hs | 7 ++++++- src/Parser/JavaParser.y | 4 ++-- 2 files changed, 8 insertions(+), 3 deletions(-) diff --git a/Test/TestParser.hs b/Test/TestParser.hs index b7cd93e..a5b94fa 100644 --- a/Test/TestParser.hs +++ b/Test/TestParser.hs @@ -151,6 +151,10 @@ testStatementIfThen = TestCase $ testStatementIfThenElse = TestCase $ assertEqual "expect empty ifthen" [If (Reference "a") (Block [Block []]) (Just (Block [Block []]))] $ parseStatement [IF,LBRACE,IDENTIFIER "a",RBRACE,LBRACKET,RBRACKET,ELSE,LBRACKET,RBRACKET] +testStatementWhile = TestCase $ + assertEqual "expect while" [While (Reference "a") (Block [Block []])] $ + parseStatement [WHILE,LBRACE,IDENTIFIER "a",RBRACE,LBRACKET,RBRACKET] + tests = TestList [ @@ -194,5 +198,6 @@ tests = TestList [ testExpressionPreIncrement, testExpressionPreDecrement, testStatementIfThen, - testStatementIfThenElse + testStatementIfThenElse, + testStatementWhile ] \ No newline at end of file diff --git a/src/Parser/JavaParser.y b/src/Parser/JavaParser.y index 2e80289..b3e0e43 100644 --- a/src/Parser/JavaParser.y +++ b/src/Parser/JavaParser.y @@ -203,7 +203,7 @@ localvariabledeclarationstatement : localvariabledeclaration SEMICOLON { $1 } statement : statementwithouttrailingsubstatement{ $1 } -- statement returns a list of statements | ifthenstatement { [$1] } | ifthenelsestatement { [$1] } - -- | whilestatement { } + | whilestatement { [$1] } expression : assignmentexpression { $1 } @@ -222,7 +222,7 @@ ifthenstatement : IF LBRACE expression RBRACE statement { If $3 (Block $5) No ifthenelsestatement : IF LBRACE expression RBRACE statementnoshortif ELSE statement { If $3 (Block $5) (Just (Block $7)) } -whilestatement : WHILE LBRACE expression RBRACE statement { } +whilestatement : WHILE LBRACE expression RBRACE statement { While $3 (Block $5) } assignmentexpression : conditionalexpression { $1 } -- | assignment { } From 9f658397de204f501d80b1318969dc0f9b983b5c Mon Sep 17 00:00:00 2001 From: Marvin Schlegel Date: Tue, 14 May 2024 23:14:43 +0200 Subject: [PATCH 53/98] parser implement assign --- Test/TestParser.hs | 4 ++++ src/Parser/JavaParser.y | 30 ++++++++++++++++-------------- 2 files changed, 20 insertions(+), 14 deletions(-) diff --git a/Test/TestParser.hs b/Test/TestParser.hs index a5b94fa..2911f3f 100644 --- a/Test/TestParser.hs +++ b/Test/TestParser.hs @@ -144,6 +144,9 @@ testExpressionPreIncrement = TestCase $ testExpressionPreDecrement = TestCase $ assertEqual "expect PreIncrement" (UnaryOperation PreDecrement (Reference "a")) $ parseExpression [DECREMENT,IDENTIFIER "a"] +testExpressionAssign = TestCase $ + assertEqual "expect assign and addition" (StatementExpressionExpression (Assignment (Reference "a") (IntegerLiteral 5))) $ + parseExpression [IDENTIFIER "a",ASSIGN,INTEGERLITERAL 5] testStatementIfThen = TestCase $ assertEqual "expect empty ifthen" [If (Reference "a") (Block [Block []]) Nothing] $ @@ -197,6 +200,7 @@ tests = TestList [ testExpressionPostDecrement, testExpressionPreIncrement, testExpressionPreDecrement, + testExpressionAssign, testStatementIfThen, testStatementIfThenElse, testStatementWhile diff --git a/src/Parser/JavaParser.y b/src/Parser/JavaParser.y index b3e0e43..fcd3559 100644 --- a/src/Parser/JavaParser.y +++ b/src/Parser/JavaParser.y @@ -82,7 +82,7 @@ compilationunit : typedeclarations { $1 } typedeclarations : typedeclaration { [$1] } | typedeclarations typedeclaration { $1 ++ [$2] } -name : simplename { $1 } +name : simplename { Reference $1 } -- | qualifiedname { } typedeclaration : classdeclaration { $1 } @@ -122,7 +122,7 @@ classtype : classorinterfacetype{ } classbodydeclaration : classmemberdeclaration { $1 } | constructordeclaration { $1 } -classorinterfacetype : name { $1 } +classorinterfacetype : simplename { $1 } classmemberdeclaration : fielddeclaration { $1 } | methoddeclaration { $1 } @@ -225,7 +225,7 @@ ifthenelsestatement : IF LBRACE expression RBRACE statementnoshortif ELSE state whilestatement : WHILE LBRACE expression RBRACE statement { While $3 (Block $5) } assignmentexpression : conditionalexpression { $1 } - -- | assignment { } + | assignment { StatementExpressionExpression $1 } emptystatement : SEMICOLON { Block [] } @@ -241,7 +241,9 @@ statementnoshortif : statementwithouttrailingsubstatement { $1 } conditionalexpression : conditionalorexpression { $1 } -- | conditionalorexpression QUESMARK expression COLON conditionalexpression { } -assignment : lefthandside assignmentoperator assignmentexpression { } +assignment : lefthandside assignmentoperator assignmentexpression { + Assignment $1 $3 + } statementexpression : assignment { } @@ -262,18 +264,18 @@ conditionalorexpression : conditionalandexpression { $1 } lefthandside : name { $1 } -assignmentoperator : ASSIGN{ } - -- | TIMESEQUAL { } - -- | DIVIDEEQUAL { } - -- | MODULOEQUAL { } - -- | PLUSEQUAL { } - -- | MINUSEQUAL { } +assignmentoperator : ASSIGN { Nothing } + | TIMESEQUAL { Just Multiplication } + | DIVIDEEQUAL { Just Division } + | MODULOEQUAL { Just Modulo } + | PLUSEQUAL { Just Addition } + | MINUSEQUAL { Just Subtraction } -- | SHIFTLEFTEQUAL { } -- | SIGNEDSHIFTRIGHTEQUAL { } -- | UNSIGNEDSHIFTRIGHTEQUAL { } - -- | ANDEQUAL { } - -- | XOREQUAL { } - -- | OREQUAL{ } + | ANDEQUAL { Just BitwiseAnd } + | XOREQUAL { Just BitwiseXor } + | OREQUAL{ Just BitwiseOr } preincrementexpression : INCREMENT unaryexpression { UnaryOperation PreIncrement $2 } @@ -302,7 +304,7 @@ unaryexpression : unaryexpressionnotplusminus { $1 } | preincrementexpression { $1 } postfixexpression : primary { $1 } - | name { Reference $1 } + | name { $1 } | postincrementexpression { $1 } | postdecrementexpression{ $1 } From a4d41b9ef73429649f262acf7183a80d7bd21b50 Mon Sep 17 00:00:00 2001 From: Marvin Schlegel Date: Tue, 14 May 2024 23:35:56 +0200 Subject: [PATCH 54/98] parser add timesequal, divideequal, moduloequal, minusequal, andequal, xorequal, orequal --- Test/TestParser.hs | 19 ++++++++++++++++++- src/Parser/JavaParser.y | 4 +++- 2 files changed, 21 insertions(+), 2 deletions(-) diff --git a/Test/TestParser.hs b/Test/TestParser.hs index 2911f3f..873f438 100644 --- a/Test/TestParser.hs +++ b/Test/TestParser.hs @@ -145,8 +145,20 @@ testExpressionPreDecrement = TestCase $ assertEqual "expect PreIncrement" (UnaryOperation PreDecrement (Reference "a")) $ parseExpression [DECREMENT,IDENTIFIER "a"] testExpressionAssign = TestCase $ - assertEqual "expect assign and addition" (StatementExpressionExpression (Assignment (Reference "a") (IntegerLiteral 5))) $ + assertEqual "expect assign 5 to a" (StatementExpressionExpression (Assignment (Reference "a") (IntegerLiteral 5))) $ parseExpression [IDENTIFIER "a",ASSIGN,INTEGERLITERAL 5] +testExpressionTimesEqual = TestCase $ + assertEqual "expect assign and multiplication" (StatementExpressionExpression (Assignment (Reference "a") (BinaryOperation Multiplication (Reference "a") (IntegerLiteral 5)))) $ + parseExpression [IDENTIFIER "a",TIMESEQUAL,INTEGERLITERAL 5] +testExpressionDivideEqual = TestCase $ + assertEqual "expect assign and division" (StatementExpressionExpression (Assignment (Reference "a") (BinaryOperation Division (Reference "a") (IntegerLiteral 5)))) $ + parseExpression [IDENTIFIER "a",DIVEQUAL,INTEGERLITERAL 5] +testExpressionPlusEqual = TestCase $ + assertEqual "expect assign and addition" (StatementExpressionExpression (Assignment (Reference "a") (BinaryOperation Addition (Reference "a") (IntegerLiteral 5)))) $ + parseExpression [IDENTIFIER "a",PLUSEQUAL,INTEGERLITERAL 5] +testExpressionMinusEqual = TestCase $ + assertEqual "expect assign and subtraction" (StatementExpressionExpression (Assignment (Reference "a") (BinaryOperation Subtraction (Reference "a") (IntegerLiteral 5)))) $ + parseExpression [IDENTIFIER "a",MINUSEQUAL,INTEGERLITERAL 5] testStatementIfThen = TestCase $ assertEqual "expect empty ifthen" [If (Reference "a") (Block [Block []]) Nothing] $ @@ -201,6 +213,11 @@ tests = TestList [ testExpressionPreIncrement, testExpressionPreDecrement, testExpressionAssign, + testExpressionTimesEqual, + testExpressionTimesEqual, + testExpressionDivideEqual, + testExpressionPlusEqual, + testExpressionMinusEqual, testStatementIfThen, testStatementIfThenElse, testStatementWhile diff --git a/src/Parser/JavaParser.y b/src/Parser/JavaParser.y index fcd3559..4e66850 100644 --- a/src/Parser/JavaParser.y +++ b/src/Parser/JavaParser.y @@ -242,7 +242,9 @@ conditionalexpression : conditionalorexpression { $1 } -- | conditionalorexpression QUESMARK expression COLON conditionalexpression { } assignment : lefthandside assignmentoperator assignmentexpression { - Assignment $1 $3 + case $2 of + Nothing -> Assignment $1 $3 + Just operator -> Assignment $1 (BinaryOperation operator $1 $3) } From b095678769416713b4adb79446bb77639cf3c6c7 Mon Sep 17 00:00:00 2001 From: Christian Brier Date: Wed, 15 May 2024 10:01:01 +0200 Subject: [PATCH 55/98] add: local variable assembler --- src/ByteCode/ClassFile.hs | 6 +++--- src/ByteCode/ClassFile/Generator.hs | 23 +++++++++++++++++++++++ 2 files changed, 26 insertions(+), 3 deletions(-) diff --git a/src/ByteCode/ClassFile.hs b/src/ByteCode/ClassFile.hs index 7798cf8..38cf88e 100644 --- a/src/ByteCode/ClassFile.hs +++ b/src/ByteCode/ClassFile.hs @@ -51,7 +51,7 @@ data Operation = Opiadd | Opastore Word16 | Opistore Word16 | Opputfield Word16 - | OpgetField Word16 + | Opgetfield Word16 deriving (Show, Eq) @@ -118,7 +118,7 @@ opcodeEncodingLength (Opiload _) = 3 opcodeEncodingLength (Opastore _) = 3 opcodeEncodingLength (Opistore _) = 3 opcodeEncodingLength (Opputfield _) = 3 -opcodeEncodingLength (OpgetField _) = 3 +opcodeEncodingLength (Opgetfield _) = 3 class Serializable a where serialize :: a -> [Word8] @@ -168,7 +168,7 @@ instance Serializable Operation where serialize (Opastore index) = [0xC4, 0x3A] ++ unpackWord16 index serialize (Opistore index) = [0xC4, 0x36] ++ unpackWord16 index serialize (Opputfield index) = 0xB5 : unpackWord16 index - serialize (OpgetField index) = 0xB4 : unpackWord16 index + serialize (Opgetfield index) = 0xB4 : unpackWord16 index instance Serializable Attribute where serialize (CodeAttribute { attributeMaxStack = maxStack, diff --git a/src/ByteCode/ClassFile/Generator.hs b/src/ByteCode/ClassFile/Generator.hs index 37919e0..2b6f0f1 100644 --- a/src/ByteCode/ClassFile/Generator.hs +++ b/src/ByteCode/ClassFile/Generator.hs @@ -37,6 +37,24 @@ methodParameterDescriptor x = "L" ++ x ++ ";" memberInfoIsMethod :: [ConstantInfo] -> MemberInfo -> Bool memberInfoIsMethod constants info = elem '(' (memberInfoDescriptor constants info) +findFieldIndex :: [ConstantInfo] -> String -> Maybe Int +findFieldIndex constants name = let + fieldRefNameInfos = [ + -- we only skip one entry to get the name since the Java constant pool + -- is 1-indexed (why) + (index, constants!!(fromIntegral index + 1)) + | (index, FieldRefInfo _ _) <- (zip [1..] constants) + ] + fieldRefNames = map (\(index, nameInfo) -> case nameInfo of + Utf8Info fieldName -> (index, fieldName) + something_else -> error ("Expected UTF8Info but got" ++ show something_else)) + fieldRefNameInfos + fieldIndex = find (\(index, fieldName) -> fieldName == name) fieldRefNames + in case fieldIndex of + Just (index, _) -> Just index + Nothing -> Nothing + + findMethodIndex :: ClassFile -> String -> Maybe Int findMethodIndex classFile name = let constants = constantPool classFile @@ -271,3 +289,8 @@ assembleExpression (constants, ops) (TypedExpression _ (UnaryOperation Minus exp (exprConstants, exprOps) = assembleExpression (constants, ops) expr in (exprConstants, exprOps ++ [Opineg]) +assembleExpression (constants, ops) (TypedExpression _ (FieldVariable name)) = let + fieldIndex = findFieldIndex constants name + in case fieldIndex of + Just index -> (constants, ops ++ [Opaload 0, Opgetfield (fromIntegral index)]) + Nothing -> error ("No such field found in constant pool: " ++ name) From b11adcf907087830d544775ae3c3b8d9ac1502ba Mon Sep 17 00:00:00 2001 From: Marvin Schlegel Date: Wed, 15 May 2024 10:32:03 +0200 Subject: [PATCH 56/98] parser add this and braced expressions --- Test/TestParser.hs | 13 +++++++++++++ src/Parser/JavaParser.y | 4 ++-- 2 files changed, 15 insertions(+), 2 deletions(-) diff --git a/Test/TestParser.hs b/Test/TestParser.hs index 873f438..bf874fc 100644 --- a/Test/TestParser.hs +++ b/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 diff --git a/src/Parser/JavaParser.y b/src/Parser/JavaParser.y index 4e66850..513b198 100644 --- a/src/Parser/JavaParser.y +++ b/src/Parser/JavaParser.y @@ -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 { } From 207fb5c5f3fdd57e06aedb4f717e86fdc6b04b21 Mon Sep 17 00:00:00 2001 From: mrab Date: Wed, 15 May 2024 11:23:40 +0200 Subject: [PATCH 57/98] local variables working --- src/ByteCode/ClassFile/Generator.hs | 115 ++++++++++++++++------------ 1 file changed, 66 insertions(+), 49 deletions(-) diff --git a/src/ByteCode/ClassFile/Generator.hs b/src/ByteCode/ClassFile/Generator.hs index 2b6f0f1..935de81 100644 --- a/src/ByteCode/ClassFile/Generator.hs +++ b/src/ByteCode/ClassFile/Generator.hs @@ -92,7 +92,7 @@ methodDescriptor (MethodDeclaration returntype _ parameters _) = let "(" ++ (concat (map methodParameterDescriptor parameter_types)) ++ ")" - ++ datatypeDescriptor returntype + ++ methodParameterDescriptor returntype classBuilder :: ClassFileBuilder Class @@ -160,11 +160,12 @@ methodBuilder (MethodDeclaration returntype name parameters statement) input = l memberDescriptorIndex = (fromIntegral (baseIndex + 1)), memberAttributes = [] } - in + in input { constantPool = (constantPool input) ++ constants, methods = (methods input) ++ [method] } + methodAssembler :: ClassFileBuilder MethodDeclaration @@ -174,8 +175,9 @@ methodAssembler (MethodDeclaration returntype name parameters statement) input = Nothing -> error ("Cannot find method entry in method pool for method: " ++ name) Just index -> let declaration = MethodDeclaration returntype name parameters statement + paramNames = "this" : [name | ParameterDeclaration _ name <- parameters] (pre, method : post) = splitAt index (methods input) - (_, bytecode) = assembleMethod (constantPool input, []) declaration + (_, bytecode, _) = assembleMethod (constantPool input, [], paramNames) declaration assembledMethod = method { memberAttributes = [ CodeAttribute { @@ -193,7 +195,7 @@ methodAssembler (MethodDeclaration returntype name parameters statement) input = -type Assembler a = ([ConstantInfo], [Operation]) -> a -> ([ConstantInfo], [Operation]) +type Assembler a = ([ConstantInfo], [Operation], [String]) -> a -> ([ConstantInfo], [Operation], [String]) returnOperation :: DataType -> Operation returnOperation dtype @@ -219,78 +221,93 @@ comparisonOperation CompareGreaterOrEqual branchLocation = Opif_icmpge branchLoc assembleMethod :: Assembler MethodDeclaration -assembleMethod (constants, ops) (MethodDeclaration _ name _ (TypedStatement _ (Block statements))) +assembleMethod (constants, ops, lvars) (MethodDeclaration _ name _ (TypedStatement _ (Block statements))) | name == "" = let - (constants_a, ops_a) = foldl assembleStatement (constants, ops) statements + (constants_a, ops_a, lvars_a) = foldl assembleStatement (constants, ops, lvars) statements init_ops = [Opaload 0, Opinvokespecial 2] in - (constants_a, init_ops ++ ops_a ++ [Opreturn]) + (constants_a, init_ops ++ ops_a ++ [Opreturn], lvars_a) | otherwise = let - (constants_a, ops_a) = foldl assembleStatement (constants, ops) statements + (constants_a, ops_a, lvars_a) = foldl assembleStatement (constants, ops, lvars) statements init_ops = [Opaload 0] in - (constants_a, init_ops ++ ops_a) + (constants_a, init_ops ++ ops_a, lvars_a) assembleMethod _ (MethodDeclaration _ _ _ stmt) = error ("Block expected for method body, got: " ++ show stmt) assembleStatement :: Assembler Statement -assembleStatement (constants, ops) (TypedStatement stype (Return expr)) = case expr of - Nothing -> (constants, ops ++ [Opreturn]) +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) expr + (expr_constants, expr_ops, _) = assembleExpression (constants, ops, lvars) expr in - (expr_constants, expr_ops ++ [returnOperation stype]) -assembleStatement (constants, ops) (TypedStatement _ (Block statements)) = - foldl assembleStatement (constants, ops) statements -assembleStatement (constants, ops) (TypedStatement _ (If expr if_stmt else_stmt)) = let - (constants_cmp, ops_cmp) = assembleExpression (constants, []) expr - (constants_ifa, ops_ifa) = assembleStatement (constants_cmp, []) if_stmt - (constants_elsea, ops_elsea) = case else_stmt of - Nothing -> (constants_ifa, []) - Just stmt -> assembleStatement (constants_ifa, []) stmt + (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) -assembleStatement stmt _ = error ("Not yet implemented: " ++ show stmt) + (constants_ifa, ops ++ ops_cmp ++ [Opsipush 0, Opif_icmpeq if_length] ++ ops_ifa ++ [Opgoto else_length] ++ ops_elsea, 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) + loadLocal = if isPrimitive then [Opistore localIndex] else [Opastore localIndex] + in + (constants_init, ops_init ++ loadLocal, lvars ++ [name]) +assembleStatement _ stmt = error ("Not yet implemented: " ++ show stmt) assembleExpression :: Assembler Expression -assembleExpression (constants, ops) (TypedExpression _ (BinaryOperation op a b)) +assembleExpression (constants, ops, lvars) (TypedExpression _ (BinaryOperation op a b)) | elem op [Addition, Subtraction, Multiplication, Division, BitwiseAnd, BitwiseOr, BitwiseXor] = let - (aConstants, aOps) = assembleExpression (constants, ops) a - (bConstants, bOps) = assembleExpression (aConstants, aOps) b + (aConstants, aOps, _) = assembleExpression (constants, ops, lvars) a + (bConstants, bOps, _) = assembleExpression (aConstants, aOps, lvars) b in - (bConstants, bOps ++ [binaryOperation op]) + (bConstants, bOps ++ [binaryOperation op], lvars) | elem op [CompareEqual, CompareNotEqual, CompareLessThan, CompareLessOrEqual, CompareGreaterThan, CompareGreaterOrEqual] = let - (aConstants, aOps) = assembleExpression (constants, ops) a - (bConstants, bOps) = assembleExpression (aConstants, aOps) b + (aConstants, aOps, _) = assembleExpression (constants, ops, lvars) a + (bConstants, bOps, _) = assembleExpression (aConstants, aOps, lvars) b cmp_op = comparisonOperation op 9 cmp_ops = [cmp_op, Opsipush 0, Opgoto 6, Opsipush 1] in - (bConstants, bOps ++ cmp_ops) -assembleExpression (constants, ops) (TypedExpression _ (CharacterLiteral literal)) = - (constants, ops ++ [Opsipush (fromIntegral (ord literal))]) -assembleExpression (constants, ops) (TypedExpression _ (BooleanLiteral literal)) = - (constants, ops ++ [Opsipush (if literal then 1 else 0)]) -assembleExpression (constants, ops) (TypedExpression _ (IntegerLiteral literal)) - | literal <= 32767 && literal >= -32768 = (constants, ops ++ [Opsipush (fromIntegral literal)]) - | otherwise = (constants ++ [IntegerInfo (fromIntegral literal)], ops ++ [Opldc_w (fromIntegral (1 + length constants))]) -assembleExpression (constants, ops) (TypedExpression _ NullLiteral) = - (constants, ops ++ [Opaconst_null]) -assembleExpression (constants, ops) (TypedExpression etype (UnaryOperation Not expr)) = let - (exprConstants, exprOps) = assembleExpression (constants, ops) expr + (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) in case etype of - "int" -> (exprConstants ++ [IntegerInfo 0x7FFFFFFF], exprOps ++ [Opldc_w newConstant, Opixor]) - "char" -> (exprConstants, exprOps ++ [Opsipush 0xFFFF, Opixor]) - "boolean" -> (exprConstants, exprOps ++ [Opsipush 0x01, Opixor]) -assembleExpression (constants, ops) (TypedExpression _ (UnaryOperation Minus expr)) = let - (exprConstants, exprOps) = assembleExpression (constants, ops) expr + "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]) -assembleExpression (constants, ops) (TypedExpression _ (FieldVariable name)) = let + (exprConstants, exprOps ++ [Opineg], lvars) +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)]) + 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 _ (LocalVariable name)) = let + localIndex = findIndex ((==) name) lvars + in case localIndex of + Just index -> (constants, ops ++ [Opiload (fromIntegral index)], lvars) + Nothing -> error ("No such local variable found in local variable pool: " ++ name) +assembleExpression _ expr = error ("unimplemented: " ++ show expr) From e572975bdacdb3441e2430c526d9ab07197ec35a Mon Sep 17 00:00:00 2001 From: Christian Brier Date: Wed, 15 May 2024 11:45:41 +0200 Subject: [PATCH 58/98] add: inject default constructor --- src/ByteCode/ClassFile/Generator.hs | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/src/ByteCode/ClassFile/Generator.hs b/src/ByteCode/ClassFile/Generator.hs index 935de81..d78dae6 100644 --- a/src/ByteCode/ClassFile/Generator.hs +++ b/src/ByteCode/ClassFile/Generator.hs @@ -94,6 +94,11 @@ methodDescriptor (MethodDeclaration returntype _ parameters _) = let ++ ")" ++ methodParameterDescriptor returntype +injectDefaultConstructor :: [MethodDeclaration] -> [MethodDeclaration] +injectDefaultConstructor pre + | any (\(MethodDeclaration _ name _ _) -> name == "") pre = pre + | otherwise = pre ++ [MethodDeclaration "void" "" [] (TypedStatement "void" (Block []))] + classBuilder :: ClassFileBuilder Class classBuilder (Class name methods fields) _ = let @@ -117,9 +122,11 @@ classBuilder (Class name methods fields) _ = let attributes = [] } + methodsWithInjectedConstructor = injectDefaultConstructor methods + classFileWithFields = foldr fieldBuilder nakedClassFile fields - classFileWithMethods = foldr methodBuilder classFileWithFields methods - classFileWithAssembledMethods = foldr methodAssembler classFileWithMethods methods + classFileWithMethods = foldr methodBuilder classFileWithFields methodsWithInjectedConstructor + classFileWithAssembledMethods = foldr methodAssembler classFileWithMethods methodsWithInjectedConstructor in classFileWithAssembledMethods @@ -232,7 +239,7 @@ assembleMethod (constants, ops, lvars) (MethodDeclaration _ name _ (TypedStateme init_ops = [Opaload 0] in (constants_a, init_ops ++ ops_a, lvars_a) -assembleMethod _ (MethodDeclaration _ _ _ stmt) = error ("Block expected for method body, got: " ++ show stmt) +assembleMethod _ (MethodDeclaration _ _ _ stmt) = error ("Block expected for method body, got: " ++ show stmt) assembleStatement :: Assembler Statement assembleStatement (constants, ops, lvars) (TypedStatement stype (Return expr)) = case expr of From a80dc1d34be6717fbf39ef77a979c00f9c327a5a Mon Sep 17 00:00:00 2001 From: MisterChaos96 Date: Wed, 15 May 2024 12:51:14 +0200 Subject: [PATCH 59/98] null is now a valid declaration value for a object --- src/Example.hs | 30 +++++++++++++++++++++++++----- src/Typecheck.hs | 11 +++++++++-- 2 files changed, 34 insertions(+), 7 deletions(-) diff --git a/src/Example.hs b/src/Example.hs index db4213f..38df899 100644 --- a/src/Example.hs +++ b/src/Example.hs @@ -101,24 +101,30 @@ exampleNameResolutionAssignment = Block [ exampleCharIntOperation :: Expression exampleCharIntOperation = BinaryOperation Addition (CharacterLiteral 'a') (IntegerLiteral 1) +exampleNullDeclaration :: Statement +exampleNullDeclaration = LocalVariableDeclaration (VariableDeclaration "Person" "bob" (Just NullLiteral)) + +exampleNullDeclarationFail :: Statement +exampleNullDeclarationFail = LocalVariableDeclaration (VariableDeclaration "int" "a" (Just NullLiteral)) + testClasses :: [Class] testClasses = [ Class "Person" [ - MethodDeclaration "Person" "Person" [ParameterDeclaration "int" "initialAge"] + MethodDeclaration "Person" "Person" [ParameterDeclaration "int" "initialAge"] (Block [ Return (Just (Reference "this")) ]), - MethodDeclaration "void" "setAge" [ParameterDeclaration "int" "newAge"] + MethodDeclaration "void" "setAge" [ParameterDeclaration "int" "newAge"] (Block [ LocalVariableDeclaration (VariableDeclaration "int" "age" (Just (Reference "newAge"))) ]), - MethodDeclaration "int" "getAge" [] + MethodDeclaration "int" "getAge" [] (Return (Just (Reference "age"))) ] [ VariableDeclaration "int" "age" Nothing -- initially unassigned ], Class "Main" [ - MethodDeclaration "int" "main" [] + MethodDeclaration "int" "main" [] (Block [ LocalVariableDeclaration (VariableDeclaration "Person" "bob" (Just (StatementExpressionExpression (ConstructorCall "Person" [IntegerLiteral 25])))), StatementExpressionStatement (MethodCall (Reference "bob") "setAge" [IntegerLiteral 30]), @@ -211,7 +217,7 @@ runTypeCheck = do printSuccess "Type checking of Program completed successfully" printResult "Typed Program:" typedProgram ) handleError - + catch (do print "=====================================================================================" typedAssignment <- evaluate (typeCheckStatement exampleNameResolutionAssignment [] sampleClasses) @@ -226,3 +232,17 @@ runTypeCheck = do printResult "Result Char Int Operation:" evaluatedCharIntOperation ) handleError + catch (do + print "=====================================================================================" + evaluatedNullDeclaration <- evaluate (typeCheckStatement exampleNullDeclaration [] sampleClasses) + printSuccess "Type checking of null declaration completed successfully" + printResult "Result Null Declaration:" evaluatedNullDeclaration + ) handleError + + catch (do + print "=====================================================================================" + evaluatedNullDeclarationFail <- evaluate (typeCheckStatement exampleNullDeclarationFail [] sampleClasses) + printSuccess "Type checking of null declaration failed" + printResult "Result Null Declaration:" evaluatedNullDeclarationFail + ) handleError + diff --git a/src/Typecheck.hs b/src/Typecheck.hs index 0032d46..f691558 100644 --- a/src/Typecheck.hs +++ b/src/Typecheck.hs @@ -226,8 +226,12 @@ typeCheckStatement (LocalVariableDeclaration (VariableDeclaration dataType ident let checkedExpr = fmap (\expr -> typeCheckExpression expr symtab classes) maybeExpr exprType = fmap getTypeFromExpr checkedExpr in case exprType of - Just t | t /= dataType -> error $ "Type mismatch in declaration of '" ++ identifier ++ "': expected " ++ dataType ++ ", found " ++ t - _ -> TypedStatement dataType (LocalVariableDeclaration (VariableDeclaration dataType identifier checkedExpr)) + Just t + | t == "null" && isObjectType dataType -> + TypedStatement dataType (LocalVariableDeclaration (VariableDeclaration dataType identifier checkedExpr)) + | t /= dataType -> error $ "Type mismatch in declaration of '" ++ identifier ++ "': expected " ++ dataType ++ ", found " ++ t + | otherwise -> TypedStatement dataType (LocalVariableDeclaration (VariableDeclaration dataType identifier checkedExpr)) + Nothing -> TypedStatement dataType (LocalVariableDeclaration (VariableDeclaration dataType identifier checkedExpr)) typeCheckStatement (While cond stmt) symtab classes = let cond' = typeCheckExpression cond symtab classes @@ -278,6 +282,9 @@ typeCheckStatement (StatementExpressionStatement stmtExpr) symtab classes = -- ********************************** Type Checking: Helpers ********************************** +isObjectType :: DataType -> Bool +isObjectType dt = dt /= "int" && dt /= "boolean" && dt /= "char" + getTypeFromExpr :: Expression -> DataType getTypeFromExpr (TypedExpression t _) = t getTypeFromExpr _ = error "Untyped expression found where typed was expected" From 07837f7d5f5e9de3bbd9279c1c9fbbf75e958f8e Mon Sep 17 00:00:00 2001 From: MisterChaos96 Date: Wed, 15 May 2024 13:04:06 +0200 Subject: [PATCH 60/98] null is now a valid declaration value for a object --- src/Example.hs | 9 +++++++++ src/Typecheck.hs | 10 +++++----- 2 files changed, 14 insertions(+), 5 deletions(-) diff --git a/src/Example.hs b/src/Example.hs index 38df899..080b738 100644 --- a/src/Example.hs +++ b/src/Example.hs @@ -107,6 +107,9 @@ exampleNullDeclaration = LocalVariableDeclaration (VariableDeclaration "Person" exampleNullDeclarationFail :: Statement exampleNullDeclarationFail = LocalVariableDeclaration (VariableDeclaration "int" "a" (Just NullLiteral)) +exampleNullAssignment :: Statement +exampleNullAssignment = StatementExpressionStatement (Assignment (Reference "a") NullLiteral) + testClasses :: [Class] testClasses = [ Class "Person" [ @@ -246,3 +249,9 @@ runTypeCheck = do printResult "Result Null Declaration:" evaluatedNullDeclarationFail ) handleError + catch (do + print "=====================================================================================" + evaluatedNullAssignment <- evaluate (typeCheckStatement exampleNullAssignment [("a", "Person")] sampleClasses) + printSuccess "Type checking of null assignment completed successfully" + printResult "Result Null Assignment:" evaluatedNullAssignment + ) handleError diff --git a/src/Typecheck.hs b/src/Typecheck.hs index f691558..8755458 100644 --- a/src/Typecheck.hs +++ b/src/Typecheck.hs @@ -146,11 +146,11 @@ typeCheckStatementExpression (Assignment ref expr) symtab classes = ref' = typeCheckExpression ref symtab classes type' = getTypeFromExpr expr' type'' = getTypeFromExpr ref' - in - if type'' == type' then - TypedStatementExpression type' (Assignment ref' expr') - else - error $ "Type mismatch in assignment to variable: expected " ++ type'' ++ ", found " ++ type' + in + if type'' == type' || (type' == "null" && isObjectType type'') then + TypedStatementExpression type'' (Assignment ref' expr') + else + error $ "Type mismatch in assignment to variable: expected " ++ type'' ++ ", found " ++ type' typeCheckStatementExpression (ConstructorCall className args) symtab classes = case find (\(Class name _ _) -> name == className) classes of From 535a6891ad5c1772d52c7aef701f4b2cb1507d14 Mon Sep 17 00:00:00 2001 From: mrab Date: Thu, 16 May 2024 09:28:00 +0200 Subject: [PATCH 61/98] Local variable assignment --- src/ByteCode/ClassFile/Generator.hs | 20 ++++++++++++++++---- 1 file changed, 16 insertions(+), 4 deletions(-) diff --git a/src/ByteCode/ClassFile/Generator.hs b/src/ByteCode/ClassFile/Generator.hs index d78dae6..2eabd67 100644 --- a/src/ByteCode/ClassFile/Generator.hs +++ b/src/ByteCode/ClassFile/Generator.hs @@ -268,9 +268,9 @@ assembleStatement (constants, ops, lvars) (TypedStatement _ (LocalVariableDeclar Just exp -> assembleExpression (constants, ops, lvars) exp Nothing -> (constants, ops ++ if isPrimitive then [Opsipush 0] else [Opaconst_null], lvars) localIndex = fromIntegral (length lvars) - loadLocal = if isPrimitive then [Opistore localIndex] else [Opastore localIndex] + storeLocal = if isPrimitive then [Opistore localIndex] else [Opastore localIndex] in - (constants_init, ops_init ++ loadLocal, lvars ++ [name]) + (constants_init, ops_init ++ storeLocal, lvars ++ [name]) assembleStatement _ stmt = error ("Not yet implemented: " ++ show stmt) assembleExpression :: Assembler Expression @@ -312,9 +312,21 @@ assembleExpression (constants, ops, lvars) (TypedExpression _ (FieldVariable nam 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 _ (LocalVariable name)) = let +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 ++ [Opiload (fromIntegral index)], lvars) + 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) + +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) \ No newline at end of file From 2a502a6c673c00809dda0760f5b2633b60ea6c08 Mon Sep 17 00:00:00 2001 From: MisterChaos96 Date: Thu, 16 May 2024 09:36:35 +0200 Subject: [PATCH 62/98] fix return null for object return type not possible --- src/Typecheck.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Typecheck.hs b/src/Typecheck.hs index 8755458..5834f57 100644 --- a/src/Typecheck.hs +++ b/src/Typecheck.hs @@ -25,7 +25,7 @@ typeCheckMethodDeclaration (MethodDeclaration retType name params body) classFie checkedBody = typeCheckStatement body initialSymtab classes bodyType = getTypeFromStmt checkedBody -- Check if the type of the body matches the declared return type - in if bodyType == retType || (bodyType == "void" && retType == "void") + in if bodyType == retType || (bodyType == "void" && retType == "void") || (bodyType == "null" && isObjectType retType) then MethodDeclaration retType name params checkedBody else error $ "Return type mismatch in method " ++ name ++ ": expected " ++ retType ++ ", found " ++ bodyType From 09f70ca7890ad0a02b64d3864e5940045369bbaf Mon Sep 17 00:00:00 2001 From: mrab Date: Thu, 16 May 2024 09:53:36 +0200 Subject: [PATCH 63/98] While assembly --- src/ByteCode/ClassFile.hs | 8 ++++---- src/ByteCode/ClassFile/Generator.hs | 8 ++++++++ 2 files changed, 12 insertions(+), 4 deletions(-) diff --git a/src/ByteCode/ClassFile.hs b/src/ByteCode/ClassFile.hs index 38cf88e..37481db 100644 --- a/src/ByteCode/ClassFile.hs +++ b/src/ByteCode/ClassFile.hs @@ -113,10 +113,10 @@ opcodeEncodingLength (Opinvokespecial _) = 3 opcodeEncodingLength (Opgoto _) = 3 opcodeEncodingLength (Opsipush _) = 3 opcodeEncodingLength (Opldc_w _) = 3 -opcodeEncodingLength (Opaload _) = 3 -opcodeEncodingLength (Opiload _) = 3 -opcodeEncodingLength (Opastore _) = 3 -opcodeEncodingLength (Opistore _) = 3 +opcodeEncodingLength (Opaload _) = 4 +opcodeEncodingLength (Opiload _) = 4 +opcodeEncodingLength (Opastore _) = 4 +opcodeEncodingLength (Opistore _) = 4 opcodeEncodingLength (Opputfield _) = 3 opcodeEncodingLength (Opgetfield _) = 3 diff --git a/src/ByteCode/ClassFile/Generator.hs b/src/ByteCode/ClassFile/Generator.hs index 2eabd67..adb4d6f 100644 --- a/src/ByteCode/ClassFile/Generator.hs +++ b/src/ByteCode/ClassFile/Generator.hs @@ -262,6 +262,14 @@ assembleStatement (constants, ops, lvars) (TypedStatement _ (If expr if_stmt els 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 From d0d2cbd0810b20fbf2f528d2398cf85c9e667139 Mon Sep 17 00:00:00 2001 From: mrab Date: Thu, 16 May 2024 10:39:27 +0200 Subject: [PATCH 64/98] restructured bytecode code --- project.cabal | 15 +- src/ByteCode/ClassFile/Generator.hs | 340 ------------------ .../Generation/Assembler/Expression.hs | 55 +++ src/ByteCode/Generation/Assembler/Method.hs | 20 ++ .../Generation/Assembler/Statement.hs | 46 +++ .../Assembler/StatementExpression.hs | 18 + src/ByteCode/Generation/Builder/Class.hs | 44 +++ src/ByteCode/Generation/Builder/Field.hs | 46 +++ src/ByteCode/Generation/Builder/Method.hs | 80 +++++ src/ByteCode/Generation/Generator.hs | 73 ++++ src/Main.hs | 3 +- 11 files changed, 394 insertions(+), 346 deletions(-) delete mode 100644 src/ByteCode/ClassFile/Generator.hs create mode 100644 src/ByteCode/Generation/Assembler/Expression.hs create mode 100644 src/ByteCode/Generation/Assembler/Method.hs create mode 100644 src/ByteCode/Generation/Assembler/Statement.hs create mode 100644 src/ByteCode/Generation/Assembler/StatementExpression.hs create mode 100644 src/ByteCode/Generation/Builder/Class.hs create mode 100644 src/ByteCode/Generation/Builder/Field.hs create mode 100644 src/ByteCode/Generation/Builder/Method.hs create mode 100644 src/ByteCode/Generation/Generator.hs diff --git a/project.cabal b/project.cabal index cf8bce0..ad9b335 100644 --- a/project.cabal +++ b/project.cabal @@ -12,18 +12,23 @@ executable compiler utf8-string, bytestring default-language: Haskell2010 - hs-source-dirs: src, - src/ByteCode, - src/ByteCode/ClassFile + hs-source-dirs: src build-tool-depends: alex:alex, happy:happy other-modules: Parser.Lexer, - Parser.JavaParser + Parser.JavaParser, Ast, Example, Typecheck, ByteCode.ByteUtil, ByteCode.ClassFile, - ByteCode.ClassFile.Generator, + ByteCode.Generation.Generator, + 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, ByteCode.Constants test-suite tests diff --git a/src/ByteCode/ClassFile/Generator.hs b/src/ByteCode/ClassFile/Generator.hs deleted file mode 100644 index adb4d6f..0000000 --- a/src/ByteCode/ClassFile/Generator.hs +++ /dev/null @@ -1,340 +0,0 @@ -module ByteCode.ClassFile.Generator( - classBuilder, - datatypeDescriptor, - methodParameterDescriptor, - methodDescriptor, - memberInfoIsMethod, - memberInfoName, - memberInfoDescriptor, - findMethodIndex -) where - -import ByteCode.Constants -import ByteCode.ClassFile (ClassFile (..), ConstantInfo (..), MemberInfo(..), Operation(..), Attribute(..), opcodeEncodingLength) -import Ast -import Data.Char -import Data.List -import Data.Word - - -type ClassFileBuilder a = a -> ClassFile -> ClassFile - - -datatypeDescriptor :: String -> String -datatypeDescriptor "void" = "V" -datatypeDescriptor "int" = "I" -datatypeDescriptor "char" = "C" -datatypeDescriptor "boolean" = "B" -datatypeDescriptor x = "L" ++ x - -methodParameterDescriptor :: String -> String -methodParameterDescriptor "void" = "V" -methodParameterDescriptor "int" = "I" -methodParameterDescriptor "char" = "C" -methodParameterDescriptor "boolean" = "B" -methodParameterDescriptor x = "L" ++ x ++ ";" - -memberInfoIsMethod :: [ConstantInfo] -> MemberInfo -> Bool -memberInfoIsMethod constants info = elem '(' (memberInfoDescriptor constants info) - -findFieldIndex :: [ConstantInfo] -> String -> Maybe Int -findFieldIndex constants name = let - fieldRefNameInfos = [ - -- we only skip one entry to get the name since the Java constant pool - -- is 1-indexed (why) - (index, constants!!(fromIntegral index + 1)) - | (index, FieldRefInfo _ _) <- (zip [1..] constants) - ] - fieldRefNames = map (\(index, nameInfo) -> case nameInfo of - Utf8Info fieldName -> (index, fieldName) - something_else -> error ("Expected UTF8Info but got" ++ show something_else)) - fieldRefNameInfos - fieldIndex = find (\(index, fieldName) -> fieldName == name) fieldRefNames - in case fieldIndex of - Just (index, _) -> Just index - Nothing -> Nothing - - -findMethodIndex :: ClassFile -> String -> Maybe Int -findMethodIndex classFile name = let - constants = constantPool classFile - in - findIndex (\method -> ((memberInfoIsMethod constants method) && (memberInfoName constants method) == name)) (methods classFile) - -memberInfoDescriptor :: [ConstantInfo] -> MemberInfo -> String -memberInfoDescriptor constants MemberInfo { - memberAccessFlags = _, - memberNameIndex = _, - memberDescriptorIndex = descriptorIndex, - memberAttributes = _ } = let - descriptor = constants!!((fromIntegral descriptorIndex) - 1) - in case descriptor of - Utf8Info descriptorText -> descriptorText - _ -> ("Invalid Item at Constant pool index " ++ show descriptorIndex) - - -memberInfoName :: [ConstantInfo] -> MemberInfo -> String -memberInfoName constants MemberInfo { - memberAccessFlags = _, - memberNameIndex = nameIndex, - memberDescriptorIndex = _, - memberAttributes = _ } = let - name = constants!!((fromIntegral nameIndex) - 1) - in case name of - Utf8Info nameText -> nameText - _ -> ("Invalid Item at Constant pool index " ++ show nameIndex) - - -methodDescriptor :: MethodDeclaration -> String -methodDescriptor (MethodDeclaration returntype _ parameters _) = let - parameter_types = [datatype | ParameterDeclaration datatype _ <- parameters] - in - "(" - ++ (concat (map methodParameterDescriptor parameter_types)) - ++ ")" - ++ methodParameterDescriptor returntype - -injectDefaultConstructor :: [MethodDeclaration] -> [MethodDeclaration] -injectDefaultConstructor pre - | any (\(MethodDeclaration _ name _ _) -> name == "") pre = pre - | otherwise = pre ++ [MethodDeclaration "void" "" [] (TypedStatement "void" (Block []))] - - -classBuilder :: ClassFileBuilder Class -classBuilder (Class name methods fields) _ = let - baseConstants = [ - ClassInfo 4, - MethodRefInfo 1 3, - NameAndTypeInfo 5 6, - Utf8Info "java/lang/Object", - Utf8Info "", - Utf8Info "()V", - Utf8Info "Code" - ] - nameConstants = [ClassInfo 9, Utf8Info name] - nakedClassFile = ClassFile { - constantPool = baseConstants ++ nameConstants, - accessFlags = accessPublic, - thisClass = 8, - superClass = 1, - fields = [], - methods = [], - attributes = [] - } - - methodsWithInjectedConstructor = injectDefaultConstructor methods - - classFileWithFields = foldr fieldBuilder nakedClassFile fields - classFileWithMethods = foldr methodBuilder classFileWithFields methodsWithInjectedConstructor - classFileWithAssembledMethods = foldr methodAssembler classFileWithMethods methodsWithInjectedConstructor - in - classFileWithAssembledMethods - - - -fieldBuilder :: ClassFileBuilder VariableDeclaration -fieldBuilder (VariableDeclaration datatype name _) input = let - baseIndex = 1 + length (constantPool input) - constants = [ - FieldRefInfo (fromIntegral (thisClass input)) (fromIntegral (baseIndex + 1)), - NameAndTypeInfo (fromIntegral (baseIndex + 2)) (fromIntegral (baseIndex + 3)), - Utf8Info name, - Utf8Info (datatypeDescriptor datatype) - ] - field = MemberInfo { - memberAccessFlags = accessPublic, - memberNameIndex = (fromIntegral (baseIndex + 2)), - memberDescriptorIndex = (fromIntegral (baseIndex + 3)), - memberAttributes = [] - } - in - input { - constantPool = (constantPool input) ++ constants, - fields = (fields input) ++ [field] - } - -methodBuilder :: ClassFileBuilder MethodDeclaration -methodBuilder (MethodDeclaration returntype name parameters statement) input = let - baseIndex = 1 + length (constantPool input) - constants = [ - Utf8Info name, - Utf8Info (methodDescriptor (MethodDeclaration returntype name parameters (Block []))) - ] - - method = MemberInfo { - memberAccessFlags = accessPublic, - memberNameIndex = (fromIntegral baseIndex), - memberDescriptorIndex = (fromIntegral (baseIndex + 1)), - memberAttributes = [] - } - in - input { - constantPool = (constantPool input) ++ constants, - methods = (methods input) ++ [method] - } - - - -methodAssembler :: ClassFileBuilder MethodDeclaration -methodAssembler (MethodDeclaration returntype name parameters statement) input = let - methodConstantIndex = findMethodIndex input name - in case methodConstantIndex of - Nothing -> error ("Cannot find method entry in method pool for method: " ++ name) - Just index -> let - declaration = MethodDeclaration returntype name parameters statement - paramNames = "this" : [name | ParameterDeclaration _ name <- parameters] - (pre, method : post) = splitAt index (methods input) - (_, bytecode, _) = assembleMethod (constantPool input, [], paramNames) declaration - assembledMethod = method { - memberAttributes = [ - CodeAttribute { - attributeMaxStack = 420, - attributeMaxLocals = 420, - attributeCode = bytecode - } - ] - } - in - input { - methods = pre ++ (assembledMethod : post) - } - - - - -type Assembler a = ([ConstantInfo], [Operation], [String]) -> a -> ([ConstantInfo], [Operation], [String]) - -returnOperation :: DataType -> Operation -returnOperation dtype - | elem dtype ["int", "char", "boolean"] = Opireturn - | otherwise = Opareturn - -binaryOperation :: BinaryOperator -> Operation -binaryOperation Addition = Opiadd -binaryOperation Subtraction = Opisub -binaryOperation Multiplication = Opimul -binaryOperation Division = Opidiv -binaryOperation BitwiseAnd = Opiand -binaryOperation BitwiseOr = Opior -binaryOperation BitwiseXor = Opixor - -comparisonOperation :: BinaryOperator -> Word16 -> Operation -comparisonOperation CompareEqual branchLocation = Opif_icmpeq branchLocation -comparisonOperation CompareNotEqual branchLocation = Opif_icmpne branchLocation -comparisonOperation CompareLessThan branchLocation = Opif_icmplt branchLocation -comparisonOperation CompareLessOrEqual branchLocation = Opif_icmple branchLocation -comparisonOperation CompareGreaterThan branchLocation = Opif_icmpgt branchLocation -comparisonOperation CompareGreaterOrEqual branchLocation = Opif_icmpge branchLocation - - -assembleMethod :: Assembler MethodDeclaration -assembleMethod (constants, ops, lvars) (MethodDeclaration _ name _ (TypedStatement _ (Block statements))) - | name == "" = let - (constants_a, ops_a, lvars_a) = foldl assembleStatement (constants, ops, lvars) statements - init_ops = [Opaload 0, Opinvokespecial 2] - in - (constants_a, init_ops ++ ops_a ++ [Opreturn], lvars_a) - | otherwise = let - (constants_a, ops_a, lvars_a) = foldl assembleStatement (constants, ops, lvars) statements - init_ops = [Opaload 0] - in - (constants_a, init_ops ++ ops_a, lvars_a) -assembleMethod _ (MethodDeclaration _ _ _ stmt) = error ("Block expected for method body, got: " ++ show stmt) - -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 _ stmt = error ("Not yet implemented: " ++ show stmt) - -assembleExpression :: Assembler Expression -assembleExpression (constants, ops, lvars) (TypedExpression _ (BinaryOperation op a b)) - | elem op [Addition, Subtraction, Multiplication, Division, BitwiseAnd, BitwiseOr, BitwiseXor] = let - (aConstants, aOps, _) = assembleExpression (constants, ops, lvars) a - (bConstants, bOps, _) = assembleExpression (aConstants, aOps, lvars) b - in - (bConstants, bOps ++ [binaryOperation op], lvars) - | elem op [CompareEqual, CompareNotEqual, CompareLessThan, CompareLessOrEqual, CompareGreaterThan, CompareGreaterOrEqual] = let - (aConstants, aOps, _) = assembleExpression (constants, ops, lvars) a - (bConstants, bOps, _) = assembleExpression (aConstants, aOps, lvars) b - cmp_op = comparisonOperation op 9 - 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) - in case etype of - "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 _ (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) - -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) \ No newline at end of file diff --git a/src/ByteCode/Generation/Assembler/Expression.hs b/src/ByteCode/Generation/Assembler/Expression.hs new file mode 100644 index 0000000..a7f3d15 --- /dev/null +++ b/src/ByteCode/Generation/Assembler/Expression.hs @@ -0,0 +1,55 @@ +module ByteCode.Generation.Assembler.Expression where + +import Ast +import ByteCode.ClassFile(ClassFile (..), ConstantInfo (..), MemberInfo(..), Operation(..), Attribute(..), opcodeEncodingLength) +import ByteCode.Generation.Generator +import Data.List +import Data.Char +import ByteCode.Generation.Builder.Field + +assembleExpression :: Assembler Expression +assembleExpression (constants, ops, lvars) (TypedExpression _ (BinaryOperation op a b)) + | elem op [Addition, Subtraction, Multiplication, Division, BitwiseAnd, BitwiseOr, BitwiseXor] = let + (aConstants, aOps, _) = assembleExpression (constants, ops, lvars) a + (bConstants, bOps, _) = assembleExpression (aConstants, aOps, lvars) b + in + (bConstants, bOps ++ [binaryOperation op], lvars) + | elem op [CompareEqual, CompareNotEqual, CompareLessThan, CompareLessOrEqual, CompareGreaterThan, CompareGreaterOrEqual] = let + (aConstants, aOps, _) = assembleExpression (constants, ops, lvars) a + (bConstants, bOps, _) = assembleExpression (aConstants, aOps, lvars) b + cmp_op = comparisonOperation op 9 + 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) + in case etype of + "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 _ (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) diff --git a/src/ByteCode/Generation/Assembler/Method.hs b/src/ByteCode/Generation/Assembler/Method.hs new file mode 100644 index 0000000..c4826c1 --- /dev/null +++ b/src/ByteCode/Generation/Assembler/Method.hs @@ -0,0 +1,20 @@ +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 + +assembleMethod :: Assembler MethodDeclaration +assembleMethod (constants, ops, lvars) (MethodDeclaration _ name _ (TypedStatement _ (Block statements))) + | name == "" = let + (constants_a, ops_a, lvars_a) = foldl assembleStatement (constants, ops, lvars) statements + init_ops = [Opaload 0, Opinvokespecial 2] + in + (constants_a, init_ops ++ ops_a ++ [Opreturn], lvars_a) + | otherwise = let + (constants_a, ops_a, lvars_a) = foldl assembleStatement (constants, ops, lvars) statements + init_ops = [Opaload 0] + in + (constants_a, init_ops ++ ops_a, lvars_a) +assembleMethod _ (MethodDeclaration _ _ _ stmt) = error ("Block expected for method body, got: " ++ show stmt) diff --git a/src/ByteCode/Generation/Assembler/Statement.hs b/src/ByteCode/Generation/Assembler/Statement.hs new file mode 100644 index 0000000..5d80942 --- /dev/null +++ b/src/ByteCode/Generation/Assembler/Statement.hs @@ -0,0 +1,46 @@ +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 + +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 _ stmt = error ("Not yet implemented: " ++ show stmt) diff --git a/src/ByteCode/Generation/Assembler/StatementExpression.hs b/src/ByteCode/Generation/Assembler/StatementExpression.hs new file mode 100644 index 0000000..f1648a2 --- /dev/null +++ b/src/ByteCode/Generation/Assembler/StatementExpression.hs @@ -0,0 +1,18 @@ +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 + +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) \ No newline at end of file diff --git a/src/ByteCode/Generation/Builder/Class.hs b/src/ByteCode/Generation/Builder/Class.hs new file mode 100644 index 0000000..16fef21 --- /dev/null +++ b/src/ByteCode/Generation/Builder/Class.hs @@ -0,0 +1,44 @@ +module ByteCode.Generation.Builder.Class where + +import ByteCode.Generation.Builder.Field +import ByteCode.Generation.Builder.Method +import ByteCode.Generation.Generator +import Ast +import ByteCode.ClassFile(ClassFile (..), ConstantInfo (..), MemberInfo(..), Operation(..), Attribute(..), opcodeEncodingLength) +import ByteCode.Constants + +injectDefaultConstructor :: [MethodDeclaration] -> [MethodDeclaration] +injectDefaultConstructor pre + | any (\(MethodDeclaration _ name _ _) -> name == "") pre = pre + | otherwise = pre ++ [MethodDeclaration "void" "" [] (TypedStatement "void" (Block []))] + + +classBuilder :: ClassFileBuilder Class +classBuilder (Class name methods fields) _ = let + baseConstants = [ + ClassInfo 4, + MethodRefInfo 1 3, + NameAndTypeInfo 5 6, + Utf8Info "java/lang/Object", + Utf8Info "", + Utf8Info "()V", + Utf8Info "Code" + ] + nameConstants = [ClassInfo 9, Utf8Info name] + nakedClassFile = ClassFile { + constantPool = baseConstants ++ nameConstants, + accessFlags = accessPublic, + thisClass = 8, + superClass = 1, + fields = [], + methods = [], + attributes = [] + } + + methodsWithInjectedConstructor = injectDefaultConstructor methods + + classFileWithFields = foldr fieldBuilder nakedClassFile fields + classFileWithMethods = foldr methodBuilder classFileWithFields methodsWithInjectedConstructor + classFileWithAssembledMethods = foldr methodAssembler classFileWithMethods methodsWithInjectedConstructor + in + classFileWithAssembledMethods \ No newline at end of file diff --git a/src/ByteCode/Generation/Builder/Field.hs b/src/ByteCode/Generation/Builder/Field.hs new file mode 100644 index 0000000..ec1f711 --- /dev/null +++ b/src/ByteCode/Generation/Builder/Field.hs @@ -0,0 +1,46 @@ +module ByteCode.Generation.Builder.Field where + +import Ast +import ByteCode.ClassFile(ClassFile (..), ConstantInfo (..), MemberInfo(..), Operation(..), Attribute(..), opcodeEncodingLength) +import ByteCode.Generation.Generator +import ByteCode.Constants +import Data.List + +findFieldIndex :: [ConstantInfo] -> String -> Maybe Int +findFieldIndex constants name = let + fieldRefNameInfos = [ + -- we only skip one entry to get the name since the Java constant pool + -- is 1-indexed (why) + (index, constants!!(fromIntegral index + 1)) + | (index, FieldRefInfo _ _) <- (zip [1..] constants) + ] + fieldRefNames = map (\(index, nameInfo) -> case nameInfo of + Utf8Info fieldName -> (index, fieldName) + something_else -> error ("Expected UTF8Info but got" ++ show something_else)) + fieldRefNameInfos + fieldIndex = find (\(index, fieldName) -> fieldName == name) fieldRefNames + in case fieldIndex of + Just (index, _) -> Just index + Nothing -> Nothing + + +fieldBuilder :: ClassFileBuilder VariableDeclaration +fieldBuilder (VariableDeclaration datatype name _) input = let + baseIndex = 1 + length (constantPool input) + constants = [ + FieldRefInfo (fromIntegral (thisClass input)) (fromIntegral (baseIndex + 1)), + NameAndTypeInfo (fromIntegral (baseIndex + 2)) (fromIntegral (baseIndex + 3)), + Utf8Info name, + Utf8Info (datatypeDescriptor datatype) + ] + field = MemberInfo { + memberAccessFlags = accessPublic, + memberNameIndex = (fromIntegral (baseIndex + 2)), + memberDescriptorIndex = (fromIntegral (baseIndex + 3)), + memberAttributes = [] + } + in + input { + constantPool = (constantPool input) ++ constants, + fields = (fields input) ++ [field] + } diff --git a/src/ByteCode/Generation/Builder/Method.hs b/src/ByteCode/Generation/Builder/Method.hs new file mode 100644 index 0000000..5475d4d --- /dev/null +++ b/src/ByteCode/Generation/Builder/Method.hs @@ -0,0 +1,80 @@ +module ByteCode.Generation.Builder.Method where + +import Ast +import ByteCode.ClassFile(ClassFile (..), ConstantInfo (..), MemberInfo(..), Operation(..), Attribute(..), opcodeEncodingLength) +import ByteCode.Generation.Generator +import ByteCode.Generation.Assembler.Method +import ByteCode.Constants +import Data.List + +methodDescriptor :: MethodDeclaration -> String +methodDescriptor (MethodDeclaration returntype _ parameters _) = let + parameter_types = [datatype | ParameterDeclaration datatype _ <- parameters] + in + "(" + ++ (concat (map methodParameterDescriptor parameter_types)) + ++ ")" + ++ methodParameterDescriptor returntype + +methodParameterDescriptor :: String -> String +methodParameterDescriptor "void" = "V" +methodParameterDescriptor "int" = "I" +methodParameterDescriptor "char" = "C" +methodParameterDescriptor "boolean" = "B" +methodParameterDescriptor x = "L" ++ x ++ ";" + +memberInfoIsMethod :: [ConstantInfo] -> MemberInfo -> Bool +memberInfoIsMethod constants info = elem '(' (memberInfoDescriptor constants info) + +findMethodIndex :: ClassFile -> String -> Maybe Int +findMethodIndex classFile name = let + constants = constantPool classFile + in + findIndex (\method -> ((memberInfoIsMethod constants method) && (memberInfoName constants method) == name)) (methods classFile) + + +methodBuilder :: ClassFileBuilder MethodDeclaration +methodBuilder (MethodDeclaration returntype name parameters statement) input = let + baseIndex = 1 + length (constantPool input) + constants = [ + Utf8Info name, + Utf8Info (methodDescriptor (MethodDeclaration returntype name parameters (Block []))) + ] + + method = MemberInfo { + memberAccessFlags = accessPublic, + memberNameIndex = (fromIntegral baseIndex), + memberDescriptorIndex = (fromIntegral (baseIndex + 1)), + memberAttributes = [] + } + in + input { + constantPool = (constantPool input) ++ constants, + methods = (methods input) ++ [method] + } + + + +methodAssembler :: ClassFileBuilder MethodDeclaration +methodAssembler (MethodDeclaration returntype name parameters statement) input = let + methodConstantIndex = findMethodIndex input name + in case methodConstantIndex of + Nothing -> error ("Cannot find method entry in method pool for method: " ++ name) + Just index -> let + declaration = MethodDeclaration returntype name parameters statement + paramNames = "this" : [name | ParameterDeclaration _ name <- parameters] + (pre, method : post) = splitAt index (methods input) + (_, bytecode, _) = assembleMethod (constantPool input, [], paramNames) declaration + assembledMethod = method { + memberAttributes = [ + CodeAttribute { + attributeMaxStack = 420, + attributeMaxLocals = 420, + attributeCode = bytecode + } + ] + } + in + input { + methods = pre ++ (assembledMethod : post) + } diff --git a/src/ByteCode/Generation/Generator.hs b/src/ByteCode/Generation/Generator.hs new file mode 100644 index 0000000..6d42ba0 --- /dev/null +++ b/src/ByteCode/Generation/Generator.hs @@ -0,0 +1,73 @@ +module ByteCode.Generation.Generator( + datatypeDescriptor, + memberInfoName, + memberInfoDescriptor, + returnOperation, + binaryOperation, + comparisonOperation, + ClassFileBuilder, + Assembler +) where + +import ByteCode.Constants +import ByteCode.ClassFile (ClassFile (..), ConstantInfo (..), MemberInfo(..), Operation(..), Attribute(..), opcodeEncodingLength) +import Ast +import Data.Char +import Data.List +import Data.Word + +type ClassFileBuilder a = a -> ClassFile -> ClassFile +type Assembler a = ([ConstantInfo], [Operation], [String]) -> a -> ([ConstantInfo], [Operation], [String]) + +datatypeDescriptor :: String -> String +datatypeDescriptor "void" = "V" +datatypeDescriptor "int" = "I" +datatypeDescriptor "char" = "C" +datatypeDescriptor "boolean" = "B" +datatypeDescriptor x = "L" ++ x + +memberInfoDescriptor :: [ConstantInfo] -> MemberInfo -> String +memberInfoDescriptor constants MemberInfo { + memberAccessFlags = _, + memberNameIndex = _, + memberDescriptorIndex = descriptorIndex, + memberAttributes = _ } = let + descriptor = constants!!((fromIntegral descriptorIndex) - 1) + in case descriptor of + Utf8Info descriptorText -> descriptorText + _ -> ("Invalid Item at Constant pool index " ++ show descriptorIndex) + + +memberInfoName :: [ConstantInfo] -> MemberInfo -> String +memberInfoName constants MemberInfo { + memberAccessFlags = _, + memberNameIndex = nameIndex, + memberDescriptorIndex = _, + memberAttributes = _ } = let + name = constants!!((fromIntegral nameIndex) - 1) + in case name of + Utf8Info nameText -> nameText + _ -> ("Invalid Item at Constant pool index " ++ show nameIndex) + + +returnOperation :: DataType -> Operation +returnOperation dtype + | elem dtype ["int", "char", "boolean"] = Opireturn + | otherwise = Opareturn + +binaryOperation :: BinaryOperator -> Operation +binaryOperation Addition = Opiadd +binaryOperation Subtraction = Opisub +binaryOperation Multiplication = Opimul +binaryOperation Division = Opidiv +binaryOperation BitwiseAnd = Opiand +binaryOperation BitwiseOr = Opior +binaryOperation BitwiseXor = Opixor + +comparisonOperation :: BinaryOperator -> Word16 -> Operation +comparisonOperation CompareEqual branchLocation = Opif_icmpeq branchLocation +comparisonOperation CompareNotEqual branchLocation = Opif_icmpne branchLocation +comparisonOperation CompareLessThan branchLocation = Opif_icmplt branchLocation +comparisonOperation CompareLessOrEqual branchLocation = Opif_icmple branchLocation +comparisonOperation CompareGreaterThan branchLocation = Opif_icmpgt branchLocation +comparisonOperation CompareGreaterOrEqual branchLocation = Opif_icmpge branchLocation \ No newline at end of file diff --git a/src/Main.hs b/src/Main.hs index 858d5bb..588efc2 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -4,7 +4,8 @@ import Example import Typecheck import Parser.Lexer (alexScanTokens) import Parser.JavaParser -import ByteCode.ClassFile.Generator +import ByteCode.Generation.Generator +import ByteCode.Generation.Builder.Class import ByteCode.ClassFile import Data.ByteString (pack, writeFile) From f81a812f59f95d1c2fb7e20ab462015d0646ef53 Mon Sep 17 00:00:00 2001 From: Marvin Schlegel Date: Thu, 16 May 2024 11:15:41 +0200 Subject: [PATCH 65/98] parser add assigment statement --- src/Parser/JavaParser.y | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/src/Parser/JavaParser.y b/src/Parser/JavaParser.y index 513b198..7002706 100644 --- a/src/Parser/JavaParser.y +++ b/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 { } - | preincrementexpression { } - | predecrementexpression { } - | postincrementexpression { } - | postdecrementexpression { } - | methodinvocation { } - | classinstancecreationexpression { } +statementexpression : assignment { $1 } + -- | preincrementexpression { } + -- | predecrementexpression { } + -- | postincrementexpression { } + -- | postdecrementexpression { } + -- | methodinvocation { } + -- | classinstancecreationexpression { } ifthenelsestatementnoshortif :IF LBRACE expression RBRACE statementnoshortif ELSE statementnoshortif { } From c347e6c630e65d5848303f35ca80860f9a49dca4 Mon Sep 17 00:00:00 2001 From: Marvin Schlegel Date: Thu, 16 May 2024 11:31:58 +0200 Subject: [PATCH 66/98] add test --- Test/TestParser.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/Test/TestParser.hs b/Test/TestParser.hs index bf874fc..5869961 100644 --- a/Test/TestParser.hs +++ b/Test/TestParser.hs @@ -179,6 +179,9 @@ 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] @@ -233,5 +236,6 @@ tests = TestList [ testExpressionPrecedence, testStatementIfThen, testStatementIfThenElse, - testStatementWhile + testStatementWhile, + testStatementAssign ] \ No newline at end of file From 6f4143a60a5bf58e8832099c41b4be24d9052798 Mon Sep 17 00:00:00 2001 From: mrab Date: Thu, 16 May 2024 11:42:48 +0200 Subject: [PATCH 67/98] increment/decrement --- src/ByteCode/ClassFile.hs | 3 + .../Generation/Assembler/Expression.hs | 98 +++++++++++++++++++ .../Generation/Assembler/Statement.hs | 5 + .../Assembler/StatementExpression.hs | 13 ++- 4 files changed, 118 insertions(+), 1 deletion(-) diff --git a/src/ByteCode/ClassFile.hs b/src/ByteCode/ClassFile.hs index 37481db..358b91a 100644 --- a/src/ByteCode/ClassFile.hs +++ b/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 diff --git a/src/ByteCode/Generation/Assembler/Expression.hs b/src/ByteCode/Generation/Assembler/Expression.hs index a7f3d15..6921956 100644 --- a/src/ByteCode/Generation/Assembler/Expression.hs +++ b/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) diff --git a/src/ByteCode/Generation/Assembler/Statement.hs b/src/ByteCode/Generation/Assembler/Statement.hs index 5d80942..ed4dcc9 100644 --- a/src/ByteCode/Generation/Assembler/Statement.hs +++ b/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) diff --git a/src/ByteCode/Generation/Assembler/StatementExpression.hs b/src/ByteCode/Generation/Assembler/StatementExpression.hs index f1648a2..e9fcb07 100644 --- a/src/ByteCode/Generation/Assembler/StatementExpression.hs +++ b/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) @@ -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) \ No newline at end of file + 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) \ No newline at end of file From 3c70f9f1f64bf77028ff7c308ab52ea18261be89 Mon Sep 17 00:00:00 2001 From: Marvin Schlegel Date: Thu, 16 May 2024 11:49:52 +0200 Subject: [PATCH 68/98] parser add methodcall no params --- Test/TestParser.hs | 12 +++++++++++- src/Parser/JavaParser.y | 12 ++++++------ 2 files changed, 17 insertions(+), 7 deletions(-) diff --git a/Test/TestParser.hs b/Test/TestParser.hs index 5869961..e97d793 100644 --- a/Test/TestParser.hs +++ b/Test/TestParser.hs @@ -170,6 +170,10 @@ 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] + testStatementIfThen = TestCase $ assertEqual "expect empty ifthen" [If (Reference "a") (Block [Block []]) Nothing] $ parseStatement [IF,LBRACE,IDENTIFIER "a",RBRACE,LBRACKET,RBRACKET] @@ -183,6 +187,10 @@ 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] + tests = TestList [ @@ -234,8 +242,10 @@ tests = TestList [ testExpressionBraced, testExpressionThis, testExpressionPrecedence, + testExpressionMethodCallNoParams, testStatementIfThen, testStatementIfThenElse, testStatementWhile, - testStatementAssign + testStatementAssign, + testStatementMethodCallNoParams ] \ No newline at end of file diff --git a/src/Parser/JavaParser.y b/src/Parser/JavaParser.y index 7002706..07c11b5 100644 --- a/src/Parser/JavaParser.y +++ b/src/Parser/JavaParser.y @@ -253,7 +253,7 @@ statementexpression : assignment { $1 } -- | predecrementexpression { } -- | postincrementexpression { } -- | postdecrementexpression { } - -- | methodinvocation { } + | methodinvocation { $1 } -- | classinstancecreationexpression { } ifthenelsestatementnoshortif :IF LBRACE expression RBRACE statementnoshortif @@ -287,10 +287,10 @@ postincrementexpression : postfixexpression INCREMENT { UnaryOperation PostIncre postdecrementexpression : postfixexpression DECREMENT { UnaryOperation PostDecrement $1 } -methodinvocation : name LBRACE RBRACE { } - | name LBRACE argumentlist RBRACE { } - | primary DOT IDENTIFIER LBRACE RBRACE { } - | primary DOT IDENTIFIER LBRACE argumentlist RBRACE { } +methodinvocation : simplename LBRACE RBRACE { MethodCall (Reference "this") $1 [] } + -- | 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 { } @@ -320,7 +320,7 @@ primarynonewarray : literal { $1 } | LBRACE expression RBRACE { $2 } -- | classinstancecreationexpression { } -- | fieldaccess { } - -- | methodinvocation { } + | methodinvocation { StatementExpressionExpression $1 } unaryexpressionnotplusminus : postfixexpression { $1 } -- | TILDE unaryexpression { } From 24c2920c9c0c38410f53c6c67a8b83871aadfa71 Mon Sep 17 00:00:00 2001 From: Marvin Schlegel Date: Thu, 16 May 2024 11:58:27 +0200 Subject: [PATCH 69/98] parser implement methodcall with params --- Test/TestParser.hs | 8 ++++++++ src/Parser/JavaParser.y | 6 +++--- 2 files changed, 11 insertions(+), 3 deletions(-) diff --git a/Test/TestParser.hs b/Test/TestParser.hs index e97d793..c22968c 100644 --- a/Test/TestParser.hs +++ b/Test/TestParser.hs @@ -173,6 +173,12 @@ testExpressionPrecedence = TestCase $ 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] testStatementIfThen = TestCase $ assertEqual "expect empty ifthen" [If (Reference "a") (Block [Block []]) Nothing] $ @@ -243,6 +249,8 @@ tests = TestList [ testExpressionThis, testExpressionPrecedence, testExpressionMethodCallNoParams, + testExpressionMethodCallOneParam, + testExpressionMethodCallTwoParams, testStatementIfThen, testStatementIfThenElse, testStatementWhile, diff --git a/src/Parser/JavaParser.y b/src/Parser/JavaParser.y index 07c11b5..068a821 100644 --- a/src/Parser/JavaParser.y +++ b/src/Parser/JavaParser.y @@ -189,8 +189,8 @@ blockstatement : localvariabledeclarationstatement { $1 } -- expected ty formalparameter : type variabledeclaratorid { ParameterDeclaration $1 $2 } -argumentlist : expression { } - | argumentlist COMMA expression { } +argumentlist : expression { [$1] } + | argumentlist COMMA expression { $1 ++ [$3] } numerictype : integraltype { $1 } @@ -288,7 +288,7 @@ postincrementexpression : postfixexpression INCREMENT { UnaryOperation PostIncre postdecrementexpression : postfixexpression DECREMENT { UnaryOperation PostDecrement $1 } methodinvocation : simplename LBRACE RBRACE { MethodCall (Reference "this") $1 [] } - -- | name LBRACE argumentlist RBRACE { } + | simplename LBRACE argumentlist RBRACE { MethodCall (Reference "this") $1 $3 } -- | primary DOT IDENTIFIER LBRACE RBRACE { } -- | primary DOT IDENTIFIER LBRACE argumentlist RBRACE { } From 067bf8d7965af5da0ff2bfe946a6b36f289f13f0 Mon Sep 17 00:00:00 2001 From: Fabian Noll Date: Sun, 19 May 2024 09:20:43 +0200 Subject: [PATCH 70/98] refactor: move incremental types to statementsexpressions --- src/Ast.hs | 8 ++--- src/Example.hs | 10 ++++++ src/Typecheck.hs | 79 +++++++++++++++++++++++------------------------- 3 files changed, 52 insertions(+), 45 deletions(-) diff --git a/src/Ast.hs b/src/Ast.hs index 9634ab8..a20b8e8 100644 --- a/src/Ast.hs +++ b/src/Ast.hs @@ -24,6 +24,10 @@ 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 @@ -49,10 +53,6 @@ data BinaryOperator data UnaryOperator = Not | Minus - | PostIncrement - | PostDecrement - | PreIncrement - | PreDecrement deriving (Show, Eq) data Expression diff --git a/src/Example.hs b/src/Example.hs index 080b738..03ff209 100644 --- a/src/Example.hs +++ b/src/Example.hs @@ -110,6 +110,9 @@ exampleNullDeclarationFail = LocalVariableDeclaration (VariableDeclaration "int" exampleNullAssignment :: Statement exampleNullAssignment = StatementExpressionStatement (Assignment (Reference "a") NullLiteral) +exampleIncrement :: Statement +exampleIncrement = StatementExpressionStatement (PostIncrement (Reference "a")) + testClasses :: [Class] testClasses = [ Class "Person" [ @@ -255,3 +258,10 @@ 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 diff --git a/src/Typecheck.hs b/src/Typecheck.hs index 5834f57..bac30a7 100644 --- a/src/Typecheck.hs +++ b/src/Typecheck.hs @@ -89,50 +89,11 @@ typeCheckExpression (UnaryOperation op expr) symtab classes = else error "Logical NOT operation requires an operand of type boolean" Minus -> - if type' == "int" + if type' == "int" || type' == "char" then - TypedExpression "int" (UnaryOperation op expr') - else if type' == "char" - then - TypedExpression "char" (UnaryOperation op expr') + TypedExpression type' (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 @@ -202,6 +163,42 @@ 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 From 6ab64371b5a7595160731bf79b40c644816520f9 Mon Sep 17 00:00:00 2001 From: MisterChaos96 Date: Sun, 26 May 2024 21:45:11 +0200 Subject: [PATCH 71/98] feat: Add support for block statements in type checking --- src/Typecheck.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Typecheck.hs b/src/Typecheck.hs index 5834f57..1bfda74 100644 --- a/src/Typecheck.hs +++ b/src/Typecheck.hs @@ -258,6 +258,7 @@ 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 From f4d31a85ccd49aafeb2835900ce5ba4f9977dec3 Mon Sep 17 00:00:00 2001 From: Marvin Schlegel Date: Tue, 28 May 2024 23:27:23 +0200 Subject: [PATCH 72/98] parser add dot method call --- Test/TestParser.hs | 8 ++++++++ src/Parser/JavaParser.y | 4 ++-- 2 files changed, 10 insertions(+), 2 deletions(-) diff --git a/Test/TestParser.hs b/Test/TestParser.hs index c22968c..63f4dc1 100644 --- a/Test/TestParser.hs +++ b/Test/TestParser.hs @@ -179,6 +179,12 @@ testExpressionMethodCallOneParam = TestCase $ 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] $ @@ -251,6 +257,8 @@ tests = TestList [ testExpressionMethodCallNoParams, testExpressionMethodCallOneParam, testExpressionMethodCallTwoParams, + testExpressionThisMethodCall, + testExpressionThisMethodCallParam, testStatementIfThen, testStatementIfThenElse, testStatementWhile, diff --git a/src/Parser/JavaParser.y b/src/Parser/JavaParser.y index 068a821..d51b376 100644 --- a/src/Parser/JavaParser.y +++ b/src/Parser/JavaParser.y @@ -289,8 +289,8 @@ postdecrementexpression : postfixexpression DECREMENT { UnaryOperation PostDecre methodinvocation : simplename LBRACE RBRACE { MethodCall (Reference "this") $1 [] } | simplename LBRACE argumentlist RBRACE { MethodCall (Reference "this") $1 $3 } - -- | primary DOT IDENTIFIER LBRACE RBRACE { } - -- | primary DOT IDENTIFIER LBRACE argumentlist RBRACE { } + | primary DOT IDENTIFIER LBRACE RBRACE { MethodCall $1 $3 [] } + | primary DOT IDENTIFIER LBRACE argumentlist RBRACE { MethodCall $1 $3 $5 } classinstancecreationexpression : NEW classtype LBRACE RBRACE { } | NEW classtype LBRACE argumentlist RBRACE { } From 1e59ba9e277f291285983f21347a605deefa3811 Mon Sep 17 00:00:00 2001 From: Marvin Schlegel Date: Tue, 28 May 2024 23:47:34 +0200 Subject: [PATCH 73/98] parser implement constructor with statements --- Test/TestParser.hs | 8 ++++++++ src/Parser/JavaParser.y | 10 +++++----- 2 files changed, 13 insertions(+), 5 deletions(-) diff --git a/Test/TestParser.hs b/Test/TestParser.hs index 63f4dc1..8e8db60 100644 --- a/Test/TestParser.hs +++ b/Test/TestParser.hs @@ -52,6 +52,12 @@ testClassWithMethodAndField = TestCase $ testClassWithConstructor = TestCase $ assertEqual "expect class with constructor" [Class "WithConstructor" [MethodDeclaration "void" "" [] (Block [])] []] $ parse [CLASS,IDENTIFIER "WithConstructor",LBRACKET,IDENTIFIER "WithConstructor",LBRACE,RBRACE,LBRACKET,RBRACKET,RBRACKET] +testConstructorWithParams = TestCase $ + assertEqual "expect constructor with params" [Class "WithParams" [MethodDeclaration "void" "" [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" "" [] (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] @@ -220,6 +226,8 @@ tests = TestList [ testEmptyMethodWithParams, testClassWithMethodAndField, testClassWithConstructor, + testConstructorWithParams, + testConstructorWithStatements, testEmptyBlock, testBlockWithLocalVarDecl, testBlockWithMultipleLocalVarDecls, diff --git a/src/Parser/JavaParser.y b/src/Parser/JavaParser.y index d51b376..45206a5 100644 --- a/src/Parser/JavaParser.y +++ b/src/Parser/JavaParser.y @@ -127,8 +127,8 @@ classorinterfacetype : simplename { $1 } classmemberdeclaration : fielddeclaration { $1 } | methoddeclaration { $1 } -constructordeclaration : constructordeclarator constructorbody { case $1 of (classname, parameters) -> MethodDecl $ MethodDeclaration "void" "" parameters $2 } - | modifiers constructordeclarator constructorbody { case $2 of (classname, parameters) -> MethodDecl $ MethodDeclaration "void" "" parameters $3 } +constructordeclaration : constructordeclarator constructorbody { MethodDecl $ MethodDeclaration "void" "" $1 $2 } + | modifiers constructordeclarator constructorbody { MethodDecl $ MethodDeclaration "void" "" $2 $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 { ($1, []) } - | simplename LBRACE formalparameterlist RBRACE { ($1, $3) } +constructordeclarator : simplename LBRACE RBRACE { [] } + | simplename LBRACE formalparameterlist RBRACE { $3 } constructorbody : LBRACKET RBRACKET { Block [] } -- | LBRACKET explicitconstructorinvocation RBRACKET { } - -- | LBRACKET blockstatements RBRACKET { } + | LBRACKET blockstatements RBRACKET { Block $2 } -- | LBRACKET explicitconstructorinvocation blockstatements RBRACKET { } methodheader : type methoddeclarator { ($1, $2) } From 25c0c331091e90e8fcd071e534cdf75a910e9ef3 Mon Sep 17 00:00:00 2001 From: Fabian Noll Date: Fri, 31 May 2024 10:00:12 +0200 Subject: [PATCH 74/98] make UnaryOperation a statementexpression --- src/Ast.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/Ast.hs b/src/Ast.hs index a20b8e8..9fb1cea 100644 --- a/src/Ast.hs +++ b/src/Ast.hs @@ -24,10 +24,7 @@ data StatementExpression | ConstructorCall DataType [Expression] | MethodCall Expression Identifier [Expression] | TypedStatementExpression DataType StatementExpression - | PostIncrement Expression - | PostDecrement Expression - | PreIncrement Expression - | PreDecrement Expression + | UnaryOperation UnaryOperator Expression deriving (Show, Eq) data BinaryOperator @@ -53,6 +50,10 @@ data BinaryOperator data UnaryOperator = Not | Minus + | PostIncrement Expression + | PostDecrement Expression + | PreIncrement Expression + | PreDecrement Expression deriving (Show, Eq) data Expression @@ -64,7 +65,6 @@ data Expression | LocalVariable Identifier | FieldVariable Identifier | BinaryOperation BinaryOperator Expression Expression - | UnaryOperation UnaryOperator Expression | StatementExpressionExpression StatementExpression | TypedExpression DataType Expression deriving (Show, Eq) From 56cc1a93744ab85d49282fe333f94e50429e68e8 Mon Sep 17 00:00:00 2001 From: Fabian Noll Date: Fri, 31 May 2024 10:02:53 +0200 Subject: [PATCH 75/98] remove expression from unary operators --- src/Ast.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/Ast.hs b/src/Ast.hs index 9fb1cea..750200c 100644 --- a/src/Ast.hs +++ b/src/Ast.hs @@ -50,10 +50,10 @@ data BinaryOperator data UnaryOperator = Not | Minus - | PostIncrement Expression - | PostDecrement Expression - | PreIncrement Expression - | PreDecrement Expression + | PostIncrement + | PostDecrement + | PreIncrement + | PreDecrement deriving (Show, Eq) data Expression From c690b0139634a89bf6c7dca6013778ee3dd892d0 Mon Sep 17 00:00:00 2001 From: Fabian Noll Date: Fri, 31 May 2024 10:07:01 +0200 Subject: [PATCH 76/98] change back UnaryOperation and move it to StatementExpression --- src/Typecheck.hs | 102 ++++++++++++++++++++++++----------------------- 1 file changed, 53 insertions(+), 49 deletions(-) diff --git a/src/Typecheck.hs b/src/Typecheck.hs index ba49157..0564ce9 100644 --- a/src/Typecheck.hs +++ b/src/Typecheck.hs @@ -78,22 +78,6 @@ typeCheckExpression (BinaryOperation op expr1 expr2) symtab classes = Or -> checkLogicalOperation op expr1' expr2' type1 type2 NameResolution -> resolveNameResolution expr1' expr2 symtab classes -typeCheckExpression (UnaryOperation op expr) symtab classes = - let expr' = typeCheckExpression expr symtab classes - type' = getTypeFromExpr expr' - in case op of - Not -> - if type' == "boolean" - then - TypedExpression "boolean" (UnaryOperation op expr') - else - error "Logical NOT operation requires an operand of type boolean" - Minus -> - if type' == "int" || type' == "char" - then - TypedExpression type' (UnaryOperation op expr') - else - error "Unary minus operation requires an operand of type int or char" typeCheckExpression (StatementExpressionExpression stmtExpr) symtab classes = let stmtExpr' = typeCheckStatementExpression stmtExpr symtab classes @@ -163,41 +147,61 @@ 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 = +typeCheckStatementExpression (UnaryOperation op 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" + in case op of + Not -> + if type' == "boolean" + then + TypedStatementExpression "boolean" (UnaryOperation op expr') + else + error "Logical NOT operation requires an operand of type boolean" + Minus -> + if type' == "int" + then + TypedStatementExpression "int" (UnaryOperation op expr') + else if type' == "char" + then + TypedStatementExpression "char" (UnaryOperation op expr') + else + error "Unary minus operation requires an operand of type int or char" + PostIncrement -> + if type' == "int" + then + TypedStatementExpression "int" (UnaryOperation op expr') + else if type' == "char" + then + TypedStatementExpression "char" (UnaryOperation op expr') + else + error "Post-increment operation requires an operand of type int or char" + PostDecrement -> + if type' == "int" + then + TypedStatementExpression "int" (UnaryOperation op expr') + else if type' == "char" + then + TypedStatementExpression "char" (UnaryOperation op expr') + else + error "Post-decrement operation requires an operand of type int or char" + PreIncrement -> + if type' == "int" + then + TypedStatementExpression "int" (UnaryOperation op expr') + else if type' == "char" + then + TypedStatementExpression "char" (UnaryOperation op expr') + else + error "Pre-increment operation requires an operand of type int or char" + PreDecrement -> + if type' == "int" + then + TypedStatementExpression "int" (UnaryOperation op expr') + else if type' == "char" + then + TypedStatementExpression "char" (UnaryOperation op expr') + else + error "Pre-decrement operation requires an operand of type int or char" -- ********************************** Type Checking: Statements ********************************** From 761244df747909f49b3e7aa99c9181bae2118b6a Mon Sep 17 00:00:00 2001 From: Fabian Noll Date: Fri, 31 May 2024 10:34:42 +0200 Subject: [PATCH 77/98] Revert "change back UnaryOperation and move it to StatementExpression" This reverts commit c690b0139634a89bf6c7dca6013778ee3dd892d0. --- src/Typecheck.hs | 102 +++++++++++++++++++++++------------------------ 1 file changed, 49 insertions(+), 53 deletions(-) diff --git a/src/Typecheck.hs b/src/Typecheck.hs index 0564ce9..ba49157 100644 --- a/src/Typecheck.hs +++ b/src/Typecheck.hs @@ -78,6 +78,22 @@ typeCheckExpression (BinaryOperation op expr1 expr2) symtab classes = Or -> checkLogicalOperation op expr1' expr2' type1 type2 NameResolution -> resolveNameResolution expr1' expr2 symtab classes +typeCheckExpression (UnaryOperation op expr) symtab classes = + let expr' = typeCheckExpression expr symtab classes + type' = getTypeFromExpr expr' + in case op of + Not -> + if type' == "boolean" + then + TypedExpression "boolean" (UnaryOperation op expr') + else + error "Logical NOT operation requires an operand of type boolean" + Minus -> + if type' == "int" || type' == "char" + then + TypedExpression type' (UnaryOperation op expr') + else + error "Unary minus operation requires an operand of type int or char" typeCheckExpression (StatementExpressionExpression stmtExpr) symtab classes = let stmtExpr' = typeCheckStatementExpression stmtExpr symtab classes @@ -147,61 +163,41 @@ 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 (UnaryOperation op expr) symtab classes = +typeCheckStatementExpression (PostIncrement expr) symtab classes = let expr' = typeCheckExpression expr symtab classes type' = getTypeFromExpr expr' - in case op of - Not -> - if type' == "boolean" - then - TypedStatementExpression "boolean" (UnaryOperation op expr') - else - error "Logical NOT operation requires an operand of type boolean" - Minus -> - if type' == "int" - then - TypedStatementExpression "int" (UnaryOperation op expr') - else if type' == "char" - then - TypedStatementExpression "char" (UnaryOperation op expr') - else - error "Unary minus operation requires an operand of type int or char" - PostIncrement -> - if type' == "int" - then - TypedStatementExpression "int" (UnaryOperation op expr') - else if type' == "char" - then - TypedStatementExpression "char" (UnaryOperation op expr') - else - error "Post-increment operation requires an operand of type int or char" - PostDecrement -> - if type' == "int" - then - TypedStatementExpression "int" (UnaryOperation op expr') - else if type' == "char" - then - TypedStatementExpression "char" (UnaryOperation op expr') - else - error "Post-decrement operation requires an operand of type int or char" - PreIncrement -> - if type' == "int" - then - TypedStatementExpression "int" (UnaryOperation op expr') - else if type' == "char" - then - TypedStatementExpression "char" (UnaryOperation op expr') - else - error "Pre-increment operation requires an operand of type int or char" - PreDecrement -> - if type' == "int" - then - TypedStatementExpression "int" (UnaryOperation op expr') - else if type' == "char" - then - TypedStatementExpression "char" (UnaryOperation op expr') - else - error "Pre-decrement operation requires an operand of type int or char" + 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 ********************************** From d4f474ba543d905f0ebbbdad277ff19b323eef60 Mon Sep 17 00:00:00 2001 From: Marvin Schlegel Date: Fri, 31 May 2024 10:34:47 +0200 Subject: [PATCH 78/98] fix increment --- Test/TestParser.hs | 61 ++++++++++++++++++++++++++++++++++++---- src/Parser/JavaParser.y | 62 ++++++++++++++++++++--------------------- 2 files changed, 87 insertions(+), 36 deletions(-) diff --git a/Test/TestParser.hs b/Test/TestParser.hs index 873f438..090fac1 100644 --- a/Test/TestParser.hs +++ b/Test/TestParser.hs @@ -52,6 +52,12 @@ testClassWithMethodAndField = TestCase $ testClassWithConstructor = TestCase $ assertEqual "expect class with constructor" [Class "WithConstructor" [MethodDeclaration "void" "" [] (Block [])] []] $ parse [CLASS,IDENTIFIER "WithConstructor",LBRACKET,IDENTIFIER "WithConstructor",LBRACE,RBRACE,LBRACKET,RBRACKET,RBRACKET] +testConstructorWithParams = TestCase $ + assertEqual "expect constructor with params" [Class "WithParams" [MethodDeclaration "void" "" [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" "" [] (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] @@ -133,16 +139,16 @@ testExpressionOr = TestCase $ assertEqual "expect or expression" (BinaryOperation Or (Reference "bar") (Reference "baz")) $ parseExpression [IDENTIFIER "bar",OR,IDENTIFIER "baz"] testExpressionPostIncrement = TestCase $ - assertEqual "expect PostIncrement" (UnaryOperation PostIncrement (Reference "a")) $ + assertEqual "expect PostIncrement" (StatementExpressionExpression $ PostIncrement (Reference "a")) $ parseExpression [IDENTIFIER "a",INCREMENT] testExpressionPostDecrement = TestCase $ - assertEqual "expect PostDecrement" (UnaryOperation PostDecrement (Reference "a")) $ + assertEqual "expect PostDecrement" (StatementExpressionExpression $ PostDecrement (Reference "a")) $ parseExpression [IDENTIFIER "a",DECREMENT] testExpressionPreIncrement = TestCase $ - assertEqual "expect PreIncrement" (UnaryOperation PreIncrement (Reference "a")) $ + assertEqual "expect PreIncrement" (StatementExpressionExpression $ PreIncrement (Reference "a")) $ parseExpression [INCREMENT,IDENTIFIER "a"] testExpressionPreDecrement = TestCase $ - assertEqual "expect PreIncrement" (UnaryOperation PreDecrement (Reference "a")) $ + assertEqual "expect PreIncrement" (StatementExpressionExpression $ PreDecrement (Reference "a")) $ parseExpression [DECREMENT,IDENTIFIER "a"] testExpressionAssign = TestCase $ assertEqual "expect assign 5 to a" (StatementExpressionExpression (Assignment (Reference "a") (IntegerLiteral 5))) $ @@ -159,6 +165,32 @@ 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] + +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] $ @@ -169,6 +201,13 @@ 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] @@ -187,6 +226,8 @@ tests = TestList [ testEmptyMethodWithParams, testClassWithMethodAndField, testClassWithConstructor, + testConstructorWithParams, + testConstructorWithStatements, testEmptyBlock, testBlockWithLocalVarDecl, testBlockWithMultipleLocalVarDecls, @@ -218,7 +259,17 @@ tests = TestList [ testExpressionDivideEqual, testExpressionPlusEqual, testExpressionMinusEqual, + testExpressionBraced, + testExpressionThis, + testExpressionPrecedence, + testExpressionMethodCallNoParams, + testExpressionMethodCallOneParam, + testExpressionMethodCallTwoParams, + testExpressionThisMethodCall, + testExpressionThisMethodCallParam, testStatementIfThen, testStatementIfThenElse, - testStatementWhile + testStatementWhile, + testStatementAssign, + testStatementMethodCallNoParams ] \ No newline at end of file diff --git a/src/Parser/JavaParser.y b/src/Parser/JavaParser.y index 4e66850..21d7be1 100644 --- a/src/Parser/JavaParser.y +++ b/src/Parser/JavaParser.y @@ -127,8 +127,8 @@ classorinterfacetype : simplename { $1 } classmemberdeclaration : fielddeclaration { $1 } | methoddeclaration { $1 } -constructordeclaration : constructordeclarator constructorbody { case $1 of (classname, parameters) -> MethodDecl $ MethodDeclaration "void" "" parameters $2 } - | modifiers constructordeclarator constructorbody { case $2 of (classname, parameters) -> MethodDecl $ MethodDeclaration "void" "" parameters $3 } +constructordeclaration : constructordeclarator constructorbody { MethodDecl $ MethodDeclaration "void" "" $1 $2 } + | modifiers constructordeclarator constructorbody { MethodDecl $ MethodDeclaration "void" "" $2 $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 { ($1, []) } - | simplename LBRACE formalparameterlist RBRACE { ($1, $3) } +constructordeclarator : simplename LBRACE RBRACE { [] } + | simplename LBRACE formalparameterlist RBRACE { $3 } constructorbody : LBRACKET RBRACKET { Block [] } -- | LBRACKET explicitconstructorinvocation RBRACKET { } - -- | LBRACKET blockstatements RBRACKET { } + | LBRACKET blockstatements RBRACKET { Block $2 } -- | 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 { } - | argumentlist COMMA expression { } +argumentlist : expression { [$1] } + | argumentlist COMMA expression { $1 ++ [$3] } numerictype : integraltype { $1 } @@ -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 { $1 } + -- | classinstancecreationexpression { } ifthenelsestatementnoshortif :IF LBRACE expression RBRACE statementnoshortif ELSE statementnoshortif { } @@ -279,18 +279,18 @@ assignmentoperator : ASSIGN { Nothing } | XOREQUAL { Just BitwiseXor } | OREQUAL{ Just BitwiseOr } -preincrementexpression : INCREMENT unaryexpression { UnaryOperation PreIncrement $2 } +preincrementexpression : INCREMENT unaryexpression { PreIncrement $2 } -predecrementexpression : DECREMENT unaryexpression { UnaryOperation PreDecrement $2 } +predecrementexpression : DECREMENT unaryexpression { PreDecrement $2 } -postincrementexpression : postfixexpression INCREMENT { UnaryOperation PostIncrement $1 } +postincrementexpression : postfixexpression INCREMENT { PostIncrement $1 } -postdecrementexpression : postfixexpression DECREMENT { UnaryOperation PostDecrement $1 } +postdecrementexpression : postfixexpression DECREMENT { PostDecrement $1 } -methodinvocation : name LBRACE RBRACE { } - | name LBRACE argumentlist RBRACE { } - | primary DOT IDENTIFIER LBRACE RBRACE { } - | primary DOT IDENTIFIER LBRACE argumentlist RBRACE { } +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 } 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 { $1 } + | predecrementexpression { StatementExpressionExpression $1 } | PLUS unaryexpression { $2 } | MINUS unaryexpression { UnaryOperation Minus $2 } - | preincrementexpression { $1 } + | preincrementexpression { StatementExpressionExpression $1 } postfixexpression : primary { $1 } | name { $1 } - | postincrementexpression { $1 } - | postdecrementexpression{ $1 } + | postincrementexpression { StatementExpressionExpression $1 } + | postdecrementexpression { StatementExpressionExpression $1 } primary : primarynonewarray { $1 } @@ -316,11 +316,11 @@ 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 { } + | methodinvocation { StatementExpressionExpression $1 } unaryexpressionnotplusminus : postfixexpression { $1 } -- | TILDE unaryexpression { } From 8cf022e6e07d66df90313b01bb035917b97fe724 Mon Sep 17 00:00:00 2001 From: Fabian Noll Date: Fri, 31 May 2024 10:34:48 +0200 Subject: [PATCH 79/98] Revert "remove expression from unary operators" This reverts commit 56cc1a93744ab85d49282fe333f94e50429e68e8. --- src/Ast.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/Ast.hs b/src/Ast.hs index 750200c..9fb1cea 100644 --- a/src/Ast.hs +++ b/src/Ast.hs @@ -50,10 +50,10 @@ data BinaryOperator data UnaryOperator = Not | Minus - | PostIncrement - | PostDecrement - | PreIncrement - | PreDecrement + | PostIncrement Expression + | PostDecrement Expression + | PreIncrement Expression + | PreDecrement Expression deriving (Show, Eq) data Expression From 4c82f5bfdd7062f8bfd0a06bdd7e458caf5671eb Mon Sep 17 00:00:00 2001 From: Fabian Noll Date: Fri, 31 May 2024 10:34:52 +0200 Subject: [PATCH 80/98] Revert "make UnaryOperation a statementexpression" This reverts commit 25c0c331091e90e8fcd071e534cdf75a910e9ef3. --- src/Ast.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/Ast.hs b/src/Ast.hs index 9fb1cea..a20b8e8 100644 --- a/src/Ast.hs +++ b/src/Ast.hs @@ -24,7 +24,10 @@ data StatementExpression | ConstructorCall DataType [Expression] | MethodCall Expression Identifier [Expression] | TypedStatementExpression DataType StatementExpression - | UnaryOperation UnaryOperator Expression + | PostIncrement Expression + | PostDecrement Expression + | PreIncrement Expression + | PreDecrement Expression deriving (Show, Eq) data BinaryOperator @@ -50,10 +53,6 @@ data BinaryOperator data UnaryOperator = Not | Minus - | PostIncrement Expression - | PostDecrement Expression - | PreIncrement Expression - | PreDecrement Expression deriving (Show, Eq) data Expression @@ -65,6 +64,7 @@ data Expression | LocalVariable Identifier | FieldVariable Identifier | BinaryOperation BinaryOperator Expression Expression + | UnaryOperation UnaryOperator Expression | StatementExpressionExpression StatementExpression | TypedExpression DataType Expression deriving (Show, Eq) From 408111df5160a2bfcc01bd66b9ddb2c708db681a Mon Sep 17 00:00:00 2001 From: Marvin Schlegel Date: Fri, 31 May 2024 11:04:23 +0200 Subject: [PATCH 81/98] parser implement field access --- Test/TestParser.hs | 8 ++++++++ src/Parser/JavaParser.y | 4 ++-- 2 files changed, 10 insertions(+), 2 deletions(-) diff --git a/Test/TestParser.hs b/Test/TestParser.hs index 090fac1..dee3985 100644 --- a/Test/TestParser.hs +++ b/Test/TestParser.hs @@ -191,6 +191,12 @@ testExpressionThisMethodCall = TestCase $ testExpressionThisMethodCallParam = TestCase $ assertEqual "expect this methocall" (StatementExpressionExpression (MethodCall (Reference "this") "foo" [Reference "x"])) $ parseExpression [THIS,DOT,IDENTIFIER "foo",LBRACE,IDENTIFIER "x",RBRACE] +testExpressionFieldAccess = TestCase $ + assertEqual "expect NameResolution" (BinaryOperation NameResolution (Reference "this") (Reference "b")) $ + parseExpression [THIS,DOT,IDENTIFIER "b"] +testExpressionSimpleFieldAccess = TestCase $ + assertEqual "expect Reference" (Reference "a") $ + parseExpression [IDENTIFIER "a"] testStatementIfThen = TestCase $ assertEqual "expect empty ifthen" [If (Reference "a") (Block [Block []]) Nothing] $ @@ -267,6 +273,8 @@ tests = TestList [ testExpressionMethodCallTwoParams, testExpressionThisMethodCall, testExpressionThisMethodCallParam, + testExpressionFieldAccess, + testExpressionSimpleFieldAccess, testStatementIfThen, testStatementIfThenElse, testStatementWhile, diff --git a/src/Parser/JavaParser.y b/src/Parser/JavaParser.y index 21d7be1..eb47864 100644 --- a/src/Parser/JavaParser.y +++ b/src/Parser/JavaParser.y @@ -297,7 +297,7 @@ classinstancecreationexpression : NEW classtype LBRACE RBRACE { } conditionalandexpression : inclusiveorexpression { $1 } -fieldaccess : primary DOT IDENTIFIER { } +fieldaccess : primary DOT IDENTIFIER { BinaryOperation NameResolution $1 (Reference $3) } unaryexpression : unaryexpressionnotplusminus { $1 } | predecrementexpression { StatementExpressionExpression $1 } @@ -319,7 +319,7 @@ primarynonewarray : literal { $1 } | THIS { Reference "this" } | LBRACE expression RBRACE { $2 } -- | classinstancecreationexpression { } - -- | fieldaccess { } + | fieldaccess { $1 } | methodinvocation { StatementExpressionExpression $1 } unaryexpressionnotplusminus : postfixexpression { $1 } From 84613fabe089c9e8b5bf53c07cdb5d578fab632e Mon Sep 17 00:00:00 2001 From: Marvin Schlegel Date: Fri, 31 May 2024 11:07:19 +0200 Subject: [PATCH 82/98] parser add field subaccess --- Test/TestParser.hs | 4 ++++ src/Parser/JavaParser.y | 4 ++-- 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/Test/TestParser.hs b/Test/TestParser.hs index dee3985..521a615 100644 --- a/Test/TestParser.hs +++ b/Test/TestParser.hs @@ -197,6 +197,9 @@ testExpressionFieldAccess = TestCase $ testExpressionSimpleFieldAccess = TestCase $ assertEqual "expect Reference" (Reference "a") $ parseExpression [IDENTIFIER "a"] +testExpressionFieldSubAccess = TestCase $ + assertEqual "expect NameResolution without this" (BinaryOperation NameResolution (Reference "a") (Reference "b")) $ + parseExpression [IDENTIFIER "a",DOT,IDENTIFIER "b"] testStatementIfThen = TestCase $ assertEqual "expect empty ifthen" [If (Reference "a") (Block [Block []]) Nothing] $ @@ -275,6 +278,7 @@ tests = TestList [ testExpressionThisMethodCallParam, testExpressionFieldAccess, testExpressionSimpleFieldAccess, + testExpressionFieldSubAccess, testStatementIfThen, testStatementIfThenElse, testStatementWhile, diff --git a/src/Parser/JavaParser.y b/src/Parser/JavaParser.y index eb47864..fd694b6 100644 --- a/src/Parser/JavaParser.y +++ b/src/Parser/JavaParser.y @@ -83,11 +83,11 @@ typedeclarations : typedeclaration { [$1] } | typedeclarations typedeclaration { $1 ++ [$2] } name : simplename { Reference $1 } - -- | qualifiedname { } + | qualifiedname { $1 } typedeclaration : classdeclaration { $1 } -qualifiedname : name DOT IDENTIFIER { } +qualifiedname : name DOT IDENTIFIER { BinaryOperation NameResolution $1 (Reference $3) } simplename : IDENTIFIER { $1 } From 2acba0f28330613ecc831128c8790a4d3869ff0f Mon Sep 17 00:00:00 2001 From: Marvin Schlegel Date: Fri, 31 May 2024 11:23:25 +0200 Subject: [PATCH 83/98] parser add preincrement and decrement conversion --- Test/TestParser.hs | 4 ++-- src/Parser/JavaParser.y | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/Test/TestParser.hs b/Test/TestParser.hs index 521a615..7c38433 100644 --- a/Test/TestParser.hs +++ b/Test/TestParser.hs @@ -145,10 +145,10 @@ testExpressionPostDecrement = TestCase $ assertEqual "expect PostDecrement" (StatementExpressionExpression $ PostDecrement (Reference "a")) $ parseExpression [IDENTIFIER "a",DECREMENT] testExpressionPreIncrement = TestCase $ - assertEqual "expect PreIncrement" (StatementExpressionExpression $ PreIncrement (Reference "a")) $ + assertEqual "expect PreIncrement" (StatementExpressionExpression $ Assignment (Reference "a") (BinaryOperation Addition (IntegerLiteral 1) (Reference "a"))) $ parseExpression [INCREMENT,IDENTIFIER "a"] testExpressionPreDecrement = TestCase $ - assertEqual "expect PreIncrement" (StatementExpressionExpression $ PreDecrement (Reference "a")) $ + assertEqual "expect PreIncrement" (StatementExpressionExpression $ Assignment (Reference "a") (BinaryOperation Subtraction (IntegerLiteral 1) (Reference "a"))) $ parseExpression [DECREMENT,IDENTIFIER "a"] testExpressionAssign = TestCase $ assertEqual "expect assign 5 to a" (StatementExpressionExpression (Assignment (Reference "a") (IntegerLiteral 5))) $ diff --git a/src/Parser/JavaParser.y b/src/Parser/JavaParser.y index fd694b6..5f19c34 100644 --- a/src/Parser/JavaParser.y +++ b/src/Parser/JavaParser.y @@ -279,9 +279,9 @@ assignmentoperator : ASSIGN { Nothing } | XOREQUAL { Just BitwiseXor } | OREQUAL{ Just BitwiseOr } -preincrementexpression : INCREMENT unaryexpression { PreIncrement $2 } +preincrementexpression : INCREMENT unaryexpression { Assignment $2 (BinaryOperation Addition (IntegerLiteral 1) $2) } -predecrementexpression : DECREMENT unaryexpression { PreDecrement $2 } +predecrementexpression : DECREMENT unaryexpression { Assignment $2 (BinaryOperation Subtraction (IntegerLiteral 1) $2) } postincrementexpression : postfixexpression INCREMENT { PostIncrement $1 } From 2b7d217e8a78f880890bb5ca5a8f44f8d9f996d8 Mon Sep 17 00:00:00 2001 From: mrab Date: Fri, 31 May 2024 11:24:11 +0200 Subject: [PATCH 84/98] moved expression statement and expressionstatement --- project.cabal | 4 +- ...xpression.hs => ExpressionAndStatement.hs} | 255 +++++++++++------- src/ByteCode/Generation/Assembler/Method.hs | 2 +- .../Generation/Assembler/Statement.hs | 51 ---- .../Assembler/StatementExpression.hs | 29 -- 5 files changed, 167 insertions(+), 174 deletions(-) rename src/ByteCode/Generation/Assembler/{Expression.hs => ExpressionAndStatement.hs} (58%) delete mode 100644 src/ByteCode/Generation/Assembler/Statement.hs delete mode 100644 src/ByteCode/Generation/Assembler/StatementExpression.hs diff --git a/project.cabal b/project.cabal index ad9b335..7c0128b 100644 --- a/project.cabal +++ b/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, diff --git a/src/ByteCode/Generation/Assembler/Expression.hs b/src/ByteCode/Generation/Assembler/ExpressionAndStatement.hs similarity index 58% rename from src/ByteCode/Generation/Assembler/Expression.hs rename to src/ByteCode/Generation/Assembler/ExpressionAndStatement.hs index 6921956..4ace628 100644 --- a/src/ByteCode/Generation/Assembler/Expression.hs +++ b/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) diff --git a/src/ByteCode/Generation/Assembler/Method.hs b/src/ByteCode/Generation/Assembler/Method.hs index c4826c1..a1b896e 100644 --- a/src/ByteCode/Generation/Assembler/Method.hs +++ b/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))) diff --git a/src/ByteCode/Generation/Assembler/Statement.hs b/src/ByteCode/Generation/Assembler/Statement.hs deleted file mode 100644 index ed4dcc9..0000000 --- a/src/ByteCode/Generation/Assembler/Statement.hs +++ /dev/null @@ -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) diff --git a/src/ByteCode/Generation/Assembler/StatementExpression.hs b/src/ByteCode/Generation/Assembler/StatementExpression.hs deleted file mode 100644 index e9fcb07..0000000 --- a/src/ByteCode/Generation/Assembler/StatementExpression.hs +++ /dev/null @@ -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) \ No newline at end of file From 30365d76bd95fa74ecd3a00c8cc89d9e501d00c0 Mon Sep 17 00:00:00 2001 From: Marvin Schlegel Date: Fri, 31 May 2024 11:44:10 +0200 Subject: [PATCH 85/98] Revert "parser add preincrement and decrement conversion" This reverts commit 2acba0f28330613ecc831128c8790a4d3869ff0f. --- Test/TestParser.hs | 4 ++-- src/Parser/JavaParser.y | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/Test/TestParser.hs b/Test/TestParser.hs index 7c38433..521a615 100644 --- a/Test/TestParser.hs +++ b/Test/TestParser.hs @@ -145,10 +145,10 @@ testExpressionPostDecrement = TestCase $ assertEqual "expect PostDecrement" (StatementExpressionExpression $ PostDecrement (Reference "a")) $ parseExpression [IDENTIFIER "a",DECREMENT] testExpressionPreIncrement = TestCase $ - assertEqual "expect PreIncrement" (StatementExpressionExpression $ Assignment (Reference "a") (BinaryOperation Addition (IntegerLiteral 1) (Reference "a"))) $ + assertEqual "expect PreIncrement" (StatementExpressionExpression $ PreIncrement (Reference "a")) $ parseExpression [INCREMENT,IDENTIFIER "a"] testExpressionPreDecrement = TestCase $ - assertEqual "expect PreIncrement" (StatementExpressionExpression $ Assignment (Reference "a") (BinaryOperation Subtraction (IntegerLiteral 1) (Reference "a"))) $ + assertEqual "expect PreIncrement" (StatementExpressionExpression $ PreDecrement (Reference "a")) $ parseExpression [DECREMENT,IDENTIFIER "a"] testExpressionAssign = TestCase $ assertEqual "expect assign 5 to a" (StatementExpressionExpression (Assignment (Reference "a") (IntegerLiteral 5))) $ diff --git a/src/Parser/JavaParser.y b/src/Parser/JavaParser.y index 5f19c34..fd694b6 100644 --- a/src/Parser/JavaParser.y +++ b/src/Parser/JavaParser.y @@ -279,9 +279,9 @@ assignmentoperator : ASSIGN { Nothing } | XOREQUAL { Just BitwiseXor } | OREQUAL{ Just BitwiseOr } -preincrementexpression : INCREMENT unaryexpression { Assignment $2 (BinaryOperation Addition (IntegerLiteral 1) $2) } +preincrementexpression : INCREMENT unaryexpression { PreIncrement $2 } -predecrementexpression : DECREMENT unaryexpression { Assignment $2 (BinaryOperation Subtraction (IntegerLiteral 1) $2) } +predecrementexpression : DECREMENT unaryexpression { PreDecrement $2 } postincrementexpression : postfixexpression INCREMENT { PostIncrement $1 } From 666856b33abf1d5df1f136dca9b3c2c5ed366a7e Mon Sep 17 00:00:00 2001 From: Marvin Schlegel Date: Fri, 31 May 2024 12:02:25 +0200 Subject: [PATCH 86/98] parser add constructor call --- Test/TestParser.hs | 15 ++++++++++++++- src/Parser/JavaParser.y | 10 +++++----- 2 files changed, 19 insertions(+), 6 deletions(-) diff --git a/Test/TestParser.hs b/Test/TestParser.hs index 521a615..99ad2c9 100644 --- a/Test/TestParser.hs +++ b/Test/TestParser.hs @@ -200,6 +200,9 @@ testExpressionSimpleFieldAccess = TestCase $ testExpressionFieldSubAccess = TestCase $ assertEqual "expect NameResolution without this" (BinaryOperation NameResolution (Reference "a") (Reference "b")) $ parseExpression [IDENTIFIER "a",DOT,IDENTIFIER "b"] +testExpressionConstructorCall = TestCase $ + assertEqual "expect constructor call" (StatementExpressionExpression (ConstructorCall "Foo" [])) $ + parseExpression [NEW,IDENTIFIER "Foo",LBRACE,RBRACE] testStatementIfThen = TestCase $ assertEqual "expect empty ifthen" [If (Reference "a") (Block [Block []]) Nothing] $ @@ -217,6 +220,13 @@ testStatementAssign = TestCase $ testStatementMethodCallNoParams = TestCase $ assertEqual "expect methodcall statement no params" [StatementExpressionStatement (MethodCall (Reference "this") "foo" [])] $ parseStatement [IDENTIFIER "foo",LBRACE,RBRACE,SEMICOLON] +testStatementConstructorCall = TestCase $ + assertEqual "expect constructor call" [StatementExpressionStatement (ConstructorCall "Foo" [])] $ + parseStatement [NEW,IDENTIFIER "Foo",LBRACE,RBRACE,SEMICOLON] +testStatementConstructorCallWithArgs = TestCase $ + assertEqual "expect constructor call" [StatementExpressionStatement (ConstructorCall "Foo" [Reference "b"])] $ + parseStatement [NEW,IDENTIFIER "Foo",LBRACE,IDENTIFIER "b",RBRACE,SEMICOLON] + @@ -279,9 +289,12 @@ tests = TestList [ testExpressionFieldAccess, testExpressionSimpleFieldAccess, testExpressionFieldSubAccess, + testExpressionConstructorCall, testStatementIfThen, testStatementIfThenElse, testStatementWhile, testStatementAssign, - testStatementMethodCallNoParams + testStatementMethodCallNoParams, + testStatementConstructorCall, + testStatementConstructorCallWithArgs ] \ No newline at end of file diff --git a/src/Parser/JavaParser.y b/src/Parser/JavaParser.y index fd694b6..54c4b55 100644 --- a/src/Parser/JavaParser.y +++ b/src/Parser/JavaParser.y @@ -117,7 +117,7 @@ modifier : PUBLIC { } | STATIC { } | ABSTRACT { } -classtype : classorinterfacetype{ } +classtype : classorinterfacetype { $1 } classbodydeclaration : classmemberdeclaration { $1 } | constructordeclaration { $1 } @@ -254,7 +254,7 @@ statementexpression : assignment { $1 } -- | postincrementexpression { } -- | postdecrementexpression { } | methodinvocation { $1 } - -- | classinstancecreationexpression { } + | classinstancecreationexpression { $1 } ifthenelsestatementnoshortif :IF LBRACE expression RBRACE statementnoshortif ELSE statementnoshortif { } @@ -292,8 +292,8 @@ methodinvocation : simplename LBRACE RBRACE { MethodCall (Reference "this") $ | primary DOT IDENTIFIER LBRACE RBRACE { MethodCall $1 $3 [] } | primary DOT IDENTIFIER LBRACE argumentlist RBRACE { MethodCall $1 $3 $5 } -classinstancecreationexpression : NEW classtype LBRACE RBRACE { } - | NEW classtype LBRACE argumentlist RBRACE { } +classinstancecreationexpression : NEW classtype LBRACE RBRACE { ConstructorCall $2 [] } + | NEW classtype LBRACE argumentlist RBRACE { ConstructorCall $2 $4 } conditionalandexpression : inclusiveorexpression { $1 } @@ -318,7 +318,7 @@ inclusiveorexpression : exclusiveorexpression { $1 } primarynonewarray : literal { $1 } | THIS { Reference "this" } | LBRACE expression RBRACE { $2 } - -- | classinstancecreationexpression { } + | classinstancecreationexpression { StatementExpressionExpression $1 } | fieldaccess { $1 } | methodinvocation { StatementExpressionExpression $1 } From af093fa3bbcc1cbd36818dd63d884b647ac22601 Mon Sep 17 00:00:00 2001 From: Marvin Schlegel Date: Fri, 31 May 2024 12:10:00 +0200 Subject: [PATCH 87/98] parser add increment statement --- Test/TestParser.hs | 7 +++++-- src/Parser/JavaParser.y | 8 ++++---- 2 files changed, 9 insertions(+), 6 deletions(-) diff --git a/Test/TestParser.hs b/Test/TestParser.hs index 99ad2c9..5727203 100644 --- a/Test/TestParser.hs +++ b/Test/TestParser.hs @@ -227,7 +227,9 @@ testStatementConstructorCallWithArgs = TestCase $ assertEqual "expect constructor call" [StatementExpressionStatement (ConstructorCall "Foo" [Reference "b"])] $ parseStatement [NEW,IDENTIFIER "Foo",LBRACE,IDENTIFIER "b",RBRACE,SEMICOLON] - +testStatementPreIncrement = TestCase $ + assertEqual "expect increment" [StatementExpressionStatement $ PostIncrement $ Reference "a"] $ + parseStatement [IDENTIFIER "a",INCREMENT,SEMICOLON] tests = TestList [ @@ -296,5 +298,6 @@ tests = TestList [ testStatementAssign, testStatementMethodCallNoParams, testStatementConstructorCall, - testStatementConstructorCallWithArgs + testStatementConstructorCallWithArgs, + testStatementIncrement ] \ No newline at end of file diff --git a/src/Parser/JavaParser.y b/src/Parser/JavaParser.y index 54c4b55..aa22bb8 100644 --- a/src/Parser/JavaParser.y +++ b/src/Parser/JavaParser.y @@ -249,10 +249,10 @@ assignment : lefthandside assignmentoperator assignmentexpression { statementexpression : assignment { $1 } - -- | preincrementexpression { } - -- | predecrementexpression { } - -- | postincrementexpression { } - -- | postdecrementexpression { } + | preincrementexpression { $1 } + | predecrementexpression { $1 } + | postincrementexpression { $1 } + | postdecrementexpression { $1 } | methodinvocation { $1 } | classinstancecreationexpression { $1 } From 05b599b8ff04bfc676d895a0d7ab7f39a4051cff Mon Sep 17 00:00:00 2001 From: Fabian Noll Date: Fri, 31 May 2024 17:10:50 +0200 Subject: [PATCH 88/98] fix if typecheck --- src/Typecheck.hs | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/src/Typecheck.hs b/src/Typecheck.hs index ba49157..f7e63ae 100644 --- a/src/Typecheck.hs +++ b/src/Typecheck.hs @@ -21,7 +21,7 @@ typeCheckMethodDeclaration (MethodDeclaration retType name params body) classFie let -- Combine class fields with method parameters to form the initial symbol table for the method methodParams = [(identifier, dataType) | ParameterDeclaration dataType identifier <- params] - initialSymtab = classFields ++ methodParams + initialSymtab = ("thisMeth", retType) : classFields ++ methodParams checkedBody = typeCheckStatement body initialSymtab classes bodyType = getTypeFromStmt checkedBody -- Check if the type of the body matches the declared return type @@ -37,6 +37,7 @@ typeCheckExpression (CharacterLiteral c) _ _ = TypedExpression "char" (Character typeCheckExpression (BooleanLiteral b) _ _ = TypedExpression "boolean" (BooleanLiteral b) typeCheckExpression NullLiteral _ _ = TypedExpression "null" NullLiteral typeCheckExpression (Reference id) symtab classes = + -- TODO: maybe maje exception for "this" in first lookup? case lookup id symtab of Just t -> TypedExpression t (LocalVariable id) Nothing -> @@ -208,12 +209,16 @@ typeCheckStatement (If cond thenStmt elseStmt) symtab classes = elseStmt' = case elseStmt of Just stmt -> Just (typeCheckStatement stmt symtab classes) Nothing -> Nothing + thenType = getTypeFromStmt thenStmt' + elseType = maybe "void" getTypeFromStmt elseStmt' + ifType = if thenType /= "void" && elseType /= "void" && thenType == elseType then thenType else "void" in if getTypeFromExpr cond' == "boolean" then - TypedStatement (getTypeFromStmt thenStmt') (If cond' thenStmt' elseStmt') + TypedStatement ifType (If cond' thenStmt' elseStmt') else error "If condition must be of type boolean" + typeCheckStatement (LocalVariableDeclaration (VariableDeclaration dataType identifier maybeExpr)) symtab classes = -- Check for redefinition in the current scope if any ((== identifier) . snd) symtab From 3d351ee02b8067fd92fd8c94232913545be29a0f Mon Sep 17 00:00:00 2001 From: Fabian Noll Date: Fri, 31 May 2024 17:11:46 +0200 Subject: [PATCH 89/98] fix false error message --- src/Typecheck.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Typecheck.hs b/src/Typecheck.hs index f7e63ae..ac08d39 100644 --- a/src/Typecheck.hs +++ b/src/Typecheck.hs @@ -324,7 +324,7 @@ checkBitwiseOperation :: BinaryOperator -> Expression -> Expression -> DataType checkBitwiseOperation op expr1' expr2' type1 type2 | type1 == "int" && type2 == "int" = TypedExpression "int" (BinaryOperation op expr1' expr2') - | otherwise = error $ "Bitwise operation " ++ show op ++ " requires operands of type int" + | otherwise = error $ "Bitwise operation " ++ show op ++ " requires operands of type int or char" checkComparisonOperation :: BinaryOperator -> Expression -> Expression -> DataType -> DataType -> Expression checkComparisonOperation op expr1' expr2' type1 type2 From 82b2b4a6e1bf5d2442dd10be819cbb7c0423f51c Mon Sep 17 00:00:00 2001 From: Marvin Schlegel Date: Fri, 31 May 2024 17:39:56 +0200 Subject: [PATCH 90/98] fix intliteral 0 --- src/Parser/Lexer.x | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Parser/Lexer.x b/src/Parser/Lexer.x index ef76773..cb0d075 100644 --- a/src/Parser/Lexer.x +++ b/src/Parser/Lexer.x @@ -72,7 +72,7 @@ tokens :- -- end keywords $JavaLetter$JavaLetterOrDigit* { \s -> IDENTIFIER s } -- Literals - [1-9]([0-9\_]*[0-9])* { \s -> case readMaybe $ filter ((/=) '_') s of Just a -> INTEGERLITERAL a; Nothing -> error ("failed to parse INTLITERAL " ++ s) } + [0-9]([0-9\_]*[0-9])* { \s -> case readMaybe $ filter ((/=) '_') s of Just a -> INTEGERLITERAL a; Nothing -> error ("failed to parse INTLITERAL " ++ s) } "'"."'" { \s -> case (s) of _ : c : _ -> CHARLITERAL c; _ -> error ("failed to parse CHARLITERAL " ++ s) } -- separators "(" { \_ -> LBRACE } From 98b02446ba4d8ab4d032b250c5a53db1db6feefd Mon Sep 17 00:00:00 2001 From: fanoll Date: Mon, 10 Jun 2024 12:53:59 +0200 Subject: [PATCH 91/98] remove unused thisMeth type. Returns are combined and already checked against return Type --- src/Typecheck.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Typecheck.hs b/src/Typecheck.hs index ac08d39..fd58f17 100644 --- a/src/Typecheck.hs +++ b/src/Typecheck.hs @@ -21,7 +21,7 @@ typeCheckMethodDeclaration (MethodDeclaration retType name params body) classFie let -- Combine class fields with method parameters to form the initial symbol table for the method methodParams = [(identifier, dataType) | ParameterDeclaration dataType identifier <- params] - initialSymtab = ("thisMeth", retType) : classFields ++ methodParams + initialSymtab = classFields ++ methodParams checkedBody = typeCheckStatement body initialSymtab classes bodyType = getTypeFromStmt checkedBody -- Check if the type of the body matches the declared return type From 7c52084bbedf052ff1522869b8663ffdd77b06ee Mon Sep 17 00:00:00 2001 From: Marvin Schlegel Date: Mon, 10 Jun 2024 17:19:56 +0200 Subject: [PATCH 92/98] fix test --- Test/TestParser.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Test/TestParser.hs b/Test/TestParser.hs index 5727203..5041e3e 100644 --- a/Test/TestParser.hs +++ b/Test/TestParser.hs @@ -299,5 +299,5 @@ tests = TestList [ testStatementMethodCallNoParams, testStatementConstructorCall, testStatementConstructorCallWithArgs, - testStatementIncrement + testStatementPreIncrement ] \ No newline at end of file From b525d141924e84cdb9f4f3062d950b45bd3c16b2 Mon Sep 17 00:00:00 2001 From: MisterChaos96 Date: Tue, 11 Jun 2024 20:04:59 +0200 Subject: [PATCH 93/98] add typechecking for returns, fix finding of constructors, fix if statement --- src/Typecheck.hs | 68 ++++++++++++++++++++++++++++++------------------ 1 file changed, 42 insertions(+), 26 deletions(-) diff --git a/src/Typecheck.hs b/src/Typecheck.hs index fd58f17..e4aab3b 100644 --- a/src/Typecheck.hs +++ b/src/Typecheck.hs @@ -19,15 +19,14 @@ typeCheckClass (Class className methods fields) classes = typeCheckMethodDeclaration :: MethodDeclaration -> [(Identifier, DataType)] -> [Class] -> MethodDeclaration typeCheckMethodDeclaration (MethodDeclaration retType name params body) classFields classes = let - -- Combine class fields with method parameters to form the initial symbol table for the method methodParams = [(identifier, dataType) | ParameterDeclaration dataType identifier <- params] - initialSymtab = classFields ++ methodParams + initialSymtab = ("thisMeth", retType) : classFields ++ methodParams checkedBody = typeCheckStatement body initialSymtab classes bodyType = getTypeFromStmt checkedBody - -- Check if the type of the body matches the declared return type - in if bodyType == retType || (bodyType == "void" && retType == "void") || (bodyType == "null" && isObjectType retType) + in if bodyType == retType || (bodyType == "void" && retType == "void") || (bodyType == "null" && isObjectType retType) || isSubtype bodyType retType classes then MethodDeclaration retType name params checkedBody - else error $ "Return type mismatch in method " ++ name ++ ": expected " ++ retType ++ ", found " ++ bodyType + else error $ "Method Declaration: Return type mismatch in method " ++ name ++ ": expected " ++ retType ++ ", found " ++ bodyType + -- ********************************** Type Checking: Expressions ********************************** @@ -119,7 +118,7 @@ typeCheckStatementExpression (ConstructorCall className args) symtab classes = Nothing -> error $ "Class '" ++ className ++ "' not found." Just (Class _ methods fields) -> -- Constructor needs the same name as the class - case find (\(MethodDeclaration retType name params _) -> name == className && retType == className) methods of + case find (\(MethodDeclaration retType name params _) -> name == "" && retType == "void") methods of Nothing -> error $ "No valid constructor found for class '" ++ className ++ "'." Just (MethodDeclaration _ _ params _) -> let @@ -204,19 +203,21 @@ typeCheckStatementExpression (PreDecrement expr) symtab classes = typeCheckStatement :: Statement -> [(Identifier, DataType)] -> [Class] -> Statement typeCheckStatement (If cond thenStmt elseStmt) symtab classes = - let cond' = typeCheckExpression cond symtab classes - thenStmt' = typeCheckStatement thenStmt symtab classes - elseStmt' = case elseStmt of - Just stmt -> Just (typeCheckStatement stmt symtab classes) - Nothing -> Nothing - thenType = getTypeFromStmt thenStmt' - elseType = maybe "void" getTypeFromStmt elseStmt' - ifType = if thenType /= "void" && elseType /= "void" && thenType == elseType then thenType else "void" - in if getTypeFromExpr cond' == "boolean" - then - TypedStatement ifType (If cond' thenStmt' elseStmt') - else - error "If condition must be of type boolean" + let + cond' = typeCheckExpression cond symtab classes + thenStmt' = typeCheckStatement thenStmt symtab classes + elseStmt' = fmap (\stmt -> typeCheckStatement stmt symtab classes) elseStmt + + thenType = getTypeFromStmt thenStmt' + elseType = maybe "void" getTypeFromStmt elseStmt' + + ifType = if thenType == "void" || elseType == "void" + then "void" + else unifyReturnTypes thenType elseType + + in if getTypeFromExpr cond' == "boolean" + then TypedStatement ifType (If cond' thenStmt' elseStmt') + else error "If condition must be of type boolean" typeCheckStatement (LocalVariableDeclaration (VariableDeclaration dataType identifier maybeExpr)) symtab classes = @@ -229,7 +230,7 @@ typeCheckStatement (LocalVariableDeclaration (VariableDeclaration dataType ident exprType = fmap getTypeFromExpr checkedExpr in case exprType of Just t - | t == "null" && isObjectType dataType -> + | t == "null" && isObjectType dataType -> TypedStatement dataType (LocalVariableDeclaration (VariableDeclaration dataType identifier checkedExpr)) | t /= dataType -> error $ "Type mismatch in declaration of '" ++ identifier ++ "': expected " ++ dataType ++ ", found " ++ t | otherwise -> TypedStatement dataType (LocalVariableDeclaration (VariableDeclaration dataType identifier checkedExpr)) @@ -272,12 +273,14 @@ typeCheckStatement (Block statements) symtab classes = in TypedStatement blockType (Block checkedStatements) typeCheckStatement (Return expr) symtab classes = - let expr' = case expr of + let methodReturnType = fromMaybe (error "Method return type not found in symbol table") (lookup "thisMeth" symtab) + expr' = case expr of Just e -> Just (typeCheckExpression e symtab classes) Nothing -> Nothing - in case expr' of - Just e' -> TypedStatement (getTypeFromExpr e') (Return (Just e')) - Nothing -> TypedStatement "void" (Return Nothing) + returnType = maybe "void" getTypeFromExpr expr' + in if returnType == methodReturnType || isSubtype returnType methodReturnType classes + then TypedStatement returnType (Return expr') + else error $ "Return: Return type mismatch: expected " ++ methodReturnType ++ ", found " ++ returnType typeCheckStatement (StatementExpressionStatement stmtExpr) symtab classes = let stmtExpr' = typeCheckStatementExpression stmtExpr symtab classes @@ -285,6 +288,17 @@ typeCheckStatement (StatementExpressionStatement stmtExpr) symtab classes = -- ********************************** Type Checking: Helpers ********************************** +isSubtype :: DataType -> DataType -> [Class] -> Bool +isSubtype subType superType classes + | subType == superType = True + | subType == "null" && isObjectType superType = True + | superType == "Object" && isObjectType subType = True + | superType == "Object" && isUserDefinedClass subType classes = True + | otherwise = False + +isUserDefinedClass :: DataType -> [Class] -> Bool +isUserDefinedClass dt classes = dt `elem` map (\(Class name _ _) -> name) classes + isObjectType :: DataType -> Bool isObjectType dt = dt /= "int" && dt /= "boolean" && dt /= "char" @@ -302,8 +316,10 @@ getTypeFromStmtExpr _ = error "Untyped statement expression found where typed wa unifyReturnTypes :: DataType -> DataType -> DataType unifyReturnTypes dt1 dt2 - | dt1 == dt2 = dt1 - | otherwise = "Object" + | dt1 == dt2 = dt1 + | dt1 == "null" = dt2 + | dt2 == "null" = dt1 + | otherwise = "Object" resolveResultType :: DataType -> DataType -> DataType resolveResultType "char" "char" = "char" From 710ec4395964ee0354f1a40e19196b6f938774b5 Mon Sep 17 00:00:00 2001 From: Fabian Noll Date: Thu, 13 Jun 2024 09:26:05 +0200 Subject: [PATCH 94/98] add using standard constructor for constructor call --- src/Typecheck.hs | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/src/Typecheck.hs b/src/Typecheck.hs index e4aab3b..d7eeac2 100644 --- a/src/Typecheck.hs +++ b/src/Typecheck.hs @@ -117,9 +117,14 @@ typeCheckStatementExpression (ConstructorCall className args) symtab classes = case find (\(Class name _ _) -> name == className) classes of Nothing -> error $ "Class '" ++ className ++ "' not found." Just (Class _ methods fields) -> - -- Constructor needs the same name as the class + -- Find constructor matching the class name with void return type case find (\(MethodDeclaration retType name params _) -> name == "" && retType == "void") methods of - Nothing -> error $ "No valid constructor found for class '" ++ className ++ "'." + -- If no constructor is found, assume standard constructor with no parameters + Nothing -> + if null args then + TypedStatementExpression className (ConstructorCall className args) + else + error $ "No valid constructor found for class '" ++ className ++ "', but arguments were provided." Just (MethodDeclaration _ _ params _) -> let args' = map (\arg -> typeCheckExpression arg symtab classes) args From baf93626340ca8bb9ceeea8a09ff45b619135fa5 Mon Sep 17 00:00:00 2001 From: MisterChaos96 Date: Thu, 13 Jun 2024 15:49:59 +0200 Subject: [PATCH 95/98] make implicit this to explicit this for field variables --- src/Typecheck.hs | 20 +++++++++++--------- 1 file changed, 11 insertions(+), 9 deletions(-) diff --git a/src/Typecheck.hs b/src/Typecheck.hs index d7eeac2..8374ea4 100644 --- a/src/Typecheck.hs +++ b/src/Typecheck.hs @@ -9,24 +9,27 @@ typeCheckCompilationUnit classes = map (`typeCheckClass` classes) classes typeCheckClass :: Class -> [Class] -> Class typeCheckClass (Class className methods fields) classes = let - -- Create a symbol table from class fields and method entries - -- TODO: Maybe remove method entries from the symbol table? - methodEntries = [(methodName, className) | MethodDeclaration _ methodName _ _ <- methods] - initalSymTab = ("this", className) : methodEntries + -- Fields dont need to be added to the symtab because they are looked upon automatically under this if its not a declared local variable + -- TODO: Maybe remove method entries from the symbol table? I dont think we need them but if yes the next line would be + -- initalSymTab = ("this", className) : methodEntries + -- methodEntries = [(methodName, className) | MethodDeclaration _ methodName _ _ <- methods] + initalSymTab = [("this", className)] checkedMethods = map (\method -> typeCheckMethodDeclaration method initalSymTab classes) methods in Class className checkedMethods fields typeCheckMethodDeclaration :: MethodDeclaration -> [(Identifier, DataType)] -> [Class] -> MethodDeclaration -typeCheckMethodDeclaration (MethodDeclaration retType name params body) classFields classes = +typeCheckMethodDeclaration (MethodDeclaration retType name params body) symtab classes = let methodParams = [(identifier, dataType) | ParameterDeclaration dataType identifier <- params] - initialSymtab = ("thisMeth", retType) : classFields ++ methodParams + initialSymtab = ("thisMeth", retType) : symtab ++ methodParams checkedBody = typeCheckStatement body initialSymtab classes bodyType = getTypeFromStmt checkedBody in if bodyType == retType || (bodyType == "void" && retType == "void") || (bodyType == "null" && isObjectType retType) || isSubtype bodyType retType classes then MethodDeclaration retType name params checkedBody else error $ "Method Declaration: Return type mismatch in method " ++ name ++ ": expected " ++ retType ++ ", found " ++ bodyType +-- TODO: It could be that TypeCheckVariableDeclaration is missing. If it comes up -> just check wether the type is correct. The maybe expression needs to be +-- checked as well. Also if its a class type, check wether the class exists. -- ********************************** Type Checking: Expressions ********************************** @@ -36,7 +39,6 @@ typeCheckExpression (CharacterLiteral c) _ _ = TypedExpression "char" (Character typeCheckExpression (BooleanLiteral b) _ _ = TypedExpression "boolean" (BooleanLiteral b) typeCheckExpression NullLiteral _ _ = TypedExpression "null" NullLiteral typeCheckExpression (Reference id) symtab classes = - -- TODO: maybe maje exception for "this" in first lookup? case lookup id symtab of Just t -> TypedExpression t (LocalVariable id) Nothing -> @@ -47,7 +49,7 @@ typeCheckExpression (Reference id) symtab classes = Just (Class _ _ fields) -> let fieldTypes = [dt | VariableDeclaration dt fieldId _ <- fields, fieldId == id] in case fieldTypes of - [fieldType] -> TypedExpression fieldType (FieldVariable id) + [fieldType] -> TypedExpression fieldType (BinaryOperation NameResolution (LocalVariable "this") (FieldVariable id)) [] -> error $ "Field '" ++ id ++ "' not found in class '" ++ className ++ "'" _ -> error $ "Ambiguous reference to field '" ++ id ++ "' in class '" ++ className ++ "'" Nothing -> error $ "Class '" ++ className ++ "' not found for 'this'" @@ -272,7 +274,7 @@ typeCheckStatement (Block statements) symtab classes = -- Initial accumulator: empty statements list, initial symbol table, empty types list (checkedStatements, finalSymtab, collectedTypes) = foldl processStatements ([], symtab, []) statements - -- Determine the block's type: unify all collected types, default to "Void" if none + -- Determine the block's type: unify all collected types, default to "void" if none (UpperBound) blockType = if null collectedTypes then "void" else foldl1 unifyReturnTypes collectedTypes in TypedStatement blockType (Block checkedStatements) From 2139e7832c1c80c455bac77e40ca96521d5af9b3 Mon Sep 17 00:00:00 2001 From: MisterChaos96 Date: Thu, 13 Jun 2024 17:33:30 +0200 Subject: [PATCH 96/98] fix missing Typed Expression for local and field variable --- src/Typecheck.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/Typecheck.hs b/src/Typecheck.hs index 8374ea4..5e5efc5 100644 --- a/src/Typecheck.hs +++ b/src/Typecheck.hs @@ -48,8 +48,9 @@ typeCheckExpression (Reference id) symtab classes = in case classDetails of Just (Class _ _ fields) -> let fieldTypes = [dt | VariableDeclaration dt fieldId _ <- fields, fieldId == id] + -- this case only happens when its a field of its own class so the implicit this will be converted to explicit this in case fieldTypes of - [fieldType] -> TypedExpression fieldType (BinaryOperation NameResolution (LocalVariable "this") (FieldVariable id)) + [fieldType] -> TypedExpression fieldType (BinaryOperation NameResolution (TypedExpression className (LocalVariable "this")) (TypedExpression fieldType (FieldVariable id))) [] -> error $ "Field '" ++ id ++ "' not found in class '" ++ className ++ "'" _ -> error $ "Ambiguous reference to field '" ++ id ++ "' in class '" ++ className ++ "'" Nothing -> error $ "Class '" ++ className ++ "' not found for 'this'" From 7e13b3fac3463b41aa8f44ff7823ba70c26d5ac8 Mon Sep 17 00:00:00 2001 From: MisterChaos96 Date: Thu, 13 Jun 2024 20:35:00 +0200 Subject: [PATCH 97/98] fix variable redefinition in scope not working --- src/Typecheck.hs | 28 ++++++++++++++++++---------- 1 file changed, 18 insertions(+), 10 deletions(-) diff --git a/src/Typecheck.hs b/src/Typecheck.hs index 5e5efc5..b03155a 100644 --- a/src/Typecheck.hs +++ b/src/Typecheck.hs @@ -2,6 +2,7 @@ module Typecheck where import Data.List (find) import Data.Maybe import Ast +import Debug.Trace (trace) typeCheckCompilationUnit :: CompilationUnit -> CompilationUnit typeCheckCompilationUnit classes = map (`typeCheckClass` classes) classes @@ -256,21 +257,27 @@ typeCheckStatement (While cond stmt) symtab classes = typeCheckStatement (Block statements) symtab classes = let processStatements (accSts, currentSymtab, types) stmt = - let - checkedStmt = typeCheckStatement stmt currentSymtab classes - stmtType = getTypeFromStmt checkedStmt - in case stmt of + case stmt of LocalVariableDeclaration (VariableDeclaration dataType identifier maybeExpr) -> let + alreadyDefined = any (\(id, _) -> id == identifier) currentSymtab + newSymtab = if alreadyDefined + then error ("Variable " ++ identifier ++ " already defined in this scope.") + else (identifier, dataType) : currentSymtab checkedExpr = fmap (\expr -> typeCheckExpression expr currentSymtab classes) maybeExpr - newSymtab = (identifier, dataType) : currentSymtab + checkedStmt = typeCheckStatement stmt newSymtab classes in (accSts ++ [checkedStmt], newSymtab, types) - 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) + _ -> + let + checkedStmt = typeCheckStatement stmt currentSymtab classes + stmtType = getTypeFromStmt checkedStmt + in case stmt of + 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 (checkedStatements, finalSymtab, collectedTypes) = foldl processStatements ([], symtab, []) statements @@ -280,6 +287,7 @@ typeCheckStatement (Block statements) symtab classes = in TypedStatement blockType (Block checkedStatements) + typeCheckStatement (Return expr) symtab classes = let methodReturnType = fromMaybe (error "Method return type not found in symbol table") (lookup "thisMeth" symtab) expr' = case expr of From f02226bca84e2c21e85ed327a00428835e027648 Mon Sep 17 00:00:00 2001 From: MisterChaos96 Date: Thu, 13 Jun 2024 22:06:10 +0200 Subject: [PATCH 98/98] add missing typeCheckVariableDeclaration --- src/Typecheck.hs | 30 ++++++++++++++++++++++-------- 1 file changed, 22 insertions(+), 8 deletions(-) diff --git a/src/Typecheck.hs b/src/Typecheck.hs index b03155a..0be409f 100644 --- a/src/Typecheck.hs +++ b/src/Typecheck.hs @@ -2,7 +2,6 @@ module Typecheck where import Data.List (find) import Data.Maybe import Ast -import Debug.Trace (trace) typeCheckCompilationUnit :: CompilationUnit -> CompilationUnit typeCheckCompilationUnit classes = map (`typeCheckClass` classes) classes @@ -10,13 +9,12 @@ typeCheckCompilationUnit classes = map (`typeCheckClass` classes) classes typeCheckClass :: Class -> [Class] -> Class typeCheckClass (Class className methods fields) classes = let - -- Fields dont need to be added to the symtab because they are looked upon automatically under this if its not a declared local variable - -- TODO: Maybe remove method entries from the symbol table? I dont think we need them but if yes the next line would be - -- initalSymTab = ("this", className) : methodEntries - -- methodEntries = [(methodName, className) | MethodDeclaration _ methodName _ _ <- methods] + -- Fields and methods dont need to be added to the symtab because they are looked upon automatically under "this" + -- if its not a declared local variable. Also shadowing wouldnt be possible then. initalSymTab = [("this", className)] checkedMethods = map (\method -> typeCheckMethodDeclaration method initalSymTab classes) methods - in Class className checkedMethods fields + checkedFields = map (\field -> typeCheckVariableDeclaration field initalSymTab classes) fields + in Class className checkedMethods checkedFields typeCheckMethodDeclaration :: MethodDeclaration -> [(Identifier, DataType)] -> [Class] -> MethodDeclaration typeCheckMethodDeclaration (MethodDeclaration retType name params body) symtab classes = @@ -29,8 +27,24 @@ typeCheckMethodDeclaration (MethodDeclaration retType name params body) symtab c then MethodDeclaration retType name params checkedBody else error $ "Method Declaration: Return type mismatch in method " ++ name ++ ": expected " ++ retType ++ ", found " ++ bodyType --- TODO: It could be that TypeCheckVariableDeclaration is missing. If it comes up -> just check wether the type is correct. The maybe expression needs to be --- checked as well. Also if its a class type, check wether the class exists. +typeCheckVariableDeclaration :: VariableDeclaration -> [(Identifier, DataType)] -> [Class] -> VariableDeclaration +typeCheckVariableDeclaration (VariableDeclaration dataType identifier maybeExpr) symtab classes = + let + -- Ensure the type is valid (either a primitive type or a valid class name) + validType = dataType `elem` ["int", "boolean", "char"] || isUserDefinedClass dataType classes + -- Ensure no redefinition in the same scope + redefined = any ((== identifier) . snd) symtab + -- Type check the initializer expression if it exists + checkedExpr = fmap (\expr -> typeCheckExpression expr symtab classes) maybeExpr + exprType = fmap getTypeFromExpr checkedExpr + in case (validType, redefined, exprType) of + (False, _, _) -> error $ "Type '" ++ dataType ++ "' is not a valid type for variable '" ++ identifier ++ "'" + (_, True, _) -> error $ "Variable '" ++ identifier ++ "' is redefined in the same scope" + (_, _, Just t) + | t == "null" && isObjectType dataType -> VariableDeclaration dataType identifier checkedExpr + | t /= dataType -> error $ "Type mismatch in declaration of '" ++ identifier ++ "': expected " ++ dataType ++ ", found " ++ t + | otherwise -> VariableDeclaration dataType identifier checkedExpr + (_, _, Nothing) -> VariableDeclaration dataType identifier checkedExpr -- ********************************** Type Checking: Expressions **********************************