/usr/lib/ocaml/compiler-libs/typing/typetexp.ml is in ocaml-compiler-libs 3.12.1-2ubuntu2.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 | (***********************************************************************)
(* *)
(* Objective Caml *)
(* *)
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 1996 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the Q Public License version 1.0. *)
(* *)
(***********************************************************************)
(* typetexp.ml,v 1.34.4.9 2002/01/07 08:39:16 garrigue Exp *)
(* Typechecking of type expressions for the core language *)
open Misc
open Parsetree
open Types
open Ctype
exception Already_bound
type error =
Unbound_type_variable of string
| Unbound_type_constructor of Longident.t
| Unbound_type_constructor_2 of Path.t
| Type_arity_mismatch of Longident.t * int * int
| Bound_type_variable of string
| Recursive_type
| Unbound_row_variable of Longident.t
| Type_mismatch of (type_expr * type_expr) list
| Alias_type_mismatch of (type_expr * type_expr) list
| Present_has_conjunction of string
| Present_has_no_type of string
| Constructor_mismatch of type_expr * type_expr
| Not_a_variant of type_expr
| Variant_tags of string * string
| Invalid_variable_name of string
| Cannot_quantify of string * type_expr
| Multiple_constraints_on_type of string
| Repeated_method_label of string
| Unbound_value of Longident.t
| Unbound_constructor of Longident.t
| Unbound_label of Longident.t
| Unbound_module of Longident.t
| Unbound_class of Longident.t
| Unbound_modtype of Longident.t
| Unbound_cltype of Longident.t
| Ill_typed_functor_application of Longident.t
exception Error of Location.t * error
type variable_context = int * (string, type_expr) Tbl.t
(* Narrowing unbound identifier errors. *)
let rec narrow_unbound_lid_error env loc lid make_error =
let check_module mlid =
try ignore (Env.lookup_module mlid env)
with Not_found -> narrow_unbound_lid_error env loc mlid (fun lid -> Unbound_module lid); assert false
in
begin match lid with
| Longident.Lident _ -> ()
| Longident.Ldot (mlid, _) -> check_module mlid
| Longident.Lapply (flid, mlid) ->
check_module flid;
check_module mlid;
raise (Error (loc, Ill_typed_functor_application lid))
end;
raise (Error (loc, make_error lid))
let find_component lookup make_error env loc lid =
try
match lid with
| Longident.Ldot (Longident.Lident "*predef*", s) -> lookup (Longident.Lident s) Env.initial
| _ -> lookup lid env
with Not_found ->
(narrow_unbound_lid_error env loc lid make_error
: unit (* to avoid a warning *));
assert false
let find_type = find_component Env.lookup_type (fun lid -> Unbound_type_constructor lid)
let find_constructor = find_component Env.lookup_constructor (fun lid -> Unbound_constructor lid)
let find_label = find_component Env.lookup_label (fun lid -> Unbound_label lid)
let find_class = find_component Env.lookup_class (fun lid -> Unbound_class lid)
let find_value = find_component Env.lookup_value (fun lid -> Unbound_value lid)
let find_module = find_component Env.lookup_module (fun lid -> Unbound_module lid)
let find_modtype = find_component Env.lookup_modtype (fun lid -> Unbound_modtype lid)
let find_cltype = find_component Env.lookup_cltype (fun lid -> Unbound_cltype lid)
(* Support for first-class modules. *)
let transl_modtype_longident = ref (fun _ -> assert false)
let transl_modtype = ref (fun _ -> assert false)
let create_package_mty fake loc env (p, l) =
let l =
List.sort
(fun (s1, t1) (s2, t2) ->
if s1 = s2 then raise (Error (loc, Multiple_constraints_on_type s1));
compare s1 s2)
l
in
l,
List.fold_left
(fun mty (s, t) ->
let d = {ptype_params = [];
ptype_cstrs = [];
ptype_kind = Ptype_abstract;
ptype_private = Asttypes.Public;
ptype_manifest = if fake then None else Some t;
ptype_variance = [];
ptype_loc = loc} in
{pmty_desc=Pmty_with (mty, [ Longident.Lident s, Pwith_type d ]); pmty_loc=loc}
)
{pmty_desc=Pmty_ident p; pmty_loc=loc}
l
(* Translation of type expressions *)
let type_variables = ref (Tbl.empty : (string, type_expr) Tbl.t)
let univars = ref ([] : (string * type_expr) list)
let pre_univars = ref ([] : type_expr list)
let used_variables = ref (Tbl.empty : (string, type_expr * Location.t) Tbl.t)
let reset_type_variables () =
reset_global_level ();
type_variables := Tbl.empty
let narrow () =
(increase_global_level (), !type_variables)
let widen (gl, tv) =
restore_global_level gl;
type_variables := tv
let enter_type_variable strict loc name =
try
if name <> "" && name.[0] = '_' then
raise (Error (loc, Invalid_variable_name ("'" ^ name)));
let v = Tbl.find name !type_variables in
if strict then raise Already_bound;
v
with Not_found ->
let v = new_global_var() in
type_variables := Tbl.add name v !type_variables;
v
let type_variable loc name =
try
Tbl.find name !type_variables
with Not_found ->
raise(Error(loc, Unbound_type_variable ("'" ^ name)))
let wrap_method ty =
match (Ctype.repr ty).desc with
Tpoly _ -> ty
| _ -> Ctype.newty (Tpoly (ty, []))
let new_pre_univar () =
let v = newvar () in pre_univars := v :: !pre_univars; v
let rec swap_list = function
x :: y :: l -> y :: x :: swap_list l
| l -> l
type policy = Fixed | Extensible | Univars
let rec transl_type env policy styp =
match styp.ptyp_desc with
Ptyp_any ->
if policy = Univars then new_pre_univar () else
if policy = Fixed then
raise (Error (styp.ptyp_loc, Unbound_type_variable "_"))
else newvar ()
| Ptyp_var name ->
if name <> "" && name.[0] = '_' then
raise (Error (styp.ptyp_loc, Invalid_variable_name ("'" ^ name)));
begin try
instance (List.assoc name !univars)
with Not_found -> try
instance (fst(Tbl.find name !used_variables))
with Not_found ->
let v =
if policy = Univars then new_pre_univar () else newvar () in
used_variables := Tbl.add name (v, styp.ptyp_loc) !used_variables;
v
end
| Ptyp_arrow(l, st1, st2) ->
let ty1 = transl_type env policy st1 in
let ty2 = transl_type env policy st2 in
newty (Tarrow(l, ty1, ty2, Cok))
| Ptyp_tuple stl ->
newty (Ttuple(List.map (transl_type env policy) stl))
| Ptyp_constr(lid, stl) ->
let (path, decl) = find_type env styp.ptyp_loc lid in
if List.length stl <> decl.type_arity then
raise(Error(styp.ptyp_loc, Type_arity_mismatch(lid, decl.type_arity,
List.length stl)));
let args = List.map (transl_type env policy) stl in
let params = Ctype.instance_list decl.type_params in
let unify_param =
match decl.type_manifest with
None -> unify_var
| Some ty ->
if (repr ty).level = Btype.generic_level then unify_var else unify
in
List.iter2
(fun (sty, ty) ty' ->
try unify_param env ty' ty with Unify trace ->
raise (Error(sty.ptyp_loc, Type_mismatch (swap_list trace))))
(List.combine stl args) params;
let constr = newconstr path args in
begin try
Ctype.enforce_constraints env constr
with Unify trace ->
raise (Error(styp.ptyp_loc, Type_mismatch trace))
end;
constr
| Ptyp_object fields ->
newobj (transl_fields env policy [] fields)
| Ptyp_class(lid, stl, present) ->
let (path, decl, is_variant) =
try
let (path, decl) = Env.lookup_type lid env in
let rec check decl =
match decl.type_manifest with
None -> raise Not_found
| Some ty ->
match (repr ty).desc with
Tvariant row when Btype.static_row row -> ()
| Tconstr (path, _, _) ->
check (Env.find_type path env)
| _ -> raise Not_found
in check decl;
Location.prerr_warning styp.ptyp_loc Warnings.Deprecated;
(path, decl,true)
with Not_found -> try
if present <> [] then raise Not_found;
let lid2 =
match lid with
Longident.Lident s -> Longident.Lident ("#" ^ s)
| Longident.Ldot(r, s) -> Longident.Ldot (r, "#" ^ s)
| Longident.Lapply(_, _) -> fatal_error "Typetexp.transl_type"
in
let (path, decl) = Env.lookup_type lid2 env in
(path, decl, false)
with Not_found ->
raise(Error(styp.ptyp_loc, Unbound_class lid))
in
if List.length stl <> decl.type_arity then
raise(Error(styp.ptyp_loc, Type_arity_mismatch(lid, decl.type_arity,
List.length stl)));
let args = List.map (transl_type env policy) stl in
let params = Ctype.instance_list decl.type_params in
List.iter2
(fun (sty, ty) ty' ->
try unify_var env ty' ty with Unify trace ->
raise (Error(sty.ptyp_loc, Type_mismatch (swap_list trace))))
(List.combine stl args) params;
let ty =
try Ctype.expand_head env (newconstr path args)
with Unify trace ->
raise (Error(styp.ptyp_loc, Type_mismatch trace))
in
begin match ty.desc with
Tvariant row ->
let row = Btype.row_repr row in
List.iter
(fun l -> if not (List.mem_assoc l row.row_fields) then
raise(Error(styp.ptyp_loc, Present_has_no_type l)))
present;
let fields =
List.map
(fun (l,f) -> l,
if List.mem l present then f else
match Btype.row_field_repr f with
| Rpresent (Some ty) ->
Reither(false, [ty], false, ref None)
| Rpresent None ->
Reither (true, [], false, ref None)
| _ -> f)
row.row_fields
in
let row = { row_closed = true; row_fields = fields;
row_bound = (); row_name = Some (path, args);
row_fixed = false; row_more = newvar () } in
let static = Btype.static_row row in
let row =
if static || policy <> Univars then row
else { row with row_more = new_pre_univar () }
in
newty (Tvariant row)
| Tobject (fi, _) ->
let _, tv = flatten_fields fi in
if policy = Univars then pre_univars := tv :: !pre_univars;
ty
| _ ->
assert false
end
| Ptyp_alias(st, alias) ->
begin
try
let t =
try List.assoc alias !univars
with Not_found ->
instance (fst(Tbl.find alias !used_variables))
in
let ty = transl_type env policy st in
begin try unify_var env t ty with Unify trace ->
let trace = swap_list trace in
raise(Error(styp.ptyp_loc, Alias_type_mismatch trace))
end;
ty
with Not_found ->
if !Clflags.principal then begin_def ();
let t = newvar () in
used_variables := Tbl.add alias (t, styp.ptyp_loc) !used_variables;
let ty = transl_type env policy st in
begin try unify_var env t ty with Unify trace ->
let trace = swap_list trace in
raise(Error(styp.ptyp_loc, Alias_type_mismatch trace))
end;
if !Clflags.principal then begin
end_def ();
generalize_structure t;
end;
instance t
end
| Ptyp_variant(fields, closed, present) ->
let name = ref None in
let mkfield l f =
newty (Tvariant {row_fields=[l,f]; row_more=newvar();
row_bound=(); row_closed=true;
row_fixed=false; row_name=None}) in
let hfields = Hashtbl.create 17 in
let add_typed_field loc l f =
let h = Btype.hash_variant l in
try
let (l',f') = Hashtbl.find hfields h in
(* Check for tag conflicts *)
if l <> l' then raise(Error(styp.ptyp_loc, Variant_tags(l, l')));
let ty = mkfield l f and ty' = mkfield l f' in
if equal env false [ty] [ty'] then () else
try unify env ty ty'
with Unify trace -> raise(Error(loc, Constructor_mismatch (ty,ty')))
with Not_found ->
Hashtbl.add hfields h (l,f)
in
let rec add_field = function
Rtag (l, c, stl) ->
name := None;
let f = match present with
Some present when not (List.mem l present) ->
let tl = List.map (transl_type env policy) stl in
Reither(c, tl, false, ref None)
| _ ->
if List.length stl > 1 || c && stl <> [] then
raise(Error(styp.ptyp_loc, Present_has_conjunction l));
match stl with [] -> Rpresent None
| st :: _ -> Rpresent (Some(transl_type env policy st))
in
add_typed_field styp.ptyp_loc l f
| Rinherit sty ->
let ty = transl_type env policy sty in
let nm =
match repr ty with
{desc=Tconstr(p, tl, _)} -> Some(p, tl)
| _ -> None
in
begin try
(* Set name if there are no fields yet *)
Hashtbl.iter (fun _ _ -> raise Exit) hfields;
name := nm
with Exit ->
(* Unset it otherwise *)
name := None
end;
let fl = match expand_head env ty, nm with
{desc=Tvariant row}, _ when Btype.static_row row ->
let row = Btype.row_repr row in
row.row_fields
| {desc=Tvar}, Some(p, _) ->
raise(Error(sty.ptyp_loc, Unbound_type_constructor_2 p))
| _ ->
raise(Error(sty.ptyp_loc, Not_a_variant ty))
in
List.iter
(fun (l, f) ->
let f = match present with
Some present when not (List.mem l present) ->
begin match f with
Rpresent(Some ty) ->
Reither(false, [ty], false, ref None)
| Rpresent None ->
Reither(true, [], false, ref None)
| _ ->
assert false
end
| _ -> f
in
add_typed_field sty.ptyp_loc l f)
fl
in
List.iter add_field fields;
let fields = Hashtbl.fold (fun _ p l -> p :: l) hfields [] in
begin match present with None -> ()
| Some present ->
List.iter
(fun l -> if not (List.mem_assoc l fields) then
raise(Error(styp.ptyp_loc, Present_has_no_type l)))
present
end;
let row =
{ row_fields = List.rev fields; row_more = newvar ();
row_bound = (); row_closed = closed;
row_fixed = false; row_name = !name } in
let static = Btype.static_row row in
let row =
if static || policy <> Univars then row
else { row with row_more = new_pre_univar () }
in
newty (Tvariant row)
| Ptyp_poly(vars, st) ->
begin_def();
let new_univars = List.map (fun name -> name, newvar()) vars in
let old_univars = !univars in
univars := new_univars @ !univars;
let ty = transl_type env policy st in
univars := old_univars;
end_def();
generalize ty;
let ty_list =
List.fold_left
(fun tyl (name, ty1) ->
let v = Btype.proxy ty1 in
if deep_occur v ty then begin
if v.level <> Btype.generic_level || v.desc <> Tvar then
raise (Error (styp.ptyp_loc, Cannot_quantify (name, v)));
v.desc <- Tunivar;
v :: tyl
end else tyl)
[] new_univars
in
let ty' = Btype.newgenty (Tpoly(ty, List.rev ty_list)) in
unify_var env (newvar()) ty';
ty'
| Ptyp_package (p, l) ->
let l, mty = create_package_mty true styp.ptyp_loc env (p, l) in
let z = narrow () in
ignore (!transl_modtype env mty);
widen z;
newty (Tpackage (!transl_modtype_longident styp.ptyp_loc env p,
List.map fst l,
List.map (transl_type env policy) (List.map snd l)))
and transl_fields env policy seen =
function
[] ->
newty Tnil
| {pfield_desc = Pfield_var}::_ ->
if policy = Univars then new_pre_univar () else newvar ()
| {pfield_desc = Pfield(s, e); pfield_loc = loc}::l ->
if List.mem s seen then raise (Error (loc, Repeated_method_label s));
let ty1 = transl_type env policy e in
let ty2 = transl_fields env policy (s::seen) l in
newty (Tfield (s, Fpresent, ty1, ty2))
(* Make the rows "fixed" in this type, to make universal check easier *)
let rec make_fixed_univars ty =
let ty = repr ty in
if ty.level >= Btype.lowest_level then begin
Btype.mark_type_node ty;
match ty.desc with
| Tvariant row ->
let row = Btype.row_repr row in
if (Btype.row_more row).desc = Tunivar then
ty.desc <- Tvariant
{row with row_fixed=true;
row_fields = List.map
(fun (s,f as p) -> match Btype.row_field_repr f with
Reither (c, tl, m, r) -> s, Reither (c, tl, true, r)
| _ -> p)
row.row_fields};
Btype.iter_row make_fixed_univars row
| _ ->
Btype.iter_type_expr make_fixed_univars ty
end
let make_fixed_univars ty =
make_fixed_univars ty;
Btype.unmark_type ty
let create_package_mty = create_package_mty false
let globalize_used_variables env fixed =
let r = ref [] in
Tbl.iter
(fun name (ty, loc) ->
let v = new_global_var () in
let snap = Btype.snapshot () in
if try unify env v ty; true with _ -> Btype.backtrack snap; false
then try
r := (loc, v, Tbl.find name !type_variables) :: !r
with Not_found ->
if fixed && (repr ty).desc = Tvar then
raise(Error(loc, Unbound_type_variable ("'"^name)));
let v2 = new_global_var () in
r := (loc, v, v2) :: !r;
type_variables := Tbl.add name v2 !type_variables)
!used_variables;
used_variables := Tbl.empty;
fun () ->
List.iter
(function (loc, t1, t2) ->
try unify env t1 t2 with Unify trace ->
raise (Error(loc, Type_mismatch trace)))
!r
let transl_simple_type env fixed styp =
univars := []; used_variables := Tbl.empty;
let typ = transl_type env (if fixed then Fixed else Extensible) styp in
globalize_used_variables env fixed ();
make_fixed_univars typ;
typ
let transl_simple_type_univars env styp =
univars := []; used_variables := Tbl.empty; pre_univars := [];
begin_def ();
let typ = transl_type env Univars styp in
(* Only keep already global variables in used_variables *)
let new_variables = !used_variables in
used_variables := Tbl.empty;
Tbl.iter
(fun name p ->
if Tbl.mem name !type_variables then
used_variables := Tbl.add name p !used_variables)
new_variables;
globalize_used_variables env false ();
end_def ();
generalize typ;
let univs =
List.fold_left
(fun acc v ->
let v = repr v in
if v.level <> Btype.generic_level || v.desc <> Tvar then acc
else (v.desc <- Tunivar ; v :: acc))
[] !pre_univars
in
make_fixed_univars typ;
instance (Btype.newgenty (Tpoly (typ, univs)))
let transl_simple_type_delayed env styp =
univars := []; used_variables := Tbl.empty;
let typ = transl_type env Extensible styp in
make_fixed_univars typ;
(typ, globalize_used_variables env false)
let transl_type_scheme env styp =
reset_type_variables();
begin_def();
let typ = transl_simple_type env false styp in
end_def();
generalize typ;
typ
(* Error report *)
open Format
open Printtyp
let report_error ppf = function
| Unbound_type_variable name ->
fprintf ppf "Unbound type parameter %s" name
| Unbound_type_constructor lid ->
fprintf ppf "Unbound type constructor %a" longident lid
| Unbound_type_constructor_2 p ->
fprintf ppf "The type constructor@ %a@ is not yet completely defined"
path p
| Type_arity_mismatch(lid, expected, provided) ->
fprintf ppf
"@[The type constructor %a@ expects %i argument(s),@ \
but is here applied to %i argument(s)@]"
longident lid expected provided
| Bound_type_variable name ->
fprintf ppf "Already bound type parameter '%s" name
| Recursive_type ->
fprintf ppf "This type is recursive"
| Unbound_row_variable lid ->
fprintf ppf "Unbound row variable in #%a" longident lid
| Type_mismatch trace ->
Printtyp.unification_error true trace
(function ppf ->
fprintf ppf "This type")
ppf
(function ppf ->
fprintf ppf "should be an instance of type")
| Alias_type_mismatch trace ->
Printtyp.unification_error true trace
(function ppf ->
fprintf ppf "This alias is bound to type")
ppf
(function ppf ->
fprintf ppf "but is used as an instance of type")
| Present_has_conjunction l ->
fprintf ppf "The present constructor %s has a conjunctive type" l
| Present_has_no_type l ->
fprintf ppf "The present constructor %s has no type" l
| Constructor_mismatch (ty, ty') ->
Printtyp.reset_and_mark_loops_list [ty; ty'];
fprintf ppf "@[<hov>%s %a@ %s@ %a@]"
"This variant type contains a constructor"
Printtyp.type_expr ty
"which should be"
Printtyp.type_expr ty'
| Not_a_variant ty ->
Printtyp.reset_and_mark_loops ty;
fprintf ppf "@[The type %a@ is not a polymorphic variant type@]"
Printtyp.type_expr ty
| Variant_tags (lab1, lab2) ->
fprintf ppf
"Variant tags `%s@ and `%s have the same hash value.@ Change one of them."
lab1 lab2
| Invalid_variable_name name ->
fprintf ppf "The type variable name %s is not allowed in programs" name
| Cannot_quantify (name, v) ->
fprintf ppf "This type scheme cannot quantify '%s :@ %s." name
(if v.desc = Tvar then "it escapes this scope" else
if v.desc = Tunivar then "it is aliased to another variable"
else "it is not a variable")
| Multiple_constraints_on_type s ->
fprintf ppf "Multiple constraints for type %s" s
| Repeated_method_label s ->
fprintf ppf "@[This is the second method `%s' of this object type.@ %s@]"
s "Multiple occurences are not allowed."
| Unbound_value lid ->
fprintf ppf "Unbound value %a" longident lid
| Unbound_module lid ->
fprintf ppf "Unbound module %a" longident lid
| Unbound_constructor lid ->
fprintf ppf "Unbound constructor %a" longident lid
| Unbound_label lid ->
fprintf ppf "Unbound record field label %a" longident lid
| Unbound_class lid ->
fprintf ppf "Unbound class %a" longident lid
| Unbound_modtype lid ->
fprintf ppf "Unbound module type %a" longident lid
| Unbound_cltype lid ->
fprintf ppf "Unbound class type %a" longident lid
| Ill_typed_functor_application lid ->
fprintf ppf "Ill-typed functor application %a" longident lid
|