improve error messages (PR#633)

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@4016 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
master
Jacques Garrigue 2001-11-16 09:07:09 +00:00
parent 50fc257b4c
commit 3b7bdb3044
2 changed files with 18 additions and 12 deletions

View File

@ -49,7 +49,7 @@ type error =
| Outside_class
| Value_multiply_overridden of string
| Coercion_failure of type_expr * type_expr * (type_expr * type_expr) list
| Too_many_arguments
| Too_many_arguments of bool
| Abstract_wrong_label of label * type_expr
| Scoping_let_module of string * type_expr
| Masked_instance_variable of Longident.t
@ -1184,9 +1184,9 @@ and type_application env funct sargs =
let ignored = ref [] in
let rec type_unknown_args args omitted ty_fun = function
[] ->
(List.rev_map
(List.map
(function None, x -> None, x | Some f, x -> Some (f ()), x)
args,
(List.rev args),
result_type omitted ty_fun)
| (l1, sarg1) :: sargl ->
let (ty1, ty2) =
@ -1342,7 +1342,7 @@ and type_construct env loc lid sarg explicit_arity ty_expected =
(* Typing of an expression with an expected type.
Some constructs are treated specially to provide better error messages. *)
and type_expect env sexp ty_expected =
and type_expect ?(in_function=false) env sexp ty_expected =
match sexp.pexp_desc with
Pexp_constant(Const_string s as cst) ->
let exp =
@ -1396,7 +1396,7 @@ and type_expect env sexp ty_expected =
{pexp_loc = sexp.pexp_loc; pexp_desc =
Pexp_let(Default, [spat, smatch], sbody)}])}
in
type_expect env sfun ty_expected
type_expect ~in_function env sfun ty_expected
| Pexp_function (l, _, caselist) ->
let (ty_arg, ty_res) =
try filter_arrow env ty_expected l
@ -1405,14 +1405,15 @@ and type_expect env sexp ty_expected =
{desc = Tarrow _} as ty ->
raise(Error(sexp.pexp_loc, Abstract_wrong_label(l, ty)))
| _ ->
raise(Error(sexp.pexp_loc, Too_many_arguments))
raise(Error(sexp.pexp_loc, Too_many_arguments in_function))
in
if is_optional l then begin
try unify env ty_arg (type_option(newvar()))
with Unify _ -> assert false
end;
let cases, partial =
type_cases env ty_arg ty_res (Some sexp.pexp_loc) caselist in
type_cases ~in_function:true env ty_arg ty_res (Some sexp.pexp_loc)
caselist in
let rec all_labeled ty =
match (repr ty).desc with
Tarrow ("", _, _, _) | Tvar -> false
@ -1447,7 +1448,7 @@ and type_statement env sexp =
(* Typing of match cases *)
and type_cases env ty_arg ty_res partial_loc caselist =
and type_cases ?(in_function=false) env ty_arg ty_res partial_loc caselist =
let ty_arg' = newvar () in
let pat_env_list =
List.map
@ -1475,10 +1476,11 @@ and type_cases env ty_arg ty_res partial_loc caselist =
begin match pat_env_list with [] -> ()
| (pat, _) :: _ -> unify_pat env pat ty_arg
end;
let in_function = in_function && List.length caselist = 1 in
let cases =
List.map2
(fun (pat, ext_env) (spat, sexp) ->
let exp = type_expect ext_env sexp ty_res in
let exp = type_expect ~in_function ext_env sexp ty_res in
(pat, exp))
pat_env_list caselist in
(* Check for impossible variant constructors, and normalize variant types *)
@ -1634,8 +1636,11 @@ let report_error ppf = function
(type_expansion ty) ty')
(function ppf ->
fprintf ppf "but is here used with type")
| Too_many_arguments ->
fprintf ppf "This function expects too many arguments"
| Too_many_arguments in_function ->
if in_function then
fprintf ppf "This function expects too many arguments"
else
fprintf ppf "This expression should not be a function"
| Abstract_wrong_label (l, ty) ->
let label_mark = function
| "" -> "but its first argument is not labeled"

View File

@ -41,6 +41,7 @@ val type_self_pattern:
(Ident.t * Asttypes.mutable_flag * type_expr) Vars.t ref *
Env.t * Env.t * Env.t
val type_expect:
?in_function:bool ->
Env.t -> Parsetree.expression -> type_expr -> Typedtree.expression
val type_exp:
Env.t -> Parsetree.expression -> Typedtree.expression
@ -81,7 +82,7 @@ type error =
| Outside_class
| Value_multiply_overridden of string
| Coercion_failure of type_expr * type_expr * (type_expr * type_expr) list
| Too_many_arguments
| Too_many_arguments of bool
| Abstract_wrong_label of label * type_expr
| Scoping_let_module of string * type_expr
| Masked_instance_variable of Longident.t