Merge branch 'create-parser' of ssh://gitea.hb.dhbw-stuttgart.de:2222/MisterChaos69/MiniJavaCompiler into bytecode

.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*/"
+emptyTokenList :: [Token]
-testEmptyComment =  TestCase $ assertEqual "scan /*x*/"  [Comment "/**/"] $ alexScanTokens "/**/"
+emptyTokenList = []
-testLineComment = TestCase $ assertEqual "scan // comment" [Comment "// comment"] $ alexScanTokens "// comment"
+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,28 @@
+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]
+
+
+tests = TestList [
+    testSingleEmptyClass,
+    testTwoEmptyClasses,
+    testBooleanField,
+    testIntField
+    ]

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
+    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,53 +2,64 @@ module Ast where
 
 type CompilationUnit = [Class]
 type DataType = String
-type Identifier = String
+type Identifier = String 
 
-data ParameterDeclaration = ParameterDeclaration DataType Identifier
+data ParameterDeclaration = ParameterDeclaration DataType Identifier deriving (Show, Eq)
-data VariableDeclaration = VariableDeclaration DataType Identifier (Maybe Expression)
+data VariableDeclaration = VariableDeclaration DataType Identifier (Maybe Expression) deriving (Show, Eq)
-data Class = Class DataType [MethodDeclaration] [VariableDeclaration]
+data Class = Class DataType [MethodDeclaration] [VariableDeclaration] deriving (Show, Eq)
-data MethodDeclaration = MethodDeclaration DataType Identifier [ParameterDeclaration] Statement
+data MethodDeclaration = MethodDeclaration DataType Identifier [ParameterDeclaration] Statement deriving (Show, Eq)
 
-data Statement = If Expression Statement (Maybe Statement)
+data Statement
-               | LocalVariableDeclaration VariableDeclaration
+  = If Expression Statement (Maybe Statement)
-               | While Expression Statement
+  | LocalVariableDeclaration VariableDeclaration
-               | Block [Statement]
+  | While Expression Statement
-               | Return (Maybe Expression)
+  | Block [Statement]
-               | StatementExpressionStatement StatementExpression
+  | Return (Maybe Expression)
-               | TypedStatement DataType Statement
+  | StatementExpressionStatement StatementExpression
+  | TypedStatement DataType Statement
+  deriving (Show, Eq)
 
-data StatementExpression = Assignment Identifier Expression
+data StatementExpression
-                         | ConstructorCall DataType [Expression]
+  = Assignment Identifier Expression
-                         | MethodCall Identifier [Expression]
+  | ConstructorCall DataType [Expression]
-                         | TypedStatementExpression DataType StatementExpression
+  | MethodCall Expression Identifier [Expression]
+  | TypedStatementExpression DataType StatementExpression
+  deriving (Show, Eq)
 
-data BinaryOperator = Addition
+data BinaryOperator
-                    | Subtraction
+  = Addition
-                    | Multiplication
+  | Subtraction
-                    | Division
+  | Multiplication
-                    | BitwiseAnd
+  | Division
-                    | BitwiseOr
+  | BitwiseAnd
-                    | BitwiseXor
+  | BitwiseOr
-                    | CompareLessThan
+  | BitwiseXor
-                    | CompareLessOrEqual
+  | CompareLessThan
-                    | CompareGreaterThan
+  | CompareLessOrEqual
-                    | CompareGreaterOrEqual
+  | CompareGreaterThan
-                    | CompareEqual
+  | CompareGreaterOrEqual
-                    | CompareNotEqual
+  | CompareEqual
-                    | And
+  | CompareNotEqual
-                    | Or
+  | And
-                    | NameResolution
+  | Or
+  | NameResolution
+  deriving (Show, Eq)
 
-data UnaryOperator = Not
+data UnaryOperator
-                   | Minus
+  = Not
+  | Minus
+  deriving (Show, Eq)
 
-data Expression = IntegerLiteral Int
+data Expression
-                | CharacterLiteral Char
+  = IntegerLiteral Int
-                | BooleanLiteral Bool
+  | CharacterLiteral Char
-                | NullLiteral
+  | BooleanLiteral Bool
-                | Reference Identifier
+  | NullLiteral
-                | BinaryOperation BinaryOperator Expression Expression
+  | Reference Identifier
-                | UnaryOperation UnaryOperator Expression
+  | LocalVariable Identifier
-                | StatementExpressionExpression StatementExpression
+  | FieldVariable Identifier
-                | TypedExpression DataType Expression
+  | BinaryOperation BinaryOperator Expression Expression
-                
+  | UnaryOperation UnaryOperator Expression
+  | StatementExpressionExpression StatementExpression
+  | TypedExpression DataType Expression
+  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/Example.hs

@@ -0,0 +1,203 @@
+module Example where
+
+import Ast
+import Typecheck
+import Control.Exception (catch, evaluate, SomeException, displayException)
+import Control.Exception.Base
+import System.IO (stderr, hPutStrLn)
+import Data.Maybe
+import Data.List
+
+green, red, yellow, blue, magenta, cyan, white :: String -> String
+green str = "\x1b[32m" ++ str ++ "\x1b[0m"
+red str = "\x1b[31m" ++ str ++ "\x1b[0m"
+yellow str = "\x1b[33m" ++ str ++ "\x1b[0m"
+blue str = "\x1b[34m" ++ str ++ "\x1b[0m"
+magenta str = "\x1b[35m" ++ str ++ "\x1b[0m"
+cyan str = "\x1b[36m" ++ str ++ "\x1b[0m"
+white str = "\x1b[37m" ++ str ++ "\x1b[0m"
+
+printSuccess :: String -> IO ()
+printSuccess msg = putStrLn $ green "Success:" ++ white msg
+
+handleError :: SomeException -> IO ()
+handleError e = hPutStrLn stderr $ red ("Error: " ++ displayException e)
+
+printResult :: Show a => String -> a -> IO ()
+printResult title result = do
+    putStrLn $ green title
+    print result
+
+sampleClasses :: [Class]
+sampleClasses = [
+    Class "Person" [
+        MethodDeclaration "void" "setAge" [ParameterDeclaration "int" "newAge"]
+        (Block [
+            LocalVariableDeclaration (VariableDeclaration "int" "age" (Just (Reference "newAge")))
+        ]),
+        MethodDeclaration "int" "getAge" [] (Return (Just (Reference "age"))),
+        MethodDeclaration "Person" "Person" [ParameterDeclaration "int" "initialAge"] (Block [])
+    ] [
+        VariableDeclaration "int" "age" (Just (IntegerLiteral 25))
+    ]
+ ]
+
+initialSymtab :: [(DataType, Identifier)]
+initialSymtab = []
+
+exampleExpression :: Expression
+exampleExpression = BinaryOperation NameResolution (Reference "bob") (Reference "age")
+
+exampleAssignment :: Expression
+exampleAssignment = StatementExpressionExpression (Assignment "a" (IntegerLiteral 30))
+
+exampleMethodCall :: Statement
+exampleMethodCall = StatementExpressionStatement (MethodCall (Reference "this") "setAge" [IntegerLiteral 30])
+
+exampleConstructorCall :: Statement
+exampleConstructorCall = LocalVariableDeclaration (VariableDeclaration "Person" "bob" (Just (StatementExpressionExpression  (ConstructorCall "Person" [IntegerLiteral 30]))))
+
+exampleNameResolution :: Expression
+exampleNameResolution = BinaryOperation NameResolution (Reference "b") (Reference "age")
+
+exampleBlockResolution :: Statement
+exampleBlockResolution = 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])
+    ]
+
+exampleBlockResolutionFail :: Statement
+exampleBlockResolutionFail = Block [
+    LocalVariableDeclaration (VariableDeclaration "Person" "bob" (Just (StatementExpressionExpression  (ConstructorCall "Person" [IntegerLiteral 30])))),
+    LocalVariableDeclaration (VariableDeclaration "bool" "age" (Just (StatementExpressionExpression (MethodCall (Reference "bob") "getAge" [])))),
+    StatementExpressionStatement (MethodCall (Reference "bob") "setAge" [IntegerLiteral 30])
+    ]
+
+exampleMethodCallAndAssignment :: Statement
+exampleMethodCallAndAssignment = 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]),
+    LocalVariableDeclaration (VariableDeclaration "int" "a" Nothing),
+    StatementExpressionStatement (Assignment "a" (Reference "age"))
+    ]
+
+
+exampleMethodCallAndAssignmentFail :: Statement
+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"))
+    ]
+
+testClasses :: [Class]
+testClasses = [
+    Class "Person" [
+        MethodDeclaration "Person" "Person" [ParameterDeclaration "int" "initialAge"] 
+        (Block [
+            Return (Just (Reference "this"))
+        ]),
+        MethodDeclaration "void" "setAge" [ParameterDeclaration "int" "newAge"] 
+        (Block [
+            LocalVariableDeclaration (VariableDeclaration "int" "age" (Just (Reference "newAge")))
+        ]),
+        MethodDeclaration "int" "getAge" [] 
+        (Return (Just (Reference "age")))
+    ] [
+        VariableDeclaration "int" "age" Nothing  -- initially unassigned
+    ],
+    Class "Main" [
+        MethodDeclaration "int" "main" [] 
+        (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" [])))),
+            Return (Just (Reference "bobAge"))
+        ])
+    ] []
+ ]
+
+runTypeCheck :: IO ()
+runTypeCheck = do
+    catch (do
+        print "====================================================================================="
+        evaluatedExpression <- evaluate (typeCheckExpression exampleExpression [("bob", "Person")] sampleClasses)
+        printSuccess "Type checking of expression completed successfully"
+        printResult "Result Expression:" evaluatedExpression
+      ) handleError
+
+    catch (do
+        print "====================================================================================="
+        evaluatedAssignment <- evaluate (typeCheckExpression exampleAssignment [("a", "int")] sampleClasses)
+        printSuccess "Type checking of assignment completed successfully"
+        printResult "Result Assignment:" evaluatedAssignment
+      ) handleError
+
+    catch (do
+        print "====================================================================================="
+        evaluatedMethodCall <- evaluate (typeCheckStatement exampleMethodCall [("this", "Person"), ("setAge", "Person"), ("getAge", "Person")] sampleClasses)
+        printSuccess "Type checking of method call this completed successfully"
+        printResult "Result MethodCall:" evaluatedMethodCall
+      ) handleError
+
+    catch (do
+        print "====================================================================================="
+        evaluatedConstructorCall <- evaluate (typeCheckStatement exampleConstructorCall [] sampleClasses)
+        printSuccess "Type checking of constructor call completed successfully"
+        printResult "Result Constructor Call:" evaluatedConstructorCall
+      ) handleError
+
+    catch (do
+        print "====================================================================================="
+        evaluatedNameResolution <- evaluate (typeCheckExpression exampleNameResolution [("b", "Person")] sampleClasses)
+        printSuccess "Type checking of name resolution completed successfully"
+        printResult "Result Name Resolution:" evaluatedNameResolution
+      ) handleError
+
+    catch (do
+        print "====================================================================================="
+        evaluatedBlockResolution <- evaluate (typeCheckStatement exampleBlockResolution [] sampleClasses)
+        printSuccess "Type checking of block resolution completed successfully"
+        printResult "Result Block Resolution:" evaluatedBlockResolution
+      ) handleError
+
+    catch (do
+        print "====================================================================================="
+        evaluatedBlockResolutionFail <- evaluate (typeCheckStatement exampleBlockResolutionFail [] sampleClasses)
+        printSuccess "Type checking of block resolution failed"
+        printResult "Result Block Resolution:" evaluatedBlockResolutionFail
+      ) handleError
+
+    catch (do
+        print "====================================================================================="
+        evaluatedMethodCallAndAssignment <- evaluate (typeCheckStatement exampleMethodCallAndAssignment [] sampleClasses)
+        printSuccess "Type checking of method call and assignment completed successfully"
+        printResult "Result Method Call and Assignment:" evaluatedMethodCallAndAssignment
+      ) handleError
+
+    catch (do
+        print "====================================================================================="
+        evaluatedMethodCallAndAssignmentFail <- evaluate (typeCheckStatement exampleMethodCallAndAssignmentFail [] sampleClasses)
+        printSuccess "Type checking of method call and assignment failed"
+        printResult "Result Method Call and Assignment:" evaluatedMethodCallAndAssignmentFail
+      ) handleError
+
+    catch (do
+        print "====================================================================================="
+        let mainClass = fromJust $ find (\(Class className _ _) -> className == "Main") testClasses
+        case mainClass of
+            Class _ [mainMethod] _ -> do
+                let result = typeCheckMethodDeclaration mainMethod [] testClasses
+                printSuccess "Full program type checking completed successfully."
+                printResult "Main method result:" result
+      ) handleError
+
+    catch (do
+        print "====================================================================================="
+        let typedProgram = typeCheckCompilationUnit testClasses
+        printSuccess "Type checking of Program completed successfully"
+        printResult "Typed Program:" typedProgram
+        ) handleError
+

src/Main.hs

@@ -1,6 +1,8 @@
 module Main where
 
-import Parser.Lexer
+import Example
+import Typecheck
 
 main = do
-    print $ alexScanTokens "/**/"
+    Example.runTypeCheck
+    

src/Parser/JavaParser.y

@@ -1,6 +1,6 @@
 {
 module Parser.JavaParser (parse) where
---import AbsSyn
+import Ast
 import Parser.Lexer
 }
 
@@ -14,10 +14,10 @@ import Parser.Lexer
         CASE { CASE }
         CHAR  { CHAR  }
         CLASS { CLASS}
-        IDENTIFIER { IDENTIFIER $$}
+        IDENTIFIER { IDENTIFIER $$ }
-        INTLITERAL { INTLITERAL $$}
+        INTLITERAL { INTEGERLITERAL $$}
         DOT { DOT }
-        MOD { MOD }
+        MOD { MODULO }
         TIMESEQUAL { TIMESEQUAL }
         GREATEREQUAL { GREATEREQUAL }
         WHILE { WHILE }
@@ -29,30 +29,29 @@ import Parser.Lexer
         THIS { THIS }
         STATIC { STATIC }
         PROTECTED { PROTECTED }
-        TILDE { TILDE }
+        TILDE { BITWISENOT }
-        MUL { MUL }
+        MUL { TIMES }
         MINUS { MINUS }
-        EXCLMARK { EXCLMARK }
+        EXCLMARK { NOT }
         IF { IF }
         ELSE { ELSE }
-        DIVIDEEQUAL { DIVIDEEQUAL }
+        DIVIDEEQUAL { DIVEQUAL }
         NEW { NEW }
         LBRACKET { LBRACKET }
-        JNULL { JNULL }
+        JNULL { NULLLITERAL }
-        BOOLLITERAL { BOOLLITERAL }
+        BOOLLITERAL { BOOLLITERAL $$ }
         DIV { DIV }
-        LOGICALOR { LOGICALOR }
+        LOGICALOR { OR }
         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 +67,7 @@ import Parser.Lexer
         INT { INT }
         ABSTRACT { ABSTRACT }
         SEMICOLON { SEMICOLON }
-        SIGNEDSHIFTRIGHTEQUAL { SIGNEDSHIFTRIGHTEQUAL }
+        SIGNEDSHIFTRIGHTEQUAL { SHIFTRIGHTEQUAL }
         UNSIGNEDSHIFTRIGHTEQUAL { UNSIGNEDSHIFTRIGHTEQUAL }
         PLUSEQUAL { PLUSEQUAL }
         OREQUAL { OREQUAL }
@@ -76,138 +75,146 @@ import Parser.Lexer
         LESS { LESS }
 %%
 
-compilationunit  : typedeclarations { }
+compilationunit  : typedeclarations { $1 }
 
-typedeclarations : typedeclaration { }
+typedeclarations : typedeclaration { [$1] }
-		 | typedeclarations typedeclaration { }
+                 | typedeclarations typedeclaration { $1 ++ [$2] }
 
 name             : qualifiedname { }
-		 | simplename { }
+                 | simplename { }
 
-typedeclaration  : classdeclaration { }
+typedeclaration  : classdeclaration { $1 }
 
 qualifiedname    : name  DOT IDENTIFIER { }
 
 simplename       : IDENTIFIER { }
 
-classdeclaration : CLASS IDENTIFIER classbody { }
+classdeclaration : CLASS IDENTIFIER classbody { case $3 of (methods, fields) -> Class $2 methods fields }
-                 | modifiers CLASS IDENTIFIER classbody { }
+                --  | 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), FieldDecl field) -> (methods, (fields ++ [field]))
+                --         }
 
 modifier         : PUBLIC { }
-		 | PROTECTED { }
+                 | PROTECTED { }
                  | PRIVATE { }
                  | STATIC { }
                  | ABSTRACT { }
 
 classtype        : classorinterfacetype{ }
 
-classbodydeclaration : classmemberdeclaration { }
+classbodydeclaration : classmemberdeclaration { $1 }
-		 | constructordeclaration { }
+                --  | constructordeclaration { FieldDecl $ VariableDeclaration "int" "a" Nothing }  -- TODO
 
 classorinterfacetype : name{ }
 
-classmemberdeclaration : fielddeclaration { }
+classmemberdeclaration : fielddeclaration { $1 }
-		 | methoddeclaration { }
+                --  | methoddeclaration { }
 
 constructordeclaration : constructordeclarator constructorbody { }
-		 |  modifiers constructordeclarator constructorbody { }
+                 |  modifiers constructordeclarator constructorbody { }
 
-fielddeclaration : type variabledeclarators  SEMICOLON { }
+fielddeclaration : type variabledeclarators  SEMICOLON { FieldDecls $ map (convertDeclarator $1) $2 }
- 		 | modifiers type variabledeclarators  SEMICOLON { }
+                --   | modifiers type variabledeclarators  SEMICOLON {}
 
 methoddeclaration : methodheader methodbody { }
 
 block            : LBRACKET   RBRACKET { }
-		 | LBRACKET  blockstatements  RBRACKET { }
+                 | LBRACKET  blockstatements  RBRACKET { }
 
 constructordeclarator :  simplename LBRACE  RBRACE  { }
-		 |  simplename LBRACE formalparameterlist RBRACE  { }
+                 |  simplename LBRACE formalparameterlist RBRACE  { }
 
-constructorbody	 : LBRACKET RBRACKET { }
+constructorbody  : LBRACKET RBRACKET { }
-		 | LBRACKET explicitconstructorinvocation  RBRACKET { }
+                 | LBRACKET explicitconstructorinvocation  RBRACKET { }
-		 | LBRACKET blockstatements  RBRACKET { }
+                 | LBRACKET blockstatements  RBRACKET { }
-		 | LBRACKET explicitconstructorinvocation blockstatements RBRACKET { }
+                 | LBRACKET explicitconstructorinvocation blockstatements RBRACKET { }
 
-methodheader	 : type methoddeclarator { }
+methodheader         : type methoddeclarator { }
-		 | modifiers type methoddeclarator { }
+                 | modifiers type methoddeclarator { }
-		 | VOID methoddeclarator { }
+                 | VOID methoddeclarator { }
-		 | modifiers VOID methoddeclarator { }
+                 | modifiers VOID methoddeclarator { }
 
-type             : primitivetype { }
+type             : primitivetype { $1 }
-		 | referencetype { }
+                --  | referencetype { }
 
-variabledeclarators : variabledeclarator { }
+variabledeclarators : variabledeclarator { [$1] }
-		 | variabledeclarators  COMMA  variabledeclarator { }
+                --  | variabledeclarators  COMMA  variabledeclarator { $1 ++ [$3] }
 
 methodbody       : block { }
-		 | SEMICOLON { }
+                 | SEMICOLON { }
 
 blockstatements  : blockstatement { }
-		 | blockstatements blockstatement { }
+                 | blockstatements blockstatement { }
 
 formalparameterlist : formalparameter { }
-		 | formalparameterlist  COMMA  formalparameter{ }
+                 | formalparameterlist  COMMA  formalparameter{ }
 
 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  { }
+                 | IDENTIFIER LBRACE formalparameterlist  RBRACE  { }
 
-primitivetype    : BOOLEAN { }
+primitivetype    : BOOLEAN { "boolean" }
-		 | numerictype { }
+                 | numerictype { $1 }
 
 referencetype    : classorinterfacetype { }
 
 
-variabledeclarator : variabledeclaratorid { }
+variabledeclarator : variabledeclaratorid { Declarator $1 Nothing }
-		 | variabledeclaratorid ASSIGN variableinitializer { }
+                --  | variabledeclaratorid ASSIGN variableinitializer { Declarator $1 Nothing } -- TODO
 
-blockstatement	 : localvariabledeclarationstatement { }
+blockstatement         : localvariabledeclarationstatement { }
-		 | statement  { }
+                 | statement  { }
 
 formalparameter  : type variabledeclaratorid { }
 
 argumentlist     : expression { }
-		 | argumentlist  COMMA  expression { }
+                 | argumentlist  COMMA  expression { }
 
-numerictype      : integraltype { }
+numerictype      : integraltype { $1 }
 
-variabledeclaratorid : IDENTIFIER { }
+variabledeclaratorid : IDENTIFIER { $1 }
 
 variableinitializer  : expression { }
 
 localvariabledeclarationstatement : localvariabledeclaration  SEMICOLON  { }
 
 statement        : statementwithouttrailingsubstatement{ }
-		 | ifthenstatement { }
+                 | ifthenstatement { }
-		 | ifthenelsestatement { }
+                 | ifthenelsestatement { }
-		 | whilestatement { }
+                 | whilestatement { }
-				     
+                                     
 
 expression       : assignmentexpression { }
 
-integraltype     : INT  { }
+integraltype     : INT  { "int" }
-                 | CHAR { }
+                 | CHAR { "char" }
 
 localvariabledeclaration : type variabledeclarators { }
 
 statementwithouttrailingsubstatement : block { }
-		 | emptystatement { }
+                 | emptystatement { }
-		 | expressionstatement { }
+                 | expressionstatement { }
-		 | returnstatement { }
+                 | returnstatement { }
 
 ifthenstatement  : IF LBRACE expression  RBRACE  statement { }
 
@@ -216,55 +223,55 @@ ifthenelsestatement : IF LBRACE expression  RBRACE statementnoshortif ELSE state
 whilestatement   : WHILE LBRACE expression  RBRACE  statement { }
 
 assignmentexpression : conditionalexpression { }
-		 |  assignment{ }
+                 |  assignment{ }
 
-emptystatement	 :  SEMICOLON  { }
+emptystatement         :  SEMICOLON  { }
 
 expressionstatement : statementexpression  SEMICOLON { }
 
 returnstatement  : RETURN  SEMICOLON  { }
-		 | RETURN expression  SEMICOLON { }
+                 | RETURN expression  SEMICOLON { }
 
 statementnoshortif : statementwithouttrailingsubstatement { }
-		 | ifthenelsestatementnoshortif { }
+                 | ifthenelsestatementnoshortif { }
-		 | whilestatementnoshortif { }
+                 | whilestatementnoshortif { }
 
 conditionalexpression : conditionalorexpression { }
-		 | conditionalorexpression QUESMARK expression  COLON  conditionalexpression { }
+                 | conditionalorexpression QUESMARK expression  COLON  conditionalexpression { }
 
 assignment       :lefthandside assignmentoperator assignmentexpression { }
-	
+        
 
 statementexpression : assignment { }
-		 | preincrementexpression { }
+                 | preincrementexpression { }
-		 | predecrementexpression { }
+                 | predecrementexpression { }
-		 | postincrementexpression { }
+                 | postincrementexpression { }
-		 | postdecrementexpression { }
+                 | postdecrementexpression { }
-		 | methodinvocation { }
+                 | methodinvocation { }
-		 | classinstancecreationexpression { }
+                 | classinstancecreationexpression { }
 
 ifthenelsestatementnoshortif :IF LBRACE expression  RBRACE  statementnoshortif
-			      ELSE statementnoshortif  { }
+                              ELSE statementnoshortif  { }
 
 whilestatementnoshortif : WHILE LBRACE expression  RBRACE  statementnoshortif { }
 
 conditionalorexpression : conditionalandexpression { }
-		 | conditionalorexpression LOGICALOR conditionalandexpression{ }
+                 | conditionalorexpression LOGICALOR conditionalandexpression{ }
 
 lefthandside     : name { }
 
 assignmentoperator : ASSIGN{ }
-		 | TIMESEQUAL { }
+                 | TIMESEQUAL { }
-		 | DIVIDEEQUAL { }
+                 | DIVIDEEQUAL { }
-		 | MODULOEQUAL { }
+                 | MODULOEQUAL { }
-		 | PLUSEQUAL { }
+                 | PLUSEQUAL { }
-		 | MINUSEQUAL { }
+                 | MINUSEQUAL { }
-		 | SHIFTLEFTEQUAL { }
+                 | SHIFTLEFTEQUAL { }
-		 | SIGNEDSHIFTRIGHTEQUAL { }
+                 | SIGNEDSHIFTRIGHTEQUAL { }
-		 | UNSIGNEDSHIFTRIGHTEQUAL { }
+                 | UNSIGNEDSHIFTRIGHTEQUAL { }
-		 | ANDEQUAL { }
+                 | ANDEQUAL { }
-		 | XOREQUAL { }
+                 | XOREQUAL { }
-		 | OREQUAL{ }
+                 | OREQUAL{ }
 
 preincrementexpression : INCREMENT unaryexpression { }
 
@@ -275,9 +282,9 @@ postincrementexpression : postfixexpression INCREMENT { }
 postdecrementexpression : postfixexpression DECREMENT { }
 
 methodinvocation : name LBRACE   RBRACE  { }
-		 | name LBRACE argumentlist RBRACE { }
+                 | name LBRACE argumentlist RBRACE { }
-		 | primary  DOT IDENTIFIER LBRACE RBRACE  { }
+                 | primary  DOT IDENTIFIER LBRACE RBRACE  { }
-		 | primary  DOT IDENTIFIER LBRACE argumentlist  RBRACE  { }
+                 | primary  DOT IDENTIFIER LBRACE argumentlist  RBRACE  { }
      
 classinstancecreationexpression : NEW classtype LBRACE   RBRACE  { }
                  | NEW classtype LBRACE  argumentlist  RBRACE  { }
@@ -286,75 +293,85 @@ conditionalandexpression : inclusiveorexpression { }
 
 fieldaccess      : primary  DOT IDENTIFIER { }
 
-unaryexpression	 : preincrementexpression { }
+unaryexpression         : preincrementexpression { }
-		 | predecrementexpression { }
+                 | predecrementexpression { }
-		 | PLUS unaryexpression { }
+                 | PLUS unaryexpression { }
-		 | MINUS unaryexpression { }
+                 | MINUS unaryexpression { }
-		 | unaryexpressionnotplusminus { }
+                 | unaryexpressionnotplusminus { }
 
 postfixexpression : primary { }
-		 | name { }
+                 | name { }
-		 | postincrementexpression { }
+                 | postincrementexpression { }
-		 | postdecrementexpression{ }
+                 | postdecrementexpression{ }
 
-primary		 : primarynonewarray { }
+primary                 : primarynonewarray { }
 
 inclusiveorexpression : exclusiveorexpression { }
-		 | inclusiveorexpression OR exclusiveorexpression { }
+                 | inclusiveorexpression OR exclusiveorexpression { }
 
 primarynonewarray : literal { }
-		 | THIS { }
+                 | THIS { }
-		 | LBRACE expression RBRACE  { }
+                 | LBRACE expression RBRACE  { }
                  | classinstancecreationexpression { }
-		 | fieldaccess { }
+                 | fieldaccess { }
-		 | methodinvocation { }
+                 | methodinvocation { }
 
 unaryexpressionnotplusminus : postfixexpression { }
-	         | TILDE unaryexpression { }
+                 | TILDE unaryexpression { }
-		 | EXCLMARK unaryexpression { }
+                 | EXCLMARK unaryexpression { }
-		 | castexpression{ }
+                 | castexpression{ }
 
 exclusiveorexpression : andexpression { }
-		 | exclusiveorexpression XOR andexpression { }
+                 | exclusiveorexpression XOR andexpression { }
 
-literal		 : INTLITERAL { }
+literal          : INTLITERAL { }
-		 | BOOLLITERAL { }
+                 | BOOLLITERAL { }
-		 | CHARLITERAL { }
+                 | CHARLITERAL { }
-		 | STRINGLITERAL { }
+                 | JNULL { }
-		 | JNULL { }
 
-castexpression	 : LBRACE  primitivetype  RBRACE  unaryexpression { }
+castexpression         : LBRACE  primitivetype  RBRACE  unaryexpression { }
- 		 | LBRACE  expression  RBRACE  unaryexpressionnotplusminus{ }
+                  | LBRACE  expression  RBRACE  unaryexpressionnotplusminus{ }
 
 andexpression    : equalityexpression { }
-		 | andexpression AND equalityexpression { }
+                 | andexpression AND equalityexpression { }
 
 equalityexpression : relationalexpression { }
-		 | equalityexpression EQUAL relationalexpression { }
+                 | equalityexpression EQUAL relationalexpression { }
-		 | equalityexpression NOTEQUAL relationalexpression { }
+                 | equalityexpression NOTEQUAL relationalexpression { }
 
 relationalexpression : shiftexpression { }
-		 | relationalexpression LESS shiftexpression { }
+                 | relationalexpression LESS shiftexpression { }
-		 | relationalexpression GREATER shiftexpression { }
+                 | relationalexpression GREATER shiftexpression { }
-		 | relationalexpression LESSEQUAL shiftexpression { }
+                 | relationalexpression LESSEQUAL shiftexpression { }
-		 | relationalexpression GREATEREQUAL shiftexpression { }
+                 | relationalexpression GREATEREQUAL shiftexpression { }
-		 | relationalexpression INSTANCEOF referencetype { }
+                 | relationalexpression INSTANCEOF referencetype { }
 
-shiftexpression	 : additiveexpression { }
+shiftexpression         : additiveexpression { }
 
 additiveexpression : multiplicativeexpression { }
-		 | additiveexpression PLUS multiplicativeexpression { }
+                 | additiveexpression PLUS multiplicativeexpression { }
-		 | additiveexpression MINUS multiplicativeexpression { }
+                 | additiveexpression MINUS multiplicativeexpression { }
 
 multiplicativeexpression : unaryexpression { }
-		 | multiplicativeexpression MUL unaryexpression { }
+                 | multiplicativeexpression MUL unaryexpression { }
-		 | multiplicativeexpression DIV unaryexpression { }
+                 | multiplicativeexpression DIV unaryexpression { }
-		 | multiplicativeexpression MOD unaryexpression { }
+                 | multiplicativeexpression MOD unaryexpression { }
 
 
 {
 
+data MethodOrFieldDeclaration = MethodDecl MethodDeclaration
+                              | FieldDecls [VariableDeclaration]
+
+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
+
 parseError :: [Token] -> a
-parseError _ = error "Parse error"
+parseError msg = error ("Parse error: " ++ show msg)
 
 }

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 }
+    "/*"(.|\n)*"*/" ;
-    "//".* {\s -> Comment s}
+    "//".* ;
-
+    -- 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
+    = ABSTRACT
-    | Different
+    | 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)
 
 }

src/Typecheck.hs

@@ -0,0 +1,334 @@
+module Typecheck where
+import Data.List (find)
+import Data.Maybe
+import Ast
+
+typeCheckCompilationUnit :: CompilationUnit -> CompilationUnit
+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
+        classFields = [(id, dt) | VariableDeclaration dt id _ <- fields]
+        methodEntries = [(methodName, className) | MethodDeclaration _ methodName _ _ <- methods]
+        initalSymTab = ("this", className) : classFields ++ methodEntries
+        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 =
+    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
+        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")
+       then MethodDeclaration retType name params checkedBody
+       else error $ "Return type mismatch in method " ++ name ++ ": expected " ++ retType ++ ", found " ++ bodyType
+
+-- ********************************** Type Checking: Expressions **********************************
+
+typeCheckExpression :: Expression -> [(Identifier, DataType)] -> [Class] -> Expression
+typeCheckExpression (IntegerLiteral i) _ _ = TypedExpression "int" (IntegerLiteral i)
+typeCheckExpression (CharacterLiteral c) _ _ = TypedExpression "char" (CharacterLiteral c)
+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)
+typeCheckExpression (BinaryOperation op expr1 expr2) symtab classes =
+  let expr1' = typeCheckExpression expr1 symtab classes
+      expr2' = typeCheckExpression expr2 symtab classes
+      type1 = getTypeFromExpr expr1'
+      type2 = getTypeFromExpr expr2'
+   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"
+        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 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"
+
+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"
+            then
+              TypedExpression "int" (UnaryOperation op expr')
+            else
+              error "Unary minus operation requires an operand of type int"
+
+typeCheckExpression (StatementExpressionExpression stmtExpr) symtab classes =
+  let stmtExpr' = typeCheckStatementExpression stmtExpr symtab classes
+   in TypedExpression (getTypeFromStmtExpr stmtExpr') (StatementExpressionExpression stmtExpr')
+
+-- ********************************** Type Checking: StatementExpressions **********************************
+
+typeCheckStatementExpression :: StatementExpression -> [(Identifier, DataType)] -> [Class] -> StatementExpression
+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"
+
+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
+      case find (\(MethodDeclaration retType name params _) -> name == className && retType == className) methods of
+        Nothing -> error $ "No valid constructor found for class '" ++ className ++ "'."
+        Just (MethodDeclaration _ _ params _) ->
+          let
+            args' = map (\arg -> typeCheckExpression arg symtab classes) args
+            -- Extract expected parameter types from the constructor's parameters
+            expectedTypes = [dataType | ParameterDeclaration dataType _ <- params]
+            argTypes = map getTypeFromExpr args'
+            -- Check if the types of the provided arguments match the expected types
+            typeMatches = zipWith (\expected actual -> if expected == actual then Nothing else Just (expected, actual)) expectedTypes argTypes
+            mismatchErrors = map (\(exp, act) -> "Expected type '" ++ exp ++ "', found '" ++ act ++ "'.") (catMaybes typeMatches)
+          in
+            if length args /= length params then
+              error $ "Constructor for class '" ++ className ++ "' expects " ++ show (length params) ++ " arguments, but got " ++ show (length args) ++ "."
+            else if not (null mismatchErrors) then
+              error $ unlines $ ("Type mismatch in constructor arguments for class '" ++ className ++ "':") : mismatchErrors
+            else
+              TypedStatementExpression className (ConstructorCall className args')
+
+typeCheckStatementExpression (MethodCall expr methodName args) symtab classes =
+    let objExprTyped = typeCheckExpression expr symtab classes
+    in case objExprTyped of
+        TypedExpression objType _ ->
+            case find (\(Class className _ _) -> className == objType) classes of
+                Just (Class _ methods _) ->
+                    case find (\(MethodDeclaration retType name params _) -> name == methodName) methods of
+                        Just (MethodDeclaration retType _ params _) ->
+                            let args' = map (\arg -> typeCheckExpression arg symtab classes) args
+                                expectedTypes = [dataType | ParameterDeclaration dataType _ <- params]
+                                argTypes = map getTypeFromExpr args'
+                                typeMatches = zipWith (\expType argType -> (expType == argType, expType, argType)) expectedTypes argTypes
+                                mismatches = filter (not . fst3) typeMatches
+                                    where fst3 (a, _, _) = a
+                            in
+                                if null mismatches && length args == length params then
+                                    TypedStatementExpression retType (MethodCall objExprTyped methodName args')
+                                else if not (null mismatches) then
+                                    error $ unlines $ ("Argument type mismatches for method '" ++ methodName ++ "':")
+                                        : [ "Expected: " ++ expType ++ ", Found: " ++ argType | (_, expType, argType) <- mismatches ]
+                                else
+                                    error $ "Incorrect number of arguments for method '" ++ methodName ++ "'. Expected " ++ show (length expectedTypes) ++ ", found " ++ show (length args) ++ "."
+                        Nothing -> error $ "Method '" ++ methodName ++ "' not found in class '" ++ objType ++ "'."
+                Nothing -> error $ "Class for object type '" ++ objType ++ "' not found."
+        _ -> error "Invalid object type for method call. Object must have a class type."
+
+-- ********************************** Type Checking: Statements **********************************
+
+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
+   in if getTypeFromExpr cond' == "boolean"
+        then
+          TypedStatement (getTypeFromStmt thenStmt') (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
+    then error $ "Variable '" ++ identifier ++ "' is redefined in the same scope"
+    else
+        -- If there's an initializer expression, type check it
+        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))
+
+typeCheckStatement (While cond stmt) symtab classes =
+  let cond' = typeCheckExpression cond symtab classes
+      stmt' =  typeCheckStatement stmt symtab classes
+  in if getTypeFromExpr cond' == "boolean"
+       then
+         TypedStatement (getTypeFromStmt stmt') (While cond' stmt')
+       else
+         error "While condition must be of type boolean"
+
+typeCheckStatement (Block statements) symtab classes =
+    let
+        processStatements (accSts, currentSymtab, types) stmt =
+            let
+                checkedStmt = typeCheckStatement stmt currentSymtab classes
+                stmtType = getTypeFromStmt checkedStmt
+            in case stmt of
+                LocalVariableDeclaration (VariableDeclaration dataType identifier maybeExpr) ->
+                    let
+                        checkedExpr = fmap (\expr -> typeCheckExpression expr currentSymtab classes) maybeExpr
+                        newSymtab = (identifier, dataType) : currentSymtab
+                    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)
+                _ -> (accSts ++ [checkedStmt], currentSymtab, types)
+
+        -- 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
+        blockType = if null collectedTypes then "void" else foldl1 unifyReturnTypes collectedTypes
+
+    in TypedStatement blockType (Block checkedStatements)
+
+typeCheckStatement (Return expr) symtab classes =
+  let 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)
+
+typeCheckStatement (StatementExpressionStatement stmtExpr) symtab classes =
+  let stmtExpr' = typeCheckStatementExpression stmtExpr symtab classes
+   in TypedStatement (getTypeFromStmtExpr stmtExpr') (StatementExpressionStatement stmtExpr')
+
+-- ********************************** Type Checking: Helpers **********************************
+
+getTypeFromExpr :: Expression -> DataType
+getTypeFromExpr (TypedExpression t _) = t
+getTypeFromExpr _ = error "Untyped expression found where typed was expected"
+
+getTypeFromStmt :: Statement -> DataType
+getTypeFromStmt (TypedStatement t _) = t
+getTypeFromStmt _ = error "Untyped statement found where typed was expected"
+
+getTypeFromStmtExpr :: StatementExpression -> DataType
+getTypeFromStmtExpr (TypedStatementExpression t _) = t
+getTypeFromStmtExpr _ = error "Untyped statement expression found where typed was expected"
+
+unifyReturnTypes :: DataType -> DataType -> DataType
+unifyReturnTypes dt1 dt2
+    | dt1 == dt2 = dt1
+    | otherwise  = "Object"
+
+lookupType :: Identifier -> [(Identifier, DataType)] -> DataType
+lookupType id symtab =
+  case lookup id symtab of
+    Just t  -> t
+    Nothing -> error ("Identifier " ++ id ++ " not found in symbol table")