injecting initializers into all constructors, multiple classes per file supported

src/ByteCode/ClassFile.hs

@@ -6,7 +6,8 @@ module ByteCode.ClassFile(
     Operation(..),
     serialize,
     emptyClassFile,
-    opcodeEncodingLength
+    opcodeEncodingLength,
+    className
 ) where
 
 import Data.Word
@@ -96,6 +97,14 @@ emptyClassFile = ClassFile {
         attributes = []
     }
 
+className :: ClassFile -> String
+className classFile = let
+        classInfo = (constantPool classFile)!!(fromIntegral (thisClass classFile))
+    in case classInfo of
+        Utf8Info className -> className
+        otherwise -> error ("expected Utf8Info but got: " ++ show otherwise)
+        
+
 opcodeEncodingLength :: Operation -> Word16
 opcodeEncodingLength Opiadd                 = 1
 opcodeEncodingLength Opisub                 = 1

src/ByteCode/Generator.hs

@@ -16,6 +16,7 @@ import Ast
 import Data.Char
 import Data.List
 import Data.Word
+import Data.Maybe (mapMaybe)
 
 type ClassFileBuilder a = a -> ClassFile -> ClassFile
 type Assembler a = ([ConstantInfo], [Operation], [String]) -> a -> ([ConstantInfo], [Operation], [String])
@@ -308,6 +309,28 @@ injectDefaultConstructor pre
     | any (\(MethodDeclaration _ name _ _) -> name == "<init>") pre = pre
     | otherwise = pre ++ [MethodDeclaration "void" "<init>" [] (TypedStatement "void" (Block []))]
 
+injectFieldInitializers :: String -> [VariableDeclaration] -> [MethodDeclaration] -> [MethodDeclaration]
+injectFieldInitializers classname vars pre = let 
+        initializers = mapMaybe (\(variable) -> case variable of
+                VariableDeclaration dtype name (Just initializer) -> Just (
+                        TypedStatement dtype (
+                            StatementExpressionStatement (
+                                TypedStatementExpression dtype (
+                                    Assignment
+                                        (TypedExpression dtype (BinaryOperation NameResolution (TypedExpression classname (LocalVariable "this")) (TypedExpression dtype (FieldVariable name))))
+                                        initializer
+                                    )
+                                )
+                            )
+                        )
+                otherwise -> Nothing
+            ) vars
+    in
+        map (\(method) -> case method of
+                MethodDeclaration "void" "<init>" params (TypedStatement "void" (Block statements)) -> MethodDeclaration "void" "<init>" params (TypedStatement "void" (Block (initializers ++ statements)))
+                otherwise -> method
+            ) pre
+
 
 classBuilder :: ClassFileBuilder Class
 classBuilder (Class name methods fields) _ = let
@@ -332,10 +355,11 @@ classBuilder (Class name methods fields) _ = let
         }
 
         methodsWithInjectedConstructor = injectDefaultConstructor methods
+        methodsWithInjectedInitializers = injectFieldInitializers name fields methodsWithInjectedConstructor
 
         classFileWithFields = foldr fieldBuilder nakedClassFile fields
-        classFileWithMethods = foldr methodBuilder classFileWithFields methodsWithInjectedConstructor
+        classFileWithMethods = foldr methodBuilder classFileWithFields methodsWithInjectedInitializers
-        classFileWithAssembledMethods = foldr methodAssembler classFileWithMethods methodsWithInjectedConstructor
+        classFileWithAssembledMethods = foldr methodAssembler classFileWithMethods methodsWithInjectedInitializers
     in
         classFileWithAssembledMethods
 

src/Main.hs

@@ -9,12 +9,22 @@ import ByteCode.ClassFile
 import Data.ByteString (pack, writeFile)
 
 main = do
+    -- read source code from disk
     file <- readFile "Testklasse.java"
 
+    -- parse source code
     let untypedAST = parse $ alexScanTokens file
-    let typedAST = head (typeCheckCompilationUnit untypedAST)
+    -- typecheck AST
-    --print typedAST
+    let typedAST = (typeCheckCompilationUnit untypedAST)
-    let abstractClassFile = classBuilder typedAST emptyClassFile
+    -- assemble classes
-    let assembledClassFile = pack (serialize abstractClassFile)
+    let assembledClasses = map (\(typedClass) -> classBuilder typedClass emptyClassFile) typedAST
+
+    -- write class files to disk
+    mapM_ (\(classFile) -> let
+            fileContent = pack (serialize classFile)
+            fileName = (className classFile) ++ ".class"
+        in Data.ByteString.writeFile fileName fileContent
+        ) assembledClasses
+
+
     
-    Data.ByteString.writeFile "Testklasse.class" assembledClassFile

src/Typecheck.hs

@@ -2,7 +2,6 @@ module Typecheck where
 import Data.List (find)
 import Data.Maybe
 import Ast
-import Debug.Trace (trace)
 
 typeCheckCompilationUnit :: CompilationUnit -> CompilationUnit
 typeCheckCompilationUnit classes = map (`typeCheckClass` classes) classes
@@ -10,13 +9,12 @@ typeCheckCompilationUnit classes = map (`typeCheckClass` classes) classes
 typeCheckClass :: Class -> [Class] -> Class
 typeCheckClass (Class className methods fields) classes =
     let
-        -- Fields dont need to be added to the symtab because they are looked upon automatically under this if its not a declared local variable
+        -- Fields and methods dont need to be added to the symtab because they are looked upon automatically under "this" 
-        -- TODO: Maybe remove method entries from the symbol table? I dont think we need them but if yes the next line would be
+        -- if its not a declared local variable. Also shadowing wouldnt be possible then.
-        -- initalSymTab = ("this", className) : methodEntries
-        -- methodEntries = [(methodName, className) | MethodDeclaration _ methodName _ _ <- methods]
         initalSymTab = [("this", className)]
         checkedMethods = map (\method -> typeCheckMethodDeclaration method initalSymTab classes) methods
-    in Class className checkedMethods fields
+        checkedFields = map (\field -> typeCheckVariableDeclaration field initalSymTab classes) fields
+    in Class className checkedMethods checkedFields
 
 typeCheckMethodDeclaration :: MethodDeclaration -> [(Identifier, DataType)] -> [Class] -> MethodDeclaration
 typeCheckMethodDeclaration (MethodDeclaration retType name params body) symtab classes =
@@ -29,8 +27,24 @@ typeCheckMethodDeclaration (MethodDeclaration retType name params body) symtab c
        then MethodDeclaration retType name params checkedBody
        else error $ "Method Declaration: Return type mismatch in method " ++ name ++ ": expected " ++ retType ++ ", found " ++ bodyType
 
--- TODO: It could be that TypeCheckVariableDeclaration is missing. If it comes up -> just check wether the type is correct. The maybe expression needs to be
+typeCheckVariableDeclaration :: VariableDeclaration -> [(Identifier, DataType)] -> [Class] -> VariableDeclaration
--- checked as well. Also if its a class type, check wether the class exists.
+typeCheckVariableDeclaration (VariableDeclaration dataType identifier maybeExpr) symtab classes =
+    let
+        -- Ensure the type is valid (either a primitive type or a valid class name)
+        validType = dataType `elem` ["int", "boolean", "char"] || isUserDefinedClass dataType classes
+        -- Ensure no redefinition in the same scope
+        redefined = any ((== identifier) . snd) symtab
+        -- Type check the initializer expression if it exists
+        checkedExpr = fmap (\expr -> typeCheckExpression expr symtab classes) maybeExpr
+        exprType = fmap getTypeFromExpr checkedExpr
+    in case (validType, redefined, exprType) of
+        (False, _, _) -> error $ "Type '" ++ dataType ++ "' is not a valid type for variable '" ++ identifier ++ "'"
+        (_, True, _) -> error $ "Variable '" ++ identifier ++ "' is redefined in the same scope"
+        (_, _, Just t)
+            | t == "null" && isObjectType dataType -> VariableDeclaration dataType identifier checkedExpr
+            | t /= dataType -> error $ "Type mismatch in declaration of '" ++ identifier ++ "': expected " ++ dataType ++ ", found " ++ t
+            | otherwise -> VariableDeclaration dataType identifier checkedExpr
+        (_, _, Nothing) -> VariableDeclaration dataType identifier checkedExpr
 
 -- ********************************** Type Checking: Expressions **********************************