diff options
| -rw-r--r-- | source/mod_student/typechecker.ml | 44 |
1 files changed, 36 insertions, 8 deletions
diff --git a/source/mod_student/typechecker.ml b/source/mod_student/typechecker.ml index 0d4d76d..ce396d9 100644 --- a/source/mod_student/typechecker.ml +++ b/source/mod_student/typechecker.ml @@ -140,9 +140,27 @@ module Make() = struct | EXPR_Struct {elements=x::xs; _} -> failwith "not yet implemented" - and check_function_call env call = - failwith "not yet implemented" - + and check_function_call env (Call {loc;callee;_} as call)= + match check_function_args env call with + | [] -> ErrorReporter.report_other_error ~loc ~descr:("Procedures don't return expressions") + | [x] ->x + | _ -> ErrorReporter.report_expected_function_returning_one_value ~loc ~id:callee + and check_function_args env (Call {loc;callee;arguments;_}) = + begin + match TypingEnvironment.lookup callee env with + | None -> ErrorReporter.report_unknown_identifier ~loc ~id:callee + | Some ENVTP_Var _ -> ErrorReporter.report_identifier_is_not_callable ~loc ~id:callee + | Some (ENVTP_Fn (arg_types,ret_types)) -> + begin + let rec aux args types = match args,types with + | [],[] -> () + | arg::args, t::ts -> check_expression env t arg;aux args ts + | _,[] -> ErrorReporter.report_bad_number_of_arguments ~loc ~expected:(List.length arg_types) ~actual:(List.length arguments) + | [],_ -> ErrorReporter.report_bad_number_of_arguments ~loc ~expected:(List.length arg_types) ~actual:(List.length arguments) + in aux arguments arg_types; + ret_types + end + end (* --------------------------------------------------- *) (* Odgórna strategia: zapish w node2type_map oczekiwanie a następnie * sprawdź czy nie zachodzi specjalny przypadek. *) @@ -173,8 +191,10 @@ module Make() = struct (* --------------------------------------------------- *) (* Pomocnicza funkcja do sprawdzania wywołania procedury *) - let check_procedure_call env call : unit = - failwith "not yet implemented" + let check_procedure_call env (Call {loc;_} as call) : unit = + match check_function_args env call with + | [] -> () + | _ -> ErrorReporter.report_other_error ~loc ~descr:"Function used as procedure" (* --------------------------------------------------- *) (* Rekonstrukcja typu dla lvalue *) @@ -198,6 +218,7 @@ module Make() = struct env, RT_Unit | STMT_MultiVarDecl {vars; init; _} -> + failwith "not yet implemented" | STMT_Block body -> @@ -208,7 +229,14 @@ module Make() = struct env, RT_Unit | STMT_If {cond;then_branch;else_branch; _} -> - failwith "not yet implemented" + check_expression env TP_Bool cond; + let if_ret = snd(check_statement env then_branch) in + begin + match else_branch with + | None -> env,RT_Unit + | Some else_branch -> let else_ret =snd(check_statement env else_branch) in + env, (if if_ret==RT_Void && else_ret==RT_Void then RT_Void else RT_Unit) + end | STMT_Return {values;loc} -> begin @@ -247,8 +275,8 @@ module Make() = struct | STMT_While {cond; body; _} -> check_expression env TP_Bool cond; - (* TODO *) - failwith "not yet implemented" + let _ = check_statement env body in + env,RT_Unit and check_statement_block env (STMTBlock {body; _}) = let rec aux env = function |