diff options
Diffstat (limited to 'source')
| -rw-r--r-- | source/mod_student/typechecker.ml | 87 |
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 |