summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorPaweł Dybiec <pdybiec@stud.cs.uni.wroc.pl>2018-11-24 23:48:58 +0100
committerPaweł Dybiec <pdybiec@stud.cs.uni.wroc.pl>2018-11-24 23:48:58 +0100
commit79e35a7044ba43a4827c83ed8d1850b8fc3bec15 (patch)
tree8a3db03aa6b070111fcf68b669016cdaa2064765
parent45db6551fd1860159e9babd53b68a67302e57e37 (diff)
Type checking for global definitions and basic types and operands
-rw-r--r--source/mod_student/typechecker.ml87
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