Translate: Basic expressions and statements

1 files changed, 110 insertions, 5 deletions

diff --git a/source/mod_student/translator.ml b/source/mod_student/translator.ml
index 1514319..6831038 100644
--- a/source/mod_student/translator.ml
+++ b/source/mod_student/translator.ml
@@ -114,6 +114,8 @@ module Make() = struct
 
     let i32_0 = Int32.of_int 0
     let i32_1 = Int32.of_int 1
+    let int32_of_bool b = Int32.of_int (
+                            if b then 1 else 0 )
 
     (* --------------------------------------------------- *)
     let rec translate_expression env current_bb = function
@@ -121,8 +123,74 @@ module Make() = struct
         current_bb, E_Int (Int32.of_int @@ Char.code value)
 
       | Ast.EXPR_Id {id; _} ->
+         
         current_bb, E_Reg (Environment.lookup_var id env)
-
+      | Ast.EXPR_Int {value;_} ->
+         current_bb, E_Int value
+
+      | Ast.EXPR_Bool {value; _} ->
+         current_bb, E_Int (int32_of_bool value)
+
+      | Ast.EXPR_Binop {lhs;rhs;op=Ast.BINOP_Add;tag;_} ->
+         let reg= allocate_register() in
+         let current_bb,lhs = translate_expression env current_bb lhs in
+         let current_bb,rhs = translate_expression env current_bb rhs in
+         begin
+           match Hashtbl.find node2type tag with
+           | TP_Int -> append_instruction current_bb @@ I_Add ( reg, lhs, rhs)
+           | TP_Array _ -> append_instruction current_bb @@ I_Concat ( reg, lhs, rhs)
+           | TP_Bool -> failwith "Internal error"
+         end;
+         current_bb, E_Reg reg
+
+      | Ast.EXPR_Binop {lhs;rhs;op=Ast.BINOP_Sub;_} ->
+         let reg= allocate_register() in
+         let current_bb,lhs = translate_expression env current_bb lhs in
+         let current_bb,rhs = translate_expression env current_bb rhs in
+         append_instruction current_bb @@ I_Sub ( reg, lhs, rhs);
+         current_bb, E_Reg reg
+
+      | Ast.EXPR_Binop {lhs;rhs;op=Ast.BINOP_Mult;_} ->
+         let reg= allocate_register() in
+         let current_bb,lhs = translate_expression env current_bb lhs in
+         let current_bb,rhs = translate_expression env current_bb rhs in
+         append_instruction current_bb @@ I_Mul ( reg, lhs, rhs);
+         current_bb, E_Reg reg
+
+      | Ast.EXPR_Binop {lhs;rhs;op=Ast.BINOP_Div;_} ->
+         let reg= allocate_register() in
+         let current_bb,lhs = translate_expression env current_bb lhs in
+         let current_bb,rhs = translate_expression env current_bb rhs in
+         append_instruction current_bb @@ I_Div ( reg, lhs, rhs);
+         current_bb, E_Reg reg
+
+      | Ast.EXPR_Binop {lhs;rhs;op=Ast.BINOP_Rem;_} ->
+         let reg= allocate_register() in
+         let current_bb,lhs = translate_expression env current_bb lhs in
+         let current_bb,rhs = translate_expression env current_bb rhs in
+         append_instruction current_bb @@ I_Rem ( reg, lhs, rhs);
+         current_bb, E_Reg reg
+      | Ast.EXPR_Call call ->
+         let reg =allocate_register() in
+         let current_bb,env = translate_call env current_bb call [reg] in
+         current_bb, E_Reg reg
+      | Ast.EXPR_Relation {op;lhs;rhs;_} ->
+         begin
+         let convert_rel = function
+           | Ast.RELOP_Eq -> COND_Eq
+           | Ast.RELOP_Ne -> COND_Ne
+           | Ast.RELOP_Lt -> COND_Lt
+           | Ast.RELOP_Gt -> COND_Gt
+           | Ast.RELOP_Le -> COND_Le
+           | Ast.RELOP_Ge -> COND_Ge
+         in
+         let reg = allocate_register() in
+         let current_bb,lhs = translate_expression env current_bb lhs in
+         let current_bb,rhs = translate_expression env current_bb rhs in
+         append_instruction current_bb @@ I_Set(reg,convert_rel op,lhs,rhs);
+         current_bb, E_Reg reg
+      
+         end
       | _ ->
         failwith "not yet implemented"
 
@@ -134,9 +202,9 @@ module Make() = struct
       | Ast.EXPR_Bool {value=false; _} ->
         set_jump current_bb else_bb;
         allocate_block ()
-
+      
       (* Zaimplementuj dodatkowe przypadki *)
-
+      
       | e ->
         let current_bb, res = translate_expression env current_bb e in
         let next_bb = allocate_block () in 
@@ -145,14 +213,51 @@ module Make() = struct
 
 
     (* --------------------------------------------------- *)
-
+    and translate_call env current_bb (Ast.Call {callee;arguments;tag;_}) returns =
+      begin
+           let rec aux current_bb = function
+             | [] -> []
+             | x::xs -> let current_bb,r =
+                          translate_expression env current_bb x
+                        in r::(aux current_bb xs)
+           in
+           let arguments = aux current_bb arguments in
+           append_instruction current_bb @@ I_Call ( returns, Environment.lookup_proc callee env, arguments, []);
+           current_bb,env
+      end
     let rec translate_statement env current_bb = function
+      | Ast.STMT_Return {values;_} ->
+         begin
+           let rec aux current_bb = function
+             | [] -> []
+             | x::xs -> let current_bb,r =
+                          translate_expression env current_bb x
+                        in r::(aux current_bb xs)
+           in
+           set_return current_bb (aux current_bb values);
+           current_bb,env
+         end
+      | STMT_Assign {lhs=Ast.LVALUE_Id{id;_};rhs;_} ->
+         let current_bb, reg = translate_expression env current_bb rhs in
+         let my_reg = allocate_register() in
+         append_instruction current_bb @@ I_Move (my_reg, reg);
+         current_bb, (Environment.add_var id my_reg env)           
+      | STMT_Call call ->
+          translate_call env current_bb call []
       | _ ->
         failwith "not yet implemented"
 
 
     and translate_block env current_bb (Ast.STMTBlock {body; _}) =
-      failwith "not yet implemented"
+      begin
+           let rec aux env current_bb = function
+             | [] -> env,current_bb
+             | x::xs -> let current_bb,env =
+                          translate_statement env current_bb x
+                        in aux env current_bb xs
+             in aux env current_bb body
+      end
+      
 
     let bind_var_declaration env vardecl =
       let r = allocate_register () in