Various improvements for arrays

1 files changed, 22 insertions, 12 deletions

diff --git a/source/mod_student/typechecker.ml b/source/mod_student/typechecker.ml
index eb5c2a4..95e9157 100644
--- a/source/mod_student/typechecker.ml
+++ b/source/mod_student/typechecker.ml
@@ -23,19 +23,11 @@ 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 rec te2type_ret = function
       | TEXPR_Int _ -> TP_Int
       | TEXPR_Bool _ -> TP_Bool
       | TEXPR_Array {sub;dim=None;_} -> TP_Array (te2type_ret sub)
       | TEXPR_Array {sub;dim;loc} -> ErrorReporter.report_array_initialization_forbidden ~loc
-    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 =
@@ -168,6 +160,22 @@ module Make() = struct
           ret_types
         end
       end
+    and te2base env = begin function
+        | TEXPR_Int _ -> TP_Int
+        | TEXPR_Bool _ -> TP_Bool
+        | TEXPR_Array {sub;dim=None;loc} -> ErrorReporter.report_array_initialization_forbidden ~loc
+        | TEXPR_Array {sub;dim=Some x;_} -> check_expression env TP_Int x;TP_Array (te2base env sub)
+      end
+    and te2type_decl env = begin function
+        | TEXPR_Int _ -> TP_Int
+        | TEXPR_Bool _ -> TP_Bool
+        | TEXPR_Array {sub;dim=None;_} -> TP_Array (te2type_decl env sub)
+        | TEXPR_Array {sub;dim=Some x;_} -> check_expression env TP_Int x;TP_Array (te2base env sub)
+      end
+    and add_var_decl env (VarDecl {loc;id;tp}) = 
+        match TypingEnvironment.add id (ENVTP_Var (te2type_decl env tp)) env with
+        | (env,true) -> env
+        | (env,false) -> ErrorReporter.report_shadows_previous_definition ~loc ~id
     (* --------------------------------------------------- *)
     (* Odgórna strategia: zapish w node2type_map oczekiwanie a następnie
      * sprawdź czy nie zachodzi specjalny przypadek. *)
@@ -189,7 +197,9 @@ module Make() = struct
       | EXPR_Binop {op=BINOP_And; lhs; rhs;_}, (TP_Array tp as t) ->
         check_expression env t lhs;
         check_expression env t rhs
-
+      | EXPR_Index {expr;index;loc; _}, tp ->
+        check_expression env  TP_Int index;
+        check_expression env (TP_Array tp) expr
       (* ========== !! Zaimplementuj pozostale przypadki !! =========  *)
 
       (* Fallback do strategii oddolnej *)
@@ -253,7 +263,7 @@ module Make() = struct
               | []          , []       -> bindings
               | None::vars  , t::types -> aux vars types bindings
               | (Some (VarDecl{tp;loc;id} as v) )::vars, t::types ->
-                let expected =te2type tp in
+                let expected =te2type_decl env tp in
                 if expected==t then aux vars types (v::bindings)
                 else ErrorReporter.report_binding_type_mismatch ~loc ~expected ~id ~actual:t
               | _ -> failwith "Should not happen"
@@ -304,7 +314,7 @@ module Make() = struct
         begin
         match var with 
         | VarDecl {tp;_} ->
-          let t=te2type (tp) in
+          let t=te2type_decl env tp in
             begin
               match init with
               | Some init -> check_expression env t init
@@ -339,7 +349,7 @@ module Make() = struct
         match body with
         | Some body -> begin
                       match check_statement_block  (TypingEnvironment.set_return env (List.map te2type_ret return_types)) body with
-                        | _, RT_Unit -> ErrorReporter.report_not_all_control_paths_return_value ~loc ~id
+                        | _, RT_Unit -> if return_types!=[] then ErrorReporter.report_not_all_control_paths_return_value ~loc ~id else ()
                         | _, RT_Void -> ()
                         end
         | None -> ()