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
-        classFileWithAssembledMethods = foldr methodAssembler classFileWithMethods methodsWithInjectedConstructor
+        classFileWithMethods = foldr methodBuilder classFileWithFields methodsWithInjectedInitializers
+        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)
-    --print typedAST
-    let abstractClassFile = classBuilder typedAST emptyClassFile
-    let assembledClassFile = pack (serialize abstractClassFile)
+    -- typecheck AST
+    let typedAST = (typeCheckCompilationUnit untypedAST)
+    -- assemble classes
+    let assembledClasses = map (\(typedClass) -> classBuilder typedClass emptyClassFile) typedAST
 
-    Data.ByteString.writeFile "Testklasse.class" assembledClassFile
+    -- write class files to disk
+    mapM_ (\(classFile) -> let
+            fileContent = pack (serialize classFile)
+            fileName = (className classFile) ++ ".class"
+        in Data.ByteString.writeFile fileName fileContent
+        ) assembledClasses
+
+
+