summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorPaweł Dybiec <pdybiec@stud.cs.uni.wroc.pl>2018-11-25 02:47:34 +0100
committerPaweł Dybiec <pdybiec@stud.cs.uni.wroc.pl>2018-11-25 02:47:34 +0100
commitaf7ed8a78a3e8d10a86832af633d4bca376a470c (patch)
tree653e4e1ef647dc020eb41fabab4e5f598c3d5684
parent5fb0e62352450476fffd710e33f1b55e28ba63b2 (diff)
Types for function calls
-rw-r--r--source/mod_student/typechecker.ml44
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