Respond to final round of review for #10407

testsuite/tests/typing-misc/labels.ml

@@ -31,8 +31,7 @@ Line 1, characters 4-23:
 1 | foo (fun ?opt () -> ()) ;; (* fails *)
         ^^^^^^^^^^^^^^^^^^^
 Error: This function should have type unit -> unit
-       but its first argument is labeled ?opt
-       instead of being unlabeled
+       but its first argument is labeled ?opt instead of being unlabeled
 |}];;
 
 (* filter_arrow *)
@@ -43,8 +42,7 @@ Line 1, characters 25-35:
 1 | let (f : x:int -> int) = fun y -> y
                              ^^^^^^^^^^
 Error: This function should have type x:int -> int
-       but its first argument is unlabeled
-       instead of being labeled ~x
+       but its first argument is unlabeled instead of being labeled ~x
 |}];;
 
 let (f : int -> int) = fun ~y -> y
@@ -53,8 +51,7 @@ Line 1, characters 23-34:
 1 | let (f : int -> int) = fun ~y -> y
                            ^^^^^^^^^^^
 Error: This function should have type int -> int
-       but its first argument is labeled ~y
-       instead of being unlabeled
+       but its first argument is labeled ~y instead of being unlabeled
 |}];;
 
 let (f : x:int -> int) = fun ~y -> y
@@ -63,8 +60,7 @@ Line 1, characters 25-36:
 1 | let (f : x:int -> int) = fun ~y -> y
                              ^^^^^^^^^^^
 Error: This function should have type x:int -> int
-       but its first argument is labeled ~y
-       instead of ~x
+       but its first argument is labeled ~y instead of ~x
 |}];;
 
 (* More examples *)

typing/ctype.ml

@@ -3413,14 +3413,8 @@ let filter_method env name priv ty =
 let check_filter_method env name priv ty =
   ignore(filter_method env name priv ty)
 
-exception Self_has_no_such_method
-
 let filter_self_method env lab priv meths ty =
-  let ty' =
-    try filter_method env lab priv ty
-    with Filter_method_failed Not_a_method -> raise Self_has_no_such_method
-       | Filter_method_failed _            -> assert false
-  in
+  let ty' = filter_method env lab priv ty in
   try
     Meths.find lab !meths
   with Not_found ->

typing/ctype.mli

@@ -241,7 +241,7 @@ val deep_occur: type_expr -> type_expr -> bool
 val filter_self_method:
         Env.t -> string -> private_flag -> (Ident.t * type_expr) Meths.t ref ->
         type_expr -> Ident.t * type_expr
-        (* Raises [Self_has_no_such_method] instead of [Unify], and only if the
+        (* Raises [Filter_method_failed] instead of [Unify], and only if the
            self type is closed at this point. *)
 val moregeneral: Env.t -> bool -> type_expr -> type_expr -> unit
         (* Check if the first type scheme is more general than the second. *)
@@ -281,8 +281,6 @@ type filter_method_failure =
 
 exception Filter_method_failed of filter_method_failure
 
-exception Self_has_no_such_method
-
 type class_match_failure =
     CM_Virtual_class
   | CM_Parameter_arity_mismatch of int * int

typing/errortrace.ml

@@ -150,19 +150,16 @@ type equality_error =
 type moregen_error = { trace : comparison error } [@@unboxed]
 
 let unification_error ~trace : unification_error =
-  if trace = []
-  then Misc.fatal_error "Unification error trace was empty"
-  else { trace }
+  assert (trace <> []);
+  { trace }
 
 let equality_error ~trace ~subst : equality_error =
-  if trace = []
-  then Misc.fatal_error "Equality error trace was empty"
-  else { trace; subst }
+    assert (trace <> []);
+    { trace; subst }
 
 let moregen_error ~trace : moregen_error =
-  if trace = []
-  then Misc.fatal_error "Moregen error trace was empty"
-  else { trace }
+  assert (trace <> []);
+  { trace }
 
 type comparison_error =
   | Equality_error of equality_error
@@ -187,9 +184,8 @@ module Subtype = struct
     ; unification_trace : unification error }
 
   let error ~trace ~unification_trace =
-    if trace = []
-    then Misc.fatal_error "Subtype error trace was empty"
-    else { trace; unification_trace }
+  assert (trace <> []);
+  { trace; unification_trace }
 
   let map_elt f = function
     | Diff x -> Diff (map_diff f x)

typing/printtyp.ml

@@ -2427,7 +2427,7 @@ module Subtype = struct
         txt1 =
     wrap_printing_env ~error:true env (fun () ->
       reset ();
-      let tr_sub  = prepare_trace             prepare_expansion tr_sub  in
+      let tr_sub = prepare_trace prepare_expansion tr_sub in
       let tr_unif = prepare_unification_trace prepare_expansion tr_unif in
       let keep_first = match tr_unif with
         | [Obj _ | Variant _ | Escape _ ] | [] -> true

typing/typecore.ml

@@ -3508,13 +3508,7 @@ and type_expect_
           exp_type = typ;
           exp_attributes = sexp.pexp_attributes;
           exp_env = env }
-      with (Filter_method_failed _ | Self_has_no_such_method) as err ->
-        let err =
-          match err with
-          | Filter_method_failed err -> err
-          | Self_has_no_such_method -> Not_a_method
-          | _ -> assert false
-        in
+      with Filter_method_failed err ->
         let error =
           match err with
           | Unification_error err ->
@@ -5687,8 +5681,7 @@ let report_error ~loc env = function
       in
       Location.errorf ~loc
         "@[<v>@[<2>This function should have type@ %a%t@]@,\
-         but its first argument is %s@ \
-         instead of %s%s@]"
+         @[but its first argument is %s@ instead of %s%s@]@]"
         Printtyp.type_expr expected_type
         (report_type_expected_explanation_opt explanation)
         (label ~long:true got)