X-Git-Url: https://git.xandkar.net/?p=tiger.ml.git;a=blobdiff_plain;f=compiler%2Fsrc%2Flib%2Ftiger%2Ftiger_semant.ml;fp=compiler%2Fsrc%2Flib%2Ftiger%2Ftiger_semant.ml;h=b19c6fcd92ae48540bc463068aa1b277bbfa2f0b;hp=21816959a1ab402b4f736c3d27cf15f73f06d5e6;hb=a284f5c25c7f6e4d38a7b0c71846af50321951e2;hpb=9340b0e333dd6acb5b18f68d1bf3eadad8401fa5 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