add: MethodBuilder

Test/TestByteCodeGenerator.hs

@@ -15,11 +15,12 @@ expectedClass = ClassFile {
             Utf8Info "java/lang/Object",
             Utf8Info "<init>",
             Utf8Info "()V",
-            ClassInfo 8,
+            Utf8Info "Code",
+            ClassInfo 9,
             Utf8Info "Testklasse"
         ],
         accessFlags = accessPublic,
-        thisClass = 7,
+        thisClass = 8,
         superClass = 1,
         fields = [],
         methods = [],
@@ -35,21 +36,22 @@ expectedClassWithFields = ClassFile {
             Utf8Info "java/lang/Object",
             Utf8Info "<init>",
             Utf8Info "()V",
-            ClassInfo 8,
+            Utf8Info "Code",
+            ClassInfo 9,
             Utf8Info "Testklasse",
-            FieldRefInfo (fromIntegral 7) (fromIntegral 10),
+            FieldRefInfo 8 11,
-            NameAndTypeInfo (fromIntegral 11) (fromIntegral 12),
+            NameAndTypeInfo 12 13,
             Utf8Info "testvariable",
             Utf8Info "I"
         ],
         accessFlags = accessPublic,
-        thisClass = 7,
+        thisClass = 8,
         superClass = 1,
         fields = [
             MemberInfo {
                 memberAccessFlags = accessPublic,
-                memberNameIndex = 11,
+                memberNameIndex = 12,
-                memberDescriptorIndex = 12,
+                memberDescriptorIndex = 13,
                 memberAttributes = []
             }
         ],
@@ -57,11 +59,58 @@ 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, ByteCode.Operations
+    other-modules:      Ast, Example, Typecheck, ByteCode.ByteUtil, ByteCode.ClassFile, ByteCode.ClassFile.Generator, ByteCode.Constants
 
 test-suite tests
     type:               exitcode-stdio-1.0

src/ByteCode/ClassFile.hs

@@ -3,6 +3,7 @@ module ByteCode.ClassFile(
     Attribute(..),
     MemberInfo(..),
     ClassFile(..),
+    Operation(..),
     serialize,
     emptyClassFile
 ) where
@@ -22,7 +23,30 @@ data ConstantInfo = ClassInfo Word16
                   | Utf8Info [Char]
                   deriving (Show, Eq)
 
-data Attribute = Attribute Word16 [Word8] deriving (Show, Eq)
+
+data Operation = Opiadd
+               | Opisub
+               | Opimul
+               | Opidiv
+               | Opreturn
+               | OpiReturn
+               | 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,
@@ -72,8 +96,36 @@ instance Serializable MemberInfo where
                     ++ 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 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
+
 instance Serializable Attribute where
-    serialize (Attribute nameIndex bytes) = unpackWord16 nameIndex ++ unpackWord32 (fromIntegral (length bytes)) ++ bytes
+    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

src/ByteCode/ClassFile/Generator.hs

@@ -1,22 +1,40 @@
 module ByteCode.ClassFile.Generator(
-    classBuilder
+    classBuilder,
+    datatypeDescriptor,
+    methodParameterDescriptor,
+    methodDescriptor,
 ) where
 
 import ByteCode.Constants
-import ByteCode.ClassFile (ClassFile (..), ConstantInfo (..), MemberInfo(..))
+import ByteCode.ClassFile (ClassFile (..), ConstantInfo (..), MemberInfo(..), Operation(..), Attribute(..))
 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 = x
+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
@@ -26,20 +44,21 @@ classBuilder (Class name methods fields) _ = let
             NameAndTypeInfo 5 6,
             Utf8Info "java/lang/Object",
             Utf8Info "<init>",
-            Utf8Info "()V"
+            Utf8Info "()V",
+            Utf8Info "Code"
             ]
-        nameConstants = [ClassInfo 8, Utf8Info name]
+        nameConstants = [ClassInfo 9, Utf8Info name]
         nakedClassFile = ClassFile {
             constantPool = baseConstants ++ nameConstants,
             accessFlags = accessPublic,
-            thisClass = 7,
+            thisClass = 8,
             superClass = 1,
             fields = [],
             methods = [],
             attributes = []
         }
     in
-        foldr fieldBuilder nakedClassFile fields
+        foldr methodBuilder (foldr fieldBuilder nakedClassFile fields) methods
         
         
 
@@ -62,4 +81,32 @@ fieldBuilder (VariableDeclaration datatype name _) input = let
         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]
         }

src/ByteCode/Operations.hs

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