- List.fold_left typedecs ~init:env ~f:(
- fun env (A.TypeDec {name; ty; pos=_}) ->
- let ty = transTy ~env ty in
- Env.set_typ env name ty
- )
- | A.FunDecs _ ->
- unimplemented ()
+ check_cycles typedecs;
+ let env =
+ List.fold_left typedecs ~init:env ~f:(
+ fun env (A.TypeDec {name; ty=_; pos=_}) ->
+ Env.set_typ env name (Type.Name (name, ref None))
+ )
+ in
+ List.iter typedecs ~f:(fun (A.TypeDec {name; ty=ty_exp; pos}) ->
+ let ty = transTy ~env ty_exp in
+ (match env_get_typ ~sym:name ~env ~pos with
+ | Type.Name (_, ty_opt_ref) ->
+ ty_opt_ref := Some ty
+ | Type.Unit
+ | Type.Nil
+ | Type.Int
+ | Type.String
+ | Type.Record _
+ | Type.Array _ ->
+ ()
+ )
+ );
+ env
+ | A.FunDecs fundecs ->
+ 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
+ (* we only care if an exception is raised *)
+ ignore (transExp ~env:env_with_fun_heads_and_local_vars body);
+ );
+ env_with_fun_heads_only