improve error messages (PR#633)
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@4016 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02master
parent
50fc257b4c
commit
3b7bdb3044
|
@ -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"
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue