else Assembly

src/ByteCode/ClassFile/Generator.hs

@@ -157,7 +157,7 @@ methodAssembler (MethodDeclaration returntype name parameters statement) input =
         Just index -> let
                 declaration = MethodDeclaration returntype name parameters statement
                 (pre, method : post) = splitAt index (methods input)
-                (_, bytecode) = assembleMethod declaration (constantPool input, [])
+                (_, bytecode) = assembleMethod (constantPool input, []) declaration
                 assembledMethod = method {
                     memberAttributes = [
                         CodeAttribute {
@@ -175,7 +175,7 @@ methodAssembler (MethodDeclaration returntype name parameters statement) input =
 
 
 
-type Assembler a = a -> ([ConstantInfo], [Operation]) -> ([ConstantInfo], [Operation])
+type Assembler a = ([ConstantInfo], [Operation]) -> a -> ([ConstantInfo], [Operation])
 
 returnOperation :: DataType -> Operation
 returnOperation dtype
@@ -201,67 +201,72 @@ comparisonOperation CompareGreaterOrEqual branchLocation = Opif_icmpge branchLoc
 
 
 assembleMethod :: Assembler MethodDeclaration
-assembleMethod (MethodDeclaration _ name _ (TypedStatement _ (Block statements))) (constants, ops)
+assembleMethod (constants, ops) (MethodDeclaration _ name _ (TypedStatement _ (Block statements)))
     | name == "<init>" = let
-            (constants_a, ops_a) = foldr assembleStatement (constants, ops) statements
+            (constants_a, ops_a) = foldl assembleStatement (constants, ops) statements
             init_ops = [Opaload 0, Opinvokespecial 2]
         in
             (constants_a, init_ops ++ ops_a ++ [Opreturn])
     | otherwise = let
-            (constants_a, ops_a) = foldr assembleStatement (constants, ops) statements
+            (constants_a, ops_a) = foldl assembleStatement (constants, ops) statements
             init_ops = [Opaload 0]
         in
             (constants_a, init_ops ++ ops_a)
-assembleMethod (MethodDeclaration _ _ _ stmt) (_, _) = error ("Block expected for method body, got: " ++ show stmt)
+assembleMethod _ (MethodDeclaration _ _ _ stmt) = error ("Block expected for method body, got: " ++ show stmt)
 
 assembleStatement :: Assembler Statement
-assembleStatement (TypedStatement stype (Return expr)) (constants, ops) = case expr of
+assembleStatement (constants, ops) (TypedStatement stype (Return expr)) = case expr of
     Nothing -> (constants, ops ++ [Opreturn])
     Just expr -> let
-            (expr_constants, expr_ops) = assembleExpression expr (constants, ops)
+            (expr_constants, expr_ops) = assembleExpression (constants, ops) expr
         in
             (expr_constants, expr_ops ++ [returnOperation stype])
-assembleStatement (TypedStatement _ (Block statements)) (constants, ops) =
+assembleStatement (constants, ops) (TypedStatement _ (Block statements)) =
-    foldr assembleStatement (constants, ops) statements
+    foldl assembleStatement (constants, ops) statements
-assembleStatement (TypedStatement _ (If expr if_stmt else_stmt)) (constants, ops) = let
+assembleStatement (constants, ops) (TypedStatement _ (If expr if_stmt else_stmt)) = let
-        (constants_cmp, ops_cmp) = assembleExpression expr (constants, [])
+        (constants_cmp, ops_cmp) = assembleExpression (constants, []) expr
-        (constants_ifa, ops_ifa) = assembleStatement if_stmt (constants_cmp, [])
+        (constants_ifa, ops_ifa) = assembleStatement (constants_cmp, []) if_stmt
-        skip_length = sum (map opcodeEncodingLength ops_ifa)
+        (constants_elsea, ops_elsea) = case else_stmt of
+            Nothing -> (constants_ifa, [])
+            Just stmt -> assembleStatement (constants_ifa, []) stmt
+        -- +6 because we insert 2 gotos, one for if, one for else
+        if_length = sum (map opcodeEncodingLength ops_ifa) + 6
+        else_length = sum (map opcodeEncodingLength ops_ifa)
     in
-        (constants_ifa, ops ++ ops_cmp ++ [Opsipush 0, Opif_icmpeq skip_length] ++ ops_ifa)
+        (constants_ifa, ops ++ ops_cmp ++ [Opsipush 0, Opif_icmpeq if_length] ++ ops_ifa ++ [Opgoto else_length] ++ ops_elsea)
-
+assembleStatement stmt _ = error ("Not yet implemented: " ++ show stmt)
 
 assembleExpression :: Assembler Expression
-assembleExpression (TypedExpression _ (BinaryOperation op a b)) (constants, ops)
+assembleExpression (constants, ops) (TypedExpression _ (BinaryOperation op a b))
     | elem op [Addition, Subtraction, Multiplication, Division, BitwiseAnd, BitwiseOr, BitwiseXor] = let
-            (aConstants, aOps) = assembleExpression a (constants, ops)
+            (aConstants, aOps) = assembleExpression (constants, ops) a
-            (bConstants, bOps) = assembleExpression b (aConstants, aOps)
+            (bConstants, bOps) = assembleExpression (aConstants, aOps) b
         in
             (bConstants, bOps ++ [binaryOperation op])
     | elem op [CompareEqual, CompareNotEqual, CompareLessThan, CompareLessOrEqual, CompareGreaterThan, CompareGreaterOrEqual] = let
-            (aConstants, aOps) = assembleExpression a (constants, ops)
+            (aConstants, aOps) = assembleExpression (constants, ops) a
-            (bConstants, bOps) = assembleExpression b (aConstants, aOps)
+            (bConstants, bOps) = assembleExpression (aConstants, aOps) b
             cmp_op = comparisonOperation op 9
             cmp_ops = [cmp_op, Opsipush 0, Opgoto 6, Opsipush 1]
         in
             (bConstants, bOps ++ cmp_ops)
-assembleExpression (TypedExpression _ (CharacterLiteral literal)) (constants, ops) = 
+assembleExpression (constants, ops) (TypedExpression _ (CharacterLiteral literal)) =
     (constants, ops ++ [Opsipush (fromIntegral (ord literal))])
-assembleExpression (TypedExpression _ (BooleanLiteral literal)) (constants, ops) = 
+assembleExpression (constants, ops) (TypedExpression _ (BooleanLiteral literal)) =
     (constants, ops ++ [Opsipush (if literal then 1 else 0)])
-assembleExpression (TypedExpression _ (IntegerLiteral literal)) (constants, ops)
+assembleExpression (constants, ops) (TypedExpression _ (IntegerLiteral literal))
     | literal <= 32767 && literal >= -32768 = (constants, ops ++ [Opsipush (fromIntegral literal)])
     | otherwise = (constants ++ [IntegerInfo (fromIntegral literal)], ops ++ [Opldc_w (fromIntegral (1 + length constants))])
-assembleExpression (TypedExpression _ NullLiteral) (constants, ops) = 
+assembleExpression (constants, ops) (TypedExpression _ NullLiteral) =
     (constants, ops ++ [Opaconst_null])
-assembleExpression (TypedExpression etype (UnaryOperation Not expr)) (constants, ops) = let
+assembleExpression (constants, ops) (TypedExpression etype (UnaryOperation Not expr)) = let
-        (exprConstants, exprOps) = assembleExpression expr (constants, ops)
+        (exprConstants, exprOps) = assembleExpression (constants, ops) expr
         newConstant = fromIntegral (1 + length exprConstants)
     in case etype of
         "int" -> (exprConstants ++ [IntegerInfo 0x7FFFFFFF], exprOps ++ [Opldc_w newConstant, Opixor])
         "char" -> (exprConstants, exprOps ++ [Opsipush 0xFFFF, Opixor])
         "boolean" -> (exprConstants, exprOps ++ [Opsipush 0x01, Opixor])
-assembleExpression (TypedExpression _ (UnaryOperation Minus expr)) (constants, ops) = let
+assembleExpression (constants, ops) (TypedExpression _ (UnaryOperation Minus expr)) = let
-        (exprConstants, exprOps) = assembleExpression expr (constants, ops)
+        (exprConstants, exprOps) = assembleExpression (constants, ops) expr
     in
         (exprConstants, exprOps ++ [Opineg])

src/Parser/JavaParser.y

@@ -184,7 +184,7 @@ referencetype    : classorinterfacetype { $1 }
 variabledeclarator : variabledeclaratorid { Declarator $1 Nothing }
                  | variabledeclaratorid ASSIGN variableinitializer { Declarator $1 (Just $3) }
 
-blockstatement         : localvariabledeclarationstatement { $1 }
+blockstatement         : localvariabledeclarationstatement { $1 } -- expected type statement
                  | statement  { $1 }
 
 formalparameter  : type variabledeclaratorid { ParameterDeclaration $1 $2 }
@@ -200,8 +200,8 @@ variableinitializer  : expression { $1 }
 
 localvariabledeclarationstatement : localvariabledeclaration  SEMICOLON  { $1 }
 
-statement        : statementwithouttrailingsubstatement{ $1 }
+statement        : statementwithouttrailingsubstatement{ $1 }  -- statement returns a list of statements
-                --  | ifthenstatement { }
+                 | ifthenstatement { [$1] }
                 --  | ifthenelsestatement { }
                 --  | whilestatement { }
                                      
@@ -218,7 +218,7 @@ statementwithouttrailingsubstatement : block { [$1] }
                 --  | expressionstatement { }
                  | returnstatement { [$1] }
 
-ifthenstatement  : IF LBRACE expression  RBRACE  statement { }
+ifthenstatement  : IF LBRACE expression  RBRACE  statement { If $3 (Block $5) Nothing }
 
 ifthenelsestatement : IF LBRACE expression  RBRACE statementnoshortif ELSE statement  { }