diff options
| author | Alasdair Armstrong | 2019-11-05 18:55:59 +0000 |
|---|---|---|
| committer | Alasdair Armstrong | 2019-11-05 18:55:59 +0000 |
| commit | d474f256c7dfde3af9ef089ad9de5b7ff01f2d9f (patch) | |
| tree | 91741c959063a4b1d476d444bd4e4cf3c47da92c /src | |
| parent | 1edd0e73a7d19904639341fd360fff5fa3ff4fec (diff) | |
Improve type error for recursive types slightly
Diffstat (limited to 'src')
| -rw-r--r-- | src/type_check.ml | 9 |
1 files changed, 5 insertions, 4 deletions
diff --git a/src/type_check.ml b/src/type_check.ml index 1f27a0ab..4424fe8d 100644 --- a/src/type_check.ml +++ b/src/type_check.ml @@ -803,10 +803,10 @@ end = struct | Typ_var kid -> begin match KBindings.find kid env.typ_vars with | (_, K_type) -> () - | (_, k) -> typ_error env l ("Kind identifier " ^ string_of_kid kid ^ " in type " ^ string_of_typ typ + | (_, k) -> typ_error env l ("Type variable " ^ string_of_kid kid ^ " in type " ^ string_of_typ typ ^ " is " ^ string_of_kind_aux k ^ " rather than Type") | exception Not_found -> - typ_error env l ("Unbound kind identifier " ^ string_of_kid kid ^ " in type " ^ string_of_typ typ) + typ_error env l ("Unbound type variable " ^ string_of_kid kid ^ " in type " ^ string_of_typ typ) end | Typ_fn (arg_typs, ret_typ, effs) -> List.iter (wf_typ ~exs:exs env) arg_typs; wf_typ ~exs:exs env ret_typ | Typ_bidir (typ1, typ2) when strip_typ typ1 = strip_typ typ2 -> @@ -5080,15 +5080,16 @@ let fold_union_quant quants (QI_aux (qi, l)) = let forbid_recursive_types type_l f = try f () with | Type_error (env, l, err) -> - raise (Type_error (env, l, Err_because (err, type_l, Err_other "Recursive types are not allowed"))) + let msg = "Types are not well-formed within this type definition. Note that recursive types are forbidden." in + raise (Type_error (env, l, Err_because (err, type_l, Err_other msg))) let check_type_union u_l non_rec_env env variant typq (Tu_aux (tu, l)) = let ret_typ = app_typ variant (List.fold_left fold_union_quant [] (quant_items typq)) in match tu with | Tu_ty_id (Typ_aux (Typ_fn (arg_typ, ret_typ, _), _) as typ, v) -> let typq = mk_typquant (List.map (mk_qi_id K_type) (KidSet.elements (tyvars_of_typ typ))) in - forbid_recursive_types u_l (fun () -> wf_binding l non_rec_env (typq, tuple_typ arg_typ)); wf_binding l env (typq, typ); + forbid_recursive_types u_l (fun () -> wf_binding l non_rec_env (typq, tuple_typ arg_typ)); env |> Env.add_union_id v (typq, typ) |> Env.add_val_spec v (typq, typ) |