Test/TestByteCodeGenerator.hs

@@ -107,10 +107,12 @@ testBasicConstantPool = TestCase $ assertEqual "basic constant pool" expectedCla
 testFields = TestCase $ assertEqual "fields in constant pool" expectedClassWithFields $ classBuilder classWithFields emptyClassFile
 testMethodDescriptor = TestCase $ assertEqual "method descriptor" "(II)I" (methodDescriptor method)
 testMethodAssembly = TestCase $ assertEqual "method assembly" expectedClassWithMethod (classBuilder classWithMethod emptyClassFile)
+testFindMethodIndex = TestCase $ assertEqual "find method" (Just 0) (findMethodIndex expectedClassWithMethod "add_two_numbers")
 
 tests = TestList [
     TestLabel "Basic constant pool" testBasicConstantPool,
     TestLabel "Fields constant pool" testFields,
     TestLabel "Method descriptor building" testMethodDescriptor,
-    TestLabel "Method assembly" testMethodAssembly
+    TestLabel "Method assembly" testMethodAssembly,
+    TestLabel "Find method by name" testFindMethodIndex
     ]

src/ByteCode/ClassFile.hs

@@ -151,7 +151,7 @@ instance Serializable Attribute where
             ++ unpackWord16 0                                               -- attributes_count
 
 instance Serializable ClassFile where
-    serialize classfile  = unpackWord32 0xC0FEBABE                                           -- magic
+    serialize classfile  = unpackWord32 0xCAFEBABE                                           -- magic
                         ++ unpackWord16 0                                                    -- minor version
                         ++ unpackWord16 49                                                   -- major version
                         ++ unpackWord16 (fromIntegral (1 + length (constantPool classfile))) -- constant pool count

src/ByteCode/ClassFile/Generator.hs

@@ -3,12 +3,17 @@ module ByteCode.ClassFile.Generator(
     datatypeDescriptor,
     methodParameterDescriptor,
     methodDescriptor,
+    memberInfoIsMethod,
+    memberInfoName,
+    memberInfoDescriptor,
+    findMethodIndex
 ) where
 
 import ByteCode.Constants
 import ByteCode.ClassFile (ClassFile (..), ConstantInfo (..), MemberInfo(..), Operation(..), Attribute(..))
 import Ast
 import Data.Char
+import Data.List
 
 
 type ClassFileBuilder a = a -> ClassFile -> ClassFile
@@ -28,6 +33,39 @@ methodParameterDescriptor "char" = "C"
 methodParameterDescriptor "boolean" = "B"
 methodParameterDescriptor x = "L" ++ x ++ ";"
 
+memberInfoIsMethod :: [ConstantInfo] -> MemberInfo -> Bool
+memberInfoIsMethod constants info = elem '(' (memberInfoDescriptor constants info)
+
+findMethodIndex :: ClassFile -> String -> Maybe Int
+findMethodIndex classFile name = let
+        constants = constantPool classFile
+    in
+        findIndex (\method -> ((memberInfoIsMethod constants method) && (memberInfoName constants method) == name)) (methods classFile)
+
+memberInfoDescriptor :: [ConstantInfo] -> MemberInfo -> String
+memberInfoDescriptor constants MemberInfo {
+    memberAccessFlags = _,
+    memberNameIndex = _,
+    memberDescriptorIndex = descriptorIndex,
+    memberAttributes = _ } = let
+            descriptor = constants!!((fromIntegral descriptorIndex) - 1)
+        in case descriptor of
+            Utf8Info descriptorText -> descriptorText
+            _ -> ("Invalid Item at Constant pool index " ++ show descriptorIndex) 
+
+
+memberInfoName :: [ConstantInfo] -> MemberInfo -> String
+memberInfoName constants MemberInfo {
+    memberAccessFlags = _,
+    memberNameIndex = nameIndex,
+    memberDescriptorIndex = _,
+    memberAttributes = _ } = let
+            name = constants!!((fromIntegral nameIndex) - 1)
+        in case name of
+            Utf8Info nameText -> nameText
+            _ -> ("Invalid Item at Constant pool index " ++ show nameIndex) 
+
+
 methodDescriptor :: MethodDeclaration -> String
 methodDescriptor (MethodDeclaration returntype _ parameters _) = let 
         parameter_types = [datatype | ParameterDeclaration datatype _ <- parameters]
@@ -37,6 +75,7 @@ methodDescriptor (MethodDeclaration returntype _ parameters _) = let
         ++ ")"
         ++ datatypeDescriptor returntype
 
+
 classBuilder :: ClassFileBuilder Class
 classBuilder (Class name methods fields) _ = let
         baseConstants = [
@@ -58,8 +97,12 @@ classBuilder (Class name methods fields) _ = let
             methods = [],
             attributes = []
         }
+
+        classFileWithFields = foldr fieldBuilder nakedClassFile fields
+        classFileWithMethods = foldr methodBuilder classFileWithFields methods
+        classFileWithAssembledMethods = foldr methodAssembler classFileWithMethods methods
     in
-        foldr methodBuilder (foldr fieldBuilder nakedClassFile fields) methods
+        classFileWithAssembledMethods
         
         
 
@@ -88,30 +131,43 @@ methodBuilder :: ClassFileBuilder MethodDeclaration
 methodBuilder (MethodDeclaration returntype name parameters statement) input = let
         baseIndex = 1 + length (constantPool input)
         constants = [
-                FieldRefInfo (fromIntegral (thisClass input)) (fromIntegral (baseIndex + 1)),
-                NameAndTypeInfo (fromIntegral (baseIndex + 2)) (fromIntegral (baseIndex + 3)),
                 Utf8Info name,
                 Utf8Info (methodDescriptor (MethodDeclaration returntype name parameters (Block [])))
             ]
-        --code = assembleByteCode statement
+            
         method = MemberInfo {
             memberAccessFlags = accessPublic,
-            memberNameIndex = (fromIntegral (baseIndex + 2)),
+            memberNameIndex = (fromIntegral baseIndex),
-            memberDescriptorIndex = (fromIntegral (baseIndex + 3)),
+            memberDescriptorIndex = (fromIntegral (baseIndex + 1)),
             memberAttributes = [
                    CodeAttribute {
                         attributeMaxStack = 420,
                         attributeMaxLocals = 420,
-                        attributeCode = [Opiadd]
+                        attributeCode = [Opreturn]
                     }
                 ]
             }
     in
         input {
             constantPool = (constantPool input) ++ constants,
-            methods = (fields input) ++ [method]
+            methods = (methods input) ++ [method]
         }
 
+
+methodAssembler :: ClassFileBuilder MethodDeclaration
+methodAssembler (MethodDeclaration returntype name parameters statement) input = let
+        code = CodeAttribute {
+            attributeMaxStack = 420,
+            attributeMaxLocals = 420,
+            attributeCode = [Opiadd]
+        }
+        --methodConstantIndex = 
+    in
+        input
+        
+
+
+
 type Assembler a = a -> ([ConstantInfo], [Operation]) -> ([ConstantInfo], [Operation])
 
 returnOperation :: DataType -> Operation

src/Main.hs

@@ -2,7 +2,16 @@ module Main where
 
 import Example
 import Typecheck
+import Parser.Lexer (alexScanTokens)
+import Parser.JavaParser
+import ByteCode.ClassFile.Generator
+import ByteCode.ClassFile
+import Data.ByteString (pack, writeFile)
 
 main = do
-    Example.runTypeCheck
+    let untypedAST = parse $ alexScanTokens "class Testklasse {int a; int b; void something(){} void something_else(){} Testklasse(){}}"
+    let typedAST = head (typeCheckCompilationUnit untypedAST)
+    let abstractClassFile = classBuilder typedAST emptyClassFile
+    let assembledClassFile = pack (serialize abstractClassFile)
 
+    Data.ByteString.writeFile "Testklasse.class" assembledClassFile