merge patch new-error.diff by lpw25record-disambiguation

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

11 files changed, 140 insertions, 65 deletions

diff --git a/testsuite/tests/typing-misc/records.ml.principal.reference b/testsuite/tests/typing-misc/records.ml.principal.reference
index cd7a20ed42..d2f35cb5ec 100644
--- a/testsuite/tests/typing-misc/records.ml.principal.reference
+++ b/testsuite/tests/typing-misc/records.ml.principal.reference
@@ -3,16 +3,16 @@
 # Characters 5-6:
   {x=3;z=2};;
        ^
-Error: Unbound record field label z
+Error: Unbound record field z
 # Characters 9-10:
   fun {x=3;z=2} -> ();;
            ^
-Error: Unbound record field label z
+Error: Unbound record field z
 #     Characters 26-34:
   {x=3; contents=2};;
         ^^^^^^^^
-Error: The record field label contents belongs to the type 'a ref
-       but is mixed here with labels of type t
+Error: The record field contents belongs to the type 'a ref
+       but is mixed here with fields of type t
 #     type u = private { mutable u : int; }
 # Characters 0-5:
   {u=3};;
diff --git a/testsuite/tests/typing-misc/records.ml.reference b/testsuite/tests/typing-misc/records.ml.reference
index cd7a20ed42..d2f35cb5ec 100644
--- a/testsuite/tests/typing-misc/records.ml.reference
+++ b/testsuite/tests/typing-misc/records.ml.reference
@@ -3,16 +3,16 @@
 # Characters 5-6:
   {x=3;z=2};;
        ^
-Error: Unbound record field label z
+Error: Unbound record field z
 # Characters 9-10:
   fun {x=3;z=2} -> ();;
            ^
-Error: Unbound record field label z
+Error: Unbound record field z
 #     Characters 26-34:
   {x=3; contents=2};;
         ^^^^^^^^
-Error: The record field label contents belongs to the type 'a ref
-       but is mixed here with labels of type t
+Error: The record field contents belongs to the type 'a ref
+       but is mixed here with fields of type t
 #     type u = private { mutable u : int; }
 # Characters 0-5:
   {u=3};;
diff --git a/testsuite/tests/typing-warnings/records.ml.principal.reference b/testsuite/tests/typing-warnings/records.ml.principal.reference
index 69b98dc22f..ecd3865cd4 100644
--- a/testsuite/tests/typing-warnings/records.ml.principal.reference
+++ b/testsuite/tests/typing-warnings/records.ml.principal.reference
@@ -4,7 +4,7 @@
 #                 Characters 89-90:
     let f2 r = ignore (r:t); r.x (* non principal *)
                                ^
-Warning 18: this type-based label disambiguation is not principal.
+Warning 18: this type-based field disambiguation is not principal.
 Characters 81-103:
     let f2 r = ignore (r:t); r.x (* non principal *)
                        ^^^^^^^^^^^^^^^^^^^^^^
@@ -86,14 +86,14 @@ Error: Some record fields are undefined: y
 #               Characters 111-112:
     let b : bar = {x=3; y=4}
                         ^
-Error: The record type bar has no label y
+Error: The record type bar has no field y
 #   module M : sig type foo = { x : int; y : int; } end
 # module N : sig type bar = { x : int; y : int; } end
 # Characters 19-22:
   let r = { M.x = 3; N.y = 4; };; (* error: different definitions *)
                      ^^^
-Error: The record field label N.y belongs to the type N.bar
-       but is mixed here with labels of type M.foo
+Error: The record field N.y belongs to the type N.bar
+       but is mixed here with fields of type M.foo
 #     module MN :
   sig
     type foo = M.foo = { x : int; y : int; }
@@ -111,8 +111,8 @@ Warning 41: this record contains fields that are ambiguous: x y.
 Characters 19-23:
   let r = {MN.x = 3; NM.y = 4};; (* error: type would change with order *)
                      ^^^^
-Error: The record field label NM.y belongs to the type NM.foo = M.foo
-       but is mixed here with labels of type MN.bar = N.bar
+Error: The record field NM.y belongs to the type NM.foo = M.foo
+       but is mixed here with fields of type MN.bar = N.bar
 #             module M :
   sig
     type foo = { x : int; y : int; }
@@ -121,7 +121,7 @@ Error: The record field label NM.y belongs to the type NM.foo = M.foo
 #       Characters 72-73:
     let f r = ignore (r: foo); {r with x = 2; z = 3}
                                               ^
-Error: The record type M.foo has no label z
+Error: The record type M.foo has no field z
 #       module M :
   sig
     type foo = M.foo = { x : int; y : int; }
@@ -131,20 +131,21 @@ Error: The record type M.foo has no label z
 #       Characters 73-74:
     let f r = ignore (r: foo); { r with x = 3; a = 4 }
                                                ^
-Error: The record type M.foo has no label a
+Error: The record type M.foo has no field a
 #         Characters 67-68:
     let r: other = {x=1; y=2}
                     ^
-Error: The record type M.other has no label x
+Error: The record type M.other has no field x
 #     module A : sig type t = { x : int; } end
 module B : sig type t = { x : int; } end
 # Characters 20-23:
   let f (r : B.t) = r.A.x;; (* fail *)
                       ^^^
-Error: The record type B.t has no label A.x
+Error: The field A.x belongs to the record type A.t
+       but a field was expected belonging to the record type B.t
 #             Characters 88-91:
     let a : t = {x=1;yyz=2}
                      ^^^
-Error: The record type t has no label yyz
+Error: The record type t has no field yyz
 Did you mean yyy?
 # 
diff --git a/testsuite/tests/typing-warnings/records.ml.reference b/testsuite/tests/typing-warnings/records.ml.reference
index f9bb04c6c4..1b39032ba3 100644
--- a/testsuite/tests/typing-warnings/records.ml.reference
+++ b/testsuite/tests/typing-warnings/records.ml.reference
@@ -82,14 +82,14 @@ Error: Some record fields are undefined: y
 #               Characters 111-112:
     let b : bar = {x=3; y=4}
                         ^
-Error: The record type bar has no label y
+Error: The record type bar has no field y
 #   module M : sig type foo = { x : int; y : int; } end
 # module N : sig type bar = { x : int; y : int; } end
 # Characters 19-22:
   let r = { M.x = 3; N.y = 4; };; (* error: different definitions *)
                      ^^^
-Error: The record field label N.y belongs to the type N.bar
-       but is mixed here with labels of type M.foo
+Error: The record field N.y belongs to the type N.bar
+       but is mixed here with fields of type M.foo
 #     module MN :
   sig
     type foo = M.foo = { x : int; y : int; }
@@ -107,8 +107,8 @@ Warning 41: this record contains fields that are ambiguous: x y.
 Characters 19-23:
   let r = {MN.x = 3; NM.y = 4};; (* error: type would change with order *)
                      ^^^^
-Error: The record field label NM.y belongs to the type NM.foo = M.foo
-       but is mixed here with labels of type MN.bar = N.bar
+Error: The record field NM.y belongs to the type NM.foo = M.foo
+       but is mixed here with fields of type MN.bar = N.bar
 #             module M :
   sig
     type foo = { x : int; y : int; }
@@ -117,7 +117,7 @@ Error: The record field label NM.y belongs to the type NM.foo = M.foo
 #       Characters 72-73:
     let f r = ignore (r: foo); {r with x = 2; z = 3}
                                               ^
-Error: The record type M.foo has no label z
+Error: The record type M.foo has no field z
 #       module M :
   sig
     type foo = M.foo = { x : int; y : int; }
@@ -127,20 +127,21 @@ Error: The record type M.foo has no label z
 #       Characters 73-74:
     let f r = ignore (r: foo); { r with x = 3; a = 4 }
                                                ^
-Error: The record type M.foo has no label a
+Error: The record type M.foo has no field a
 #         Characters 67-68:
     let r: other = {x=1; y=2}
                     ^
-Error: The record type M.other has no label x
+Error: The record type M.other has no field x
 #     module A : sig type t = { x : int; } end
 module B : sig type t = { x : int; } end
 # Characters 20-23:
   let f (r : B.t) = r.A.x;; (* fail *)
                       ^^^
-Error: The record type B.t has no label A.x
+Error: The field A.x belongs to the record type A.t
+       but a field was expected belonging to the record type B.t
 #             Characters 88-91:
     let a : t = {x=1;yyz=2}
                      ^^^
-Error: The record type t has no label yyz
+Error: The record type t has no field yyz
 Did you mean yyy?
 # 
diff --git a/typing/ctype.ml b/typing/ctype.ml
index 5780826e92..70c899f45a 100644
--- a/typing/ctype.ml
+++ b/typing/ctype.ml
@@ -1407,10 +1407,12 @@ let rec extract_concrete_typedecl env ty =
   match ty.desc with
     Tconstr (p, _, _) ->
       let decl = Env.find_type p env in
-      if decl.type_kind <> Type_abstract then (p, decl) else
+      if decl.type_kind <> Type_abstract then (p, p, decl) else
       let ty =
-	try try_expand_once env ty with Cannot_expand -> raise Not_found
-      in extract_concrete_typedecl env ty
+        try try_expand_once env ty with Cannot_expand -> raise Not_found
+      in 
+      let (_, p', decl) = extract_concrete_typedecl env ty in
+        (p, p', decl)
   | _ -> raise Not_found
 
 (* Implementing function [expand_head_opt], the compiler's own version of
diff --git a/typing/ctype.mli b/typing/ctype.mli
index 1cf67eeec4..e52fec49f4 100644
--- a/typing/ctype.mli
+++ b/typing/ctype.mli
@@ -145,10 +145,11 @@ val expand_head_opt: Env.t -> type_expr -> type_expr
 (** The compiler's own version of [expand_head] necessary for type-based
     optimisations. *)
 val full_expand: Env.t -> type_expr -> type_expr
-val extract_concrete_typedecl: Env.t -> type_expr -> Path.t * type_declaration
-        (* Return the first concrete type declaration found expanding
-	   the type. Raise [Not_found] if none appears or not a type
-	   constructor. *)
+val extract_concrete_typedecl:
+        Env.t -> type_expr -> Path.t * Path.t * type_declaration
+        (* Return the original path of the types, and the first concrete
+           type declaration found expanding it.
+           Raise [Not_found] if none appears or not a type constructor. *)
 
 val enforce_constraints: Env.t -> type_expr -> unit
 
diff --git a/typing/printtyp.ml b/typing/printtyp.ml
index dd5774bf8f..11156663ac 100644
--- a/typing/printtyp.ml
+++ b/typing/printtyp.ml
@@ -928,6 +928,10 @@ let type_expansion t ppf t' =
   let t' = if proxy t == proxy t' then unalias t' else t' in
   fprintf ppf "@[<2>%a@ =@ %a@]" type_expr t type_expr t'
 
+let type_path_expansion tp ppf tp' =
+  if Path.same tp tp' then path ppf tp else
+  fprintf ppf "@[<2>%a@ =@ %a@]" path tp path tp'
+
 let rec trace fst txt ppf = function
   | (t1, t1') :: (t2, t2') :: rem ->
       if not fst then fprintf ppf "@,";
@@ -946,6 +950,14 @@ let rec filter_trace = function
       else (t1, t1') :: (t2, t2') :: rem'
   | _ -> []
 
+let rec type_path_list ppf = function
+  | [tp, tp'] -> type_path_expansion tp ppf tp'
+  | (tp, tp') :: rem -> 
+      fprintf ppf "%a@;<2 0>%a"
+        (type_path_expansion tp) tp'
+        type_path_list rem
+  | [] -> ()
+
 (* Hide variant name and var, to force printing the expanded type *)
 let hide_variant_name t =
   match repr t with
@@ -1130,3 +1142,28 @@ let report_subtyping_error ppf tr1 txt1 tr2 =
   let mis = mismatch true tr2 in
   trace false "is not compatible with type" ppf tr2;
   explanation true mis ppf
+
+let report_ambiguous_type_error ppf (tp0, tp0') tpl txt1 txt2 txt3 =
+  reset ();
+  List.iter 
+    (fun (tp, tp') -> path_same_name tp0 tp; path_same_name tp0' tp') 
+    tpl;
+  match tpl with
+    [] -> assert false
+  | [tp, tp'] ->       
+      fprintf ppf
+        "@[%t@;<1 2>%a@ \
+            %t@;<1 2>%a\
+          @]"
+        txt1 (type_path_expansion tp) tp'
+        txt3 (type_path_expansion tp0) tp0'
+  | _ ->
+      fprintf ppf
+        "@[%t@;<1 2>@[<hv>%a@]\
+           @ %t@;<1 2>%a\
+          @]"
+        txt2 type_path_list tpl
+        txt3 (type_path_expansion tp0) tp0'
+
+
+      
diff --git a/typing/printtyp.mli b/typing/printtyp.mli
index 9b513e0ee4..7aff325747 100644
--- a/typing/printtyp.mli
+++ b/typing/printtyp.mli
@@ -72,3 +72,7 @@ val report_unification_error:
 val report_subtyping_error:
     formatter -> (type_expr * type_expr) list ->
     string -> (type_expr * type_expr) list -> unit
+val report_ambiguous_type_error:
+    formatter -> (Path.t * Path.t) -> (Path.t * Path.t) list -> 
+    (formatter -> unit) -> (formatter -> unit) -> (formatter -> unit) -> unit
+
diff --git a/typing/typecore.ml b/typing/typecore.ml
index b944650439..6670da94f8 100644
--- a/typing/typecore.ml
+++ b/typing/typecore.ml
@@ -34,6 +34,8 @@ type error =
   | Label_missing of Ident.t list
   | Label_not_mutable of Longident.t
   | Wrong_name of string * Env.t * Path.t * Longident.t
+  | Name_type_mismatch of 
+      string * Longident.t * (Path.t * Path.t) * (Path.t * Path.t) list
   | Incomplete_format of string
   | Bad_conversion of string * int * char
   | Undefined_method of type_expr * string
@@ -244,18 +246,18 @@ let extract_option_type env ty =
 
 let extract_concrete_record env ty =
   match extract_concrete_typedecl env ty with
-    (p, {type_kind=Type_record (fields, _)}) -> (p, fields)
+    (p0, p, {type_kind=Type_record (fields, _)}) -> (p0, p, fields)
   | _ -> raise Not_found
 
 let extract_concrete_variant env ty =
   match extract_concrete_typedecl env ty with
     (* exclude exceptions *)
-    (p, {type_kind=Type_variant (_::_ as cstrs)}) -> (p, cstrs)
+    (p0, p, {type_kind=Type_variant (_::_ as cstrs)}) -> (p0, p, cstrs)
   | _ -> raise Not_found
 
 let extract_label_names sexp env ty =
   try
-    let (_,fields) = extract_concrete_record env ty in
+    let (_, _,fields) = extract_concrete_record env ty in
     List.map (fun (name, _, _) -> name) fields
   with Not_found ->
     assert false
@@ -564,9 +566,13 @@ end) = struct
   let lookup_from_type env tpath lid =
     let descrs = get_descrs (Env.find_type_descrs tpath env) in
     Env.mark_type_used (Path.last tpath) (Env.find_type tpath env);
-    match lid with
-      Longident.Lident s ->
-	List.find (fun nd -> get_name nd = s) descrs
+    match lid.txt with
+      Longident.Lident s -> begin
+        try
+          List.find (fun nd -> get_name nd = s) descrs
+        with Not_found -> 
+          raise (Error (lid.loc, Wrong_name (type_kind, env, tpath, lid.txt)))
+      end
     | _ -> raise Not_found
 
   let is_ambiguous env lbl others =
@@ -599,10 +605,10 @@ end) = struct
 		(Warnings.Ambiguous_name ([Longident.last lid.txt], false));
 	    lbl
 	end
-    | Some(tpath, pr) ->
+    | Some(tpath0, tpath, pr) ->
 	let scope = match scope with None -> lbls | Some l -> l in
 	let warn_pr () =
-	  let kind = if type_kind = "record" then "label" else "constructor" in
+	  let kind = if type_kind = "record" then "field" else "constructor" in
           warn lid.loc
             (Warnings.Not_principal
 	       ("this type-based " ^ kind ^ " disambiguation"))
@@ -610,8 +616,6 @@ end) = struct
         try
           let lbl, use = disambiguate_by_type env tpath scope in
           use ();
-          (* Strange: why do we need to mark type by hand? *)
-          Env.mark_type_used (Path.last tpath) (Env.find_type tpath env);
           if not pr then begin
             (* Check if non-principal type is affecting result *)
             match lbls with
@@ -625,13 +629,22 @@ end) = struct
           end;
           lbl
         with Not_found -> try
-          let lbl = lookup_from_type env tpath lid.txt in
+          let lbl = lookup_from_type env tpath lid in
           warn lid.loc
             (Warnings.Name_out_of_scope ([Longident.last lid.txt], false));
           if not pr then warn_pr ();
           lbl
 	with Not_found ->
-	  raise (Error (lid.loc, Wrong_name (type_kind, env, tpath, lid.txt)))
+          let tp = (tpath0, expand_path env tpath) in
+	  let tpl = 
+            List.map 
+              (fun (lbl, _) -> 
+                let tp0 = get_type_path env lbl in
+                let tp = expand_path env tp0 in
+                  (tp0, tp))
+              lbls
+          in
+            raise (Error (lid.loc, Name_type_mismatch (type_kind, lid.txt, tp, tpl)))
 end
 
 module Label = NameChoice (struct
@@ -655,7 +668,7 @@ let disambiguate_label_by_ids keep env closed ids labels =
   let labels' = List.filter check_ids labels in
   if keep && labels' = [] then (false, labels) else
   let labels'' = List.filter check_closed labels' in
-  if keep & labels'' = [] then (false, labels') else (true, labels'')
+  if keep && labels'' = [] then (false, labels') else (true, labels'')
 
 (* Only issue warnings once per record constructor/pattern *)
 let disambiguate_lid_a_list loc closed env opath lid_a_list =
@@ -685,7 +698,7 @@ let disambiguate_lid_a_list loc closed env opath lid_a_list =
       Typetexp.unbound_label_error env lid;
     let (ok, labels) =
       match opath with
-        Some (_, true) -> (true, scope) (* disambiguate only checks scope *)
+        Some (_, _, true) -> (true, scope) (* disambiguate only checks scope *)
       | _  -> disambiguate_label_by_ids (opath=None) env closed ids scope
     in
     if ok then Label.disambiguate lid env opath labels ~warn ~scope
@@ -890,7 +903,9 @@ let rec type_pat ~constrs ~labels ~no_existentials ~mode ~env sp expected_ty =
         pat_env = !env }
   | Ppat_construct(lid, sarg, explicit_arity) ->
       let opath =
-        try Some (fst (extract_concrete_variant !env expected_ty), true)
+        try 
+          let (p0, p, _) = extract_concrete_variant !env expected_ty in
+            Some (p0, p, true)
 	with Not_found -> None
       in
       let constrs =
@@ -953,8 +968,8 @@ let rec type_pat ~constrs ~labels ~no_existentials ~mode ~env sp expected_ty =
   | Ppat_record(lid_sp_list, closed) ->
       let opath, record_ty =
         try
-          let (p,_) = extract_concrete_record !env expected_ty in
-          Some (p, true), expected_ty
+          let (p0, p,_) = extract_concrete_record !env expected_ty in
+          Some (p0, p, true), expected_ty
 	with Not_found -> None, newvar ()
       in
       let type_label_pat (label_lid, label, sarg) =
@@ -1992,9 +2007,9 @@ and type_expect ?in_function env sexp ty_expected =
       let ty_record, opath =
         let get_path ty =
 	  try
-	    let (p,_) = extract_concrete_record env ty in
+	    let (p0, p,_) = extract_concrete_record env ty in
 	    (* XXX level may be wrong *)
-            Some (p, ty.level = generic_level || not !Clflags.principal)
+            Some (p0, p, ty.level = generic_level || not !Clflags.principal)
           with Not_found -> None
         in
         match get_path ty_expected with
@@ -2605,8 +2620,8 @@ and type_label_access env loc srecord lid =
   let ty_exp = record.exp_type in
   let opath =
     try
-      let (p,_) = extract_concrete_record env ty_exp in
-      Some(p, ty_exp.level = generic_level || not !Clflags.principal)
+      let (p0, p,_) = extract_concrete_record env ty_exp in
+      Some(p0, p, ty_exp.level = generic_level || not !Clflags.principal)
     with Not_found -> None
   in
   let labels = Typetexp.find_all_labels env lid.loc lid.txt in
@@ -2925,8 +2940,8 @@ and type_application env funct sargs =
 and type_construct env loc lid sarg explicit_arity ty_expected =
   let opath =
     try
-      let (p,_) = extract_concrete_variant env ty_expected in
-      Some(p, ty_expected.level = generic_level || not !Clflags.principal)
+      let (p0, p,_) = extract_concrete_variant env ty_expected in
+      Some(p0, p, ty_expected.level = generic_level || not !Clflags.principal)
     with Not_found -> None
   in
   let constrs = Typetexp.find_all_constructors env lid.loc lid.txt in
@@ -3320,7 +3335,7 @@ open Printtyp
 
 let report_error ppf = function
   | Polymorphic_label lid ->
-      fprintf ppf "@[The record field label %a is polymorphic.@ %s@]"
+      fprintf ppf "@[The record field %a is polymorphic.@ %s@]"
         longident lid "You cannot instantiate it in a pattern."
   | Constructor_arity_mismatch(lid, expected, provided) ->
       fprintf ppf
@@ -3330,10 +3345,10 @@ let report_error ppf = function
   | Label_mismatch(lid, trace) ->
       report_unification_error ppf trace
         (function ppf ->
-           fprintf ppf "The record field label %a@ belongs to the type"
+           fprintf ppf "The record field %a@ belongs to the type"
                    longident lid)
         (function ppf ->
-           fprintf ppf "but is mixed here with labels of type")
+           fprintf ppf "but is mixed here with fields of type")
   | Pattern_type_clash trace ->
       report_unification_error ppf trace
         (function ppf ->
@@ -3376,7 +3391,7 @@ let report_error ppf = function
           This argument cannot be applied %a@]"
         type_expr ty print_label l
   | Label_multiply_defined lid ->
-      fprintf ppf "The record field label %a is defined several times"
+      fprintf ppf "The record field %a is defined several times"
               longident lid
   | Label_missing labels ->
       let print_labels ppf =
@@ -3387,10 +3402,22 @@ let report_error ppf = function
       fprintf ppf "The record field %a is not mutable" longident lid
   | Wrong_name (kind, env, p, lid) ->
       fprintf ppf "The %s type %a has no %s %a" kind path p
-	(if kind = "record" then "label" else "constructor")
+	(if kind = "record" then "field" else "constructor")
 	longident lid;
       if kind = "record" then Label.spellcheck ppf env p lid
                          else Constructor.spellcheck ppf env p lid
+  | Name_type_mismatch (kind, lid, tp, tpl) ->
+      let name = if kind = "record" then "field" else "constructor" in
+      report_ambiguous_type_error ppf tp tpl
+        (function ppf ->
+           fprintf ppf "The %s %a@ belongs to the %s type"
+             name longident lid kind)
+        (function ppf ->
+           fprintf ppf "The %s %a@ belongs to one of the following %s types:"
+             name longident lid kind)
+        (function ppf ->
+           fprintf ppf "but a %s was expected belonging to the %s type"
+             name kind)
   | Incomplete_format s ->
       fprintf ppf "Premature end of format string ``%S''" s
   | Bad_conversion (fmt, i, c) ->
diff --git a/typing/typecore.mli b/typing/typecore.mli
index 344c64b9ea..75b3d4f6c7 100644
--- a/typing/typecore.mli
+++ b/typing/typecore.mli
@@ -76,6 +76,8 @@ type error =
   | Label_missing of Ident.t list
   | Label_not_mutable of Longident.t
   | Wrong_name of string * Env.t * Path.t * Longident.t
+  | Name_type_mismatch of 
+      string * Longident.t * (Path.t * Path.t) * (Path.t * Path.t) list
   | Incomplete_format of string
   | Bad_conversion of string * int * char
   | Undefined_method of type_expr * string
diff --git a/typing/typetexp.ml b/typing/typetexp.ml
index 6fb2c2c76b..05141b2d84 100644
--- a/typing/typetexp.ml
+++ b/typing/typetexp.ml
@@ -815,7 +815,7 @@ let report_error ppf = function
       spellcheck_simple ppf Env.fold_constructors (fun d -> d.cstr_name)
 	env lid;
   | Unbound_label (env, lid) ->
-      fprintf ppf "Unbound record field label %a" longident lid;
+      fprintf ppf "Unbound record field %a" longident lid;
       spellcheck_simple ppf Env.fold_labels (fun d -> d.lbl_name) env lid;
   | Unbound_class (env, lid) ->
       fprintf ppf "Unbound class %a" longident lid;