From a284f5c25c7f6e4d38a7b0c71846af50321951e2 Mon Sep 17 00:00:00 2001 From: Siraaj Khandkar Date: Mon, 17 Sep 2018 09:53:26 -0400 Subject: [PATCH] Implement (mutually) recursive function definitions --- compiler/src/lib/tiger/tiger_semant.ml | 48 +++++++++++-------- .../src/lib/tiger/tiger_test_cases_book.ml | 6 ++- 2 files changed, 32 insertions(+), 22 deletions(-) diff --git a/compiler/src/lib/tiger/tiger_semant.ml b/compiler/src/lib/tiger/tiger_semant.ml index 2181695..b19c6fc 100644 --- a/compiler/src/lib/tiger/tiger_semant.ml +++ b/compiler/src/lib/tiger/tiger_semant.ml @@ -307,28 +307,36 @@ end = struct ); env | A.FunDecs fundecs -> - List.fold_left fundecs ~init:env ~f:( - fun env (A.FunDec {name; params; result; body; pos=_}) -> - let (env_for_body, formals_in_reverse_order) = - List.fold_left params ~init:(env, []) ~f:( - fun (env, formals) (A.Field {name; escape=_; typ; pos}) -> - let ty = env_get_typ_actual ~env ~sym:typ ~pos in - let env = Env.set_val env name (Value.Var {ty}) in - (env, ty :: formals) + let env_with_fun_heads_only = + List.fold_left fundecs ~init:env ~f:( + fun env (A.FunDec {name; params; result; body=_; pos=_}) -> + let formals = + List.map params ~f:( + fun (A.Field {name=_; typ; pos; escape=_}) -> + env_get_typ_actual ~env ~sym:typ ~pos + ) + in + let result = + match result with + | Some (s, p) -> env_get_typ_actual ~sym:s ~env ~pos:p + | None -> Type.Unit + in + Env.set_val env name (Value.Fun {formals; result}) + ) + in + List.iter fundecs ~f:( + fun (A.FunDec {name=_; params; result=_; body; pos=_}) -> + let env_with_fun_heads_and_local_vars = + List.fold_left params ~init:env_with_fun_heads_only ~f:( + fun env (A.Field {name=var_name; escape=_; typ; pos}) -> + let var_ty = env_get_typ_actual ~env ~sym:typ ~pos in + Env.set_val env var_name (Value.Var {ty = var_ty}) ) in - (* ignore because we only care if an exception is raised *) - ignore (transExp ~env:env_for_body body); - let formals = List.rev formals_in_reverse_order in - let result = - match result with - | None -> - Type.Unit - | Some (sym, pos) -> - env_get_typ_actual ~sym ~env ~pos - in - Env.set_val env name (Value.Fun {formals; result}) - ) + (* we only care if an exception is raised *) + ignore (transExp ~env:env_with_fun_heads_and_local_vars body); + ); + env_with_fun_heads_only ) and transTy ~(env : Env.t) (ty_exp : A.ty) : Type.t = (match ty_exp with diff --git a/compiler/src/lib/tiger/tiger_test_cases_book.ml b/compiler/src/lib/tiger/tiger_test_cases_book.ml index 76bb5af..928373b 100644 --- a/compiler/src/lib/tiger/tiger_test_cases_book.ml +++ b/compiler/src/lib/tiger/tiger_test_cases_book.ml @@ -91,7 +91,6 @@ let is_error_expected_parsing_of_filename = (* TODO: Fill-in other expected cases *) None -(* TODO: test18.tig - error : definition of recursive functions is interrupted*) (* TODO: test21.tig - error : procedure returns value and procedure is used in arexpr *) let is_error_expected_semant_of_filename = @@ -101,6 +100,8 @@ let is_error_expected_semant_of_filename = | "test33.tig" -> Some Error.is_unknown_type (* TODO: Be more specific - which type? *) + | "test18.tig" + | "test19.tig" | "test20.tig" -> Some Error.is_unknown_id (* TODO: Be more specific - the unknown id is "i" *) @@ -121,6 +122,7 @@ let is_error_expected_semant_of_filename = | "test11.tig" | "test13.tig" | "test14.tig" + | "test21.tig" | "test23.tig" | "test26.tig" | "test28.tig" @@ -130,7 +132,7 @@ let is_error_expected_semant_of_filename = | "test34.tig" | "test43.tig" -> Some Error.is_wrong_type - (* TODO: Be more specific - what expected, what given? *) + (* TODO: Be more specific - what expected, what given? Where? *) | _ -> (* TODO: Fill-in other expected cases *) None -- 2.20.1