Type checking for global definitions and basic types and operands

1 files changed, 70 insertions, 17 deletions

diff --git a/source/mod_student/typechecker.ml b/source/mod_student/typechecker.ml
index 800fecf..109d22f 100644
--- a/source/mod_student/typechecker.ml
+++ b/source/mod_student/typechecker.ml
@@ -23,6 +23,14 @@ module Make() = struct
      *)
     let node2type_map = Hashtbl.create 513
 
+    let rec te2type = function
+      | TEXPR_Int _ -> TP_Int
+      | TEXPR_Bool _ -> TP_Bool
+      | TEXPR_Array {sub;_} -> TP_Array (te2type sub)
+    let add_var_decl env (VarDecl {loc;id;tp}) = 
+        match TypingEnvironment.add id (ENVTP_Var (te2type tp)) env with
+        | (env,true) -> env
+        | (env,false) -> ErrorReporter.report_shadows_previous_definition ~loc ~id
     (* --------------------------------------------------- *)
     (* Funkcja nakładka na inferencję, jej zadanie to uzupełniać hashtablicę node2type_map *)
     let rec infer_expression env e =
@@ -38,35 +46,56 @@ module Make() = struct
     (* Oddolna strategia *)
     and _infer_expression env = function
       | EXPR_Id {id; loc; _} ->
-        failwith "Not yet implemented"
+        begin
+          match TypingEnvironment.lookup id env with
+          | None -> ErrorReporter.report_unknown_identifier ~loc ~id
+          | Some tp -> match tp with
+                       | ENVTP_Var tp -> tp
+                       | ENVTP_Fn (_,_) -> ErrorReporter.report_identifier_is_not_variable ~loc ~id
+        end
 
       | EXPR_Int _ ->
         TP_Int
 
       | EXPR_Char _ ->
-        failwith "Not yet implemented"
+        TP_Int
 
       | EXPR_Bool _ ->
-        failwith "Not yet implemented"
+        TP_Bool
 
       | EXPR_Index {expr;index;loc; _} ->
-        failwith "Not yet implemented"
-
+        check_expression env  TP_Int index;
+        begin
+          match  infer_expression env expr with
+          | (TP_Array _) as tp -> tp
+          | TP_Int   -> ErrorReporter.report_expected_array ~loc ~actual:TP_Int
+          | TP_Bool  -> ErrorReporter.report_expected_array ~loc ~actual:TP_Bool
+        end
       | EXPR_Call call ->
         check_function_call env call
 
       | EXPR_Length {arg;loc;_} ->
-        failwith "Not yet implemented"
+        begin
+          match infer_expression env arg with
+          | TP_Array _ -> TP_Int
+          | TP_Int   -> ErrorReporter.report_expected_array ~loc ~actual:TP_Int
+          | TP_Bool  -> ErrorReporter.report_expected_array ~loc ~actual:TP_Bool
+        end
 
       | EXPR_Relation {lhs; rhs; op=RELOP_Ge; _} 
       | EXPR_Relation {lhs; rhs; op=RELOP_Gt; _} 
       | EXPR_Relation {lhs; rhs; op=RELOP_Lt; _} 
       | EXPR_Relation {lhs; rhs; op=RELOP_Le; _}  ->
-        failwith "Not yet implemented"
+        check_expression env TP_Int lhs;
+        check_expression env TP_Int rhs;
+        TP_Bool
 
       | EXPR_Relation {lhs; rhs; op=RELOP_Eq; _} 
       | EXPR_Relation {lhs; rhs; op=RELOP_Ne; _} ->
-        failwith "Not yet implemented"
+        let tp = infer_expression env lhs in
+        check_expression env tp rhs;
+        TP_Bool
+        (* Consider backtracking *)
 
         (* Reguła dla dodawania, jak w treści zadania *)
       | EXPR_Binop {loc; lhs; rhs; op=BINOP_Add; _} ->
@@ -82,22 +111,28 @@ module Make() = struct
 
       | EXPR_Binop {lhs; rhs; op=BINOP_And;_} 
       | EXPR_Binop {lhs; rhs; op=BINOP_Or; _} ->
-        failwith "not yet implemented"
+        check_expression env TP_Bool lhs;
+        check_expression env TP_Bool rhs;
+        TP_Bool
 
       | EXPR_Binop {lhs; rhs; op=BINOP_Sub;_} 
       | EXPR_Binop {lhs; rhs; op=BINOP_Rem;_} 
       | EXPR_Binop {lhs; rhs; op=BINOP_Mult;_} 
       | EXPR_Binop {lhs; rhs; op=BINOP_Div; _} ->
-        failwith "not yet implemented"
+        check_expression env TP_Int lhs;
+        check_expression env TP_Int rhs;
+        TP_Int
 
       | EXPR_Unop {op=UNOP_Neg; sub; _} ->
-        failwith "not yet implemented"
+        check_expression env TP_Int sub;
+        TP_Int
 
       | EXPR_Unop {op=UNOP_Not; sub; _} ->
-        failwith "not yet implemented"
+        check_expression env TP_Bool sub;
+        TP_Bool
 
       | EXPR_String _ ->
-        failwith "not yet implemented"
+        TP_Array TP_Int
 
       | EXPR_Struct {elements=[]; loc; _} ->
         ErrorReporter.report_cannot_infer ~loc
@@ -179,7 +214,17 @@ module Make() = struct
         failwith "not yet implemented"
 
       | STMT_VarDecl {var; init} ->
-        failwith "not yet implemented"
+        begin
+        match var with 
+        | VarDecl {tp;_} ->
+          let t=te2type (tp) in
+            begin
+              match init with
+              | Some init -> check_expression env t init
+              | None -> ()
+            end;
+          (add_var_decl env var),RT_Unit
+        end
 
       | STMT_While {cond; body; _} ->
         failwith "not yet implemented"
@@ -193,12 +238,20 @@ module Make() = struct
     let check_global_declaration env = function
       | GDECL_Function {formal_parameters; return_types; body; loc; id; _} ->
         (* Sprawdź wszystko *)
-        failwith "not yet implemented"
+        let env = List.fold_left add_var_decl env formal_parameters in
+        match body with
+        | Some body -> begin
+                      match check_statement_block  (TypingEnvironment.set_return env (List.map te2type return_types)) body with
+                        | _, RT_Unit -> ErrorReporter.report_not_all_control_paths_return_value ~loc ~id
+                        | _, RT_Void -> ()
+                        end
+        | None -> ()
 
     let scan_global_declaration env = function
       | GDECL_Function {id; formal_parameters; return_types; loc; _} ->
-        (* Dodaj idenetyfkator funkcji i jej typ do środowiska *)
-        failwith "not yet implemented"
+         match TypingEnvironment.add id (ENVTP_Fn ((List.map (fun (VarDecl x) -> te2type(x.tp)) formal_parameters),(List.map te2type return_types)) ) env with
+        | (env,true)  -> env
+        | (env,false) -> ErrorReporter.report_shadows_previous_definition ~loc ~id
 
     let scan_module env (ModuleDefinition {global_declarations; _}) =
       List.fold_left scan_global_declaration env global_declarations