diff options
| -rw-r--r-- | source/mod_student/typechecker.ml | 34 |
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 -> () |