diff options
Diffstat (limited to 'typing')
| -rw-r--r-- | typing/typecore.ml | 9 | ||||
| -rw-r--r-- | typing/typecore.mli | 1 |
2 files changed, 9 insertions, 1 deletions
diff --git a/typing/typecore.ml b/typing/typecore.ml index 7d094d36dc..47cbb0ede9 100644 --- a/typing/typecore.ml +++ b/typing/typecore.ml @@ -25,6 +25,7 @@ type error = | Constructor_arity_mismatch of Longident.t * int * int | Label_mismatch of Longident.t * (type_expr * type_expr) list | Pattern_type_clash of (type_expr * type_expr) list + | Or_pattern_type_clash of Ident.t * (type_expr * type_expr) list | Multiply_bound_variable of string | Orpat_vars of Ident.t | Expr_type_clash of (type_expr * type_expr) list @@ -438,7 +439,7 @@ let enter_orpat_variables loc env p1_vs p2_vs = unify env t1 t2 with | Unify trace -> - raise(Error(loc, env, Pattern_type_clash(trace))) + raise(Error(loc, env, Or_pattern_type_clash(x1, trace))) end; (x2,x1)::unify_vars rem1 rem2 end @@ -3674,6 +3675,12 @@ let report_error env ppf = function fprintf ppf "This pattern matches values of type") (function ppf -> fprintf ppf "but a pattern was expected which matches values of type") + | Or_pattern_type_clash (id, trace) -> + report_unification_error ppf env trace + (function ppf -> + fprintf ppf "The variable %s on the left-hand side of this or-pattern has type" (Ident.name id)) + (function ppf -> + fprintf ppf "but on the right-hand side it has type") | Multiply_bound_variable name -> fprintf ppf "Variable %s is bound several times in this matching" name | Orpat_vars id -> diff --git a/typing/typecore.mli b/typing/typecore.mli index 7d8f5c75da..8dae2c9883 100644 --- a/typing/typecore.mli +++ b/typing/typecore.mli @@ -67,6 +67,7 @@ type error = | Constructor_arity_mismatch of Longident.t * int * int | Label_mismatch of Longident.t * (type_expr * type_expr) list | Pattern_type_clash of (type_expr * type_expr) list + | Or_pattern_type_clash of Ident.t * (type_expr * type_expr) list | Multiply_bound_variable of string | Orpat_vars of Ident.t | Expr_type_clash of (type_expr * type_expr) list |