improve error message

git-svn-id: http://caml.inria.fr/svn/ocaml/branches/poly_meth2@4517 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

1 files changed, 14 insertions, 13 deletions

diff --git a/typing/typecore.ml b/typing/typecore.ml
index a9f40483fd..91e2ca854b 100644
--- a/typing/typecore.ml
+++ b/typing/typecore.ml
@@ -680,19 +680,20 @@ let list_labels env ty = list_labels_aux env [] [] ty
 
 (* Check that all univars are safe in a type *)
 let check_univars env kind exp ty_expected vars =
-  List.iter
-    (fun t ->
-      let t = repr t in
-      generalize t;
-      if t.desc = Tvar && t.level = generic_level then () else
-      raise
-        (Error
-           (exp.exp_loc,
-            Less_general(kind,
-                         [repr exp.exp_type, full_expand env exp.exp_type;
-                          repr ty_expected, full_expand env ty_expected])));
-      t.desc <- Tunivar)
-    vars
+  let vars' =
+    List.filter
+      (fun t ->
+        let t = repr t in
+        generalize t;
+        if t.desc = Tvar && t.level = generic_level then
+          (t.desc <- Tunivar; true)
+        else false)
+      vars in
+  if List.length vars = List.length vars' then () else
+  let ty = newgenty (Tpoly(repr exp.exp_type, vars'))
+  and ty_expected = repr ty_expected in
+  raise (Error (exp.exp_loc,
+                Less_general(kind, [ty, ty; ty_expected, ty_expected])))
 
 (* Hack to allow coercion of self. Will clean-up later. *)
 let self_coercion = ref ([] : (Path.t * Location.t list ref) list)