Test/TestByteCodeGenerator.hs

@@ -39,8 +39,8 @@ expectedClassWithFields = ClassFile {
             Utf8Info "Code",
             ClassInfo 9,
             Utf8Info "Testklasse",
-            FieldRefInfo 8 11,
+            FieldRefInfo (fromIntegral 8) (fromIntegral 11),
-            NameAndTypeInfo 12 13,
+            NameAndTypeInfo (fromIntegral 12) (fromIntegral 13),
             Utf8Info "testvariable",
             Utf8Info "I"
         ],
@@ -59,58 +59,11 @@ expectedClassWithFields = ClassFile {
         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 "Fields constant pool" testFields
-    TestLabel "Method descriptor building" testMethodDescriptor,
-    TestLabel "Method assembly" testMethodAssembly
     ]

project.cabal

@@ -16,7 +16,7 @@ executable compiler
                         src/ByteCode,
                         src/ByteCode/ClassFile
     build-tool-depends: alex:alex, happy:happy
-    other-modules:      Ast, Example, Typecheck, ByteCode.ByteUtil, ByteCode.ClassFile, ByteCode.ClassFile.Generator, ByteCode.Constants
+    other-modules:      Ast, Example, Typecheck, ByteCode.ByteUtil, ByteCode.ClassFile, ByteCode.ClassFile.Generator, ByteCode.Constants, ByteCode.Operations
 
 test-suite tests
     type:               exitcode-stdio-1.0

src/ByteCode/ClassFile.hs

@@ -3,7 +3,6 @@ module ByteCode.ClassFile(
     Attribute(..),
     MemberInfo(..),
     ClassFile(..),
-    Operation(..),
     serialize,
     emptyClassFile
 ) where
@@ -24,20 +23,38 @@ data ConstantInfo = ClassInfo Word16
                   deriving (Show, Eq)
 
 
-data Operation = Opiadd
+{-
-               | Opisub
+    Code_attribute {
-               | Opimul
+    u2 attribute_name_index;
-               | Opidiv
+    u4 attribute_length;
-               | Opreturn
+    u2 max_stack;
-               | OpiReturn
+    u2 max_locals;
-               | Opsipush Word16
+    u4 code_length;
-               | Opldc_w Word16
+    u1 code[code_length];
-               | Opaload Word16
+    u2 exception_table_length;
-               | Opiload Word16
+    {   u2 start_pc;
-               | Opastore Word16
+        u2 end_pc;
-               | Opistore Word16
+        u2 handler_pc;
-               | Opputfield Word16
+        u2 catch_type;
-               | OpgetField Word16
+    } exception_table[exception_table_length];
+    u2 attributes_count;
+    attribute_info attributes[attributes_count];
+-}
+--data Attribute = Attribute Word16 [Word8] deriving (Show, Eq)
+data Operation = Iadd
+               | Isub
+               | Imul
+               | Idiv
+               | Return
+               | IReturn
+               | Sipush Word16
+               | Ldc_w Word16
+               | Aload Word16
+               | Iload Word16
+               | Astore Word16
+               | Istore Word16
+               | Putfield Word16
+               | GetField Word16
     deriving (Show, Eq)
 
 
@@ -97,22 +114,6 @@ instance Serializable MemberInfo where
                     ++ concatMap serialize (memberAttributes member)
 
 instance Serializable Operation where
-<<<<<<< HEAD
-    serialize Opiadd              = [0x60]
-    serialize Opisub              = [0x64]
-    serialize Opimul              = [0x68]
-    serialize Opidiv              = [0x6C]
-    serialize Opreturn            = [0xB1]
-    serialize OpiReturn           = [0xAC]
-    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
-=======
     serialize Iadd              = [0x60]
     serialize Isub              = [0x64]
     serialize Imul              = [0x68]
@@ -127,7 +128,6 @@ instance Serializable Operation where
     serialize (Istore index)    = [0xC4, 0x36] ++ unpackWord16 index
     serialize (Putfield index)  = 0xB5 : unpackWord16 index
     serialize (GetField index)  = 0xB4 : unpackWord16 index
->>>>>>> 8b5650dd6104d1e350128fdcee37502d65824370
 
 instance Serializable Attribute where
     serialize (CodeAttribute { attributeMaxStack = maxStack,

src/ByteCode/ClassFile/Generator.hs

@@ -1,40 +1,22 @@
 module ByteCode.ClassFile.Generator(
-    classBuilder,
+    classBuilder
-    datatypeDescriptor,
-    methodParameterDescriptor,
-    methodDescriptor,
 ) where
 
 import ByteCode.Constants
-import ByteCode.ClassFile (ClassFile (..), ConstantInfo (..), MemberInfo(..), Operation(..), Attribute(..))
+import ByteCode.ClassFile (ClassFile (..), ConstantInfo (..), MemberInfo(..))
 import Ast
+import ByteCode.Operations
 
 
 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
@@ -58,7 +40,7 @@ classBuilder (Class name methods fields) _ = let
             attributes = []
         }
     in
-        foldr methodBuilder (foldr fieldBuilder nakedClassFile fields) methods
+        foldr fieldBuilder nakedClassFile fields
         
         
 
@@ -82,31 +64,3 @@ fieldBuilder (VariableDeclaration datatype name _) input = let
             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]
-        }

src/ByteCode/Operations.hs

@@ -0,0 +1,3 @@
+module ByteCode.Operations where 
+data Operation = Iadd
+            --   |