Merge remote-tracking branch 'origin/create-parser' into typedAST

.gitignore

@@ -8,6 +8,12 @@ cabal-dev
 *.chs.h
 *.dyn_o
 *.dyn_hi
+*.java
+*.class
+*.local~*
+src/Parser/JavaParser.hs
+src/Parser/Parser.hs
+src/Parser/Lexer.hs
 .hpc
 .hsenv
 .cabal-sandbox/
@@ -20,4 +26,4 @@ cabal.sandbox.config
 cabal.project.local
 cabal.project.local~
 .HTF/
-.ghc.environment.*
+.ghc.environment.*

Test/TestByteCodeGenerator.hs

@@ -0,0 +1,116 @@
+module TestByteCodeGenerator where
+
+import Test.HUnit
+import ByteCode.ClassFile.Generator
+import ByteCode.ClassFile
+import ByteCode.Constants
+import Ast
+
+nakedClass = Class "Testklasse" [] []
+expectedClass = ClassFile {
+        constantPool = [
+            ClassInfo 4,
+            MethodRefInfo 1 3,
+            NameAndTypeInfo 5 6,
+            Utf8Info "java/lang/Object",
+            Utf8Info "<init>",
+            Utf8Info "()V",
+            Utf8Info "Code",
+            ClassInfo 9,
+            Utf8Info "Testklasse"
+        ],
+        accessFlags = accessPublic,
+        thisClass = 8,
+        superClass = 1,
+        fields = [],
+        methods = [],
+        attributes = []
+    }
+
+classWithFields = Class "Testklasse" [] [VariableDeclaration "int" "testvariable" Nothing]
+expectedClassWithFields = ClassFile {
+        constantPool = [
+            ClassInfo 4,
+            MethodRefInfo 1 3,
+            NameAndTypeInfo 5 6,
+            Utf8Info "java/lang/Object",
+            Utf8Info "<init>",
+            Utf8Info "()V",
+            Utf8Info "Code",
+            ClassInfo 9,
+            Utf8Info "Testklasse",
+            FieldRefInfo 8 11,
+            NameAndTypeInfo 12 13,
+            Utf8Info "testvariable",
+            Utf8Info "I"
+        ],
+        accessFlags = accessPublic,
+        thisClass = 8,
+        superClass = 1,
+        fields = [
+            MemberInfo {
+                memberAccessFlags = accessPublic,
+                memberNameIndex = 12,
+                memberDescriptorIndex = 13,
+                memberAttributes = []
+            }
+        ],
+        methods = [],
+        attributes = []
+    }
+
+method = MethodDeclaration "int" "add_two_numbers" [
+    ParameterDeclaration "int" "a",
+    ParameterDeclaration "int" "b" ]
+    (Block [Return (Just (BinaryOperation Addition (Reference "a") (Reference "b")))])
+
+
+classWithMethod = Class "Testklasse" [method] []
+expectedClassWithMethod = ClassFile {
+        constantPool = [
+            ClassInfo 4,
+            MethodRefInfo 1 3,
+            NameAndTypeInfo 5 6,
+            Utf8Info "java/lang/Object",
+            Utf8Info "<init>",
+            Utf8Info "()V",
+            Utf8Info "Code",
+            ClassInfo 9,
+            Utf8Info "Testklasse",
+            FieldRefInfo 8 11,
+            NameAndTypeInfo 12 13,
+            Utf8Info "add_two_numbers",
+            Utf8Info "(II)I"
+        ],
+        accessFlags = accessPublic,
+        thisClass = 8,
+        superClass = 1,
+        fields = [],
+        methods = [
+            MemberInfo {
+                memberAccessFlags = accessPublic,
+                memberNameIndex = 12,
+                memberDescriptorIndex = 13,
+                memberAttributes = [
+                    CodeAttribute {
+                        attributeMaxStack = 420,
+                        attributeMaxLocals = 420,
+                        attributeCode = [Opiadd]
+                    }
+                ]
+            }
+        ],
+        attributes = []
+    }
+
+testBasicConstantPool = TestCase $ assertEqual "basic constant pool" expectedClass $ classBuilder nakedClass emptyClassFile
+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)
+
+tests = TestList [
+    TestLabel "Basic constant pool" testBasicConstantPool,
+    TestLabel "Fields constant pool" testFields,
+    TestLabel "Method descriptor building" testMethodDescriptor,
+    TestLabel "Method assembly" testMethodAssembly
+    ]

Test/TestLexer.hs

@@ -4,14 +4,46 @@ import Test.HUnit
 import Parser.Lexer
 
 
-testCommentSomething = TestCase $ assertEqual "scan /*Something*/" [Comment "/*Something*/"] $ alexScanTokens "/*Something*/"
-testEmptyComment =  TestCase $ assertEqual "scan /*x*/"  [Comment "/**/"] $ alexScanTokens "/**/"
-testLineComment = TestCase $ assertEqual "scan // comment" [Comment "// comment"] $ alexScanTokens "// comment"
+emptyTokenList :: [Token]
+emptyTokenList = []
+testCommentSomething = TestCase $ assertEqual "scan '/*Something*/'" emptyTokenList $ alexScanTokens "/*Something*/"
+testEmptyComment =  TestCase $ assertEqual "scan '/*x*/'"  emptyTokenList $ alexScanTokens "/**/"
+testLineComment = TestCase $ assertEqual "scan '// comment'" emptyTokenList $ alexScanTokens "// comment"
+testLineCommentEnds = TestCase $ assertEqual "scan '// com\\n'" emptyTokenList $ alexScanTokens "// com\n"
 
+testIdentifier = TestCase $ assertEqual "scan 'identifier'" [IDENTIFIER "identifier"] $ alexScanTokens "identifier"
+testShortIdentifier = TestCase $ assertEqual "scan 'i'" [IDENTIFIER "i"] $ alexScanTokens "i"
+testIdentifierWithNumber = TestCase $ assertEqual "scan 'i2'" [IDENTIFIER "i2"] $ alexScanTokens "i2"
 
+testKeywordBreak = TestCase $ assertEqual "scan 'break'" [BREAK] $ alexScanTokens "break"
+testKeywordInt = TestCase $ assertEqual "scan 'int'" [INT] $ alexScanTokens "int"
+
+testIntLiteral = TestCase $ assertEqual "scan '234'" [INTEGERLITERAL 234] $ alexScanTokens "234"
+testIntLiteral2 = TestCase $ assertEqual "scan '54_2'" [INTEGERLITERAL 542] $ alexScanTokens "54_2"
+
+testCharLiteral = TestCase $ assertEqual "scan ''f''" [CHARLITERAL 'f'] $ alexScanTokens "'f'"
+
+testBoolLiteralTrue = TestCase $ assertEqual "scan 'true'" [BOOLLITERAL True] $ alexScanTokens "true"
+testBoolLiteralFalse = TestCase $ assertEqual "scan 'false'" [BOOLLITERAL False] $ alexScanTokens "false"
+
+testLBrace = TestCase $ assertEqual "scan '('" [LBRACE] $ alexScanTokens "("
+testAnd = TestCase $ assertEqual "scan '&&'" [AND] $ alexScanTokens "&&"
 
 tests = TestList [
     TestLabel "TestCommentSomething" testCommentSomething,
     TestLabel "TestEmptyComment" testEmptyComment,
-    TestLabel "TestLineComment" testLineComment
+    TestLabel "TestLineComment" testLineComment,
+    TestLabel "TestLineCommentEnds" testLineCommentEnds,
+    TestLabel "TestIdentifier" testIdentifier,
+    TestLabel "TestShortIdentifier" testShortIdentifier,
+    TestLabel "TestIdentifierWithNumber" testIdentifierWithNumber,
+    TestLabel "TestKeywordBreak" testKeywordBreak,
+    TestLabel "TestKeywordInt" testKeywordInt,
+    TestLabel "TestIntLiteral" testIntLiteral,
+    TestLabel "TestIntLiteral2" testIntLiteral2,
+    TestLabel "TestCharLiteral" testCharLiteral,
+    TestLabel "TestBoolLiteralTrue" testBoolLiteralTrue,
+    TestLabel "TestBoolLiteralFalse" testBoolLiteralFalse,
+    TestLabel "TestLBrace" testLBrace,
+    TestLabel "TestAnd" testAnd
     ]

Test/TestParser.hs

@@ -0,0 +1,189 @@
+module TestParser(tests) where
+
+import Test.HUnit
+import Parser.Lexer
+import Parser.JavaParser
+import Ast
+
+
+testSingleEmptyClass = TestCase $
+    assertEqual "expect single empty class hello" [Class "Hello" [] []] $
+    parse [CLASS, IDENTIFIER "Hello", LBRACKET, RBRACKET]
+testTwoEmptyClasses = TestCase $
+    assertEqual "expect two empty classes" [Class "Class1" [] [], Class "Class2" [] []] $
+    parse [CLASS,IDENTIFIER "Class1",LBRACKET,RBRACKET,CLASS,IDENTIFIER "Class2",LBRACKET,RBRACKET]
+testBooleanField = TestCase $
+    assertEqual "expect class with boolean field" [Class "WithBool" [] [VariableDeclaration "boolean" "value" Nothing]] $
+    parse [CLASS,IDENTIFIER "WithBool",LBRACKET,BOOLEAN,IDENTIFIER "value",SEMICOLON,RBRACKET]
+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]
+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]
+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]
+
+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]
+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]
+testClassWithConstructor = TestCase $
+    assertEqual "expect class with constructor" [Class "WithConstructor" [MethodDeclaration "void" "<init>" [] (Block [])] []] $
+    parse [CLASS,IDENTIFIER "WithConstructor",LBRACKET,IDENTIFIER "WithConstructor",LBRACE,RBRACE,LBRACKET,RBRACKET,RBRACKET]
+
+
+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]] $
+    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]] $
+    parseStatement [LBRACKET,INT,IDENTIFIER "var1",SEMICOLON,BOOLEAN,IDENTIFIER "var2",SEMICOLON,RBRACKET]
+testNestedBlocks = TestCase $
+    assertEqual "expect block with block inside" [Block [Block []]] $
+    parseStatement [LBRACKET,LBRACKET,RBRACKET,RBRACKET]
+testBlockWithEmptyStatement = TestCase $
+    assertEqual "expect empty block" [Block []] $
+    parseStatement [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]
+testLocalBoolWithInitialization = TestCase $
+    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]] $
+    parseStatement [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"]
+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]
+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"]
+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 [
+    testSingleEmptyClass,
+    testTwoEmptyClasses,
+    testBooleanField,
+    testIntField,
+    testCustomTypeField,
+    testMultipleDeclarations,
+    testWithModifier,
+    testEmptyMethod,
+    testEmptyPrivateMethod,
+    testEmptyVoidMethod,
+    testEmptyMethodWithParam,
+    testEmptyMethodWithParams,
+    testClassWithMethodAndField,
+    testClassWithConstructor,
+    testEmptyBlock,
+    testBlockWithLocalVarDecl,
+    testBlockWithMultipleLocalVarDecls,
+    testNestedBlocks,
+    testBlockWithEmptyStatement,
+    testExpressionIntLiteral,
+    testFieldWithInitialization,
+    testLocalBoolWithInitialization,
+    testFieldNullWithInitialization,
+    testReturnVoid,
+    testExpressionNot,
+    testExpressionMinus,
+    testExpressionLessThan,
+    testExpressionGreaterThan,
+    testExpressionLessThanEqual,
+    testExpressionGreaterThanOrEqual,
+    testExpressionEqual,
+    testExpressionNotEqual,
+    testExpressionAnd,
+    testExpressionXor,
+    testExpressionOr,
+    testExpressionPostIncrement,
+    testExpressionPostDecrement,
+    testExpressionPreIncrement,
+    testExpressionPreDecrement
+    ]

Test/TestSuite.hs

@@ -1,11 +1,14 @@
 module Main where
 
 import Test.HUnit
-import Parser.Lexer
 import TestLexer
+import TestByteCodeGenerator
+import TestParser
 
-otherTest = TestCase $ assertEqual "math" (4+3) 7
 
-tests = TestList [TestLabel "TestLexer" TestLexer.tests, TestLabel "mathTest" otherTest]
+tests = TestList [
+    TestLabel "TestLexer" TestLexer.tests,
+    TestLabel "TestParser" TestParser.tests,
+    TestLabel "TestByteCodeGenerator" TestByteCodeGenerator.tests]
 
 main = do runTestTTAndExit Main.tests

project.cabal

@@ -8,11 +8,23 @@ executable compiler
     main-is:            Main.hs
     build-depends:      base,
                         array,
-                        HUnit
+                        HUnit,
+                        utf8-string,
+                        bytestring
     default-language:   Haskell2010
-    hs-source-dirs:     src
+    hs-source-dirs:     src,
+                        src/ByteCode,
+                        src/ByteCode/ClassFile
     build-tool-depends: alex:alex, happy:happy
-    other-modules:      Parser.Lexer, Ast, Example, Typecheck
+    other-modules:      Parser.Lexer,
+                        Parser.JavaParser
+                        Ast,
+                        Example,
+                        Typecheck,
+                        ByteCode.ByteUtil,
+                        ByteCode.ClassFile,
+                        ByteCode.ClassFile.Generator,
+                        ByteCode.Constants
 
 test-suite tests
     type:               exitcode-stdio-1.0
@@ -20,6 +32,17 @@ test-suite tests
     hs-source-dirs:     src,Test
     build-depends:      base,
                         array,
-                        HUnit
+                        HUnit,
+                        utf8-string,
+                        bytestring
     build-tool-depends: alex:alex, happy:happy
-    other-modules:      Parser.Lexer, TestLexer
+    other-modules:      Parser.Lexer,
+                        Parser.JavaParser,
+                        Ast,
+                        TestLexer,
+                        TestParser,
+                        TestByteCodeGenerator,
+                        ByteCode.ByteUtil,
+                        ByteCode.ClassFile,
+                        ByteCode.ClassFile.Generator,
+                        ByteCode.Constants

questions.md

@@ -0,0 +1,2 @@
+# Questions
+- Enum?

src/Ast.hs

@@ -2,11 +2,12 @@ module Ast where
 
 type CompilationUnit = [Class]
 type DataType = String
-type Identifier = String
-data ParameterDeclaration = ParameterDeclaration DataType Identifier deriving (Show)
-data VariableDeclaration = VariableDeclaration DataType Identifier (Maybe Expression) deriving (Show)
-data Class = Class DataType [MethodDeclaration] [VariableDeclaration] deriving (Show)
-data MethodDeclaration = MethodDeclaration DataType Identifier [ParameterDeclaration] Statement deriving (Show)
+type Identifier = String 
+
+data ParameterDeclaration = ParameterDeclaration DataType Identifier deriving (Show, Eq)
+data VariableDeclaration = VariableDeclaration DataType Identifier (Maybe Expression) deriving (Show, Eq)
+data Class = Class DataType [MethodDeclaration] [VariableDeclaration] deriving (Show, Eq)
+data MethodDeclaration = MethodDeclaration DataType Identifier [ParameterDeclaration] Statement deriving (Show, Eq)
 
 data Statement
   = If Expression Statement (Maybe Statement)
@@ -16,14 +17,14 @@ data Statement
   | Return (Maybe Expression)
   | StatementExpressionStatement StatementExpression
   | TypedStatement DataType Statement
-  deriving (Show)
+  deriving (Show, Eq)
 
 data StatementExpression
   = Assignment Expression Expression
   | ConstructorCall DataType [Expression]
   | MethodCall Expression Identifier [Expression]
   | TypedStatementExpression DataType StatementExpression
-  deriving (Show)
+  deriving (Show, Eq)
 
 data BinaryOperator
   = Addition
@@ -43,7 +44,7 @@ data BinaryOperator
   | And
   | Or
   | NameResolution
-  deriving (Show)
+  deriving (Show, Eq)
 
 data UnaryOperator
   = Not
@@ -52,7 +53,7 @@ data UnaryOperator
   | PostDecrement
   | PreIncrement
   | PreDecrement
-  deriving (Show)
+  deriving (Show, Eq)
 
 data Expression
   = IntegerLiteral Int
@@ -66,4 +67,4 @@ data Expression
   | UnaryOperation UnaryOperator Expression
   | StatementExpressionExpression StatementExpression
   | TypedExpression DataType Expression
-  deriving (Show)
+  deriving (Show, Eq)

src/ByteCode/ByteUtil.hs

@@ -0,0 +1,19 @@
+module ByteCode.ByteUtil(unpackWord16, unpackWord32) where
+
+import Data.Word ( Word8, Word16, Word32 )
+import Data.Int
+import Data.Bits
+
+unpackWord16 :: Word16 -> [Word8]
+unpackWord16 v = [
+                    fromIntegral (shiftR ((.&.) v 0xFF00) 8),
+                    fromIntegral (shiftR ((.&.) v 0x00FF) 0)
+                 ]
+
+unpackWord32 :: Word32 -> [Word8]
+unpackWord32 v = [
+                    fromIntegral (shiftR ((.&.) v 0xFF000000) 24),
+                    fromIntegral (shiftR ((.&.) v 0x00FF0000) 16),
+                    fromIntegral (shiftR ((.&.) v 0x0000FF00) 8),
+                    fromIntegral (shiftR ((.&.) v 0x000000FF) 0)
+                 ]

src/ByteCode/ClassFile.hs

@@ -0,0 +1,168 @@
+module ByteCode.ClassFile(
+    ConstantInfo(..),
+    Attribute(..),
+    MemberInfo(..),
+    ClassFile(..),
+    Operation(..),
+    serialize,
+    emptyClassFile
+) where
+
+import Data.Word
+import Data.Int
+import Data.ByteString (unpack)
+import Data.ByteString.UTF8 (fromString)
+import ByteCode.ByteUtil
+import ByteCode.Constants
+
+data ConstantInfo = ClassInfo Word16
+                  | FieldRefInfo Word16 Word16
+                  | MethodRefInfo Word16 Word16
+                  | NameAndTypeInfo Word16 Word16
+                  | IntegerInfo Int32
+                  | Utf8Info [Char]
+                  deriving (Show, Eq)
+
+data Operation = Opiadd
+               | Opisub
+               | Opimul
+               | Opidiv
+               | Opiand
+               | Opior
+               | Opixor
+               | Opineg
+               | Opif_icmplt Word16
+               | Opif_icmple Word16
+               | Opif_icmpgt Word16
+               | Opif_icmpge Word16
+               | Opif_icmpeq Word16
+               | Opif_icmpne Word16
+               | Opaconst_null
+               | Opreturn
+               | Opireturn
+               | Opareturn
+               | Opsipush Word16
+               | Opldc_w Word16
+               | Opaload Word16
+               | Opiload Word16
+               | Opastore Word16
+               | Opistore Word16
+               | Opputfield Word16
+               | OpgetField Word16
+    deriving (Show, Eq)
+
+
+data Attribute = CodeAttribute {
+    attributeMaxStack   :: Word16,
+    attributeMaxLocals  :: Word16,
+    attributeCode       :: [Operation]
+} deriving (Show, Eq)
+
+
+data MemberInfo = MemberInfo {
+    memberAccessFlags     :: Word16,
+    memberNameIndex       :: Word16,
+    memberDescriptorIndex :: Word16,
+    memberAttributes      :: [Attribute]
+} deriving (Show, Eq)
+
+data ClassFile = ClassFile {
+    constantPool    :: [ConstantInfo],
+    accessFlags     :: Word16,
+    thisClass       :: Word16,
+    superClass      :: Word16,
+    fields          :: [MemberInfo],
+    methods         :: [MemberInfo],
+    attributes      :: [Attribute]
+} deriving (Show, Eq)
+
+emptyClassFile :: ClassFile
+emptyClassFile = ClassFile {
+        constantPool = [],
+        accessFlags = accessPublic,
+        thisClass = 0,
+        superClass = 0,
+        fields = [],
+        methods = [],
+        attributes = []
+    }
+
+class Serializable a where
+    serialize :: a -> [Word8]
+
+instance Serializable ConstantInfo where
+    serialize (ClassInfo nameIndex) = tagClass : unpackWord16 nameIndex
+    serialize (FieldRefInfo classIndex nameAndTypeIndex) = tagFieldref : (unpackWord16 classIndex ++ unpackWord16 nameAndTypeIndex)
+    serialize (MethodRefInfo classIndex nameAndTypeIndex) = tagMethodref : (unpackWord16 classIndex ++ unpackWord16 nameAndTypeIndex)
+    serialize (NameAndTypeInfo classIndex descriptorIndex) = tagNameandtype : (unpackWord16 classIndex ++ unpackWord16 descriptorIndex)
+    serialize (IntegerInfo value) = tagInteger : unpackWord32 (fromIntegral value)
+    serialize (Utf8Info string) = tagUtf8 : unpackWord16 num_bytes ++ bytes where
+                                    bytes = unpack (fromString string)
+                                    num_bytes = fromIntegral $ length bytes
+
+instance Serializable MemberInfo where
+    serialize member = unpackWord16 (memberAccessFlags member)
+                    ++ unpackWord16 (memberNameIndex member)
+                    ++ unpackWord16 (memberDescriptorIndex member)
+                    ++ unpackWord16 (fromIntegral (length (memberAttributes member)))
+                    ++ 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 (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,
+                               attributeMaxLocals = maxLocals,
+                               attributeCode = code }) = let
+            assembledCode = concat (map serialize code)
+        in
+            unpackWord16 7                                                  -- attribute_name_index
+            ++ unpackWord32 (12 + (fromIntegral (length assembledCode)))    -- attribute_length
+            ++ unpackWord16 maxStack                                        -- max_stack
+            ++ unpackWord16 maxLocals                                       -- max_locals
+            ++ unpackWord32 (fromIntegral (length assembledCode))           -- code_length
+            ++ assembledCode                                                -- code
+            ++ unpackWord16 0                                               -- exception_table_length
+            ++ unpackWord16 0                                               -- attributes_count
+
+instance Serializable ClassFile where
+    serialize classfile  = unpackWord32 0xC0FEBABE                                           -- magic
+                        ++ unpackWord16 0                                                    -- minor version
+                        ++ unpackWord16 49                                                   -- major version
+                        ++ unpackWord16 (fromIntegral (1 + length (constantPool classfile))) -- constant pool count
+                        ++ concatMap serialize (constantPool classfile)                      -- constant pool
+                        ++ unpackWord16 (accessFlags classfile)                              -- access flags
+                        ++ unpackWord16 (thisClass classfile)                                -- this class
+                        ++ unpackWord16 (superClass classfile)                               -- super class
+                        ++ unpackWord16 0                                                    -- interface count
+                        ++ unpackWord16 (fromIntegral (length (fields classfile)))           -- fields count
+                        ++ concatMap serialize (fields classfile)                            -- fields info
+                        ++ unpackWord16 (fromIntegral (length (methods classfile)))          -- methods count
+                        ++ concatMap serialize (methods classfile)                           -- methods info
+                        ++ unpackWord16 (fromIntegral (length (attributes classfile)))       -- attributes count
+                        ++ concatMap serialize (attributes classfile)                        -- attributes info

src/ByteCode/ClassFile/Generator.hs

@@ -0,0 +1,169 @@
+module ByteCode.ClassFile.Generator(
+    classBuilder,
+    datatypeDescriptor,
+    methodParameterDescriptor,
+    methodDescriptor,
+) where
+
+import ByteCode.Constants
+import ByteCode.ClassFile (ClassFile (..), ConstantInfo (..), MemberInfo(..), Operation(..), Attribute(..))
+import Ast
+import Data.Char
+
+
+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 ++ ";"
+
+methodDescriptor :: MethodDeclaration -> String
+methodDescriptor (MethodDeclaration returntype _ parameters _) = let 
+        parameter_types = [datatype | ParameterDeclaration datatype _ <- parameters]
+    in
+        "("
+        ++ (concat (map methodParameterDescriptor parameter_types))
+        ++ ")"
+        ++ datatypeDescriptor returntype
+
+classBuilder :: ClassFileBuilder Class
+classBuilder (Class name methods fields) _ = let
+        baseConstants = [
+            ClassInfo 4,
+            MethodRefInfo 1 3,
+            NameAndTypeInfo 5 6,
+            Utf8Info "java/lang/Object",
+            Utf8Info "<init>",
+            Utf8Info "()V",
+            Utf8Info "Code"
+            ]
+        nameConstants = [ClassInfo 9, Utf8Info name]
+        nakedClassFile = ClassFile {
+            constantPool = baseConstants ++ nameConstants,
+            accessFlags = accessPublic,
+            thisClass = 8,
+            superClass = 1,
+            fields = [],
+            methods = [],
+            attributes = []
+        }
+    in
+        foldr methodBuilder (foldr fieldBuilder nakedClassFile fields) methods
+        
+        
+
+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 = [
+                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)),
+            memberAttributes = [
+                   CodeAttribute {
+                        attributeMaxStack = 420,
+                        attributeMaxLocals = 420,
+                        attributeCode = [Opiadd]
+                    }
+                ]
+            }
+    in
+        input {
+            constantPool = (constantPool input) ++ constants,
+            methods = (fields input) ++ [method]
+        }
+
+type Assembler a = a -> ([ConstantInfo], [Operation]) -> ([ConstantInfo], [Operation])
+
+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
+
+assembleMethod :: Assembler MethodDeclaration
+assembleMethod (MethodDeclaration _ _ _ (Block statements)) (constants, ops) =
+    foldr assembleStatement (constants, ops) statements
+
+assembleStatement :: Assembler Statement
+assembleStatement (TypedStatement stype (Return expr)) (constants, ops) = case expr of
+    Nothing -> (constants, ops ++ [Opreturn])
+    Just expr -> let
+            (expr_constants, expr_ops) = assembleExpression expr (constants, ops)
+        in  
+            (expr_constants, expr_ops ++ [returnOperation stype])
+
+assembleExpression :: Assembler Expression
+assembleExpression (TypedExpression _ (BinaryOperation op a b)) (constants, ops)
+    | elem op [Addition, Subtraction, Multiplication, Division, BitwiseAnd, BitwiseOr, BitwiseXor] = let
+            (aConstants, aOps) = assembleExpression a (constants, ops)
+            (bConstants, bOps) = assembleExpression b (aConstants, aOps)
+        in
+            (bConstants, bOps ++ [binaryOperation op])
+assembleExpression (TypedExpression _ (CharacterLiteral literal)) (constants, ops) = 
+    (constants, ops ++ [Opsipush (fromIntegral (ord literal))])
+assembleExpression (TypedExpression _ (BooleanLiteral literal)) (constants, ops) = 
+    (constants, ops ++ [Opsipush (if literal then 1 else 0)])
+assembleExpression (TypedExpression _ (IntegerLiteral literal)) (constants, ops)
+    | 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) = 
+    (constants, ops ++ [Opaconst_null])
+assembleExpression (TypedExpression etype (UnaryOperation Not expr)) (constants, ops) = let
+        (exprConstants, exprOps) = assembleExpression expr (constants, ops)
+        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)
+    in
+        (exprConstants, exprOps ++ [Opineg])

src/ByteCode/Constants.hs

@@ -0,0 +1,25 @@
+module ByteCode.Constants where
+import Data.Word
+
+
+tagClass :: Word8
+tagFieldref :: Word8
+tagMethodref :: Word8
+tagNameandtype :: Word8
+tagInteger :: Word8
+tagUtf8 :: Word8
+
+accessPublic :: Word16
+accessPrivate :: Word16
+accessProtected :: Word16
+
+tagClass        = 0x07
+tagFieldref     = 0x09
+tagMethodref    = 0x0A
+tagNameandtype  = 0x0C
+tagInteger      = 0x03
+tagUtf8         = 0x01
+
+accessPublic    = 0x01
+accessPrivate   = 0x02
+accessProtected = 0x04

src/Main.hs

@@ -5,4 +5,4 @@ import Typecheck
 
 main = do
     Example.runTypeCheck
-    
+    

src/Parser/JavaParser.y

@@ -1,12 +1,15 @@
 {
-module Parser.JavaParser (parse) where
---import AbsSyn
+module Parser.JavaParser (parse, parseStatement, parseExpression) where
+import Ast
 import Parser.Lexer
 }
 
 %name parse
+%name parseStatement statement
+%name parseExpression expression
 %tokentype { Token }
 %error { parseError }
+%errorhandlertype explist
   
 %token 
         BOOLEAN { BOOLEAN }
@@ -14,10 +17,10 @@ import Parser.Lexer
         CASE { CASE }
         CHAR  { CHAR  }
         CLASS { CLASS}
-        IDENTIFIER { IDENTIFIER $$}
-        INTLITERAL { INTLITERAL $$}
+        IDENTIFIER { IDENTIFIER $$ }
+        INTLITERAL { INTEGERLITERAL $$}
         DOT { DOT }
-        MOD { MOD }
+        MOD { MODULO }
         TIMESEQUAL { TIMESEQUAL }
         GREATEREQUAL { GREATEREQUAL }
         WHILE { WHILE }
@@ -29,30 +32,28 @@ import Parser.Lexer
         THIS { THIS }
         STATIC { STATIC }
         PROTECTED { PROTECTED }
-        TILDE { TILDE }
-        MUL { MUL }
+        TILDE { BITWISENOT }
+        MUL { TIMES }
         MINUS { MINUS }
-        EXCLMARK { EXCLMARK }
+        EXCLMARK { NOT }
         IF { IF }
         ELSE { ELSE }
-        DIVIDEEQUAL { DIVIDEEQUAL }
+        DIVIDEEQUAL { DIVEQUAL }
         NEW { NEW }
         LBRACKET { LBRACKET }
-        JNULL { JNULL }
-        BOOLLITERAL { BOOLLITERAL }
+        JNULL { NULLLITERAL }
+        BOOLLITERAL { BOOLLITERAL $$ }
         DIV { DIV }
-        LOGICALOR { LOGICALOR }
         NOTEQUAL { NOTEQUAL }
         INSTANCEOF { INSTANCEOF }
         ANDEQUAL { ANDEQUAL }
         ASSIGN { ASSIGN }
         DECREMENT { DECREMENT }
-        STRINGLITERAL { STRINGLITERAL }
-        CHARLITERAL { CHARLITERAL }
+        CHARLITERAL { CHARLITERAL $$ }
         AND { AND }
         XOREQUAL { XOREQUAL }
         RETURN { RETURN }
-        QUESMARK { QUESMARK }
+        QUESMARK { QUESTIONMARK }
         SHIFTLEFTEQUAL { SHIFTLEFTEQUAL }
         RBRACKET { RBRACKET }
         COMMA { COMMA }
@@ -68,7 +69,7 @@ import Parser.Lexer
         INT { INT }
         ABSTRACT { ABSTRACT }
         SEMICOLON { SEMICOLON }
-        SIGNEDSHIFTRIGHTEQUAL { SIGNEDSHIFTRIGHTEQUAL }
+        SIGNEDSHIFTRIGHTEQUAL { SHIFTRIGHTEQUAL }
         UNSIGNEDSHIFTRIGHTEQUAL { UNSIGNEDSHIFTRIGHTEQUAL }
         PLUSEQUAL { PLUSEQUAL }
         OREQUAL { OREQUAL }
@@ -76,138 +77,146 @@ import Parser.Lexer
         LESS { LESS }
 %%
 
-compilationunit  : typedeclarations { }
+compilationunit  : typedeclarations { $1 }
 
-typedeclarations : typedeclaration { }
-		 | typedeclarations typedeclaration { }
+typedeclarations : typedeclaration { [$1] }
+                 | typedeclarations typedeclaration { $1 ++ [$2] }
 
-name             : qualifiedname { }
-		 | simplename { }
+name             : simplename { $1 }
+                --  | qualifiedname { }
 
-typedeclaration  : classdeclaration { }
+typedeclaration  : classdeclaration { $1 }
 
 qualifiedname    : name  DOT IDENTIFIER { }
 
-simplename       : IDENTIFIER { }
+simplename       : IDENTIFIER { $1 }
 
-classdeclaration : CLASS IDENTIFIER classbody { }
-                 | modifiers CLASS IDENTIFIER classbody { }
+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 }
 
 classbody        : LBRACKET RBRACKET  { ([], []) }
-		 | LBRACKET classbodydeclarations  RBRACKET { }
+                 | LBRACKET classbodydeclarations  RBRACKET { $2 }
 
 modifiers        : modifier { }
-		 | modifiers modifier		 { }
+                 | modifiers modifier		 { }
 
-classbodydeclarations :  classbodydeclaration { }
-		 | classbodydeclarations classbodydeclaration{ }
+classbodydeclarations :  classbodydeclaration {
+                        case $1 of
+                        MethodDecl method -> ([method], [])
+                        FieldDecls fields -> ([], fields)
+                        }
+                 | classbodydeclarations classbodydeclaration {
+                        case ($1, $2) of
+                        ((methods, fields), MethodDecl method) -> ((methods ++ [method]), fields)
+                        ((methods, fields), FieldDecls newFields) -> (methods, (fields ++ newFields))
+                        }
 
 modifier         : PUBLIC { }
-		 | PROTECTED { }
+                 | PROTECTED { }
                  | PRIVATE { }
                  | STATIC { }
                  | ABSTRACT { }
 
 classtype        : classorinterfacetype{ }
 
-classbodydeclaration : classmemberdeclaration { }
-		 | constructordeclaration { }
+classbodydeclaration : classmemberdeclaration { $1 }
+                 | constructordeclaration { $1 }
 
-classorinterfacetype : name{ }
+classorinterfacetype : name { $1 }
 
-classmemberdeclaration : fielddeclaration { }
-		 | methoddeclaration { }
+classmemberdeclaration : fielddeclaration { $1 }
+                 | methoddeclaration { $1 }
 
-constructordeclaration : constructordeclarator constructorbody { }
-		 |  modifiers constructordeclarator constructorbody { }
+constructordeclaration : constructordeclarator constructorbody { case $1 of (classname, parameters) -> MethodDecl $ MethodDeclaration "void" "<init>" parameters $2 }
+                 |  modifiers constructordeclarator constructorbody { case $2 of (classname, parameters) -> MethodDecl $ MethodDeclaration "void" "<init>" parameters $3 }
 
-fielddeclaration : type variabledeclarators  SEMICOLON { }
- 		 | modifiers type variabledeclarators  SEMICOLON { }
+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 { Block $2 }
 
-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 { }
-		 | 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 { }
-		 | referencetype { }
+type             : primitivetype { $1 }
+                 | referencetype { $1 }
 
-variabledeclarators : variabledeclarator { }
-		 | variabledeclarators  COMMA  variabledeclarator { }
+variabledeclarators : variabledeclarator { [$1] }
+                 | variabledeclarators  COMMA  variabledeclarator { $1 ++ [$3] }
 
-methodbody       : block { }
-		 | SEMICOLON { }
+methodbody       : block { $1 }
+                 | SEMICOLON { Block [] }
 
-blockstatements  : blockstatement { }
-		 | blockstatements blockstatement { }
+blockstatements  : blockstatement { $1 }
+                 | blockstatements blockstatement { $1 ++ $2}
 
-formalparameterlist : formalparameter { }
-		 | formalparameterlist  COMMA  formalparameter{ }
+formalparameterlist : formalparameter { [$1] }
+                 | formalparameterlist  COMMA  formalparameter { $1 ++ [$3] }
 
 explicitconstructorinvocation : THIS LBRACE  RBRACE   SEMICOLON  { }
-		 | THIS LBRACE argumentlist  RBRACE   SEMICOLON  { }
+                 | THIS LBRACE argumentlist  RBRACE   SEMICOLON  { }
 
 classtypelist    : classtype { }
-		 | classtypelist  COMMA  classtype { }
+                 | classtypelist  COMMA  classtype { }
 
-methoddeclarator : IDENTIFIER LBRACE  RBRACE  { }
-		 | IDENTIFIER LBRACE formalparameterlist  RBRACE  { }
+methoddeclarator : IDENTIFIER LBRACE  RBRACE  { ($1, []) }
+                 | IDENTIFIER LBRACE formalparameterlist  RBRACE  { ($1, $3) }
 
-primitivetype    : BOOLEAN { }
-		 | numerictype { }
+primitivetype    : BOOLEAN { "boolean" }
+                 | numerictype { $1 }
 
-referencetype    : classorinterfacetype { }
+referencetype    : classorinterfacetype { $1 }
 
 
-variabledeclarator : variabledeclaratorid { }
-		 | variabledeclaratorid ASSIGN variableinitializer { }
+variabledeclarator : variabledeclaratorid { Declarator $1 Nothing }
+                 | variabledeclaratorid ASSIGN variableinitializer { Declarator $1 (Just $3) }
 
-blockstatement	 : localvariabledeclarationstatement { }
-		 | statement  { }
+blockstatement         : localvariabledeclarationstatement { $1 }
+                 | statement  { $1 }
 
-formalparameter  : type variabledeclaratorid { }
+formalparameter  : type variabledeclaratorid { ParameterDeclaration $1 $2 }
 
 argumentlist     : expression { }
-		 | argumentlist  COMMA  expression { }
+                 | argumentlist  COMMA  expression { }
 
-numerictype      : integraltype { }
+numerictype      : integraltype { $1 }
 
-variabledeclaratorid : IDENTIFIER { }
+variabledeclaratorid : IDENTIFIER { $1 }
 
-variableinitializer  : expression { }
+variableinitializer  : expression { $1 }
 
-localvariabledeclarationstatement : localvariabledeclaration  SEMICOLON  { }
+localvariabledeclarationstatement : localvariabledeclaration  SEMICOLON  { $1 }
 
-statement        : statementwithouttrailingsubstatement{ }
-		 | ifthenstatement { }
-		 | ifthenelsestatement { }
-		 | whilestatement { }
-				     
+statement        : statementwithouttrailingsubstatement{ $1 }
+                --  | ifthenstatement { }
+                --  | ifthenelsestatement { }
+                --  | whilestatement { }
+                                     
 
-expression       : assignmentexpression { }
+expression       : assignmentexpression { $1 }
 
-integraltype     : INT  { }
-                 | CHAR { }
+integraltype     : INT  { "int" }
+                 | CHAR { "char" }
 
-localvariabledeclaration : type variabledeclarators { }
+localvariabledeclaration : type variabledeclarators { map LocalVariableDeclaration $ map (convertDeclarator $1) $2 }
 
-statementwithouttrailingsubstatement : block { }
-		 | emptystatement { }
-		 | expressionstatement { }
-		 | returnstatement { }
+statementwithouttrailingsubstatement : block { [$1] }
+                 | emptystatement { [] }
+                --  | expressionstatement { }
+                 | returnstatement { [$1] }
 
 ifthenstatement  : IF LBRACE expression  RBRACE  statement { }
 
@@ -215,146 +224,153 @@ ifthenelsestatement : IF LBRACE expression  RBRACE statementnoshortif ELSE state
 
 whilestatement   : WHILE LBRACE expression  RBRACE  statement { }
 
-assignmentexpression : conditionalexpression { }
-		 |  assignment{ }
+assignmentexpression : conditionalexpression { $1 }
+                --  | assignment { }
 
-emptystatement	 :  SEMICOLON  { }
+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 { }
-		 | whilestatementnoshortif { }
+                 | 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 { }
-		 | preincrementexpression { }
-		 | predecrementexpression { }
-		 | postincrementexpression { }
-		 | postdecrementexpression { }
-		 | methodinvocation { }
-		 | classinstancecreationexpression { }
+                 | preincrementexpression { }
+                 | predecrementexpression { }
+                 | postincrementexpression { }
+                 | postdecrementexpression { }
+                 | methodinvocation { }
+                 | classinstancecreationexpression { }
 
 ifthenelsestatementnoshortif :IF LBRACE expression  RBRACE  statementnoshortif
-			      ELSE statementnoshortif  { }
+                              ELSE 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 { }
+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 { }
-		 | primary  DOT IDENTIFIER LBRACE RBRACE  { }
-		 | primary  DOT IDENTIFIER LBRACE argumentlist  RBRACE  { }
+                 | name LBRACE argumentlist RBRACE { }
+                 | primary  DOT IDENTIFIER LBRACE RBRACE  { }
+                 | primary  DOT IDENTIFIER LBRACE argumentlist  RBRACE  { }
      
 classinstancecreationexpression : NEW classtype LBRACE   RBRACE  { }
                  | NEW classtype LBRACE  argumentlist  RBRACE  { }
 
-conditionalandexpression : inclusiveorexpression { }
+conditionalandexpression : inclusiveorexpression { $1 }
 
 fieldaccess      : primary  DOT IDENTIFIER { }
 
-unaryexpression	 : preincrementexpression { }
-		 | predecrementexpression { }
-		 | PLUS unaryexpression { }
-		 | MINUS unaryexpression { }
-		 | unaryexpressionnotplusminus { }
+unaryexpression         : unaryexpressionnotplusminus { $1 }
+                 | predecrementexpression { $1 }
+                 | PLUS unaryexpression { $2 }
+                 | MINUS unaryexpression { UnaryOperation Minus $2 }
+                 | preincrementexpression { $1 }
 
-postfixexpression : primary { }
-		 | name { }
-		 | postincrementexpression { }
-		 | postdecrementexpression{ }
+postfixexpression : primary { $1 }
+                 | name { Reference $1 }
+                 | postincrementexpression { $1 }
+                 | postdecrementexpression{ $1 }
 
-primary		 : primarynonewarray { }
+primary                 : primarynonewarray { $1 }
 
-inclusiveorexpression : exclusiveorexpression { }
-		 | inclusiveorexpression OR exclusiveorexpression { }
+inclusiveorexpression : exclusiveorexpression { $1 }
+                 | inclusiveorexpression OR exclusiveorexpression { BinaryOperation Or $1 $3 }
 
-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 { UnaryOperation Not $2 }
+                --  | castexpression{ }
 
-exclusiveorexpression : andexpression { }
-		 | exclusiveorexpression XOR andexpression { }
+exclusiveorexpression : andexpression { $1 }
+                 | exclusiveorexpression XOR andexpression { BinaryOperation BitwiseXor $1 $3 }
 
-literal		 : INTLITERAL { }
-		 | BOOLLITERAL { }
-		 | CHARLITERAL { }
-		 | STRINGLITERAL { }
-		 | JNULL { }
+literal          : INTLITERAL { IntegerLiteral $1 }
+                 | BOOLLITERAL { BooleanLiteral $1 }
+                 | CHARLITERAL { CharacterLiteral $1 }
+                 | JNULL { NullLiteral }
 
-castexpression	 : LBRACE  primitivetype  RBRACE  unaryexpression { }
- 		 | LBRACE  expression  RBRACE  unaryexpressionnotplusminus{ }
+castexpression         : LBRACE  primitivetype  RBRACE  unaryexpression { }
+                  | LBRACE  expression  RBRACE  unaryexpressionnotplusminus{ }
 
-andexpression    : equalityexpression { }
-		 | andexpression AND equalityexpression { }
+andexpression    : equalityexpression { $1 }
+                 | andexpression AND equalityexpression { BinaryOperation And $1 $3 }
 
-equalityexpression : relationalexpression { }
-		 | equalityexpression EQUAL relationalexpression { }
-		 | equalityexpression NOTEQUAL relationalexpression { }
+equalityexpression : relationalexpression { $1 }
+                 | equalityexpression EQUAL relationalexpression { BinaryOperation CompareEqual $1 $3 }
+                 | equalityexpression NOTEQUAL relationalexpression { BinaryOperation CompareNotEqual $1 $3 }
 
-relationalexpression : shiftexpression { }
-		 | relationalexpression LESS shiftexpression { }
-		 | relationalexpression GREATER shiftexpression { }
-		 | relationalexpression LESSEQUAL shiftexpression { }
-		 | relationalexpression GREATEREQUAL shiftexpression { }
-		 | relationalexpression INSTANCEOF referencetype { }
+relationalexpression : shiftexpression { $1 }
+                 | 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 { }
+shiftexpression         : additiveexpression { $1 }
 
-additiveexpression : multiplicativeexpression { }
-		 | additiveexpression PLUS multiplicativeexpression { }
-		 | additiveexpression MINUS multiplicativeexpression { }
+additiveexpression : multiplicativeexpression { $1 }
+                 | additiveexpression PLUS multiplicativeexpression { BinaryOperation Addition $1 $3 }
+                 | additiveexpression MINUS multiplicativeexpression { BinaryOperation Subtraction $1 $3 }
 
-multiplicativeexpression : unaryexpression { }
-		 | multiplicativeexpression MUL unaryexpression { }
-		 | multiplicativeexpression DIV unaryexpression { }
-		 | multiplicativeexpression MOD unaryexpression { }
+multiplicativeexpression : unaryexpression { $1 }
+                 | multiplicativeexpression MUL unaryexpression { BinaryOperation Multiplication $1 $3 }
+                 | multiplicativeexpression DIV unaryexpression { BinaryOperation Division $1 $3 }
+                 | multiplicativeexpression MOD unaryexpression { BinaryOperation Modulo $1 $3 }
 
 
 {
 
-parseError :: [Token] -> a
-parseError _ = error "Parse error"
+data MethodOrFieldDeclaration = MethodDecl MethodDeclaration
+                              | FieldDecls [VariableDeclaration]
+
+data Declarator = Declarator Identifier (Maybe Expression)
+
+convertDeclarator :: DataType -> Declarator -> VariableDeclaration
+convertDeclarator dataType (Declarator id assigment) = VariableDeclaration dataType id assigment
+
+parseError :: ([Token], [String]) -> a
+parseError (errortoken, expected) = error ("parse error on token: " ++ show errortoken ++ "\nexpected one of:      " ++ show expected)
 
 }

src/Parser/Lexer.x

@@ -1,5 +1,6 @@
 {
-    module Parser.Lexer(Token(..), alexScanTokens) where
+module Parser.Lexer(Token(..), alexScanTokens) where
+import Text.Read
 }
 
 %wrapper "basic"
@@ -7,18 +8,221 @@
 $digit = 0-9
 $alpha = [a-zA-Z]
 $alphanum = [a-zA-Z0-9]
+$JavaLetter = [A-Za-z\_\$]
+$JavaLetterOrDigit = [A-Za-z\_\$0-9]
 
 tokens :-
     $white ;
-    "/*"(.|\n)*"*/" { \s -> Comment s }
-    "//".* {\s -> Comment s}
-
+    "/*"(.|\n)*"*/" ;
+    "//".* ;
+    -- keywords
+    "abstract" { \_ -> ABSTRACT }
+    "assert" { \_ -> BOOLEAN }
+    "boolean" { \_ -> BOOLEAN}
+    "break" { \_ -> BREAK}
+    "byte" { \_ -> BYTE}
+    "case" { \_ -> CASE}
+    "catch" { \_ -> CATCH}
+    "char" { \_ -> CHAR}
+    "class" { \_ -> CLASS}
+    "const" { \_ -> CONST}
+    "continue" { \_ -> CONTINUE}
+    "default" { \_ -> DEFAULT}
+    "do" { \_ -> DO}
+    "double" { \_ -> DOUBLE}
+    ("else"|"ifn't") { \_ -> ELSE}
+    "enum" { \_ -> ENUM}
+    "extends" { \_ -> EXTENDS}
+    "final" { \_ -> FINAL}
+    "finally" { \_ -> FINALLY}
+    "float" { \_ -> FLOAT}
+    "for" { \_ -> FOR}
+    "if" { \_ -> IF}
+    "goto" { \_ -> GOTO}
+    "implements" { \_ -> IMPLEMENTS}
+    "import" { \_ -> IMPORT}
+    "instanceof" { \_ -> INSTANCEOF}
+    "int" { \_ -> INT}
+    "long" { \_ -> LONG}
+    "native" { \_ -> NATIVE}
+    "new" { \_ -> NEW}
+    "package" { \_ -> PACKAGE}
+    "private" { \_ -> PRIVATE}
+    "protected" { \_ -> PROTECTED}
+    "public" { \_ -> PUBLIC}
+    "return" { \_ -> RETURN}
+    "short" { \_ -> SHORT}
+    "static" { \_ -> STATIC}
+    "strictfp" { \_ -> STRICTFP}
+    "super" { \_ -> SUPER}
+    "switch" { \_ -> SWITCH}
+    "synchronized" { \_ -> SYNCHRONIZED}
+    "this" { \_ -> THIS}
+    "throw" { \_ -> THROW}
+    "throws" { \_ -> THROWS}
+    "transient" { \_ -> TRANSIENT}
+    "try" { \_ -> TRY}
+    "void" { \_ -> VOID}
+    "volatile" { \_ -> VOLATILE}
+    "while" { \_ -> WHILE}
+    -- Literals
+    "true" { \_ -> BOOLLITERAL True }
+    "false" { \_ -> BOOLLITERAL False }
+    "null" { \_ -> NULLLITERAL }
+    -- 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) }
+    "'"."'" { \s -> case (s) of _ : c : _ -> CHARLITERAL c; _ -> error ("failed to parse CHARLITERAL " ++ s) }
+    -- separators
+    "(" { \_ -> LBRACE }
+    ")" { \_ -> RBRACE }
+    "{" { \_ -> LBRACKET }
+    "}" { \_ -> RBRACKET }
+    ";" { \_ -> SEMICOLON }
+    "," { \_ -> COMMA}
+    "." { \_ -> DOT }
+    -- operators
+    "=" { \_ -> ASSIGN }
+    "==" { \_ -> EQUAL }
+    "+" { \_ -> PLUS }
+    "+=" { \_ -> PLUSEQUAL }
+    ">" { \_ -> GREATER }
+    ">=" { \_ -> GREATEREQUAL }
+    "-" { \_ -> MINUS }
+    "-=" { \_ -> MINUSEQUAL }
+    "<" { \_ -> LESS }
+    "<=" { \_ -> LESSEQUAL }
+    "*" { \_ -> TIMES }
+    "*=" { \_ -> TIMESEQUAL }
+    "!" { \_ -> NOT }
+    "!=" { \_ -> NOTEQUAL }
+    "/" { \_ -> DIV }
+    "/=" { \_ -> DIVEQUAL }
+    "~" { \_ -> BITWISENOT }
+    "&&" { \_ -> AND }
+    "&" { \_ -> BITWISEAND }
+    "&=" { \_ -> ANDEQUAL }
+    "?" { \_ -> QUESTIONMARK }
+    "||" { \_ -> OR }
+    "|" { \_ -> BITWISEOR }
+    "|=" { \_ -> OREQUAL }
+    ":" { \_ -> COLON }
+    "++" { \_ -> INCREMENT }
+    "^" { \_ -> XOR }
+    "^=" { \_ -> XOREQUAL }
+    "--" { \_ -> DECREMENT }
+    "%" { \_ -> MODULO }
+    "%=" { \_ -> MODULOEQUAL }
+    "<<" { \_ -> SHIFTLEFT }
+    "<<=" { \_ -> SHIFTLEFTEQUAL }
+    ">>" { \_ -> SHIFTRIGHT }
+    ">>=" { \_ -> SHIFTRIGHTEQUAL }
+    ">>>" { \_ -> UNSIGNEDSHIFTRIGHT }
+    ">>>=" { \_ -> UNSIGNEDSHIFTRIGHTEQUAL }
 
 
 {
 data Token 
-    = Comment String
-    | Different
+    = ABSTRACT
+    | ASSERT
+    | BOOLEAN
+    | BREAK
+    | BYTE
+    | CASE
+    | CATCH
+    | CHAR
+    | CLASS
+    | CONST
+    | CONTINUE
+    | DEFAULT
+    | DO
+    | DOUBLE
+    | ELSE
+    | ENUM
+    | EXTENDS
+    | FINAL
+    | FINALLY
+    | FLOAT
+    | FOR
+    | IF
+    | GOTO
+    | IMPLEMENTS
+    | IMPORT
+    | INSTANCEOF
+    | INT
+    | INTERFACE
+    | LONG
+    | NATIVE
+    | NEW
+    | PACKAGE
+    | PRIVATE
+    | PROTECTED
+    | PUBLIC
+    | RETURN
+    | SHORT
+    | STATIC
+    | STRICTFP
+    | SUPER
+    | SWITCH
+    | SYNCHRONIZED
+    | THIS
+    | THROW
+    | THROWS
+    | TRANSIENT
+    | TRY
+    | VOID
+    | VOLATILE
+    | WHILE
+    | IDENTIFIER String
+    | INTEGERLITERAL Int
+    | CHARLITERAL Char
+    | BOOLLITERAL Bool
+    | NULLLITERAL
+    | LBRACE
+    | RBRACE
+    | LBRACKET
+    | RBRACKET
+    | SEMICOLON
+    | COMMA
+    | DOT
+    | ASSIGN
+    | EQUAL
+    | PLUS
+    | PLUSEQUAL
+    | GREATER
+    | GREATEREQUAL
+    | MINUS
+    | MINUSEQUAL
+    | LESS
+    | LESSEQUAL
+    | TIMES
+    | TIMESEQUAL
+    | NOT
+    | NOTEQUAL
+    | DIV
+    | DIVEQUAL
+    | BITWISENOT
+    | AND
+    | BITWISEAND
+    | ANDEQUAL
+    | QUESTIONMARK
+    | OR
+    | BITWISEOR
+    | OREQUAL
+    | COLON
+    | INCREMENT
+    | XOR
+    | XOREQUAL
+    | DECREMENT
+    | MODULO
+    | MODULOEQUAL
+    | SHIFTLEFT
+    | SHIFTLEFTEQUAL
+    | SHIFTRIGHT
+    | SHIFTRIGHTEQUAL
+    | UNSIGNEDSHIFTRIGHT
+    | UNSIGNEDSHIFTRIGHTEQUAL
     deriving(Eq,Show)
 
 }